module Factory.Math.Radix(
digitSum,
digitalRoot,
fromBase,
toBase
) where
import Data.Array((!))
import qualified Data.Array
import qualified Data.Char
import qualified Data.List
import qualified Data.Maybe
digits :: String
digits = ['0' .. '9'] ++ ['a' .. 'z']
encodes :: (Data.Array.Ix index, Integral index) => Data.Array.Array index Char
encodes = Data.Array.listArray (0, fromIntegral $ length digits 1) digits
decodes :: Integral i => [(Char, i)]
decodes = zip digits [0 ..]
toBase :: (Integral base, Integral decimal) => base -> decimal -> String
toBase 10 decimal = show decimal
toBase _ 0 = "0"
toBase base decimal
| abs base < 2 = error $ "Factory.Math.Radix.toBase:\tan arbitrary integer can't be represented in base " ++ show base
| abs base > Data.List.genericLength digits = error $ "Factory.Math.Radix.toBase:\tunable to clearly represent the complete set of digits in base " ++ show base
| base > 0 && decimal < 0 = '-' : map (toDigit . fromIntegral) (fromDecimal (negate decimal) [])
| otherwise = (toDigit . fromIntegral) `map` fromDecimal decimal []
where
fromDecimal 0 = id
fromDecimal n
| remainder < 0 = fromDecimal (quotient + 1) . ((remainder fromIntegral base) :)
| otherwise = fromDecimal quotient . (remainder :)
where
(quotient, remainder) = n `quotRem` fromIntegral base
toDigit :: Int -> Char
toDigit n
| n >&< encodes = encodes ! n
| otherwise = error $ "Factory.Math.Radix.toBase.toDigit:\tno suitable character-representation for integer " ++ show n
where
(>&<) :: Int -> Data.Array.Array Int Char -> Bool
index >&< array = ($ index) `all` [(>= lower), (<= upper)] where
(lower, upper) = Data.Array.bounds array
fromBase :: (Integral base, Integral decimal, Read decimal) => base -> String -> decimal
fromBase 10 s = read s
fromBase _ "0" = 0
fromBase base s
| abs base < 2 = error $ "Factory.Math.Radix.fromBase:\tan arbitrary integer can't be represented in base " ++ show base
| abs base > Data.List.genericLength digits = error $ "Factory.Math.Radix.fromBase:\tunable to clearly represent the complete set of digits in base " ++ show base
| base > 0 && head s == '-' = negate . fromBase base $ tail s --Recurse.
| otherwise = Data.List.foldl' (\l -> ((l * fromIntegral base) +) . fromIntegral . fromDigit) 0 s where
fromDigit :: Char -> Int
fromDigit c = case c `lookup` decodes of
Just i
| i >= abs (fromIntegral base) -> error $ "Factory.Math.Radix.fromBase.fromDigit:\tillegal char " ++ show c ++ ", for base " ++ show base
| otherwise -> i
_ -> error $ "Factory.Math.Radix.fromBase.fromDigit:\tunrecognised char " ++ show c
digitSum :: (Integral base, Integral decimal) => base -> decimal -> decimal
digitSum 10 = fromIntegral . foldr ((+) . Data.Char.digitToInt) 0 . show
digitSum base = sum . Data.Maybe.mapMaybe (`lookup` decodes) . toBase base
digitalRoot :: Integral decimal => decimal -> decimal
digitalRoot = head . dropWhile (> 9) . iterate (digitSum (10 :: Int))