September 2017 Update

Task/Digital-root/360-Assembly/digital-root.360

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

Task/Digital-root/Component-Pascal/digital-root.component

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

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

@@ -1,11 +1,17 @@
+import Data.Tuple (swap)
 import Data.List (unfoldr)
 
-digSum base = sum . unfoldr f where
-        f 0 = Nothing
-	f n = Just (r,q) where (q,r) = n `divMod` base
+digSum :: Int -> Int -> Int
+digSum base = sum . unfoldr f
+  where
+    f 0 = Nothing
+    f n = Just (swap (quotRem n base))
 
-digRoot base = head . dropWhile ((>= base).snd) . zip [0..] . iterate (digSum base)
+digRoot :: Int -> Int -> (Int, Int)
+digRoot base =
+  head . dropWhile ((>= base) . snd) . zip [0 ..] . iterate (digSum base)
 
-main =	do
-	putStrLn "in base 10:"
-	mapM_ print $ map (\x -> (x, digRoot 10 x)) [627615, 39390, 588225, 393900588225]
+main :: IO ()
+main = do
+  putStrLn "in base 10:"
+  mapM_ (print . ((,) <*> digRoot 10)) [627615, 39390, 588225, 393900588225]

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

@@ -1,51 +1,63 @@
-import Data.List (elemIndex, unfoldr)
+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)
+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
+  (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
+  :: Integral a
+  => a -> a -> [a]
 toDigits b = unfoldr f
-  where f 0 = Nothing
-        f n = Just (r,q) where (q,r) = n `quotRem` b
+  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']
+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 ""
+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))
+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"
+main =
+  mapM_
+    (uncurry printDigRoot)
+    [ (2, "1001100111011110")
+    , (3, "2000000220")
+    , (8, "5566623376301")
+    , (10, "39390")
+    , (16, "99DE")
+    , (36, "50YE8N29")
+    , (36, "37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN")
+    ]

Task/Digital-root/Kotlin/digital-root.kotlin

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

Task/Digital-root/Phix/digital-root.phix

@@ -0,0 +1,20 @@
+procedure digital_root(atom n, integer base=10)
+integer root, persistence = 1
+atom work = n
+    while 1 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)

Task/Digital-root/PowerShell/digital-root-2.psh

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

Task/Digital-root/Zkl/digital-root-1.zkl

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

Task/Digital-root/Zkl/digital-root-2.zkl

@@ -0,0 +1,6 @@
+droot(627615)
+droot(39390)
+droot(588225)
+droot(393900588225)
+droot(7,2)
+droot(0x7e0,16)