How to define nested recursive sequence? [duplicate]

Question

This question already has an answer here:

• Fibonacci Sequence Generator 10 answers

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.

Answer 1

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

Answer 2

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