Data commit

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

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

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

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