102 lines
2.9 KiB
Text
102 lines
2.9 KiB
Text
# Multiplicative Digital Roots #
|
|
|
|
# structure to hold the results of calculating the digital root & persistence #
|
|
MODE DR = STRUCT( INT root, INT persistence );
|
|
|
|
# calculate the multiplicative digital root and persistence of a number #
|
|
PROC md root = ( INT number )DR:
|
|
BEGIN
|
|
|
|
# calculate the product of the digits of a number #
|
|
PROC digit product = ( INT number )INT:
|
|
BEGIN
|
|
|
|
INT result := 1;
|
|
INT rest := number;
|
|
|
|
WHILE
|
|
result TIMESAB ( rest MOD 10 );
|
|
rest OVERAB 10;
|
|
rest > 0
|
|
DO
|
|
SKIP
|
|
OD;
|
|
|
|
result
|
|
END; # digit product #
|
|
|
|
INT mp := 0;
|
|
INT mdr := ABS number;
|
|
|
|
WHILE mdr > 9
|
|
DO
|
|
mp +:= 1;
|
|
mdr := digit product( mdr )
|
|
OD;
|
|
|
|
( mdr, mp )
|
|
END; # md root #
|
|
|
|
# prints a number and its MDR and MP #
|
|
PROC print md root = ( INT number )VOID:
|
|
BEGIN
|
|
DR mdr = md root( number );
|
|
print( ( whole( number, -6 )
|
|
, ": MDR: ", whole( root OF mdr, 0 )
|
|
, ", MP: ", whole( persistence OF mdr, -2 )
|
|
, newline
|
|
)
|
|
)
|
|
END; # print md root #
|
|
|
|
# prints the first few numbers with each possible Multiplicative Digital #
|
|
# Root. The number of values to print is specified as a parameter #
|
|
PROC tabulate mdr = ( INT number of values )VOID:
|
|
BEGIN
|
|
|
|
[ 0 : 9, 1 : number of values ]INT mdr values;
|
|
[ 0 : 9 ]INT mdr counts;
|
|
mdr counts[ AT 1 ] := ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );
|
|
|
|
# find the first few numbers with each possible mdr #
|
|
|
|
INT values found := 0;
|
|
INT required values := 10 * number of values;
|
|
|
|
FOR value FROM 0 WHILE values found < required values
|
|
DO
|
|
DR mdr = md root( value );
|
|
IF mdr counts[ root OF mdr ] < number of values
|
|
THEN
|
|
# need more values with this multiplicative digital root #
|
|
values found +:= 1;
|
|
mdr counts[ root OF mdr ] +:= 1;
|
|
mdr values[ root OF mdr, mdr counts[ root OF mdr ] ] := value
|
|
FI
|
|
OD;
|
|
|
|
# print the values #
|
|
|
|
print( ( "MDR: [n0..n" + whole( number of values - 1, 0 ) + "]", newline ) );
|
|
print( ( "=== ========", newline ) );
|
|
FOR mdr pos FROM 1 LWB mdr values TO 1 UPB mdr values
|
|
DO
|
|
STRING separator := ": [";
|
|
print( ( whole( mdr pos, -3 ) ) );
|
|
FOR val pos FROM 2 LWB mdr values TO 2 UPB mdr values
|
|
DO
|
|
print( ( separator + whole( mdr values[ mdr pos, val pos ], 0 ) ) );
|
|
separator := ", "
|
|
OD;
|
|
print( ( "]", newline ) )
|
|
OD
|
|
|
|
END; # tabulate mdr #
|
|
|
|
main:(
|
|
print md root( 123321 );
|
|
print md root( 7739 );
|
|
print md root( 893 );
|
|
print md root( 899998 );
|
|
tabulate mdr( 5 )
|
|
)
|