RosettaCodeData/Task/Digital-root-Multiplicative-digital-root/Quackery/digital-root-multiplicative-digital-root.quackery
2023-07-01 13:44:08 -04:00

34 lines
763 B
Text

[ abs 1 swap
[ base share /mod
rot * swap
dup 0 = until ]
drop ] is digitproduct ( n --> n )
[ 0 swap
[ dup base share > while
dip 1+
digitproduct again ] ] is mdr ( n --> n n )
[ dup mdr
rot echo
say ": "
swap echo
say ", "
echo cr ] is task.1 ( n --> )
[ times
[ i^ [] swap dup rot
[ unrot dup mdr nip
swap dip
[ over = ]
swap iff
[ rot over join ]
else rot
dip 1+
dup size 5 = until ]
i^ echo say " : "
echo cr 2drop ] ] is task.2 ( n --> )
' [ 123321 7739 893 899998 ] witheach task.1
cr
10 task.2