How to define nested recursive sequence?

Question

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[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 — Jason B., May 25 '16 at 11:37
Did you at least look at the Mathematica notebook in this page? — J. M.'s missing motivation, May 25 '16 at 13:04
@J.M. yes i looked at the page in the link but i didnt find a notebook?? — user40510, May 25 '16 at 14:37
There's a tiny "Download Mathematica Notebook" link just below the title. — J. M.'s missing motivation, 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. — J. M.'s missing motivation, May 25 '16 at 17:17
I tried it, but nothing seems to work, when i change initial values the other values stay the same. Also Rsolve gives me just a nested function warning or says that the recursion limit is exceeded — user40510, May 26 '16 at 08:08

score 2 · Answer 1 · answered May 25 '16 at 11:48

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|>}

Thanks, but when i change the initial values it doesnt work?? — user40510, May 26 '16 at 08: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 — Squigglyteeth, May 27 '16 at 01:14

BlacKow · Answer 2 · 2016-05-25T17:15:10.950

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

How to define nested recursive sequence?

2 Answers2