A function that accepts a list of pairs and adds new pairs that are the averages of the neighbouring pair values

Probably a duplicate, but it isn't easy browsing through list-related questions.

I am looking for an elegant way to construct a function that accepts a list of pairs, for example

list1 = {{x1, y1}, {x2, y2}, {x3, y3}};


and returns a list with added elements that are arithmetic means of the neighbouring coordinates.

list2 = Function[list1] = {{x1, y1}, {(x1+x2)/2, (y1+y2)/2}, {x2, y2},
{(x2+x3)/2, (y2+y3)/2}, {x3, y3}};


Any tips would be greatly appreciated.

• Look up MovingAverage and Riffle. Commented Mar 22, 2017 at 15:26
• Amplifying on comment by @Szabolcs: MovingAverage[Riffle[list1,list1],2] Commented Mar 22, 2017 at 17:23
• Yet another method: Most[Riffle[#, (# + RotateLeft[#])/2]]& Commented Mar 22, 2017 at 20:43

You can get the lists of consecutive pairs with Partition:

list1 = {{x1, y1}, {x2, y2}, {x3, y3}};
pairs = Partition[list1, 2, 1]


The easiest way to construct your desired output from here is to compute the means on these and then Riffle them back into the original list:

Riffle[list1, Mean /@ pairs]
(* {{x1, y1}, {(x1 + x2)/2, (y1 + y2)/2}, {x2, y2},
{(x2 + x3)/2, (y2 + y3)/2}, {x3, y3}}


Partition and Map (abbreviated as /@ above) can also be combined into one step with BlockMap:

Riffle[list1, BlockMap[Mean, list1, 2, 1]]


However, as Szabolcs points out in a comment, for the specific case where the function you want to apply is Mean, you can skip Partitions (or BlockMap) altogether and use MovingAverage instead:

Riffle[list1, MovingAverage[pairs, 2]]


using Replace and recursion

list1 = {{x1, y1}, {x2, y2}, {x3, y3}};

Clear@func;
func[list_] := list /. {___, a : {_, _}, b : {_, _}, d : {_, _} ...} :>
Join[{a, Mean[{a, b}]}, func[Join[{b}, {d}]]]

func[list1];

(* {{x1, y1}, {(x1 + x2)/2, (y1 + y2)/2}, {x2, y2}, {(x2 + x3)/2,
(y2 + y3)/2}, {x3, y3}} *)


yet another way using ReplaceRepeated

list1 //. {p___, a : {__Symbol}, b : {__Symbol},c : {__Symbol} ...} :>
{p, a, Mean[{a, b}], b, c}

(* {{x1, y1}, {(x1 + x2)/2, (y1 + y2)/2}, {x2, y2}, {(x2 + x3)/2, (
y2 + y3)/2}, {x3, y3}} *)


similar to @Martin Ender but without Riffle

Clear@func;
func[list_] :=
Flatten[#, 1] &@Join[BlockMap[Through[{First, Mean}[#]] &, list, 2,
1], {{Last@list}}];

func[list1]

(* {{x1, y1}, {(x1 + x2)/2, (y1 + y2)/2}, {x2, y2}, {(x2 + x3)/2,
(y2 + y3)/2}, {x3, y3}} *)


@Szabolcs and @Bob Hanlon's method (fewer lines, easy to understand, more elegant):

MovingAverage[Riffle[list1, list1], 2]

• @drabus you can see the above mentioned implementations too. there are a lot of ways things can be done in Mathematica Commented Mar 22, 2017 at 19:13
• In your func solution, you use three dots in your rule. What do those three dots mean?. I tried searching for it, but couldn't find anything related. Commented Mar 22, 2017 at 23:05
• @AnjanKumar its known as RepeatedNull. It accounts for the null case i.e. when nothing exists. Commented Mar 22, 2017 at 23:15
• @AnjanKumar it takes care of cases when the length of the list is odd. For even length of the list you can use Repeated rather than RepeatedNull. This is true for this particular case ! Commented Mar 22, 2017 at 23:16
• Oh! Thank you for the information. Commented Mar 22, 2017 at 23:20
list = {{x1, y1}, {x2, y2}, {x3, y3}};


Using SequenceCases (new in 10.1)

Append[Last @ list] @ SequenceCases[list, {{a_, b_}, {c_, d_}} :>
Sequence[{a, b}, {(a + c)/2, (b + d)/2}], Overlaps -> True]


{{x1, y1}, {(x1 + x2)/2, (y1 + y2)/2}, {x2, y2}, {(x2 + x3)/2, (y2 + y3)/2}, {x3, y3}}