# Solving problem using recursive functions

Attached below is a question posed by the Canadian Mathematical Society, and I have my code and answer. Is there a better way of writing the code, and will the answer be different as a result?

My code and possible answer (edited):

jk[0] = 0;
jk[1] = 0;
jk[2] = 1;
jk[3] = 2;
tr[n_] := If[n > 3,
LengthWhile[Range[3, 20], Divisible[n, #1] & ] + 3, jk[n]]
Sum[tr[tr[tr[m]]], {m, 1, 2006}]

(* 2672 *)


Let me know if you get an answer that differs.

You made a few mistakes. jk[0] should be 0 in your code and your function tr is wrong.

Corrected version:

t[0] = 0;
t[1] = 0;
t[2] = 1;
t[n_] := t[n] = LengthWhile[Range[1, 11], Divisible[n, #1] &] + 1
Sum[Nest[t, m, 3], {m, 1, 2006}]


1171

10x faster version:

t[n_] := t[n] = Module[{i = 1}, While[MemberQ[Divisors[n], i], i++]; i];

• Excellent! Thanks. Commented Nov 1, 2015 at 2:23
• I'm not sure your summing is done properly -- compare Total[t[#] & /@ Range[2006]] which sums up all the t[i] value from 1 to 2006. The total is 5584 Commented Nov 1, 2015 at 2:54
• @paw -- thanks for the explanation. I'll erase my erroneous comment in a few minutes... Commented Nov 1, 2015 at 2:58
f[0] := 0
f[1] := 0
f[2] := 1
f[x_] := Module[{j = 1}, While[Mod[x, j] == 0, j++]; j];
bt[x_] := Nest[f, x, 3]
Total[bt /@ Range[2006]]


yields 1171

• Just as good. Thks Commented Nov 1, 2015 at 9:34