Update all new Tasks

Task/Digital-root-Multiplicative-digital-root/Haskell/digital-root-multiplicative-digital-root.hs

@@ -0,0 +1,41 @@
+import Control.Arrow
+import Data.Array
+import Data.LazyArray
+import Data.List (unfoldr)
+import Data.Tuple
+import Text.Printf
+
+-- The multiplicative persistence (MP) and multiplicative digital root (MDR) of
+-- the argument.
+mpmdr :: Integer -> (Int, Integer)
+mpmdr = (length *** head) . span (> 9) . iterate (product . digits)
+
+-- Pairs (mdr, ns) where mdr is a multiplicative digital root and ns are the
+-- first k numbers having that root.
+mdrNums :: Int -> [(Integer, [Integer])]
+mdrNums k = assocs $ lArrayMap (take k) (0,9) [(snd $ mpmdr n, n) | n <- [0..]]
+
+digits :: Integral t => t -> [t]
+digits 0 = [0]
+digits n = unfoldr step n
+  where step 0 = Nothing
+        step k = Just (swap $ quotRem k 10)
+
+printMpMdrs :: [Integer] -> IO ()
+printMpMdrs ns = do
+  putStrLn "Number MP MDR"
+  putStrLn "====== == ==="
+  sequence_ [printf "%6d %2d %2d\n" n p r | n <- ns, let (p,r) = mpmdr n]
+
+printMdrNums:: Int -> IO ()
+printMdrNums k = do
+  putStrLn "MDR Numbers"
+  putStrLn "=== ======="
+  let showNums = unwords . map show
+  sequence_ [printf "%2d  %s\n" mdr $ showNums ns | (mdr,ns) <- mdrNums k]
+
+main :: IO ()
+main = do
+  printMpMdrs [123321, 7739, 893, 899998]
+  putStrLn ""
+  printMdrNums 5