Digital root: Difference between revisions
Added Forth version |
|||
(205 intermediate revisions by 98 users not shown) | |||
Line 1: | Line 1: | ||
{{task}} |
{{task}} |
||
Related task [[Sum digits of an integer]] |
|||
The digital root |
The digital root, <math>X</math>, of a number, <math>n</math>, is calculated: |
||
: find X as the sum of the digits of |
: find <math>X</math> as the sum of the digits of <math>n</math> |
||
: find a new X by summing the digits of X repeating until X has only one digit. |
: 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 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 |
The task is to calculate the additive persistence and the digital root of a number, e.g.: |
||
:627615 has additive persistence 2 and digital root of 9; |
:<math>627615</math> has additive persistence <math>2</math> and digital root of <math>9</math>; |
||
:39390 has additive persistence 2 and digital root of 6; |
:<math>39390</math> has additive persistence <math>2</math> and digital root of <math>6</math>; |
||
:588225 has additive persistence 2 and digital root of 3; |
:<math>588225</math> has additive persistence <math>2</math> and digital root of <math>3</math>; |
||
:393900588225 has additive persistence 2 and digital root of 9; |
:<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. |
The digital root may be calculated in bases other than 10. |
||
See: |
|||
*[[Casting out nines]] for this wiki's use of this procedure. |
|||
*[[oeis:A010888|Digital root sequence on OEIS]] |
|||
*[[oeis:A031286|Additive persistence sequence on OEIS]] |
|||
;See: |
|||
=={{header|Ada}}== |
|||
* [[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> |
|||
=={{header|11l}}== |
|||
<lang Ada>with Ada.Text_IO; |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">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] |
|||
procedure Digital_Root is |
|||
Int64 persistance, root |
|||
(persistance, root) = digital_root(n) |
|||
print(‘#12 has additive persistance #2 and digital root #..’.format(n, persistance, root))</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 has additive persistance 2 and digital root 9. |
|||
39390 has additive persistance 2 and digital root 6. |
|||
588225 has additive persistance 2 and digital root 3. |
|||
393900588225 has additive persistance 2 and digital root 9. |
|||
55 has additive persistance 2 and digital root 1. |
|||
</pre> |
|||
=={{header|360 Assembly}}== |
|||
<syntaxhighlight lang="360asm">* 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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
number= 627615 persistence= 2 root=9 |
|||
number= 39390 persistence= 2 root=6 |
|||
number= 588225 persistence= 2 root=3 |
|||
number=2147483647 persistence= 3 root=1 |
|||
</pre> |
|||
=={{header|Ada}}== |
|||
We first specify a Package "Generic_Root" with a generic procedure "Compute". The package is reduced for the implementation of multiplicative digital roots [[http://rosettacode.org/wiki/Digital_root/Multiplicative_digital_root#Ada]]. Further note the tunable parameter for the number base (default 10). |
|||
<syntaxhighlight lang="ada">package Generic_Root is |
|||
type Number is range 0 .. 2**63-1; |
type Number is range 0 .. 2**63-1; |
||
type Number_Array is array(Positive range <>) of Number; |
type Number_Array is array(Positive range <>) of Number; |
||
type Base_Type is range 2 .. 16; -- any reasonable base to write down |
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;</syntaxhighlight> |
|||
The implementation is straightforward: If the input N is a digit, then the root is N and the persistence is zero. Else, commute the digit-sum DS. The root of N is the root of DS, the persistence of N is 1 + (the persistence of DS). |
|||
procedure Compute(N: Number; Digital_Root, Persistence: out Number; |
|||
Base: Base_Type := 10) is |
|||
<syntaxhighlight lang="ada">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 |
function Digit_Sum(N: Number) return Number is |
||
begin |
begin |
||
Line 39: | Line 134: | ||
return N; |
return N; |
||
else |
else |
||
return (N mod Number(Base)) |
return (N mod Number(Base)) & Digit_Sum(N / Number(Base)); |
||
end if; |
end if; |
||
end Digit_Sum; |
end Digit_Sum; |
||
begin |
begin |
||
if N < Number(Base) then |
if N < Number(Base) then |
||
Root := N; |
|||
Persistence := 0; |
Persistence := 0; |
||
else |
else |
||
Compute_Root(Digit_Sum(N), Root, Persistence, Base); |
|||
Persistence := Persistence + 1; |
Persistence := Persistence + 1; |
||
end if; |
end if; |
||
end |
end Compute_Root; |
||
end Generic_Root;</syntaxhighlight> |
|||
Finally the main program. The procedure "Print_Roots" is for our convenience. |
|||
procedure Compute_And_Write(Values: Number_Array; Base: Base_Type := 10) is |
|||
<syntaxhighlight lang="ada">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; |
Root, Pers: Number; |
||
package NIO is new Ada.Text_IO.Integer_IO(Number); |
|||
begin |
begin |
||
for I in |
for I in Inputs'Range loop |
||
Compute( |
Compute(Inputs(I), Root, Pers, Base); |
||
NIO.Put( |
NIO.Put(Inputs(I), Base => Integer(Base), Width => 12); |
||
NIO.Put(Root, Base => Integer(Base), Width => 9); |
|||
NIO.Put( |
NIO.Put(Pers, Base => Integer(Base), Width => 12); |
||
TIO.Put_Line(" " & Base_Type'Image(Base)); |
|||
Ada.Text_IO.Put_Line(" (base" & Base_Type'Image(Base) & ")."); |
|||
end loop; |
end loop; |
||
end |
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;</syntaxhighlight> |
|||
{{out}} |
|||
begin |
|||
Compute_And_Write((961038, 923594037444, 670033, 448944221089)); |
|||
Compute_And_Write((16#7e0#, 16#14e344#, 16#12343210#), 16); |
|||
end Digital_Root;</lang> |
|||
<pre> Number Root Persistence Base |
|||
961038 9 2 10 |
|||
923594037444 9 2 10 |
|||
670033 1 3 10 |
|||
448944221089 1 3 10 |
|||
16#7E0# 16#6# 16#2# 16 |
|||
16#14E344# 16#F# 16#2# 16 |
|||
16#12343210# 16#1# 16#2# 16</pre> |
|||
=={{header|ALGOL 68}}== |
|||
<syntaxhighlight lang="algol68"># 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</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
|||
627615 root: 9 persistance: 2 |
|||
39390 root: 6 persistance: 2 |
|||
588225 root: 3 persistance: 2 |
|||
393900588225 root: 9 persistance: 2 |
|||
</pre> |
|||
=={{header|ALGOL W}}== |
|||
<pre> 961038 has digital root 9 and additive persistence 2 (base 10). |
|||
<syntaxhighlight lang="algolw">begin |
|||
923594037444 has digital root 9 and additive persistence 2 (base 10). |
|||
670033 has digital root 1 and additive persistence 3 (base 10). |
|||
% 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 % |
|||
16#7E0# has digital root 16#6# and additive persistence 2 (base 16). |
|||
% as the lower and upper digits e.g. 393900588225 can be processed by % |
|||
16#14E344# has digital root 16#F# and additive persistence 2 (base 16). |
|||
% specifying upper = 393900, lower = 58825 % |
|||
16#12343210# has digital root 16#1# and additive persistence 2 (base 16).</pre> |
|||
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.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
0, 627615: digital root: 9, persistence: 2 |
|||
0, 39390: digital root: 6, persistence: 2 |
|||
0, 588225: digital root: 3, persistence: 2 |
|||
393900, 588225: digital root: 9, persistence: 2 |
|||
</pre> |
|||
=={{header|AppleScript}}== |
|||
<syntaxhighlight lang="applescript">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)</syntaxhighlight> |
|||
{{out}}<pre>{N:627615, persistences:2, root:9}</pre> |
|||
Or, generalizing to allow for other bases, composing a solution from generic primitives, and testing a few more numbers. |
|||
<syntaxhighlight lang="applescript">-------------------------- 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</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>Base 10: |
|||
Integer -> (additive persistance, digital root) |
|||
627615 -> (2, 9) |
|||
39390 -> (2, 6) |
|||
588225 -> (2, 3) |
|||
3.93900588225E+11 -> (2, 9.0)</pre> |
|||
=={{header|Applesoft BASIC}}== |
|||
<syntaxhighlight lang="applesoftbasic">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,</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 9; |
|||
39390 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 6; |
|||
588225 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 3; |
|||
393900588225 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 9; |
|||
DIGITALROOT(30) HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT Q;</pre> |
|||
=={{header|Arturo}}== |
|||
{{trans|Ruby}} |
|||
<syntaxhighlight lang="rebol">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] |
|||
]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has additive persistence 9 and digital root of 2 |
|||
39390 has additive persistence 6 and digital root of 2 |
|||
588225 has additive persistence 3 and digital root of 2 |
|||
393900588225 has additive persistence 9 and digital root of 2</pre> |
|||
=={{header|AutoHotkey}}== |
|||
<syntaxhighlight lang="autohotkey">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 30: Digital Root = 3, Additive Persistence = 1 |
|||
1597: Digital Root = 4, Additive Persistence = 2 |
|||
381947: Digital Root = 5, Additive Persistence = 2 |
|||
92524902: Digital Root = 6, Additive Persistence = 2 |
|||
448944221089: Digital Root = 1, Additive Persistence = 3</pre> |
|||
=={{header|AWK}}== |
|||
<syntaxhighlight lang="awk"># 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) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 has additive persistence 2 and digital root of 9 |
|||
39390 has additive persistence 2 and digital root of 6 |
|||
588225 has additive persistence 2 and digital root of 3 |
|||
393900588225 has additive persistence 2 and digital root of 9 |
|||
10 has additive persistence 1 and digital root of 1 |
|||
199 has additive persistence 3 and digital root of 1 |
|||
</pre> |
|||
=={{header|BASIC}}== |
=={{header|BASIC}}== |
||
{{works with|QBasic}} |
{{works with|QBasic}} |
||
{{improve}} |
{{improve}} |
||
This calculates the result "the hard way", but is limited to the limits of a 32-bit signed integer (+/-2,147,483,647) and therefore can't calculate the digital root of 393,900,588,225. |
This calculates the result "the hard way", but is limited to the limits of a 32-bit signed integer (+/-2,147,483,647) and therefore can't calculate the digital root of 393,900,588,225. |
||
<syntaxhighlight lang="qbasic">DECLARE SUB digitalRoot (what AS LONG) |
|||
<lang qbasic>DECLARE SUB digitalRoot (what AS LONG) |
|||
'test inputs: |
'test inputs: |
||
Line 111: | Line 885: | ||
END IF |
END IF |
||
PRINT what; ": additive persistance "; c; ", digital root "; w |
PRINT what; ": additive persistance "; c; ", digital root "; w |
||
END SUB</ |
END SUB</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
627615 : additive persistance 2 , digital root 9 |
627615 : additive persistance 2 , digital root 9 |
||
39390 : additive persistance 2 , digital root 6 |
39390 : additive persistance 2 , digital root 6 |
||
588225 : additive persistance 2 , digital root 3 |
588225 : additive persistance 2 , digital root 3 |
||
==={{header|ASIC}}=== |
|||
Compile with the ''Extended math'' option. |
|||
<syntaxhighlight lang="basic"> |
|||
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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 0 1 |
|||
14 1 5 |
|||
267 2 6 |
|||
8128 3 1 |
|||
39390 2 6 |
|||
588225 2 3 |
|||
627615 2 9 |
|||
</pre> |
|||
==={{header|BASIC256}}=== |
|||
<syntaxhighlight lang="vb">global dr |
|||
global ap |
|||
dim a = {627615, 39390, 588225} |
|||
for i = 0 to a[?]-1 |
|||
dr = digitalRoot(a[i]) |
|||
print a[i], "Additive Persistence = "; ap, "Digital root = "; dr |
|||
next i |
|||
end |
|||
function digitalRoot(n) |
|||
ap = 0 |
|||
do |
|||
dr = 0 |
|||
while n > 0 |
|||
dr += n mod 10 |
|||
n = n \ 10 |
|||
end while |
|||
ap += 1 |
|||
n = dr |
|||
until dr < 10 |
|||
return dr |
|||
end function</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 Additive Persistence = 2 Digital root = 9 |
|||
39390 Additive Persistence = 2 Digital root = 6 |
|||
588225 Additive Persistence = 2 Digital root = 3</pre> |
|||
==={{header|Nascom BASIC}}=== |
|||
{{trans|ASIC}} |
|||
{{works with|Nascom ROM BASIC|4.7}} |
|||
<syntaxhighlight lang="basic"> |
|||
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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 1 0 1 |
|||
14 1 5 |
|||
267 2 6 |
|||
8128 3 1 |
|||
39390 2 6 |
|||
588225 2 3 |
|||
627615 2 9</pre> |
|||
==={{header|True BASIC}}=== |
|||
<syntaxhighlight lang="qbasic">SUB digitalroot (what) |
|||
LET dr = ABS(what) |
|||
IF dr > 10 THEN |
|||
LET ap = 0 |
|||
DO |
|||
LET ap = ap + 1 |
|||
DO WHILE dr <> 0 |
|||
LET t = t + REMAINDER(dr, 10) |
|||
LET dr = IP(dr / 10) |
|||
LOOP |
|||
LET dr = t |
|||
LET t = 0 |
|||
LOOP WHILE dr > 9 |
|||
END IF |
|||
PRINT what, "Additive persistance ="; ap, "Digital root ="; dr |
|||
END SUB |
|||
CALL digitalroot (627615) |
|||
CALL digitalroot (39390) |
|||
CALL digitalroot (588225) |
|||
CALL digitalroot (393900588225) |
|||
END</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 Additive persistence = 2 Digital root = 9 |
|||
39390 Additive persistence = 2 Digital root = 6 |
|||
588225 Additive persistence = 2 Digital root = 3 |
|||
393900588225 Additive persistence = 2 Digital root = 9</pre> |
|||
==={{header|Yabasic}}=== |
|||
<syntaxhighlight lang="vb">dim a(2) |
|||
a(0) = 627615 : a(1) = 39390 : a(2) = 588225 |
|||
for i = 0 to arraysize(a(),1) |
|||
dr = digitalRoot(a(i)) |
|||
print a(i), "\tAdditive persistence = ", ap, "\tDigital root = ", dr |
|||
next i |
|||
end |
|||
sub digitalRoot(n) |
|||
ap = 0 |
|||
repeat |
|||
dr = 0 |
|||
while n > 0 |
|||
dr = dr + mod(n, 10) |
|||
n = int(n / 10) |
|||
wend |
|||
ap = ap + 1 |
|||
n = dr |
|||
until dr < 10 |
|||
return dr |
|||
end sub</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 Additive persistence = 2 Digital root = 9 |
|||
39390 Additive persistence = 2 Digital root = 6 |
|||
588225 Additive persistence = 2 Digital root = 3</pre> |
|||
=={{header|Batch File}}== |
|||
<syntaxhighlight lang="dos">:: 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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>(9876543214) |
|||
Additive Persistence=3 Digital Root=4. |
|||
(393900588225) |
|||
Additive Persistence=2 Digital Root=9. |
|||
(1985989328582) |
|||
Additive Persistence=3 Digital Root=5. |
|||
(34559) |
|||
Additive Persistence=2 Digital Root=8. |
|||
Press any key to continue . . .</pre> |
|||
=={{header|BBC BASIC}}== |
=={{header|BBC BASIC}}== |
||
{{works with|BBC BASIC for Windows}} |
{{works with|BBC BASIC for Windows}} |
||
< |
<syntaxhighlight lang="bbcbasic"> *FLOAT64 |
||
PRINT "Digital root of 627615 is "; FNdigitalroot(627615, 10, p) ; |
PRINT "Digital root of 627615 is "; FNdigitalroot(627615, 10, p) ; |
||
PRINT " (additive persistence " ; p ")" |
PRINT " (additive persistence " ; p ")" |
||
Line 148: | Line 1,142: | ||
n = q |
n = q |
||
ENDWHILE |
ENDWHILE |
||
= s</ |
= s</syntaxhighlight> |
||
{{out}} |
|||
'''Output:''' |
|||
<pre> |
|||
<pre>Digital root of 627615 is 9 (additive persistence 2) |
|||
Digital root of 627615 is 9 (additive persistence 2) |
|||
Digital root of 39390 is 6 (additive persistence 2) |
Digital root of 39390 is 6 (additive persistence 2) |
||
Digital root of 588225 is 3 (additive persistence 2) |
Digital root of 588225 is 3 (additive persistence 2) |
||
Line 156: | Line 1,151: | ||
Digital root of 9992 is 2 (additive persistence 3) |
Digital root of 9992 is 2 (additive persistence 3) |
||
</pre> |
</pre> |
||
=={{header|Befunge}}== |
|||
The number, ''n'', is read as a string from stdin in order to support a larger range of values than would typically be accepted by the numeric input of most Befunge implementations. After the initial value has been summed, though, subsequent iterations are simply calculated as integer sums. |
|||
<syntaxhighlight lang="befunge">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: "<</syntaxhighlight> |
|||
{{out}} (multiple runs) |
|||
<pre>Enter number: 1003201 |
|||
Digital root: 7 |
|||
Additive Persistence: 1 |
|||
Enter number: 393900588225 |
|||
Digital root: 9 |
|||
Additive Persistence: 2 |
|||
Enter number: 448944221089 |
|||
Digital root: 1 |
|||
Additive Persistence: 3</pre> |
|||
=={{header|BQN}}== |
|||
A recursive implementation which takes the root and persistence in base 10. |
|||
Other bases can be used by changing the <code>DSum</code> function, which is derived from a [https://mlochbaum.github.io/bqncrate/ BQNcrate] idiom. |
|||
<syntaxhighlight lang="bqn">DSum ← +´10{⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)} |
|||
Root ← 0⊸{(×○⌊÷⟜10)◶⟨𝕨‿𝕩,(1+𝕨)⊸𝕊 Dsum⟩𝕩} |
|||
P ← •Show ⊢∾Root |
|||
P 627615 |
|||
P 39390 |
|||
P 588225 |
|||
P 393900588225</syntaxhighlight> |
|||
<syntaxhighlight lang="text">⟨ 627615 2 9 ⟩ |
|||
⟨ 39390 2 6 ⟩ |
|||
⟨ 588225 2 3 ⟩ |
|||
⟨ 393900588225 2 9 ⟩</syntaxhighlight> |
|||
[https://mlochbaum.github.io/BQN/try.html#code=RFN1bSDihpAgK8K0MTB74oy98J2Vl3zijIriiJjDt+KfnPCdlZfijZ8o4oaVMSvCt+KMivCdlZfii4bigbwx4oyI4oqiKX0KUm9vdCDihpAgMOKKuHsow5fil4vijIrDt+KfnDEwKeKXtuKfqPCdlajigL/wnZWpLCgxK/Cdlagp4oq48J2ViiBEc3Vt4p+p8J2VqX0KClAg4oaQIOKAolNob3cg4oqi4oi+Um9vdApQIDYyNzYxNQpQIDM5MzkwClAgNTg4MjI1ClAgMzkzOTAwNTg4MjI1Cg== Try It!] |
|||
=={{header|Bracmat}}== |
|||
<syntaxhighlight lang="bracmat"> ( 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 |
|||
);</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has additive persistence 2 and digital root of 9 |
|||
39390 has additive persistence 2 and digital root of 6 |
|||
588225 has additive persistence 2 and digital root of 3 |
|||
393900588225 has additive persistence 2 and digital root of 9 |
|||
10 has additive persistence 1 and digital root of 1 |
|||
199 has additive persistence 3 and digital root of 1</pre> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
< |
<syntaxhighlight lang="c">#include <stdio.h> |
||
int droot(long long int x, int base, int *pers) |
int droot(long long int x, int base, int *pers) |
||
Line 183: | Line 1,263: | ||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
=={{header|C sharp|C#}}== |
|||
<syntaxhighlight lang="csharp">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); |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has additive persistence 2 and digital root 9 |
|||
39390 has additive persistence 2 and digital root 6 |
|||
588225 has additive persistence 2 and digital root 3 |
|||
393900588225 has additive persistence 2 and digital root 9</pre> |
|||
=={{header|C++}}== |
=={{header|C++}}== |
||
For details of SumDigits see: http://rosettacode.org/wiki/Sum_digits_of_an_integer |
For details of SumDigits see: http://rosettacode.org/wiki/Sum_digits_of_an_integer |
||
< |
<syntaxhighlight lang="cpp">// Calculate the Digital Root and Additive Persistance of an Integer - Compiles with gcc4.7 |
||
// |
// |
||
// Nigel Galloway. July 23rd., 2012 |
// Nigel Galloway. July 23rd., 2012 |
||
Line 193: | Line 1,304: | ||
#include <iostream> |
#include <iostream> |
||
#include <cmath> |
#include <cmath> |
||
#include < |
#include <utility> |
||
template<class P_> P_ IncFirst(const P_& src) {return P_(src.first + 1, src.second);} |
|||
std::tuple<const unsigned long long int,int,int> DigitalRoot(const unsigned long long int digits, const int BASE = 10) { |
|||
int x = SumDigits(digits,BASE); |
|||
std::pair<int, int> DigitalRoot(unsigned long long digits, int base = 10) |
|||
int ap = 1; |
|||
{ |
|||
while (x >= BASE) { |
|||
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 |
|||
ap++; |
|||
} |
|||
return std::make_tuple(digits,ap,x); |
|||
} |
} |
||
int main() { |
int main() { |
||
const unsigned long long |
const unsigned long long ip[] = {961038,923594037444,670033,448944221089}; |
||
for (auto i:ip){ |
for (auto i:ip){ |
||
auto res = DigitalRoot(i); |
auto res = DigitalRoot(i); |
||
std::cout << |
std::cout << i << " has digital root " << res.second << " and additive persistance " << res.first << "\n"; |
||
} |
} |
||
std::cout << "\n"; |
std::cout << "\n"; |
||
const unsigned long long |
const unsigned long long hip[] = {0x7e0,0x14e344,0xd60141,0x12343210}; |
||
for (auto i:hip){ |
for (auto i:hip){ |
||
auto res = DigitalRoot(i,16); |
auto res = DigitalRoot(i,16); |
||
std::cout << std::hex << |
std::cout << std::hex << i << " has digital root " << res.second << " and additive persistance " << res.first << "\n"; |
||
} |
} |
||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>961038 has digital root 9 and additive persistance 2 |
<pre>961038 has digital root 9 and additive persistance 2 |
||
Line 229: | Line 1,338: | ||
d60141 has digital root a and additive persistance 2 |
d60141 has digital root a and additive persistance 2 |
||
12343210 has digital root 1 and additive persistance 2</pre> |
12343210 has digital root 1 and additive persistance 2</pre> |
||
=={{header|Clojure}}== |
|||
<syntaxhighlight lang="clojure"> |
|||
(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)))))) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
({:n 627615, :add-persist 2, :digital-root 9} |
|||
{:n 39390, :add-persist 2, :digital-root 6} |
|||
{:n 588225, :add-persist 2, :digital-root 3} |
|||
{:n 393900588225, :add-persist 2, :digital-root 9}) |
|||
</pre> |
|||
=={{header|CLU}}== |
|||
<syntaxhighlight lang="clu">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has additive persistence 2 and digital root of 9 |
|||
39390 has additive persistence 2 and digital root of 6 |
|||
588225 has additive persistence 2 and digital root of 3 |
|||
393900588225 has additive persistence 2 and digital root of 9</pre> |
|||
=={{header|Common Lisp}}== |
|||
Using <code>SUM-DIGITS</code> from the task "[[Sum_digits_of_an_integer#Common_Lisp|Sum digits of an integer]]". |
|||
<syntaxhighlight lang="lisp">(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)))</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>627615 (base 10): additive persistence = 2, digital root = 9 |
|||
393900588225 (base 10): additive persistence = 2, digital root = 9 |
|||
14E344 (base 16): additive persistence = 2, digital root = F |
|||
DG9R (base 36): additive persistence = 2, digital root = U</pre> |
|||
=={{header|Component Pascal}}== |
|||
{{Works with|BlackBox Component Builder}} |
|||
<syntaxhighlight lang="oberon2"> |
|||
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. |
|||
</syntaxhighlight> |
|||
Execute: |
|||
^Q DigitalRoot.Do 627615 39390 588225 393900588~ |
|||
{{out}} |
|||
<pre> |
|||
627615 Digital root: 9 Persistence: 2 |
|||
39390 Digital root: 6 Persistence: 2 |
|||
588225 Digital root: 3 Persistence: 2 |
|||
393900588 Digital root: 9 Persistence: 2 |
|||
</pre> |
|||
=={{header|COBOL}}== |
|||
<syntaxhighlight lang="cobol"> 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.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 627615: PERSISTENCE = 2, ROOT = 9 |
|||
39390: PERSISTENCE = 2, ROOT = 6 |
|||
588225: PERSISTENCE = 2, ROOT = 3 |
|||
393900588225: PERSISTENCE = 2, ROOT = 9</pre> |
|||
=={{header|Cowgol}}== |
|||
<syntaxhighlight lang="cowgol">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);</syntaxhighlight> |
|||
{{out}} |
|||
<pre>4: root = 4, persistence = 0 |
|||
627615: root = 9, persistence = 2 |
|||
39390: root = 6, persistence = 2 |
|||
588225: root = 3, persistence = 2 |
|||
9992: root = 2, persistence = 3</pre> |
|||
=={{header|Crystal}}== |
|||
If you just want the digital root, you can use this, which is almost 100x faster than calculating it with persistence: |
|||
<syntaxhighlight lang="ruby">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>9 |
|||
6 |
|||
3 |
|||
1</pre> |
|||
The faster approach when calculating it with persistence uses exponentiation and log to avoid converting to and from strings. |
|||
<syntaxhighlight lang="ruby">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>{9, 2} |
|||
{6, 2} |
|||
{3, 2}</pre> |
|||
However, the string-conversion based solution is easiest to read. |
|||
<syntaxhighlight lang="ruby">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>{9, 2} |
|||
{6, 2} |
|||
{3, 2}</pre> |
|||
=={{header|D}}== |
=={{header|D}}== |
||
< |
<syntaxhighlight lang="d">import std.stdio, std.typecons, std.conv, std.bigint, std.math, |
||
std.traits; |
std.traits; |
||
Tuple!(uint, Unqual!T) digitalRoot(T)(in T inRoot, in uint base) |
Tuple!(uint, Unqual!T) digitalRoot(T)(in T inRoot, in uint base) |
||
pure |
pure nothrow |
||
in { |
in { |
||
assert(base > 1); |
assert(base > 1); |
||
Line 266: | Line 1,684: | ||
foreach (immutable b; [2, 3, 8, 10, 16, 36]) |
foreach (immutable b; [2, 3, 8, 10, 16, 36]) |
||
writefln(f2, b, n.digitalRoot(b)[]); // Shortened output. |
writefln(f2, b, n.digitalRoot(b)[]); // Shortened output. |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>101(2): additive persistance= 2, digital root= 1 |
<pre>101(2): additive persistance= 2, digital root= 1 |
||
Line 313: | Line 1,731: | ||
=={{header|Dc}}== |
=={{header|Dc}}== |
||
Tested on GNU dc. |
Tested on GNU dc. |
||
Procedure p is for breaking up the number into individual digits. |
Procedure <code>p</code> is for breaking up the number into individual digits. |
||
Procedure q is for summing all digits left by procedure p. |
Procedure <code>q</code> is for summing all digits left by procedure <code>p</code>. |
||
Procedure r is for overall control (when to stop). |
Procedure <code>r</code> is for overall control (when to stop). |
||
<syntaxhighlight lang="dc">?[10~rd10<p]sp[+z1<q]sq[lpxlqxd10<r]dsrxp</syntaxhighlight> |
|||
<lang Dc> |
|||
?[10~rd10<p]sp[+z1<q]sq[lpxlqxd10<r]dsrxp |
|||
=={{header|DCL}}== |
|||
</lang> |
|||
<syntaxhighlight lang="dcl">$ 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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>$ @digital_root 627615 |
|||
627615 has additive persistence 2 and digital root of 9 |
|||
$ @digital_root 6 |
|||
6 has additive persistence 0 and digital root of 6 |
|||
$ @digital_root 99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999998 |
|||
99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999998 has additive persistence 3 and digital root of 8</pre> |
|||
=={{header|Delphi}}== |
|||
See [https://rosettacode.org/wiki/Digital_root#Pascal Pascal]. |
|||
=={{header|EasyLang}}== |
|||
<syntaxhighlight lang="easylang"> |
|||
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[] |
|||
digitalRoot i x persistence |
|||
print i |
|||
print "Additive persistence: " & persistence |
|||
print "Digital root: " & x |
|||
. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 |
|||
Additive persistence: 2 |
|||
Digital root: 9 |
|||
39390 |
|||
Additive persistence: 2 |
|||
Digital root: 6 |
|||
588225 |
|||
Additive persistence: 2 |
|||
Digital root: 3 |
|||
393900588225 |
|||
Additive persistence: 2 |
|||
Digital root: 9 |
|||
</pre> |
|||
=={{header|Eiffel}}== |
|||
<syntaxhighlight lang="eiffel"> |
|||
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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
670033 has additive persistence 3 and digital root 1 |
|||
39390 has additive persistence 2 and digital root 6 |
|||
588225 has additive persistence 2 and digital root 3 |
|||
393900588225 has additive persistence 2 and digital root 9 |
|||
</pre> |
|||
=={{header|Elena}}== |
|||
{{trans|C#}} |
|||
ELENA 6.x : |
|||
<syntaxhighlight lang="elena">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) |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 has additive persistence 2 and digital root 9 |
|||
39390 has additive persistence 2 and digital root 6 |
|||
588225 has additive persistence 2 and digital root 3 |
|||
393900588225 has additive persistence 2 and digital root 9 |
|||
</pre> |
|||
=={{header|Elixir}}== |
|||
{{works with|Elixir|1.1}} |
|||
<syntaxhighlight lang="elixir">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)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 has additive persistence 2 and digital root of 9 |
|||
39390 has additive persistence 2 and digital root of 6 |
|||
588225 has additive persistence 2 and digital root of 3 |
|||
393900588225 has additive persistence 2 and digital root of 9 |
|||
Base = 16 |
|||
9939F(16) has additive persistence 2 and digital root of 15 |
|||
99DE(16) has additive persistence 2 and digital root of 15 |
|||
8F9C1(16) has additive persistence 2 and digital root of 15 |
|||
5BB64DFCC1(16) has additive persistence 2 and digital root of 15 |
|||
</pre> |
|||
=={{header|Erlang}}== |
|||
Using [[Sum_digits_of_an_integer]]. |
|||
<syntaxhighlight lang="erlang">-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 ). |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
11> digital_root:task(). |
|||
627615 has additive persistence 2 and digital root of 9 |
|||
39390 has additive persistence 2 and digital root of 6 |
|||
588225 has additive persistence 2 and digital root of 3 |
|||
393900588225 has additive persistence 2 and digital root of 9 |
|||
</pre> |
|||
=={{header|F_Sharp|F#}}== |
|||
This code uses sumDigits from [[Sum_digits_of_an_integer#or_Generically]] |
|||
<syntaxhighlight lang="fsharp"> |
|||
//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) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
> digitalRoot 627615 10;; |
|||
val it : int * int = (9, 2) |
|||
> digitalRoot 39390 10;; |
|||
val it : int * int = (6, 2) |
|||
> digitalRoot 588225 10;; |
|||
val it : int * int = (3, 2) |
|||
> digitalRoot 393900588225L 10L;; |
|||
val it : int64 * int = (9L, 2) |
|||
> digitalRoot 123456789123456789123456789123456789123456789I 10I;; |
|||
val it : System.Numerics.BigInteger * int = (9 {IsEven = false; |
|||
IsOne = false; |
|||
IsPowerOfTwo = false; |
|||
IsZero = false; |
|||
Sign = 1;}, 2) |
|||
</pre> |
|||
=={{header|Factor}}== |
|||
<syntaxhighlight lang="factor">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has additive persistence 2 and digital root 9. |
|||
39390 has additive persistence 2 and digital root 6. |
|||
588225 has additive persistence 2 and digital root 3. |
|||
393900588225 has additive persistence 2 and digital root 9.</pre> |
|||
=={{header|Forth}}== |
=={{header|Forth}}== |
||
This is trivial to do in Forth, because radix control is one of its most prominent feature. The 32-bits version just takes two lines: |
This is trivial to do in Forth, because radix control is one of its most prominent feature. The 32-bits version just takes two lines: |
||
< |
<syntaxhighlight lang="forth">: (Sdigit) 0 swap begin base @ /mod >r + r> dup 0= until drop ; |
||
: digiroot 0 swap begin (Sdigit) >r 1+ r> dup base @ < until ;</ |
: digiroot 0 swap begin (Sdigit) >r 1+ r> dup base @ < until ;</syntaxhighlight> |
||
This will take care of most numbers: |
This will take care of most numbers: |
||
<pre> |
<pre> |
||
Line 331: | Line 2,053: | ||
</pre> |
</pre> |
||
For the last one we will need a "double number" version. '''MU/MOD''' is not available in some Forth implementations, but it is easy to define: |
For the last one we will need a "double number" version. '''MU/MOD''' is not available in some Forth implementations, but it is easy to define: |
||
< |
<syntaxhighlight lang="forth">[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 ; |
: (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 ;</ |
: digiroot 0 -rot begin (Sdigit) 2>r 1+ 2r> 2dup base @ s>d d< until d>s ;</syntaxhighlight> |
||
That one will take care of the last one: |
That one will take care of the last one: |
||
<pre> |
<pre> |
||
393900588225. digiroot . . 9 2 ok |
393900588225. digiroot . . 9 2 ok |
||
</pre> |
</pre> |
||
=={{header|Fortran}}== |
|||
<syntaxhighlight lang="fortran"> |
|||
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 |
|||
</syntaxhighlight> |
|||
<pre> |
|||
Number: 627615 |
|||
digital root = 9 |
|||
additive persistance = 2 |
|||
Number: 39390 |
|||
digital root = 6 |
|||
additive persistance = 2 |
|||
Number: 588225 |
|||
digital root = 3 |
|||
additive persistance = 2 |
|||
Number: 393900588225 |
|||
digital root = 9 |
|||
additive persistance = 2 |
|||
</pre> |
|||
=={{header|FreeBASIC}}== |
|||
<syntaxhighlight lang="freebasic">' 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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 Additive Persistence = 2 Digital root = 9 |
|||
39390 Additive Persistence = 2 Digital root = 6 |
|||
588225 Additive Persistence = 2 Digital root = 3 |
|||
393900588225 Additive Persistence = 2 Digital root = 9 |
|||
</pre> |
|||
=={{header|Fōrmulæ}}== |
|||
{{FormulaeEntry|page=https://formulae.org/?script=examples/Digital_root}} |
|||
'''Solution''' |
|||
[[File:Fōrmulæ - Digital root 01.png]] |
|||
'''Test cases''' |
|||
[[File:Fōrmulæ - Digital root 02.png]] |
|||
[[File:Fōrmulæ - Digital root 03.png]] |
|||
=={{header|Go}}== |
=={{header|Go}}== |
||
With function <code>Sum</code> from [[Sum digits of an integer#Go]]. |
|||
<lang go>package main |
|||
<syntaxhighlight lang="go">package main |
|||
import ( |
|||
"fmt" |
|||
"log" |
|||
"strconv" |
|||
import ( |
|||
"digit" |
|||
"fmt" |
|||
"log" |
|||
"strconv" |
|||
) |
) |
||
func Sum(i uint64, base int) (sum int) { |
|||
type testCase struct { |
|||
b64 := uint64(base) |
|||
n string |
|||
for ; i > 0; i /= b64 { |
|||
sum += int(i % b64) |
|||
persistence int |
|||
} |
|||
root int |
|||
return |
|||
} |
} |
||
func DigitalRoot(n uint64, base int) (persistence, root int) { |
|||
var testCases = []testCase{ |
|||
root = int(n) |
|||
{"627615", 10, 2, 9}, |
|||
for x := n; x >= uint64(base); x = uint64(root) { |
|||
{"39390", 10, 2, 6}, |
|||
root = Sum(x, base) |
|||
{"588225", 10, 2, 3}, |
|||
persistence++ |
|||
{"393900588225", 10, 2, 9}, |
|||
} |
|||
return |
|||
} |
} |
||
// Normally the below would be moved to a *_test.go file and |
|||
func root(n string, base int) (persistence, root int, err error) { |
|||
// use the testing package to be runnable as a regular test. |
|||
i, err := digit.Sum(n, base) |
|||
if err != nil { |
|||
var testCases = []struct { |
|||
return 0, 0, err |
|||
n string |
|||
base int |
|||
persistence int |
|||
return 0, int(i), nil |
|||
root int |
|||
}{ |
|||
for { |
|||
{"627615", 10, 2, 9}, |
|||
persistence++ |
|||
{"39390", 10, 2, 6}, |
|||
n := strconv.FormatInt(i, base) |
|||
{"588225", 10, 2, 3}, |
|||
if len(n) == 1 { |
|||
{"393900588225", 10, 2, 9}, |
|||
root = int(i) |
|||
{"1", 10, 0, 1}, |
|||
break |
|||
{"11", 10, 1, 2}, |
|||
} |
|||
{"e", 16, 0, 0xe}, |
|||
i, _ = digit.Sum(n, base) |
|||
{"87", 16, 1, 0xf}, |
|||
} |
|||
// From Applesoft BASIC example: |
|||
return |
|||
{"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() { |
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) |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 (base 10) has additive persistence 2 and digital root 9 |
|||
39390 (base 10) has additive persistence 2 and digital root 6 |
|||
588225 (base 10) has additive persistence 2 and digital root 3 |
|||
393900588225 (base 10) has additive persistence 2 and digital root 9 |
|||
1 (base 10) has additive persistence 0 and digital root 1 |
|||
11 (base 10) has additive persistence 1 and digital root 2 |
|||
e (base 16) has additive persistence 0 and digital root e |
|||
87 (base 16) has additive persistence 1 and digital root f |
|||
DigitalRoot (base 30) has additive persistence 2 and digital root q |
|||
448944221089 (base 10) has additive persistence 3 and digital root 1 |
|||
7e0 (base 16) has additive persistence 2 and digital root 6 |
|||
14e344 (base 16) has additive persistence 2 and digital root f |
|||
d60141 (base 16) has additive persistence 2 and digital root a |
|||
12343210 (base 16) has additive persistence 2 and digital root 1 |
|||
1101122201121110011000000 (base 3) has additive persistence 3 and digital root 1 |
|||
</pre> |
|||
=={{header|Groovy}}== |
|||
{{trans|Java}} |
|||
<syntaxhighlight lang="groovy">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) |
|||
if p != tc.persistence || r != tc.root { |
|||
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()] |
|||
} |
} |
||
fmt.Println("all tests passed") |
|||
static void main(String[] args) { |
|||
}</lang> |
|||
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]}") |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has additive persistence 2 and digital root of 9 |
|||
39390 has additive persistence 2 and digital root of 6 |
|||
588225 has additive persistence 2 and digital root of 3 |
|||
393900588225 has additive persistence 2 and digital root of 9</pre> |
|||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
<lang |
<syntaxhighlight lang="haskell">import Data.Bifunctor (bimap) |
||
import Data.List (unfoldr) |
|||
f a n = let (q,r) = n`divMod`base in |
|||
import Data.Tuple (swap) |
|||
if q == 0 then a+r else f (a+r) q |
|||
digSum :: Int -> Int -> Int |
|||
digRoot base = f 0 where |
|||
digSum base = sum . unfoldr f |
|||
f p n | n < base = (p,n) |
|||
where |
|||
| otherwise = f (p+1) (digSum base n) |
|||
f 0 = Nothing |
|||
f n = Just (swap (quotRem n base)) |
|||
digRoot :: Int -> Int -> (Int, Int) |
|||
main = do |
|||
digRoot base = |
|||
head . |
|||
mapM_ print $ map (\x -> (x, digRoot 10 x)) [627615, 39390, 588225, 393900588225]</lang> |
|||
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]</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 419: | Line 2,319: | ||
</pre> |
</pre> |
||
< |
<syntaxhighlight lang="haskell">import Data.Tuple (swap) |
||
import Data.Maybe (fromJust) |
import Data.Maybe (fromJust) |
||
import Data.List (elemIndex, unfoldr) |
|||
import Numeric (readInt, showIntAtBase) |
import Numeric (readInt, showIntAtBase) |
||
Line 426: | Line 2,327: | ||
-- base b number. |
-- base b number. |
||
digRoot :: Integer -> Integer -> (Integer, Integer) |
digRoot :: Integer -> Integer -> (Integer, Integer) |
||
digRoot b = find . zip [0..] . iterate (sum . toDigits b) |
digRoot b = find . zip [0 ..] . iterate (sum . toDigits b) |
||
where |
|||
where find = head . dropWhile ((>= b) . snd) |
|||
find = head . dropWhile ((>= b) . snd) |
|||
-- Print the additive persistence and digital root of a base b number (given as |
-- Print the additive persistence and digital root of a base b number (given as |
||
Line 434: | Line 2,336: | ||
printDigRoot b s = do |
printDigRoot b s = do |
||
let (p, r) = digRoot b $ strToInt b s |
let (p, r) = digRoot b $ strToInt b s |
||
putStrLn |
(putStrLn . unwords) |
||
", |
[s, "-> additive persistence:", show p, "digital root:", intToStr b r] |
||
-- |
-- |
||
-- Utility methods for dealing with numbers in different bases. |
-- Utility methods for dealing with numbers in different bases. |
||
-- |
-- |
||
-- Convert a base b number to a list of digits, from least to most significant. |
-- Convert a base b number to a list of digits, from least to most significant. |
||
toDigits |
toDigits |
||
:: Integral a |
|||
toDigits b n = toDigits' n 0 |
|||
=> a -> a -> [a] |
|||
toDigits b = unfoldr f |
|||
where |
|||
toDigits' m _ = let (q, r) = m `quotRem` b in r : toDigits' q r |
|||
f 0 = Nothing |
|||
f n = Just (swap (quotRem n b)) |
|||
-- A list of digits, for bases up to 36. |
-- A list of digits, for bases up to 36. |
||
digits :: String |
digits :: String |
||
digits = ['0'..'9'] ++ ['A'..'Z'] |
digits = ['0' .. '9'] ++ ['A' .. 'Z'] |
||
-- Return a number's base b string representation. |
-- Return a number's base b string representation. |
||
intToStr |
|||
intToStr :: Integral a => a -> a -> String |
|||
:: (Integral a, Show a) |
|||
intToStr b n | b < 2 || b > 36 = error "intToStr: base must be in [2..36]" |
|||
=> a -> a -> String |
|||
| otherwise = showIntAtBase b (digits !!) n "" |
|||
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. |
-- Return the number for the base b string representation. |
||
strToInt |
|||
strToInt :: Integral a => a -> String -> a |
|||
:: Integral a |
|||
strToInt b = fst . head . readInt b (`elem` digits) |
|||
=> a -> String -> a |
|||
(fromJust . (`elemIndex` digits)) |
|||
strToInt b = |
|||
fst . head . readInt b (`elem` digits) (fromJust . (`elemIndex` digits)) |
|||
main :: IO () |
main :: IO () |
||
main = |
main = |
||
mapM_ |
|||
printDigRoot 2 "1001100111011110" |
|||
(uncurry printDigRoot) |
|||
printDigRoot 3 "2000000220" |
|||
[ (2, "1001100111011110") |
|||
printDigRoot 8 "5566623376301" |
|||
, (3, "2000000220") |
|||
printDigRoot 10 "39390" |
|||
, (8, "5566623376301") |
|||
printDigRoot 16 "99DE" |
|||
, (10, "39390") |
|||
printDigRoot 36 "50YE8N29" |
|||
, (16, "99DE") |
|||
printDigRoot 36 "37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN"</lang> |
|||
, (36, "50YE8N29") |
|||
, (36, "37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN") |
|||
]</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
1001100111011110 |
1001100111011110 -> additive persistence: 3 digital root: 1 |
||
2000000220 |
2000000220 -> additive persistence: 2 digital root: 2 |
||
5566623376301 |
5566623376301 -> additive persistence: 3 digital root: 4 |
||
39390 |
39390 -> additive persistence: 2 digital root: 6 |
||
99DE |
99DE -> additive persistence: 2 digital root: F |
||
50YE8N29 |
50YE8N29 -> additive persistence: 2 digital root: P |
||
37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN |
37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN -> additive persistence: 2 digital root: N</pre> |
||
</pre> |
|||
=={{header| |
=={{header|Huginn}}== |
||
<syntaxhighlight lang="huginn">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 ); |
|||
}</syntaxhighlight> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
|||
The following works in both languages: |
The following works in both languages: |
||
<syntaxhighlight lang="unicon">procedure main(A) |
|||
<lang unicon>procedure main(A) |
|||
every m := n := integer(!A) do { |
every m := n := integer(!A) do { |
||
ap := 0 |
ap := 0 |
||
Line 498: | Line 2,424: | ||
n ? while s +:= move(1) |
n ? while s +:= move(1) |
||
return s |
return s |
||
end</ |
end</syntaxhighlight> |
||
{{out|Sample run}} |
|||
Sample run: |
|||
<pre> |
<pre> |
||
->dr 627615 39390 588225 393900588225 |
->dr 627615 39390 588225 393900588225 |
||
Line 512: | Line 2,436: | ||
=={{header|J}}== |
=={{header|J}}== |
||
<syntaxhighlight lang="j">digrt=: 10&$: :(|&.<:^:<:)"0 |
|||
addps=: 10&$: :([: <:@# +/@(#.inv)^:a:)"0</syntaxhighlight> |
|||
With these functions, the base can be supplied as a left argument (dyadic). When being called monadically, they default to base 10. |
|||
addper=: _1 + [: # +/@(#.inv~&10)^:a:</lang> |
|||
Example use: |
Example use: |
||
<syntaxhighlight lang="j"> (,. addps ,. digrt) 627615 39390 588225 393900588225 |
|||
<lang J> (, addper, digrot)&> 627615 39390 588225 393900588225 |
|||
627615 2 9 |
627615 2 9 |
||
39390 2 6 |
39390 2 6 |
||
588225 2 3 |
588225 2 3 |
||
393900588225 2 9 |
393900588225 2 9 |
||
Here's an equality operator for comparing these digital roots: |
|||
8 digrt 8b4321 |
|||
<lang J>equals=: =&(9&|)"0</lang> |
|||
3 |
|||
8 addps 8b4321 |
|||
2</syntaxhighlight> |
|||
Here's an equality operator for comparing these base 10 digital roots: |
|||
table of results: |
|||
<syntaxhighlight lang="j">equals=: =&(9&|)"0</syntaxhighlight> |
|||
Table of results: |
|||
<lang J> equals table i. 10 |
|||
<syntaxhighlight lang="j"> equals table i. 10 |
|||
┌──────┬───────────────────┐ |
┌──────┬───────────────────┐ |
||
│equals│0 1 2 3 4 5 6 7 8 9│ |
│equals│0 1 2 3 4 5 6 7 8 9│ |
||
Line 544: | Line 2,471: | ||
│8 │0 0 0 0 0 0 0 0 1 0│ |
│8 │0 0 0 0 0 0 0 0 1 0│ |
||
│9 │1 0 0 0 0 0 0 0 0 1│ |
│9 │1 0 0 0 0 0 0 0 0 1│ |
||
└──────┴───────────────────┘</ |
└──────┴───────────────────┘</syntaxhighlight> |
||
Note that these routines merely calculate results, which are numbers. If you want the result to be displayed in some other base, converting the result from numbers to character strings needs an additional step. Since that's currently not a part of the task, this is left as an exercise for the reader. |
|||
If digital roots other than 10 are desired, the modifier ~&10 can be removed from the above definitions, and the base can be supplied as a left argument. Since this is a simplification, these definitions are shown here: |
|||
<lang J>digrt=: +/@(#.inv)^:_ |
|||
addpr=: _1 + [: # +/@(#.inv)^:a:</lang> |
|||
Note that these routines merely calculate results, which are numbers. If you want the result to be displayed in some other base converting the result from numbers to character strings needs an additional step. Since that's currently not a part of the task, this is left as an exercise for the reader. |
|||
=={{header|Janet}}== |
|||
<syntaxhighlight lang="janet"> |
|||
(defn numbers [s] (filter (fn [y] (and (<= y 9) (>= y 0))) (map (fn [z] (- z 48)) (string/bytes s)))) |
|||
(defn summa [s] (reduce (fn [x y] (+ x y)) 0 (numbers s))) |
|||
(defn minsumma [x p] |
|||
(if (<= x 9) |
|||
[x p] |
|||
(minsumma (summa (string/format "%d" x)) (+ 1 p)))) |
|||
(defn test [t] (printf "%j" (minsumma (summa t) 1))) |
|||
(test "627615") |
|||
(test "39390") |
|||
(test "588225") |
|||
(test "393900588225") |
|||
(test "19999999999999999999999999999999999999999999999999999999999999999999999999999999999999") |
|||
(test "192348-0347203478-20483298402-39482-04720348-20394823-058720375204820-394823842-049802-93482-034892-3") |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
(9 2) |
|||
(6 2) |
|||
(3 2) |
|||
(9 2) |
|||
(1 4) |
|||
(6 3) |
|||
</pre> |
|||
=={{header|Java}}== |
=={{header|Java}}== |
||
;<nowiki>Code:</nowiki> |
|||
<syntaxhighlight lang="java">import java.math.BigInteger; |
|||
'''Code:''' |
|||
<lang java>import java.math.BigInteger; |
|||
class DigitalRoot |
class DigitalRoot |
||
Line 587: | Line 2,532: | ||
} |
} |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
{{out|Example}} |
|||
'''Example:''' |
|||
<pre>java DigitalRoot 627615 39390 588225 393900588225 |
<pre>java DigitalRoot 627615 39390 588225 393900588225 |
||
627615 has additive persistence 2 and digital root of 9 |
627615 has additive persistence 2 and digital root of 9 |
||
Line 597: | Line 2,540: | ||
393900588225 has additive persistence 2 and digital root of 9</pre> |
393900588225 has additive persistence 2 and digital root of 9</pre> |
||
=={{header| |
=={{header|JavaScript}}== |
||
<syntaxhighlight lang="javascript">/// Digital root of 'x' in base 'b'. |
|||
<lang Mathematica>seq[n_, b_] := FixedPointList[Total[IntegerDigits[#, b]] &, n]; |
|||
/// @return {addpers, digrt} |
|||
root[n_Integer, base_: 10] := If[base == 10, #, BaseForm[#, base]] &[Last[seq[n, base]]] |
|||
function digitalRootBase(x,b) { |
|||
persistance[n_Integer, base_: 10] := Length[seq[n, base]] - 2;</lang> |
|||
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; |
|||
}</syntaxhighlight> |
|||
=={{header|jq}}== |
|||
{{works with|jq|1.4}} |
|||
digital_root(n) is defined here for decimals and strings representing decimals. |
|||
<syntaxhighlight lang="jq">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)*" " + .;</syntaxhighlight> |
|||
'''Examples''': |
|||
<syntaxhighlight lang="jq">( |
|||
" i : [DR, P]", |
|||
(961038, 923594037444, 670033, 448944221089 |
|||
) as $i |
|||
| "\($i|rjust(12)): \(digital_root($i))" |
|||
), |
|||
"", |
|||
"digital_root(\"1\" * 100000) => \(digital_root( "1" * 100000))"</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<syntaxhighlight lang="sh">$ 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]</syntaxhighlight> |
|||
=={{header|Julia}}== |
|||
{{works with|Julia|0.6}} |
|||
<syntaxhighlight lang="julia">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has persistence 2 and digital root 9 |
|||
39390 has persistence 2 and digital root 6 |
|||
588225 has persistence 2 and digital root 3 |
|||
393900588225 has persistence 2 and digital root 9 |
|||
1267650600228229401496703205376 has persistence 2 and digital root 7</pre> |
|||
=={{header|K}}== |
|||
<syntaxhighlight lang="k"> |
|||
/ 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]} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
digroot 627615 |
|||
(`"Digital root = ";9;`"Additive persistence = ";2) |
|||
digroot 39390 |
|||
(`"Digital root = ";6;`"Additive persistence = ";2) |
|||
digroot 588225 |
|||
(`"Digital root = ";3;`"Additive persistence = ";2) |
|||
digroot 393900588225 |
|||
(`"Digital root = ";9;`"Additive persistence = ";2) |
|||
digroot 14 |
|||
(`"Digital root = ";5;`"Additive persistence = ";1) |
|||
digroot 3 |
|||
(`"Digital root = ";3;`"Additive persistence = ";0) |
|||
</pre> |
|||
=={{header|Kotlin}}== |
|||
<syntaxhighlight lang="scala">// 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") |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 has additive persistence 0 and digital root of 1 |
|||
14 has additive persistence 1 and digital root of 5 |
|||
267 has additive persistence 2 and digital root of 6 |
|||
8128 has additive persistence 3 and digital root of 1 |
|||
627615 has additive persistence 2 and digital root of 9 |
|||
39390 has additive persistence 2 and digital root of 6 |
|||
588225 has additive persistence 2 and digital root of 3 |
|||
393900588225 has additive persistence 2 and digital root of 9 |
|||
</pre> |
|||
=={{header|Lua}}== |
|||
With function sum_digits from [http://rosettacode.org/wiki/Sum_digits_of_an_integer#Lua] |
|||
<syntaxhighlight lang="lua">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))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>9 2 |
|||
6 2 |
|||
3 2 |
|||
9 2</pre> |
|||
=={{header|MAD}}== |
|||
<syntaxhighlight lang="mad"> 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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 |
|||
9 2 |
|||
39390 |
|||
6 2 |
|||
588225 |
|||
3 2 |
|||
393900588225 |
|||
9 2 |
|||
</pre> |
|||
=={{header|Malbolge}}== |
|||
<!-- codificado por: matthias@lutter.cc --> |
|||
Código sacado de https://lutter.cc/malbolge/ |
|||
=={{header|Mathematica}} / {{header|Wolfram Language}}== |
|||
<syntaxhighlight lang="mathematica">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;</syntaxhighlight> |
|||
{{out}} |
|||
<pre> root /@ {627615, 39390, 588225 , 393900, 588225, 670033, 448944221089} |
<pre> root /@ {627615, 39390, 588225 , 393900, 588225, 670033, 448944221089} |
||
{9, 6, 3, 6, 3, 1, 1} |
{9, 6, 3, 6, 3, 1, 1} |
||
Line 613: | Line 2,783: | ||
f |
f |
||
16</pre> |
16</pre> |
||
=={{header|Maxima}}== |
|||
<syntaxhighlight lang="maxima"> |
|||
/* Function that returns a list of digits given a nonnegative integer */ |
|||
decompose(num) := block([digits, remainder], |
|||
digits: [], |
|||
while num > 0 do |
|||
(remainder: mod(num, 10), |
|||
digits: cons(remainder, digits), |
|||
num: floor(num/10)), |
|||
digits |
|||
)$ |
|||
/* Function that given a positive integer returns the sum of their digits */ |
|||
auxdig(n):=block(decompose(n),apply("+",%%)); |
|||
/* Function that given a positive integer returns a list of two: the additive persistence and the digital root */ |
|||
digrt(n):=block([additive_persistence:0,digital_root:n], |
|||
while length(decompose(digital_root))>1 do (digital_root:auxdig(digital_root),additive_persistence:additive_persistence+1), |
|||
[additive_persistence,digital_root]); |
|||
/* Examples */ |
|||
digrt(627615); |
|||
digrt(39390); |
|||
digrt(588225); |
|||
digrt(393900588225); |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[2,9] |
|||
[2,6] |
|||
[2,3] |
|||
[2,9] |
|||
</pre> |
|||
=={{header|MiniScript}}== |
|||
<syntaxhighlight lang="miniscript">testNumbers = [627615, 39390, 588225, 393900588225, 45, 9991] |
|||
pad = function(n, width) |
|||
return (n + " " * width)[:width] |
|||
end function |
|||
getDigitalRoot = function(n) |
|||
persistance = 0 |
|||
while floor(log(n)) > 0 |
|||
sum = 0 |
|||
while n > 0 |
|||
sum += n % 10 |
|||
n = floor(n / 10) |
|||
end while |
|||
n = sum |
|||
persistance += 1 |
|||
end while |
|||
return [n, persistance] |
|||
end function |
|||
for num in testNumbers |
|||
digRoot = getDigitalRoot(num) |
|||
print pad(num, 12), "" |
|||
print " has a digital root ", "" |
|||
print digRoot[0], "" |
|||
print " and additive persistance ","" |
|||
print digRoot[1] |
|||
end for</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has a digital root 9 and additive persistance 2 |
|||
39390 has a digital root 6 and additive persistance 2 |
|||
588225 has a digital root 3 and additive persistance 2 |
|||
393900588225 has a digital root 9 and additive persistance 2 |
|||
45 has a digital root 9 and additive persistance 1 |
|||
9991 has a digital root 1 and additive persistance 3 |
|||
</pre> |
|||
=={{header|Modula-2}}== |
|||
<syntaxhighlight lang="modula2">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.</syntaxhighlight> |
|||
=={{header|Modula-3}}== |
|||
{{trans|Modula-2}} |
|||
<syntaxhighlight lang="modula3">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.</syntaxhighlight> |
|||
=={{header|Nanoquery}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="nanoquery">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 627615 has additive persistence 2 and digital root 9. |
|||
39390 has additive persistence 2 and digital root 6. |
|||
588825 has additive persistence 2 and digital root 9. |
|||
393900588225 has additive persistence 2 and digital root 9. |
|||
55 has additive persistence 2 and digital root 1.</pre> |
|||
=={{header|NetRexx}}== |
=={{header|NetRexx}}== |
||
< |
<syntaxhighlight lang="netrexx">/* NetRexx ************************************************************ |
||
* Test digroot |
* Test digroot |
||
**********************************************************************/ |
**********************************************************************/ |
||
Line 648: | Line 3,020: | ||
n=s /* the 'new' number */ |
n=s /* the 'new' number */ |
||
End |
End |
||
return n p /* return root and persistence */</ |
return n p /* return root and persistence */</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
number -> digital_root persistence |
number -> digital_root persistence |
||
Line 658: | Line 3,030: | ||
393900588225 -> 9 2 ok |
393900588225 -> 9 2 ok |
||
393900588225 -> 9 2 expected: 9 3 |
393900588225 -> 9 2 expected: 9 3 |
||
</pre> |
|||
=={{header|Nim}}== |
|||
<syntaxhighlight lang="nim">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 627615 has additive persistence 2 and digital root of 9 |
|||
39390 has additive persistence 2 and digital root of 6 |
|||
588225 has additive persistence 2 and digital root of 3 |
|||
393900588225 has additive persistence 2 and digital root of 9</pre> |
|||
=={{header|OCaml}}== |
|||
<syntaxhighlight lang="ocaml">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]</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615: additive persistence = 2, digital root = 9 |
|||
39390: additive persistence = 2, digital root = 6 |
|||
588225: additive persistence = 2, digital root = 3 |
|||
393900588225: additive persistence = 2, digital root = 9 |
|||
</pre> |
|||
=={{header|Oforth}}== |
|||
Using result of sum digit task : |
|||
<syntaxhighlight lang="oforth">: 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 ;</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[ 627615, 39390 , 588225, 393900588225 ] map(#[ 10 digitalRoot ]) println |
|||
[[9, 2], [6, 2], [3, 2], [9, 2]] |
|||
</pre> |
|||
=={{header|Ol}}== |
|||
<syntaxhighlight lang="scheme"> |
|||
(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)) |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
9 |
|||
6 |
|||
3 |
|||
9 |
|||
</pre> |
</pre> |
||
=={{header|PARI/GP}}== |
=={{header|PARI/GP}}== |
||
< |
<syntaxhighlight lang="parigp">dsum(n)=my(s); while(n, s+=n%10; n\=10); s |
||
additivePersistence(n)=my(s); while(n>9, s++; n=dsum(n)); s |
additivePersistence(n)=my(s); while(n>9, s++; n=dsum(n)); s |
||
digitalRoot(n)=if(n, (n-1)%9+1, 0)</ |
digitalRoot(n)=if(n, (n-1)%9+1, 0)</syntaxhighlight> |
||
=={{header|Pascal}}== |
|||
{{works with|Free Pascal|2.6.2}} |
|||
<syntaxhighlight lang="pascal">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.</syntaxhighlight> |
|||
{{out}} |
|||
<pre>--- Examples in 10-Base --- |
|||
627615(10) has additive persistence 2 and digital root 9. |
|||
39390(10) has additive persistence 2 and digital root 6. |
|||
588225(10) has additive persistence 2 and digital root 3. |
|||
393900588225(10) has additive persistence 2 and digital root 9. |
|||
--- Examples in 16-Base --- |
|||
9939F(16) has additive persistence 2 and digital root 15. |
|||
99DE(16) has additive persistence 2 and digital root 15. |
|||
8F9C1(16) has additive persistence 2 and digital root 15. |
|||
5BB64DFCC1(16) has additive persistence 2 and digital root 15.</pre> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
< |
<syntaxhighlight lang="perl">#!perl |
||
use strict; |
use strict; |
||
use warnings; |
use warnings; |
||
Line 716: | Line 3,256: | ||
print "\n"; |
print "\n"; |
||
} |
} |
||
}</syntaxhighlight> |
|||
} |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 763: | Line 3,301: | ||
BIG(36): persistance = 3, root = 17 |
BIG(36): persistance = 3, root = 17 |
||
</pre> |
</pre> |
||
=={{header|Perl 6}}== |
|||
<lang perl6>sub digroot ($r, :$base = 10) { |
|||
my $root = $r.base($base); |
|||
my $persistence = 0; |
|||
while $root.chars > 1 { |
|||
$root = [+]($root.comb.map({:36($_)})).base($base); |
|||
$persistence++; |
|||
} |
|||
$root, $persistence; |
|||
} |
|||
=={{header|Phix}}== |
|||
my @testnums = |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
627615, |
|||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> |
|||
39390, |
|||
588225, |
|||
<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> |
|||
393900588225, |
|||
<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> |
|||
58142718981673030403681039458302204471300738980834668522257090844071443085937; |
|||
<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> |
|||
for 10, 8, 16, 36 -> $b { |
|||
<span style="color: #000000;">root</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> |
|||
for @testnums -> $n { |
|||
<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> |
|||
printf ":$b\<%s>\ndigital root %s, persistence %s\n\n", |
|||
<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> |
|||
$n.base($b), digroot $n, :base($b); |
|||
<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> |
|||
}</lang> |
|||
<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> |
|||
<!--</syntaxhighlight>--> |
|||
{{out}} |
{{out}} |
||
<pre |
<pre> |
||
627615 root: 9 persistence: 2 |
|||
39390 root: 6 persistence: 2 |
|||
588225 root: 3 persistence: 2 |
|||
393900588225 root: 9 persistence: 2 |
|||
</pre> |
|||
=={{header|PHP}}== |
|||
:10<39390> |
|||
{{trans|TypeScript}} |
|||
digital root 6, persistence 2 |
|||
<syntaxhighlight lang="php"> |
|||
<?php |
|||
// Digital root |
|||
function rootAndPers($n, $bas) |
|||
:10<588225> |
|||
digital root |
// 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) { |
|||
:10<393900588225> |
|||
list($root, $pers) = rootAndPers($a, 10); |
|||
digital root 9, persistence 2 |
|||
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; |
|||
} |
|||
?> |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 0 1 |
|||
14 1 5 |
|||
267 2 6 |
|||
8128 3 1 |
|||
39390 2 6 |
|||
588225 2 3 |
|||
627615 2 9 |
|||
</pre> |
|||
=={{header|Picat}}== |
|||
:10<58142718981673030403681039458302204471300738980834668522257090844071443085937> |
|||
<syntaxhighlight lang="picat">go => |
|||
digital root 4, persistence 3 |
|||
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. |
|||
% |
|||
:8<2311637> |
|||
digital root |
% (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.</syntaxhighlight> |
|||
{{out}} |
|||
:8<114736> |
|||
<pre>627615 har addititive persistence 2 and digital root of 9 |
|||
39390 har addititive persistence 2 and digital root of 6 |
|||
588225 har addititive persistence 2 and digital root of 3 |
|||
393900588225 har addititive persistence 2 and digital root of 9 |
|||
58142718981673030403681039458302204471300738980834668522257090844071443085937 har addititive persistence 3 and digital root of 4</pre> |
|||
=={{header|PicoLisp}}== |
|||
:8<2174701> |
|||
<syntaxhighlight lang="picolisp">(for N (627615 39390 588225 393900588225) |
|||
digital root 1, persistence 3 |
|||
(for ((A . I) N T (sum format (chop I))) |
|||
(T (> 10 I) |
|||
:8<5566623376301> |
|||
(prinl N " has additive persistance " (dec A) " and digital root of " I ";") ) ) )</syntaxhighlight> |
|||
digital root 4, persistence 3 |
|||
{{out}} |
|||
<pre>627615 has additive persistance 2 and digital root of 9; |
|||
:8<10021347156245115014463623107370014314341751427033746320331121536631531505161175135161> |
|||
digital root |
39390 has additive persistance 2 and digital root of 6; |
||
588225 has additive persistance 2 and digital root of 3; |
|||
393900588225 has additive persistance 2 and digital root of 9;</pre> |
|||
:16<9939F> |
|||
digital root F, persistence 2 |
|||
:16<99DE> |
|||
digital root F, persistence 2 |
|||
:16<8F9C1> |
|||
digital root F, persistence 2 |
|||
:16<5BB64DFCC1> |
|||
digital root F, persistence 2 |
|||
:16<808B9CDCA526832679323BE018CC70FA62E1BF3341B251AF666B345389F4BA71> |
|||
digital root 7, persistence 3 |
|||
:36<DG9R> |
|||
digital root U, persistence 2 |
|||
:36<UE6> |
|||
digital root F, persistence 2 |
|||
:36<CLVL> |
|||
digital root F, persistence 2 |
|||
:36<50YE8N29> |
|||
digital root P, persistence 2 |
|||
:36<37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVNCBWNRVNOJYPD> |
|||
digital root H, persistence 3</pre> |
|||
Or if you are more inclined to the functional programming persuasion, you can use the <tt>...</tt> sequence operator to calculate the values without side effects: |
|||
<lang perl6>sub digroot ($r, :$base = 10) { |
|||
my &sum = { [+](.comb.map({:36($_)})).base($base) } |
|||
return .[*-1], .elems-1 |
|||
given $r.base($base), &sum ... { .chars == 1 } |
|||
}</lang> |
|||
=={{header|PL/I}}== |
=={{header|PL/I}}== |
||
<syntaxhighlight lang="pli"> digrt: Proc Options(main); |
|||
<lang pli> |
|||
digrt: Proc Options(main); |
|||
/* REXX *************************************************************** |
/* REXX *************************************************************** |
||
* Test digroot |
* Test digroot |
||
Line 915: | Line 3,473: | ||
Return(res); |
Return(res); |
||
End; |
End; |
||
End; |
End;</syntaxhighlight> |
||
{{out}} |
|||
</lang> |
|||
Output: |
|||
<pre> |
<pre> |
||
7 7 0 |
7 7 0 |
||
Line 925: | Line 3,482: | ||
393900588225 9 2 |
393900588225 9 2 |
||
</pre> |
</pre> |
||
Alternative: |
|||
<syntaxhighlight lang="pl/i">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; |
|||
=={{header|Powershell}}== |
|||
x = n; |
|||
<pre>Uses the recursive function from the 'Sum Digits of an Integer' task.</pre> |
|||
do ap = 1 by 1 until (x < 10); |
|||
<lang Powershell>function Get-DigitalRoot ($n) |
|||
x = sum(d); |
|||
end; |
|||
put skip data (n, x, ap); |
|||
end; |
|||
end digital;</syntaxhighlight> |
|||
Results: |
|||
<pre> |
|||
N= 5 PICT.X=0000000000005 AP= 1; |
|||
N= 627615 PICT.X=0000000000009 AP= 2; |
|||
N= 39390 PICT.X=0000000000006 AP= 2; |
|||
N= 588225 PICT.X=0000000000003 AP= 2; |
|||
N= 393900588225 PICT.X=0000000000009 AP= 2; |
|||
N= 99999999999 PICT.X=0000000000009 AP= 3; |
|||
</pre> |
|||
=={{header|PL/M}}== |
|||
Similar to the Algol W version, this sample handles numbers larger than 65535 ( the largest integer supported by the original 8080 PL/M compiler ) by splitting the numbers into 3 parts. Note that the original 8080 PL/M compiler only supports 8 and 16 bit unsigned values. |
|||
<syntaxhighlight lang="plm">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615: DIGITAL ROOT: 9, PERSISTENCE: 2 |
|||
39390: DIGITAL ROOT: 6, PERSISTENCE: 2 |
|||
588225: DIGITAL ROOT: 3, PERSISTENCE: 2 |
|||
393900588225: DIGITAL ROOT: 9, PERSISTENCE: 2 |
|||
</pre> |
|||
=={{header|Potion}}== |
|||
<syntaxhighlight lang="potion">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)</syntaxhighlight> |
|||
=={{header|PowerShell}}== |
|||
Uses the recursive function from the 'Sum Digits of an Integer' task. |
|||
<syntaxhighlight lang="powershell">function Get-DigitalRoot ($n) |
|||
{ |
{ |
||
function Get-Digitalsum ($n) |
function Get-Digitalsum ($n) |
||
Line 946: | Line 3,659: | ||
} |
} |
||
$DigitalRoot |
$DigitalRoot |
||
}</ |
}</syntaxhighlight> |
||
Command: |
Command: |
||
<pre> |
<pre> |
||
Get-DigitalRoot 65536 |
Get-DigitalRoot 65536 |
||
</pre> |
</pre> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
Sum Additive Persistence |
Sum Additive Persistence |
||
--- -------------------- |
--- -------------------- |
||
7 2 |
7 2 |
||
</pre> |
|||
===Alternative Method=== |
|||
<syntaxhighlight lang="powershell">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 |
|||
} |
|||
}</syntaxhighlight> |
|||
Command: |
|||
<pre> |
|||
Get-DigitalRoot 627615 |
|||
</pre> |
|||
{{out}} |
|||
<pre> |
|||
Name Value |
|||
---- ----- |
|||
AdditivePersistence 2 |
|||
DigitalRoot 9 |
|||
</pre> |
</pre> |
||
=={{header| |
=={{header|Prolog}}== |
||
{{works with|SWI Prolog}} |
|||
<lang PicoLisp>(for N (627615 39390 588225 393900588225) |
|||
<syntaxhighlight lang="prolog">digit_sum(N, Base, Sum):- |
|||
(for ((A . I) N T (sum format (chop I))) |
|||
digit_sum(N, Base, Sum, 0). |
|||
(prinl N " has additive persistance " (dec A) " and digital root of " I ";") ) ) )</lang> |
|||
Output: |
|||
<pre>627615 has additive persistance 2 and digital root of 9; |
|||
39390 has additive persistance 2 and digital root of 6; |
|||
588225 has additive persistance 2 and digital root of 3; |
|||
393900588225 has additive persistance 2 and digital root of 9;</pre> |
|||
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):- |
|||
=={{header|PureBasic}}== |
|||
N < Base, |
|||
<lang purebasic> |
|||
!. |
|||
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):- |
|||
; if you just want the DigitalRoot |
|||
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).</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 has additive persistence 2 and digital root 9. |
|||
39390 has additive persistence 2 and digital root 6. |
|||
588225 has additive persistence 2 and digital root 3. |
|||
393900588225 has additive persistence 2 and digital root 9. |
|||
685943443231217865409 has additive persistence 3 and digital root 4. |
|||
</pre> |
|||
=={{header|PureBasic}}== |
|||
<syntaxhighlight lang="purebasic">; if you just want the DigitalRoot |
|||
; Procedure.q DigitalRoot(N.q) apparently will do |
; Procedure.q DigitalRoot(N.q) apparently will do |
||
; i must have missed something because it seems too simple |
; i must have missed something because it seems too simple |
||
Line 1,022: | Line 3,786: | ||
; cw(DigitalRootandPersistance(N)) |
; cw(DigitalRootandPersistance(N)) |
||
Debug DigitalRootandPersistance(N) |
Debug DigitalRootandPersistance(N) |
||
Next</syntaxhighlight> |
|||
Next |
|||
{{out}} |
|||
</lang> |
|||
;Sample output: |
|||
<pre> |
<pre> |
||
627615 has additive persistance 2 and digital root of X(slow) =9 M(fast) =9 ok |
627615 has additive persistance 2 and digital root of X(slow) =9 M(fast) =9 ok |
||
Line 1,034: | Line 3,796: | ||
=={{header|Python}}== |
=={{header|Python}}== |
||
===Procedural=== |
|||
<lang python>def droot (n): |
|||
<syntaxhighlight lang="python">def digital_root (n): |
|||
x = [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]: |
|||
for n in [627615, 39390, 588225, 393900588225, 55]: |
|||
a, d = droot (n) |
|||
persistance, root = digital_root(n) |
|||
print("%12i has additive persistance %2i and digital root %i." |
|||
n, a, d)</lang> |
|||
% (n, persistance, root))</syntaxhighlight> |
|||
{{out}} |
|||
;Sample output: |
|||
<pre> 627615 has additive persistance 2 and digital root |
<pre> 627615 has additive persistance 2 and digital root 9. |
||
39390 has additive persistance 2 and digital root |
39390 has additive persistance 2 and digital root 6. |
||
588225 has additive persistance 2 and digital root |
588225 has additive persistance 2 and digital root 3. |
||
393900588225 has additive persistance 2 and digital root |
393900588225 has additive persistance 2 and digital root 9. |
||
55 has additive persistance 2 and digital root 1.</pre> |
|||
===Composition of pure functions=== |
|||
A useful functional abstraction for this kind of pattern is '''until''' ''p f x'' (predicate, function, start value). |
|||
For the digit sum, we can fuse the two-pass composition of '''sum''' and '''for''' in the procedural version to a single [[Catamorphism|'fold' or catamorphism]] using '''reduce'''. |
|||
The tabulation of '''f(x)''' values can be derived by a generalised function over the '''f''', a header string '''s''', and the input '''xs''': |
|||
<syntaxhighlight lang="python">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()</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>Integer -> (additive persistence, digital root): |
|||
627615 -> (2, 9) |
|||
39390 -> (2, 6) |
|||
588225 -> (2, 3) |
|||
393900588225 -> (2, 9) |
|||
55 -> (2, 1)</pre> |
|||
=={{header|Quackery}}== |
|||
<syntaxhighlight lang="quackery">[ 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</syntaxhighlight> |
|||
'''Output:''' |
|||
<pre>627615 has additive persistance 9 and digital root of 2; |
|||
39390 has additive persistance 6 and digital root of 2; |
|||
588225 has additive persistance 3 and digital root of 2; |
|||
393900588225 has additive persistance 9 and digital root of 2; |
|||
</pre> |
|||
=={{header|R}}== |
|||
The code prints digital root and persistence seperately |
|||
<syntaxhighlight lang="r">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)</syntaxhighlight> |
|||
=={{header|Racket}}== |
=={{header|Racket}}== |
||
< |
<syntaxhighlight lang="racket">#lang racket |
||
(define/contract (additive-persistence/digital-root n (ap 0)) |
(define/contract (additive-persistence/digital-root n (ap 0)) |
||
(->* (natural-number/c) (natural-number/c) (values natural-number/c natural-number/c)) |
(->* (natural-number/c) (natural-number/c) (values natural-number/c natural-number/c)) |
||
Line 1,076: | Line 3,973: | ||
(check-equal? a ap) |
(check-equal? a ap) |
||
(check-equal? d dr) |
(check-equal? d dr) |
||
(printf ":~a has additive persistence ~a and digital root of ~a;~%" n a d))))) |
(printf ":~a has additive persistence ~a and digital root of ~a;~%" n a d)))))</syntaxhighlight> |
||
{{out}} |
|||
</lang> |
|||
Ouput: |
|||
<pre>627615 has additive persistence 2 and digital root of 9 |
<pre>627615 has additive persistence 2 and digital root of 9 |
||
39390 has additive persistence 2 and digital root of 6 |
39390 has additive persistence 2 and digital root of 6 |
||
588225 has additive persistence 2 and digital root of 3 |
588225 has additive persistence 2 and digital root of 3 |
||
393900588225 has additive persistence 2 and digital root of 9</pre> |
393900588225 has additive persistence 2 and digital root of 9</pre> |
||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
<syntaxhighlight lang="raku" line>sub digital-root ($r, :$base = 10) { |
|||
my $root = $r.base($base); |
|||
my $persistence = 0; |
|||
while $root.chars > 1 { |
|||
$root = $root.comb.map({:36($_)}).sum.base($base); |
|||
$persistence++; |
|||
} |
|||
$root, $persistence; |
|||
} |
|||
my @testnums = |
|||
627615, |
|||
39390, |
|||
588225, |
|||
393900588225, |
|||
58142718981673030403681039458302204471300738980834668522257090844071443085937; |
|||
for 10, 8, 16, 36 -> $b { |
|||
for @testnums -> $n { |
|||
printf ":$b\<%s>\ndigital root %s, persistence %s\n\n", |
|||
$n.base($b), digital-root $n, :base($b); |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>:10<627615> |
|||
digital root 9, persistence 2 |
|||
:10<39390> |
|||
digital root 6, persistence 2 |
|||
:10<588225> |
|||
digital root 3, persistence 2 |
|||
:10<393900588225> |
|||
digital root 9, persistence 2 |
|||
:10<58142718981673030403681039458302204471300738980834668522257090844071443085937> |
|||
digital root 4, persistence 3 |
|||
:8<2311637> |
|||
digital root 2, persistence 3 |
|||
:8<114736> |
|||
digital root 1, persistence 3 |
|||
:8<2174701> |
|||
digital root 1, persistence 3 |
|||
:8<5566623376301> |
|||
digital root 4, persistence 3 |
|||
:8<10021347156245115014463623107370014314341751427033746320331121536631531505161175135161> |
|||
digital root 3, persistence 3 |
|||
:16<9939F> |
|||
digital root F, persistence 2 |
|||
:16<99DE> |
|||
digital root F, persistence 2 |
|||
:16<8F9C1> |
|||
digital root F, persistence 2 |
|||
:16<5BB64DFCC1> |
|||
digital root F, persistence 2 |
|||
:16<808B9CDCA526832679323BE018CC70FA62E1BF3341B251AF666B345389F4BA71> |
|||
digital root 7, persistence 3 |
|||
:36<DG9R> |
|||
digital root U, persistence 2 |
|||
:36<UE6> |
|||
digital root F, persistence 2 |
|||
:36<CLVL> |
|||
digital root F, persistence 2 |
|||
:36<50YE8N29> |
|||
digital root P, persistence 2 |
|||
:36<37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVNCBWNRVNOJYPD> |
|||
digital root H, persistence 3</pre> |
|||
Or if you are more inclined to the functional programming persuasion, you can use the <tt>…</tt> sequence operator to calculate the values without side effects: |
|||
<syntaxhighlight lang="raku" line>sub digital-root ($r, :$base = 10) { |
|||
my &sum = { .comb.map({:36($_)}).sum.base($base) } |
|||
return .[*-1], .elems-1 |
|||
given $r.base($base), &sum … { .chars == 1 } |
|||
}</syntaxhighlight> |
|||
Output same as above. |
|||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
===version 1=== |
===version 1=== |
||
< |
<syntaxhighlight lang="rexx">/* REXX *************************************************************** |
||
* Test digroot |
* Test digroot |
||
**********************************************************************/ |
**********************************************************************/ |
||
Line 1,113: | Line 4,102: | ||
n=s /* the 'new' number */ |
n=s /* the 'new' number */ |
||
End |
End |
||
return n p /* return root and persistence */</ |
return n p /* return root and persistence */</syntaxhighlight> |
||
===version 2=== |
===version 2=== |
||
< |
<syntaxhighlight lang="rexx">/*REXX program calculates and displays the digital root and additive persistence. */ |
||
say 'digital additive' /*display the 1st line of the header.*/ |
|||
say |
say " root persistence" center('number',77) /* " " 2nd " " " " */ |
||
say |
say "═══════ ═══════════" left('', 77, "═") /* " " 3rd " " " " */ |
||
say digRoot( 627615) |
|||
say '═══════ ═══════════' center('' ,79,'═') /* " " " " */ |
|||
say digRoot( 39390) |
|||
say digRoot( 588225) |
|||
say digRoot( 393900588225) |
|||
say digRoot(89999999999999999999999999999999999999999999999999999999999999999999999999999) |
|||
call digRoot 393900588225 |
|||
say "═══════ ═══════════" left('', 77, "═") /*display the foot separator. */ |
|||
call digRoot 899999999999999999999999999999999999999999999999999999999999999999999999999999999 |
|||
exit /*stick a fork in it, we're done.*/ |
exit 0 /*stick a fork in it, we're all done. */ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
/*──────────────────────────────────DIGROOT subroutine──────────────────*/ |
|||
digRoot: procedure; |
digRoot: procedure; parse arg x 1 z; L= length(x) /*get a number & also another copy*/ |
||
do pers= |
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 /*j*/ |
|||
end /*pers*/ |
|||
return center(x, 7) center(pers, 11) z /*return a nicely formatted line. */</syntaxhighlight> |
|||
end /*pers*/ |
|||
{{out|output|text= when using the internal default inputs:}} |
|||
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */ |
|||
<pre> |
|||
return</lang> |
|||
digital additive |
|||
'''output''' |
|||
root persistence number |
|||
<pre style="overflow:scroll"> |
|||
═══════ ═══════════ ═════════════════════════════════════════════════════════════════════════════ |
|||
digital |
|||
root persistance number |
|||
═══════ ═══════════ ═══════════════════════════════════════════════════════════════════════════════ |
|||
9 2 627615 |
9 2 627615 |
||
6 2 39390 |
6 2 39390 |
||
3 2 588225 |
3 2 588225 |
||
9 2 393900588225 |
9 2 393900588225 |
||
8 3 89999999999999999999999999999999999999999999999999999999999999999999999999999 |
|||
8 3 899999999999999999999999999999999999999999999999999999999999999999999999999999999 |
|||
═══════ ═══════════ ═════════════════════════════════════════════════════════════════════════════ |
|||
</pre> |
</pre> |
||
===version 3=== |
===version 3=== |
||
This subroutine version can handle numbers with signs, blanks, and/or decimal points. |
This subroutine version can also handle numbers with signs, blanks, commas, and/or decimal points. |
||
<syntaxhighlight lang="rexx">/*REXX program calculates and displays the digital root and additive persistence. */ |
|||
<lang rexx>/*──────────────────────────────────DIGROOT subroutine──────────────────*/ |
|||
say 'digital additive' /*display the 1st line of the header.*/ |
|||
digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */ |
|||
say " root persistence" center('number',77) /* " " 2nd " " " " */ |
|||
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/ |
|||
say "═══════ ═══════════" left('', 77, "═") /* " " 3rd " " " " */ |
|||
do j=1 for length(x) /*add each digit in the number. */ |
|||
say digRoot( 627615) |
|||
?=substr(x,j,1) /*pick off a char, maybe a dig ? */ |
|||
say digRoot( 39390) |
|||
if datatype(?,'W') then r=r+? /*add a digit to the digital root*/ |
|||
say digRoot( 588225) |
|||
say digRoot( 393900588225) |
|||
x=r /*'new' num, it may be multi-dig.*/ |
|||
say digRoot(89999999999999999999999999999999999999999999999999999999999999999999999999999) |
|||
end /*pers*/ |
|||
say "═══════ ═══════════" left('', 77, "═") /*display the foot separator. */ |
|||
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */ |
|||
exit 0 /*stick a fork in it, we're all done. */ |
|||
return</lang> |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
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.*/</syntaxhighlight> |
|||
{{out|output|text= is identical to the 2<sup>nd</sup> REXX version.}} <br><br> |
|||
===Version 4=== |
|||
=={{header|REXX}}== |
|||
'''Libraries:''' [[Mathematics.hel|How to use]]<br> |
|||
'''Library:''' [[Mathematics.rex#Numbers|Numbers]]<br> |
|||
'''Library:''' [[Mathematics.rex#Functions|Functions]]<br> |
|||
For calculation of the Digital root there exists a closed formula, as given in the Wikipedia article on this topic. For bigger numbers a formula is 5-10 times faster than just counting digits. For the Additional persistence no such formula is known. So there you'll still need the whole algorithm.<br> |
|||
Nevertheless, since function Digital root might be needed stand-alone (i.e. the REXX entry for Perfect numbers), I coded a solution where the two functions are split up. |
|||
<syntaxhighlight lang="rexx"> |
|||
numeric digits 30; glob. = '' |
|||
parse version version; say version Digits() 'digits' |
|||
say 'Digital root: Use REXX libraries'; say |
|||
say Show(0) |
|||
say Show(9) |
|||
say Show(10) |
|||
say Show(19) |
|||
say Show(199) |
|||
say Show(679) |
|||
say Show(6788) |
|||
say Show(39390) |
|||
say Show(588225) |
|||
say Show(2677889) |
|||
say Show(393900588225) |
|||
say Show(19999999999999999999999) |
|||
exit |
|||
Show: |
|||
arg x |
|||
return 'Number:' x 'Digital root:' Digitroot(x) 'Additive persistence:' Persistence(x) |
|||
Digitroot: |
|||
/* Digital root function */ |
|||
procedure expose glob. |
|||
arg x |
|||
/* Validity */ |
|||
if \ Whole(x) then |
|||
return 'X' |
|||
if x < 0 then |
|||
return 'X' |
|||
/* Formula */ |
|||
return 1+(x-1)//9 |
|||
Persistence: |
|||
/* Additive persistence function */ |
|||
procedure expose glob. |
|||
arg x |
|||
/* Validity */ |
|||
if \ Whole(x) then |
|||
return 'X' |
|||
if x < 0 then |
|||
return 'X' |
|||
/* Fast value */ |
|||
if x < 10 then |
|||
return 0 |
|||
/* Cf definition */ |
|||
do y = 1 until x < 10 |
|||
x = Digitsum(x) |
|||
end |
|||
return y |
|||
Digitsum: |
|||
/* Digitsum function = sum(digits) */ |
|||
procedure expose glob. |
|||
arg x |
|||
/* Validity */ |
|||
if \ Whole(x) then |
|||
return 'X' |
|||
if x < 0 then |
|||
return 'X' |
|||
/* Sum digits */ |
|||
y = 0 |
|||
do n = 1 to Length(x) |
|||
y = y+Substr(x,n,1) |
|||
end |
|||
return y |
|||
include Numbers |
|||
include Functions |
|||
</syntaxhighlight> |
|||
Most of the code is parameter checking or fast values, but this is a neat and elegant solution. Though slightly slower than the previous versions. |
|||
{{out|Output}} |
|||
<pre> |
|||
REXX-Regina_3.9.6(MT) 5.00 29 Apr 2024 30 digits |
|||
Digital root: Use REXX libraries |
|||
Number: 0 Digital root: 0 Additive persistence: 0 |
|||
Number: 9 Digital root: 9 Additive persistence: 0 |
|||
Number: 10 Digital root: 1 Additive persistence: 1 |
|||
Number: 19 Digital root: 1 Additive persistence: 2 |
|||
Number: 199 Digital root: 1 Additive persistence: 3 |
|||
Number: 679 Digital root: 4 Additive persistence: 2 |
|||
Number: 6788 Digital root: 2 Additive persistence: 3 |
|||
Number: 39390 Digital root: 6 Additive persistence: 2 |
|||
Number: 588225 Digital root: 3 Additive persistence: 2 |
|||
Number: 2677889 Digital root: 2 Additive persistence: 3 |
|||
Number: 393900588225 Digital root: 9 Additive persistence: 2 |
|||
Number: 19999999999999999999999 Digital root: 1 Additive persistence: 4 |
|||
</pre> |
|||
=={{header|Ring}}== |
|||
<syntaxhighlight lang="ring"> |
|||
c = 0 |
|||
see "Digital root of 627615 is " + digitRoot(627615, 10) + " persistance is " + c + nl |
|||
see "Digital root of 39390 is " + digitRoot(39390, 10) + " persistance is " + c + nl |
|||
see "Digital root of 588225 is " + digitRoot(588225, 10) + " persistance is " + c + nl |
|||
see "Digital root of 9992 is " + digitRoot(9992, 10) + " persistance is " + c + nl |
|||
func digitRoot n,b |
|||
c = 0 |
|||
while n >= b |
|||
c = c + 1 |
|||
n = digSum(n, b) |
|||
end |
|||
return n |
|||
func digSum n, b |
|||
s = 0 |
|||
while n != 0 |
|||
q = floor(n / b) |
|||
s = s + n - q * b |
|||
n = q |
|||
end |
|||
return s |
|||
</syntaxhighlight> |
|||
=={{header|RPL}}== |
|||
Base 10 only. For other bases, use <code>DIGITS</code> from [[Factors of an integer#RPL]] instead of <code>∑DGIT</code> below, which is more compact - but works only in base 10. |
|||
≪ 0 SWAP |
|||
'''DO''' 10 / LAST MOD ROT + RND SWAP FLOOR |
|||
'''UNTIL''' DUP NOT '''END''' DROP |
|||
≫ ''''∑DGIT'''' STO |
|||
≪ 0 '''WHILE''' OVER 9 > '''REPEAT''' |
|||
1 + SWAP '''∑DGIT''' SWAP '''END''' R→C |
|||
≫ ''''DROOT'''' STO |
|||
≪ { 627615 39390 588225 393900588225 55 } → cases |
|||
≪ {} 1 cases SIZE '''FOR''' j cases j GET '''DROOT''' + '''NEXT''' |
|||
≫ ≫ EVAL |
|||
{out} |
|||
<pre> |
|||
1: { (9,2) (6,2) (3,2) (9,2) (1,2) } |
|||
</pre> |
|||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
< |
<syntaxhighlight lang="ruby">class String |
||
def |
def digroot_persistence(base=10) |
||
num = self.to_i(base) |
num = self.to_i(base) |
||
persistence = 0 |
|||
until num < base do |
until num < base do |
||
num = num. |
num = num.digits(base).sum |
||
persistence += 1 |
|||
end |
end |
||
[num.to_s(base), |
[num.to_s(base), persistence] |
||
end |
end |
||
end |
end |
||
puts "--- Examples in 10-Base ---" |
|||
#Handles bases upto 36; Demo: |
|||
%w(627615 39390 588225 393900588225).each do |str| |
|||
puts "%12s has a digital root of %s and a persistence of %s." % [str, *str.digroot_persistence] |
|||
end |
|||
puts "\n--- Examples in other Base ---" |
|||
format = "%s base %s has a digital root of %s and a persistence of %s." |
|||
[["101101110110110010011011111110011000001", 2], |
[["101101110110110010011011111110011000001", 2], |
||
[ "5BB64DFCC1", 16], |
[ "5BB64DFCC1", 16], |
||
["5", |
["5", 8], |
||
["50YE8N29", 36]].each do |(str, base)| |
|||
["393900588225", 10], |
|||
puts format % [str, base, *str.digroot_persistence(base)] |
|||
["50YE8N29", 36]].each{|(str, base)| puts "#{str} base #{base} has a digital root \ |
|||
end</syntaxhighlight> |
|||
of %s and a resistance of %s." % str.digroot_persistance(base) }</lang> |
|||
{{out}} |
|||
{{Output}} |
|||
<pre> |
<pre> |
||
--- Examples in 10-Base --- |
|||
101101110110110010011011111110011000001 base 2 has a digital root of 1 and a resistance of 3. |
|||
627615 has a digital root of 9 and a persistence of 2. |
|||
39390 has a digital root of 6 and a persistence of 2. |
|||
588225 has a digital root of 3 and a persistence of 2. |
|||
393900588225 has a digital root of 9 and a persistence of 2. |
|||
--- Examples in other Base --- |
|||
101101110110110010011011111110011000001 base 2 has a digital root of 1 and a persistence of 3. |
|||
5BB64DFCC1 base 16 has a digital root of f and a persistence of 2. |
|||
5 base 8 has a digital root of 5 and a persistence of 0. |
|||
50YE8N29 base 36 has a digital root of p and a persistence of 2. |
|||
</pre> |
</pre> |
||
=={{header|Run BASIC}}== |
=={{header|Run BASIC}}== |
||
< |
<syntaxhighlight lang="runbasic">print "Digital root of 627615 is "; digitRoot$(627615, 10) |
||
print "Digital root of 39390 is "; digitRoot$(39390, 10) |
print "Digital root of 39390 is "; digitRoot$(39390, 10) |
||
print "Digital root of 588225 is "; digitRoot$(588225, 10) |
print "Digital root of 588225 is "; digitRoot$(588225, 10) |
||
Line 1,215: | Line 4,366: | ||
wend |
wend |
||
digSum = s |
digSum = s |
||
end function</ |
end function</syntaxhighlight> |
||
{{out}} |
|||
<pre>Digital root of 627615 is 9 persistance is 2 |
<pre>Digital root of 627615 is 9 persistance is 2 |
||
Digital root of 39390 is 6 persistance is 2 |
Digital root of 39390 is 6 persistance is 2 |
||
Line 1,221: | Line 4,373: | ||
Digital root of 393900588225 is 9 persistance is 2 |
Digital root of 393900588225 is 9 persistance is 2 |
||
Digital root of 9992 is 2 persistance is 3</pre> |
Digital root of 9992 is 2 persistance is 3</pre> |
||
=={{header|Rust}}== |
|||
<syntaxhighlight lang="rust">fn sum_digits(mut n: u64, base: u64) -> u64 { |
|||
let mut sum = 0u64; |
|||
while n > 0 { |
|||
sum = sum + (n % base); |
|||
n = n / base; |
|||
} |
|||
sum |
|||
} |
|||
// Returns tuple of (additive-persistence, digital-root) |
|||
fn digital_root(mut num: u64, base: u64) -> (u64, u64) { |
|||
let mut pers = 0; |
|||
while num >= base { |
|||
pers = pers + 1; |
|||
num = sum_digits(num, base); |
|||
} |
|||
(pers, num) |
|||
} |
|||
fn main() { |
|||
// Test base 10 |
|||
let values = [627615u64, 39390u64, 588225u64, 393900588225u64]; |
|||
for &value in values.iter() { |
|||
let (pers, root) = digital_root(value, 10); |
|||
println!("{} has digital root {} and additive persistance {}", |
|||
value, |
|||
root, |
|||
pers); |
|||
} |
|||
println!(""); |
|||
// Test base 16 |
|||
let values_base16 = [0x7e0, 0x14e344, 0xd60141, 0x12343210]; |
|||
for &value in values_base16.iter() { |
|||
let (pers, root) = digital_root(value, 16); |
|||
println!("0x{:x} has digital root 0x{:x} and additive persistance 0x{:x}", |
|||
value, |
|||
root, |
|||
pers); |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 has digital root 9 and additive persistance 2 |
|||
39390 has digital root 6 and additive persistance 2 |
|||
588225 has digital root 3 and additive persistance 2 |
|||
393900588225 has digital root 9 and additive persistance 2 |
|||
0x7e0 has digital root 0x6 and additive persistance 0x2 |
|||
0x14e344 has digital root 0xf and additive persistance 0x2 |
|||
0xd60141 has digital root 0xa and additive persistance 0x2 |
|||
0x12343210 has digital root 0x1 and additive persistance 0x2 |
|||
</pre> |
|||
=={{header|S-BASIC}}== |
|||
We operate on the number as a string to avoid the limitations of S-BASIC's 16-bit integer type |
|||
<syntaxhighlight lang="BASIC"> |
|||
rem - return the digital sum of n represented as a string |
|||
function digitalsum(nstr = string) = integer |
|||
var i, slen, sum = integer |
|||
var ch = char |
|||
slen = len(nstr) |
|||
sum = 0 |
|||
for i = 1 to slen |
|||
ch = mid(nstr, i, 1) |
|||
rem - don't process leading or embedded spaces, etc. |
|||
if ch >= '0' and ch <= '9' then |
|||
sum = sum + (ch - '0') |
|||
next i |
|||
end = sum |
|||
var nstr = string |
|||
var droot, pers = integer |
|||
0again |
|||
rem - input1 does not advance to next line; control-C will exit |
|||
input1 "What number"; nstr |
|||
droot = digitalsum(nstr) |
|||
pers = 1 |
|||
while droot > 9 do |
|||
begin |
|||
droot = digitalsum(str$(droot)) |
|||
pers = pers + 1 |
|||
end |
|||
print " digital root ="; droot; " persistence ="; pers |
|||
goto 0again |
|||
end |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
Control-C at the prompt provides a quick and dirty exit |
|||
<pre> |
|||
What number ? 627615 digital root = 9 persistence = 2 |
|||
What number ? 39390 digital root = 6 persistence = 2 |
|||
What number ? 588225 digital root = 3 persistence = 2 |
|||
What number ? 393900588225 digital root = 9 persistence = 2 |
|||
What number ? |
|||
</pre> |
|||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
< |
<syntaxhighlight lang="scala">def digitalRoot(x:BigInt, base:Int=10):(Int,Int) = { |
||
def sumDigits(x:BigInt):Int=x.toString(base) map (_.asDigit) sum |
def sumDigits(x:BigInt):Int=x.toString(base) map (_.asDigit) sum |
||
def loop(s:Int, c:Int):(Int,Int)=if (s < 10) (s, c) else loop(sumDigits(s), c+1) |
def loop(s:Int, c:Int):(Int,Int)=if (s < 10) (s, c) else loop(sumDigits(s), c+1) |
||
Line 1,234: | Line 4,488: | ||
} |
} |
||
var (s, c)=digitalRoot(0x7e0, 16) |
var (s, c)=digitalRoot(0x7e0, 16) |
||
println("%x has additive persistance %d and digital root of %d".format(0x7e0,c,s))</ |
println("%x has additive persistance %d and digital root of %d".format(0x7e0,c,s))</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>627615 has additive persistance 2 and digital root of 9 |
<pre>627615 has additive persistance 2 and digital root of 9 |
||
Line 1,241: | Line 4,495: | ||
393900588225 has additive persistance 2 and digital root of 9 |
393900588225 has additive persistance 2 and digital root of 9 |
||
7e0 has additive persistance 2 and digital root of 6</pre> |
7e0 has additive persistance 2 and digital root of 6</pre> |
||
=={{header|Scheme}}== |
|||
{{works with|Chez Scheme}} |
|||
<syntaxhighlight lang="scheme">; Convert an integer into a list of its digits. |
|||
(define integer->list |
|||
(lambda (integer) |
|||
(let loop ((list '()) (int integer)) |
|||
(if (< int 10) |
|||
(cons int list) |
|||
(loop (cons (remainder int 10) list) (quotient int 10)))))) |
|||
; Return the sum of the digits of an integer. |
|||
(define integer-sum-digits |
|||
(lambda (integer) |
|||
(fold-left + 0 (integer->list integer)))) |
|||
; Compute the digital root (additive) and additive persistence of an integer. |
|||
; Return as a cons of (adr . ap). |
|||
(define adr-ap |
|||
(lambda (integer) |
|||
(let loop ((int integer) (cnt 0)) |
|||
(if (< int 10) |
|||
(cons int cnt) |
|||
(loop (integer-sum-digits int) (1+ cnt)))))) |
|||
; Emit a table of integer, digital root (additive), and additive persistence |
|||
; for the example integers given. |
|||
(printf "~13@a ~6@a ~6@a~%" "Integer" "Root" "Pers.") |
|||
(let rowloop ((intlist '(627615 39390 588225 393900588225 0 1 68010887038))) |
|||
(when (pair? intlist) |
|||
(let* ((int (car intlist)) |
|||
(aa (adr-ap int))) |
|||
(printf "~13@a ~6@a ~6@a~%" int (car aa) (cdr aa)) |
|||
(rowloop (cdr intlist)))))</syntaxhighlight> |
|||
{{out}} |
|||
<pre> Integer Root Pers. |
|||
627615 9 2 |
|||
39390 6 2 |
|||
588225 3 2 |
|||
393900588225 9 2 |
|||
0 0 0 |
|||
1 1 0 |
|||
68010887038 4 3</pre> |
|||
=={{header|Seed7}}== |
=={{header|Seed7}}== |
||
< |
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i"; |
||
include "bigint.s7i"; |
include "bigint.s7i"; |
||
Line 1,272: | Line 4,572: | ||
writeln(num <& " has additive persistence " <& persistence <& " and digital root of " <& root); |
writeln(num <& " has additive persistence " <& persistence <& " and digital root of " <& root); |
||
end for; |
end for; |
||
end func;</ |
end func;</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,281: | Line 4,580: | ||
393900588225 has additive persistence 2 and digital root of 9 |
393900588225 has additive persistence 2 and digital root of 9 |
||
</pre> |
</pre> |
||
=={{header|Sidef}}== |
|||
{{trans|Perl}} |
|||
<syntaxhighlight lang="ruby">func digroot (r, base = 10) { |
|||
var root = r.base(base) |
|||
var persistence = 0 |
|||
while (root.len > 1) { |
|||
root = root.chars.map{|n| Number(n, 36) }.sum(0).base(base) |
|||
++persistence |
|||
} |
|||
return(persistence, root) |
|||
} |
|||
var nums = [5, 627615, 39390, 588225, 393900588225] |
|||
var bases = [2, 3, 8, 10, 16, 36] |
|||
var fmt = "%25s(%2s): persistance = %s, root = %2s\n" |
|||
nums << (550777011503 * |
|||
105564897893993412813307040538786690718089963180462913406682192479) |
|||
bases.each { |b| |
|||
nums.each { |n| |
|||
var x = n.base(b) |
|||
x = 'BIG' if (x.len > 25) |
|||
fmt.printf(x, b, digroot(n, b)) |
|||
} |
|||
print "\n" |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
101( 2): persistance = 2, root = 1 |
|||
10011001001110011111( 2): persistance = 3, root = 1 |
|||
1001100111011110( 2): persistance = 3, root = 1 |
|||
10001111100111000001( 2): persistance = 3, root = 1 |
|||
BIG( 2): persistance = 3, root = 1 |
|||
BIG( 2): persistance = 4, root = 1 |
|||
12( 3): persistance = 2, root = 1 |
|||
1011212221000( 3): persistance = 3, root = 1 |
|||
2000000220( 3): persistance = 2, root = 2 |
|||
1002212220010( 3): persistance = 3, root = 1 |
|||
1101122201121110011000000( 3): persistance = 3, root = 1 |
|||
BIG( 3): persistance = 4, root = 1 |
|||
5( 8): persistance = 0, root = 5 |
|||
2311637( 8): persistance = 3, root = 2 |
|||
114736( 8): persistance = 3, root = 1 |
|||
2174701( 8): persistance = 3, root = 1 |
|||
5566623376301( 8): persistance = 3, root = 4 |
|||
BIG( 8): persistance = 3, root = 3 |
|||
5(10): persistance = 0, root = 5 |
|||
627615(10): persistance = 2, root = 9 |
|||
39390(10): persistance = 2, root = 6 |
|||
588225(10): persistance = 2, root = 3 |
|||
393900588225(10): persistance = 2, root = 9 |
|||
BIG(10): persistance = 3, root = 4 |
|||
5(16): persistance = 0, root = 5 |
|||
9939f(16): persistance = 2, root = f |
|||
99de(16): persistance = 2, root = f |
|||
8f9c1(16): persistance = 2, root = f |
|||
5bb64dfcc1(16): persistance = 2, root = f |
|||
BIG(16): persistance = 3, root = 7 |
|||
5(36): persistance = 0, root = 5 |
|||
dg9r(36): persistance = 2, root = u |
|||
ue6(36): persistance = 2, root = f |
|||
clvl(36): persistance = 2, root = f |
|||
50ye8n29(36): persistance = 2, root = p |
|||
BIG(36): persistance = 3, root = h |
|||
</pre> |
|||
=={{header|Smalltalk}}== |
|||
{{works with|Smalltalk/X}} |
|||
<syntaxhighlight lang="smalltalk">digitalRoot := |
|||
[:nr :arIn | |
|||
r := (nr printString asArray collect:#digitValue) sum. |
|||
r > 9 ifTrue:[ |
|||
digitalRoot value:r value:arIn+1. |
|||
] ifFalse:[ |
|||
{ arIn+1 . r } |
|||
]. |
|||
]. |
|||
#( |
|||
627615 39390 588225 393900588225 10 199 |
|||
1999999999999999999999999999999999999999999999999999999999999999999999999999999999999 |
|||
) do:[:nr | |
|||
Transcript showCR:'%1 has digitalRoot %3 and Additive Resistance %2' |
|||
withArguments:{nr},(digitalRoot value:nr value:0) |
|||
]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>39390 has digitalRoot 6 and Additive Resistance 2 |
|||
588225 has digitalRoot 3 and Additive Resistance 2 |
|||
393900588225 has digitalRoot 9 and Additive Resistance 2 |
|||
10 has digitalRoot 1 and Additive Resistance 1 |
|||
199 has digitalRoot 1 and Additive Resistance 3 |
|||
1999999999999999999999999999999999999999999999999999999999999999999999999999999999999 has digitalRoot 1 and Additive Resistance 4</pre> |
|||
=={{header|SmileBASIC}}== |
|||
<syntaxhighlight lang="smilebasic">DEF DIGITAL_ROOT N OUT DR,AP |
|||
AP=0 |
|||
DR=N |
|||
WHILE DR>9 |
|||
INC AP |
|||
STRDR$=STR$(DR) |
|||
NEWDR=0 |
|||
FOR I=0 TO LEN(STRDR$)-1 |
|||
INC NEWDR,VAL(MID$(STRDR$,I,1)) |
|||
NEXT |
|||
DR=NEWDR |
|||
WEND |
|||
END</syntaxhighlight> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
< |
<syntaxhighlight lang="tcl">package require Tcl 8.5 |
||
proc digitalroot num { |
proc digitalroot num { |
||
for {set p 0} {[string length $num] > 1} {incr p} { |
for {set p 0} {[string length $num] > 1} {incr p} { |
||
Line 1,294: | Line 4,707: | ||
lassign [digitalroot $n] p r |
lassign [digitalroot $n] p r |
||
puts [format "$n has additive persistence $p and digital root of $r"] |
puts [format "$n has additive persistence $p and digital root of $r"] |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,301: | Line 4,714: | ||
588225 has additive persistence 2 and digital root of 3 |
588225 has additive persistence 2 and digital root of 3 |
||
393900588225 has additive persistence 2 and digital root of 9 |
393900588225 has additive persistence 2 and digital root of 9 |
||
</pre> |
|||
=={{header|TI-83 BASIC}}== |
|||
<syntaxhighlight lang="ti83b">:ClrHome |
|||
:1→X |
|||
:Input ">",Str1 |
|||
:Str1→Str2 |
|||
:Repeat L≤1 |
|||
:Disp Str1 |
|||
:length(Str1→L |
|||
:L→dim(L₁ |
|||
:seq(expr(sub(Str1,A,1)),A,1,L)→L₁ |
|||
:sum(L₁→N |
|||
:{0,.5,1→L₂ |
|||
:NL₂→L₃ |
|||
:Med-Med L₂,L₃,Y₁ |
|||
:Equ►String(Y₁,Str1 |
|||
:sub(Str1,1,length(Str1)-3→Str1 |
|||
:X+1→X |
|||
:End |
|||
:Pause |
|||
:ClrHome |
|||
:Disp Str2,"DIGITAL ROOT",expr(Str1),"ADDITIVE","PERSISTENCE",X |
|||
:Pause</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 |
|||
DIGITAL ROOT 9 |
|||
ADDITIVE PERSISTENCE 2 |
|||
39390 |
|||
DIGITAL ROOT 6 |
|||
ADDITIVE PERSISTENCE 2 |
|||
588225 |
|||
DIGITAL ROOT 3 |
|||
ADDITIVE PERSISTENCE 2 |
|||
393900588225 |
|||
DIGITAL ROOT 9 |
|||
ADDITIVE PERSISTENCE 2</pre> |
|||
== {{header|TypeScript}} == |
|||
{{trans|ASIC}} |
|||
<syntaxhighlight lang="javascript">// Digital root |
|||
function rootAndPers(n: number, bas: number): [number, number] { |
|||
var pers = 0; |
|||
while (n >= bas) |
|||
{ |
|||
var s = 0; |
|||
do |
|||
{ |
|||
s += n % bas; |
|||
n = Math.floor(n / bas); |
|||
} while (n > 0); |
|||
pers++; |
|||
n = s; |
|||
} |
|||
return [n, pers]; |
|||
} |
|||
for (var a of [1, 14, 267, 8128, 39390, 588225, 627615]) { |
|||
var rp = rootAndPers(a, 10); |
|||
console.log(a.toString().padStart(7, ' ') + |
|||
rp[1].toString().padStart(6, ' ') + rp[0].toString().padStart(6, ' ')); |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 0 1 |
|||
14 1 5 |
|||
267 2 6 |
|||
8128 3 1 |
|||
39390 2 6 |
|||
588225 2 3 |
|||
627615 2 9 |
|||
</pre> |
|||
=={{header|uBasic/4tH}}== |
|||
{{trans|BBC Basic}} |
|||
<syntaxhighlight lang="text">PRINT "Digital root of 627615 is "; FUNC(_FNdigitalroot(627615, 10)) ; |
|||
PRINT " (additive persistence " ; Pop(); ")" |
|||
PRINT "Digital root of 39390 is "; FUNC(_FNdigitalroot(39390, 10)) ; |
|||
PRINT " (additive persistence " ; Pop(); ")" |
|||
PRINT "Digital root of 588225 is "; FUNC(_FNdigitalroot(588225, 10)) ; |
|||
PRINT " (additive persistence " ; Pop(); ")" |
|||
PRINT "Digital root of 9992 is "; FUNC(_FNdigitalroot(9992, 10)) ; |
|||
PRINT " (additive persistence " ; Pop(); ")" |
|||
END |
|||
_FNdigitalroot Param(2) |
|||
Local (1) |
|||
c@ = 0 |
|||
Do Until a@ < b@ |
|||
c@ = c@ + 1 |
|||
a@ = FUNC(_FNdigitsum (a@, b@)) |
|||
Loop |
|||
Push (c@) ' That's how uBasic handles an extra |
|||
Return (a@) ' return value: on the stack |
|||
_FNdigitsum Param (2) |
|||
Local (2) |
|||
d@ =0 |
|||
Do While a@ # 0 |
|||
c@ = a@ / b@ |
|||
d@ = d@ + a@ - (c@ * b@) |
|||
a@ = c@ |
|||
Loop |
|||
Return (d@)</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>Digital root of 627615 is 9 (additive persistence 2) |
|||
Digital root of 39390 is 6 (additive persistence 2) |
|||
Digital root of 588225 is 3 (additive persistence 2) |
|||
Digital root of 9992 is 2 (additive persistence 3) |
|||
0 OK, 0:737</pre> |
|||
=={{header|UNIX Shell}}== |
|||
<syntaxhighlight lang="bash">#!/usr/bin/env bash |
|||
numbers=(627615 39390 588225 393900588225 55) |
|||
declare root |
|||
for number in "${numbers[@]}"; do |
|||
declare -i iterations |
|||
root="${number}" |
|||
while [[ "${#root}" -ne 1 ]]; do |
|||
root="$(( $(fold -w1 <<<"${root}" | xargs | sed 's/ /+/g') ))" |
|||
iterations+=1 |
|||
done |
|||
echo -e "${number} has additive persistence ${iterations} and digital root ${root}" |
|||
unset iterations |
|||
done | column -t</syntaxhighlight> |
|||
{{ Out }} |
|||
<pre>627615 has additive persistence 2 and digital root 9 |
|||
39390 has additive persistence 2 and digital root 6 |
|||
588225 has additive persistence 2 and digital root 3 |
|||
393900588225 has additive persistence 2 and digital root 9 |
|||
55 has additive persistence 2 and digital root 1</pre> |
|||
=={{header|VBA}}== |
|||
<syntaxhighlight lang="vb">Option Base 1 |
|||
Private Sub digital_root(n As Variant) |
|||
Dim s As String, t() As Integer |
|||
s = CStr(n) |
|||
ReDim t(Len(s)) |
|||
For i = 1 To Len(s) |
|||
t(i) = Mid(s, i, 1) |
|||
Next i |
|||
Do |
|||
dr = WorksheetFunction.Sum(t) |
|||
s = CStr(dr) |
|||
ReDim t(Len(s)) |
|||
For i = 1 To Len(s) |
|||
t(i) = Mid(s, i, 1) |
|||
Next i |
|||
persistence = persistence + 1 |
|||
Loop Until Len(s) = 1 |
|||
Debug.Print n; "has additive persistence"; persistence; "and digital root of "; dr & ";" |
|||
End Sub |
|||
Public Sub main() |
|||
digital_root 627615 |
|||
digital_root 39390 |
|||
digital_root 588225 |
|||
digital_root 393900588225# |
|||
End Sub</syntaxhighlight>{{out}} |
|||
<pre> 627615 has additive persistence 2 and digital root of 9; |
|||
39390 has additive persistence 2 and digital root of 6; |
|||
588225 has additive persistence 2 and digital root of 3; |
|||
393900588225 has additive persistence 2 and digital root of 9;</pre> |
|||
=={{header|VBScript}}== |
|||
<syntaxhighlight lang="vb">Function digital_root(n) |
|||
ap = 0 |
|||
Do Until Len(n) = 1 |
|||
x = 0 |
|||
For i = 1 To Len(n) |
|||
x = x + CInt(Mid(n,i,1)) |
|||
Next |
|||
n = x |
|||
ap = ap + 1 |
|||
Loop |
|||
digital_root = "Additive Persistence = " & ap & vbCrLf &_ |
|||
"Digital Root = " & n & vbCrLf |
|||
End Function |
|||
WScript.StdOut.Write digital_root(WScript.Arguments(0))</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>F:\>cscript /nologo digital_root.vbs 627615 |
|||
Additive Persistence = 2 |
|||
Digital Root = 9 |
|||
F:\>cscript /nologo digital_root.vbs 39390 |
|||
Additive Persistence = 2 |
|||
Digital Root = 6 |
|||
F:\>cscript /nologo digital_root.vbs 588225 |
|||
Additive Persistence = 2 |
|||
Digital Root = 3 |
|||
F:\>cscript /nologo digital_root.vbs 393900588225 |
|||
Additive Persistence = 2 |
|||
Digital Root = 9</pre> |
|||
=={{header|Visual Basic .NET}}== |
|||
{{trans|C#}} |
|||
<syntaxhighlight lang="vbnet">Module Module1 |
|||
Function DigitalRoot(num As Long) As Tuple(Of Integer, Integer) |
|||
Dim additivepersistence = 0 |
|||
While num > 9 |
|||
num = num.ToString().ToCharArray().Sum(Function(x) Integer.Parse(x)) |
|||
additivepersistence = additivepersistence + 1 |
|||
End While |
|||
Return Tuple.Create(additivepersistence, CType(num, Integer)) |
|||
End Function |
|||
Sub Main() |
|||
Dim nums = {627615, 39390, 588225, 393900588225} |
|||
For Each num In nums |
|||
Dim t = DigitalRoot(num) |
|||
Console.WriteLine("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2) |
|||
Next |
|||
End Sub |
|||
End Module</syntaxhighlight> |
|||
{{out}} |
|||
<pre>627615 has additive persistence 2 and digital root 9 |
|||
39390 has additive persistence 2 and digital root 6 |
|||
588225 has additive persistence 2 and digital root 3 |
|||
393900588225 has additive persistence 2 and digital root 9</pre> |
|||
=={{header|V (Vlang)}}== |
|||
{{trans|Go}} |
|||
<syntaxhighlight lang="v (vlang)">import strconv |
|||
fn sum(ii u64, base int) int { |
|||
mut s := 0 |
|||
mut i := ii |
|||
b64 := u64(base) |
|||
for ; i > 0; i /= b64 { |
|||
s += int(i % b64) |
|||
} |
|||
return s |
|||
} |
|||
fn digital_root(n u64, base int) (int, int) { |
|||
mut persistence := 0 |
|||
mut root := int(n) |
|||
for x := n; x >= u64(base); x = u64(root) { |
|||
root = sum(x, base) |
|||
persistence++ |
|||
} |
|||
return persistence, root |
|||
} |
|||
// Normally the below would be moved to a *_test.go file and |
|||
// use the testing package to be runnable as a regular test. |
|||
struct Test{ |
|||
n string |
|||
base int |
|||
persistence int |
|||
root int |
|||
} |
|||
const test_cases = [ |
|||
Test{"627615", 10, 2, 9}, |
|||
Test{"39390", 10, 2, 6}, |
|||
Test{"588225", 10, 2, 3}, |
|||
Test{"393900588225", 10, 2, 9}, |
|||
Test{"1", 10, 0, 1}, |
|||
Test{"11", 10, 1, 2}, |
|||
Test{"e", 16, 0, 0xe}, |
|||
Test{"87", 16, 1, 0xf}, |
|||
// From Applesoft BASIC example: |
|||
Test{"DigitalRoot", 30, 2, 26}, // 26 is Q base 30 |
|||
// From C++ example: |
|||
Test{"448944221089", 10, 3, 1}, |
|||
Test{"7e0", 16, 2, 0x6}, |
|||
Test{"14e344", 16, 2, 0xf}, |
|||
Test{"d60141", 16, 2, 0xa}, |
|||
Test{"12343210", 16, 2, 0x1}, |
|||
// From the D example: |
|||
Test{"1101122201121110011000000", 3, 3, 1}, |
|||
] |
|||
fn main() { |
|||
for tc in test_cases { |
|||
n, err := strconv.common_parse_uint2(tc.n, tc.base, 64) |
|||
if err != 0 { |
|||
panic('ERROR') |
|||
} |
|||
p, r := digital_root(n, tc.base) |
|||
println("${tc.n:12} (base ${tc.base:2}) has additive persistence $p and digital root ${strconv.format_int(i64(r), tc.base)}",) |
|||
if p != tc.persistence || r != tc.root { |
|||
panic("bad result: $tc $p $r") |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
627615 (base 10) has additive persistence 2 and digital root 9 |
|||
39390 (base 10) has additive persistence 2 and digital root 6 |
|||
588225 (base 10) has additive persistence 2 and digital root 3 |
|||
393900588225 (base 10) has additive persistence 2 and digital root 9 |
|||
1 (base 10) has additive persistence 0 and digital root 1 |
|||
11 (base 10) has additive persistence 1 and digital root 2 |
|||
e (base 16) has additive persistence 0 and digital root e |
|||
87 (base 16) has additive persistence 1 and digital root f |
|||
DigitalRoot (base 30) has additive persistence 2 and digital root q |
|||
448944221089 (base 10) has additive persistence 3 and digital root 1 |
|||
7e0 (base 16) has additive persistence 2 and digital root 6 |
|||
14e344 (base 16) has additive persistence 2 and digital root f |
|||
d60141 (base 16) has additive persistence 2 and digital root a |
|||
12343210 (base 16) has additive persistence 2 and digital root 1 |
|||
1101122201121110011000000 (base 3) has additive persistence 3 and digital root 1 |
|||
</pre> |
</pre> |
||
=={{header|Wortel}}== |
=={{header|Wortel}}== |
||
< |
<syntaxhighlight lang="wortel">@let { |
||
sumDigits |
sumDigits ^(@sum @arr) |
||
drootl & |
drootl &\@rangef [. sumDigits ^(\~>1 #@arr)] |
||
droot |
droot ^(@last drootl) |
||
apers |
apers ^(#-drootl) |
||
[ |
[ |
||
!console.log |
!console.log "[number]: [digital root] [additive persistence] [intermediate sums]" |
||
~@each [627615 39390 588225 393900588225] |
~@each [627615 39390 588225 393900588225] |
||
&n !console.log "{n}: {!droot n} {!apers n} { |
&n !console.log "{n}: {!droot n} {!apers n} {@str !drootl n}" |
||
] |
] |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
|||
Outputs |
|||
<pre>[number]: [digital root] [additive persistence] [intermediate sums] |
<pre>[number]: [digital root] [additive persistence] [intermediate sums] |
||
627615: 9 2 [627615 27 9] |
627615: 9 2 [627615 27 9] |
||
Line 1,323: | Line 5,059: | ||
588225: 3 2 [588225 30 3] |
588225: 3 2 [588225 30 3] |
||
393900588225: 9 2 [393900588225 54 9]</pre> |
393900588225: 9 2 [393900588225 54 9]</pre> |
||
=={{header|Wren}}== |
|||
{{trans|Kotlin}} |
|||
{{libheader|Wren-fmt}} |
|||
<syntaxhighlight lang="wren">import "./fmt" for Fmt |
|||
var sumDigits = Fn.new { |n| |
|||
var sum = 0 |
|||
while (n > 0) { |
|||
sum = sum + (n%10) |
|||
n = (n/10).floor |
|||
} |
|||
return sum |
|||
} |
|||
var digitalRoot = Fn.new { |n| |
|||
if (n < 0) Fiber.abort("Argument must be non-negative.") |
|||
if (n < 10) return [n, 0] |
|||
var dr = n |
|||
var ap = 0 |
|||
while (dr > 9) { |
|||
dr = sumDigits.call(dr) |
|||
ap = ap + 1 |
|||
} |
|||
return [dr, ap] |
|||
} |
|||
var a = [1, 14, 267, 8128, 627615, 39390, 588225, 393900588225] |
|||
for (n in a) { |
|||
var res = digitalRoot.call(n) |
|||
var dr = res[0] |
|||
var ap = res[1] |
|||
Fmt.print("$,15d has additive persistence $d and digital root of $d", n, ap, dr) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 has additive persistence 0 and digital root of 1 |
|||
14 has additive persistence 1 and digital root of 5 |
|||
267 has additive persistence 2 and digital root of 6 |
|||
8,128 has additive persistence 3 and digital root of 1 |
|||
627,615 has additive persistence 2 and digital root of 9 |
|||
39,390 has additive persistence 2 and digital root of 6 |
|||
588,225 has additive persistence 2 and digital root of 3 |
|||
393,900,588,225 has additive persistence 2 and digital root of 9 |
|||
</pre> |
|||
=={{header|XPL0}}== |
=={{header|XPL0}}== |
||
Line 1,328: | Line 5,110: | ||
precision needed. |
precision needed. |
||
< |
<syntaxhighlight lang="xpl0">include c:\cxpl\codes; \intrinsic 'code' declarations |
||
func DRoot(N, B, P); \Return digital root and persistance P |
func DRoot(N, B, P); \Return digital root and persistance P |
||
Line 1,353: | Line 5,135: | ||
IntOut(0, Pers); ChOut(0, ^ ); IntOut(0, Root); CrLf(0); |
IntOut(0, Pers); ChOut(0, ^ ); IntOut(0, Root); CrLf(0); |
||
]; |
]; |
||
]</ |
]</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
2 9 |
2 9 |
||
Line 1,362: | Line 5,143: | ||
2 9 |
2 9 |
||
</pre> |
</pre> |
||
=={{header|zkl}}== |
|||
<syntaxhighlight lang="zkl">fcn sum(n,b){ n.split(b).sum(0) } |
|||
fcn droot(n,b=10,X=0) // -->(digital root, additive persistence) |
|||
{ if(n<b)return(n,X); return(self.fcn(sum(n,b),b,X+1)) }</syntaxhighlight> |
|||
<syntaxhighlight lang="zkl">droot(627615) |
|||
droot(39390) |
|||
droot(588225) |
|||
droot(393900588225) |
|||
droot(7,2) |
|||
droot(0x7e0,16)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
L(9,2) //627615 |
|||
L(6,2) //39390 |
|||
L(3,2) //588225 |
|||
L(9,2) //393900588225 |
|||
L(1,3) //111 base 2: 111-->11-->10-->1 |
|||
L(6,2) //7e0 base 16: 0x7e0-->0x15-->0x6 |
|||
</pre> |
|||
=={{header|zonnon}}== |
|||
<syntaxhighlight lang="zonnon"> |
|||
module Main; |
|||
type |
|||
longint = integer{64}; |
|||
type {public,ref} |
|||
Response = object (dr,p: longint) |
|||
var {public,immutable} |
|||
digitalRoot,persistence: longint; |
|||
procedure {public} Writeln; |
|||
begin |
|||
writeln("digital root: ",digitalRoot:2," persistence: ",persistence:2) |
|||
end Writeln; |
|||
begin |
|||
self.digitalRoot := dr; |
|||
self.persistence := p; |
|||
end Response; |
|||
procedure DigitalRoot(n:longint):Response; |
|||
var |
|||
sum,p: longint; |
|||
begin |
|||
p := 0; |
|||
loop |
|||
inc(p);sum := 0; |
|||
while (n > 0) do |
|||
inc(sum,n mod 10); |
|||
n := n div 10; |
|||
end; |
|||
if sum < 10 then return new Response(sum,p) else n := sum end |
|||
end |
|||
end DigitalRoot; |
|||
begin |
|||
write(627615:22,":> ");DigitalRoot(627615).Writeln; |
|||
write(39390:22,":> ");DigitalRoot(39390).Writeln; |
|||
write(588225:22,":> ");DigitalRoot(588225).Writeln; |
|||
write(max(integer{64}):22,":> ");DigitalRoot(max(integer{64})).Writeln; |
|||
end Main. |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
627615 :> digital root: 9 persistence: 2 |
|||
39390 :> digital root: 6 persistence: 2 |
|||
588225 :> digital root: 3 persistence: 2 |
|||
9223372036854775807 :> digital root: 7 persistence: 3 |
|||
</pre> |
|||
=={{header|ZX Spectrum Basic}}== |
|||
{{trans|Run BASIC}} |
|||
<syntaxhighlight lang="zxbasic">10 DATA 4,627615,39390,588225,9992 |
|||
20 READ j: LET b=10 |
|||
30 FOR i=1 TO j |
|||
40 READ n |
|||
50 PRINT "Digital root of ";n;" is" |
|||
60 GO SUB 1000 |
|||
70 NEXT i |
|||
80 STOP |
|||
1000 REM Digital Root |
|||
1010 LET c=0 |
|||
1020 IF n>=b THEN LET c=c+1: GO SUB 2000: GO TO 1020 |
|||
1030 PRINT n;" persistance is ";c'' |
|||
1040 RETURN |
|||
2000 REM Digit sum |
|||
2010 LET s=0 |
|||
2020 IF n<>0 THEN LET q=INT (n/b): LET s=s+n-q*b: LET n=q: GO TO 2020 |
|||
2030 LET n=s |
|||
2040 RETURN</syntaxhighlight> |
Latest revision as of 15:12, 19 August 2024
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
The digital root, , of a number, , is calculated:
- find as the sum of the digits of
- find a new by summing the digits of , repeating until 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.:
- has additive persistence and digital root of ;
- has additive persistence and digital root of ;
- has additive persistence and digital root of ;
- has additive persistence and digital root of ;
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
- Digital root sequence on OEIS
- Additive persistence sequence on OEIS
- Iterated digits squaring
11l
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))
- Output:
627615 has additive persistance 2 and digital root 9. 39390 has additive persistance 2 and digital root 6. 588225 has additive persistance 2 and digital root 3. 393900588225 has additive persistance 2 and digital root 9. 55 has additive persistance 2 and digital root 1.
360 Assembly
* 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
- Output:
number= 627615 persistence= 2 root=9 number= 39390 persistence= 2 root=6 number= 588225 persistence= 2 root=3 number=2147483647 persistence= 3 root=1
Ada
We first specify a Package "Generic_Root" with a generic procedure "Compute". The package is reduced for the implementation of multiplicative digital roots [[1]]. Further note the tunable parameter for the number base (default 10).
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;
The implementation is straightforward: If the input N is a digit, then the root is N and the persistence is zero. Else, commute the digit-sum DS. The root of N is the root of DS, the persistence of N is 1 + (the persistence of DS).
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;
Finally the main program. The procedure "Print_Roots" is for our convenience.
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;
- Output:
Number Root Persistence Base 961038 9 2 10 923594037444 9 2 10 670033 1 3 10 448944221089 1 3 10 16#7E0# 16#6# 16#2# 16 16#14E344# 16#F# 16#2# 16 16#12343210# 16#1# 16#2# 16
ALGOL 68
# 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
- Output:
627615 root: 9 persistance: 2 39390 root: 6 persistance: 2 588225 root: 3 persistance: 2 393900588225 root: 9 persistance: 2
ALGOL W
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.
- Output:
0, 627615: digital root: 9, persistence: 2 0, 39390: digital root: 6, persistence: 2 0, 588225: digital root: 3, persistence: 2 393900, 588225: digital root: 9, persistence: 2
AppleScript
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)
- Output:
{N:627615, persistences:2, root:9}
Or, generalizing to allow for other bases, composing a solution from generic primitives, and testing a few more numbers.
-------------------------- 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
- Output:
Base 10: Integer -> (additive persistance, digital root) 627615 -> (2, 9) 39390 -> (2, 6) 588225 -> (2, 3) 3.93900588225E+11 -> (2, 9.0)
Applesoft BASIC
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,
- Output:
627615 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 9; 39390 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 6; 588225 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 3; 393900588225 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 9; DIGITALROOT(30) HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT Q;
Arturo
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]
]
- Output:
627615 has additive persistence 9 and digital root of 2 39390 has additive persistence 6 and digital root of 2 588225 has additive persistence 3 and digital root of 2 393900588225 has additive persistence 9 and digital root of 2
AutoHotkey
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
- Output:
30: Digital Root = 3, Additive Persistence = 1 1597: Digital Root = 4, Additive Persistence = 2 381947: Digital Root = 5, Additive Persistence = 2 92524902: Digital Root = 6, Additive Persistence = 2 448944221089: Digital Root = 1, Additive Persistence = 3
AWK
# 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)
}
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9 10 has additive persistence 1 and digital root of 1 199 has additive persistence 3 and digital root of 1
BASIC
This calculates the result "the hard way", but is limited to the limits of a 32-bit signed integer (+/-2,147,483,647) and therefore can't calculate the digital root of 393,900,588,225.
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
- Output:
627615 : additive persistance 2 , digital root 9 39390 : additive persistance 2 , digital root 6 588225 : additive persistance 2 , digital root 3
ASIC
Compile with the Extended math option.
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
- Output:
1 0 1 14 1 5 267 2 6 8128 3 1 39390 2 6 588225 2 3 627615 2 9
BASIC256
global dr
global ap
dim a = {627615, 39390, 588225}
for i = 0 to a[?]-1
dr = digitalRoot(a[i])
print a[i], "Additive Persistence = "; ap, "Digital root = "; dr
next i
end
function digitalRoot(n)
ap = 0
do
dr = 0
while n > 0
dr += n mod 10
n = n \ 10
end while
ap += 1
n = dr
until dr < 10
return dr
end function
- Output:
627615 Additive Persistence = 2 Digital root = 9 39390 Additive Persistence = 2 Digital root = 6 588225 Additive Persistence = 2 Digital root = 3
Nascom BASIC
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
- Output:
1 0 1 14 1 5 267 2 6 8128 3 1 39390 2 6 588225 2 3 627615 2 9
True BASIC
SUB digitalroot (what)
LET dr = ABS(what)
IF dr > 10 THEN
LET ap = 0
DO
LET ap = ap + 1
DO WHILE dr <> 0
LET t = t + REMAINDER(dr, 10)
LET dr = IP(dr / 10)
LOOP
LET dr = t
LET t = 0
LOOP WHILE dr > 9
END IF
PRINT what, "Additive persistance ="; ap, "Digital root ="; dr
END SUB
CALL digitalroot (627615)
CALL digitalroot (39390)
CALL digitalroot (588225)
CALL digitalroot (393900588225)
END
- Output:
627615 Additive persistence = 2 Digital root = 9 39390 Additive persistence = 2 Digital root = 6 588225 Additive persistence = 2 Digital root = 3 393900588225 Additive persistence = 2 Digital root = 9
Yabasic
dim a(2)
a(0) = 627615 : a(1) = 39390 : a(2) = 588225
for i = 0 to arraysize(a(),1)
dr = digitalRoot(a(i))
print a(i), "\tAdditive persistence = ", ap, "\tDigital root = ", dr
next i
end
sub digitalRoot(n)
ap = 0
repeat
dr = 0
while n > 0
dr = dr + mod(n, 10)
n = int(n / 10)
wend
ap = ap + 1
n = dr
until dr < 10
return dr
end sub
- Output:
627615 Additive persistence = 2 Digital root = 9 39390 Additive persistence = 2 Digital root = 6 588225 Additive persistence = 2 Digital root = 3
Batch File
:: 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
- Output:
(9876543214) Additive Persistence=3 Digital Root=4. (393900588225) Additive Persistence=2 Digital Root=9. (1985989328582) Additive Persistence=3 Digital Root=5. (34559) Additive Persistence=2 Digital Root=8. Press any key to continue . . .
BBC BASIC
*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
- Output:
Digital root of 627615 is 9 (additive persistence 2) Digital root of 39390 is 6 (additive persistence 2) Digital root of 588225 is 3 (additive persistence 2) Digital root of 393900588225 is 9 (additive persistence 2) Digital root of 9992 is 2 (additive persistence 3)
Befunge
The number, n, is read as a string from stdin in order to support a larger range of values than would typically be accepted by the numeric input of most Befunge implementations. After the initial value has been summed, though, subsequent iterations are simply calculated as integer sums.
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: "<
- Output:
(multiple runs)
Enter number: 1003201 Digital root: 7 Additive Persistence: 1 Enter number: 393900588225 Digital root: 9 Additive Persistence: 2 Enter number: 448944221089 Digital root: 1 Additive Persistence: 3
BQN
A recursive implementation which takes the root and persistence in base 10.
Other bases can be used by changing the DSum
function, which is derived from a BQNcrate idiom.
DSum ← +´10{⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}
Root ← 0⊸{(×○⌊÷⟜10)◶⟨𝕨‿𝕩,(1+𝕨)⊸𝕊 Dsum⟩𝕩}
P ← •Show ⊢∾Root
P 627615
P 39390
P 588225
P 393900588225
⟨ 627615 2 9 ⟩
⟨ 39390 2 6 ⟩
⟨ 588225 2 3 ⟩
⟨ 393900588225 2 9 ⟩
Bracmat
( 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
);
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9 10 has additive persistence 1 and digital root of 1 199 has additive persistence 3 and digital root of 1
C
#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;
}
C#
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);
}
}
}
- Output:
627615 has additive persistence 2 and digital root 9 39390 has additive persistence 2 and digital root 6 588225 has additive persistence 2 and digital root 3 393900588225 has additive persistence 2 and digital root 9
C++
For details of SumDigits see: http://rosettacode.org/wiki/Sum_digits_of_an_integer
// 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;
}
- Output:
961038 has digital root 9 and additive persistance 2 923594037444 has digital root 9 and additive persistance 2 670033 has digital root 1 and additive persistance 3 448944221089 has digital root 1 and additive persistance 3 7e0 has digital root 6 and additive persistance 2 14e344 has digital root f and additive persistance 2 d60141 has digital root a and additive persistance 2 12343210 has digital root 1 and additive persistance 2
Clojure
(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))))))
- Output:
({:n 627615, :add-persist 2, :digital-root 9} {:n 39390, :add-persist 2, :digital-root 6} {:n 588225, :add-persist 2, :digital-root 3} {:n 393900588225, :add-persist 2, :digital-root 9})
CLU
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
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
Common Lisp
Using SUM-DIGITS
from the task "Sum digits of an integer".
(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)))
- Output:
627615 (base 10): additive persistence = 2, digital root = 9 393900588225 (base 10): additive persistence = 2, digital root = 9 14E344 (base 16): additive persistence = 2, digital root = F DG9R (base 36): additive persistence = 2, digital root = U
Component Pascal
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.
Execute: ^Q DigitalRoot.Do 627615 39390 588225 393900588~
- Output:
627615 Digital root: 9 Persistence: 2 39390 Digital root: 6 Persistence: 2 588225 Digital root: 3 Persistence: 2 393900588 Digital root: 9 Persistence: 2
COBOL
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.
- Output:
627615: PERSISTENCE = 2, ROOT = 9 39390: PERSISTENCE = 2, ROOT = 6 588225: PERSISTENCE = 2, ROOT = 3 393900588225: PERSISTENCE = 2, ROOT = 9
Cowgol
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);
- Output:
4: root = 4, persistence = 0 627615: root = 9, persistence = 2 39390: root = 6, persistence = 2 588225: root = 3, persistence = 2 9992: root = 2, persistence = 3
Crystal
If you just want the digital root, you can use this, which is almost 100x faster than calculating it with persistence:
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
- Output:
9 6 3 1
The faster approach when calculating it with persistence uses exponentiation and log to avoid converting to and from strings.
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
- Output:
{9, 2} {6, 2} {3, 2}
However, the string-conversion based solution is easiest to read.
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
- Output:
{9, 2} {6, 2} {3, 2}
D
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.
}
- Output:
101(2): additive persistance= 2, digital root= 1 10011001001110011111(2): additive persistance= 3, digital root= 1 1001100111011110(2): additive persistance= 3, digital root= 1 10001111100111000001(2): additive persistance= 3, digital root= 1 101101110110110010011011111110011000001(2): additive persistance= 3, digital root= 1 12(3): additive persistance= 2, digital root= 1 1011212221000(3): additive persistance= 3, digital root= 1 2000000220(3): additive persistance= 2, digital root= 2 1002212220010(3): additive persistance= 3, digital root= 1 1101122201121110011000000(3): additive persistance= 3, digital root= 1 5(8): additive persistance= 0, digital root= 5 2311637(8): additive persistance= 3, digital root= 2 114736(8): additive persistance= 3, digital root= 1 2174701(8): additive persistance= 3, digital root= 1 5566623376301(8): additive persistance= 3, digital root= 4 5(10): additive persistance= 0, digital root= 5 627615(10): additive persistance= 2, digital root= 9 39390(10): additive persistance= 2, digital root= 6 588225(10): additive persistance= 2, digital root= 3 393900588225(10): additive persistance= 2, digital root= 9 5(16): additive persistance= 0, digital root= 5 9939F(16): additive persistance= 2, digital root= 15 99DE(16): additive persistance= 2, digital root= 15 8F9C1(16): additive persistance= 2, digital root= 15 5BB64DFCC1(16): additive persistance= 2, digital root= 15 5(36): additive persistance= 0, digital root= 5 DG9R(36): additive persistance= 2, digital root= 30 UE6(36): additive persistance= 2, digital root= 15 CLVL(36): additive persistance= 2, digital root= 15 50YE8N29(36): additive persistance= 2, digital root= 25 <BIG>(2): additive persistance= 4, digital root= 1 <BIG>(3): additive persistance= 4, digital root= 1 <BIG>(8): additive persistance= 3, digital root= 3 <BIG>(10): additive persistance= 3, digital root= 4 <BIG>(16): additive persistance= 3, digital root= 7 <BIG>(36): additive persistance= 3, digital root= 17
Dc
Tested on GNU dc.
Procedure p
is for breaking up the number into individual digits.
Procedure q
is for summing all digits left by procedure p
.
Procedure r
is for overall control (when to stop).
?[10~rd10<p]sp[+z1<q]sq[lpxlqxd10<r]dsrxp
DCL
$ 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
- Output:
$ @digital_root 627615 627615 has additive persistence 2 and digital root of 9 $ @digital_root 6 6 has additive persistence 0 and digital root of 6 $ @digital_root 99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999998 99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999998 has additive persistence 3 and digital root of 8
Delphi
See Pascal.
EasyLang
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[]
digitalRoot i x persistence
print i
print "Additive persistence: " & persistence
print "Digital root: " & x
.
- Output:
627615 Additive persistence: 2 Digital root: 9 39390 Additive persistence: 2 Digital root: 6 588225 Additive persistence: 2 Digital root: 3 393900588225 Additive persistence: 2 Digital root: 9
Eiffel
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
- Output:
670033 has additive persistence 3 and digital root 1 39390 has additive persistence 2 and digital root 6 588225 has additive persistence 2 and digital root 3 393900588225 has additive persistence 2 and digital root 9
Elena
ELENA 6.x :
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)
}
}
- Output:
627615 has additive persistence 2 and digital root 9 39390 has additive persistence 2 and digital root 6 588225 has additive persistence 2 and digital root 3 393900588225 has additive persistence 2 and digital root 9
Elixir
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)
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9 Base = 16 9939F(16) has additive persistence 2 and digital root of 15 99DE(16) has additive persistence 2 and digital root of 15 8F9C1(16) has additive persistence 2 and digital root of 15 5BB64DFCC1(16) has additive persistence 2 and digital root of 15
Erlang
Using Sum_digits_of_an_integer.
-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 ).
- Output:
11> digital_root:task(). 627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
F#
This code uses sumDigits from Sum_digits_of_an_integer#or_Generically
//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)
- Output:
> digitalRoot 627615 10;; val it : int * int = (9, 2) > digitalRoot 39390 10;; val it : int * int = (6, 2) > digitalRoot 588225 10;; val it : int * int = (3, 2) > digitalRoot 393900588225L 10L;; val it : int64 * int = (9L, 2) > digitalRoot 123456789123456789123456789123456789123456789I 10I;; val it : System.Numerics.BigInteger * int = (9 {IsEven = false; IsOne = false; IsPowerOfTwo = false; IsZero = false; Sign = 1;}, 2)
Factor
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
- Output:
627615 has additive persistence 2 and digital root 9. 39390 has additive persistence 2 and digital root 6. 588225 has additive persistence 2 and digital root 3. 393900588225 has additive persistence 2 and digital root 9.
Forth
This is trivial to do in Forth, because radix control is one of its most prominent feature. The 32-bits version just takes two lines:
: (Sdigit) 0 swap begin base @ /mod >r + r> dup 0= until drop ;
: digiroot 0 swap begin (Sdigit) >r 1+ r> dup base @ < until ;
This will take care of most numbers:
627615 digiroot . . 9 2 ok 39390 digiroot . . 6 2 ok 588225 digiroot . . 3 2 ok
For the last one we will need a "double number" version. MU/MOD is not available in some Forth implementations, but it is easy to define:
[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 ;
That one will take care of the last one:
393900588225. digiroot . . 9 2 ok
Fortran
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
Number: 627615 digital root = 9 additive persistance = 2 Number: 39390 digital root = 6 additive persistance = 2 Number: 588225 digital root = 3 additive persistance = 2 Number: 393900588225 digital root = 9 additive persistance = 2
FreeBASIC
' 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
- Output:
627615 Additive Persistence = 2 Digital root = 9 39390 Additive Persistence = 2 Digital root = 6 588225 Additive Persistence = 2 Digital root = 3 393900588225 Additive Persistence = 2 Digital root = 9
Fōrmulæ
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation —i.e. XML, JSON— they are intended for storage and transfer purposes more than visualization and edition.
Programs in Fōrmulæ are created/edited online in its website.
In this page you can see and run the program(s) related to this task and their results. You can also change either the programs or the parameters they are called with, for experimentation, but remember that these programs were created with the main purpose of showing a clear solution of the task, and they generally lack any kind of validation.
Solution
Test cases
Go
With function Sum
from Sum digits of an integer#Go.
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)
}
}
}
- Output:
627615 (base 10) has additive persistence 2 and digital root 9 39390 (base 10) has additive persistence 2 and digital root 6 588225 (base 10) has additive persistence 2 and digital root 3 393900588225 (base 10) has additive persistence 2 and digital root 9 1 (base 10) has additive persistence 0 and digital root 1 11 (base 10) has additive persistence 1 and digital root 2 e (base 16) has additive persistence 0 and digital root e 87 (base 16) has additive persistence 1 and digital root f DigitalRoot (base 30) has additive persistence 2 and digital root q 448944221089 (base 10) has additive persistence 3 and digital root 1 7e0 (base 16) has additive persistence 2 and digital root 6 14e344 (base 16) has additive persistence 2 and digital root f d60141 (base 16) has additive persistence 2 and digital root a 12343210 (base 16) has additive persistence 2 and digital root 1 1101122201121110011000000 (base 3) has additive persistence 3 and digital root 1
Groovy
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]}")
}
}
}
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
Haskell
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]
- Output:
in base 10: (627615,(2,9)) (39390,(2,6)) (588225,(2,3)) (393900588225,(2,9))
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")
]
- Output:
1001100111011110 -> additive persistence: 3 digital root: 1 2000000220 -> additive persistence: 2 digital root: 2 5566623376301 -> additive persistence: 3 digital root: 4 39390 -> additive persistence: 2 digital root: 6 99DE -> additive persistence: 2 digital root: F 50YE8N29 -> additive persistence: 2 digital root: P 37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN -> additive persistence: 2 digital root: N
Huginn
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 );
}
Icon and Unicon
The following works in both languages:
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
- Sample run:
->dr 627615 39390 588225 393900588225 627615 has additive persistence of 2 and digital root of 9 39390 has additive persistence of 2 and digital root of 6 588225 has additive persistence of 2 and digital root of 3 393900588225 has additive persistence of 2 and digital root of 9 ->
J
digrt=: 10&$: :(|&.<:^:<:)"0
addps=: 10&$: :([: <:@# +/@(#.inv)^:a:)"0
With these functions, the base can be supplied as a left argument (dyadic). When being called monadically, they default to base 10.
Example use:
(,. addps ,. digrt) 627615 39390 588225 393900588225
627615 2 9
39390 2 6
588225 2 3
393900588225 2 9
8 digrt 8b4321
3
8 addps 8b4321
2
Here's an equality operator for comparing these base 10 digital roots:
equals=: =&(9&|)"0
Table of results:
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│
└──────┴───────────────────┘
Note that these routines merely calculate results, which are numbers. If you want the result to be displayed in some other base, converting the result from numbers to character strings needs an additional step. Since that's currently not a part of the task, this is left as an exercise for the reader.
Janet
(defn numbers [s] (filter (fn [y] (and (<= y 9) (>= y 0))) (map (fn [z] (- z 48)) (string/bytes s))))
(defn summa [s] (reduce (fn [x y] (+ x y)) 0 (numbers s)))
(defn minsumma [x p]
(if (<= x 9)
[x p]
(minsumma (summa (string/format "%d" x)) (+ 1 p))))
(defn test [t] (printf "%j" (minsumma (summa t) 1)))
(test "627615")
(test "39390")
(test "588225")
(test "393900588225")
(test "19999999999999999999999999999999999999999999999999999999999999999999999999999999999999")
(test "192348-0347203478-20483298402-39482-04720348-20394823-058720375204820-394823842-049802-93482-034892-3")
- Output:
(9 2) (6 2) (3 2) (9 2) (1 4) (6 3)
Java
- Code:
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]);
}
}
}
- Example:
java DigitalRoot 627615 39390 588225 393900588225 627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
JavaScript
/// 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;
}
jq
digital_root(n) is defined here for decimals and strings representing decimals.
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)*" " + .;
Examples:
(
" i : [DR, P]",
(961038, 923594037444, 670033, 448944221089
) as $i
| "\($i|rjust(12)): \(digital_root($i))"
),
"",
"digital_root(\"1\" * 100000) => \(digital_root( "1" * 100000))"
- Output:
$ 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]
Julia
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
- Output:
627615 has persistence 2 and digital root 9 39390 has persistence 2 and digital root 6 588225 has persistence 2 and digital root 3 393900588225 has persistence 2 and digital root 9 1267650600228229401496703205376 has persistence 2 and digital root 7
K
/ 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]}
- Output:
digroot 627615 (`"Digital root = ";9;`"Additive persistence = ";2) digroot 39390 (`"Digital root = ";6;`"Additive persistence = ";2) digroot 588225 (`"Digital root = ";3;`"Additive persistence = ";2) digroot 393900588225 (`"Digital root = ";9;`"Additive persistence = ";2) digroot 14 (`"Digital root = ";5;`"Additive persistence = ";1) digroot 3 (`"Digital root = ";3;`"Additive persistence = ";0)
Kotlin
// 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")
}
}
- Output:
1 has additive persistence 0 and digital root of 1 14 has additive persistence 1 and digital root of 5 267 has additive persistence 2 and digital root of 6 8128 has additive persistence 3 and digital root of 1 627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
Lua
With function sum_digits from [2]
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))
- Output:
9 2 6 2 3 2 9 2
MAD
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
- Output:
627615 9 2 39390 6 2 588225 3 2 393900588225 9 2
Malbolge
Código sacado de https://lutter.cc/malbolge/
Mathematica / Wolfram Language
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;
- Output:
root /@ {627615, 39390, 588225 , 393900, 588225, 670033, 448944221089} {9, 6, 3, 6, 3, 1, 1} persistance /@ {627615, 39390, 588225 , 393900, 588225, 670033, 448944221089} {2, 2, 2, 2, 2, 3, 3} root[16^^14E344, 16] f 16
Maxima
/* Function that returns a list of digits given a nonnegative integer */
decompose(num) := block([digits, remainder],
digits: [],
while num > 0 do
(remainder: mod(num, 10),
digits: cons(remainder, digits),
num: floor(num/10)),
digits
)$
/* Function that given a positive integer returns the sum of their digits */
auxdig(n):=block(decompose(n),apply("+",%%));
/* Function that given a positive integer returns a list of two: the additive persistence and the digital root */
digrt(n):=block([additive_persistence:0,digital_root:n],
while length(decompose(digital_root))>1 do (digital_root:auxdig(digital_root),additive_persistence:additive_persistence+1),
[additive_persistence,digital_root]);
/* Examples */
digrt(627615);
digrt(39390);
digrt(588225);
digrt(393900588225);
- Output:
[2,9] [2,6] [2,3] [2,9]
MiniScript
testNumbers = [627615, 39390, 588225, 393900588225, 45, 9991]
pad = function(n, width)
return (n + " " * width)[:width]
end function
getDigitalRoot = function(n)
persistance = 0
while floor(log(n)) > 0
sum = 0
while n > 0
sum += n % 10
n = floor(n / 10)
end while
n = sum
persistance += 1
end while
return [n, persistance]
end function
for num in testNumbers
digRoot = getDigitalRoot(num)
print pad(num, 12), ""
print " has a digital root ", ""
print digRoot[0], ""
print " and additive persistance ",""
print digRoot[1]
end for
- Output:
627615 has a digital root 9 and additive persistance 2 39390 has a digital root 6 and additive persistance 2 588225 has a digital root 3 and additive persistance 2 393900588225 has a digital root 9 and additive persistance 2 45 has a digital root 9 and additive persistance 1 9991 has a digital root 1 and additive persistance 3
Modula-2
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.
Modula-3
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.
Nanoquery
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
- Output:
627615 has additive persistence 2 and digital root 9. 39390 has additive persistence 2 and digital root 6. 588825 has additive persistence 2 and digital root 9. 393900588225 has additive persistence 2 and digital root 9. 55 has additive persistence 2 and digital root 1.
NetRexx
/* 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 */
- Output:
number -> digital_root persistence 7 -> 7 0 ok 627615 -> 9 2 ok 39390 -> 6 2 ok 588225 -> 3 2 ok 393900588225 -> 9 2 ok 393900588225 -> 9 2 expected: 9 3
Nim
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
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
OCaml
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]
- Output:
627615: additive persistence = 2, digital root = 9 39390: additive persistence = 2, digital root = 6 588225: additive persistence = 2, digital root = 3 393900588225: additive persistence = 2, digital root = 9
Oforth
Using result of sum digit task :
: 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 ;
- Output:
[ 627615, 39390 , 588225, 393900588225 ] map(#[ 10 digitalRoot ]) println [[9, 2], [6, 2], [3, 2], [9, 2]]
Ol
(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))
- Output:
9 6 3 9
PARI/GP
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)
Pascal
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.
- Output:
--- Examples in 10-Base --- 627615(10) has additive persistence 2 and digital root 9. 39390(10) has additive persistence 2 and digital root 6. 588225(10) has additive persistence 2 and digital root 3. 393900588225(10) has additive persistence 2 and digital root 9. --- Examples in 16-Base --- 9939F(16) has additive persistence 2 and digital root 15. 99DE(16) has additive persistence 2 and digital root 15. 8F9C1(16) has additive persistence 2 and digital root 15. 5BB64DFCC1(16) has additive persistence 2 and digital root 15.
Perl
#!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";
}
}
- Output:
101( 2): persistance = 2, root = 1 10011001001110011111( 2): persistance = 3, root = 1 1001100111011110( 2): persistance = 3, root = 1 10001111100111000001( 2): persistance = 3, root = 1 BIG( 2): persistance = 3, root = 1 BIG( 2): persistance = 4, root = 1 12( 3): persistance = 2, root = 1 1011212221000( 3): persistance = 3, root = 1 2000000220( 3): persistance = 2, root = 2 1002212220010( 3): persistance = 3, root = 1 1101122201121110011000000( 3): persistance = 3, root = 1 BIG( 3): persistance = 4, root = 1 5( 8): persistance = 0, root = 5 2311637( 8): persistance = 3, root = 2 114736( 8): persistance = 3, root = 1 2174701( 8): persistance = 3, root = 1 5566623376301( 8): persistance = 3, root = 4 BIG( 8): persistance = 3, root = 3 5(10): persistance = 0, root = 5 627615(10): persistance = 2, root = 9 39390(10): persistance = 2, root = 6 588225(10): persistance = 2, root = 3 393900588225(10): persistance = 2, root = 9 BIG(10): persistance = 3, root = 4 5(16): persistance = 0, root = 5 9939f(16): persistance = 2, root = 15 99de(16): persistance = 2, root = 15 8f9c1(16): persistance = 2, root = 15 5bb64dfcc1(16): persistance = 2, root = 15 BIG(16): persistance = 3, root = 7 5(36): persistance = 0, root = 5 dg9r(36): persistance = 2, root = 30 ue6(36): persistance = 2, root = 15 clvl(36): persistance = 2, root = 15 50ye8n29(36): persistance = 2, root = 25 BIG(36): persistance = 3, root = 17
Phix
with javascript_semantics procedure digital_root(atom n, integer base=10) integer root, persistence = 1 atom work = n while true do root = 0 while work!=0 do root += remainder(work,base) work = floor(work/base) end while if root<base then exit end if work = root persistence += 1 end while printf(1,"%15d root: %d persistence: %d\n",{n,root,persistence}) end procedure digital_root(627615) digital_root(39390) digital_root(588225) digital_root(393900588225)
- Output:
627615 root: 9 persistence: 2 39390 root: 6 persistence: 2 588225 root: 3 persistence: 2 393900588225 root: 9 persistence: 2
PHP
<?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;
}
?>
- Output:
1 0 1 14 1 5 267 2 6 8128 3 1 39390 2 6 588225 2 3 627615 2 9
Picat
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.
- Output:
627615 har addititive persistence 2 and digital root of 9 39390 har addititive persistence 2 and digital root of 6 588225 har addititive persistence 2 and digital root of 3 393900588225 har addititive persistence 2 and digital root of 9 58142718981673030403681039458302204471300738980834668522257090844071443085937 har addititive persistence 3 and digital root of 4
PicoLisp
(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 ";") ) ) )
- Output:
627615 has additive persistance 2 and digital root of 9; 39390 has additive persistance 2 and digital root of 6; 588225 has additive persistance 2 and digital root of 3; 393900588225 has additive persistance 2 and digital root of 9;
PL/I
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;
- Output:
7 7 0 627615 9 2 39390 6 2 588225 3 2 393900588225 9 2
Alternative:
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;
Results:
N= 5 PICT.X=0000000000005 AP= 1; N= 627615 PICT.X=0000000000009 AP= 2; N= 39390 PICT.X=0000000000006 AP= 2; N= 588225 PICT.X=0000000000003 AP= 2; N= 393900588225 PICT.X=0000000000009 AP= 2; N= 99999999999 PICT.X=0000000000009 AP= 3;
PL/M
Similar to the Algol W version, this sample handles numbers larger than 65535 ( the largest integer supported by the original 8080 PL/M compiler ) by splitting the numbers into 3 parts. Note that the original 8080 PL/M compiler only supports 8 and 16 bit unsigned values.
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
- Output:
627615: DIGITAL ROOT: 9, PERSISTENCE: 2 39390: DIGITAL ROOT: 6, PERSISTENCE: 2 588225: DIGITAL ROOT: 3, PERSISTENCE: 2 393900588225: DIGITAL ROOT: 9, PERSISTENCE: 2
Potion
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)
PowerShell
Uses the recursive function from the 'Sum Digits of an Integer' task.
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
}
Command:
Get-DigitalRoot 65536
- Output:
Sum Additive Persistence --- -------------------- 7 2
Alternative Method
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
}
}
Command:
Get-DigitalRoot 627615
- Output:
Name Value ---- ----- AdditivePersistence 2 DigitalRoot 9
Prolog
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).
- Output:
627615 has additive persistence 2 and digital root 9. 39390 has additive persistence 2 and digital root 6. 588225 has additive persistence 2 and digital root 3. 393900588225 has additive persistence 2 and digital root 9. 685943443231217865409 has additive persistence 3 and digital root 4.
PureBasic
; 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
- Output:
627615 has additive persistance 2 and digital root of X(slow) =9 M(fast) =9 ok 39390 has additive persistance 2 and digital root of X(slow) =6 M(fast) =6 ok 588225 has additive persistance 2 and digital root of X(slow) =3 M(fast) =3 ok 393900588225 has additive persistance 2 and digital root of X(slow) =9 M(fast) =9 ok
Python
Procedural
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))
- Output:
627615 has additive persistance 2 and digital root 9. 39390 has additive persistance 2 and digital root 6. 588225 has additive persistance 2 and digital root 3. 393900588225 has additive persistance 2 and digital root 9. 55 has additive persistance 2 and digital root 1.
Composition of pure functions
A useful functional abstraction for this kind of pattern is until p f x (predicate, function, start value).
For the digit sum, we can fuse the two-pass composition of sum and for in the procedural version to a single 'fold' or catamorphism using reduce.
The tabulation of f(x) values can be derived by a generalised function over the f, a header string s, and the input xs:
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()
- Output:
Integer -> (additive persistence, digital root): 627615 -> (2, 9) 39390 -> (2, 6) 588225 -> (2, 3) 393900588225 -> (2, 9) 55 -> (2, 1)
Quackery
[ 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
Output:
627615 has additive persistance 9 and digital root of 2; 39390 has additive persistance 6 and digital root of 2; 588225 has additive persistance 3 and digital root of 2; 393900588225 has additive persistance 9 and digital root of 2;
R
The code prints digital root and persistence seperately
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)
Racket
#lang racket
(define/contract (additive-persistence/digital-root n (ap 0))
(->* (natural-number/c) (natural-number/c) (values natural-number/c natural-number/c))
(define/contract (sum-digits x (acc 0))
(->* (natural-number/c) (natural-number/c) natural-number/c)
(if (= x 0)
acc
(let-values (((q r) (quotient/remainder x 10)))
(sum-digits q (+ acc r)))))
(if (< n 10)
(values ap n)
(additive-persistence/digital-root (sum-digits n) (+ ap 1))))
(module+ test
(require rackunit)
(for ((n (in-list '(627615 39390 588225 393900588225)))
(ap (in-list '(2 2 2 2)))
(dr (in-list '(9 6 3 9))))
(call-with-values
(lambda () (additive-persistence/digital-root n))
(lambda (a d)
(check-equal? a ap)
(check-equal? d dr)
(printf ":~a has additive persistence ~a and digital root of ~a;~%" n a d)))))
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
Raku
(formerly Perl 6)
sub digital-root ($r, :$base = 10) {
my $root = $r.base($base);
my $persistence = 0;
while $root.chars > 1 {
$root = $root.comb.map({:36($_)}).sum.base($base);
$persistence++;
}
$root, $persistence;
}
my @testnums =
627615,
39390,
588225,
393900588225,
58142718981673030403681039458302204471300738980834668522257090844071443085937;
for 10, 8, 16, 36 -> $b {
for @testnums -> $n {
printf ":$b\<%s>\ndigital root %s, persistence %s\n\n",
$n.base($b), digital-root $n, :base($b);
}
}
- Output:
:10<627615> digital root 9, persistence 2 :10<39390> digital root 6, persistence 2 :10<588225> digital root 3, persistence 2 :10<393900588225> digital root 9, persistence 2 :10<58142718981673030403681039458302204471300738980834668522257090844071443085937> digital root 4, persistence 3 :8<2311637> digital root 2, persistence 3 :8<114736> digital root 1, persistence 3 :8<2174701> digital root 1, persistence 3 :8<5566623376301> digital root 4, persistence 3 :8<10021347156245115014463623107370014314341751427033746320331121536631531505161175135161> digital root 3, persistence 3 :16<9939F> digital root F, persistence 2 :16<99DE> digital root F, persistence 2 :16<8F9C1> digital root F, persistence 2 :16<5BB64DFCC1> digital root F, persistence 2 :16<808B9CDCA526832679323BE018CC70FA62E1BF3341B251AF666B345389F4BA71> digital root 7, persistence 3 :36<DG9R> digital root U, persistence 2 :36<UE6> digital root F, persistence 2 :36<CLVL> digital root F, persistence 2 :36<50YE8N29> digital root P, persistence 2 :36<37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVNCBWNRVNOJYPD> digital root H, persistence 3
Or if you are more inclined to the functional programming persuasion, you can use the … sequence operator to calculate the values without side effects:
sub digital-root ($r, :$base = 10) {
my &sum = { .comb.map({:36($_)}).sum.base($base) }
return .[*-1], .elems-1
given $r.base($base), &sum … { .chars == 1 }
}
Output same as above.
REXX
version 1
/* 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 */
version 2
/*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. */
- output when using the internal default inputs:
digital additive root persistence number ═══════ ═══════════ ═════════════════════════════════════════════════════════════════════════════ 9 2 627615 6 2 39390 3 2 588225 9 2 393900588225 8 3 89999999999999999999999999999999999999999999999999999999999999999999999999999 ═══════ ═══════════ ═════════════════════════════════════════════════════════════════════════════
version 3
This subroutine version can also handle numbers with signs, blanks, commas, and/or decimal points.
/*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.*/
- output is identical to the 2nd REXX version.
Version 4
REXX
Libraries: How to use
Library: Numbers
Library: Functions
For calculation of the Digital root there exists a closed formula, as given in the Wikipedia article on this topic. For bigger numbers a formula is 5-10 times faster than just counting digits. For the Additional persistence no such formula is known. So there you'll still need the whole algorithm.
Nevertheless, since function Digital root might be needed stand-alone (i.e. the REXX entry for Perfect numbers), I coded a solution where the two functions are split up.
numeric digits 30; glob. = ''
parse version version; say version Digits() 'digits'
say 'Digital root: Use REXX libraries'; say
say Show(0)
say Show(9)
say Show(10)
say Show(19)
say Show(199)
say Show(679)
say Show(6788)
say Show(39390)
say Show(588225)
say Show(2677889)
say Show(393900588225)
say Show(19999999999999999999999)
exit
Show:
arg x
return 'Number:' x 'Digital root:' Digitroot(x) 'Additive persistence:' Persistence(x)
Digitroot:
/* Digital root function */
procedure expose glob.
arg x
/* Validity */
if \ Whole(x) then
return 'X'
if x < 0 then
return 'X'
/* Formula */
return 1+(x-1)//9
Persistence:
/* Additive persistence function */
procedure expose glob.
arg x
/* Validity */
if \ Whole(x) then
return 'X'
if x < 0 then
return 'X'
/* Fast value */
if x < 10 then
return 0
/* Cf definition */
do y = 1 until x < 10
x = Digitsum(x)
end
return y
Digitsum:
/* Digitsum function = sum(digits) */
procedure expose glob.
arg x
/* Validity */
if \ Whole(x) then
return 'X'
if x < 0 then
return 'X'
/* Sum digits */
y = 0
do n = 1 to Length(x)
y = y+Substr(x,n,1)
end
return y
include Numbers
include Functions
Most of the code is parameter checking or fast values, but this is a neat and elegant solution. Though slightly slower than the previous versions.
- Output:
REXX-Regina_3.9.6(MT) 5.00 29 Apr 2024 30 digits Digital root: Use REXX libraries Number: 0 Digital root: 0 Additive persistence: 0 Number: 9 Digital root: 9 Additive persistence: 0 Number: 10 Digital root: 1 Additive persistence: 1 Number: 19 Digital root: 1 Additive persistence: 2 Number: 199 Digital root: 1 Additive persistence: 3 Number: 679 Digital root: 4 Additive persistence: 2 Number: 6788 Digital root: 2 Additive persistence: 3 Number: 39390 Digital root: 6 Additive persistence: 2 Number: 588225 Digital root: 3 Additive persistence: 2 Number: 2677889 Digital root: 2 Additive persistence: 3 Number: 393900588225 Digital root: 9 Additive persistence: 2 Number: 19999999999999999999999 Digital root: 1 Additive persistence: 4
Ring
c = 0
see "Digital root of 627615 is " + digitRoot(627615, 10) + " persistance is " + c + nl
see "Digital root of 39390 is " + digitRoot(39390, 10) + " persistance is " + c + nl
see "Digital root of 588225 is " + digitRoot(588225, 10) + " persistance is " + c + nl
see "Digital root of 9992 is " + digitRoot(9992, 10) + " persistance is " + c + nl
func digitRoot n,b
c = 0
while n >= b
c = c + 1
n = digSum(n, b)
end
return n
func digSum n, b
s = 0
while n != 0
q = floor(n / b)
s = s + n - q * b
n = q
end
return s
RPL
Base 10 only. For other bases, use DIGITS
from Factors of an integer#RPL instead of ∑DGIT
below, which is more compact - but works only in base 10.
≪ 0 SWAP DO 10 / LAST MOD ROT + RND SWAP FLOOR UNTIL DUP NOT END DROP ≫ '∑DGIT' STO ≪ 0 WHILE OVER 9 > REPEAT 1 + SWAP ∑DGIT SWAP END R→C ≫ 'DROOT' STO
≪ { 627615 39390 588225 393900588225 55 } → cases ≪ {} 1 cases SIZE FOR j cases j GET DROOT + NEXT ≫ ≫ EVAL
{out}
1: { (9,2) (6,2) (3,2) (9,2) (1,2) }
Ruby
class String
def digroot_persistence(base=10)
num = self.to_i(base)
persistence = 0
until num < base do
num = num.digits(base).sum
persistence += 1
end
[num.to_s(base), persistence]
end
end
puts "--- Examples in 10-Base ---"
%w(627615 39390 588225 393900588225).each do |str|
puts "%12s has a digital root of %s and a persistence of %s." % [str, *str.digroot_persistence]
end
puts "\n--- Examples in other Base ---"
format = "%s base %s has a digital root of %s and a persistence of %s."
[["101101110110110010011011111110011000001", 2],
[ "5BB64DFCC1", 16],
["5", 8],
["50YE8N29", 36]].each do |(str, base)|
puts format % [str, base, *str.digroot_persistence(base)]
end
- Output:
--- Examples in 10-Base --- 627615 has a digital root of 9 and a persistence of 2. 39390 has a digital root of 6 and a persistence of 2. 588225 has a digital root of 3 and a persistence of 2. 393900588225 has a digital root of 9 and a persistence of 2. --- Examples in other Base --- 101101110110110010011011111110011000001 base 2 has a digital root of 1 and a persistence of 3. 5BB64DFCC1 base 16 has a digital root of f and a persistence of 2. 5 base 8 has a digital root of 5 and a persistence of 0. 50YE8N29 base 36 has a digital root of p and a persistence of 2.
Run BASIC
print "Digital root of 627615 is "; digitRoot$(627615, 10)
print "Digital root of 39390 is "; digitRoot$(39390, 10)
print "Digital root of 588225 is "; digitRoot$(588225, 10)
print "Digital root of 393900588225 is "; digitRoot$(393900588225, 10)
print "Digital root of 9992 is "; digitRoot$(9992, 10)
END
function digitRoot$(n,b)
WHILE n >= b
c = c + 1
n = digSum(n, b)
wend
digitRoot$ = n;" persistance is ";c
end function
function digSum(n, b)
WHILE n <> 0
q = INT(n / b)
s = s + n - q * b
n = q
wend
digSum = s
end function
- Output:
Digital root of 627615 is 9 persistance is 2 Digital root of 39390 is 6 persistance is 2 Digital root of 588225 is 3 persistance is 2 Digital root of 393900588225 is 9 persistance is 2 Digital root of 9992 is 2 persistance is 3
Rust
fn sum_digits(mut n: u64, base: u64) -> u64 {
let mut sum = 0u64;
while n > 0 {
sum = sum + (n % base);
n = n / base;
}
sum
}
// Returns tuple of (additive-persistence, digital-root)
fn digital_root(mut num: u64, base: u64) -> (u64, u64) {
let mut pers = 0;
while num >= base {
pers = pers + 1;
num = sum_digits(num, base);
}
(pers, num)
}
fn main() {
// Test base 10
let values = [627615u64, 39390u64, 588225u64, 393900588225u64];
for &value in values.iter() {
let (pers, root) = digital_root(value, 10);
println!("{} has digital root {} and additive persistance {}",
value,
root,
pers);
}
println!("");
// Test base 16
let values_base16 = [0x7e0, 0x14e344, 0xd60141, 0x12343210];
for &value in values_base16.iter() {
let (pers, root) = digital_root(value, 16);
println!("0x{:x} has digital root 0x{:x} and additive persistance 0x{:x}",
value,
root,
pers);
}
}
- Output:
627615 has digital root 9 and additive persistance 2 39390 has digital root 6 and additive persistance 2 588225 has digital root 3 and additive persistance 2 393900588225 has digital root 9 and additive persistance 2 0x7e0 has digital root 0x6 and additive persistance 0x2 0x14e344 has digital root 0xf and additive persistance 0x2 0xd60141 has digital root 0xa and additive persistance 0x2 0x12343210 has digital root 0x1 and additive persistance 0x2
S-BASIC
We operate on the number as a string to avoid the limitations of S-BASIC's 16-bit integer type
rem - return the digital sum of n represented as a string
function digitalsum(nstr = string) = integer
var i, slen, sum = integer
var ch = char
slen = len(nstr)
sum = 0
for i = 1 to slen
ch = mid(nstr, i, 1)
rem - don't process leading or embedded spaces, etc.
if ch >= '0' and ch <= '9' then
sum = sum + (ch - '0')
next i
end = sum
var nstr = string
var droot, pers = integer
0again
rem - input1 does not advance to next line; control-C will exit
input1 "What number"; nstr
droot = digitalsum(nstr)
pers = 1
while droot > 9 do
begin
droot = digitalsum(str$(droot))
pers = pers + 1
end
print " digital root ="; droot; " persistence ="; pers
goto 0again
end
- Output:
Control-C at the prompt provides a quick and dirty exit
What number ? 627615 digital root = 9 persistence = 2 What number ? 39390 digital root = 6 persistence = 2 What number ? 588225 digital root = 3 persistence = 2 What number ? 393900588225 digital root = 9 persistence = 2 What number ?
Scala
def digitalRoot(x:BigInt, base:Int=10):(Int,Int) = {
def sumDigits(x:BigInt):Int=x.toString(base) map (_.asDigit) sum
def loop(s:Int, c:Int):(Int,Int)=if (s < 10) (s, c) else loop(sumDigits(s), c+1)
loop(sumDigits(x), 1)
}
Seq[BigInt](627615, 39390, 588225, BigInt("393900588225")) foreach {x =>
var (s, c)=digitalRoot(x)
println("%d has additive persistance %d and digital root of %d".format(x,c,s))
}
var (s, c)=digitalRoot(0x7e0, 16)
println("%x has additive persistance %d and digital root of %d".format(0x7e0,c,s))
- Output:
627615 has additive persistance 2 and digital root of 9 39390 has additive persistance 2 and digital root of 6 588225 has additive persistance 2 and digital root of 3 393900588225 has additive persistance 2 and digital root of 9 7e0 has additive persistance 2 and digital root of 6
Scheme
; Convert an integer into a list of its digits.
(define integer->list
(lambda (integer)
(let loop ((list '()) (int integer))
(if (< int 10)
(cons int list)
(loop (cons (remainder int 10) list) (quotient int 10))))))
; Return the sum of the digits of an integer.
(define integer-sum-digits
(lambda (integer)
(fold-left + 0 (integer->list integer))))
; Compute the digital root (additive) and additive persistence of an integer.
; Return as a cons of (adr . ap).
(define adr-ap
(lambda (integer)
(let loop ((int integer) (cnt 0))
(if (< int 10)
(cons int cnt)
(loop (integer-sum-digits int) (1+ cnt))))))
; Emit a table of integer, digital root (additive), and additive persistence
; for the example integers given.
(printf "~13@a ~6@a ~6@a~%" "Integer" "Root" "Pers.")
(let rowloop ((intlist '(627615 39390 588225 393900588225 0 1 68010887038)))
(when (pair? intlist)
(let* ((int (car intlist))
(aa (adr-ap int)))
(printf "~13@a ~6@a ~6@a~%" int (car aa) (cdr aa))
(rowloop (cdr intlist)))))
- Output:
Integer Root Pers. 627615 9 2 39390 6 2 588225 3 2 393900588225 9 2 0 0 0 1 1 0 68010887038 4 3
Seed7
$ include "seed7_05.s7i";
include "bigint.s7i";
const func bigInteger: digitalRoot (in var bigInteger: num, in bigInteger: base, inout bigInteger: persistence) is func
result
var bigInteger: sum is 0_;
begin
persistence := 0_;
while num >= base do
sum := 0_;
while num > 0_ do
sum +:= num rem base;
num := num div base;
end while;
num := sum;
incr(persistence);
end while;
end func;
const proc: main is func
local
var bigInteger: num is 0_;
var bigInteger: root is 0_;
var bigInteger: persistence is 0_;
begin
for num range [] (627615_, 39390_, 588225_, 393900588225_) do
root := digitalRoot(num, 10_, persistence);
writeln(num <& " has additive persistence " <& persistence <& " and digital root of " <& root);
end for;
end func;
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
Sidef
func digroot (r, base = 10) {
var root = r.base(base)
var persistence = 0
while (root.len > 1) {
root = root.chars.map{|n| Number(n, 36) }.sum(0).base(base)
++persistence
}
return(persistence, root)
}
var nums = [5, 627615, 39390, 588225, 393900588225]
var bases = [2, 3, 8, 10, 16, 36]
var fmt = "%25s(%2s): persistance = %s, root = %2s\n"
nums << (550777011503 *
105564897893993412813307040538786690718089963180462913406682192479)
bases.each { |b|
nums.each { |n|
var x = n.base(b)
x = 'BIG' if (x.len > 25)
fmt.printf(x, b, digroot(n, b))
}
print "\n"
}
- Output:
101( 2): persistance = 2, root = 1 10011001001110011111( 2): persistance = 3, root = 1 1001100111011110( 2): persistance = 3, root = 1 10001111100111000001( 2): persistance = 3, root = 1 BIG( 2): persistance = 3, root = 1 BIG( 2): persistance = 4, root = 1 12( 3): persistance = 2, root = 1 1011212221000( 3): persistance = 3, root = 1 2000000220( 3): persistance = 2, root = 2 1002212220010( 3): persistance = 3, root = 1 1101122201121110011000000( 3): persistance = 3, root = 1 BIG( 3): persistance = 4, root = 1 5( 8): persistance = 0, root = 5 2311637( 8): persistance = 3, root = 2 114736( 8): persistance = 3, root = 1 2174701( 8): persistance = 3, root = 1 5566623376301( 8): persistance = 3, root = 4 BIG( 8): persistance = 3, root = 3 5(10): persistance = 0, root = 5 627615(10): persistance = 2, root = 9 39390(10): persistance = 2, root = 6 588225(10): persistance = 2, root = 3 393900588225(10): persistance = 2, root = 9 BIG(10): persistance = 3, root = 4 5(16): persistance = 0, root = 5 9939f(16): persistance = 2, root = f 99de(16): persistance = 2, root = f 8f9c1(16): persistance = 2, root = f 5bb64dfcc1(16): persistance = 2, root = f BIG(16): persistance = 3, root = 7 5(36): persistance = 0, root = 5 dg9r(36): persistance = 2, root = u ue6(36): persistance = 2, root = f clvl(36): persistance = 2, root = f 50ye8n29(36): persistance = 2, root = p BIG(36): persistance = 3, root = h
Smalltalk
digitalRoot :=
[:nr :arIn |
r := (nr printString asArray collect:#digitValue) sum.
r > 9 ifTrue:[
digitalRoot value:r value:arIn+1.
] ifFalse:[
{ arIn+1 . r }
].
].
#(
627615 39390 588225 393900588225 10 199
1999999999999999999999999999999999999999999999999999999999999999999999999999999999999
) do:[:nr |
Transcript showCR:'%1 has digitalRoot %3 and Additive Resistance %2'
withArguments:{nr},(digitalRoot value:nr value:0)
]
- Output:
39390 has digitalRoot 6 and Additive Resistance 2 588225 has digitalRoot 3 and Additive Resistance 2 393900588225 has digitalRoot 9 and Additive Resistance 2 10 has digitalRoot 1 and Additive Resistance 1 199 has digitalRoot 1 and Additive Resistance 3 1999999999999999999999999999999999999999999999999999999999999999999999999999999999999 has digitalRoot 1 and Additive Resistance 4
SmileBASIC
DEF DIGITAL_ROOT N OUT DR,AP
AP=0
DR=N
WHILE DR>9
INC AP
STRDR$=STR$(DR)
NEWDR=0
FOR I=0 TO LEN(STRDR$)-1
INC NEWDR,VAL(MID$(STRDR$,I,1))
NEXT
DR=NEWDR
WEND
END
Tcl
package require Tcl 8.5
proc digitalroot num {
for {set p 0} {[string length $num] > 1} {incr p} {
set num [::tcl::mathop::+ {*}[split $num ""]]
}
list $p $num
}
foreach n {627615 39390 588225 393900588225} {
lassign [digitalroot $n] p r
puts [format "$n has additive persistence $p and digital root of $r"]
}
- Output:
627615 has additive persistence 2 and digital root of 9 39390 has additive persistence 2 and digital root of 6 588225 has additive persistence 2 and digital root of 3 393900588225 has additive persistence 2 and digital root of 9
TI-83 BASIC
:ClrHome
:1→X
:Input ">",Str1
:Str1→Str2
:Repeat L≤1
:Disp Str1
:length(Str1→L
:L→dim(L₁
:seq(expr(sub(Str1,A,1)),A,1,L)→L₁
:sum(L₁→N
:{0,.5,1→L₂
:NL₂→L₃
:Med-Med L₂,L₃,Y₁
:Equ►String(Y₁,Str1
:sub(Str1,1,length(Str1)-3→Str1
:X+1→X
:End
:Pause
:ClrHome
:Disp Str2,"DIGITAL ROOT",expr(Str1),"ADDITIVE","PERSISTENCE",X
:Pause
- Output:
627615 DIGITAL ROOT 9 ADDITIVE PERSISTENCE 2 39390 DIGITAL ROOT 6 ADDITIVE PERSISTENCE 2 588225 DIGITAL ROOT 3 ADDITIVE PERSISTENCE 2 393900588225 DIGITAL ROOT 9 ADDITIVE PERSISTENCE 2
TypeScript
// Digital root
function rootAndPers(n: number, bas: number): [number, number] {
var pers = 0;
while (n >= bas)
{
var s = 0;
do
{
s += n % bas;
n = Math.floor(n / bas);
} while (n > 0);
pers++;
n = s;
}
return [n, pers];
}
for (var a of [1, 14, 267, 8128, 39390, 588225, 627615]) {
var rp = rootAndPers(a, 10);
console.log(a.toString().padStart(7, ' ') +
rp[1].toString().padStart(6, ' ') + rp[0].toString().padStart(6, ' '));
}
- Output:
1 0 1 14 1 5 267 2 6 8128 3 1 39390 2 6 588225 2 3 627615 2 9
uBasic/4tH
PRINT "Digital root of 627615 is "; FUNC(_FNdigitalroot(627615, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"
PRINT "Digital root of 39390 is "; FUNC(_FNdigitalroot(39390, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"
PRINT "Digital root of 588225 is "; FUNC(_FNdigitalroot(588225, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"
PRINT "Digital root of 9992 is "; FUNC(_FNdigitalroot(9992, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"
END
_FNdigitalroot Param(2)
Local (1)
c@ = 0
Do Until a@ < b@
c@ = c@ + 1
a@ = FUNC(_FNdigitsum (a@, b@))
Loop
Push (c@) ' That's how uBasic handles an extra
Return (a@) ' return value: on the stack
_FNdigitsum Param (2)
Local (2)
d@ =0
Do While a@ # 0
c@ = a@ / b@
d@ = d@ + a@ - (c@ * b@)
a@ = c@
Loop
Return (d@)
- Output:
Digital root of 627615 is 9 (additive persistence 2) Digital root of 39390 is 6 (additive persistence 2) Digital root of 588225 is 3 (additive persistence 2) Digital root of 9992 is 2 (additive persistence 3) 0 OK, 0:737
UNIX Shell
#!/usr/bin/env bash
numbers=(627615 39390 588225 393900588225 55)
declare root
for number in "${numbers[@]}"; do
declare -i iterations
root="${number}"
while [[ "${#root}" -ne 1 ]]; do
root="$(( $(fold -w1 <<<"${root}" | xargs | sed 's/ /+/g') ))"
iterations+=1
done
echo -e "${number} has additive persistence ${iterations} and digital root ${root}"
unset iterations
done | column -t
- Output:
627615 has additive persistence 2 and digital root 9 39390 has additive persistence 2 and digital root 6 588225 has additive persistence 2 and digital root 3 393900588225 has additive persistence 2 and digital root 9 55 has additive persistence 2 and digital root 1
VBA
Option Base 1
Private Sub digital_root(n As Variant)
Dim s As String, t() As Integer
s = CStr(n)
ReDim t(Len(s))
For i = 1 To Len(s)
t(i) = Mid(s, i, 1)
Next i
Do
dr = WorksheetFunction.Sum(t)
s = CStr(dr)
ReDim t(Len(s))
For i = 1 To Len(s)
t(i) = Mid(s, i, 1)
Next i
persistence = persistence + 1
Loop Until Len(s) = 1
Debug.Print n; "has additive persistence"; persistence; "and digital root of "; dr & ";"
End Sub
Public Sub main()
digital_root 627615
digital_root 39390
digital_root 588225
digital_root 393900588225#
End Sub
- Output:
627615 has additive persistence 2 and digital root of 9; 39390 has additive persistence 2 and digital root of 6; 588225 has additive persistence 2 and digital root of 3; 393900588225 has additive persistence 2 and digital root of 9;
VBScript
Function digital_root(n)
ap = 0
Do Until Len(n) = 1
x = 0
For i = 1 To Len(n)
x = x + CInt(Mid(n,i,1))
Next
n = x
ap = ap + 1
Loop
digital_root = "Additive Persistence = " & ap & vbCrLf &_
"Digital Root = " & n & vbCrLf
End Function
WScript.StdOut.Write digital_root(WScript.Arguments(0))
- Output:
F:\>cscript /nologo digital_root.vbs 627615 Additive Persistence = 2 Digital Root = 9 F:\>cscript /nologo digital_root.vbs 39390 Additive Persistence = 2 Digital Root = 6 F:\>cscript /nologo digital_root.vbs 588225 Additive Persistence = 2 Digital Root = 3 F:\>cscript /nologo digital_root.vbs 393900588225 Additive Persistence = 2 Digital Root = 9
Visual Basic .NET
Module Module1
Function DigitalRoot(num As Long) As Tuple(Of Integer, Integer)
Dim additivepersistence = 0
While num > 9
num = num.ToString().ToCharArray().Sum(Function(x) Integer.Parse(x))
additivepersistence = additivepersistence + 1
End While
Return Tuple.Create(additivepersistence, CType(num, Integer))
End Function
Sub Main()
Dim nums = {627615, 39390, 588225, 393900588225}
For Each num In nums
Dim t = DigitalRoot(num)
Console.WriteLine("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2)
Next
End Sub
End Module
- Output:
627615 has additive persistence 2 and digital root 9 39390 has additive persistence 2 and digital root 6 588225 has additive persistence 2 and digital root 3 393900588225 has additive persistence 2 and digital root 9
V (Vlang)
import strconv
fn sum(ii u64, base int) int {
mut s := 0
mut i := ii
b64 := u64(base)
for ; i > 0; i /= b64 {
s += int(i % b64)
}
return s
}
fn digital_root(n u64, base int) (int, int) {
mut persistence := 0
mut root := int(n)
for x := n; x >= u64(base); x = u64(root) {
root = sum(x, base)
persistence++
}
return persistence, root
}
// Normally the below would be moved to a *_test.go file and
// use the testing package to be runnable as a regular test.
struct Test{
n string
base int
persistence int
root int
}
const test_cases = [
Test{"627615", 10, 2, 9},
Test{"39390", 10, 2, 6},
Test{"588225", 10, 2, 3},
Test{"393900588225", 10, 2, 9},
Test{"1", 10, 0, 1},
Test{"11", 10, 1, 2},
Test{"e", 16, 0, 0xe},
Test{"87", 16, 1, 0xf},
// From Applesoft BASIC example:
Test{"DigitalRoot", 30, 2, 26}, // 26 is Q base 30
// From C++ example:
Test{"448944221089", 10, 3, 1},
Test{"7e0", 16, 2, 0x6},
Test{"14e344", 16, 2, 0xf},
Test{"d60141", 16, 2, 0xa},
Test{"12343210", 16, 2, 0x1},
// From the D example:
Test{"1101122201121110011000000", 3, 3, 1},
]
fn main() {
for tc in test_cases {
n, err := strconv.common_parse_uint2(tc.n, tc.base, 64)
if err != 0 {
panic('ERROR')
}
p, r := digital_root(n, tc.base)
println("${tc.n:12} (base ${tc.base:2}) has additive persistence $p and digital root ${strconv.format_int(i64(r), tc.base)}",)
if p != tc.persistence || r != tc.root {
panic("bad result: $tc $p $r")
}
}
}
- Output:
627615 (base 10) has additive persistence 2 and digital root 9 39390 (base 10) has additive persistence 2 and digital root 6 588225 (base 10) has additive persistence 2 and digital root 3 393900588225 (base 10) has additive persistence 2 and digital root 9 1 (base 10) has additive persistence 0 and digital root 1 11 (base 10) has additive persistence 1 and digital root 2 e (base 16) has additive persistence 0 and digital root e 87 (base 16) has additive persistence 1 and digital root f DigitalRoot (base 30) has additive persistence 2 and digital root q 448944221089 (base 10) has additive persistence 3 and digital root 1 7e0 (base 16) has additive persistence 2 and digital root 6 14e344 (base 16) has additive persistence 2 and digital root f d60141 (base 16) has additive persistence 2 and digital root a 12343210 (base 16) has additive persistence 2 and digital root 1 1101122201121110011000000 (base 3) has additive persistence 3 and digital root 1
Wortel
@let {
sumDigits ^(@sum @arr)
drootl &\@rangef [. sumDigits ^(\~>1 #@arr)]
droot ^(@last drootl)
apers ^(#-drootl)
[
!console.log "[number]: [digital root] [additive persistence] [intermediate sums]"
~@each [627615 39390 588225 393900588225]
&n !console.log "{n}: {!droot n} {!apers n} {@str !drootl n}"
]
}
- Output:
[number]: [digital root] [additive persistence] [intermediate sums] 627615: 9 2 [627615 27 9] 39390: 6 2 [39390 24 6] 588225: 3 2 [588225 30 3] 393900588225: 9 2 [393900588225 54 9]
Wren
import "./fmt" for Fmt
var sumDigits = Fn.new { |n|
var sum = 0
while (n > 0) {
sum = sum + (n%10)
n = (n/10).floor
}
return sum
}
var digitalRoot = Fn.new { |n|
if (n < 0) Fiber.abort("Argument must be non-negative.")
if (n < 10) return [n, 0]
var dr = n
var ap = 0
while (dr > 9) {
dr = sumDigits.call(dr)
ap = ap + 1
}
return [dr, ap]
}
var a = [1, 14, 267, 8128, 627615, 39390, 588225, 393900588225]
for (n in a) {
var res = digitalRoot.call(n)
var dr = res[0]
var ap = res[1]
Fmt.print("$,15d has additive persistence $d and digital root of $d", n, ap, dr)
}
- Output:
1 has additive persistence 0 and digital root of 1 14 has additive persistence 1 and digital root of 5 267 has additive persistence 2 and digital root of 6 8,128 has additive persistence 3 and digital root of 1 627,615 has additive persistence 2 and digital root of 9 39,390 has additive persistence 2 and digital root of 6 588,225 has additive persistence 2 and digital root of 3 393,900,588,225 has additive persistence 2 and digital root of 9
XPL0
Since integers are only 32 bits, floating point is used to get the extra precision needed.
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);
];
]
- Output:
2 9 2 6 2 3 2 9
zkl
fcn sum(n,b){ n.split(b).sum(0) }
fcn droot(n,b=10,X=0) // -->(digital root, additive persistence)
{ if(n<b)return(n,X); return(self.fcn(sum(n,b),b,X+1)) }
droot(627615)
droot(39390)
droot(588225)
droot(393900588225)
droot(7,2)
droot(0x7e0,16)
- Output:
L(9,2) //627615 L(6,2) //39390 L(3,2) //588225 L(9,2) //393900588225 L(1,3) //111 base 2: 111-->11-->10-->1 L(6,2) //7e0 base 16: 0x7e0-->0x15-->0x6
zonnon
module Main;
type
longint = integer{64};
type {public,ref}
Response = object (dr,p: longint)
var {public,immutable}
digitalRoot,persistence: longint;
procedure {public} Writeln;
begin
writeln("digital root: ",digitalRoot:2," persistence: ",persistence:2)
end Writeln;
begin
self.digitalRoot := dr;
self.persistence := p;
end Response;
procedure DigitalRoot(n:longint):Response;
var
sum,p: longint;
begin
p := 0;
loop
inc(p);sum := 0;
while (n > 0) do
inc(sum,n mod 10);
n := n div 10;
end;
if sum < 10 then return new Response(sum,p) else n := sum end
end
end DigitalRoot;
begin
write(627615:22,":> ");DigitalRoot(627615).Writeln;
write(39390:22,":> ");DigitalRoot(39390).Writeln;
write(588225:22,":> ");DigitalRoot(588225).Writeln;
write(max(integer{64}):22,":> ");DigitalRoot(max(integer{64})).Writeln;
end Main.
- Output:
627615 :> digital root: 9 persistence: 2 39390 :> digital root: 6 persistence: 2 588225 :> digital root: 3 persistence: 2 9223372036854775807 :> digital root: 7 persistence: 3
ZX Spectrum Basic
10 DATA 4,627615,39390,588225,9992
20 READ j: LET b=10
30 FOR i=1 TO j
40 READ n
50 PRINT "Digital root of ";n;" is"
60 GO SUB 1000
70 NEXT i
80 STOP
1000 REM Digital Root
1010 LET c=0
1020 IF n>=b THEN LET c=c+1: GO SUB 2000: GO TO 1020
1030 PRINT n;" persistance is ";c''
1040 RETURN
2000 REM Digit sum
2010 LET s=0
2020 IF n<>0 THEN LET q=INT (n/b): LET s=s+n-q*b: LET n=q: GO TO 2020
2030 LET n=s
2040 RETURN
- Programming Tasks
- Solutions by Programming Task
- 11l
- 360 Assembly
- Ada
- ALGOL 68
- ALGOL W
- AppleScript
- Applesoft BASIC
- Arturo
- AutoHotkey
- AWK
- BASIC
- Examples needing attention
- ASIC
- BASIC256
- Nascom BASIC
- True BASIC
- Yabasic
- Batch File
- BBC BASIC
- Befunge
- BQN
- Bracmat
- C
- C sharp
- C++
- Clojure
- CLU
- Common Lisp
- Component Pascal
- COBOL
- Cowgol
- Crystal
- D
- Dc
- DCL
- Delphi
- EasyLang
- Eiffel
- Elena
- Elixir
- Erlang
- F Sharp
- Factor
- Forth
- Fortran
- FreeBASIC
- Fōrmulæ
- Go
- Groovy
- Haskell
- Huginn
- Icon
- Unicon
- J
- Janet
- Java
- JavaScript
- Jq
- Julia
- K
- Kotlin
- Lua
- MAD
- Malbolge
- Mathematica
- Wolfram Language
- Maxima
- MiniScript
- Modula-2
- Modula-3
- Nanoquery
- NetRexx
- Nim
- OCaml
- Oforth
- Ol
- PARI/GP
- Pascal
- Perl
- Phix
- PHP
- Picat
- PicoLisp
- PL/I
- PL/M
- Potion
- PowerShell
- Prolog
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- REXX
- Ring
- RPL
- Ruby
- Run BASIC
- Rust
- S-BASIC
- Scala
- Scheme
- Seed7
- Sidef
- Smalltalk
- SmileBASIC
- Tcl
- TI-83 BASIC
- TypeScript
- UBasic/4tH
- UNIX Shell
- VBA
- VBScript
- Visual Basic .NET
- V (Vlang)
- Wortel
- Wren
- Wren-fmt
- XPL0
- Zkl
- Zonnon
- ZX Spectrum Basic