CDE

Task/Digital-root/REXX/digital-root-1.rexx

@@ -0,0 +1,27 @@
+/* REXX ***************************************************************
+* Test digroot
+**********************************************************************/
+                                                 /*           n r p */
+say right(7           ,12) digroot(7           ) /*           7 7 0 */
+say right(627615      ,12) digroot(627615      ) /*      627615 9 2 */
+say right(39390       ,12) digroot(39390       ) /*       39390 6 2 */
+say right(588225      ,12) digroot(588225      ) /*      588225 3 2 */
+say right(393900588225,12) digroot(393900588225) /*393900588225 9 2 */
+  Exit
+digroot: Procedure
+/**********************************************************************
+* Compute the digital root and persistence of the given decimal number
+* 25.07.2012 Walter Pachl
+**************************** Bottom of Data **************************/
+Parse Arg n                         /* the number                    */
+p=0                                 /* persistence                   */
+Do While length(n)>1                /* more than one digit in n      */
+  s=0                               /* initialize sum                */
+  p=p+1                             /* increment persistence         */
+  Do while n<>''                    /* as long as there are digits   */
+    Parse Var n c +1 n              /* pick the first one            */
+    s=s+c                           /* add to the new sum            */
+    End
+  n=s                               /* the 'new' number              */
+  End
+return n p                          /* return root and persistence   */

Task/Digital-root/REXX/digital-root-2.rexx

@@ -0,0 +1,21 @@
+/*REXX program calculates the  digital root  and  additive persistence. */
+numeric digits 1000                                /*lets handle biguns.*/
+say 'digital'                                      /*part of the header.*/
+say '  root  persistence' center('number',79)      /*  "   "  "     "   */
+say '═══════ ═══════════' center(''      ,79,'═')  /*  "   "  "     "   */
+call digRoot       627615
+call digRoot        39390
+call digRoot       588225
+call digRoot 393900588225
+call digRoot 899999999999999999999999999999999999999999999999999999999999999999999999999999999
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────DIGROOT subroutine──────────────────*/
+digRoot: procedure;  parse arg x 1 ox  /*get the num, save as original. */
+  do pers=0 while length(x)\==1;  r=0  /*keep summing until digRoot=1dig*/
+       do j=1 for length(x)            /*add each digit in the number.  */
+       r=r+substr(x,j,1)               /*add a digit to the digital root*/
+       end   /*j*/
+  x=r                                  /*'new' num, it may be multi-dig.*/
+  end        /*pers*/
+say center(x,7) center(pers,11) ox     /*show a nicely formatted line.  */
+return

Task/Digital-root/REXX/digital-root-3.rexx

@@ -0,0 +1,11 @@
+/*──────────────────────────────────DIGROOT subroutine──────────────────*/
+digRoot: procedure;  parse arg x 1 ox  /*get the num, save as original. */
+  do pers=0 while length(x)\==1;  r=0  /*keep summing until digRoot=1dig*/
+       do j=1 for length(x)            /*add each digit in the number.  */
+       ?=substr(x,j,1)                 /*pick off a char, maybe a dig ? */
+       if datatype(?,'W') then r=r+?   /*add a digit to the digital root*/
+       end   /*j*/
+  x=r                                  /*'new' num, it may be multi-dig.*/
+  end        /*pers*/
+say center(x,7) center(pers,11) ox     /*show a nicely formatted line.  */
+return