# An accumulated moving average

1. Problem statement

In accordance with the standard definitions the inbuilt MovingAverage

list = {a, b, c, d, e};
n = 3;
MovingAverage[list, n]


{(a + b + c)/3, (b + c + d)/3, (c + d + e)/3}

shortens the original list. But in some cases (f.e. if the values are very similar) it might be desirable to avoid this shortening.

I thought there should be an inbuilt function (variant) which would do this. So I looked at MovingMap, TimeSeries and related functions, but I didn't find one.

2. Current solution

After some struggling with the Partition parameters I found the following solution:

par = Partition[list, n, 1, -1, {}]


{{a}, {a, b}, {a, b, c}, {b, c, d}, {c, d, e}}

MapApply[Plus] @ par / Map[Length, par]


{a, (a + b)/2, (a + b + c)/3, (b + c + d)/3, (c + d + e)/3}

3. Other examples

list = {a, b, c, d, e, f};
n = 4;
Plus @@@ # / Map[Length, #] & [Partition[list, n, 1, -1, {}]]


{a, (a + b)/2, (a + b + c)/3, (a + b + c + d)/4, (b + c + d + e)/4, (c + d + e + f)/4}

list = {a, b};
n = 2;
Plus @@@ # / Map[Length, #] & [Partition[list, n, 1, -1, {}]]


{a, (a + b)/2}

4. Question

I'm curious to see what alternative solutions would look like

• Once you have par, wouldn't Mean /@ par achieve the result you seek? Sep 28 at 11:15
• Oh, yes of course, that's why outside looks are so important :)
– eldo
Sep 28 at 11:20
• You might consider a more modern approach by using LOESS and/or LOWESS: mathematica.stackexchange.com/questions/106126/…. This approach doesn't need to assume equal distances between data points and even allows extrapolation (although there should be some subject matter justification for that).
– JimB
Sep 28 at 16:23
• It's possible that the reason you haven't found an inbuilt function for doing this is that the correct solution to this issue depends on the nature of your data. For instance, if the data followed an approximately linear trend, the method you've outlined here would give biased results at the end values. In that case, one might be better off running a linear fit through the last available data points. Sep 29 at 10:44

movingMean = MovingMap[Mean @* DeleteCases, #, #2 - 1, 0] &;


Examples:

movingMean[{a, b}, 2]

{a, (a + b)/2}

movingMean[{a, b}, 1000]

{a, (a + b)/2}

movingMean[{a, b, c, d, e}, 2]

{a, (a + b)/2, (b + c)/2, (c + d)/2, (d + e)/2}

movingMean[{a, b, c, d, e}, 3]

{a, (a + b)/2, 1/3 (a + b + c), 1/3 (b + c + d), 1/3 (c + d + e)}

movingMean[{a, b, c, d, e}, 4]

{a, (a + b)/2, 1/3 (a + b + c), 1/4 (a + b + c + d), 1/4 (b + c + d + e)}


Note:

We can also use TagSetDelayed to define a tag that makes MovingAverage behave as if it accepts UpTo[_] as the second argument:

$$upTo /: MovingAverage[a_,$$upTo[n_]] := movingMean[a, n]


Examples:

MovingAverage[{a, b, c, d, e}, $upTo]  {a, (a + b)/2, (b + c)/2, (c + d)/2, (d + e)/2}  MovingAverage[{a, b, c, d, e},$upTo]

{a, (a + b)/2, 1/3 (a + b + c), 1/4 (a + b + c + d), 1/4 (b + c + d + e)}

• Thank you, kglr, much to learn here
– eldo
Sep 30 at 8:28

Using the (still-undocumented) 6th argument of Partition:

movingPartitionAverage = Partition[##, 1, -1, {}, Mean @* List] &;


Examples:

movingPartitionAverage[{a, b}, 2]

{a, (a + b)/2}

movingPartitionAverage[{a, b}, 10^5]

{a, (a + b)/2}

movingPartitionAverage[{a, b, c, d, e}, 2]

{a, (a + b)/2, (b + c)/2, (c + d)/2, (d + e)/2}

movingPartitionAverage[{a, b, c, d, e}, 4]

{a, (a + b)/2, 1/3 (a + b + c), 1/4 (a + b + c + d), 1/4 (b + c + d + e)}

movingPartitionAverage[{a, b, c, d, e}, 10]

{a, (a + b)/2, 1/3 (a + b + c), 1/4 (a + b + c + d),
1/5 (a + b + c + d + e)}

movingAverage =
ListCorrelate[ConstantArray[1, #2],
#,
-1,
0,
#2 &,
Mean @* DeleteCases @* List] &;


Examples:

movingAverage[{a, b}, 2]

{a, (a + b)/2}

movingAverage[{a, b}, 10^5]

{a, (a + b)/2}

movingAverage[{a, b, c, d, e}, 2]

{a, (a + b)/2, (b + c)/2, (c + d)/2, (d + e)/2}

movingAverage[{a, b, c, d, e}, 4]

{a, (a + b)/2, 1/3 (a + b + c), 1/4 (a + b + c + d), 1/4 (b + c + d + e)}

movingAverage[{a, b, c, d, e}, 10]

{a, (a + b)/2, 1/3 (a + b + c), 1/4 (a + b + c + d),
1/5 (a + b + c + d + e)}


My attempt is the following:

CompleteAdjustedMovingAverage[data_List, n_Integer] :=
Module[{len, partitionSize, start, end, partitions},
len = Length[data];
partitions = Table[partitionSize = Min[n, i, len - i + n];
start = i - partitionSize + 1;
end = i;
data[[start ;; end]], {i, len}];
Mean /@ partitions]


Testing CompleteAdjustedMovingAverage:

CompleteAdjustedMovingAverage[{a, b, c, d, e}, 3]

(*{a, (a + b)/2, 1/3 (a + b + c), 1/3 (b + c + d), 1/3 (c + d + e)}*)