CDE

Task/Digital-root/0DESCRIPTION

@@ -0,0 +1,20 @@
+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.
+*[[oeis:A010888|Digital root sequence on OEIS]]
+*[[oeis:A031286|Additive persistence sequence on OEIS]]

Task/Digital-root/Ada/digital-root.ada

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

Task/Digital-root/BASIC/digital-root.bas

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

Task/Digital-root/BBC-BASIC/digital-root.bbc

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

Task/Digital-root/C++/digital-root.cpp

@@ -0,0 +1,32 @@
+// 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;
+}

Task/Digital-root/C/digital-root.c

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

Task/Digital-root/D/digital-root.d

@@ -0,0 +1,37 @@
+import std.stdio, std.typecons, std.conv, std.bigint;
+
+Tuple!(int, T) digitalRoot(T)(T root, in uint base) /*pure nothrow*/
+in {
+    assert(base > 1);
+} body {
+    if (root < 0)
+        root = -root;
+    int persistence = 0;
+    while (root >= base) {
+        auto num = root;
+        root = 0;
+        while (num != 0) {
+            root += num % base;
+            num /= base;
+        }
+        persistence++;
+    }
+    return tuple(persistence, root);
+}
+
+void main() {
+    // import std.stdio, std.conv, std.bigint;
+    enum f1 = "%s(%d): additive persistance= %d, digital root= %d";
+    foreach (b; [2, 3, 8, 10, 16, 36]) {
+        foreach (n; [5, 627615, 39390, 588225, 393900588225])
+            writefln(f1, to!string(n,b), b, digitalRoot(n, b).tupleof);
+        writeln();
+    }
+
+    enum f2 = "<BIG>(%d): additive persistance= %d, digital root= %d";
+    foreach (b; [2, 3, 8, 10, 16, 36]) {
+        auto n = BigInt("58142718981673030403681039458302204471" ~
+                       "300738980834668522257090844071443085937");
+        writefln(f2, b, digitalRoot(n, b).tupleof); // shortened output
+    }
+}

Task/Digital-root/Dc/digital-root.dc

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

Task/Digital-root/Go/digital-root.go

@@ -0,0 +1,56 @@
+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")
+}

Task/Digital-root/Haskell/digital-root-1.hs

@@ -0,0 +1,11 @@
+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]

Task/Digital-root/Haskell/digital-root-2.hs

@@ -0,0 +1,52 @@
+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"

Task/Digital-root/Java/digital-root.java

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

Task/Digital-root/PicoLisp/digital-root.l

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

Task/Digital-root/Python/digital-root.py

@@ -0,0 +1,10 @@
+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)

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

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

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

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

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

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

Task/Digital-root/Racket/digital-root.rkt

@@ -0,0 +1,25 @@
+#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)))))

Task/Digital-root/Scala/digital-root.scala

@@ -0,0 +1,12 @@
+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))

Task/Digital-root/Tcl/digital-root.tcl

@@ -0,0 +1,12 @@
+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"]
+}