content: 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
  