42 lines
1.2 KiB
Haskell
42 lines
1.2 KiB
Haskell
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
|