Insert two random time points to data

Question

I have a data as following. I want to add two random time points, one for birth one for death.

   data={{1, 10}, {1.06117, 11}, {1.21241, 12}, {1.33893, 13}, {1.41358, 14}, {2, 14}};

ListLinePlot[data, Mesh -> Full, MeshStyle -> {Red, PointSize[0.01]},
  Frame -> True, PlotTheme -> "Detailed", 
 FrameLabel -> {"Time", "Population"}, ImageSize -> Medium, 
 InterpolationOrder -> 0]

Here is one desired output

   data2={{1, 10}, {1.06117, 11}, {1.10169, 11}, {1.21241, 12}, {1.33893, 
  13}, {1.41358, 14}, {1.51463, 14}, {2, 14}};

ListLinePlot[{data, data2}, Mesh -> Full, 
 MeshStyle -> {Red, PointSize[0.01]}, Frame -> True, 
 PlotTheme -> "Detailed", FrameLabel -> {"Time", "Population"}, 
 ImageSize -> Medium, InterpolationOrder -> 0]

birth is added at {1.10169, 11} and death is added at {1.51463, 14}. I wanna keep both path, i.e. blue and yellow paths. Second path (yellow path ) must also start at {1,10} and finish at {2,14}. Population size can increase or decrease only by 1. Any idea?

kglr · Accepted Answer · 2018-06-12T10:12:39.003

ClearAll[insertBD]
insertBD[p_List, bd_List] := Module[{
   a = Transpose@{#, Prepend[Differences[#2], #2[[1]]]} & @@ Transpose@#, 
   b = Transpose@{Transpose@{RandomReal /@ Partition[#[[All, 1]], 2, 1][[p]], bd}, p}}, 
  Transpose[{#, Accumulate[#2]}] & @@ 
    Transpose[SortBy[Fold[Insert[#, ## & @@ #2] &, a, b], First]]] &;

SeedRandom[1]
data = {{1, 10}, {1.06117, 11}, {1.21241, 12}, {1.33893, 13}, {1.41358, 14}, {2, 14}};

ListLinePlot[{data, insertBD[{1, 5}, {1, -1}] @ data}, Mesh -> Full, 
  MeshStyle -> {Red, PointSize[0.01]}, Frame -> True, 
  PlotTheme -> "Detailed", 
  FrameLabel -> {"Time", "Population"}, ImageSize -> Medium, 
  InterpolationOrder -> 0]

Use insertBD[{4, 2}, {1, -1}]@data (i.e., insert a birth at a random time in position 4 and a death at a random time in position 2) to get

Use insertBD[{1, 3, 4, 5}, {1, -1, -1, 1}]@data (i.e., insert births at random times in positions 1 and 5 and deaths at random times in positions 3 and 4) to get

It works great when pop increase or decrease but in case of constant population code gives error. Can we modify it. Here is the sample data. data={{1,10},{2,10}}; — OkkesDulgerci, Jun 12 '18 at 14:51
@Okkes, for data={{1,10},{2,10}} , the first argument of insertBD cannot contain an integer greater than 1 (Length[data]-1). So insertBD[{1, 1}, {1, -1}]@data works. — kglr, Jun 12 '18 at 14:59

score 1 · Answer 2 · answered Jun 12 '18 at 07:12

Perhaps you can make use of StepFunction from my answer to question How can the behavior of InterpolationOrder->0 be controlled?:

StepFunction[data_, pos_:Left]:=Module[{sdata,nf},
    sdata=Sort@data;
    nf = Nearest[sdata[[All,1]]->"Index"];
    StepFunction[
        nf,
        sdata[[All,1]],
        sdata[[All,2]],
        Replace[pos,{Left->{0,1}, _->{-1,0}}]
    ]
]

StepFunction[nf_NearestFunction, x_, y_, clip_][pt_List] := With[
    {near = nf[pt][[All,1]]},

    y[[Clip[near + Clip[Sign[Subtract[pt, x[[near]]]], clip], {1, Length[x]}]]]
]
StepFunction[nf_NearestFunction, x_, y_, clip_][pt_]:=With[
    {near=First@nf[pt]},

    y[[Clip[near + Clip[Sign[Subtract[pt, x[[near]]]], clip], {1, Length[x]}]]]
]

For your example:

data={{1, 10}, {1.06117, 11}, {1.21241, 12}, {1.33893, 13}, {1.41358, 14}, {2, 14}};
data2={{1,0}, {1.10169,1}, {1.51463,0}};

sf1 = StepFunction[data, Right];
sf2 = StepFunction[{{1,0}, {1.10169,1}, {1.51463,0}}, Right];

Visualization:

Plot[{sf1[x], sf1[x]+sf2[x]}, {x, 1, 2}]

Insert two random time points to data

2 Answers2

Linked