Initial data commit

This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions

View file

@ -0,0 +1,3 @@
---
from: http://rosettacode.org/wiki/Digital_root/Multiplicative_digital_root
note: Mathematics

View file

@ -0,0 +1,39 @@
The [[wp:Multiplicative digital root|multiplicative digital root]] (MDR) and multiplicative persistence (MP) of a number, <math>n</math>, is calculated rather like the [[Digital root]] except digits are multiplied instead of being added:
# Set <math>m</math> to <math>n</math> and <math>i</math> to <math>0</math>.
# While <math>m</math> has more than one digit:
#* Find a replacement <math>m</math> as the multiplication of the digits of the current value of <math>m</math>.
#* Increment <math>i</math>.
# Return <math>i</math> (= MP) and <math>m</math> (= MDR)
;Task:
* Tabulate the MP and MDR of the numbers 123321, 7739, 893, 899998
* Tabulate MDR versus the first five numbers having that MDR, something like:
<pre>
MDR: [n0..n4]
=== ========
0: [0, 10, 20, 25, 30]
1: [1, 11, 111, 1111, 11111]
2: [2, 12, 21, 26, 34]
3: [3, 13, 31, 113, 131]
4: [4, 14, 22, 27, 39]
5: [5, 15, 35, 51, 53]
6: [6, 16, 23, 28, 32]
7: [7, 17, 71, 117, 171]
8: [8, 18, 24, 29, 36]
9: [9, 19, 33, 91, 119]
</pre>
Show all output on this page.
;Similar:
The Product of decimal digits of n page was redirected here, and had the following description<br>
Find the product of the decimal digits of a positive integer &nbsp; '''n''', &nbsp; where '''n <= 100'''
The three existing entries for Phix, REXX, and Ring have been moved here, under <nowiki>===Similar===</nowiki> headings, feel free to match or ignore them.
;References:
* [http://mathworld.wolfram.com/MultiplicativeDigitalRoot.html Multiplicative Digital Root] on Wolfram Mathworld.
* [http://oeis.org/A031347 Multiplicative digital root] on The On-Line Encyclopedia of Integer Sequences.
* [https://www.youtube.com/watch?v=Wim9WJeDTHQ What's special about 277777788888899?] - Numberphile video
<br><br>

View file

@ -0,0 +1,32 @@
F mdroot(n)
V count = 0
V mdr = n
L mdr > 9
V m = mdr
V digits_mul = 1
L m != 0
digits_mul *= m % 10
m = m I/ 10
mdr = digits_mul
count++
R (count, mdr)
print(Number: (MP, MDR))
print(====== =========)
L(n) (123321, 7739, 893, 899998)
print(#6: .format(n), end' )
print(mdroot(n))
[[Int]] table
table.resize(10)
V n = 0
L min(table.map(row -> row.len)) < 5
table[mdroot(n)[1]].append(n)
n++
print()
print(MP: [n0..n4])
print(== ========)
L(val) table
print(#2: .format(L.index), end' )
print(val[0.<5])

View file

@ -0,0 +1,70 @@
BEGIN # Multiplicative Digital Roots #
# structure to hold the results of calculating the digital root & persistence #
MODE DR = STRUCT( INT root, INT persistence );
# returns the product of the digits of number #
OP DIGITPRODUCT = ( 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; # DIGITPRODUCT #
# calculates the multiplicative digital root and persistence of number #
OP MDROOT = ( INT number )DR:
BEGIN
INT mp := 0;
INT mdr := ABS number;
WHILE mdr > 9 DO
mp +:= 1;
mdr := DIGITPRODUCT mdr
OD;
( mdr, mp )
END; # MDROOT #
# prints a number and its MDR and MP #
PROC print md root = ( INT number )VOID:
BEGIN
DR mdr = MDROOT( 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 = MDROOT 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 #
# task test cases #
print md root( 123321 );
print md root( 7739 );
print md root( 893 );
print md root( 899998 );
tabulate mdr( 5 )
END

View file

@ -0,0 +1,66 @@
begin
% calculate the Multiplicative Digital Root (mdr) and Multiplicative Persistence (mp) of n %
procedure getMDR ( integer value n
; integer result mdr, mp
) ;
begin
mp := 0;
mdr := abs n;
while mdr > 9 do begin
integer v;
v := mdr;
mdr := 1;
while begin
mdr := mdr * ( v rem 10 );
v := v div 10;
v > 0
end do begin end;
mp := mp + 1;
end while_mdr_gt_9 ;
end getMDR ;
% task test cases %
write( " N MDR MP" );
for n := 123321, 7739, 893, 899998 do begin
integer mdr, mp;
getMDR( n, mdr, mp );
write( s_w := 1, i_w := 8, n, i_w := 3, mdr, i_w := 2, mp )
end for_n ;
begin % find the first 5 numbers with each possible MDR %
integer requiredMdrs;
requiredMdrs := 5;
begin
integer array firstFew ( 0 :: 9, 1 :: requiredMdrs );
integer array mdrFOund ( 0 :: 9 );
integer totalFound, requiredTotal, n;
for i := 0 until 9 do mdrFound( i ) := 0;
totalFound := 0;
requiredTotal := 10 * requiredMdrs;
n := -1;
while totalFound < requiredTotal do begin
integer mdr, mp;
n := n + 1;
getMDR( n, mdr, mp );
if mdrFound( mdr ) < requiredMdrs then begin
% found another number with this MDR and haven't found enough yet %
totalFound := totalFound + 1;
mdrFound( mdr ) := mdrFound( mdr ) + 1;
firstFew( mdr, mdrFound( mdr ) ) := n
end if_found_another_MDR
end while_totalFound_lt_requiredTotal ;
% print the table of MDRs andnumbers %
write( "MDR: [n0..n4]" );
write( "=== ========" );
for v := 0 until 9 do begin
write( i_w := 3, s_w := 0, v, ": [" );
for foundPos := 1 until requiredMdrs do begin
if foundPos > 1 then writeon( s_w := 0, ", " );
writeon( i_w := 1, s_w := 0, firstFew( v, foundPos ) )
end for_foundPos ;
writeon( s_w := 0, "]" )
end for_v
end
end
end.

View file

@ -0,0 +1,76 @@
# Multiplicative Digital Roots
BEGIN {
printMdrAndMp( 123321 );
printMdrAndMp( 7739 );
printMdrAndMp( 893 );
printMdrAndMp( 899998 );
tabulateMdr( 5 );
} # BEGIN
function printMdrAndMp( n )
{
calculateMdrAndMp( n );
printf( "%6d: MDR: %d, MP: %2d\n", n, MDR, MP );
} # printMdrAndMp
function calculateMdrAndMp( n, mdrStr, digit )
{
MP = 0; # global Multiplicative Persistence
MDR = ( n < 0 ? -n : n ); # global Multiplicative Digital Root
while( MDR > 9 )
{
MP ++;
mdrStr = "" MDR;
MDR = 1;
for( digit = 1; digit <= length( mdrStr ); digit ++ )
{
MDR *= ( substr( mdrStr, digit, 1 ) * 1 );
} # for digit
} # while MDR > 9
} # calculateMdrAndMp
function tabulateMdr( n, rqdValues, valueCount, value, pos )
{
# generate a table of the first n numbers with each possible MDR
rqdValues = n * 10;
valueCount = 0;
for( value = 0; valueCount < rqdValues; value ++ )
{
calculateMdrAndMp( value );
if( mdrCount[ MDR ] < n )
{
# still need another value with this MDR
valueCount ++;
mdrCount[ MDR ] ++;
mdrValues[ MDR ":" mdrCount[ MDR ] ] = value;
} # if mdrCount[ MDR ] < n
} # for value
# print the table
printf( "MDR: [n0..n%d]\n", n - 1 );
printf( "=== ========\n" );
for( pos = 0; pos < 10; pos ++ )
{
printf( "%3d:", pos );
separator = " [";
for( value = 1; value <= n; value ++ )
{
printf( "%s%d", separator, mdrValues[ pos ":" value ] );
separator = ", "
} # for value
printf( "]\n" );
} # for pos
} # tabulateMdr

View file

@ -0,0 +1,47 @@
with Ada.Text_IO, Generic_Root; use Generic_Root;
procedure Multiplicative_Root is
procedure Compute is new Compute_Root("*"); -- "*" for multiplicative roots
package TIO renames Ada.Text_IO;
package NIO is new TIO.Integer_IO(Number);
procedure Print_Numbers(Target_Root: Number; How_Many: Natural) is
Current: Number := 0;
Root, Pers: Number;
begin
for I in 1 .. How_Many loop
loop
Compute(Current, Root, Pers);
exit when Root = Target_Root;
Current := Current + 1;
end loop;
NIO.Put(Current, Width => 6);
if I < How_Many then
TIO.Put(",");
end if;
Current := Current + 1;
end loop;
end Print_Numbers;
Inputs: Number_Array := (123321, 7739, 893, 899998);
Root, Pers: Number;
begin
TIO.Put_Line(" Number MDR MP");
for I in Inputs'Range loop
Compute(Inputs(I), Root, Pers);
NIO.Put(Inputs(I), Width => 8);
NIO.Put(Root, Width => 6);
NIO.Put(Pers, Width => 6);
TIO.New_Line;
end loop;
TIO.New_Line;
TIO.Put_Line(" MDR first_five_numbers_with_that_MDR");
for I in 0 .. 9 loop
TIO.Put(" " & Integer'Image(I) & " ");
Print_Numbers(Target_Root => Number(I), How_Many => 5);
TIO.New_Line;
end loop;
end Multiplicative_Root;

View file

@ -0,0 +1,46 @@
(
& ( MP/MDR
= prod L n
. ( prod
= d
. @(!arg:%@?d ?arg)&!d*prod$!arg
| 1
)
& !arg:?L
& whl
' ( @(!arg:? [>1)
& (prod$!arg:?arg) !L:?L
)
& !L:? [?n
& (!n+-1.!arg)
)
& ( test
= n
. !arg:%?n ?arg
& out$(!n "\t:" MP/MDR$!n)
& test$!arg
|
)
& test$(123321 7739 893 899998)
& 0:?i
& 1:?collecting:?done
& whl
' ( !i+1:?i
& MP/MDR$!i:(?MP.?MDR)
& ( !done:?*(!MDR.)^((?.)+?)*?
| (!MDR.)^(!i.)*!collecting:?collecting
& ( !collecting:?A*(!MDR.)^(?is+[5)*?Z
& !A*!Z:?collecting
& (!MDR.)^!is*!done:?done
|
)
)
& !collecting:~1
)
& whl
' ( !done:(?MDR.)^?is*?done
& put$(!MDR ":")
& whl'(!is:(?i.)+?is&put$(!i " "))
& put$\n
)
);

View file

@ -0,0 +1,59 @@
#include <iomanip>
#include <map>
#include <vector>
#include <iostream>
using namespace std;
void calcMDR( int n, int c, int& a, int& b )
{
int m = n % 10; n /= 10;
while( n )
{
m *= ( n % 10 );
n /= 10;
}
if( m >= 10 ) calcMDR( m, ++c, a, b );
else { a = m; b = c; }
}
void table()
{
map<int, vector<int> > mp;
int n = 0, a, b;
bool f = true;
while( f )
{
f = false;
calcMDR( n, 1, a, b );
mp[a].push_back( n );
n++;
for( int x = 0; x < 10; x++ )
if( mp[x].size() < 5 )
{ f = true; break; }
}
cout << "| MDR | [n0..n4]\n+-------+------------------------------------+\n";
for( int x = 0; x < 10; x++ )
{
cout << right << "| " << setw( 6 ) << x << "| ";
for( vector<int>::iterator i = mp[x].begin(); i != mp[x].begin() + 5; i++ )
cout << setw( 6 ) << *i << " ";
cout << "|\n";
}
cout << "+-------+------------------------------------+\n\n";
}
int main( int argc, char* argv[] )
{
cout << "| NUMBER | MDR | MP |\n+----------+----------+----------+\n";
int numbers[] = { 123321, 7739, 893, 899998 }, a, b;
for( int x = 0; x < 4; x++ )
{
cout << right << "| " << setw( 9 ) << numbers[x] << "| ";
calcMDR( numbers[x], 1, a, b );
cout << setw( 9 ) << a << "| " << setw( 9 ) << b << "|\n";
}
cout << "+----------+----------+----------+\n\n";
table();
return system( "pause" );
}

View file

@ -0,0 +1,39 @@
using System;
using System.Collections.Generic;
using System.Linq;
class Program
{
static Tuple<int, int> DigitalRoot(long num)
{
int mp = 0;
while (num > 9)
{
num = num.ToString().ToCharArray().Select(x => x - '0').Aggregate((a, b) => a * b);
mp++;
}
return new Tuple<int, int>(mp, (int)num);
}
static void Main(string[] args)
{
foreach (long num in new long[] { 123321, 7739, 893, 899998 })
{
var t = DigitalRoot(num);
Console.WriteLine("{0} has multiplicative persistence {1} and multiplicative digital root {2}", num, t.Item1, t.Item2);
}
const int twidth = 5;
List<long>[] table = new List<long>[10];
for (int i = 0; i < 10; i++)
table[i] = new List<long>();
long number = -1;
while (table.Any(x => x.Count < twidth))
{
var t = DigitalRoot(++number);
if (table[t.Item2].Count < twidth)
table[t.Item2].Add(number);
}
for (int i = 0; i < 10; i++)
Console.WriteLine(" {0} : [{1}]", i, string.Join(", ", table[i]));
}
}

View file

@ -0,0 +1,58 @@
#include <stdio.h>
#define twidth 5
#define mdr(rmdr, rmp, n)\
do { *rmp = 0; _mdr(rmdr, rmp, n); } while (0)
void _mdr(int *rmdr, int *rmp, long long n)
{
/* Adjust r if 0 case, so we don't return 1 */
int r = n ? 1 : 0;
while (n) {
r *= (n % 10);
n /= 10;
}
(*rmp)++;
if (r >= 10)
_mdr(rmdr, rmp, r);
else
*rmdr = r;
}
int main(void)
{
int i, j, vmdr, vmp;
const int values[] = { 123321, 7739, 893, 899998 };
const int vsize = sizeof(values) / sizeof(values[0]);
/* Initial test values */
printf("Number MDR MP\n");
for (i = 0; i < vsize; ++i) {
mdr(&vmdr, &vmp, values[i]);
printf("%6d %3d %3d\n", values[i], vmdr, vmp);
}
/* Determine table values */
int table[10][twidth] = { 0 };
int tfill[10] = { 0 };
int total = 0;
for (i = 0; total < 10 * twidth; ++i) {
mdr(&vmdr, &vmp, i);
if (tfill[vmdr] < twidth) {
table[vmdr][tfill[vmdr]++] = i;
total++;
}
}
/* Print calculated table values */
printf("\nMDR: [n0..n4]\n");
for (i = 0; i < 10; ++i) {
printf("%3d: [", i);
for (j = 0; j < twidth; ++j)
printf("%d%s", table[i][j], j != twidth - 1 ? ", " : "");
printf("]\n");
}
return 0;
}

View file

@ -0,0 +1,59 @@
digits = iter (n: int) yields (int)
while n>0 do
yield(n//10)
n := n/10
end
end digits
mdr = proc (n: int) returns (int,int)
i: int := 0
while n>=10 do
m: int := 1
for d: int in digits(n) do
m := m * d
end
n := m
i := i+1
end
return (i,n)
end mdr
first_mdr = iter (target_mdr, n: int) yields (int)
i: int := 0
while n>0 do
x, m: int := mdr(i)
if m=target_mdr then
yield(i)
n := n -1
end
i := i+1
end
end first_mdr
start_up = proc ()
po: stream := stream$primary_output()
nums: sequence[int] := sequence[int]$[123321, 7739, 893, 899998]
stream$putl(po, " N MDR MP")
stream$putl(po, "====== === ==")
for num: int in sequence[int]$elements(nums) do
stream$putright(po, int$unparse(num), 6)
stream$puts(po, " ")
i, m: int := mdr(num)
stream$putright(po, int$unparse(m), 3)
stream$puts(po, " ")
stream$putright(po, int$unparse(i), 3)
stream$putl(po, "")
end
stream$putl(po, "\nMDR: [n0..n4]")
stream$putl(po, "=== ========")
for dgt: int in int$from_to(0,9) do
stream$putright(po, int$unparse(dgt), 3)
stream$puts(po, ": ")
for num: int in first_mdr(dgt, 5) do
stream$puts(po, int$unparse(num) || " ")
end
stream$putl(po, "")
end
end start_up

View file

@ -0,0 +1,25 @@
(defun mdr/p (n)
"Return a list with MDR and MP of n"
(if (< n 10)
(list n 0)
(mdr/p-aux n 1 1)))
(defun mdr/p-aux (n a c)
(cond ((and (zerop n) (< a 10)) (list a c))
((zerop n) (mdr/p-aux a 1 (+ c 1)))
(t (mdr/p-aux (floor n 10) (* (rem n 10) a) c))))
(defun first-n-number-for-each-root (n &optional (r 0) (lst nil) (c 0))
"Return the first m number with MDR = 0 to 9"
(cond ((and (= (length lst) n) (= r 9)) (format t "~3@a: ~a~%" r (reverse lst)))
((= (length lst) n) (format t "~3@a: ~a~%" r (reverse lst))
(first-n-number-for-each-root n (+ r 1) nil 0))
((= (first (mdr/p c)) r) (first-n-number-for-each-root n r (cons c lst) (+ c 1)))
(t (first-n-number-for-each-root n r lst (+ c 1)))))
(defun start ()
(format t "Number: MDR MD~%")
(loop for el in '(123321 7739 893 899998)
do (format t "~6@a: ~{~3@a ~}~%" el (mdr/p el)))
(format t "~%MDR: [n0..n4]~%")
(first-n-number-for-each-root 5))

View file

@ -0,0 +1,69 @@
MODULE MDR;
IMPORT StdLog, Strings, TextMappers, DevCommanders;
PROCEDURE CalcMDR(x: LONGINT; OUT mdr, mp: LONGINT);
VAR
str: ARRAY 64 OF CHAR;
i: INTEGER;
BEGIN
mdr := 1; mp := 0;
LOOP
Strings.IntToString(x,str);
IF LEN(str$) = 1 THEN mdr := x; EXIT END;
i := 0;mdr := 1;
WHILE i < LEN(str$) DO
mdr := mdr * (ORD(str[i]) - ORD('0'));
INC(i)
END;
INC(mp);
x := mdr
END
END CalcMDR;
PROCEDURE Do*;
VAR
mdr,mp: LONGINT;
s: TextMappers.Scanner;
BEGIN
s.ConnectTo(DevCommanders.par.text);
s.SetPos(DevCommanders.par.beg);
REPEAT
s.Scan;
IF (s.type = TextMappers.int) OR (s.type = TextMappers.lint) THEN
CalcMDR(s.int,mdr,mp);
StdLog.Int(s.int);
StdLog.String(" MDR: ");StdLog.Int(mdr);
StdLog.String(" MP: ");StdLog.Int(mp);StdLog.Ln
END
UNTIL s.rider.eot;
END Do;
PROCEDURE Show(i: INTEGER; x: ARRAY OF LONGINT);
VAR
k: INTEGER;
BEGIN
StdLog.Int(i);StdLog.String(": ");
FOR k := 0 TO LEN(x) - 1 DO
StdLog.Int(x[k])
END;
StdLog.Ln
END Show;
PROCEDURE FirstFive*;
VAR
i,j: INTEGER;
five: ARRAY 5 OF LONGINT;
x,mdr,mp: LONGINT;
BEGIN
FOR i := 0 TO 9 DO
j := 0;x := 0;
WHILE (j < LEN(five)) DO
CalcMDR(x,mdr,mp);
IF mdr = i THEN five[j] := x; INC(j) END;
INC(x)
END;
Show(i,five)
END
END FirstFive;
END MDR.

View file

@ -0,0 +1,27 @@
import std.stdio, std.algorithm, std.typecons, std.range, std.conv;
/// Multiplicative digital root.
auto mdRoot(in int n) pure /*nothrow*/ {
auto mdr = [n];
while (mdr.back > 9)
mdr ~= reduce!q{a * b}(1, mdr.back.text.map!(d => d - '0'));
//mdr ~= mdr.back.text.map!(d => d - '0').mul;
//mdr ~= mdr.back.reverseDigits.mul;
return tuple(mdr.length - 1, mdr.back);
}
void main() {
"Number: (MP, MDR)\n====== =========".writeln;
foreach (immutable n; [123321, 7739, 893, 899998])
writefln("%6d: (%s, %s)", n, n.mdRoot[]);
auto table = (int[]).init.repeat.enumerate!int.take(10).assocArray;
auto n = 0;
while (table.byValue.map!walkLength.reduce!min < 5) {
table[n.mdRoot[1]] ~= n;
n++;
}
"\nMP: [n0..n4]\n== ========".writeln;
foreach (const mp; table.byKey.array.sort())
writefln("%2d: %s", mp, table[mp].take(5));
}

View file

@ -0,0 +1,34 @@
import std.stdio, std.algorithm, std.typecons, std.range;
uint digitsProduct(uint n) pure nothrow @nogc {
typeof(return) result = !!n;
while (n) {
result *= n % 10;
n /= 10;
}
return result;
}
/// Multiplicative digital root.
Tuple!(size_t, uint) mdRoot(uint m) pure nothrow {
auto mdr = m
.recurrence!((a, n) => a[n - 1].digitsProduct)
.until!q{ a <= 9 }(OpenRight.no).array;
return tuple(mdr.length - 1, mdr.back);
}
void main() {
"Number: (MP, MDR)\n====== =========".writeln;
foreach (immutable n; [123321, 7739, 893, 899998])
writefln("%6d: (%s, %s)", n, n.mdRoot[]);
auto table = (int[]).init.repeat.enumerate!int.take(10).assocArray;
auto n = 0;
while (table.byValue.map!walkLength.reduce!min < 5) {
table[n.mdRoot[1]] ~= n;
n++;
}
"\nMP: [n0..n4]\n== ========".writeln;
foreach (const mp; table.byKey.array.sort())
writefln("%2d: %s", mp, table[mp].take(5));
}

View file

@ -0,0 +1,36 @@
import std.stdio, std.algorithm, std.range;
/// Multiplicative digital root.
uint[2] mdRoot(in uint n) pure nothrow @nogc {
uint mdr = n;
uint count = 0;
while (mdr > 9) {
uint m = mdr;
uint digitsMul = !!m;
while (m) {
digitsMul *= m % 10;
m /= 10;
}
mdr = digitsMul;
count++;
}
return [count, mdr];
}
void main() {
"Number: [MP, MDR]\n====== =========".writeln;
foreach (immutable n; [123321, 7739, 893, 899998])
writefln("%6d: %s", n, n.mdRoot);
auto table = (int[]).init.repeat.enumerate!int.take(10).assocArray;
auto n = 0;
while (table.byValue.map!walkLength.reduce!min < 5) {
table[n.mdRoot[1]] ~= n;
n++;
}
"\nMP: [n0..n4]\n== ========".writeln;
foreach (const mp; table.byKey.array.sort())
writefln("%2d: %s", mp, table[mp].take(5));
}

View file

@ -0,0 +1,37 @@
defmodule Digital do
def mdroot(n), do: mdroot(n, 0)
defp mdroot(n, persist) when n < 10, do: {n, persist}
defp mdroot(n, persist), do: mdroot(product(n, 1), persist+1)
defp product(0, prod), do: prod
defp product(n, prod), do: product(div(n, 10), prod*rem(n, 10))
def task1(data) do
IO.puts "Number: MDR MP\n====== === =="
Enum.each(data, fn n ->
{mdr, persist} = mdroot(n)
:io.format "~6w: ~w ~2w~n", [n, mdr, persist]
end)
end
def task2(m \\ 5) do
IO.puts "\nMDR: [n0..n#{m-1}]\n=== ========"
map = add_map(0, m, Map.new)
Enum.each(0..9, fn i ->
first = map[i] |> Enum.reverse |> Enum.take(m)
IO.puts " #{i}: #{inspect first}"
end)
end
defp add_map(n, m, map) do
{mdr, _persist} = mdroot(n)
new_map = Map.update(map, mdr, [n], fn vals -> [n | vals] end)
min_len = Map.values(new_map) |> Enum.map(&length(&1)) |> Enum.min
if min_len < m, do: add_map(n+1, m, new_map),
else: new_map
end
end
Digital.task1([123321, 7739, 893, 899998])
Digital.task2

View file

@ -0,0 +1,6 @@
// mdr. Nigel Galloway: June 29th., 2021
let rec fG n g=if n=0 then g else fG(n/10)(g*(n%10))
let mdr n=let rec mdr n g=if n<10 then (n,g) else mdr(fG n 1)(g+1) in mdr n 0
[123321; 7739; 893; 899998] |> List.iter(fun i->let n,g=mdr i in printfn "%d has mdr=%d with persitance %d" i n g)
let fN g=Seq.initInfinite id|>Seq.filter((mdr>>fst>>(=)g))|>Seq.take 5
seq{0..9}|>Seq.iter(fun n->printf "First 5 numbers with mdr %d -> " n; Seq.initInfinite id|>Seq.filter((mdr>>fst>>(=)n))|>Seq.take 5|>Seq.iter(printf "%d ");printfn "")

View file

@ -0,0 +1,31 @@
USING: arrays formatting fry io kernel lists lists.lazy math
math.text.utils prettyprint sequences ;
IN: rosetta-code.multiplicative-digital-root
: mdr ( n -- {persistence,root} )
0 swap
[ 1 digit-groups dup length 1 > ] [ product [ 1 + ] dip ] while
dup empty? [ drop { 0 } ] when first 2array ;
: print-mdr ( n -- )
dup [ 1array ] dip mdr append
"%-12d has multiplicative persistence %d and MDR %d.\n"
vprintf ;
: first5 ( n -- seq ) ! first 5 numbers with MDR of n
0 lfrom swap '[ mdr second _ = ] lfilter 5 swap ltake list>array ;
: print-first5 ( i n -- )
"%-5d" printf bl first5 [ "%-5d " printf ] each nl ;
: header ( -- )
"MDR | First five numbers with that MDR" print
"--------------------------------------" print ;
: first5-table ( -- )
header 10 iota [ print-first5 ] each-index ;
: main ( -- )
{ 123321 7739 893 899998 } [ print-mdr ] each nl first5-table ;
MAIN: main

View file

@ -0,0 +1,90 @@
!Implemented by Anant Dixit (Oct, 2014)
program mdr
implicit none
integer :: i, mdr, mp, n, j
character(len=*), parameter :: hfmt = '(A18)', nfmt = '(I6)'
character(len=*), parameter :: cfmt = '(A3)', rfmt = '(I3)', ffmt = '(I9)'
write(*,hfmt) 'Number MDR MP '
write(*,*) '------------------'
i = 123321
call root_pers(i,mdr,mp)
write(*,nfmt,advance='no') i
write(*,cfmt,advance='no') ' '
write(*,rfmt,advance='no') mdr
write(*,cfmt,advance='no') ' '
write(*,rfmt) mp
i = 3939
call root_pers(i,mdr,mp)
write(*,nfmt,advance='no') i
write(*,cfmt,advance='no') ' '
write(*,rfmt,advance='no') mdr
write(*,cfmt,advance='no') ' '
write(*,rfmt) mp
i = 8822
call root_pers(i,mdr,mp)
write(*,nfmt,advance='no') i
write(*,cfmt,advance='no') ' '
write(*,rfmt,advance='no') mdr
write(*,cfmt,advance='no') ' '
write(*,rfmt) mp
i = 39398
call root_pers(i,mdr,mp)
write(*,nfmt,advance='no') i
write(*,cfmt,advance='no') ' '
write(*,rfmt,advance='no') mdr
write(*,cfmt,advance='no') ' '
write(*,rfmt) mp
write(*,*)
write(*,*)
write(*,*) 'First five numbers with MDR in first column: '
write(*,*) '---------------------------------------------'
do i = 0,9
n = 0
j = 0
write(*,rfmt,advance='no') i
do
call root_pers(j,mdr,mp)
if(mdr.eq.i) then
n = n+1
if(n.eq.5) then
write(*,ffmt) j
exit
else
write(*,ffmt,advance='no') j
end if
end if
j = j+1
end do
end do
end program
subroutine root_pers(i,mdr,mp)
implicit none
integer :: N, s, a, i, mdr, mp
n = i
a = 0
if(n.lt.10) then
mdr = n
mp = 0
return
end if
do while(n.ge.10)
a = a + 1
s = 1
do while(n.gt.0)
s = s * mod(n,10)
n = int(real(n)/10.0D0)
end do
n = s
end do
mdr = s
mp = a
end subroutine

View file

@ -0,0 +1,127 @@
program MultRoot;
{$IFDEF FPC}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=16}
{$ENDIF}
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils;
type
tMul3Dgt = array[0..999] of Uint32;
tMulRoot = record
mrNum,
mrMul,
mrPers : Uint64;
end;
const
Testnumbers : array[0..16] of Uint64 =(123321,7739,893,899998,
18446743999999999999,
//first occurence of persistence 0..11
0,10,25,39,77,679, 6788, 68889, 2677889,
26888999, 3778888999, 277777788888899);
var
Mul3Dgt : tMul3Dgt;
procedure InitMulDgt;
var
i,j,k,l : Int32;
begin
l := 999;
For i := 9 downto 0 do
For j := 9 downto 0 do
For k := 9 downto 0 do
Begin
Mul3Dgt[l] := i*j*k;
dec(l);
end;
end;
function GetMulDigits(n:Uint64):UInt64;inline;
var
pMul3Dgt :^tMul3Dgt;
q :Uint64;
begin
pMul3Dgt := @Mul3Dgt[0];
result := 1;
while n >= 1000 do
begin
q := n div 1000;
result *= pMul3Dgt^[n-1000*q];
n := q;
end;
If n>=100 then
result *= pMul3Dgt^[n]
else
if n>=10 then
result *= pMul3Dgt^[n+100]
else
result *= n;//Mul3Dgt[n+110]
end;
procedure GetMulRoot(var MulRoot:tMulRoot);
var
mr,
pers : UInt64;
Begin
pers := 0;
mr := MulRoot.mrNum;
while mr >=10 do
Begin
mr := GetMulDigits(mr);
inc(pers);
end;
MulRoot.mrMul:= mr;
MulRoot.mrPers:= pers;
end;
const
MaxDgtCount = 9;
var
//all initiated with 0
MulRoot:tMulRoot;
Sol : array[0..9,0..MaxDgtCount-1] of tMulRoot;
SolIds : array[0..9] of Int32;
i,idx,mr,AlreadyDone : Int32;
BEGIN
InitMulDgt;
AlreadyDone := 10;//0..9
MulRoot.mrNum := 0;
repeat
GetMulRoot(MulRoot);
mr := MulRoot.mrMul;
idx := SolIds[mr];
If idx<MaxDgtCount then
begin
Sol[mr,idx]:= MulRoot;
inc(idx);
SolIds[mr]:= idx;
if idx =MaxDgtCount then
dec(AlreadyDone);
end;
inc(MulRoot.mrNum);
until AlreadyDone = 0;
writeln('MDR: First');
For i := 0 to 9 do
begin
write(i:3,':');
For idx := 0 to MaxDgtCount-1 do
write(Sol[i,idx].mrNum:MaxDgtCount+1);
writeln;
end;
writeln;
writeln('number':20,' mulroot persitance');
For i := 0 to High(Testnumbers) do
begin
MulRoot.mrNum := Testnumbers[i];
GetMulRoot(MulRoot);
With MulRoot do
writeln(mrNum:20,mrMul:8,mrPers:8);
end;
{$IFDEF WINDOWS}
readln;
{$ENDIF}
END.

View file

@ -0,0 +1,52 @@
' FB 1.05.0 Win64
Function multDigitalRoot(n As UInteger, ByRef mp As Integer, base_ As Integer = 10) As Integer
Dim mdr As Integer
mp = 0
Do
mdr = IIf(n > 0, 1, 0)
While n > 0
mdr *= n Mod base_
n = n \ base_
Wend
mp += 1
n = mdr
Loop until mdr < base_
Return mdr
End Function
Dim As Integer mdr, mp
Dim a(3) As UInteger = {123321, 7739, 893, 899998}
For i As UInteger = 0 To 3
mp = 0
mdr = multDigitalRoot(a(i), mp)
Print a(i); Tab(10); "MDR ="; mdr; Tab(20); "MP ="; mp
Print
Next
Print
Print "MDR 1 2 3 4 5"
Print "=== ==========================="
Print
Dim num(0 To 9, 0 To 5) As UInteger '' all zero by default
Dim As UInteger n = 0, count = 0
Do
mdr = multDigitalRoot(n, mp)
If num(mdr, 0) < 5 Then
num(mdr, 0) += 1
num(mdr, num(mdr, 0)) = n
count += 1
End If
n += 1
Loop Until count = 50
For i As UInteger = 0 To 9
Print i; ":" ;
For j As UInteger = 1 To 5
Print Using "######"; num(i, j);
Next j
Print
Next i
Print
Print "Press any key to quit"
Sleep

View file

@ -0,0 +1,55 @@
package main
import "fmt"
// Only valid for n > 0 && base >= 2
func mult(n uint64, base int) (mult uint64) {
for mult = 1; mult > 0 && n > 0; n /= uint64(base) {
mult *= n % uint64(base)
}
return
}
// Only valid for n >= 0 && base >= 2
func MultDigitalRoot(n uint64, base int) (mp, mdr int) {
var m uint64
for m = n; m >= uint64(base); mp++ {
m = mult(m, base)
}
return mp, int(m)
}
func main() {
const base = 10
const size = 5
const testFmt = "%20v %3v %3v\n"
fmt.Printf(testFmt, "Number", "MDR", "MP")
for _, n := range [...]uint64{
123321, 7739, 893, 899998,
18446743999999999999,
// From http://mathworld.wolfram.com/MultiplicativePersistence.html
3778888999, 277777788888899,
} {
mp, mdr := MultDigitalRoot(n, base)
fmt.Printf(testFmt, n, mdr, mp)
}
fmt.Println()
var list [base][]uint64
for i := range list {
list[i] = make([]uint64, 0, size)
}
for cnt, n := size*base, uint64(0); cnt > 0; n++ {
_, mdr := MultDigitalRoot(n, base)
if len(list[mdr]) < size {
list[mdr] = append(list[mdr], n)
cnt--
}
}
const tableFmt = "%3v: %v\n"
fmt.Printf(tableFmt, "MDR", "First")
for i, l := range list {
fmt.Printf(tableFmt, i, l)
}
}

View file

@ -0,0 +1,41 @@
import Control.Arrow
import Data.Array
import Data.LazyArray
import Data.List (unfoldr)
import Data.Tuple
import Text.Printf
-- The multiplicative persistence (MP) and multiplicative digital root (MDR) of
-- the argument.
mpmdr :: Integer -> (Int, Integer)
mpmdr = (length *** head) . span (> 9) . iterate (product . digits)
-- Pairs (mdr, ns) where mdr is a multiplicative digital root and ns are the
-- first k numbers having that root.
mdrNums :: Int -> [(Integer, [Integer])]
mdrNums k = assocs $ lArrayMap (take k) (0,9) [(snd $ mpmdr n, n) | n <- [0..]]
digits :: Integral t => t -> [t]
digits 0 = [0]
digits n = unfoldr step n
where step 0 = Nothing
step k = Just (swap $ quotRem k 10)
printMpMdrs :: [Integer] -> IO ()
printMpMdrs ns = do
putStrLn "Number MP MDR"
putStrLn "====== == ==="
sequence_ [printf "%6d %2d %2d\n" n p r | n <- ns, let (p,r) = mpmdr n]
printMdrNums:: Int -> IO ()
printMdrNums k = do
putStrLn "MDR Numbers"
putStrLn "=== ======="
let showNums = unwords . map show
sequence_ [printf "%2d %s\n" mdr $ showNums ns | (mdr,ns) <- mdrNums k]
main :: IO ()
main = do
printMpMdrs [123321, 7739, 893, 899998]
putStrLn ""
printMdrNums 5

View file

@ -0,0 +1,24 @@
procedure main(A)
write(right("n",8)," ",right("MP",8),right("MDR",5))
every r := mdr(n := 123321|7739|893|899998) do
write(right(n,8),":",right(r[1],8),right(r[2],5))
write()
write(right("MDR",5)," ","[n0..n4]")
every m := 0 to 9 do {
writes(right(m,5),": [")
every writes(right((m = mdr(n := seq(m))[2],.n)\5,6))
write("]")
}
end
procedure mdr(m)
i := 0
while (.m > 10, m := multd(m), i+:=1)
return [i,m]
end
procedure multd(m)
c := 1
while m > 0 do c *:= 1(m%10, m/:=10)
return c
end

View file

@ -0,0 +1,2 @@
10&#.inv 123321
1 2 3 3 2 1

View file

@ -0,0 +1,2 @@
*/@(10&#.inv) 123321
36

View file

@ -0,0 +1,2 @@
*/@(10&#.inv)^:a: 123321
123321 36 18 8

View file

@ -0,0 +1,8 @@
(<:@#,{:) */@(10&#.inv)^:a: 123321
3 8
(<:@#,{:) */@(10&#.inv)^:a: 7739
3 8
(<:@#,{:) */@(10&#.inv)^:a: 893
3 2
(<:@#,{:) */@(10&#.inv)^:a: 899998
2 0

View file

@ -0,0 +1,11 @@
(5&{./.~ (*/@(10&#.inv)^:_)"0) i.20000
0 10 20 25 30
1 11 111 1111 11111
2 12 21 26 34
3 13 31 113 131
4 14 22 27 39
5 15 35 51 53
6 16 23 28 32
7 17 71 117 171
8 18 24 29 36
9 19 33 91 119

View file

@ -0,0 +1,51 @@
import java.util.*;
public class MultiplicativeDigitalRoot {
public static void main(String[] args) {
System.out.println("NUMBER MDR MP");
for (long n : new long[]{123321, 7739, 893, 899998}) {
long[] a = multiplicativeDigitalRoot(n);
System.out.printf("%6d %4d %4d%n", a[0], a[1], a[2]);
}
System.out.println();
Map<Long, List<Long>> table = new HashMap<>();
for (long i = 0; i < 10; i++)
table.put(i, new ArrayList<>());
for (long cnt = 0, n = 0; cnt < 10;) {
long[] res = multiplicativeDigitalRoot(n++);
List<Long> list = table.get(res[1]);
if (list.size() < 5) {
list.add(res[0]);
cnt = list.size() == 5 ? cnt + 1 : cnt;
}
}
System.out.println("MDR: first five numbers with same MDR");
table.forEach((key, lst) -> {
System.out.printf("%3d: ", key);
lst.forEach(e -> System.out.printf("%6s ", e));
System.out.println();
});
}
public static long[] multiplicativeDigitalRoot(long n) {
int mp = 0;
long mdr = n;
while (mdr > 9) {
long m = mdr;
long total = 1;
while (m > 0) {
total *= m % 10;
m /= 10;
}
mdr = total;
mp++;
}
return new long[]{n, mdr, mp};
}
}

View file

@ -0,0 +1,32 @@
def do_until(condition; next):
def u: if condition then . else (next|u) end;
u;
def mdroot(n):
def multiply: reduce .[] as $i (1; .*$i);
# state: [mdr, persist]
[n, 0]
| do_until( .[0] < 10;
[(.[0] | tostring | explode | map(.-48) | multiply), .[1] + 1]
);
# Produce a table with 10 rows (numbered from 0),
# showing the first n numbers having the row-number as the mdr
def tabulate(n):
# state: [answer_matrix, next_i]
def tab:
def minlength: map(length) | min;
.[0] as $matrix
| .[1] as $i
| if (.[0]|minlength) == n then .[0]
else (mdroot($i) | .[0]) as $mdr
| if $matrix[$mdr]|length < n then
($matrix[$mdr] + [$i]) as $row
| $matrix | setpath([$mdr]; $row)
else $matrix
end
| [ ., $i + 1 ]
| tab
end;
[[], 0] | tab;

View file

@ -0,0 +1,15 @@
def neatly:
. as $in
| range(0;length)
| "\(.): \($in[.])";
def rjust(n): tostring | (n-length)*" " + .;
# The task:
" i : [MDR, MP]",
((123321, 7739, 893, 899998) as $i
| "\($i|rjust(6)): \(mdroot($i))"),
"",
"Tabulation",
"MDR: [n0..n4]",
(tabulate(5) | neatly)

View file

@ -0,0 +1,20 @@
$ jq -n -r -c -f mdr.jq
i : [MDR, MP]
123321: [8,3]
7739: [8,3]
893: [2,3]
899998: [0,2]
Tabulation
MDR: [n0..n4]
0: [0,10,20,25,30]
1: [1,11,111,1111,11111]
2: [2,12,21,26,34]
3: [3,13,31,113,131]
4: [4,14,22,27,39]
5: [5,15,35,51,53]
6: [6,16,23,28,32]
7: [7,17,71,117,171]
8: [8,18,24,29,36]
9: [9,19,33,91,119]

View file

@ -0,0 +1,10 @@
function digitalmultroot{S<:Integer,T<:Integer}(n::S, bs::T=10)
-1 < n && 1 < bs || throw(DomainError())
ds = n
pers = 0
while bs <= ds
ds = prod(digits(ds, bs))
pers += 1
end
return (pers, ds)
end

View file

@ -0,0 +1,34 @@
const bs = 10
const excnt = 5
println("Testing Multiplicative Digital Root.\n")
for i in [123321, 7739, 893, 899998]
(pers, ds) = digitalmultroot(i, bs)
print(@sprintf("%8d", i))
print(" has persistence ", pers)
println(" and digital root ", ds)
end
dmr = zeros(Int, bs, excnt)
hasroom = trues(bs)
dex = ones(Int, bs)
i = 0
while any(hasroom)
(pers, ds) = digitalmultroot(i, bs)
ds += 1
if hasroom[ds]
dmr[ds, dex[ds]] = i
dex[ds] += 1
if dex[ds] > excnt
hasroom[ds] = false
end
end
i += 1
end
println("\n MDR: First ", excnt, " numbers having this MDR")
for (i, d) in enumerate(0:(bs-1))
print(@sprintf("%4d: ", d))
println(join([@sprintf("%6d", dmr[i, j]) for j in 1:excnt], ","))
end

View file

@ -0,0 +1,51 @@
// version 1.1.2
fun multDigitalRoot(n: Int): Pair<Int, Int> = when {
n < 0 -> throw IllegalArgumentException("Negative numbers not allowed")
else -> {
var mdr: Int
var mp = 0
var nn = n
do {
mdr = if (nn > 0) 1 else 0
while (nn > 0) {
mdr *= nn % 10
nn /= 10
}
mp++
nn = mdr
}
while (mdr >= 10)
Pair(mdr, mp)
}
}
fun main(args: Array<String>) {
val ia = intArrayOf(123321, 7739, 893, 899998)
for (i in ia) {
val (mdr, mp) = multDigitalRoot(i)
println("${i.toString().padEnd(9)} MDR = $mdr MP = $mp")
}
println()
println("MDR n0 n1 n2 n3 n4")
println("=== ===========================")
val ia2 = Array(10) { IntArray(6) } // all zero by default
var n = 0
var count = 0
do {
val (mdr, _) = multDigitalRoot(n)
if (ia2[mdr][0] < 5) {
ia2[mdr][0]++
ia2[mdr][ia2[mdr][0]] = n
count++
}
n++
}
while (count < 50)
for (i in 0..9) {
print("$i:")
for (j in 1..5) print("%6d".format(ia2[i][j]))
println()
}
}

View file

@ -0,0 +1,50 @@
multDigitalRoot=lambda (n as decimal) ->{
if n<0 then error "Negative numbers not allowed"
def decimal mdr, mp, nn
nn=n
do
mdr=IF(nn>0->1@, 0@)
while nn>0
mdr*=nn mod 10@
nn|div 10@
end while
mp++
nn=mdr
when mdr>=10
=(mdr, mp)
}
Document doc$
ia=(123321, 7739, 893, 899998)
in_ia=each(ia)
while in_ia
(mdr, mp)=multDigitalRoot(array(in_ia))
doc$=format$("{0::-9} mdr = {1} MP = {2}", array(in_ia), mdr, mp)+{
}
end while
let n=0@, count=0&
dim ia2(0 to 9, 0 to 5)
do
mdr=multDigitalRoot(n)#val(0)
if ia2(mdr, 0)<5 then
ia2(mdr, 0)++
ia2(mdr, ia2(mdr, 0))=n
count++
end if
n++
when count<50
doc$={MDR n0 n1 n2 n3 n4
}
doc$={=== ============================
}
for i=0 to 9
doc$=format$("{0}: ", i)
for j=1 to 5
doc$=format$("{0::-6}", ia2(i, j))
next
doc$={
}
next
Clipboard doc$
// Print like in a file (-2 is for console):
Print #-2, doc$

View file

@ -0,0 +1,9 @@
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]

View file

@ -0,0 +1,22 @@
import strutils, sequtils, sugar
proc mdroot(n: int): tuple[mp, mdr: int] =
var mdr = @[n]
while mdr[mdr.high] > 9:
var n = 1
for dig in $mdr[mdr.high]:
n *= parseInt($dig)
mdr.add n
(mdr.high, mdr[mdr.high])
for n in [123321, 7739, 893, 899998]:
echo align($n, 6)," ",mdroot(n)
echo ""
var table = newSeqWith(10, newSeq[int]())
for n in 0..int.high:
if table.map((x: seq[int]) => x.len).min >= 5: break
table[mdroot(n).mdr].add n
for mp, val in table:
echo mp, ": ", val[0..4]

View file

@ -0,0 +1,3 @@
a(n)=my(i);while(n>9,n=factorback(digits(n));i++);[i,n];
apply(a, [123321, 7739, 893, 899998])
v=vector(10,i,[]); forstep(n=0,oo,1, t=a(n)[2]+1; if(#v[t]<5,v[t]=concat(v[t],n); if(vecmin(apply(length,v))>4, return(v))))

View file

@ -0,0 +1,24 @@
multiple: procedure options (main); /* 29 April 2014 */
declare n fixed binary (31);
find_mdr: procedure;
declare (mdr, mp, p) fixed binary (31);
mdr = n;
do mp = 1 by 1 until (p <= 9);
p = 1;
do until (mdr = 0); /* Form product of the digits in mdr. */
p = mod(mdr, 10) * p;
mdr= mdr/10;
end;
mdr = p;
end;
put skip data (n, mdr, mp);
end find_mdr;
do n = 123321, 7739, 893, 899998;
call find_mdr;
end;
end multiple;

View file

@ -0,0 +1,56 @@
mdrt: Proc Options(main);
Dcl (x,p,r) Bin Fixed(31);
Put Edit('number persistence multiplicative digital root')(Skip,a);
Put Edit('------- ----------- ---------------------------')(Skip,a);
Call task1(123321);
Call task1( 7739);
Call task1( 893);
Call task1(899998);
task1: Procedure(x);
Dcl x Bin Fixed(31);
Call mdr(x,p,r);
Put Edit(x,p,r)(Skip,f(8),f(8),f(22));
End;
Dcl zn(0:9) Bin Fixed(31);
Dcl z(0:9,5) Bin Fixed(31);
zn=0;
zn(0)=1;
z(0,1)=0;
Do x=1 To 11111;
Call mdr(x,p,r);
If zn(r)<5 Then Do;
zn(r)+=1;
z(r,zn(r))=x;
End;
End;
Put Edit(' ')(Skip,a);
Put Edit('MDR first 5 numbers that have a matching MDR')(Skip,a);
Put Edit('--- ----------------------------------------')(Skip,a);
Do r=0 To 9;
Put Edit(r,' ')(Skip,f(3),a);
Do i=1 To 5;
Put Edit(z(r,i))(f(6));
End;
End;
mdr: Procedure(y,p,r);
Dcl (y,p,r) Bin Fixed(31);
Dcl (k,yy) Bin Fixed(31);
Dcl pic Pic'(10)9';
Dcl d Pic'9';
pic=abs(y);
Do p=1 By 1 Until(pic<10);
Do k=1 To 10 Until(substr(pic,k,1)>'0');
End;
r=1;
Do k=k To 10;
d=substr(pic,k,1);
r=r*d;
End;
pic=r;
End;
End;
End;

View file

@ -0,0 +1,28 @@
use warnings;
use strict;
sub mdr {
my $n = shift;
my($count, $mdr) = (0, $n);
while ($mdr > 9) {
my($m, $dm) = ($mdr, 1);
while ($m) {
$dm *= $m % 10;
$m = int($m/10);
}
$mdr = $dm;
$count++;
}
($count, $mdr);
}
print "Number: (MP, MDR)\n====== =========\n";
foreach my $n (123321, 7739, 893, 899998) {
printf "%6d: (%d, %d)\n", $n, mdr($n);
}
print "\nMP: [n0..n4]\n== ========\n";
foreach my $target (0..9) {
my $i = 0;
my @n = map { $i++ while (mdr($i))[1] != $target; $i++; } 1..5;
print " $target: [", join(", ", @n), "]\n";
}

View file

@ -0,0 +1,46 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">mdr_mp</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">mp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">></span><span style="color: #000000;">9</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">newm</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">m</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">newm</span> <span style="color: #0000FF;">*=</span> <span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">m</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">/</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000000;">m</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">newm</span>
<span style="color: #000000;">mp</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">m</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mp</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">tests</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">123321</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">7739</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">893</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">899998</span><span style="color: #0000FF;">}</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Number MDR MP\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"====== === ==\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ti</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%6d %6d %6d\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ti</span><span style="color: #0000FF;">&</span><span style="color: #000000;">mdr_mp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ti</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">found</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">columnize</span><span style="color: #0000FF;">({</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)})</span>
<span style="color: #000080;font-style:italic;">-- (ie {{0},{1},..,{9}})</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">found</span><span style="color: #0000FF;"><</span><span style="color: #000000;">50</span> <span style="color: #008080;">do</span> <span style="color: #000080;font-style:italic;">-- (ie the full 10*5)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">mdr1</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">mdr_mp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]+</span><span style="color: #000000;">1</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">m1</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">mdr1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m1</span><span style="color: #0000FF;">)<</span><span style="color: #000000;">6</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">mdr1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> <span style="color: #000080;font-style:italic;">-- (avoid p2js violation)</span>
<span style="color: #000000;">m1</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">i</span>
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">mdr1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">m1</span>
<span style="color: #000000;">found</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">i</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\nMDR 1 2 3 4 5"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n=== ===========================\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">10</span> <span style="color: #008080;">do</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%2d %5d %5d %5d %5d %5d\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--

View file

@ -0,0 +1,5 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">pdd</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">return</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%2d"</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">product</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_sub</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sprint</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">),</span><span style="color: #008000;">'0'</span><span style="color: #0000FF;">)))</span> <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Product of the decimal digits of 1..100:\n%s\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #7060A8;">join_by</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">apply</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">100</span><span style="color: #0000FF;">),</span><span style="color: #000000;">pdd</span><span style="color: #0000FF;">),</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)})</span>
<!--

View file

@ -0,0 +1,36 @@
(de mdr-mp (N)
"Returns the solutions in a list, i.e., '(MDR MP)"
(let MP 0
(while (< 1 (length N))
(setq N (apply * (mapcar format (chop N))))
(inc 'MP) )
(list N MP) ) )
# Get the MDR/MP of these nums.
(setq Test-nums '(123321 7739 893 899998))
(let Fmt (6 5 5)
(tab Fmt "Values" "MDR" "MP")
(tab Fmt "======" "===" "==")
(for I Test-nums
(let MDR-MP (mdr-mp I)
(tab Fmt I (car MDR-MP) (cadr MDR-MP)) ) ) )
(prinl)
# Get the nums of these MDRs.
(setq *Want 5)
(setq *Solutions (make (for MDR (range 0 9)
(link (make (let N 0 (until (= *Want (length (made)))
(when (= MDR (car (mdr-mp N)))
(link N) )
(inc 'N) )))) )))
(let Fmt (3 1 -1)
(tab Fmt "MDR" ": " "Values")
(tab Fmt "===" " " "======")
(for (I . S) *Solutions
(tab Fmt (dec I) ": " (glue ", " S)) ) )

View file

@ -0,0 +1,25 @@
try:
from functools import reduce
except:
pass
def mdroot(n):
'Multiplicative digital root'
mdr = [n]
while mdr[-1] > 9:
mdr.append(reduce(int.__mul__, (int(dig) for dig in str(mdr[-1])), 1))
return len(mdr) - 1, mdr[-1]
if __name__ == '__main__':
print('Number: (MP, MDR)\n====== =========')
for n in (123321, 7739, 893, 899998):
print('%6i: %r' % (n, mdroot(n)))
table, n = {i: [] for i in range(10)}, 0
while min(len(row) for row in table.values()) < 5:
mpersistence, mdr = mdroot(n)
table[mdr].append(n)
n += 1
print('\nMP: [n0..n4]\n== ========')
for mp, val in sorted(table.items()):
print('%2i: %r' % (mp, val[:5]))

View file

@ -0,0 +1,10 @@
def mdroot(n):
count, mdr = 0, n
while mdr > 9:
m, digitsMul = mdr, 1
while m:
m, md = divmod(m, 10)
digitsMul *= md
mdr = digitsMul
count += 1
return count, mdr

View file

@ -0,0 +1,34 @@
[ 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

View file

@ -0,0 +1,33 @@
/*REXX program finds the persistence and multiplicative digital root of some numbers.*/
numeric digits 100 /*increase the number of decimal digits*/
parse arg x /*obtain optional arguments from the CL*/
if x='' | x="," then x=123321 7739 893 899998 /*Not specified? Then use the default.*/
say center('number', 8) ' persistence multiplicative digital root'
say copies('' , 8) ' '
/* [↑] the title and separator. */
do j=1 for words(x); n=word(x, j) /*process each number in the X list.*/
parse value MDR(n) with mp mdr /*obtain the persistence and the MDR. */
say right(n,8) center(mp,13) center(mdr,30) /*display a number, persistence, MDR.*/
end /*j*/ /* [↑] show MP & MDR for each number. */
say copies('' , 8) ' '
say; say; target=5
say 'MDR first ' target " numbers that have a matching MDR"
say ' '
do k=0 for 10; hits=0; _= /*show numbers that have an MDR of K. */
do m=k until hits==target /*find target numbers with an MDR of K.*/
if word( MDR(m), 2)\==k then iterate /*is this the MDR that's wanted? */
hits=hits + 1; _=space(_ m',') /*yes, we got a hit, add to the list. */
end /*m*/ /* [↑] built a list of MDRs that = K. */
say " "k': ['strip(_, , ',')"]" /*display the K (MDR) and the list. */
end /*k*/ /* [↑] done with the K MDR list. */
say ' '
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
MDR: procedure; parse arg y; y=abs(y) /*get the number and determine the MDR.*/
do p=1 until y<10; parse var y r 2
do k=2 to length(y); r=r * substr(y, k, 1)
end /*k*/
y=r
end /*p*/ /* [↑] wash, rinse, and repeat ··· */
return p r /*return the persistence and the MDR. */

View file

@ -0,0 +1,82 @@
/*REXX program finds the persistence and multiplicative digital root of some numbers.*/
numeric digits 2000 /*increase the number of decimal digits*/
parse arg target x /*obtain optional arguments from the CL*/
if \datatype(target, 'W') then target=25 /*Not specified? Then use the default.*/
if x='' | x="," then x=123321 7739 893 899998 /* " " " " " " */
say center('number',8) ' persistence multiplicative digital root'
say copies('' ,8) ' '
/* [↑] the title and the separator. */
do j=1 for words(x); n= abs( word(x, j) ) /*process each number in the list. */
parse value MDR(n) with mp mdr /*obtain the persistence and the MDR. */
say right(n,8) center(mp,13) center(mdr,30) /*display the number, persistence, MDR.*/
end /*j*/ /* [↑] show MP and MDR for each number.*/
say copies('' ,8) ' '
say; say /* [↓] show a blank and the title line.*/
say 'MDR first ' target " numbers that have a matching MDR"
say ' ' copies("",(target+(target+1)**2)%2) /*display a separator line (for title).*/
do k=0 for 9; hits= 0 /*show numbers that have an MDR of K. */
_=
if k==7 then _= @7 /*handle the special case of seven. */
else do m=k until hits==target /*find target numbers with an MDR of K.*/
parse var m '' -1 ? /*obtain the right─most digit of M. */
if k\==0 then if ?==0 then iterate
if k==5 then if ?//2==0 then iterate
if k==1 then m= copies(1, hits+1)
else if MDR(m, 1)\==k then iterate
hits= hits + 1 /*got a hit, add to the list*/
_= space(_ m) /*elide superfluous blanks. */
if k==3 then do; o=strip(m, 'T', 1) /*strip trailing ones from M*/
if o==3 then m= copies(1, length(m))3 /*make a new M.*/
else do; t= pos(3, m) - 1 /*position of 3 */
m= overlay(3, translate(m, 1, 3), t)
end /* [↑] shift the "3" 1 place left.*/
m= m - 1 /*adjust for DO index increment.*/
end /* [↑] a shortcut to adj DO index*/
end /*m*/ /* [↑] built a list of MDRs = K */
say " "k': ['_"]" /*display the K (MDR) and the list. */
if k==3 then @7= translate(_, 7, k) /*save for later, a special "7" case.*/
end /*k*/ /* [↑] done with the K MDR list. */
@.= /* [↓] handle MDR of "9" special. */
_= translate(@7, 9, 7) /*translate string for MDR of nine. */
@9= translate(_, , ',') /*remove trailing commas from numbers. */
@3= /*assign null string before building. */
do j=1 for words(@9) /*process each number for MDR 9 case.*/
_= space( translate( word(@9, j), , 9), 0) /*elide all "9"s using SPACE(x,0).*/
L= length(_) + 1 /*use a "fudged" length of the number. */
new= /*these are the new numbers (so far). */
do k=0 for L; q= insert(3, _, k) /*insert the 1st "3" into the number*/
do i=k to L; z= insert(3, q, i) /* " " 2nd "3" " " " */
if @.z\=='' then iterate /*if already define, ignore the number.*/
@.z= z; new= z new /*define it, and then add to the list.*/
end /*i*/ /* [↑] end of 2nd insertion of "3".*/
end /*k*/ /* [↑] " " 1st " " " */
@3= space(@3 new) /*remove blanks, then add to the list.*/
end /*j*/ /* [↑] end of insertion of the "3"s. */
@= /* [↓] merge two lists, 3s and 9s. */
a1= @9; a2= @3 /*define some strings for the merge. */
do while a1\=='' & a2\=='' /*process while the lists aren't empty.*/
x= word(a1, 1); y= word(a2, 1) /*obtain the 1st word in A1 & A2 lists.*/
if x=='' | y=='' then leave /*are X or Y empty? */
if x<y then do; @= @ x; a1= delword(a1, 1, 1); end /*add X to the @ list*/
else do; @= @ y; a2= delword(a2, 1, 1); end /* " Y " " " " */
end /*while*/ /* [↑] only process just enough nums. */
@= subword(@, 1, target) /*elide the last trailing comma in list*/
say " "9': ['@"]" /*display the "9" (MDR) and the list.*/
say ' ' copies("",(target+(target+1)**2)%2) /*display a separator line (for title).*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
MDR: procedure; parse arg y,s; y= abs(y) /*get the number and determine the MDR.*/
do p=1 until y<10; parse var y r 2
do k=2 to length(y); r= r * substr(y, k, 1)
end /*k*/
y= r
end /*p*/ /* [↑] wash, rinse, and repeat ··· */
if s==1 then return r /*return multiplicative digital root. */
return p r /*return the persistence and the MDR. */

View file

@ -0,0 +1,22 @@
/*REXX pgm finds positive integers when shown in hex that can't be written with dec digs*/
parse arg n cols . /*obtain optional argument from the CL.*/
if n=='' | n=="," then n = 100 /*Not specified? Then use the default.*/
if cols=='' | cols=="," then cols= 10 /* " " " " " " */
w= 10 /*width of a number in any column. */
title= ' the product of the decimal digits of N, where N < ' n
say ' index 'center(title, 1 + cols*(w+1) ) /*display the title for the output. */
say ''center("" , 1 + cols*(w+1), '') /* " a sep " " " */
$=; idx= 1 /*list of products (so far); IDX=index.*/
do #=1 for n; L= length(#) /*find products of the dec. digs of J. */
p= left(#, 1) /*use first digit as the product so far*/
do j=2 for L-1 until p==0 /*add an optimization when product is 0*/
p= p * substr(#, j, 1) /*multiply the product by the next dig.*/
end /*j*/
$= $ right(p, w) /*add the product ───► the $ list. */
if #//cols \== 0 then iterate /*have we populated a line of output? */
say center(idx, 7)'' substr($, 2); $= /*display what we have so far (cols). */
idx= idx + cols /*bump the index count for the output*/
end /*#*/ /*stick a fork in it, we're all done. */
if $\=='' then say center(idx, 7)"" substr($, 2) /*possible display residual output.*/
say ''center("" , 1 + cols*(w+1), '') /*display the foot sep for output. */

View file

@ -0,0 +1,23 @@
#lang racket
(define (digital-product n)
(define (inr-d-p m rv)
(cond
[(zero? m) rv]
[else (define-values (q r) (quotient/remainder m 10))
(if (zero? r) 0 (inr-d-p q (* rv r)))])) ; lazy on zero
(inr-d-p n 1))
(define (mdr/mp n)
(define (inr-mdr/mp m i)
(if (< m 10) (values m i) (inr-mdr/mp (digital-product m) (add1 i))))
(inr-mdr/mp n 0))
(printf "Number\tMDR\tmp~%======\t===\t==~%")
(for ((n (in-list '(123321 7739 893 899998))))
(define-values (mdr mp) (mdr/mp n))
(printf "~a\t~a\t~a~%" n mdr mp))
(printf "~%MDR\t[n0..n4]~%===\t========~%")
(for ((MDR (in-range 10)))
(define (has-mdr? n) (define-values (mdr mp) (mdr/mp n)) (= mdr MDR))
(printf "~a\t~a~%" MDR (for/list ((_ 5) (n (sequence-filter has-mdr? (in-naturals)))) n)))

View file

@ -0,0 +1,13 @@
sub multiplicative-digital-root(Int $n) {
return .elems - 1, .[.end]
given cache($n, {[*] .comb} ... *.chars == 1)
}
for 123321, 7739, 893, 899998 {
say "$_: ", .&multiplicative-digital-root;
}
for ^10 -> $d {
say "$d : ", .[^5]
given (1..*).grep: *.&multiplicative-digital-root[1] == $d;
}

View file

@ -0,0 +1,39 @@
Red ["Multiplicative digital root"]
mdr: function [
"Returns a block containing the mdr and persistence of an integer"
n [integer!]
][
persistence: 0
while [n > 10][
product: 1
m: n
while [m > 0][
product: m % 10 * product
m: to-integer m / 10
]
persistence: persistence + 1
n: product
]
reduce [n persistence]
]
foreach n [123321 7739 893 899998][
result: mdr n
print [pad n 6 "has multiplicative persistence" result/2 "and MDR" result/1]
]
print [newline "First five numbers with MDR of"]
repeat i 10 [
prin rejoin [i - 1 ": "]
hits: n: 0
while [hits < 5][
if i - 1 = first mdr n [
prin pad n 5
hits: hits + 1
]
n: n + 1
]
prin newline
]

View file

@ -0,0 +1,60 @@
# Project : Digital root/Multiplicative digital root
load "stdlib.ring"
root = newlist(10, 5)
for r = 1 to 10
for x = 1 to 5
root[r][x] = 0
next
next
root2 = list(10)
for y = 1 to 10
root2[y] = 0
next
see "Number MDR MP" + nl
num = [123321, 7739, 893, 899998]
digroot(num)
see nl
num = 0:12000
digroot(num)
see "First five numbers with MDR in first column:" + nl
for n1 = 1 to 10
see "" + (n1-1) + " => "
for n2 = 1 to 5
see "" + root[n1][n2] + " "
next
see nl
next
func digroot(num)
for n = 1 to len(num)
sum = 0
numold = num[n]
while true
pro = 1
strnum = string(numold)
for nr = 1 to len(strnum)
pro = pro * number(strnum[nr])
next
sum = sum + 1
numold = pro
numn = string(num[n])
sp = 6 - len(string(num[n]))
if sp > 0
for p = 1 to sp + 2
numn = " " + numn
next
ok
if len(string(numold)) = 1 and len(num) < 5
see "" + numn + " " + numold + " " + sum + nl
exit
ok
if len(string(numold)) = 1 and len(num) > 4
root2[numold+1] = root2[numold+1] + 1
if root2[numold+1] < 6
root[numold+1][root2[numold+1]] = num[n]
ok
exit
ok
end
next

View file

@ -0,0 +1,21 @@
load "stdlib.ring"
see "working..." + nl
see "Product of decimal digits of n:" + nl
row = 0
limit = 100
for n = 1 to limit
prod = 1
strn = string(n)
for m = 1 to len(strn)
prod = prod * number(strn[m])
next
see "" + prod + " "
row = row + 1
if row%5 = 0
see nl
ok
next
see "done..." + nl

View file

@ -0,0 +1,19 @@
def mdroot(n)
mdr, persist = n, 0
until mdr < 10 do
mdr = mdr.digits.inject(:*)
persist += 1
end
[mdr, persist]
end
puts "Number: MDR MP", "====== === =="
[123321, 7739, 893, 899998].each{|n| puts "%6d: %d %2d" % [n, *mdroot(n)]}
counter = Hash.new{|h,k| h[k]=[]}
0.step do |i|
counter[mdroot(i).first] << i
break if counter.values.all?{|v| v.size >= 5 }
end
puts "", "MDR: [n0..n4]", "=== ========"
10.times{|i| puts "%3d: %p" % [i, counter[i].first(5)]}

View file

@ -0,0 +1,27 @@
import Stream._
object MDR extends App {
def mdr(x: BigInt, base: Int = 10): (BigInt, Long) = {
def multiplyDigits(x: BigInt): BigInt = ((x.toString(base) map (_.asDigit)) :\ BigInt(1))(_*_)
def loop(p: BigInt, c: Long): (BigInt, Long) = if (p < base) (p, c) else loop(multiplyDigits(p), c+1)
loop(multiplyDigits(x), 1)
}
printf("%15s\t%10s\t%s\n","Number","MDR","MP")
printf("%15s\t%10s\t%s\n","======","===","==")
Seq[BigInt](123321, 7739, 893, 899998, BigInt("393900588225"), BigInt("999999999999")) foreach {x =>
val (s, c) = mdr(x)
printf("%15s\t%10s\t%2s\n",x,s,c)
}
println
val mdrs: Stream[Int] => Stream[(Int, BigInt)] = i => i map (x => (x, mdr(x)._1))
println("MDR: [n0..n4]")
println("==== ========")
((for {i <- 0 to 9} yield (mdrs(from(0)) take 11112 toList) filter {_._2 == i})
.map {_ take 5} map {xs => xs map {_._1}}).zipWithIndex
.foreach{p => printf("%3s: [%s]\n",p._2,p._1.mkString(", "))}
}

View file

@ -0,0 +1,54 @@
; Convert an integer into a list of its digits.
(define integer->list
(lambda (integer)
(let loop ((list '()) (int integer))
(if (< int 10)
(cons int list)
(loop (cons (remainder int 10) list) (quotient int 10))))))
; Return the product of the digits of an integer.
(define integer-product-digits
(lambda (integer)
(fold-left * 1 (integer->list integer))))
; Compute the multiplicative digital root and multiplicative persistence of an integer.
; Return as a cons of (mdr . mp).
(define mdr-mp
(lambda (integer)
(let loop ((int integer) (cnt 0))
(if (< int 10)
(cons int cnt)
(loop (integer-product-digits int) (1+ cnt))))))
; Emit a table of integer, multiplicative digital root, and multiplicative persistence
; for the example integers given. Example list ends with sequence A003001 from OEIS.
(printf "~16@a ~6@a ~6@a~%" "Integer" "Root" "Pers.")
(printf "~16@a ~6@a ~6@a~%" "===============" "======" "======")
(let rowloop ((intlist '(123321 7739 893 899998
0 10 25 39 77 679 6788 68889 2677889 26888999 3778888999 277777788888899)))
(when (pair? intlist)
(let* ((int (car intlist))
(mm (mdr-mp int)))
(printf "~16@a ~6@a ~6@a~%" int (car mm) (cdr mm))
(rowloop (cdr intlist)))))
; Emit a table of multiplicative digital root versus the first five integers having that MDR.
(newline)
(printf "~5@a ~a~%" "Root" "First five integers with that root")
(printf "~5@a ~a~%" "====" "==================================")
(let ((mdrslsts (make-vector 10 '())))
(do ((integer 0 (1+ integer)))
((>= (fold-left min 5 (vector->list (vector-map length mdrslsts))) 5))
(let ((mdr (car (mdr-mp integer))))
(when (< (length (vector-ref mdrslsts mdr)) 5)
(vector-set! mdrslsts mdr (append (vector-ref mdrslsts mdr) (list integer))))))
(do ((mdr 0 (1+ mdr)))
((>= mdr 10))
(printf "~5@a" mdr)
(for-each (lambda (int) (printf "~7@a" int)) (vector-ref mdrslsts mdr))
(newline)))

View file

@ -0,0 +1,22 @@
func mdroot(n) {
var (mdr, persist) = (n, 0)
while (mdr >= 10) {
mdr = mdr.digits.prod
++persist
}
[mdr, persist]
}
say "Number: MDR MP\n====== === =="
[123321, 7739, 893, 899998].each{|n| "%6d: %3d %3d\n" \
.printf(n, mdroot(n)...) }
var counter = Hash()
Inf.times { |j|
counter{mdroot(j).first} := [] << j
break if counter.values.all {|v| v.len >= 5 }
}
 
say "\nMDR: [n0..n4]\n=== ========"
10.times {|i| "%3d: %s\n".printf(i, counter{i}.first(5)) }

View file

@ -0,0 +1,9 @@
proc mdr {n} {
if {$n < 0 || ![string is integer $n]} {
error "must be an integer"
}
for {set i 0} {$n > 9} {incr i} {
set n [tcl::mathop::* {*}[split $n ""]]
}
return [list $i $n]
}

View file

@ -0,0 +1,16 @@
puts "Number: MP MDR"
puts [regsub -all . "Number: MP MDR" -]
foreach n {123321 7739 893 899998} {
puts [format "%6d: %2d %3d" $n {*}[mdr $n]]
}
puts ""
# The longEnough variable counts how many roots have at least 5 values accumulated for them
for {set i [set longEnough 0]} {$longEnough < 10} {incr i} {
set root [lindex [mdr $i] 1]
if {[llength [lappend accum($root) $i]] == 5} {incr longEnough}
}
puts "MDR: \[n\u2080\u2026n\u2084\]"
puts [regsub -all . "MDR: \[n\u2080\u2026n\u2084\]" -]
for {set i 0} {$i < 10} {incr i} {
puts [format "%3d: (%s)" $i [join [lrange $accum($i) 0 4] ", "]]
}

View file

@ -0,0 +1,49 @@
// Only valid for n > 0 && base >= 2
fn mult(nn u64, base int) u64 {
mut n := nn
mut mult := u64(0)
for mult = 1; mult > 0 && n > 0; n /= u64(base) {
mult *= n % u64(base)
}
return mult
}
// Only valid for n >= 0 && base >= 2
fn multi_digital_root(n u64, base int) (int, int) {
mut m := u64(0)
mut mp := 0
for m = n; m >= u64(base); mp++ {
m = mult(m, base)
}
return mp, int(m)
}
const base = 10
fn main() {
size := 5
println("${'Number':20} ${'MDR':3} ${'MP':3}")
for n in [
u64(123321), 7739, 893, 899998,
18446743999999999999,
// From http://mathworld.wolfram.com/MultiplicativePersistence.html
3778888999, 277777788888899,
] {
mp, mdr := multi_digital_root(n, base)
println("${n:20} ${mdr:3} ${mp:3}")
}
println('')
mut list := [base][]u64{init: []u64{len: 0, cap:size}}
for cnt, n := size*base, u64(0); cnt > 0; n++ {
_, mdr := multi_digital_root(n, base)
if list[mdr].len < size {
list[mdr] << n
cnt--
}
}
println("${'MDR':3}: First")
for i, l in list {
println("${i:3}: $l")
}
}

View file

@ -0,0 +1,61 @@
import "/big" for BigInt
import "/fmt" for Fmt
// Only valid for n > 0 && base >= 2
var mult = Fn.new { |n, base|
var m = BigInt.one
while (m > BigInt.zero && n > BigInt.zero) {
var dm = n.divMod(base)
m = m * dm[1]
n = dm[0]
}
return m
}
// Only valid for n >= 0 && base >= 2
var multDigitalRoot = Fn.new { |n, base|
base = BigInt.new(base)
var m = n.copy()
var mp = BigInt.zero
while (m >= base) {
m = mult.call(m, base)
mp = mp.inc
}
return [mp, m.toSmall]
}
var base = 10
var size = 5
var tests = [
123321, 7739, 893, 899998,"18446743999999999999", 3778888999, "277777788888899"
]
var testFmt = "$20s $3s $3s"
Fmt.print(testFmt, "Number", "MDR", "MP")
for (test in tests) {
var n = BigInt.new(test)
var mpdr = multDigitalRoot.call(n, base)
Fmt.print(testFmt, n, mpdr[1], mpdr[0])
}
System.print()
var list = List.filled(base, null)
for (i in 0...base) list[i] = []
var cnt = size * base
var n = BigInt.zero
while (cnt > 0) {
var mpdr = multDigitalRoot.call(n, base)
var mdr = mpdr[1]
if (list[mdr].count < size) {
list[mdr].add(n)
cnt = cnt - 1
}
n = n.inc
}
Fmt.print("$3s: $s", "MDR", "First")
var i = 0
for (l in list) {
Fmt.print("$3d: $s", i, l.toString)
i = i + 1
}

View file

@ -0,0 +1,63 @@
\Calculate the Multiplicative Digital Root (MDR) and
\ Multiplicative Persistence (MP) of N
procedure GetMDR ( N, MDR, MP );
integer N, MDR, MP, V;
begin
MP(0) := 0;
MDR(0) := abs( N );
while MDR(0) > 9 do begin
V := MDR(0);
MDR(0) := 1;
repeat
MDR(0) := MDR(0) * rem( V / 10 );
V := V / 10;
until V = 0;
MP(0) := MP(0) + 1;
end; \while_mdr_gt_9
end; \GetMDR
define RequiredMDRs = 5;
integer FirstFew ( 9+1, 1+RequiredMDRs );
integer MDRFound ( 9+1 );
integer TotalFound, FoundPos, RequiredTotal, N, I, V, L;
integer MDR, MP;
begin
\task test cases
Text(0, " N MDR MP^m^j" );
L := [ 123321, 7739, 893, 899998 ];
for N := 0 to 3 do begin
GetMDR( L(N), @MDR, @MP );
Format(8, 0); RlOut(0, float(L(N)));
Format(4, 0); RlOut(0, float(MDR));
Format(3, 0); RlOut(0, float(MP));
CrLf(0)
end; \for_N
\find the first 5 numbers with each possible MDR
begin
for I := 0 to 9 do MDRFound( I ) := 0;
TotalFound := 0;
RequiredTotal := 10 * RequiredMDRs;
N := -1;
while TotalFound < RequiredTotal do begin
N := N + 1;
GetMDR( N, @MDR, @MP );
if MDRFound( MDR ) < RequiredMDRs then begin
\Found another number with this MDR and haven't found enough
TotalFound := TotalFound + 1;
MDRFound( MDR ) := MDRFound( MDR ) + 1;
FirstFew( MDR, MDRFound( MDR ) ) := N
end \if_Found_another_MDR
end; \while_TotalFound_lt_RequiredTotal
\print the table of MDRs and numbers
Text(0, "MDR: [N0..N4]^m^j" );
Text(0, "=== ========^m^j" );
for V := 0 to 9 do begin
ChOut(0, ^ ); IntOut(0, V); Text(0, ": [");
for FoundPos := 1 to RequiredMDRs do begin
if FoundPos > 1 then Text( 0, ", " );
IntOut( 0, FirstFew( V, FoundPos ) )
end; \for_FoundPos
Text(0, "]^m^j")
end \for_v
end
end

View file

@ -0,0 +1,7 @@
fcn mdroot(n){ // Multiplicative digital root
mdr := List(n);
while (mdr[-1] > 9){
mdr.append(mdr[-1].split().reduce('*,1));
}
return(mdr.len() - 1, mdr[-1]);
}

View file

@ -0,0 +1,14 @@
fcn mdroot(n){
count:=0; mdr:=n;
while(mdr > 9){
m:=mdr; digitsMul:=1;
while(m){
reg md;
m,md=m.divr(10);
digitsMul *= md;
}
mdr = digitsMul;
count += 1;
}
return(count, mdr);
}

View file

@ -0,0 +1,15 @@
println("Number: (MP, MDR)\n======= =========");
foreach n in (T(123321, 7739, 893, 899998))
{ println("%7,d: %s".fmt(n, mdroot(n))) }
table:=D([0..9].zip(fcn{List()}).walk()); // dictionary(0:List, 1:List, ...)
n :=0;
while(table.values.filter(fcn(r){r.len()<5})){ // until each entry has >=5 values
mpersistence, mdr := mdroot(n);
table[mdr].append(n);
n += 1;
}
println("\nMP: [n0..n4]\n== ========");
foreach mp in (table.keys.sort()){
println("%2d: %s".fmt(mp, table[mp][0,5])); //print first five values
}