cumulative sums

Question

I have a list of integers. The first n members of the lists will, when added to each other, will result in the n + 1 st member of the list. . I would like to replace each list with the accumulated sum when a match occurs; if there is more than one match (e.g. lis5), replace the list with the numerically largest match.

lis1 = {8,2,3,9,22} res1 = 22

lis2 = {9,11,21,3,44,12,3} res2 = 44

lis3 = {3,8,2,1,12,26} res3 = 26

lis4 = {8,4,6,2,9,11,40,3} res4 = 40

lis5 = {3,7,10,2,14,36,4} res5 = 36 (not 10)

Testing recursively the accumulated sum against each succeeding element until a match is found. Thanks for any ideas...

Answer 1

This function should do:

f = x \[Function] Last[Intersection[x, Accumulate[x]]]

(Note that Intersection automatically orders lists, so we merely have to take the last element of the intersection.)

Testing:

lists = {{8, 2, 3, 9, 22},
   {9, 11, 21, 3, 44, 12, 3},
   {3, 8, 2, 1, 12, 26},
   {8, 4, 6, 2, 9, 11, 40, 3},
   {3, 7, 10, 2, 14, 36, 4}
   };
f /@ lists

{22, 44, 26, 40, 36}

Edit

kglr pointed out that the equality of position might be necessary for a match. In this case, the following function might be what you are looking for.

g = x \[Function] Max[Pick[Rest[x], Unitize[Accumulate[Most[x]] - Rest[x]], 0]]

We obtain

g /@ lists

{22, 44, 26, 40, 36}

and with kglr's lists2

lists2 = {{22, 2, 9, 8, 3},
   {9, 3, 12, 44, 3, 21, 11},
   {12, 8, 2, 3, 1, 26},
   {2, 11, 6, 8, 4, 9, 3, 40},
   {3, 10, 4, 7, 14, 36, 2}
   };
g /@ lists2

{-∞, 12, 26, -∞, -∞}

(And yes, the supremum of an empty set is $-\infty$.)

Answer 2

Another approach is to recognize that what you want is the max value in each list. Hence:

lists = {{8, 2, 3, 9, 22}, 
         {9, 11, 21, 3, 44, 12, 3}, 
         {3, 8, 2, 1, 12, 26}, 
         {8, 4, 6, 2, 9, 11, 40, 3}, 
         {3, 7, 10, 2, 14, 36, 4}};
 Max @@@ lists
{22, 44, 26, 40, 36}

Answer 3

f1 = Module[{i = Length@#, a = #, b = Accumulate @ #}, 
    While[a[[i]] - b[[--i]] != 0 && i > 0]; ; If[i == 0, {}, a[[i + 1]]]] &;
f2 = Module[{a = Reverse @ Accumulate @ Most @ #, b = Reverse @ Rest @ #, l}, 
    l = LengthWhile[a - b, # != 0 &]; If[l == Length@a, {}, a[[1 + l]]]] &;

Examples:

lists = {{8, 2, 3, 9, 22},
   {9, 11, 21, 3, 44, 12, 3},
   {3, 8, 2, 1, 12, 26},
   {8, 4, 6, 2, 9, 11, 40, 3},
   {3, 7, 10, 2, 14, 36, 4}};

{f1 /@ lists, f2 /@ lists}

{{22, 44, 26, 40, 36}, {22, 44, 26, 40, 36}}

SeedRandom[1]
lists2 = RandomSample/@lists

{{22, 2, 9, 8, 3},
{9, 3, 12, 44, 3, 21, 11},
{12, 8, 2, 3, 1, 26},
{2, 11, 6, 8, 4, 9, 3, 40},
{3, 10, 4, 7, 14, 36, 2}}

{f1 /@ lists2, f2 /@ lists2}

{{{}, 12, 26, {}, {}}, {{}, 12, 26, {}, {}}}

Answer 4

(Pick[#, (#1 - #2) & @@@ FoldList[{#2, Total@Flatten@{#1}} &, #],0][[-1]]) & /@ lists

{22, 44, 26, 40, 36}

Original Answer

'Borrowing' from bill s

Max@Cases[FoldList[{#2, Total@Flatten@{#1}} &, lst5], {x_, x_} :> x]

36

lists = {{8, 2, 3, 9, 22}, {9, 11, 21, 3, 44, 12, 3}, {3, 8, 2, 1, 12,
 26}, {8, 4, 6, 2, 9, 11, 40, 3}, {3, 7, 10, 2, 14, 36, 4}};

Max@Cases[FoldList[{#2, Total@Flatten@{#1}} &, #], {x_, x_} :> x] & /@ lists

{22, 44, 26, 40, 36}