3
$\begingroup$

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]

enter image description here

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]

enter image description here

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?

$\endgroup$
1
$\begingroup$
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]

enter image description here

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

enter image description here

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

enter image description here

$\endgroup$
  • $\begingroup$ 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}}; $\endgroup$ – OkkesDulgerci Jun 12 '18 at 14:51
  • $\begingroup$ @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. $\endgroup$ – kglr Jun 12 '18 at 14:59
1
$\begingroup$

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

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.