module Factory.Math.Radix(
digitSum,
digitalRoot,
fromBase,
toBase
) where
import Data.Array.IArray((!))
import qualified Data.Array.IArray
import qualified Data.Char
import qualified Data.List
import qualified Data.Maybe
digits :: String
digits = ['0' .. '9'] ++ ['a' .. 'z']
encodes :: (Data.Array.IArray.Ix index, Integral index) => Data.Array.IArray.Array index Char
encodes = Data.Array.IArray.listArray (0, pred $ Data.List.genericLength digits) digits
decodes :: Integral i => [(Char, i)]
decodes = zip digits [0 ..]
toBase :: (
Data.Array.IArray.Ix decimal,
Integral base,
Integral decimal,
Show base,
Show 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 (fromDecimal (negate decimal) [])
| otherwise = toDigit `map` fromDecimal decimal []
where
fromDecimal 0 = id
fromDecimal n
| remainder < 0 = fromDecimal (succ quotient) . ((remainder fromIntegral base) :)
| otherwise = fromDecimal quotient . (remainder :)
where
(quotient, remainder) = n `quotRem` fromIntegral base
toDigit :: (Data.Array.IArray.Ix i, Integral i, Show i) => i -> Char
toDigit n
| n >&< encodes = encodes ! n
| otherwise = error $ "Factory.Math.Radix.toBase.toDigit:\tno suitable character-representation for integer " ++ show n
where
(>&<) :: (Data.Array.IArray.Ix i, Integral i) => i -> Data.Array.IArray.Array i Char -> Bool
index >&< array = ($ index) `all` [(>= lower), (<= upper)] where
(lower, upper) = Data.Array.IArray.bounds array
fromBase :: (
Integral base,
Integral decimal,
Read decimal,
Show base
) => 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
| otherwise = Data.List.foldl' (\l -> ((l * fromIntegral base) +) . fromDigit) 0 s where
fromDigit :: Integral i => Char -> i
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 :: (
Data.Array.IArray.Ix decimal,
Integral base,
Integral decimal,
Show base,
Show decimal
) => base -> decimal -> decimal
digitSum 10 = fromIntegral . foldr ((+) . Data.Char.digitToInt) 0 . show
digitSum base = sum . Data.Maybe.mapMaybe (`lookup` decodes) . toBase base
digitalRoot :: (
Data.Array.IArray.Ix decimal,
Integral decimal,
Show decimal
) => decimal -> decimal
digitalRoot = until (<= 9) (digitSum (10 :: Int))