RosettaCodeData/Task/Digital-root-Multiplicative.../Mathematica/digital-root-multiplicative...

10 lines
507 B
Plaintext

ClearAll[mdr, mp, nums];
mdr[n_] := NestWhile[Times @@ IntegerDigits[#] &, n, # > 9 &];
mp[n_] := Length@NestWhileList[Times @@ IntegerDigits[#] &, n, # > 9 &] - 1;
TableForm[{#, mdr[#], mp[#]} & /@ {123321, 7739, 893, 899998},
TableHeadings -> {None, {"Number", "MDR", "MP"}}]
nums = ConstantArray[{}, 10];
For[i = 0, Min[Length /@ nums] < 5, i++, AppendTo[nums[[mdr[i] + 1]], i]];
TableForm[Table[{i, Take[nums[[i + 1]], 5]}, {i, 0, 9}],
TableHeadings -> {None, {"MDR", "First 5"}}, TableDepth -> 2]