replace two elements in a list with the sum of those two elements?

Question

I have a list:

G[3] = {2, 4, 2, 4, 2, 4, 2, 4, 2, 4} (there's a 3 in there for the 3rd Prime)

Recursively defined by:

G[2] = {2,4}

G[i_] := Nest[Join[#, G[i - 1]] &, G[i - 1], Prime[i] - 1]

And I would like to transform it into the list

Hsum[3]= {2, 6, 4, 2, 4, 2, 4, 6}

to get the ith element of the second list, I add up elements 1 to i of the original list and test if the sum is = 1 (mod 5) then I replace G[3][[i]] with G[3][[i]]+G[3][[i+1]] and delete element G[3][[i+1]]

So far, all I can get to work is the summing and testing mod some prime.

Hsum[i_] := 
 Table[If[Mod[Sum[G[i][[j]], {j, 1, k}], Prime[i]] == 1, 
   G[i][[k]] + G[i][[k - 1]], G[i][[k]]], {k, 1, Length[G[i]]}]

but that doesn't get rid of the unwanted element that has been summed.

Any help would be appreciated!

Answer 1

Try thinking of doing substitutions on a list. You want the beginning of the list and then a couple of elements and then the rest of the list. If the beginning of the list and the next element satisfies a condition then you want the substitution to give you a modified list.

G[2] = {2, 4};
G[i_] := Nest[Join[#, G[i - 1]] &, G[i - 1], Prime[i] - 1];
g3 = G[3];
g3 //. {h__, i_, j_, k___} /; (Mod[Total[{h}]+i, 5] == 1) -> {h, i+j, k}

and that gives you

{2, 6, 4, 2, 4, 2, 4, 6}

Study that until you can see what all the pieces are doing. Look up //. and /; in the help system until you can see why this works. Carefully count the number of _ used in each place and try to understand why that number was used in each position. Note: I assigned your list to g3 instead of trying to work on G[3] to have one less level of subscripting and hopefully make this slightly easier to understand. I always try to start as simply as possible and work up from there. Then test this carefully on larger examples until you are sure it works before trusting it. Pattern matching and substitution can be tricky and error prone at times.

Answer 2

A non-rule approach

fun[list_] := 
 Module[{ps, rep}, 
  ps = {{#}, {# + 1}} & @@@ 
    Cases[Position[Mod[Accumulate[list], 5], 1], 
     Except[{1} | {Length@list}]];
  rep = Join @@ (Thread[# -> {Total@Extract[list, #], 
          Hold@Sequence[]}] & /@ ps);
  ReleaseHold[ReplacePart[list, rep]]]

Seems to scale better than replace all:

hsum[n_] := fun[G[n]];
rl[n_] := 
 With[{l = G[n]}, 
  l //. {h__, i_, j_, k___} /; (Mod[Total[{h}] + i, 5] == 1) -> {h, 
     i + j, k}]

Looking at lengths of lists:

Table[{Length[G[n]], Length@hsum[n]}, {n, 2, 8}]

yields:

{{2, 2}, {10, 8}, {70, 56}, {770, 616}, {10010, 8008}, {170170, 
  136136}, {3233230, 2586584}}

Comparison:

Naively, BenchmarkPlot[{hsum, rl}, # &, Range[2, 5], "IncludeFits" -> True]

However, removing effect of G[n]:

rul[n_] := 
 n //. {h__, i_, j_, k___} /; (Mod[Total[{h}] + i, 5] == 1) -> {h, 
    i + j, k}
BenchmarkPlot[{fun, rul}, RandomChoice[{2, 4}, #] &, 
PowerRange[10, 10^4], "IncludeFits" -> True]