3
$\begingroup$

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.

$\endgroup$
  • 6
    $\begingroup$ Look up MovingAverage and Riffle. $\endgroup$ – Szabolcs Mar 22 '17 at 15:26
  • 1
    $\begingroup$ Amplifying on comment by @Szabolcs: MovingAverage[Riffle[list1,list1],2] $\endgroup$ – Bob Hanlon Mar 22 '17 at 17:23
  • 1
    $\begingroup$ Yet another method: Most[Riffle[#, (# + RotateLeft[#])/2]]& $\endgroup$ – heropup Mar 22 '17 at 20:43
7
$\begingroup$

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]]
$\endgroup$
2
$\begingroup$

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]
$\endgroup$
  • $\begingroup$ @drabus you can see the above mentioned implementations too. there are a lot of ways things can be done in Mathematica $\endgroup$ – Ali Hashmi Mar 22 '17 at 19:13
  • $\begingroup$ 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. $\endgroup$ – Anjan Kumar Mar 22 '17 at 23:05
  • $\begingroup$ @AnjanKumar its known as RepeatedNull. It accounts for the null case i.e. when nothing exists. $\endgroup$ – Ali Hashmi Mar 22 '17 at 23:15
  • $\begingroup$ @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 ! $\endgroup$ – Ali Hashmi Mar 22 '17 at 23:16
  • $\begingroup$ Oh! Thank you for the information. $\endgroup$ – Anjan Kumar Mar 22 '17 at 23:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.