# Digits product and an iteration process

I would like to create a code which gives me the square of the product of the digits of a number, with the only rule that if a number has a 0, then it doesn't count in the product (for example, if the number is 230, then the answer is (2*3)^2=6^2=36). I tried in this way:

lst = ReplaceAll[0 -> 1][IntegerDigits[k]];
Table[Product[lst[[i]]^2, {i, 1, Length[lst]}], {k, 1, 100}]


but the result:

{1, 4, 9, 16, 25, 36, 49, 64, 81, 0, 1, 4, 9, 16, 25, 36, 49, 64, 81, 0, ...


has zeros inside! (For example, if the number is 30 the output should be 3^2=9 Also I would like to iterate the process.. for example , if I consider 25, then i should get (2*5)^2=100 and then i should get 1^2=1. I would like to understand when a number after some iterations arrives to 1 (for example, 25 does, every power of 10 does, but for example the number 2 after some iterations will got stack in a loop). Thank you for your help.

• Okay I think I solve the first part, now I would like to know how can i iterate this process. The code shoud be Table[Product[ ReplaceAll[0 -> 1][IntegerDigits[k]][[i]]^2, {i, 1, Length[ReplaceAll[0 -> 1][IntegerDigits[k]]]}], {k, 1, 100}] Commented Feb 7, 2022 at 10:15

You are nearly there. Replacement is a pretty good idea. However you may implement it a bit less clumsy by defining a function and map it to all elements of the input. E.g.:

inp = Table[i, {i, 100}];
(Times @@ (IntegerDigits[#] /. 0 -> 1)) & /@ inp

(* {1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 1, 2, 3, 4, 5, 6, 7, 8, 9, 2, 2, 4, 6,
8, 10, 12, 14, 16, 18, 3, 3, 6, 9, 12, 15, 18, 21, 24, 27, 4, 4, 8, \
12, 16, 20, 24, 28, 32, 36, 5, 5, 10, 15, 20, 25, 30, 35, 40, 45, 6, \
6, 12, 18, 24, 30, 36, 42, 48, 54, 7, 7, 14, 21, 28, 35, 42, 49, 56, \
63, 8, 8, 16, 24, 32, 40, 48, 56, 64, 72, 9, 9, 18, 27, 36, 45, 54, \
63, 72, 81, 1} *)

ClearAll[f0, numbersInRangeMthatReach1WithinKiterations];

f0 = Times @@@ (IntegerDigits[#] /. 0 -> 1)^2 &;

numbersInRangeMthatReach1WithinKiterations[m_, k_] := Flatten @
Position[Nest[f0, Range[m], k], 1]

numbersInRangeMthatReach1WithinKiterations[1000, 10]

{1, 5, 10, 11, 15, 25, 50, 51, 52, 100, 101, 105, 110, 111, 115, 125,
150, 151, 152, 205, 215, 250, 251, 255, 357, 375, 455, 500, 501, 502,
510, 511, 512, 520, 521, 525, 537, 545, 552, 554, 573, 735, 753, 1000}


I got it!

Select[Range[1000], FixedPoint[
Product[ReplaceAll[0 -> 1][IntegerDigits[#]][[i]]^2, {i, 1,
Length[ReplaceAll[0 -> 1][IntegerDigits[#]]]}] &, #, 10] == 1 &]