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

2
Task/Digital-root/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Digital_root

24
Task/Digital-root/00-TASK.txt Normal file
View file

@ -0,0 +1,24 @@
The digital root, <math>X</math>, of a number, <math>n</math>, is calculated:
: find <math>X</math> as the sum of the digits of <math>n</math>
: find a new <math>X</math> by summing the digits of <math>X</math>, repeating until <math>X</math> has only one digit.
The additive persistence is the number of summations required to obtain the single digit.
The task is to calculate the additive persistence and the digital root of a number, e.g.:
:<math>627615</math> has additive persistence <math>2</math> and digital root of <math>9</math>;
:<math>39390</math> has additive persistence <math>2</math> and digital root of <math>6</math>;
:<math>588225</math> has additive persistence <math>2</math> and digital root of <math>3</math>;
:<math>393900588225</math> has additive persistence <math>2</math> and digital root of <math>9</math>;
The digital root may be calculated in bases other than 10.
;See:
* [[Casting out nines]] for this wiki's use of this procedure.
* [[Digital root/Multiplicative digital root]]
* [[Sum digits of an integer]]
* [[oeis:A010888|Digital root sequence on OEIS]]
* [[oeis:A031286|Additive persistence sequence on OEIS]]
* [[Iterated digits squaring]]
<br><br>

11
Task/Digital-root/11l/digital-root.11l Normal file
View file

@ -0,0 +1,11 @@
F digital_root(=n)
V ap = 0
L n >= 10
n = sum(String(n).map(digit -> Int(digit)))
ap++
R (ap, n)
L(n) [Int64(627615), 39390, 588225, 393900588225, 55]
Int64 persistance, root
(persistance, root) = digital_root(n)
print(‘#12 has additive persistance #2 and digital root #..’.format(n, persistance, root))

46
Task/Digital-root/360-Assembly/digital-root.360 Normal file
View file

@ -0,0 +1,46 @@
* Digital root 21/04/2017
DIGROOT CSECT
USING DIGROOT,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R6,1 i=1
DO WHILE=(C,R6,LE,=A((PG-T)/4)) do i=1 to hbound(t)
LR R1,R6 i
SLA R1,2 *4
L R10,T-4(R1) nn=t(i)
LR R7,R10 n=nn
SR R9,R9 ap=0
DO WHILE=(C,R7,GE,=A(10)) do while(n>=10)
SR R8,R8 x=0
DO WHILE=(C,R7,GE,=A(10)) do while(n>=10)
LR R4,R7 n
SRDA R4,32 >>r5
D R4,=A(10) m=n//10
LR R7,R5 n=n/10
AR R8,R4 x=x+m
ENDDO , end
AR R7,R8 n=x+n
LA R9,1(R9) ap=ap+1
ENDDO , end
XDECO R10,XDEC nn
MVC PG+7(10),XDEC+2
XDECO R9,XDEC ap
MVC PG+31(3),XDEC+9
XDECO R7,XDEC n
MVC PG+41(1),XDEC+11
XPRNT PG,L'PG print
LA R6,1(R6) i++
ENDDO , enddo i
L R13,4(0,R13) restore previous savearea pointer
LM R14,R12,12(R13) restore previous context
XR R15,R15 rc=0
BR R14 exit
T DC F'627615',F'39390',F'588225',F'2147483647'
PG DC CL80'number=xxxxxxxxxx persistence=xxx root=x'
XDEC DS CL12
YREGS
END DIGROOT

34
Task/Digital-root/ALGOL-68/digital-root.alg Normal file
View file

@ -0,0 +1,34 @@
# calculates the digital root and persistance of n #
PROC digital root = ( LONG LONG INT n, REF INT root, persistance )VOID:
BEGIN
LONG LONG INT number := ABS n;
persistance := 0;
WHILE persistance PLUSAB 1;
LONG LONG INT digit sum := 0;
WHILE number > 0
DO
digit sum PLUSAB number MOD 10;
number OVERAB 10
OD;
number := digit sum;
number > 9
DO
SKIP
OD;
root := SHORTEN SHORTEN number
END; # digital root #
# calculates and prints the digital root and persistace of number #
PROC print digital root and persistance = ( LONG LONG INT number )VOID:
BEGIN
INT root, persistance;
digital root( number, root, persistance );
print( ( whole( number, -15 ), " root: ", whole( root, 0 ), " persistance: ", whole( persistance, -3 ), newline ) )
END; # print digital root and persistance #
# test the digital root proc #
BEGIN print digital root and persistance( 627615 )
; print digital root and persistance( 39390 )
; print digital root and persistance( 588225 )
; print digital root and persistance( 393900588225 )
END

63
Task/Digital-root/ALGOL-W/digital-root.alg Normal file
View file

@ -0,0 +1,63 @@
begin
% calculates the digital root and persistence of an integer in base 10 %
% in order to allow for numbers larger than 2^31, the number is passed %
% as the lower and upper digits e.g. 393900588225 can be processed by %
% specifying upper = 393900, lower = 58825 %
procedure findDigitalRoot( integer value upper, lower
; integer result digitalRoot, persistence
) ;
begin
integer procedure sumDigits( integer value n ) ;
begin
integer digits, sum;
digits := abs n;
sum := 0;
while digits > 0
do begin
sum := sum + ( digits rem 10 );
digits := digits div 10
end % while digits > 0 % ;
% result: % sum
end sumDigits;
digitalRoot := sumDigits( upper ) + sumDigits( lower );
persistence := 1;
while digitalRoot > 9
do begin
persistence := persistence + 1;
digitalRoot := sumDigits( digitalRoot );
end % while digitalRoot > 9 % ;
end findDigitalRoot ;
% calculates and prints the digital root and persistence %
procedure printDigitalRootAndPersistence( integer value upper, lower ) ;
begin
integer digitalRoot, persistence;
findDigitalRoot( upper, lower, digitalRoot, persistence );
write( s_w := 0 % set field saeparator width for this statement %
, i_w := 8 % set integer field width for this statement %
, upper
, ", "
, lower
, i_w := 2 % change integer field width %
, ": digital root: "
, digitalRoot
, ", persistence: "
, persistence
)
end printDigitalRootAndPersistence ;
% test the digital root and persistence procedures %
printDigitalRootAndPersistence( 0, 627615 );
printDigitalRootAndPersistence( 0, 39390 );
printDigitalRootAndPersistence( 0, 588225 );
printDigitalRootAndPersistence( 393900, 588225 )
end.

28
Task/Digital-root/ASIC/digital-root.asic Normal file
View file

@ -0,0 +1,28 @@
REM Digital root
DATA 1&, 14&, 267&, 8128&, 39390&, 588225&, 627615&
FOR I = 0 TO 6
READ A&
N& = A&
Base = 10
GOSUB CalcDRootAndPers:
PRINT A&;
PRINT Pers;
PRINT Root
NEXT I
END
CalcDRootAndPers:
REM Results: Root - digital root; Pers - persistance
Pers = 0
WHILE N& >= Base
S = 0
Loop:
NModBase& = N& MOD Base
S = S + NModBase&
N& = N& / Base
IF N& > 0 THEN Loop:
Pers = Pers + 1
N& = S
WEND
Root = N&
RETURN

25
Task/Digital-root/AWK/digital-root.awk Normal file
View file

@ -0,0 +1,25 @@
# syntax: GAWK -f DIGITAL_ROOT.AWK
BEGIN {
n = split("627615,39390,588225,393900588225,10,199",arr,",")
for (i=1; i<=n; i++) {
dr = digitalroot(arr[i],10)
printf("%12.0f has additive persistence %d and digital root of %d\n",arr[i],p,dr)
}
exit(0)
}
function digitalroot(n,b) {
p = 0 # global
while (n >= b) {
p++
n = digitsum(n,b)
}
return(n)
}
function digitsum(n,b, q,s) {
while (n != 0) {
q = int(n / b)
s += n - q * b
n = q
}
return(s)
}

15
Task/Digital-root/Ada/digital-root-1.ada Normal file
View file

@ -0,0 +1,15 @@
package Generic_Root is
type Number is range 0 .. 2**63-1;
type Number_Array is array(Positive range <>) of Number;
type Base_Type is range 2 .. 16; -- any reasonable base to write down numb
generic
with function "&"(X, Y: Number) return Number;
-- instantiate with "+" for additive digital roots
-- instantiate with "*" for multiplicative digital roots
procedure Compute_Root(N: Number;
Root, Persistence: out Number;
Base: Base_Type := 10);
-- computes Root and Persistence of N;
end Generic_Root;

26
Task/Digital-root/Ada/digital-root-2.ada Normal file
View file

@ -0,0 +1,26 @@
package body Generic_Root is
procedure Compute_Root(N: Number;
Root, Persistence: out Number;
Base: Base_Type := 10) is
function Digit_Sum(N: Number) return Number is
begin
if N < Number(Base) then
return N;
else
return (N mod Number(Base)) & Digit_Sum(N / Number(Base));
end if;
end Digit_Sum;
begin
if N < Number(Base) then
Root := N;
Persistence := 0;
else
Compute_Root(Digit_Sum(N), Root, Persistence, Base);
Persistence := Persistence + 1;
end if;
end Compute_Root;
end Generic_Root;

26
Task/Digital-root/Ada/digital-root-3.ada Normal file
View file

@ -0,0 +1,26 @@
with Generic_Root, Ada.Text_IO; use Generic_Root;
procedure Digital_Root is
procedure Compute is new Compute_Root("+");
-- "+" for additive digital roots
package TIO renames Ada.Text_IO;
procedure Print_Roots(Inputs: Number_Array; Base: Base_Type) is
package NIO is new TIO.Integer_IO(Number);
Root, Pers: Number;
begin
for I in Inputs'Range loop
Compute(Inputs(I), Root, Pers, Base);
NIO.Put(Inputs(I), Base => Integer(Base), Width => 12);
NIO.Put(Root, Base => Integer(Base), Width => 9);
NIO.Put(Pers, Base => Integer(Base), Width => 12);
TIO.Put_Line(" " & Base_Type'Image(Base));
end loop;
end Print_Roots;
begin
TIO.Put_Line(" Number Root Persistence Base");
Print_Roots((961038, 923594037444, 670033, 448944221089), Base => 10);
Print_Roots((16#7e0#, 16#14e344#, 16#12343210#), Base => 16);
end Digital_Root;

22
Task/Digital-root/AppleScript/digital-root-1.applescript Normal file
View file

@ -0,0 +1,22 @@
on digitalroot(N as integer)
script math
to sum(L)
if L = {} then return 0
(item 1 of L) + sum(rest of L)
end sum
end script
set i to 0
set M to N
repeat until M < 10
set digits to the characters of (M as text)
set M to math's sum(digits)
set i to i + 1
end repeat
{N:N, persistences:i, root:M}
end digitalroot
digitalroot(627615)

334
Task/Digital-root/AppleScript/digital-root-2.applescript Normal file
View file

@ -0,0 +1,334 @@
-------------------------- TESTS --------------------------
on run
set firstCol to justifyRight(18, space)
script test
on |λ|(x)
firstCol's |λ|(str(x)) & ¬
" -> " & showTuple(digitalRoot(10)'s |λ|(x))
end |λ|
end script
unlines({"Base 10:", firstCol's |λ|("Integer") & ¬
" -> (additive persistance, digital root)"} & ¬
map(test, ¬
{627615, 39390, 588225, 3.93900588225E+11}))
end run
---------------- DIGITAL ROOTS IN ANY BASE ----------------
-- digitalRoot :: Int -> Int -> (Int, Int)
on digitalRoot(base)
script p
on |λ|(x)
snd(x) ≥ base
end |λ|
end script
script
on |λ|(n)
next(dropWhile(p, ¬
iterate(bimap(my succ, digitalSum(base)), ¬
Tuple(0, n))))
end |λ|
end script
end digitalRoot
-- digitalSum :: Int -> Int -> Int
on digitalSum(base)
script
on |λ|(n)
script go
on |λ|(x)
if x > 0 then
Just(Tuple(x mod base, x div base))
else
Nothing()
end if
end |λ|
end script
sum(unfoldr(go, n))
end |λ|
end script
end digitalSum
-------------------- GENERIC FUNCTIONS --------------------
-- Just :: a -> Maybe a
on Just(x)
-- Constructor for an inhabited Maybe (option type) value.
-- Wrapper containing the result of a computation.
{type:"Maybe", Nothing:false, Just:x}
end Just
-- Nothing :: Maybe a
on Nothing()
-- Constructor for an empty Maybe (option type) value.
-- Empty wrapper returned where a computation is not possible.
{type:"Maybe", Nothing:true}
end Nothing
-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
-- Constructor for a pair of values, possibly of two different types.
{type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple
-- bimap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
on bimap(f, g)
-- Tuple instance of bimap.
-- A tuple of the application of f and g to the
-- first and second values of tpl respectively.
script
on |λ|(x)
Tuple(|λ|(fst(x)) of mReturn(f), ¬
|λ|(snd(x)) of mReturn(g))
end |λ|
end script
end bimap
-- cons :: a -> [a] -> [a]
on cons(x, xs)
set c to class of xs
if list is c then
{x} & xs
else if script is c then
script
property pRead : false
on |λ|()
if pRead then
|λ|() of xs
else
set pRead to true
return x
end if
end |λ|
end script
else
x & xs
end if
end cons
-- dropWhile :: (a -> Bool) -> Gen [a] -> [a]
on dropWhile(p, xs)
set v to |λ|() of xs
tell mReturn(p)
repeat while (|λ|(v))
set v to xs's |λ|()
end repeat
end tell
return cons(v, xs)
end dropWhile
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- fst :: (a, b) -> a
on fst(tpl)
if class of tpl is record then
|1| of tpl
else
item 1 of tpl
end if
end fst
-- iterate :: (a -> a) -> a -> Gen [a]
on iterate(f, x)
script
property v : missing value
property g : mReturn(f)
on |λ|()
if missing value is v then
set v to x
else
set v to g's |λ|(v)
end if
return v
end |λ|
end script
end iterate
-- justifyRight :: Int -> Char -> String -> String
on justifyRight(n, cFiller)
script
on |λ|(s)
if n > length of s then
text -n thru -1 of ((replicate(n, cFiller) as text) & s)
else
strText
end if
end |λ|
end script
end justifyRight
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of xs.
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- min :: Ord a => a -> a -> a
on min(x, y)
if y < x then
y
else
x
end if
end min
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
-- 2nd class handler function lifted into 1st class script wrapper.
if script is class of f then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- next :: Gen [a] -> a
on next(xs)
|λ|() of xs
end next
-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
set out to {}
if 1 > n then return out
set dbl to {a}
repeat while (1 < n)
if 0 < (n mod 2) then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
-- showTuple :: Tuple -> String
on showTuple(tpl)
"(" & str(fst(tpl)) & ", " & str(snd(tpl)) & ")"
end showTuple
-- snd :: (a, b) -> b
on snd(tpl)
if class of tpl is record then
|2| of tpl
else
item 2 of tpl
end if
end snd
-- str :: a -> String
on str(x)
x as string
end str
-- succ :: Enum a => a -> a
on succ(x)
1 + x
end succ
-- sum :: [Num] -> Num
on sum(xs)
script add
on |λ|(a, b)
a + b
end |λ|
end script
foldl(add, 0, xs)
end sum
-- take :: Int -> Gen [a] -> [a]
on take(n, xs)
set ys to {}
repeat with i from 1 to n
set v to |λ|() of xs
if missing value is v then
return ys
else
set end of ys to v
end if
end repeat
return ys
end take
-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- > [10,9,8,7,6,5,4,3,2,1]
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
on unfoldr(f, v)
set xr to {v, v} -- (value, remainder)
set xs to {}
tell mReturn(f)
repeat -- Function applied to remainder.
set mb to |λ|(snd(xr))
if Nothing of mb then
exit repeat
else -- New (value, remainder) tuple,
set xr to Just of mb
-- and value appended to output list.
set end of xs to fst(xr)
end if
end repeat
end tell
return xs
end unfoldr
-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation
-- of a list of strings with the newline character.
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set s to xs as text
set my text item delimiters to dlm
s
end unlines

87
Task/Digital-root/Applesoft-BASIC/digital-root.basic Normal file
View file

@ -0,0 +1,87 @@
1 GOSUB 430"BASE SETUP
2 FOR E = 0 TO 1 STEP 0
3 GOSUB 7"READ
4 ON E + 1 GOSUB 50, 10
5 NEXT E
6 END
7 READ N$
8 E = N$ = ""
9 RETURN
10 GOSUB 7"READ BASE
20 IF E THEN RETURN
30 BASE = VAL(N$)
40 READ N$
50 GOSUB 100"DIGITAL ROOT
60 GOSUB 420: PRINT " HAS AD";
70 PRINT "DITIVE PERSISTENCE";
80 PRINT " "P" AND DIGITAL R";
90 PRINT "OOT "X$";" : RETURN
REM DIGITAL ROOT OF N$, RETURNS X$ AND P
100 P = 0 : L = LEN(N$)
110 X$ = MID$(N$, 2, L - 1)
120 N = LEFT$(X$, 1) = "-"
130 IF NOT N THEN X$ = N$
140 FOR P = 0 TO 1E38
150 L = LEN(X$)
160 IF L < 2 THEN RETURN
170 GOSUB 200"DIGIT SUM
180 X$ = S$
190 NEXT P : STOP
REM DIGIT SUM OF X$, RETURNS S$
200 S$ = "0"
210 R$ = X$
220 L = LEN(R$)
230 FOR L = L TO 1 STEP -1
240 E$ = "" : V$ = RIGHT$(R$, 1)
250 GOSUB 400 : S = LEN(S$)
260 ON R$ <> "0" GOSUB 300
270 R$ = MID$(R$, 1, L - 1)
280 NEXT L
290 RETURN
REM ADD V TO S$
300 FOR C = V TO 0 STEP 0
310 V$ = RIGHT$(S$, 1)
320 GOSUB 400 : S = S - 1
330 S$ = MID$(S$, 1, S)
340 V = V + C : C = V >= BASE
350 IF C THEN V = V - BASE
360 GOSUB 410 : E$ = V$ + E$
370 IF S THEN NEXT C
380 IF C THEN S$ = "1"
390 S$ = S$ + E$ : RETURN
REM BASE VAL
400 V = V(ASC(V$)) : RETURN
REM BASE STR$
410 V$ = V$(V) : RETURN
REM BASE DISPLAY
420 PRINT N$;
421 IF BASE = 10 THEN RETURN
422 PRINT "("BASE")";
423 RETURN
REM BASE SETUP
430 IF BASE = 0 THEN BASE = 10
440 DIM V(127), V$(35)
450 FOR I = 0 TO 35
460 V = 55 + I - (I < 10) * 7
470 V$(I) = CHR$(V)
480 V(V) = I
490 NEXT I : RETURN
500 DATA627615,39390,588225
510 DATA393900588225
1000 DATA,30
1010 DATADIGITALROOT
63999DATA,

13
Task/Digital-root/Arturo/digital-root.arturo Normal file
View file

@ -0,0 +1,13 @@
droot: function [num][
persistence: 0
until [
num: sum to [:integer] split to :string num
persistence: persistence + 1
][ num < 10 ]
return @[num, persistence]
]
loop [627615, 39390, 588225, 393900588225] 'i [
a: droot i
print [i "has additive persistence" a\0 "and digital root of" a\1]
]

18
Task/Digital-root/AutoHotkey/digital-root.ahk Normal file
View file

@ -0,0 +1,18 @@
p := {}
for key, val in [30,1597,381947,92524902,448944221089]
{
n := val
while n > 9
{
m := 0
Loop, Parse, n
m += A_LoopField
n := m, i := A_Index
}
p[A_Index] := [val, n, i]
}
for key, val in p
Output .= val[1] ": Digital Root = " val[2] ", Additive Persistence = " val[3] "`n"
MsgBox, 524288, , % Output

24
Task/Digital-root/BASIC/digital-root.basic Normal file
View file

@ -0,0 +1,24 @@
DECLARE SUB digitalRoot (what AS LONG)
'test inputs:
digitalRoot 627615
digitalRoot 39390
digitalRoot 588225
SUB digitalRoot (what AS LONG)
DIM w AS LONG, t AS LONG, c AS INTEGER
w = ABS(what)
IF w > 10 THEN
DO
c = c + 1
WHILE w
t = t + (w MOD (10))
w = w \ 10
WEND
w = t
t = 0
LOOP WHILE w > 9
END IF
PRINT what; ": additive persistance "; c; ", digital root "; w
END SUB

29
Task/Digital-root/BBC-BASIC/digital-root.basic Normal file
View file

@ -0,0 +1,29 @@
*FLOAT64
PRINT "Digital root of 627615 is "; FNdigitalroot(627615, 10, p) ;
PRINT " (additive persistence " ; p ")"
PRINT "Digital root of 39390 is "; FNdigitalroot(39390, 10, p) ;
PRINT " (additive persistence " ; p ")"
PRINT "Digital root of 588225 is "; FNdigitalroot(588225, 10, p) ;
PRINT " (additive persistence " ; p ")"
PRINT "Digital root of 393900588225 is "; FNdigitalroot(393900588225, 10, p) ;
PRINT " (additive persistence " ; p ")"
PRINT "Digital root of 9992 is "; FNdigitalroot(9992, 10, p) ;
PRINT " (additive persistence " ; p ")"
END
DEF FNdigitalroot(n, b, RETURN c)
c = 0
WHILE n >= b
c += 1
n = FNdigitsum(n, b)
ENDWHILE
= n
DEF FNdigitsum(n, b)
LOCAL q, s
WHILE n <> 0
q = INT(n / b)
s += n - q * b
n = q
ENDWHILE
= s

8
Task/Digital-root/BQN/digital-root-1.bqn Normal file
View file

@ -0,0 +1,8 @@
DSum ← +´10{⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}
Root ← 0⊸{(×○⌊÷⟜10)◶⟨𝕨‿𝕩,(1+𝕨)⊸𝕊 Dsum⟩𝕩}
P ← •Show ⊢∾Root
P 627615
P 39390
P 588225
P 393900588225

4
Task/Digital-root/BQN/digital-root-2.bqn Normal file
View file

@ -0,0 +1,4 @@
⟨ 627615 2 9 ⟩
⟨ 39390 2 6 ⟩
⟨ 588225 2 3 ⟩
⟨ 393900588225 2 9 ⟩

40
Task/Digital-root/Batch-File/digital-root.bat Normal file
View file

@ -0,0 +1,40 @@
:: Digital Root Task from Rosetta Code Wiki
:: Batch File Implementation
:: (Base 10)
@echo off
setlocal enabledelayedexpansion
:: THE MAIN THING
for %%x in (9876543214 393900588225 1985989328582 34559) do call :droot %%x
echo(
pause
exit /b
:: /THE MAIN THING
:: THE FUNCTION
:droot
set inp2sum=%1
set persist=1
:cyc1
set sum=0
set scan_digit=0
:cyc2
set digit=!inp2sum:~%scan_digit%,1!
if "%digit%"=="" (goto :sumdone)
set /a sum+=%digit%
set /a scan_digit+=1
goto :cyc2
:sumdone
if %sum% lss 10 (
echo(
echo ^(%1^)
echo Additive Persistence=%persist% Digital Root=%sum%.
goto :EOF
)
set /a persist+=1
set inp2sum=%sum%
goto :cyc1
:: /THE FUNCTION

8
Task/Digital-root/Befunge/digital-root.bf Normal file
View file

@ -0,0 +1,8 @@
0" :rebmun retnE">:#,_0 0v
v\1:/+55p00<v\`\0::-"0"<~<
#>:55+%00g+^>9`+#v_+\ 1+\^
>|`9:p000<_v#`1\$< v"gi"<
|> \ 1 + \ >0" :toor lat"^
>$$00g\1+^@,+<v"Di",>#+ 5<
>:#,_$ . 5 5 ^>:#,_\.55+,v
^"Additive Persistence: "<

29
Task/Digital-root/Bracmat/digital-root.bracmat Normal file
View file

@ -0,0 +1,29 @@
( root
= sum persistence n d
. !arg:(~>9.?)
| !arg:(?n.?persistence)
& 0:?sum
& ( @( !n
: ?
(#%@?d&!d+!sum:?sum&~)
?
)
| root$(!sum.!persistence+1)
)
)
& ( 627615 39390 588225 393900588225 10 199
: ?
( #%@?N
& root$(!N.0):(?Sum.?Persistence)
& out
$ ( !N
"has additive persistence"
!Persistence
"and digital root of"
!Sum
)
& ~
)
?
| done
);

30
Task/Digital-root/C++/digital-root.cpp Normal file
View file

@ -0,0 +1,30 @@
// Calculate the Digital Root and Additive Persistance of an Integer - Compiles with gcc4.7
//
// Nigel Galloway. July 23rd., 2012
//
#include <iostream>
#include <cmath>
#include <utility>
template<class P_> P_ IncFirst(const P_& src) {return P_(src.first + 1, src.second);}
std::pair<int, int> DigitalRoot(unsigned long long digits, int base = 10)
{
int x = SumDigits(digits, base);
return x < base ? std::make_pair(1, x) : IncFirst(DigitalRoot(x, base)); // x is implicitly converted to unsigned long long; this is lossless
}
int main() {
const unsigned long long ip[] = {961038,923594037444,670033,448944221089};
for (auto i:ip){
auto res = DigitalRoot(i);
std::cout << i << " has digital root " << res.second << " and additive persistance " << res.first << "\n";
}
std::cout << "\n";
const unsigned long long hip[] = {0x7e0,0x14e344,0xd60141,0x12343210};
for (auto i:hip){
auto res = DigitalRoot(i,16);
std::cout << std::hex << i << " has digital root " << res.second << " and additive persistance " << res.first << "\n";
}
return 0;
}

24
Task/Digital-root/C-sharp/digital-root.cs Normal file
View file

@ -0,0 +1,24 @@
using System;
using System.Linq;
class Program
{
static Tuple<int, int> DigitalRoot(long num)
{
int additivepersistence = 0;
while (num > 9)
{
num = num.ToString().ToCharArray().Sum(x => x - '0');
additivepersistence++;
}
return new Tuple<int, int>(additivepersistence, (int)num);
}
static void Main(string[] args)
{
foreach (long num in new long[] { 627615, 39390, 588225, 393900588225 })
{
var t = DigitalRoot(num);
Console.WriteLine("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2);
}
}
}

26
Task/Digital-root/C/digital-root.c Normal file
View file

@ -0,0 +1,26 @@
#include <stdio.h>
int droot(long long int x, int base, int *pers)
{
int d = 0;
if (pers)
for (*pers = 0; x >= base; x = d, (*pers)++)
for (d = 0; x; d += x % base, x /= base);
else if (x && !(d = x % (base - 1)))
d = base - 1;
return d;
}
int main(void)
{
int i, d, pers;
long long x[] = {627615, 39390, 588225, 393900588225LL};
for (i = 0; i < 4; i++) {
d = droot(x[i], 10, &pers);
printf("%lld: pers %d, root %d\n", x[i], pers, d);
}
return 0;
}

31
Task/Digital-root/CLU/digital-root.clu Normal file
View file

@ -0,0 +1,31 @@
sum_digits = proc (n, base: int) returns (int)
sum: int := 0
while n > 0 do
sum := sum + n // base
n := n / base
end
return (sum)
end sum_digits
digital_root = proc (n, base: int) returns (int, int)
persistence: int := 0
while n >= base do
persistence := persistence + 1
n := sum_digits(n, base)
end
return (n, persistence)
end digital_root
start_up = proc ()
po: stream := stream$primary_output()
tests: array[int] := array[int]$[627615, 39390, 588225, 393900588225]
for test: int in array[int]$elements(tests) do
root, persistence: int := digital_root(test, 10)
stream$putl(po, int$unparse(test)
|| " has additive persistence "
|| int$unparse(persistence)
|| " and digital root of "
|| int$unparse(root))
end
end start_up

45
Task/Digital-root/COBOL/digital-root.cobol Normal file
View file

@ -0,0 +1,45 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. DIGITAL-ROOT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 VARIABLES.
03 INPUT-NUMBER PIC 9(16).
03 INPUT-DIGITS REDEFINES INPUT-NUMBER,
PIC 9 OCCURS 16 TIMES.
03 DIGIT-SUM PIC 999.
03 DIGIT-NO PIC 99.
03 PERSISTENCE PIC 9.
01 OUTPUT-FORMAT.
03 O-NUMBER PIC Z(15)9.
03 FILLER PIC X(16) VALUE ': PERSISTENCE = '.
03 O-PERSISTENCE PIC Z9.
03 FILLER PIC X(9) VALUE ', ROOT = '.
03 O-ROOT PIC Z9.
PROCEDURE DIVISION.
BEGIN.
MOVE 627615 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
MOVE 39390 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
MOVE 588225 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
MOVE 393900588225 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
STOP RUN.
FIND-DIGITAL-ROOT.
MOVE ZERO TO PERSISTENCE.
MOVE INPUT-NUMBER TO O-NUMBER.
PERFORM SUMMATION UNTIL INPUT-NUMBER IS LESS THAN 10.
MOVE INPUT-NUMBER TO O-ROOT.
MOVE PERSISTENCE TO O-PERSISTENCE.
DISPLAY OUTPUT-FORMAT.
SUMMATION.
MOVE ZERO TO DIGIT-SUM.
ADD 1 TO PERSISTENCE.
PERFORM ADD-DIGIT VARYING DIGIT-NO FROM 1 BY 1
UNTIL DIGIT-NO IS GREATER THAN 16.
MOVE DIGIT-SUM TO INPUT-NUMBER.
ADD-DIGIT.
ADD INPUT-DIGITS(DIGIT-NO) TO DIGIT-SUM.

12
Task/Digital-root/Clojure/digital-root.clj Normal file
View file

@ -0,0 +1,12 @@
(defn dig-root [value]
(let [digits (fn [n]
(map #(- (byte %) (byte \0))
(str n)))
sum (fn [nums]
(reduce + nums))]
(loop [n value
step 0]
(if (< n 10)
{:n value :add-persist step :digital-root n}
(recur (sum (digits n))
(inc step))))))

11
Task/Digital-root/Common-Lisp/digital-root.lisp Normal file
View file

@ -0,0 +1,11 @@
(defun digital-root (number &optional (base 10))
(loop for n = number then s
for ap = 1 then (1+ ap)
for s = (sum-digits n base)
when (< s base)
return (values s ap)))
(loop for (nr base) in '((627615 10) (393900588225 10) (#X14e344 16) (#36Rdg9r 36))
do (multiple-value-bind (dr ap) (digital-root nr base)
(format T "~vR (base ~a): additive persistence = ~a, digital root = ~vR~%"
base nr base ap base dr)))

40
Task/Digital-root/Component-Pascal/digital-root.pas Normal file
View file

@ -0,0 +1,40 @@
MODULE DigitalRoot;
IMPORT StdLog, Strings, TextMappers, DevCommanders;
PROCEDURE CalcDigitalRoot(x: LONGINT; OUT dr,pers: LONGINT);
VAR
str: ARRAY 64 OF CHAR;
i: INTEGER;
BEGIN
dr := 0;pers := 0;
LOOP
Strings.IntToString(x,str);
IF LEN(str$) = 1 THEN dr := x ;EXIT END;
i := 0;dr := 0;
WHILE (i < LEN(str$)) DO
INC(dr,ORD(str[i]) - ORD('0'));
INC(i)
END;
INC(pers);
x := dr
END;
END CalcDigitalRoot;
PROCEDURE Do*;
VAR
dr,pers: LONGINT;
s: TextMappers.Scanner;
BEGIN
s.ConnectTo(DevCommanders.par.text);
s.SetPos(DevCommanders.par.beg);
REPEAT
s.Scan;
IF (s.type = TextMappers.int) OR (s.type = TextMappers.lint) THEN
CalcDigitalRoot(s.int,dr,pers);
StdLog.Int(s.int);
StdLog.String(" Digital root: ");StdLog.Int(dr);
StdLog.String(" Persistence: ");StdLog.Int(pers);StdLog.Ln
END
UNTIL s.rider.eot;
END Do;
END DigitalRoot.

38
Task/Digital-root/Cowgol/digital-root.cowgol Normal file
View file

@ -0,0 +1,38 @@
include "cowgol.coh";
# Calculate the digital root and additive persistance of a number
# in a given base
sub digital_root(n: uint32, base: uint32): (root: uint32, pers: uint8) is
pers := 0;
while base < n loop
var step: uint32 := 0;
while n > 0 loop
step := step + (n % base);
n := n / base;
end loop;
pers := pers + 1;
n := step;
end loop;
root := n;
end sub;
# Print digital root and persistence (in base 10)
sub test(n: uint32) is
var root: uint32;
var pers: uint8;
(root, pers) := digital_root(n, 10);
print_i32(n);
print(": root = ");
print_i32(root);
print(", persistence = ");
print_i8(pers);
print_nl();
end sub;
test(4);
test(627615);
test(39390);
test(588225);
test(9992);

13
Task/Digital-root/Crystal/digital-root-1.crystal Normal file
View file

@ -0,0 +1,13 @@
def digital_root(n : Int, base = 10) : Int
max_single_digit = base - 1
n = n.abs
if n > max_single_digit
n = 1 + (n - 1) % max_single_digit
end
n
end
puts digital_root 627615
puts digital_root 39390
puts digital_root 588225
puts digital_root 7, base: 3

18
Task/Digital-root/Crystal/digital-root-2.crystal Normal file
View file

@ -0,0 +1,18 @@
def digital_root_with_persistence(n : Int) : {Int32, Int32}
n = n.abs
persistence = 0
until n <= 9
persistence += 1
digit_sum = (0..(Math.log10(n).floor.to_i)).sum { |i| (n % 10**(i + 1) - n % 10**i) // 10**i }
n = digit_sum
end
{n, persistence}
end
puts digital_root_with_persistence 627615
puts digital_root_with_persistence 39390
puts digital_root_with_persistence 588225

18
Task/Digital-root/Crystal/digital-root-3.crystal Normal file
View file

@ -0,0 +1,18 @@
def digital_root_with_persistence_to_s(n : Int) : {Int32, Int32}
n = n.abs
persistence = 0
until n <= 9
persistence += 1
digit_sum = n.to_s.chars.sum &.to_i
n = digit_sum
end
{n, persistence}
end
puts digital_root_with_persistence_to_s 627615
puts digital_root_with_persistence_to_s 39390
puts digital_root_with_persistence_to_s 588225

36
Task/Digital-root/D/digital-root.d Normal file
View file

@ -0,0 +1,36 @@
import std.stdio, std.typecons, std.conv, std.bigint, std.math,
std.traits;
Tuple!(uint, Unqual!T) digitalRoot(T)(in T inRoot, in uint base)
pure nothrow
in {
assert(base > 1);
} body {
Unqual!T root = inRoot.abs;
uint persistence = 0;
while (root >= base) {
auto num = root;
root = 0;
while (num != 0) {
root += num % base;
num /= base;
}
persistence++;
}
return typeof(return)(persistence, root);
}
void main() {
enum f1 = "%s(%d): additive persistance= %d, digital root= %d";
foreach (immutable b; [2, 3, 8, 10, 16, 36]) {
foreach (immutable n; [5, 627615, 39390, 588225, 393900588225])
writefln(f1, text(n, b), b, n.digitalRoot(b)[]);
writeln;
}
enum f2 = "<BIG>(%d): additive persistance= %d, digital root= %d";
immutable n = BigInt("581427189816730304036810394583022044713" ~
"00738980834668522257090844071443085937");
foreach (immutable b; [2, 3, 8, 10, 16, 36])
writefln(f2, b, n.digitalRoot(b)[]); // Shortened output.
}

18
Task/Digital-root/DCL/digital-root.dcl Normal file
View file

@ -0,0 +1,18 @@
$ x = p1
$ count = 0
$ sum = x
$ loop1:
$ length = f$length( x )
$ if length .eq. 1 then $ goto done
$ i = 0
$ sum = 0
$ loop2:
$ digit = f$extract( i, 1, x )
$ sum = sum + digit
$ i = i + 1
$ if i .lt. length then $ goto loop2
$ x = f$string( sum )
$ count = count + 1
$ goto loop1
$ done:
$ write sys$output p1, " has additive persistence ", count, " and digital root of ", sum

1
Task/Digital-root/Dc/digital-root.dc Normal file
View file

@ -0,0 +1 @@
?[10~rd10<p]sp[+z1<q]sq[lpxlqxd10<r]dsrxp

21
Task/Digital-root/EasyLang/digital-root.easy Normal file
View file

@ -0,0 +1,21 @@
proc digitalRoot n . x persistence .
numberString$ = n
currentPersist = 0
while len numberString$ > 1
for i = 1 to len numberString$
sum += number substr numberString$ i 1
.
numberString$ = sum
currentPersist += 1
sum = 0
.
x = number numberString$
persistence = currentPersist
.
numbers[] = [ 627615 39390 588225 393900588225 ]
for i in numbers[]
call digitalRoot i x persistence
print i
print "Additive persistence: " & persistence
print "Digital root: " & x
.

69
Task/Digital-root/Eiffel/digital-root.e Normal file
View file

@ -0,0 +1,69 @@
class
APPLICATION
inherit
ARGUMENTS
create
make
feature {NONE} -- Initialization
digital_root_test_values: ARRAY [INTEGER_64]
-- Test values.
once
Result := <<670033, 39390, 588225, 393900588225>> -- base 10
end
digital_root_expected_result: ARRAY [INTEGER_64]
-- Expected result values.
once
Result := <<1, 6, 3, 9>> -- base 10
end
make
local
results: ARRAY [INTEGER_64]
i: INTEGER
do
from
i := 1
until
i > digital_root_test_values.count
loop
results := compute_digital_root (digital_root_test_values [i], 10)
if results [2] ~ digital_root_expected_result [i] then
print ("%N" + digital_root_test_values [i].out + " has additive persistence " + results [1].out + " and digital root " + results [2].out)
else
print ("Error in the calculation of the digital root of " + digital_root_test_values [i].out + ". Expected value: " + digital_root_expected_result [i].out + ", produced value: " + results [2].out)
end
i := i + 1
end
end
compute_digital_root (a_number: INTEGER_64; a_base: INTEGER): ARRAY [INTEGER_64]
-- Returns additive persistence and digital root of `a_number' using `a_base'.
require
valid_number: a_number >= 0
valid_base: a_base > 1
local
temp_num: INTEGER_64
do
create Result.make_filled (0, 1, 2)
from
Result [2] := a_number
until
Result [2] < a_base
loop
from
temp_num := Result [2]
Result [2] := 0
until
temp_num = 0
loop
Result [2] := Result [2] + (temp_num \\ a_base)
temp_num := temp_num // a_base
end
Result [1] := Result [1] + 1
end
end

31
Task/Digital-root/Elena/digital-root.elena Normal file
View file

@ -0,0 +1,31 @@
import extensions;
import system'routines;
import system'collections;
extension op
{
get DigitalRoot()
{
int additivepersistence := 0;
long num := self;
while (num > 9)
{
num := num.toPrintable().toArray().selectBy:(ch => ch.toInt() - 48).summarize(new LongInteger());
additivepersistence += 1
};
^ new Tuple<int,int>(additivepersistence, num.toInt())
}
}
public program()
{
new long[]{627615l, 39390l, 588225l, 393900588225l}.forEach:(num)
{
var t := num.DigitalRoot;
console.printLineFormatted("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2)
}
}

22
Task/Digital-root/Elixir/digital-root.elixir Normal file
View file

@ -0,0 +1,22 @@
defmodule Digital do
def root(n, base\\10), do: root(n, base, 0)
defp root(n, base, ap) when n < base, do: {n, ap}
defp root(n, base, ap) do
Integer.digits(n, base) |> Enum.sum |> root(base, ap+1)
end
end
data = [627615, 39390, 588225, 393900588225]
Enum.each(data, fn n ->
{dr, ap} = Digital.root(n)
IO.puts "#{n} has additive persistence #{ap} and digital root of #{dr}"
end)
base = 16
IO.puts "\nBase = #{base}"
fmt = "~.#{base}B(#{base}) has additive persistence ~w and digital root of ~w~n"
Enum.each(data, fn n ->
{dr, ap} = Digital.root(n, base)
:io.format fmt, [n, ap, dr]
end)

14
Task/Digital-root/Erlang/digital-root.erl Normal file
View file

@ -0,0 +1,14 @@
-module( digital_root ).
-export( [task/0] ).
task() ->
Ns = [N || N <- [627615, 39390, 588225, 393900588225]],
Persistances = [persistance_root(X) || X <- Ns],
[io:fwrite("~p has additive persistence ~p and digital root of ~p~n", [X, Y, Z]) || {X, {Y, Z}} <- lists:zip(Ns, Persistances)].
persistance_root( X ) -> persistance_root( sum_digits:sum_digits(X), 1 ).
persistance_root( X, N ) when X < 10 -> {N, X};
persistance_root( X, N ) -> persistance_root( sum_digits:sum_digits(X), N + 1 ).

7
Task/Digital-root/F-Sharp/digital-root.fs Normal file
View file

@ -0,0 +1,7 @@
//Find the Digital Root of An Integer - Nigel Galloway: February 1st., 2015
//This code will work with any integer type
let inline digitalRoot N BASE =
let rec root(p,n) =
let s = sumDigits n BASE
if s < BASE then (s,p) else root(p+1, s)
root(LanguagePrimitives.GenericZero<_> + 1, N)

13
Task/Digital-root/Factor/digital-root.factor Normal file
View file

@ -0,0 +1,13 @@
USING: arrays formatting kernel math math.text.utils sequences ;
IN: rosetta-code.digital-root
: digital-root ( n -- persistence root )
0 swap [ 1 digit-groups dup length 1 > ] [ sum [ 1 + ] dip ]
while first ;
: print-root ( n -- )
dup digital-root
"%-12d has additive persistence %d and digital root %d.\n"
printf ;
{ 627615 39390 588225 393900588225 } [ print-root ] each

2
Task/Digital-root/Forth/digital-root-1.fth Normal file
View file

@ -0,0 +1,2 @@
: (Sdigit) 0 swap begin base @ /mod >r + r> dup 0= until drop ;
: digiroot 0 swap begin (Sdigit) >r 1+ r> dup base @ < until ;

4
Task/Digital-root/Forth/digital-root-2.fth Normal file
View file

@ -0,0 +1,4 @@
[UNDEFINED] mu/mod [IF] : mu/mod >r 0 r@ um/mod r> swap >r um/mod r> ; [THEN]
: (Sdigit) 0. 2swap begin base @ mu/mod 2>r s>d d+ 2r> 2dup d0= until 2drop ;
: digiroot 0 -rot begin (Sdigit) 2>r 1+ 2r> 2dup base @ s>d d< until d>s ;

31
Task/Digital-root/Fortran/digital-root.f Normal file
View file

@ -0,0 +1,31 @@
program prec
implicit none
integer(kind=16) :: i
i = 627615
call root_pers(i)
i = 39390
call root_pers(i)
i = 588225
call root_pers(i)
i = 393900588225
call root_pers(i)
end program
subroutine root_pers(i)
implicit none
integer(kind=16) :: N, s, a, i
write(*,*) 'Number: ', i
n = i
a = 0
do while(n.ge.10)
a = a + 1
s = 0
do while(n.gt.0)
s = s + n-int(real(n,kind=8)/10.0D0,kind=8) * 10_8
n = int(real(n,kind=16)/real(10,kind=8),kind=8)
end do
n = s
end do
write(*,*) 'digital root = ', s
write(*,*) 'additive persistance = ', a
end subroutine

27
Task/Digital-root/FreeBASIC/digital-root.basic Normal file
View file

@ -0,0 +1,27 @@
' FB 1.05.0 Win64
Function digitalRoot(n As UInteger, ByRef ap As Integer, base_ As Integer = 10) As Integer
Dim dr As Integer
ap = 0
Do
dr = 0
While n > 0
dr += n Mod base_
n = n \ base_
Wend
ap += 1
n = dr
Loop until dr < base_
Return dr
End Function
Dim As Integer dr, ap
Dim a(3) As UInteger = {627615, 39390, 588225, 393900588225}
For i As Integer = 0 To 3
ap = 0
dr = digitalRoot(a(i), ap)
Print a(i), "Additive Persistence ="; ap, "Digital root ="; dr
Print
Next
Print "Press any key to quit"
Sleep

68
Task/Digital-root/Go/digital-root.go Normal file
View file

@ -0,0 +1,68 @@
package main
import (
"fmt"
"log"
"strconv"
)
func Sum(i uint64, base int) (sum int) {
b64 := uint64(base)
for ; i > 0; i /= b64 {
sum += int(i % b64)
}
return
}
func DigitalRoot(n uint64, base int) (persistence, root int) {
root = int(n)
for x := n; x >= uint64(base); x = uint64(root) {
root = Sum(x, base)
persistence++
}
return
}
// Normally the below would be moved to a *_test.go file and
// use the testing package to be runnable as a regular test.
var testCases = []struct {
n string
base int
persistence int
root int
}{
{"627615", 10, 2, 9},
{"39390", 10, 2, 6},
{"588225", 10, 2, 3},
{"393900588225", 10, 2, 9},
{"1", 10, 0, 1},
{"11", 10, 1, 2},
{"e", 16, 0, 0xe},
{"87", 16, 1, 0xf},
// From Applesoft BASIC example:
{"DigitalRoot", 30, 2, 26}, // 26 is Q base 30
// From C++ example:
{"448944221089", 10, 3, 1},
{"7e0", 16, 2, 0x6},
{"14e344", 16, 2, 0xf},
{"d60141", 16, 2, 0xa},
{"12343210", 16, 2, 0x1},
// From the D example:
{"1101122201121110011000000", 3, 3, 1},
}
func main() {
for _, tc := range testCases {
n, err := strconv.ParseUint(tc.n, tc.base, 64)
if err != nil {
log.Fatal(err)
}
p, r := DigitalRoot(n, tc.base)
fmt.Printf("%12v (base %2d) has additive persistence %d and digital root %s\n",
tc.n, tc.base, p, strconv.FormatInt(int64(r), tc.base))
if p != tc.persistence || r != tc.root {
log.Fatalln("bad result:", tc, p, r)
}
}
}

26
Task/Digital-root/Groovy/digital-root.groovy Normal file
View file

@ -0,0 +1,26 @@
class DigitalRoot {
static int[] calcDigitalRoot(String number, int base) {
BigInteger bi = new BigInteger(number, base)
int additivePersistence = 0
if (bi.signum() < 0) {
bi = bi.negate()
}
BigInteger biBase = BigInteger.valueOf(base)
while (bi >= biBase) {
number = bi.toString(base)
bi = BigInteger.ZERO
for (int i = 0; i < number.length(); i++) {
bi = bi.add(new BigInteger(number.substring(i, i + 1), base))
}
additivePersistence++
}
return [additivePersistence, bi.intValue()]
}
static void main(String[] args) {
for (String arg : [627615, 39390, 588225, 393900588225]) {
int[] results = calcDigitalRoot(arg, 10)
println("$arg has additive persistence ${results[0]} and digital root of ${results[1]}")
}
}
}

19
Task/Digital-root/Haskell/digital-root-1.hs Normal file
View file

@ -0,0 +1,19 @@
import Data.Bifunctor (bimap)
import Data.List (unfoldr)
import Data.Tuple (swap)
digSum :: Int -> Int -> Int
digSum base = sum . unfoldr f
where
f 0 = Nothing
f n = Just (swap (quotRem n base))
digRoot :: Int -> Int -> (Int, Int)
digRoot base =
head .
dropWhile ((>= base) . snd) . iterate (bimap succ (digSum base)) . (,) 0
main :: IO ()
main = do
putStrLn "in base 10:"
mapM_ (print . ((,) <*> digRoot 10)) [627615, 39390, 588225, 393900588225]

63
Task/Digital-root/Haskell/digital-root-2.hs Normal file
View file

@ -0,0 +1,63 @@
import Data.Tuple (swap)
import Data.Maybe (fromJust)
import Data.List (elemIndex, unfoldr)
import Numeric (readInt, showIntAtBase)
-- Return a pair consisting of the additive persistence and digital root of a
-- base b number.
digRoot :: Integer -> Integer -> (Integer, Integer)
digRoot b = find . zip [0 ..] . iterate (sum . toDigits b)
where
find = head . dropWhile ((>= b) . snd)
-- Print the additive persistence and digital root of a base b number (given as
-- a string).
printDigRoot :: Integer -> String -> IO ()
printDigRoot b s = do
let (p, r) = digRoot b $ strToInt b s
(putStrLn . unwords)
[s, "-> additive persistence:", show p, "digital root:", intToStr b r]
--
-- Utility methods for dealing with numbers in different bases.
--
-- Convert a base b number to a list of digits, from least to most significant.
toDigits
:: Integral a
=> a -> a -> [a]
toDigits b = unfoldr f
where
f 0 = Nothing
f n = Just (swap (quotRem n b))
-- A list of digits, for bases up to 36.
digits :: String
digits = ['0' .. '9'] ++ ['A' .. 'Z']
-- Return a number's base b string representation.
intToStr
:: (Integral a, Show a)
=> a -> a -> String
intToStr b n
| b < 2 || b > 36 = error "intToStr: base must be in [2..36]"
| otherwise = showIntAtBase b (digits !!) n ""
-- Return the number for the base b string representation.
strToInt
:: Integral a
=> a -> String -> a
strToInt b =
fst . head . readInt b (`elem` digits) (fromJust . (`elemIndex` digits))
main :: IO ()
main =
mapM_
(uncurry printDigRoot)
[ (2, "1001100111011110")
, (3, "2000000220")
, (8, "5566623376301")
, (10, "39390")
, (16, "99DE")
, (36, "50YE8N29")
, (36, "37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN")
]

16
Task/Digital-root/Huginn/digital-root.huginn Normal file
View file

@ -0,0 +1,16 @@
main( argv_ ) {
if ( size( argv_ ) < 2 ) {
throw Exception( "usage: digital-root {NUM}" );
}
n = argv_[1];
if ( ( size( n ) == 0 ) || ( n.find_other_than( "0123456789" ) >= 0 ) ) {
throw Exception( "{} is not a number".format( n ) );
}
shift = integer( '0' ) + 1;
acc = 0;
for ( d : n ) {
acc = 1 + ( acc + integer( d ) - shift ) % 9;
}
print( "{}\n".format( acc ) );
return ( 0 );
}

13
Task/Digital-root/Icon/digital-root.icon Normal file
View file

@ -0,0 +1,13 @@
procedure main(A)
every m := n := integer(!A) do {
ap := 0
while (*n > 1) do (ap +:= 1, n := sumdigits(n))
write(m," has additive persistence of ",ap," and digital root of ",n)
}
end
procedure sumdigits(n)
s := 0
n ? while s +:= move(1)
return s
end

2
Task/Digital-root/J/digital-root-1.j Normal file
View file

@ -0,0 +1,2 @@
digrot=: +/@(#.inv~&10)^:_
addper=: _1 + [: # +/@(#.inv~&10)^:a:

5
Task/Digital-root/J/digital-root-2.j Normal file
View file

@ -0,0 +1,5 @@
(, addper, digrot)&> 627615 39390 588225 393900588225
627615 2 9
39390 2 6
588225 2 3
393900588225 2 9

1
Task/Digital-root/J/digital-root-3.j Normal file
View file

@ -0,0 +1 @@
equals=: =&(9&|)"0

15
Task/Digital-root/J/digital-root-4.j Normal file
View file

@ -0,0 +1,15 @@
equals table i. 10
┌──────┬───────────────────┐
│equals│0 1 2 3 4 5 6 7 8 9│
├──────┼───────────────────┤
│0 │1 0 0 0 0 0 0 0 0 1│
│1 │0 1 0 0 0 0 0 0 0 0│
│2 │0 0 1 0 0 0 0 0 0 0│
│3 │0 0 0 1 0 0 0 0 0 0│
│4 │0 0 0 0 1 0 0 0 0 0│
│5 │0 0 0 0 0 1 0 0 0 0│
│6 │0 0 0 0 0 0 1 0 0 0│
│7 │0 0 0 0 0 0 0 1 0 0│
│8 │0 0 0 0 0 0 0 0 1 0│
│9 │1 0 0 0 0 0 0 0 0 1│
└──────┴───────────────────┘

2
Task/Digital-root/J/digital-root-5.j Normal file
View file

@ -0,0 +1,2 @@
digrt=: +/@(#.inv)^:_
addpr=: _1 + [: # +/@(#.inv)^:a:

4
Task/Digital-root/J/digital-root-6.j Normal file
View file

@ -0,0 +1,4 @@
10 digrt 627615
9
10 addpr 627615
2

31
Task/Digital-root/Java/digital-root.java Normal file
View file

@ -0,0 +1,31 @@
import java.math.BigInteger;
class DigitalRoot
{
public static int[] calcDigitalRoot(String number, int base)
{
BigInteger bi = new BigInteger(number, base);
int additivePersistence = 0;
if (bi.signum() < 0)
bi = bi.negate();
BigInteger biBase = BigInteger.valueOf(base);
while (bi.compareTo(biBase) >= 0)
{
number = bi.toString(base);
bi = BigInteger.ZERO;
for (int i = 0; i < number.length(); i++)
bi = bi.add(new BigInteger(number.substring(i, i + 1), base));
additivePersistence++;
}
return new int[] { additivePersistence, bi.intValue() };
}
public static void main(String[] args)
{
for (String arg : args)
{
int[] results = calcDigitalRoot(arg, 10);
System.out.println(arg + " has additive persistence " + results[0] + " and digital root of " + results[1]);
}
}
}

16
Task/Digital-root/JavaScript/digital-root.js Normal file
View file

@ -0,0 +1,16 @@
/// Digital root of 'x' in base 'b'.
/// @return {addpers, digrt}
function digitalRootBase(x,b) {
if (x < b)
return {addpers:0, digrt:x};
var fauxroot = 0;
while (b <= x) {
x = (x / b) | 0;
fauxroot += x % b;
}
var rootobj = digitalRootBase(fauxroot,b);
rootobj.addpers += 1;
return rootobj;
}

20
Task/Digital-root/Jq/digital-root-1.jq Normal file
View file

@ -0,0 +1,20 @@
def do_until(condition; next):
def u: if condition then . else (next|u) end;
u;
# n may be a decimal number or a string representing a decimal number
def digital_root(n):
# string-only version
def dr:
# state: [mdr, persist]
do_until( .[0] | length == 1;
[ (.[0] | explode | map(.-48) | add | tostring), .[1] + 1 ]
);
[n|tostring, 0] | dr | .[0] |= tonumber;
def neatly:
. as $in
| range(0;length)
| "\(.): \($in[.])";
def rjust(n): tostring | (n-length)*" " + .;

8
Task/Digital-root/Jq/digital-root-2.jq Normal file
View file

@ -0,0 +1,8 @@
(
" i : [DR, P]",
(961038, 923594037444, 670033, 448944221089
) as $i
| "\($i|rjust(12)): \(digital_root($i))"
),
"",
"digital_root(\"1\" * 100000) => \(digital_root( "1" * 100000))"

9
Task/Digital-root/Jq/digital-root-3.jq Normal file
View file

@ -0,0 +1,9 @@
$ jq -M -n -r -c -f Digital_root.jq
i : [DR, P]
961038: [9,2]
923594037444: [9,2]
670033: [1,3]
448944221089: [1,3]
digital_root("1" * 100000) => [1,2]

14
Task/Digital-root/Julia/digital-root.julia Normal file
View file

@ -0,0 +1,14 @@
function digitalroot(n::Integer, bs::Integer=10)
if n < 0 || bs < 2 throw(DomainError()) end
ds, pers = n, 0
while bs ≤ ds
ds = sum(digits(ds, bs))
pers += 1
end
return pers, ds
end
for i in [627615, 39390, 588225, 393900588225, big(2) ^ 100]
pers, ds = digitalroot(i)
println(i, " has persistence ", pers, " and digital root ", ds)
end

6
Task/Digital-root/K/digital-root.k Normal file
View file

@ -0,0 +1,6 @@
/ print digital root and additive persistence
prt: {`"Digital root = ", x, `"Additive persistence = ",y}
/ sum of digits of an integer
sumdig: {d::(); (0<){d::d,x!10; x%:10}/x; +/d}
/ compute digital root and additive persistence
digroot: {sm::sumdig x; ap::0; (9<){sm::sumdig x;ap::ap+1; x:sm}/x; prt[sm;ap]}

36
Task/Digital-root/Kotlin/digital-root.kotlin Normal file
View file

@ -0,0 +1,36 @@
// version 1.0.6
fun sumDigits(n: Long): Int = when {
n < 0L -> throw IllegalArgumentException("Negative numbers not allowed")
else -> {
var sum = 0
var nn = n
while (nn > 0L) {
sum += (nn % 10).toInt()
nn /= 10
}
sum
}
}
fun digitalRoot(n: Long): Pair<Int, Int> = when {
n < 0L -> throw IllegalArgumentException("Negative numbers not allowed")
n < 10L -> Pair(n.toInt(), 0)
else -> {
var dr = n
var ap = 0
while (dr > 9L) {
dr = sumDigits(dr).toLong()
ap++
}
Pair(dr.toInt(), ap)
}
}
fun main(args: Array<String>) {
val a = longArrayOf(1, 14, 267, 8128, 627615, 39390, 588225, 393900588225)
for (n in a) {
val(dr, ap) = digitalRoot(n)
println("${n.toString().padEnd(12)} has additive persistence $ap and digital root of $dr")
}
}

13
Task/Digital-root/Lua/digital-root.lua Normal file
View file

@ -0,0 +1,13 @@
function digital_root(n, base)
p = 0
while n > 9.5 do
n = sum_digits(n, base)
p = p + 1
end
return n, p
end
print(digital_root(627615, 10))
print(digital_root(39390, 10))
print(digital_root(588225, 10))
print(digital_root(393900588225, 10))

23
Task/Digital-root/MAD/digital-root.mad Normal file
View file

@ -0,0 +1,23 @@
NORMAL MODE IS INTEGER
VECTOR VALUES INP = $I12*$
VECTOR VALUES OUTP = $I12,S1,I12*$
BASE = 10
R READ NUMBERS UNTIL 0 INPUT
RDNUM READ FORMAT INP,NUMBER
WHENEVER NUMBER.NE.0
SUMMAT PERS = 0
DSUM = 0
R CALCULATE ROOT AND PERSISTENCE
DIGIT DSUM = DSUM + NUMBER-NUMBER/BASE*BASE
NUMBER = NUMBER/BASE
PERS = PERS + 1
WHENEVER NUMBER.NE.0, TRANSFER TO DIGIT
NUMBER = DSUM
WHENEVER NUMBER.GE.10, TRANSFER TO SUMMAT
PRINT FORMAT OUTP,DSUM,PERS
TRANSFER TO RDNUM
END OF CONDITIONAL
END OF PROGRAM

3
Task/Digital-root/Mathematica/digital-root.math Normal file
View file

@ -0,0 +1,3 @@
seq[n_, b_] := FixedPointList[Total[IntegerDigits[#, b]] &, n];
root[n_Integer, base_: 10] := If[base == 10, #, BaseForm[#, base]] &[Last[seq[n, base]]]
persistance[n_Integer, base_: 10] := Length[seq[n, base]] - 2;

51
Task/Digital-root/Modula-2/digital-root.mod2 Normal file
View file

@ -0,0 +1,51 @@
MODULE DigitalRoot;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;
TYPE Root =
RECORD
persistence,root : LONGINT;
END;
PROCEDURE digitalRoot(inRoot,base : LONGINT) : Root;
VAR root,persistence,num : LONGINT;
BEGIN
root := ABS(inRoot);
persistence := 0;
WHILE root>=base DO
num := root;
root := 0;
WHILE num#0 DO
root := root + (num MOD base);
num := num DIV base;
END;
INC(persistence)
END;
RETURN Root{persistence, root}
END digitalRoot;
PROCEDURE Print(n,b : LONGINT);
VAR
buf : ARRAY[0..63] OF CHAR;
r : Root;
BEGIN
r := digitalRoot(n,b);
FormatString("%u (base %u): persistence=%u, digital root=%u\n", buf, n, b, r.persistence, r.root);
WriteString(buf)
END Print;
VAR
buf : ARRAY[0..63] OF CHAR;
b,n : LONGINT;
r : Root;
BEGIN
Print(1,10);
Print(14,10);
Print(267,10);
Print(8128,10);
Print(39390,10);
Print(627615,10);
Print(588225,10);
ReadChar
END DigitalRoot.

42
Task/Digital-root/Modula-3/digital-root.mod3 Normal file
View file

@ -0,0 +1,42 @@
MODULE DigitalRoot EXPORTS Main;
IMPORT IO;
FROM Fmt IMPORT F,LongInt;
TYPE
Root = RECORD persistence,R:LONGINT END;
VAR
R:Root;
Arr:ARRAY[0..3] OF LONGINT := ARRAY OF LONGINT{627615L,
39390L,
588225L,
393900588225L};
PROCEDURE DigitalRoot(InRoot,Base:LONGINT):Root =
VAR
r,persistence,Num:LONGINT;
BEGIN
r := ABS(InRoot);
persistence := 0L;
WHILE r >= Base DO
Num := r;
r := 0L;
WHILE Num # 0L DO
r := r + (Num MOD Base);
Num := Num DIV Base;
END;
INC(persistence);
END;
RETURN Root{persistence, r};
END DigitalRoot;
BEGIN
FOR I := FIRST(Arr) TO LAST(Arr) DO
R := DigitalRoot(Arr[I], 10L);
IO.Put(F(LongInt(Arr[I]) &
" has additive persistence %s and digital root of %s\n",
LongInt(R.persistence),
LongInt(R.R)));
END;
END DigitalRoot.

23
Task/Digital-root/Nanoquery/digital-root.nanoquery Normal file
View file

@ -0,0 +1,23 @@
def digital_root(n)
ap = 0
n = +(int(n))
while n >= 10
sum = 0
for digit in str(n)
sum += int(digit)
end
n = sum
ap += 1
end
return {ap, n}
end
println "here"
if main
values = {627615, 39390, 588825, 393900588225, 55}
for n in values
aproot = digital_root(n)
println format("%12d has additive persistence %2d and digital root %d.", n, aproot[0], aproot[1])
end
end

21
Task/Digital-root/Nascom-BASIC/digital-root.basic Normal file
View file

@ -0,0 +1,21 @@
10 REM Digital root
20 FOR I=0 TO 6
30 READ A
40 N=A:B=10:GOSUB 500
50 PRINT SPC(7-LEN(STR$(A)));A;PERS;ROOT
60 NEXT I
70 DATA 1,14,267,8128,39390,588225,627615
80 END
490 REM ** Calculate digital root
495 REM and persistance
500 PERS=0
510 IF N<B THEN 590
520 S=0
530 S=S+N-INT(N/B)*B
540 N=INT(N/B)
550 IF N>0 THEN 530
560 PERS=PERS+1
570 N=S
580 GOTO 510
590 ROOT=N
600 RETURN

34
Task/Digital-root/NetRexx/digital-root.netrexx Normal file
View file

@ -0,0 +1,34 @@
/* NetRexx ************************************************************
* Test digroot
**********************************************************************/
Say 'number -> digital_root persistence'
test_digroot(7 ,7, 0)
test_digroot(627615 ,9, 2)
test_digroot(39390 ,6, 2)
test_digroot(588225 ,3, 2)
test_digroot(393900588225,9, 2)
test_digroot(393900588225,9, 3) /* test error case */
method test_digroot(n,dx,px) static
res=digroot(n)
Parse res d p
If d=dx & p=px Then tag='ok'
Else tag='expected:' dx px
Say n '->' d p tag
method digroot(n) static
/**********************************************************************
* Compute the digital root and persistence of the given decimal number
* 19.08.2012 Walter Pachl derived from Rexx
**************************** Bottom of Data **************************/
p=0 /* persistence */
Loop While n.length()>1 /* more than one digit in n */
s=0 /* initialize sum */
p=p+1 /* increment persistence */
Loop while n<>'' /* as long as there are digits */
Parse 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 */

14
Task/Digital-root/Nim/digital-root.nim Normal file
View file

@ -0,0 +1,14 @@
import strutils
proc droot(n: int64): auto =
var x = @[n]
while x[x.high] > 10:
var s = 0'i64
for dig in $x[x.high]:
s += parseInt("" & dig)
x.add s
return (x.len - 1, x[x.high])
for n in [627615'i64, 39390'i64, 588225'i64, 393900588225'i64]:
let (a, d) = droot(n)
echo align($n, 12)," has additive persistence ",a," and digital root of ",d

16
Task/Digital-root/OCaml/digital-root.ocaml Normal file
View file

@ -0,0 +1,16 @@
let rec digit_sum b n =
if n < b then n else digit_sum b (n / b) + n mod b
let digital_root b n =
let rec loop a x =
if x < b then a, x else loop (succ a) (digit_sum b x)
in
loop 0 n
let () =
let pr_fmt n (p, r) =
Printf.printf "%u: additive persistence = %u, digital root = %u\n" n p r
in
List.iter
(fun n -> pr_fmt n (digital_root 10 n))
[627615; 39390; 588225; 393900588225]

4
Task/Digital-root/Oforth/digital-root.fth Normal file
View file

@ -0,0 +1,4 @@
: sumDigits(n, base) 0 while(n) [ n base /mod ->n + ] ;
: digitalRoot(n, base)
0 while(n 9 >) [ 1 + sumDigits(n, base) ->n ] n swap Pair new ;

12
Task/Digital-root/Ol/digital-root.ol Normal file
View file

@ -0,0 +1,12 @@
(define (digital-root num)
(if (less? num 10)
num
(let loop ((num num) (sum 0))
(if (zero? num)
(digital-root sum)
(loop (div num 10) (+ sum (mod num 10)))))))
(print (digital-root 627615))
(print (digital-root 39390))
(print (digital-root 588225))
(print (digital-root 393900588225))

3
Task/Digital-root/PARI-GP/digital-root.parigp Normal file
View file

@ -0,0 +1,3 @@
dsum(n)=my(s); while(n, s+=n%10; n\=10); s
additivePersistence(n)=my(s); while(n>9, s++; n=dsum(n)); s
digitalRoot(n)=if(n, (n-1)%9+1, 0)

26
Task/Digital-root/PHP/digital-root.php Normal file
View file

@ -0,0 +1,26 @@
<?php
// Digital root
function rootAndPers($n, $bas)
// Calculate digital root and persistance
{
$pers = 0;
while ($n >= $bas) {
$s = 0;
do {
$s += $n % $bas;
$n = floor($n / $bas);
} while ($n > 0);
$pers++;
$n = $s;
}
return array($n, $pers);
}
foreach ([1, 14, 267, 8128, 39390, 588225, 627615] as $a) {
list($root, $pers) = rootAndPers($a, 10);
echo str_pad($a, 7, ' ', STR_PAD_LEFT);
echo str_pad($pers, 6, ' ', STR_PAD_LEFT);
echo str_pad($root, 6, ' ', STR_PAD_LEFT), PHP_EOL;
}
?>

59
Task/Digital-root/PL-I/digital-root-1.pli Normal file
View file

@ -0,0 +1,59 @@
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;

15
Task/Digital-root/PL-I/digital-root-2.pli Normal file
View file

@ -0,0 +1,15 @@
digital: procedure options (main); /* 29 April 2014 */
declare 1 pict union,
2 x picture '9999999999999',
2 d(13) picture '9';
declare ap fixed, n fixed (15);
do n = 5, 627615, 39390, 588225, 393900588225, 99999999999;
x = n;
do ap = 1 by 1 until (x < 10);
x = sum(d);
end;
put skip data (n, x, ap);
end;
end digital;

102
Task/Digital-root/PL-M/digital-root.plm Normal file
View file

@ -0,0 +1,102 @@
100H: /* SHOW THE DIGITAL ROOT AND PERSISTENCE OF SOME NUMBERS */
/* BDOS SYSTEM CALL */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
/* PRINTS A BYTE AS A CHARACTER */
PRINT$CHAR: PROCEDURE( CH ); DECLARE CH BYTE; CALL BDOS( 2, CH ); END;
/* PRINTS A BYTE AS A NUMBER */
PRINT$BYTE: PROCEDURE( N );
DECLARE N BYTE;
DECLARE ( V, D2 ) BYTE;
IF ( V := N / 10 ) <> 0 THEN DO;
D2 = V MOD 10;
IF ( V := V / 10 ) <> 0 THEN CALL PRINT$CHAR( '0' + V );
CALL PRINT$CHAR( '0' + D2 );
END;
CALL PRINT$CHAR( '0' + N MOD 10 );
END PRINT$BYTE;
/* PRINTS A $ TERMINATED STRING */
PRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
/* PRINTS N1, N2, N3 AS A SINGLE NUMBER */
/* N1, N2, N3 MUST ALL BE BETWEEN 0 AND 9999 INCLUSIVE */
PRINT$NUMBER3: PROCEDURE( N1, N2, N3 );
DECLARE ( N1, N2, N3 ) ADDRESS;
DECLARE V ADDRESS, N$STR( 14 ) BYTE, ( W, I, J ) BYTE;
W = LAST( N$STR );
N$STR( W ) = '$';
/* ADD THE DIGITS OF THE THREE NUMBERS TO N$STR */
DO I = 0 TO 2;
DO CASE I;
V = N3;
V = N2;
V = N1;
END;
DO J = 1 TO 4;
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
V = V / 10;
END;
END;
/* SPACE FILL THE REMAINDER OF THE NUMBER */
I = W;
DO WHILE( I > 0 );
N$STR( I := I - 1 ) = ' ';
END;
/* SUPPRESS LEADING ZEROS */
DO WHILE( W < LAST( N$STR ) - 1 AND N$STR( W ) = '0' );
N$STR( W ) = ' ';
W = W + 1;
END;
CALL PRINT$STRING( .N$STR );
END PRINT$NUMBER3;
/* CALCULATES THE DIGITAL ROOT AND PERSISTENCE OF AN INTEGER IN BASE 10 */
/* IN ORDER TO ALLOW FOR NUMBERS LARGER THAN 2^15, THE NUMBER IS PASSED */
/* AS THE UPPER, MIDDLE AND LOWER DIGITS IN N1, N2 AND N3 */
/* E.G. 393900588225 CAN BE PROCESSED BY N1=3939, N2=0058, N3=8225 */
FIND$DIGITAL$ROOT: PROCEDURE( N1, N2, N3, ROOT$PTR, PERSISTENCE$PTR );
DECLARE ( N1, N2, N3, ROOT$PTR, PERSISTENCE$PTR ) ADDRESS;
DECLARE DIGITAL$ROOT BASED ROOT$PTR BYTE;
DECLARE PERSISTENCE BASED PERSISTENCE$PTR BYTE;
SUM$DIGITS: PROCEDURE( N ) ADDRESS;
DECLARE N ADDRESS;
DECLARE DIGITS ADDRESS, SUM BYTE;
DIGITS = N;
SUM = 0;
DO WHILE DIGITS > 0;
SUM = SUM + ( DIGITS MOD 10 );
DIGITS = DIGITS / 10;
END;
RETURN SUM;
END SUM$DIGITS;
DIGITAL$ROOT = SUM$DIGITS( N1 ) + SUM$DIGITS( N2 ) + SUM$DIGITS( N3 );
PERSISTENCE = 1;
DO WHILE( DIGITAL$ROOT > 9 );
PERSISTENCE = PERSISTENCE + 1;
DIGITAL$ROOT = SUM$DIGITS( DIGITAL$ROOT );
END;
END FIND$DIGITAL$ROOT ;
/* CALCULATES AND PRINTS THE DIGITAL ROOT AND PERSISTENCE OF THE */
/* NUMBER FORMED FROM THE CONCATENATION OF N1, N2 AND N3 */
PRINT$DR$AND$PERSISTENCE: PROCEDURE( N1, N2, N3 );
DECLARE ( N1, N2, N3 ) ADDRESS;
DECLARE ( DIGITAL$ROOT, PERSISTENCE ) BYTE;
CALL FIND$DIGITAL$ROOT( N1, N2, N3, .DIGITAL$ROOT, .PERSISTENCE );
CALL PRINT$NUMBER3( N1, N2, N3 );
CALL PRINT$STRING( .': DIGITAL ROOT: $' );
CALL PRINT$BYTE( DIGITAL$ROOT );
CALL PRINT$STRING( .', PERSISTENCE: $' );
CALL PRINT$BYTE( PERSISTENCE );
CALL PRINT$STRING( .( 0DH, 0AH, '$' ) );
END PRINT$DR$AND$PERSISTENCE;
/* TEST THE DIGITAL ROOT AND PERSISTENCE PROCEDURES */
CALL PRINT$DR$ANDPERSISTENCE( 0, 62, 7615 );
CALL PRINT$DR$ANDPERSISTENCE( 0, 3, 9390 );
CALL PRINT$DR$ANDPERSISTENCE( 0, 58, 8225 );
CALL PRINT$DR$ANDPERSISTENCE( 3939, 0058, 8225 );
EOF

70
Task/Digital-root/Pascal/digital-root.pas Normal file
View file

@ -0,0 +1,70 @@
program DigitalRoot;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
SysUtils, StrUtils;
// FPC has no Big mumbers implementation, Int64 will suffice.
procedure GetDigitalRoot(Value: Int64; Base: Byte; var DRoot, Pers: Integer);
var
i: Integer;
DigitSum: Int64;
begin
Pers := 0;
repeat
Inc(Pers);
DigitSum := 0;
while Value > 0 do
begin
Inc(DigitSum, Value mod Base);
Value := Value div Base;
end;
Value := DigitSum;
until Value < Base;
DRoot := Value;
End;
function IntToStrBase(Value: Int64; Base: Byte):String;
const
// usable up to 36-Base
DigitSymbols = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXY';
begin
Result := '';
while Value > 0 do
begin
Result := DigitSymbols[Value mod Base+1] + Result;
Value := Value div Base;
End;
End;
procedure Display(const Value: Int64; Base: Byte = 10);
var
DRoot, Pers: Integer;
StrValue: string;
begin
GetDigitalRoot(Value, Base, DRoot, Pers);
WriteLn(Format('%s(%d) has additive persistence %d and digital root %d.',
[IntToStrBase(Value, Base), Base, Pers, DRoot]));
End;
begin
WriteLn('--- Examples in 10-Base ---');
Display(627615);
Display(39390);
Display(588225);
Display(393900588225);
WriteLn('--- Examples in 16-Base ---');
Display(627615, 16);
Display(39390, 16);
Display(588225, 16);
Display(393900588225, 16);
ReadLn;
End.

51
Task/Digital-root/Perl/digital-root.pl Normal file
View file

@ -0,0 +1,51 @@
#!perl
use strict;
use warnings;
use List::Util qw(sum);
my @digit = (0..9, 'a'..'z');
my %digit = map { +$digit[$_], $_ } 0 .. $#digit;
sub base {
my ($n, $b) = @_;
$b ||= 10;
die if $b > @digit;
my $result = '';
while( $n ) {
$result .= $digit[ $n % $b ];
$n = int( $n / $b );
}
reverse($result) || '0';
}
sub digi_root {
my ($n, $b) = @_;
my $inbase = base($n, $b);
my $additive_persistance = 0;
while( length($inbase) > 1 ) {
++$additive_persistance;
$n = sum @digit{split //, $inbase};
$inbase = base($n, $b);
}
$additive_persistance, $n;
}
MAIN: {
my @numbers = (5, 627615, 39390, 588225, 393900588225);
my @bases = (2, 3, 8, 10, 16, 36);
my $fmt = "%25s(%2s): persistance = %s, root = %2s\n";
if( eval { require Math::BigInt; 1 } ) {
push @numbers, Math::BigInt->new("5814271898167303040368".
"1039458302204471300738980834668522257090844071443085937");
}
for my $base (@bases) {
for my $num (@numbers) {
my $inbase = base($num, $base);
$inbase = 'BIG' if length($inbase) > 25;
printf $fmt, $inbase, $base, digi_root($num, $base);
}
print "\n";
}
}

24
Task/Digital-root/Phix/digital-root.phix Normal file
View file

@ -0,0 +1,24 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">digital_root</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">base</span><span style="color: #0000FF;">=</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">persistence</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">work</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">n</span>
<span style="color: #008080;">while</span> <span style="color: #004600;">true</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">root</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">work</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">root</span> <span style="color: #0000FF;">+=</span> <span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">work</span><span style="color: #0000FF;">,</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">work</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">work</span><span style="color: #0000FF;">/</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">root</span><span style="color: #0000FF;"><</span><span style="color: #000000;">base</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">work</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">root</span>
<span style="color: #000000;">persistence</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%15d root: %d persistence: %d\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">root</span><span style="color: #0000FF;">,</span><span style="color: #000000;">persistence</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">digital_root</span><span style="color: #0000FF;">(</span><span style="color: #000000;">627615</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">digital_root</span><span style="color: #0000FF;">(</span><span style="color: #000000;">39390</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">digital_root</span><span style="color: #0000FF;">(</span><span style="color: #000000;">588225</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">digital_root</span><span style="color: #0000FF;">(</span><span style="color: #000000;">393900588225</span><span style="color: #0000FF;">)</span>
<!--

18
Task/Digital-root/Picat/digital-root.picat Normal file
View file

@ -0,0 +1,18 @@
go =>
foreach(N in [627615,39390,588225,393900588225,
58142718981673030403681039458302204471300738980834668522257090844071443085937])
[Sum,Persistence] = digital_root(N),
printf("%w har addititive persistence %d and digital root of %d\n", N,Persistence,Sum)
end,
nl.
%
% (Reduced) digit sum (digital root) of a number
%
digital_root(N) = [Sum,Persistence], integer(N) =>
Sum = N,
Persistence = 0,
while(Sum > 9)
Sum := sum([I.to_integer() : I in Sum.to_string()]),
Persistence := Persistence + 1
end.

4
Task/Digital-root/PicoLisp/digital-root.l Normal file
View file

@ -0,0 +1,4 @@
(for N (627615 39390 588225 393900588225)
(for ((A . I) N T (sum format (chop I)))
(T (> 10 I)
(prinl N " has additive persistance " (dec A) " and digital root of " I ";") ) ) )

17
Task/Digital-root/Potion/digital-root.potion Normal file
View file

@ -0,0 +1,17 @@
digital = (x) :
dr = x string # Digital Root.
ap = 0 # Additive Persistence.
while (dr length > 1) :
sum = 0
dr length times (i): sum = sum + dr(i) number integer.
dr = sum string
ap++
.
(x, " has additive persistence ", ap,
" and digital root ", dr, ";\n") join print
.
digital(627615)
digital(39390)
digital(588225)
digital(393900588225)

19
Task/Digital-root/PowerShell/digital-root-1.psh Normal file
View file

@ -0,0 +1,19 @@
function Get-DigitalRoot ($n)
{
function Get-Digitalsum ($n)
{
if ($n -lt 10) {$n}
else {
($n % 10) + (Get-DigitalSum ([math]::Floor($n / 10)))
}
}
$ap = 0
do {$n = Get-DigitalSum $n; $ap++}
until ($n -lt 10)
$DigitalRoot = [pscustomobject]@{
'Sum' = $n
'Additive Persistence' = $ap
}
$DigitalRoot
}

9
Task/Digital-root/PowerShell/digital-root-2.psh Normal file
View file

@ -0,0 +1,9 @@
function Get-DigitalRoot {
param($n)
$ap = 0
do {$n = Invoke-Expression ("0"+([string]$n -split "" -join "+")+"0"); $ap++} while ($n -ge 10)
[PSCustomObject]@{
DigitalRoot = $n
AdditivePersistence = $ap
}
}

33
Task/Digital-root/Prolog/digital-root.pro Normal file
View file

@ -0,0 +1,33 @@
digit_sum(N, Base, Sum):-
digit_sum(N, Base, Sum, 0).
digit_sum(N, Base, Sum, S1):-
N < Base,
!,
Sum is S1 + N.
digit_sum(N, Base, Sum, S1):-
divmod(N, Base, M, Digit),
S2 is S1 + Digit,
digit_sum(M, Base, Sum, S2).
digital_root(N, Base, AP, DR):-
digital_root(N, Base, AP, DR, 0).
digital_root(N, Base, AP, N, AP):-
N < Base,
!.
digital_root(N, Base, AP, DR, AP1):-
digit_sum(N, Base, Sum),
AP2 is AP1 + 1,
digital_root(Sum, Base, AP, DR, AP2).
test_digital_root(N, Base):-
digital_root(N, Base, AP, DR),
writef('%w has additive persistence %w and digital root %w.\n', [N, AP, DR]).
main:-
test_digital_root(627615, 10),
test_digital_root(39390, 10),
test_digital_root(588225, 10),
test_digital_root(393900588225, 10),
test_digital_root(685943443231217865409, 10).

49
Task/Digital-root/PureBasic/digital-root.basic Normal file
View file

@ -0,0 +1,49 @@
; if you just want the DigitalRoot
; Procedure.q DigitalRoot(N.q) apparently will do
; i must have missed something because it seems too simple
; http://en.wikipedia.org/wiki/Digital_root#Congruence_formula
Procedure.q DigitalRoot(N.q)
Protected M.q=N%9
if M=0:ProcedureReturn 9
Else :ProcedureReturn M:EndIf
EndProcedure
; there appears to be a proof guarantying that Len(N$)<=1 for some X
; http://en.wikipedia.org/wiki/Digital_root#Proof_that_a_constant_value_exists
Procedure.s DigitalRootandPersistance(N.q)
Protected r.s,t.s,X.q,M.q,persistance,N$=Str(N)
M=DigitalRoot(N.q) ; just a test to see if we get the same DigitalRoot via the Congruence_formula
Repeat
X=0:Persistance+1
For i=1 to Len(N$) ; finding X as the sum of the digits of N
X+Val(Mid(N$,i,1))
Next
N$=Str(X)
If Len(N$)<=1:Break:EndIf ; If Len(N$)<=1:Break:EndIf
Forever
If Not (X-M)=0:t.s=" Error in my logic":else:t.s=" ok":EndIf
r.s=RSet(Str(N),15)+" has additive persistance "+Str(Persistance)
r.s+" and digital root of X(slow) ="+Str(X)+" M(fast) ="+Str(M)+t.s
ProcedureReturn r.s
EndProcedure
NewList Nlist.q()
AddElement(Nlist()) : Nlist()=627615
AddElement(Nlist()) : Nlist()=39390
AddElement(Nlist()) : Nlist()=588225
AddElement(Nlist()) : Nlist()=393900588225
FirstElement(Nlist())
ForEach Nlist()
N.q=Nlist()
; cw(DigitalRootandPersistance(N))
Debug DigitalRootandPersistance(N)
Next

13
Task/Digital-root/Python/digital-root-1.py Normal file
View file

@ -0,0 +1,13 @@
def digital_root (n):
ap = 0
n = abs(int(n))
while n >= 10:
n = sum(int(digit) for digit in str(n))
ap += 1
return ap, n
if __name__ == '__main__':
for n in [627615, 39390, 588225, 393900588225, 55]:
persistance, root = digital_root(n)
print("%12i has additive persistance %2i and digital root %i."
% (n, persistance, root))

64
Task/Digital-root/Python/digital-root-2.py Normal file
View file

@ -0,0 +1,64 @@
from functools import (reduce)
# main :: IO ()
def main():
print (
tabulated(digitalRoot)(
'Integer -> (additive persistence, digital root):'
)([627615, 39390, 588225, 393900588225, 55])
)
# digitalRoot :: Int -> (Int, Int)
def digitalRoot(n):
'''Integer -> (additive persistence, digital root)'''
# f :: (Int, Int) -> (Int, Int)
def f(pn):
p, n = pn
return (
1 + p,
reduce(lambda a, x: a + int(x), str(n), 0)
)
# p :: (Int , Int) -> Bool
def p(pn):
return 10 > pn[1]
return until(p)(f)(
(0, abs(int(n)))
)
# GENERIC -------------------------------------------------
# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
return lambda f: lambda x: g(f(x))
# tabulated :: (a -> b) -> String -> String
def tabulated(f):
'''function -> heading -> input List -> tabulated output string'''
def go(s, xs):
fw = compose(len)(str)
w = fw(max(xs, key=fw))
return s + '\n' + '\n'.join(list(map(
lambda x: str(x).rjust(w, ' ') + ' -> ' + str(f(x)), xs
)))
return lambda s: lambda xs: go(s, xs)
# until :: (a -> Bool) -> (a -> a) -> a -> a
def until(p):
def go(f, x):
v = x
while not p(v):
v = f(v)
return v
return lambda f: lambda x: go(f, x)
if __name__ == '__main__':
main()

23
Task/Digital-root/Quackery/digital-root.quackery Normal file
View file

@ -0,0 +1,23 @@
[ abs 0 swap
[ base share /mod
rot + swap
dup 0 = until ]
drop ] is digitsum ( n --> n )
[ 0 swap
[ dup base share > while
dip 1+
digitsum again ] ] is digitalroot ( n --> n n )
[ dup digitalroot
rot echo
say " has additive persistance "
swap echo
say " and digital root of "
echo
say ";" cr ] is task ( n --> )
627615 task
39390 task
588225 task
393900588225 task

13
Task/Digital-root/R/digital-root.r Normal file
View file

@ -0,0 +1,13 @@
y=1
digital_root=function(n){
x=sum(as.numeric(unlist(strsplit(as.character(n),""))))
if(x<10){
k=x
}else{
y=y+1
assign("y",y,envir = globalenv())
k=digital_root(x)
}
return(k)
}
print("Given number has additive persistence",y)

Some files were not shown because too many files have changed in this diff Show more