RosettaCodeData/Task/Digital-root/XPL0/digital-root.xpl0

27 lines
778 B
Plaintext

include c:\cxpl\codes; \intrinsic 'code' declarations
func DRoot(N, B, P); \Return digital root and persistance P
real N, B; int P;
int S;
[P(0):= 0;
while N >= B do
[S:= 0;
repeat S:= S + fix(Mod(N,B)); \sum last digit
N:= N/B; \remove last digit
N:= N - Mod(N,1.);
until N < 0.1; \(beware of rounding errors)
P(0):= P(0)+1; \increment persistance
N:= float(S);
];
return fix(N);
];
real Tbl;
int I, Root, Pers;
[Tbl:= [627615., 39390., 588225., 393900588225.];
for I:= 0 to 4-1 do
[Root:= DRoot(Tbl(I), 10., @Pers);
IntOut(0, Pers); ChOut(0, ^ ); IntOut(0, Root); CrLf(0);
];
]