0
$\begingroup$

This question already has an answer here:

I have Conway's Challenge sequence at hand i.e. $a_n=a_{a_{n-1}}+a_{n-a_{n-1}}$ for $\ n \geq 3$ and $a_1=a_2=1$. I have basically no idea how to define this in Mathematica.

$\endgroup$

marked as duplicate by Kuba, Jason B., MarcoB, user9660, Simon Woods May 25 '16 at 19:35

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

  • 1
    $\begingroup$ The answer in the linked post works fine here: ClearAll@a; a[1] = a[2] = 1; a[n_Integer] := a[n] = a[a[n - 1]] + a[n - a[n - 1]]; ListPlot[a /@ Range[1, 100]] produces this plot $\endgroup$ – Jason B. May 25 '16 at 11:37
  • 1
    $\begingroup$ Did you at least look at the Mathematica notebook in this page? $\endgroup$ – J. M. will be back soon May 25 '16 at 13:04
  • $\begingroup$ @J.M. yes i looked at the page in the link but i didnt find a notebook?? $\endgroup$ – user40510 May 25 '16 at 14:37
  • $\begingroup$ There's a tiny "Download Mathematica Notebook" link just below the title. $\endgroup$ – J. M. will be back soon May 25 '16 at 14:40
  • $\begingroup$ I'm iffy about closing this one, tho. I'd sure like to see somebody come up with a tail recursive implementation of the \$10,000 sequence. $\endgroup$ – J. M. will be back soon May 25 '16 at 17:17
2
$\begingroup$

There are two ways to go about this problem. The heads on approach is to simply run a function which does what you ask for;

conwayschallenge[n_] := 
 If[n == 1 || n == 2, 1, 
  conwayschallenge[conwayschallenge[n - 1]] + 
   conwayschallenge[n - conwayschallenge[n - 1]]]

However, you will find that this is very slow.

conwayschallenge[25]//Timing --> {102.552,15}

The reason for this is that it is repeating calculations over and over. A common way around this is memoization. I have done my memoization using a new feature in version 10, called associations. These are pretty much dictionaries.

conwayschallenge2[n_] := 
 Module[{i = 2, cc = <|1 -> 1, 2 -> 1|>}, 
  While[i++ < n, 
   cc = Join[
     cc, <|i -> 
       cc[[Key[cc[[Key[i - 1]]]]]] + 
        cc[[Key[i - cc[[Key[i - 1]]]]]]|>]]; cc]

And this results in much faster calculations;

conwayschallenge2[25]//Timing --> {0., <|1 -> 1, 2 -> 1,...,24 -> 14, 25 -> 15|>}
$\endgroup$
  • $\begingroup$ Thanks, but when i change the initial values it doesnt work?? $\endgroup$ – user40510 May 26 '16 at 8:22
  • $\begingroup$ My guess is that you are trying to access a negative number or zero for a(n-a(n-1)), i.e. n-a(n-1)<=0 $\endgroup$ – Squigglyteeth May 27 '16 at 1:14
1
$\begingroup$

When recursion is involved I'm always tempted to use Fold. It pretty much imitates memoization, since it stores all previous values.

conw[n_] := Module[{},
   fc[x_List, m_] := 
    Append[x, (x[[x[[m - 1]]]] + x[[m - x[[m - 1]]]])];
   If[0 < n <= 2, ConstantArray[1, n], Fold[fc, {1, 1}, Range[3, n]]]
   ];
   conw[10]
   (* {1, 1, 2, 2, 3, 4, 4, 4, 5, 6} *)

This method seems to be faster than conwayschallenge2 from @Squigglyteeth for small n, but with large n appending to a list becomes too expensive.

bench[f_, arg_List] := {#, (f[#] // Timing // First)} & /@ arg;
bk = bench[conw, Round@10^Range[1, 5, 0.2]];
sq = bench[conwayschallenge2, Round@10^Range[1, 5, 0.2]];

ListLogLogPlot[{bk, sq}, Joined -> True, Frame -> True, 
 GridLines -> Automatic, PlotLegends -> LineLegend[{"bk", "sq"}], 
 FrameLabel -> {"n", "Time (s)"}]

enter image description here

$\endgroup$

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