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

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

4 Answers 4

Reset to default
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)}
Improve this answer
$\endgroup$
1
  • $\begingroup$ Thank you, kglr, much to learn here $\endgroup$
    – eldo
    Commented 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)}
Improve this answer
$\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)}
Improve this answer
$\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)}*)
Improve this answer
$\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.