module Data.SciRatio
(
SciRatio
, SciRational
, (.^)
, fracSignificand
, base10Exponent
, (^!)
, (^^!)
, fromSciRatio
, factorizeBase
, ilogBase
, intLog
) where
import Data.Ratio ((%), denominator, numerator)
import Data.Hashable (Hashable(hashWithSalt))
infixr 8 ^!, ^^!
infixl 7 :^, .^
infixl 1 ~~
data SciRatio a b = !a :^ !b deriving Eq
type SciRational = SciRatio Rational Integer
instance (Fractional a, Real a, Integral b, Read a, Read b) =>
Read (SciRatio a b) where
readsPrec p = readParen (p > prec) $ \ r -> do
(x, s) <- readsPrec (succ prec) r
(".^", t) <- lex s
(y, u) <- readsPrec (succ prec) t
return (x .^ y, u)
instance (Show a, Show b) => Show (SciRatio a b) where
showsPrec p (x :^ a) = showParen (p > prec) $
showsPrec (succ prec) x .
showString " .^ " .
showsPrec (succ prec) a
instance (Real a, Integral b, Ord a) => Ord (SciRatio a b) where
compare (x :^ a) (y :^ b) = case compare sgnX sgnY of
EQ -> case sgnX of
EQ -> EQ
LT -> invert order
GT -> order
k -> k
where x' = toRational x
y' = toRational y
sgnX = compare x 0
sgnY = compare y 0
absM = abs (numerator x' * denominator y')
absN = abs (numerator y' * denominator x')
invert GT = LT
invert EQ = EQ
invert LT = GT
order = case (_ilogBase 10 absM, _ilogBase 10 absN) of
(logM, logN) -> case compare (a + logM) (b + logN) of
EQ | a >= b -> compare (absM * 10 ^ (a b)) absN
| otherwise -> compare absM (absN * 10 ^ (b a))
k -> k
instance (Hashable a, Hashable b) => Hashable (SciRatio a b) where
hashWithSalt s (r :^ e) = hashWithSalt s (magic, r, e)
where magic = 0xaaa80d6b :: Int
instance (Fractional a, Real a, Integral b) => Num (SciRatio a b) where
p + q = (x + y) .^ c where (x, y, c) = p ~~ q
p q = (x y) .^ c where (x, y, c) = p ~~ q
x :^ a * (y :^ b) = x * y .^ (a + b)
abs (y :^ b) = abs y :^ b
negate (y :^ b) = negate y :^ b
signum = (:^ 0) . signum . fracSignificand
fromInteger = (.^ 0) . fromInteger
instance (Fractional a, Real a, Integral b) => Fractional (SciRatio a b) where
x :^ a / (y :^ b) = x / y .^ (a b)
recip (y :^ b) = recip y .^ (b)
fromRational = (.^ 0) . fromRational
instance (Fractional a, Real a, Integral b) => Real (SciRatio a b) where
toRational (y :^ b) = toRational y * 10 ^^ b
instance (Fractional a, Real a, Integral b) => RealFrac (SciRatio a b) where
properFraction q = (\ (n, p) -> (n, fromRational p))
. properFraction $ toRational q
instance (Fractional a, Real a, Integral b) => Enum (SciRatio a b) where
succ = fromRational . succ . toRational
pred = fromRational . pred . toRational
toEnum = fromRational . toEnum
fromEnum = fromEnum . toRational
enumFrom = fmap fromRational . enumFrom . toRational
enumFromThen x = fmap fromRational
. enumFromThen (toRational x)
. toRational
enumFromTo x = fmap fromRational
. enumFromTo (toRational x)
. toRational
enumFromThenTo x y = fmap fromRational
. enumFromThenTo (toRational x) (toRational y)
. toRational
prec :: Int
prec = 7
(.^) :: (Fractional a, Real a, Integral b) =>
a
-> b
-> SciRatio a b
x .^ y = canonicalize $ x :^ y
fracSignificand :: SciRatio a b -> a
fracSignificand (x :^ _) = x
base10Exponent :: SciRatio a b -> b
base10Exponent (_ :^ x) = x
fromSciRatio :: (Real a, Integral b, Fractional c) => SciRatio a b -> c
fromSciRatio (x :^ y) = realToFrac x * 10 ^^ y
(^^!) :: (Fractional a, Real a, Integral b, Integral c) =>
SciRatio a b -> c -> SciRatio a b
(x :^ a) ^^! b = x ^^ b :^ (a * fromIntegral b)
(^!) :: (Real a, Integral b, Integral c) =>
SciRatio a b -> c -> SciRatio a b
(x :^ a) ^! b = x ^ b :^ (a * fromIntegral b)
(~~) :: (Fractional a, Integral b) => SciRatio a b -> SciRatio a b -> (a, a, b)
x :^ a ~~ y :^ b = (x * 10 ^^ (a c), y * 10 ^^ (b c), c)
where c = if abs a <= abs b then a else b
factorizeBase :: (Integral a, Integral b) =>
a
-> a
-> (a, b)
factorizeBase _ 0 = error ("Data.SciRatio.factorizeBase: " ++
"input integer must be nonzero")
factorizeBase b n | b < 2 = error ("Data.SciRatio.factorizeBase: " ++
"base must be greater than one")
| otherwise = _factorizeBase b n
_factorizeBase :: (Integral a, Integral b) => a -> a -> (a, b)
_factorizeBase b n | r /= 0 = (n, 0)
| r' /= 0 = (n'', e2 + 1)
| otherwise = (n''', e2 + 2)
where (n', r) = n `quotRem` b
(n'', e) = _factorizeBase (b * b) n'
(n''', r') = n'' `quotRem` b
e2 = e * 2
intLog :: (Integral a, Integral b) => a -> a -> (a, b)
intLog = factorizeBase
ilogBase :: (Integral a, Integral b) =>
a
-> a
-> b
ilogBase b | b < 2 = error ("Data.SciRatio.ilogBase: " ++
"base must be greater than one")
| otherwise = _ilogBase b
_ilogBase :: (Integral a, Integral b) => a -> a -> b
_ilogBase = (fst .) . ilogr
where ilogr b n | n < b = (0, n)
| n' < b = (l2, n')
| otherwise = (1 + l2, n' `div` b)
where (l, n') = ilogr (b * b) n
l2 = l * 2
canonicalize :: (Fractional a, Real a, Integral b) =>
SciRatio a b -> SciRatio a b
canonicalize (0 :^ _) = 0 :^ 0
canonicalize (r :^ e) =
let r' = toRational r in
case (_factorizeBase 10 (numerator r'), _factorizeBase 2 (denominator r')) of
((n, ne), (d, e2)) -> case _factorizeBase 5 d of
(d', e5) -> case compare e2 e5 of
EQ -> fromRational (n % d') :^ (e + ne e5)
LT -> fromRational ((n * 2 ^ (e5 e2)) % d') :^ (e + ne e5)
GT -> fromRational ((n * 5 ^ (e2 e5)) % d') :^ (e + ne e2)