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?

Answer 1

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

Answer 2

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}]