56 lines
1.2 KiB
Text
56 lines
1.2 KiB
Text
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;
|