2
$\begingroup$

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!

$\endgroup$

2 Answers 2

4
$\begingroup$

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.

$\endgroup$
2
  • $\begingroup$ OK - this is great! very helpful indeed. Thank you for your careful explanation. As a result I can now make the general case: g[n_] := G[ n] //. {h__, i_, j_, k___} /; (Mod[Total[{h}] + i, Prime[n]] == 1) -> {h, i + j, k} which depends on G[i_] := Nest[Join[#, g[i - 1]] &, g[i - 1], Prime[i] - 1] for the next iteration. But this runs surprisingly slowly after a few iterations. I wonder why? Still learning, with gratitude! $\endgroup$
    – phaplinh
    Nov 3, 2014 at 8:44
  • $\begingroup$ This method of solving the problem seems simple, it is almost how you worded what you want done. Now imagine you are a mindless piece of pattern matching software. You don't "know what you obviously should do." So you start at the beginning of your list and try every possible way your pattern can match until you find one that matches. You change the two elements. But the solution says you do this again and again until nothing changes. So you start over at the beginning. That is why it gets slower and slower. You can write it in a more complicated way that is faster. Answer 2 is faster, harder. $\endgroup$
    – Bill
    Nov 5, 2014 at 16:57
0
$\begingroup$

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]

enter image description here

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]

enter image description here

$\endgroup$
1
  • $\begingroup$ Great - I've just seen this - need to take a moment to understand this approach - "module" "cases" "thread" etc all new to me. Still a lot to learn about this amazing language. :-) $\endgroup$
    – phaplinh
    Nov 3, 2014 at 8:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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