0
$\begingroup$

I have the data below. I would like to sample with equal step size. For simplicity lets try unit step size. Here is the desired result. Find the first time exceed the unit time step, and take lower ones second entry. {{1,0},{2,0},{3,3},{4,10},{5,17},{6,27},{7,43},{8,63}} and so on.

This suppose to work but it does not.

iFun = Interpolation[data, InterpolationOrder -> 0];
τ = 1;
range = Range[0, data[[-1, 1]], τ];
data2 = Transpose@{range, iFun@range};



SeedRandom@2 
    A = 30;
    \[Beta] = 0.05;
    {a, b} = {72, 1/12};

X = x = 0;

currentTime = 0;
stackTime = {};
data = Prepend[Join @@ Last@Reap@Do[

       a1 = A   ;
       a2 = \[Beta] X;
       a0 = Total@{a1, a2};
       reactionVec = 1/a0 Accumulate@{a1, a2};

       reaction = 
        First@FirstPosition[reactionVec - RandomReal[], _?Positive];

       tDelay = RandomVariate@GammaDistribution[a, b];

       tWait = RandomVariate@ExponentialDistribution[a0];

       currentTime = currentTime + tWait;

       stackTime = Sort@stackTime;

       minStack = Min[stackTime];

       Which[

        currentTime < minStack,


        Which[

         reaction == 1, {Sow@{currentTime, X}, 
          AppendTo[stackTime, currentTime + tDelay]},

         reaction == 2, {Sow@{currentTime, X -= 1}}],


        minStack < currentTime, 

        {Sow@{minStack, X += 1}, currentTime = minStack, 
         stackTime = Rest@stackTime} ]

       , 1000], {0, x}];
$\endgroup$
1

3 Answers 3

5
$\begingroup$

Also

TimeSeriesResample[data, {Range[1, data[[-1, 1]], τ]}]

{{1, 0}, {2, 0}, {3, 3}, {4, 10}, {5, 17}, {6, 27}, {7, 43}, {8, 63}}

$\endgroup$
3
  • $\begingroup$ This method seems slow for large data. Do you know how to speed it up. I found this but don't know how to modify it. mathematica.stackexchange.com/questions/169688/… $\endgroup$ May 1, 2018 at 23:17
  • $\begingroup$ @Okkes, unfortunately, I don't know how to make tit faster. The linked answer is using TimeSeriesResample with additional processing steps. You can use TimeSeriesResample[TimeSeries[data] , {Range[1, data[[-1, 1]], \[Tau]]}, ResamplingMethod->{"Interpolation",InterpolationOrder->0}]["Path"] but I doubt this would be faster. $\endgroup$
    – kglr
    May 1, 2018 at 23:47
  • $\begingroup$ I meant Carl's solution in the link. $\endgroup$ May 1, 2018 at 23:50
3
$\begingroup$
  1. Your range specification should start at $1$ if that is what you want the first abscissa to be; you were starting at $0$ instead.
  2. Use Floor to get the floor of your interpolated function value.

In other words, try this:

iFun = Interpolation[data, InterpolationOrder -> 1];
τ = 1;
range = Range[1, data[[-1, 1]], τ];
data2 = Transpose@{range, Floor@iFun@range}

(* Out: {{1, 0}, {2, 0}, {3, 3}, {4, 10}, {5, 17}, {6, 27}, {7, 43}, {8, 63}} *)
$\endgroup$
2
1
$\begingroup$

Here is faster way to do it. I modified the code that I found here

SeedRandom@2
A = 30;
\[Beta] = 0.05;
{a, b} = {72, 1/12};

X = x = 0;

currentTime = 0;
stackTime = {};
data = Prepend[Join @@ Last@Reap@Do[a1 = A;
       a2 = \[Beta] X;
       a0 = Total@{a1, a2};
       reactionVec = 1/a0 Accumulate@{a1, a2};

       tWait = RandomVariate@ExponentialDistribution[a0];

       currentTime = currentTime + tWait;

       stackTime = Sort@stackTime;

       minStack = Min[stackTime];

       Which[

        currentTime < minStack,


        reaction = 
         First@FirstPosition[reactionVec - RandomReal[], _?Positive];
        Which[reaction == 1,


         {Sow@{currentTime, X}, 
          AppendTo[stackTime, 
           currentTime + RandomVariate@GammaDistribution[a, b]]},

         reaction == 2, {Sow@{currentTime, X -= 1}}],

        minStack < currentTime, {Sow@{minStack, X += 1}, 
         currentTime = minStack, stackTime = Rest@stackTime}], 
       500000], {0, x}];

TimeSeriesResample Method:

\[Tau] = 1;
data2 = TimeSeriesResample[
    data, {Range[0, data[[-1, 1]], \[Tau]]}]; // AbsoluteTiming

{10.5438, Null}

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

StepFunction[nf_NearestFunction, x_, y_, clip_][pt_List] := 
 With[{near = nf[pt][[All, 1]]}, 
  Join[List@
    pt, {y[[Clip[
      near + Clip[Sign[Subtract[pt, x[[near]]]], clip], {1, 
       Length[x]}]]]}]]
data3 = Transpose@
    StepFunction[data][
     Range[0, data[[-1, 1]], \[Tau]]]; // AbsoluteTiming

{0.439258, Null}

data2 == data3

True

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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