# How to define nested recursive sequence? [duplicate]

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.

• The answer in the linked post works fine here: ClearAll@a; a = a = 1; a[n_Integer] := a[n] = a[a[n - 1]] + a[n - a[n - 1]]; ListPlot[a /@ Range[1, 100]] produces this plot May 25 '16 at 11:37
• Did you at least look at the Mathematica notebook in this page? May 25 '16 at 13:04
• @J.M. yes i looked at the page in the link but i didnt find a notebook?? May 25 '16 at 14:37
• There's a tiny "Download Mathematica Notebook" link just below the title. May 25 '16 at 14:40
• 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. May 25 '16 at 17:17

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//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//Timing --> {0., <|1 -> 1, 2 -> 1,...,24 -> 14, 25 -> 15|>}

• Thanks, but when i change the initial values it doesnt work?? May 26 '16 at 8:22
• 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 May 27 '16 at 1:14

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
(* {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)"}] 