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

Question

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.

Answer 1

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]]

Answer 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]