# How to neatly get the sum of symmetric elements in a list?

symmSum[{a, b, c, d, e, f}]

(*==> {a+f, b+e, c+d} *)

symmSum[{a, b, c, d, e}]

(*==> {a+e, b+d, c} *)


My clumsy solution is

symmSum[l_List] := Block[{n = Length@l, res},
res = Last@Last@Reap@Do[Sow[l[[i]] + l[[-i]]], {i, Ceiling[n/2]}];
If[OddQ@n, res[[-1]] /= 2];
res
];


I feel that this can be done without using Length, but how?

-
See my update for a Length-less solution. –  Szabolcs Feb 4 '12 at 21:34
Thank you all guys, it was fascinating! –  faleichik Feb 5 '12 at 7:36

Playing with patterns:

{a, b, c, d, e} //. {h_, b___, t : Except[_List]} :> {h + t, {b}} // Flatten


This can be written more efficiently, without the full rescanning inherent in //., using recursion:

f1 = # /. {h_, b___, t_} :> Prepend[f1 @ {b}, h + t] &;


Also as a DownValues definition which is a bit more efficient still:

f2[{h_, b___, t_}] := Prepend[f2 @ {b}, h + t]
f2[x_] := x

f2 @ {a, b, c, d, e}
f2 @ {a, b, c, d, e, f}

{a + e, b + d, c}
{a + f, b + e, c + d}


Disregarding elegance, this is the fastest method I could come up with for packed arrays:

Module[{ln = Length@#, x},
x  = #[[ ;; ⌈ln/2⌉ ]];
x += #[[ -1 ;; ⌊ln/2⌋ + 1 ;; -1 ]];
If[OddQ @ ln, x[[-1]] /= 2 ];
x
] &


I imagine it can be bested by compile-to-C in v8, but I don't have that.

-
+1, my favourite so far –  Szabolcs Feb 4 '12 at 22:27
@Szabolcs Thanks! I like your iter better. I use that structure fairly often myself, and it always feels powerful (a little code goes a long way). –  Mr.Wizard Feb 4 '12 at 23:12
the first method is very impressive –  acl Feb 5 '12 at 0:01
@Szabolcs I added an improved method to my answer that I like best of all now. I fear it may encroach upon your answer, however it is in essence my original method written recursively. –  Mr.Wizard Apr 25 '14 at 4:11

This is a simple though somewhat wasteful solution:

symmSum[l_List] := Take[l + Reverse[l], Ceiling[Length[l]/2]]


It will give you the middle element twice, not once. Is it important that you only get c (and not 2c) when applying this function to {a,b,c,d,e}? That's easy to do (avoiding computing elements twice is also easy), but will make the function slightly longer. These solutions all use Length though.

Here's a pattern-based solution which avoids Length:

iter[{result___}, {s_, mid___, e_}] := iter[{result, e + s}, {mid}]
iter[{result___}, {}] := {result}
iter[{result___}, {mid_}] := {result, mid}

symmSum[l_List] := iter[{}, l]


You may want to modify this as

symmSum[l_List] := Block[{$IterationLimit = Infinity}, iter[{}, l]]  to make it work for arbitrarily long lists. - +1 for iter ; nice! – Mr.Wizard Feb 4 '12 at 21:38 What's wrong with Length? It's a very efficient function to callculate (since lists are vectors internally, i.e. arrays of fixed size, whose length is precisely known to the program at all times). symSum = Module[{result, length = Length[#]}, result = (# + Reverse@#) [[1 ;; Ceiling[length/2]]]; If[OddQ[length], result[[-1]] /= 2]; result ] &; symSum@{a, b, c, d, e, f} symSum@{a, b, c, d, e}  {a + f, b + e, c + d} {a + e, b + d, c}  - Nothing wrong, just a wish for perfection :-) – faleichik Feb 5 '12 at 7:35 Here's an approach using a specially constructed (sparse) matrix: symmSum[list_] := With[{n = Length[list]}, Take[ SparseArray[ {Band[{1, 1}] -> 1, Band[{1, -1}, Automatic, {1, -1}] -> 1}, {n, n} ].list, Ceiling[n/2] ] ]  Test cases: symmSum[{a, b, c, d, e, f}] (* ==> {a + f, b + e, c + d} *) symmSum[{a, b, c, d, e}] (* ==> {a + e, b + d, c} *)  - With the conscious decision to eschew elegance for reliability, I present symSum[li_List] := Module[{k2 = Ceiling[Length[li]/2]}, Total[MapAt[Reverse, If[Apply[Equal, Length /@ #], #, MapAt[Function[l, PadLeft[l, k2]], #, {2}]] &[ Partition[li, k2, k2, {1, 1}, {}]], {2}]]]  or more compactly, symSum[li_List] := Module[{k2 = Ceiling[Length[li]/2]}, Total[MapAt[Reverse, PadLeft[Partition[li, k2, k2, {1, 1}, {}], {2, k2}], {2}]]]  Testing: list = {a, b, c, d, e, f}; symSum[list] {a + f, b + e, c + d} symSum[Most@list] {a + e, b + d, c}  Yet another variation: symSum[li_List] := Module[{k = Length[li], k2}, k2 = Ceiling[k/2]; Total[MapAt[ Composition[Reverse, If[EvenQ[k], Identity, RotateRight]], InternalDeflatten[PadRight[li, 2 k2], {2, k2}], {2}]]]  and we can keep on putting out variations until we're all blue in the face: symSum[li_List] := Module[{k = Length[li], k2}, k2 = Ceiling[k/2]; PadRight[Total[ Take[li, {#, # Quotient[k, 2], #}] & /@ {1, -1}], k2, test[[k2]]]]  - baroque! +1 though – acl Feb 5 '12 at 0:06 @acl if it ain't baroque, don't fix it! (I so rarely get to use that pun, and I'd apologize for it, if I felt any remorse whatsoever.) – rcollyer Feb 5 '12 at 3:16 Recursive solution fr[l_] := Which[ l == {}, Sequence[{}], Drop[l, 1] == {}, l, True, {First[l] + Last[l], Sequence @@ fr[Take[l, {2, -2}]]} ]  so fr[{a, b, c, d, e}] fr[{a, b, c, d, e, f}] (* {a + e, b + d, c} {a + f, b + e, c + d} *)  For longer lists, one would need to increase the recursion limit like so Block[{$RecursionLimit = \[Infinity]},
fr[RandomInteger[{-5, 5}, 1000]]]
(*lots of stuff*)


Previous solutions

For lists of even length,

(#[[1 ;; -1 ;; 2]] + Reverse@#[[2 ;; -1 ;; 2]]) &


does what you want. For odd lengths, I don't see how to avoid Length.

length without Length

length[lst_] :=
Module[{i},
i = 1;
NestWhile[(i += 1; Rest@#) &, lst, Rest[#] \[NotEqual] {u} &];
i
]


a bit silly though.

Locating the centre of a list

Here is how to find the central position of an odd-length list (returns $Failed for even-length lists): findMiddle[lst_] := If[ # == {},$Failed,
First@First@#] &@Position[
Function[
{l},
Equal,
{l, Reverse@l}
]
]@MapIndexed[First@#2 &, lst],
True
]


(please note this is not serious, so do not point out inefficiencies!).

-
...asuming the odd list doesn't have any symmetrical elements other than the middle one. The one for even lists doesn't work, try it for a list of more than 4 elements –  Rojo Feb 4 '12 at 22:24
@rojo oops true! the first seems to work.. –  acl Feb 4 '12 at 22:39
I run the first with {a, b, c, d, e, f} as input and get {a+f, c+d, b+e} instead of {a+f, b+e, c+d} –  Rojo Feb 5 '12 at 7:11
@Rojo I see, I had not interpreted the question this way (ie that the order is important) –  acl Feb 5 '12 at 10:49

sumSym = Block[{$RecursionLimit = Infinity}, Flatten[ If[Length[#1] <= 1, #1, {Total[#1[[{1, -1}]]], #0[#1[[2 ;; -2]]]}] &[#]] &[#] ] &;  or cuter but slower, avoiding nesting 3 functions and the flatten Block[{$RecursionLimit = Infinity},
If[Length[#1] <= 1, #1, {Total[#1[[{1, -1}]]],
Sequence @@ #0[#1[[2 ;; -2]]]}]] &


An incredibly slow solution that uses Length (hehe, what am I posting this for) could be

ReplaceList[r, {{i___, b_, ___, e_, j___} /;
Length[{i}] == Length[{j}] :> b + e,
{i___, m_, j___} /; Length[{i}] == Length[{j}] :> m}]

-

Yet another possible solution:

sumSym[x_List]:=
Module[{len=Length[x]~Quotient~2,
extra=Length[x]~Mod~2==1,
result},
result = x[[Range[len]]] + x[[-Range[len]]];
If[extra,Append[result,x[[len+1]]],result]]


Example:

sumSym@{a,b,c,d,e,f}
(*
==> {a + f, b + e, c + d}
*)

sumSym@{a,b,c,d,e}
(*
==> {a + e, b + d, c}
*)

-
Better to write extra = OddQ[Length[x]], no? –  Guess who it is. Feb 5 '12 at 12:27
I just recently learned that the *Q functions are not the right choice if you want to check mathematical properties (see mathematica.stackexchange.com/q/601/129). –  celtschk Feb 5 '12 at 12:38
That's for symbolic evaluation. Here, you can almost always expect Length[x] to return some integer that OddQ[]` certainly won't choke on... –  Guess who it is. Feb 5 '12 at 12:46