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")
    ]