module Text.Numeral.Positional
( toPositional
, digitSymbol
, binary
, negabinary
, ternary
, octal
, decimal
, negadecimal
, hexadecimal
) where
import qualified Data.List as L
import Data.Monoid
import Data.String
toPolynomial :: Integer -> Integer -> [Integer]
toPolynomial b n | n == 0 = [0]
| b == 0 = error "toPolynomial: base 0"
| b == (1) = case n of
(1) -> [0, 1]
1 -> [1]
_ -> error "toPolynomial: base (-1)"
| b == 1 = L.genericReplicate (abs n) (signum n)
| otherwise = toPolynomial_b $ n
where toPolynomial_b 0 = []
toPolynomial_b n = let (q, r) = n `qr` b
in r : toPolynomial_b q
qr | b > 0 = quotRem
| otherwise = quotRem'
quotRem' :: Integral a => a -> a -> (a, a)
quotRem' n d = let qr@(q, r) = n `quotRem` d
in if r < 0
then (q + 1, r d)
else qr
fromPolynomial :: Integer -> [Integer] -> Integer
fromPolynomial b = sum' . zipWith (*) (iterate (* b) 1)
where sum' = L.foldl' (+) 0
prop_polynomial :: Integer -> Integer -> Bool
prop_polynomial b n | b == 0 && n /= 0 = True
| b == (1) && abs n > 1 = True
| otherwise = n == (fromPolynomial b $ toPolynomial b n)
toPositional :: (IsString s, Monoid s) => (Integer -> s) -> Integer -> Integer -> Maybe s
toPositional f b n | b == 0 = Nothing
| n < 0 && b > 0 = fmap (mappend "-") $ repr (abs n)
| otherwise = repr n
where repr x = fmap mconcat . mapM f' . reverse . toPolynomial b $ x
f' n | n >= abs b = Nothing
| otherwise = Just $ f n
digitSymbols :: IsString s => [s]
digitSymbols = map (\x -> fromString [x]) $ ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z']
digitSymbol :: IsString s => Integer -> s
digitSymbol = (digitSymbols `L.genericIndex`)
binary :: (Monoid s, IsString s) => Integer -> Maybe s
binary = toPositional digitSymbol 2
negabinary :: (Monoid s, IsString s) => Integer -> Maybe s
negabinary = toPositional digitSymbol (2)
ternary :: (Monoid s, IsString s) => Integer -> Maybe s
ternary = toPositional digitSymbol 3
octal :: (Monoid s, IsString s) => Integer -> Maybe s
octal = toPositional digitSymbol 8
decimal :: (Monoid s, IsString s) => Integer -> Maybe s
decimal = toPositional digitSymbol 10
negadecimal :: (Monoid s, IsString s) => Integer -> Maybe s
negadecimal = toPositional digitSymbol (10)
hexadecimal ::(Monoid s, IsString s) => Integer -> Maybe s
hexadecimal = toPositional digitSymbol 16