2
$\begingroup$

Say I have a series of time points, spread randomly throughout the year

values = 1000;
mockdata = 
  Transpose[{ResourceFunction["RandomDate"][values], 
    Table[RandomReal[], values]}];
mockdata = Sort[mockdata];

I want to accumulate the sum over a rolling two week period. This means for each date in the year the accumulation should include the previous two weeks.

I can easily accumulate over the entire year

mockaccumulated = 
 Transpose[{mockdata[[;; , 1]], Accumulate[mockdata[[;; , 2]]]}];
DateListPlot[mockaccumulated]

enter image description here

Is there a easy way to do this, or should I go about finding each two week interval, checking if a value is within this interval, then summing?

$\endgroup$

3 Answers 3

3
$\begingroup$

You can use MovingMap:

First @ RepeatedTiming[movingTotal14 = 
  MovingMap[Total, mockdata, {14, "Day"}];]

0.00637388

DateListPlot[{mockdata, movingTotal14Day}, ImageSize -> Large]

enter image description here

$\endgroup$
2
  • $\begingroup$ Very fast solution! What is the purpose of the forth argument ` {1, "Day"}` in MovingMap ? $\endgroup$ Jun 23, 2023 at 11:04
  • $\begingroup$ @UlrichNeumann, {1,"Day"} was a mistake (I wrongly thought the third argument works as offset:)) Thank you! $\endgroup$
    – kglr
    Jun 23, 2023 at 11:21
2
$\begingroup$

This is very slow - but does the job.

rollingsum[date_, datelist_, timerange_] := 
 Module[{daterange, datawithinrange, total},
  daterange = 
   DateInterval[{DateObject[DatePlus[date, -timerange], "Day"], 
     DateObject[date, "Day"]}];
  datawithinrange = Select[datelist, DateWithinQ[daterange, #[[1]]] &];
  total = Total[datawithinrange[[;; , 2]]];
  Return[total]
  ]

days = DateRange[Min[mockdata[[;; , 1]]], Max[mockdata[[;; , 1]]]];
days = DateObject[#, "Day"] & /@ days;
days = DeleteDuplicates[days];

accumulated = Table[{x, rollingsum[x, mockdata, 14]}, {x, days}]

DateListPlot[accumulated]

enter image description here

$\endgroup$
2
$\begingroup$

Perhaps a bit more direct than @Tomi's answer, but still slow:

result = Table[
(* take all elements in the 2week neighbourhoud of md[[1]]*) 
zw = Select[mockdata,0 <= DateDifference[#[[1]], md[[1]], "Week"][[1]] <= 2 &];
{md[[1]], Total[zw[[All, 2]]]}
, {md, mockdata}];  (*440seconds*)

DateListPlot[result]

enter image description here

$\endgroup$

Your Answer

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

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