5
$\begingroup$

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

$\endgroup$
4
  • 3
    $\begingroup$ Once you have par, wouldn't Mean /@ par achieve the result you seek? $\endgroup$
    – MarcoB
    Sep 28, 2023 at 11:15
  • $\begingroup$ Oh, yes of course, that's why outside looks are so important :) $\endgroup$
    – eldo
    Sep 28, 2023 at 11:20
  • $\begingroup$ 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). $\endgroup$
    – JimB
    Sep 28, 2023 at 16:23
  • $\begingroup$ 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. $\endgroup$ Sep 29, 2023 at 10:44

4 Answers 4

4
$\begingroup$
movingMean = MovingMap[Mean @* DeleteCases[0], #, #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[2]]
{a, (a + b)/2, (b + c)/2, (c + d)/2, (d + e)/2}
MovingAverage[{a, b, c, d, e}, $upTo[4]]
{a, (a + b)/2, 1/3 (a + b + c), 1/4 (a + b + c + d), 1/4 (b + c + d + e)}
$\endgroup$
1
  • $\begingroup$ Thank you, kglr, much to learn here $\endgroup$
    – eldo
    Sep 30, 2023 at 8:28
5
$\begingroup$

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)}
$\endgroup$
5
$\begingroup$
movingAverage = 
  ListCorrelate[ConstantArray[1, #2], 
    #, 
   -1, 
    0, 
    #2 &, 
    Mean @* DeleteCases[0] @* 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)}
$\endgroup$
1
$\begingroup$

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)}*)
$\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.