Mathematica periodic moving map

Here is one way:

movingMapCircular[f_, l_List] := MapThread[f@* List, {l, RotateLeft[l]}];

For example:

movingMapCircular[f, {1, 2, 3, 4}]

(* {f[{1, 2}], f[{2, 3}], f[{3, 4}], f[{4, 1}]} *)

A generalization of this approach for arbitrary window size may look like:

ClearAll[movingMapCircular];
movingMapCircular[f_, l_List, {n_Integer}] :=
  MapThread[
    f@* List,
    MapThread[RotateLeft, {ConstantArray[l, n], Range[0, n - 1]}]
  ];

for example:

movingMapCircular[f, Range[5], {3}]

(* {f[{1, 2, 3}], f[{2, 3, 4}], f[{3, 4, 5}], f[{4, 5, 1}], f[{5, 1, 2}]} *)

"Reflected" padding works as desired but "Periodic" padding is missed. There is corresponding definition for "Reflected"

RandomProcesses`TemporalDataUtilitiesDump`toCannonicalPadding[
  RandomProcesses`TemporalDataUtilitiesDump`td_, "Reflected", 
  RandomProcesses`TemporalDataUtilitiesDump`w_, 
  RandomProcesses`TemporalDataUtilitiesDump`Caller_] := 
 Reverse[Rest[
   TemporalData`Utilities`TDResample[
     RandomProcesses`TemporalDataUtilitiesDump`td,
     RandomProcesses`TemporalDataUtilitiesDump`w, {}, 
     RandomProcesses`TemporalDataUtilitiesDump`Caller]["Values"]]]

So we can add a similar definition for "Periodic"

RandomProcesses`TemporalDataUtilitiesDump`toCannonicalPadding[
  RandomProcesses`TemporalDataUtilitiesDump`td_, "Periodic", 
  RandomProcesses`TemporalDataUtilitiesDump`w_, 
  RandomProcesses`TemporalDataUtilitiesDump`Caller_] := 
 TemporalData`Utilities`TDResample[
   RandomProcesses`TemporalDataUtilitiesDump`td, 
   RandomProcesses`TemporalDataUtilitiesDump`w, {}, 
   RandomProcesses`TemporalDataUtilitiesDump`Caller]["Values"]

Verification:

MovingMap[f, Range[3], {2}, "Periodic"]
(* {f[{3, 1}], f[{1, 2}], f[{2, 3}]} *)

With versions 10.4.1 and 11.0.1 "Periodic" works:

MovingMap[f, Range[5], 1, "Periodic"]
MovingMap[f, Range[5], {1, Left}, "Periodic"]
MovingMap[f, Range[5], 2, "Periodic"]
MovingMap[f, Range[5], {2, Center}, "Periodic"]
{f[{5, 1}], f[{1, 2}], f[{2, 3}], f[{3, 4}], f[{4, 5}]}

{f[{1, 2}], f[{2, 3}], f[{3, 4}], f[{4, 5}], f[{5, 1}]}

{f[{4, 5, 1}], f[{5, 1, 2}], f[{1, 2, 3}], f[{2, 3, 4}], f[{3, 4, 5}]}

{f[{5, 1, 2}], f[{1, 2, 3}], f[{2, 3, 4}], f[{3, 4, 5}], f[{4, 5, 1}]}

But MovingMap is still one order of magnitude slower than Map + Partition:

ClearSystemCache[]
m1 = MovingMap[f, Range[10^6], {2, Center}, "Periodic"]; // RepeatedTiming
ClearSystemCache[]
m2 = f /@ Partition[ArrayPad[Range[10^6], {1, 1}, "Periodic"], 3, 1]; // RepeatedTiming
ClearSystemCache[]
m3 = f /@ Partition[Range[10^6], 3, 1, {2, 2}]; // RepeatedTiming
ClearSystemCache[]
m4 = Developer`PartitionMap[f, Range[10^6], 3, 1, {2, 2}]; // RepeatedTiming
m1 === m2 === m3 === m4
{6.60, Null}

{0.950, Null}

{0.987, Null}

{1.07, Null}

True

Tags:

Map