aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

27
Task/Digital-root/REXX/digital-root-1.rexx Normal file
View file

@ -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 */

19
Task/Digital-root/REXX/digital-root-2.rexx Normal file
View file

@ -0,0 +1,19 @@
/*REXX program calculates and displays the digital root and additive persistence. */
say 'digital additive' /*display the 1st line of the header.*/
say " root persistence" center('number',77) /* " " 2nd " " " " */
say "═══════ ═══════════" left('', 77, "═") /* " " 3rd " " " " */
say digRoot( 627615)
say digRoot( 39390)
say digRoot( 588225)
say digRoot( 393900588225)
say digRoot(89999999999999999999999999999999999999999999999999999999999999999999999999999)
say "═══════ ═══════════" left('', 77, "═") /*display the foot separator. */
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
digRoot: procedure; parse arg x 1 z; L= length(x) /*get a number & also another copy*/
do pers=1 until L==1; $= left(x, 1) /*sum until digRoot ≡ one digit. */
do j=2 for L-1; $= $+substr(x,j,1) /*add digits in the decimal number*/
end /*j*/
x= $; L= length(x) /*a new num, it may be multi─digit*/
end /*pers*/
return center(x, 7) center(pers, 11) z /*return a nicely formatted line. */

20
Task/Digital-root/REXX/digital-root-3.rexx Normal file
View file

@ -0,0 +1,20 @@
/*REXX program calculates and displays the digital root and additive persistence. */
say 'digital additive' /*display the 1st line of the header.*/
say " root persistence" center('number',77) /* " " 2nd " " " " */
say "═══════ ═══════════" left('', 77, "═") /* " " 3rd " " " " */
say digRoot( 627615)
say digRoot( 39390)
say digRoot( 588225)
say digRoot( 393900588225)
say digRoot(89999999999999999999999999999999999999999999999999999999999999999999999999999)
say "═══════ ═══════════" left('', 77, "═") /*display the foot separator. */
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
digRoot: procedure; parse arg x 1 ox; L=length(x) /*get a number and another copy. */
do pers=1 until L==1; $= 0 /*keep summing 'til digRoot≡1 dig*/
do j=1 for L; ?= substr(x, j, 1) /*add each digit in the dec. num.*/
if datatype(?, 'W') then $= $ + ? /*add a dec. dig to digital root.*/
end /*j*/
x= $; L=length(x) /*a new #, it may be multi─digit.*/
end /*pers*/
return center(x,7) center(pers,11) ox /*return a nicely formatted line.*/