langs a-z

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

@@ -0,0 +1,26 @@
+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);
+        ];
+]