I've been stuck on a simple problem for a while. Let's say you have a list of any length: {a,b,c} How do you recursively add the first and last element of the list until you get to the middle. For example: {a+c,b}

Thanks

• (Assuming the list will always have an even number of elements but your example you gave {a,b,c} has odd number of elements? and to be more clear, if the input is say lst = {1, 2, 3, 4, 5, 6} what should the output be? And why does it have to be recursive? Apr 11, 2020 at 7:12
• Just to make sure I understand, the final list then should have only 3 elements in it? Apr 11, 2020 at 7:24
• Not necessarily. It depends on the length of the original list which will have odd number of elements Apr 11, 2020 at 7:47

Another approach is to recognize that adding the first and last elements repeatedly is the same as adding the list to a reversed version of the list. Hence:

list = {a, b, c, d, e};
(list + Reverse[list])[[1 ;; Ceiling[Length[list]/2]]]

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


If you really don't want the final term doubled (for odd-length lists) then divide the final element by 2.

ClearAll[f0]
f0 = Total @ PadRight @ {#, Reverse@#2} & @@ TakeDrop[#, Floor[Length[#]/2]] &;

f0[{a, b, c}]

{a + c, b}

f0[{a, b, c, d}]

{a + d, b + c}

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

{a + e, b + d, c}

f0 @ Array[x, 7]

{x[1] + x[7], x[2] + x[6], x[3] + x[5], x[4]}

f0 @ Array[x, 8]

{x[1] + x[8], x[2] + x[7], x[3] + x[6], x[4] + x[5]}


Also (for lists of odd length):

ClearAll[f1, f2, f3, f4, f5]
f1 = Module[{l = (Length[#] - 1)/2},
Join[#[[;; l]] + #[[-1 ;; -l ;; -1]], {#[[l + 1]]}]] &;

f2 = Module[{l = (Length[#] - 1)/2},
Append[Total[{#, Reverse@#2} & @@ Partition[#, l, l + 1]], #[[l + 1]]]] &;

f3 = Module[{l = (Length[#] - 1)/2},
Join[Table[#[[i]] + #[[- i]], {i, 1, l}], {#[[l + 1]]}]] &;

f4 = Module[{l = (Length[#] - 1)/2},
Join[Total[{#, Reverse @ Rest @ #2}], {First @ #2}] & @@ TakeDrop[#, l]] &;

f5 = Module[{l = (Length[#] - 1)/2},
Join[Total[{#, Reverse @ #3}], #2] & @@ TakeList[#, {l, 1, l}]] &;


Exploiting the fact that Flatten can transpose a ragged array:

{a,b,c} // Flatten[{Take[#,Floor[Length@#/2]], Reverse@Take[#,-Ceiling[Length@#/2]]},{{2}}]&
// Plus@@@#&


{a + c, b}

{a,b,c,d,e} // Flatten[{Take[#,Floor[Length@#/2]],  Reverse@Take[#,-Ceiling[Length@#/2]]},{{2}}]&
// Plus@@@#&


{a + e, b + d, c}

 Array[x, 7] // Flatten[{Take[#,Floor[Length@#/2]],  Reverse@Take[#,-Ceiling[Length@#/2]]},{{2}}]&
// Plus@@@#&


{x[1] + x[7], x[2] + x[6], x[3] + x[5], x[4]}

 {a,b,c,d} // Flatten[{Take[#,Floor[Length@#/2]],  Reverse@Take[#,-Ceiling[Length@#/2]]},{{2}}]&
// Plus@@@#&


{a + d, b + c}

you can use recursion to solve it.

Which[
Length@# == 1,   #,
True,            {First@# + Last@#, #0[# // Rest // Most]} // Flatten
] &@{a, b, c, e, f, g, h, i, j}


or

Which[
Length@# == 1,   #,
True,            Join[{First@# + Last@#}, #0[# // Rest // Most]]
] &@{a, b, c, e, f, g, h, i, j}


It's easy to find that each operation make the first and last element to the head of list, and the operation will be on the [[2;;-2]] part.

• there is another way, which maybe more intuitive? Prepend[#0[# // Rest // Most], First@# + Last@#] Apr 11, 2020 at 16:33

Using FoldPairList:

Define a function to insert a 0, if the list has odd length.

f[k_List] :=
If[OddQ[Length@k], Insert[k, 0, 1 + Ceiling@(Length@list/2)], k] &@
list

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


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

list = {a, b, c, d, e};
FoldPairList[{First@# + Last@#, Most@Rest@#} &, f[list],
ConstantArray[1, Length@f[list]/2]]


{a + e, b + d, c}

list = {a, b, c, d, e, f};
FoldPairList[{#[[1]] + #[[-1]], #[[2 ;; -2]]} &, f[list],
ConstantArray[1, Length@f[list]/2]]


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

For learners that are new to First, Last, Most, Rest usage, an alternate syntax using Part is provided in the second example above that will help with learning.

• (+1) I won't forget this use of FoldPairList. Apr 13, 2023 at 18:06