Digital root: Difference between revisions
(Updated D entry) |
(Added Forth version) |
||
| Line 320: | Line 320: | ||
</lang> |
</lang> |
||
=={{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: |
|||
<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 ;</lang> |
|||
This will take care of most numbers: |
|||
<pre> |
|||
627615 digiroot . . 9 2 ok |
|||
39390 digiroot . . 6 2 ok |
|||
588225 digiroot . . 3 2 ok |
|||
</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: |
|||
<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 ; |
|||
: digiroot 0 -rot begin (Sdigit) 2>r 1+ 2r> 2dup base @ s>d d< until d>s ;</lang> |
|||
That one will take care of the last one: |
|||
<pre> |
|||
393900588225. digiroot . . 9 2 ok |
|||
</pre> |
|||
=={{header|Go}}== |
=={{header|Go}}== |
||
Using package from task "Sum digits of an integer." |
Using package from task "Sum digits of an integer." |
||
| Line 378: | Line 397: | ||
fmt.Println("all tests passed") |
fmt.Println("all tests passed") |
||
}</lang> |
}</lang> |
||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
Revision as of 17:53, 22 November 2013
You are encouraged to solve this task according to the task description, using any language you may know.
Related task Sum digits of an integer
The digital root (X) of a number (N) is calculated:
- find X as the sum of the digits of N
- find a new X by summing the digits of X repeating until X 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.
- 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;
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 sequence on OEIS
- Additive persistence sequence on OEIS
Ada
<lang Ada>with Ada.Text_IO;
procedure Digital_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 numbers
procedure Compute(N: Number; Digital_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
Digital_Root := N;
Persistence := 0;
else
Compute(Digit_Sum(N), Digital_Root, Persistence, Base);
Persistence := Persistence + 1;
end if;
end Compute;
procedure Compute_And_Write(Values: Number_Array; Base: Base_Type := 10) is
Root, Pers: Number;
package NIO is new Ada.Text_IO.Integer_IO(Number);
begin
for I in Values'Range loop
Compute(Values(I), Root, Pers, Base);
NIO.Put(Values(I), Base => Integer(Base), Width => 12);
Ada.Text_IO.Put(" has digital root ");
NIO.Put(Root, Base => Integer(Base), Width => 0);
Ada.Text_IO.Put(" and additive persistence" & Number'Image(Pers));
Ada.Text_IO.Put_Line(" (base" & Base_Type'Image(Base) & ").");
end loop;
end Compute_And_Write;
begin
Compute_And_Write((961038, 923594037444, 670033, 448944221089)); Compute_And_Write((16#7e0#, 16#14e344#, 16#12343210#), 16);
end Digital_Root;</lang>
- Output:
961038 has digital root 9 and additive persistence 2 (base 10).
923594037444 has digital root 9 and additive persistence 2 (base 10).
670033 has digital root 1 and additive persistence 3 (base 10).
448944221089 has digital root 1 and additive persistence 3 (base 10).
16#7E0# has digital root 16#6# and additive persistence 2 (base 16).
16#14E344# has digital root 16#F# and additive persistence 2 (base 16).
16#12343210# has digital root 16#1# and additive persistence 2 (base 16).
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.
<lang qbasic>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</lang>
Output:
627615 : additive persistance 2 , digital root 9 39390 : additive persistance 2 , digital root 6 588225 : additive persistance 2 , digital root 3
BBC BASIC
<lang bbcbasic> *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</lang>
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)
C
<lang 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; }</lang>
C++
For details of SumDigits see: http://rosettacode.org/wiki/Sum_digits_of_an_integer <lang cpp>// Calculate the Digital Root and Additive Persistance of an Integer - Compiles with gcc4.7 // // Nigel Galloway. July 23rd., 2012 //
- include <iostream>
- include <cmath>
- include <tuple>
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);
int ap = 1;
while (x >= BASE) {
x = SumDigits(x,BASE);
ap++;
}
return std::make_tuple(digits,ap,x);
}
int main() {
const unsigned long long int ip[] = {961038,923594037444,670033,448944221089};
for (auto i:ip){
auto res = DigitalRoot(i);
std::cout << std::get<0>(res) << " has digital root " << std::get<2>(res) << " and additive persistance " << std::get<1>(res) << "\n";
}
std::cout << "\n";
const unsigned long long int hip[] = {0x7e0,0x14e344,0xd60141,0x12343210};
for (auto i:hip){
auto res = DigitalRoot(i,16);
std::cout << std::hex << std::get<0>(res) << " has digital root " << std::get<2>(res) << " and additive persistance " << std::get<1>(res) << "\n";
}
return 0;
}</lang>
- 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
D
<lang 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 = "(%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.
}</lang>
- 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). <lang Dc> ?[10~rd10<p]sp[+z1<q]sq[lpxlqxd10<r]dsrxp </lang>
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: <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 ;</lang>
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: <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 ;
- digiroot 0 -rot begin (Sdigit) 2>r 1+ 2r> 2dup base @ s>d d< until d>s ;</lang>
That one will take care of the last one:
393900588225. digiroot . . 9 2 ok
Go
Using package from task "Sum digits of an integer." <lang go>package main
import (
"fmt" "log" "strconv"
"digit"
)
type testCase struct {
n string base int persistence int root int
}
var testCases = []testCase{
{"627615", 10, 2, 9},
{"39390", 10, 2, 6},
{"588225", 10, 2, 3},
{"393900588225", 10, 2, 9},
}
func root(n string, base int) (persistence, root int, err error) {
i, err := digit.Sum(n, base)
if err != nil {
return 0, 0, err
}
if len(n) == 1 {
return 0, int(i), nil
}
for {
persistence++
n := strconv.FormatInt(i, base)
if len(n) == 1 {
root = int(i)
break
}
i, _ = digit.Sum(n, base)
}
return
}
func main() {
for _, tc := range testCases {
p, r, err := root(tc.n, tc.base)
if err != nil {
log.Fatal(err)
}
if p != tc.persistence || r != tc.root {
log.Fatal("test case", tc)
}
}
fmt.Println("all tests passed")
}</lang>
Haskell
<lang haskell>digSum base = f 0 where f a n = let (q,r) = n`divMod`base in if q == 0 then a+r else f (a+r) q
digRoot base = f 0 where f p n | n < base = (p,n) | otherwise = f (p+1) (digSum base n)
main = do putStrLn "in base 10:" mapM_ print $ map (\x -> (x, digRoot 10 x)) [627615, 39390, 588225, 393900588225]</lang>
- Output:
in base 10: (627615,(2,9)) (39390,(2,6)) (588225,(2,3)) (393900588225,(2,9))
<lang haskell>import Data.List (elemIndex) import Data.Maybe (fromJust) 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 $ 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 n = toDigits' n 0
where toDigits' 0 0 = [0]
toDigits' 0 _ = []
toDigits' m _ = let (q, r) = m `quotRem` b in r : toDigits' q r
-- 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 => 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 = do
printDigRoot 2 "1001100111011110" printDigRoot 3 "2000000220" printDigRoot 8 "5566623376301" printDigRoot 10 "39390" printDigRoot 16 "99DE" printDigRoot 36 "50YE8N29" printDigRoot 36 "37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN"</lang>
- 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
Icon and Unicon
The following works in both languages:
<lang unicon>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</lang>
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
<lang J>digrot=: +/@(#.inv~&10)^:_ addper=: _1 + [: # +/@(#.inv~&10)^:a:</lang>
Example use:
<lang J> (, addper, digrot)&> 627615 39390 588225 393900588225
627615 2 9
39390 2 6
588225 2 3
393900588225 2 9</lang>
Here's an equality operator for comparing these digital roots:
<lang J>equals=: =&(9&|)"0</lang>
table of results:
<lang J> 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│ └──────┴───────────────────┘</lang>
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.
Java
Code:
<lang java>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]);
}
}
}</lang>
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
Mathematica
<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;</lang>
- 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
16NetRexx
<lang 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 */</lang> 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
PARI/GP
<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 digitalRoot(n)=if(n, (n-1)%9+1, 0)</lang>
Perl
<lang 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";
}
}
</lang>
- 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
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;
}
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), digroot $n, :base($b);
}
}</lang>
- 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: <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>
PL/I
<lang pli>
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;
</lang> Output:
7 7 0 627615 9 2 39390 6 2 588225 3 2 393900588225 9 2
Powershell
Uses the recursive function from the 'Sum Digits of an Integer' task.
<lang Powershell>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
}</lang> Command:
Get-DigitalRoot 65536
Output:
Sum Additive Persistence --- -------------------- 7 2
PicoLisp
<lang 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 ";") ) ) )</lang>
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;
PureBasic
<lang 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 </lang>
- Sample 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
<lang python>def droot (n):
x = [n]
while x[-1] > 10:
x.append(sum(int(dig) for dig in str(x[-1])))
return len(x) - 1, x[-1]
for n in [627615, 39390, 588225, 393900588225]:
a, d = droot (n)
print "%12i has additive persistance %2i and digital root of %i" % (
n, a, d)</lang>
- Sample 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 9Racket
<lang 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)))))
</lang>
Ouput:
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
REXX
version 1
<lang rexx>/* 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 */</lang>
version 2
<lang rexx>/*REXX program calculates the digital root and additive persistence. */ numeric digits 1000 /*lets handle biguns.*/ say 'digital' /*part of the header.*/ say ' root persistence' center('number',79) /* " " " " */ say '═══════ ═══════════' center( ,79,'═') /* " " " " */ call digRoot 627615 call digRoot 39390 call digRoot 588225 call digRoot 393900588225 call digRoot 899999999999999999999999999999999999999999999999999999999999999999999999999999999 exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────DIGROOT subroutine──────────────────*/ digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/
do j=1 for length(x) /*add each digit in the number. */
r=r+substr(x,j,1) /*add a digit to the digital root*/
end /*j*/
x=r /*'new' num, it may be multi-dig.*/
end /*pers*/
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */ return</lang> output
digital root persistance number ═══════ ═══════════ ═══════════════════════════════════════════════════════════════════════════════ 9 2 627615 6 2 39390 3 2 588225 9 2 393900588225 8 3 899999999999999999999999999999999999999999999999999999999999999999999999999999999
version 3
This subroutine version can handle numbers with signs, blanks, and/or decimal points. <lang rexx>/*──────────────────────────────────DIGROOT subroutine──────────────────*/ digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/
do j=1 for length(x) /*add each digit in the number. */
?=substr(x,j,1) /*pick off a char, maybe a dig ? */
if datatype(?,'W') then r=r+? /*add a digit to the digital root*/
end /*j*/
x=r /*'new' num, it may be multi-dig.*/
end /*pers*/
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */ return</lang>
Ruby
<lang ruby>class String
def digroot_persistance(base)
num = self.to_i(base)
persistance = 0
until num < base do
num = num.to_s(base).each_char.reduce(0){|m, c| m += c.to_i(base) }
persistance += 1
end
[num.to_s(base), persistance]
end
end
- Handles bases upto 36; Demo:
[["101101110110110010011011111110011000001", 2],
[ "5BB64DFCC1", 16],
["5", 10],
["393900588225", 10],
["50YE8N29", 36]].each{|(str, base)| puts "#{str} base #{base} has a digital root \
of %s and a resistance of %s." % str.digroot_persistance(base) }</lang>
- Output:
101101110110110010011011111110011000001 base 2 has a digital root of 1 and a resistance of 3. 5BB64DFCC1 base 16 has a digital root of f and a resistance of 2. 5 base 10 has a digital root of 5 and a resistance of 0. 393900588225 base 10 has a digital root of 9 and a resistance of 2. 50YE8N29 base 36 has a digital root of p and a resistance of 2.
Run BASIC
<lang runbasic>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</lang>
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
Scala
<lang 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))</lang>
- 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
Seed7
<lang 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;</lang>
- 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
Tcl
<lang 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"]
}</lang>
- 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
Wortel
<lang wortel>@let {
sumDigits &n @sum !*^@+ @split + n drootl &n @rangef n sumDigits &n >#+ n 1 droot @[^@last drootl] apers &n -#!drootl n 1
[
!console.log '[number]: [digital root] [additive persistence] [intermediate sums]'
~@each [627615 39390 588225 393900588225]
&n !console.log "{n}: {!droot n} {!apers n} {+'['~+']' @join ' ' !drootl n}"
]
}</lang> Outputs
[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]
XPL0
Since integers are only 32 bits, floating point is used to get the extra precision needed.
<lang XPL0>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);
];
]</lang>
Output:
2 9 2 6 2 3 2 9