64 lines
1.7 KiB
Haskell
64 lines
1.7 KiB
Haskell
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")
|
|
]
|