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$
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$
  • $\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$ – OkkesDulgerci May 1 '18 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 '18 at 23:47
  • $\begingroup$ I meant Carl's solution in the link. $\endgroup$ – OkkesDulgerci May 1 '18 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$
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, privacy policy and cookie policy

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