60 lines
1.8 KiB
Plaintext
60 lines
1.8 KiB
Plaintext
digrt: Proc Options(main);
|
|
/* REXX ***************************************************************
|
|
* Test digroot
|
|
**********************************************************************/
|
|
|
|
Call digrtst('7');
|
|
Call digrtst('627615');
|
|
Call digrtst('39390');
|
|
Call digrtst('588225');
|
|
Call digrtst('393900588225');
|
|
|
|
digrtst: Proc(n);
|
|
Dcl n Char(100) Var;
|
|
Dcl dr Pic'9';
|
|
Dcl p Dec Fixed(5);
|
|
Call digroot(n,dr,p);
|
|
Put Edit(n,dr,p)(skip,a,col(20),f(1),f(3));
|
|
End;
|
|
|
|
digroot: Proc(n,dr,p);
|
|
/**********************************************************************
|
|
* Compute the digital root and persistence of the given decimal number
|
|
* 27.07.2012 Walter Pachl (derived from REXX)
|
|
**********************************************************************/
|
|
Dcl n Char(100) Var;
|
|
Dcl dr Pic'9';
|
|
Dcl p Dec Fixed(5);
|
|
Dcl s Pic'(14)Z9';
|
|
Dcl v Char(100) Var;
|
|
p=0;
|
|
v=strip(n); /* copy the number */
|
|
If length(v)=1 Then
|
|
dr=v;
|
|
Else Do;
|
|
Do While(length(v)>1); /* more than one digit in v */
|
|
s=0; /* initialize sum */
|
|
p+=1; /* increment persistence */
|
|
Do i=1 To length(v); /* loop over all digits */
|
|
dig=substr(v,i,1); /* pick a digit */
|
|
s=s+dig; /* add to the new sum */
|
|
End;
|
|
/*Put Skip Data(v,p,s);*/
|
|
v=strip(s); /* the 'new' number */
|
|
End;
|
|
dr=Decimal(s,1,0);
|
|
End;
|
|
Return;
|
|
End;
|
|
|
|
strip: Proc(x) Returns(Char(100) Var);
|
|
Dcl x Char(*);
|
|
Dcl res Char(100) Var Init('');
|
|
Do i=1 To length(x);
|
|
If substr(x,i,1)>' ' Then
|
|
res=res||substr(x,i,1);
|
|
End;
|
|
Return(res);
|
|
End;
|
|
End;
|