1
$\begingroup$

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.

$\endgroup$
1
  • $\begingroup$ 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}] $\endgroup$ Feb 7, 2022 at 10:15

3 Answers 3

0
$\begingroup$

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} *)
$\endgroup$
2
$\begingroup$
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}
$\endgroup$
0
$\begingroup$

I got it!

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.