module Number.Ratio
(
T((:%), numerator, denominator), (%),
Rational,
fromValue,
scale,
split,
showsPrecAuto,
toRational98,
) where
import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Units as Units
import qualified Algebra.Real as Real
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.ZeroTestable as ZeroTestable
import qualified Algebra.Indexable as Indexable
import Algebra.PrincipalIdealDomain (gcd)
import Algebra.Units (stdUnitInv, stdAssociate)
import Algebra.IntegralDomain (div, divMod)
import Algebra.Ring (one, (*), fromInteger)
import Algebra.Additive (zero, (+), negate)
import Algebra.ZeroTestable (isZero)
import Control.Monad(liftM, liftM2)
import Test.QuickCheck (Arbitrary(arbitrary,coarbitrary))
import qualified Data.Ratio as Ratio98
import qualified Prelude as P
import PreludeBase
infixl 7 %
data T a = (:%) {
numerator :: !a,
denominator :: !a
} deriving (Eq)
type Rational = T P.Integer
fromValue :: Ring.C a => a -> T a
fromValue x = x :% one
scale :: (PID.C a) => a -> T a -> T a
scale s (x:%y) =
let
(n:%d) = s%y
in ((n*x):%d)
split :: (PID.C a) => T a -> (a, T a)
split (x:%y) =
let (q,r) = divMod x y
in (q, r:%y)
ratioPrec :: P.Int
ratioPrec = 7
(%) :: (PID.C a) => a -> a -> T a
x % y =
if isZero y
then error "NumericPrelude.% : zero denominator"
else
let d = gcd x y
y0 = div y d
x0 = div x d
in (stdUnitInv y0 * x0) :% stdAssociate y0
instance (PID.C a) => Additive.C (T a) where
zero = fromValue zero
(x:%y) + (x':%y') = (x*y' + x'*y) % (y*y')
negate (x:%y) = (x) :% y
instance (PID.C a) => Ring.C (T a) where
one = fromValue one
fromInteger x = fromValue $ fromInteger x
(x:%y) * (x':%y') = (x * x') % (y * y')
instance (Real.C a, PID.C a) => Real.C (T a) where
abs (x:%y) = Real.abs x :% y
signum (x:%_) = Real.signum x :% one
liftOrd :: Ring.C a => (a -> a -> b) -> (T a -> T a -> b)
liftOrd f (x:%y) (x':%y') = f (x * y') (x' * y)
instance (Ord a, PID.C a) => Ord (T a) where
(<=) = liftOrd (<=)
(<) = liftOrd (<)
(>=) = liftOrd (>=)
(>) = liftOrd (>)
compare = liftOrd compare
instance (Ord a, PID.C a) => Indexable.C (T a) where
compare = compare
instance (ZeroTestable.C a, PID.C a) => ZeroTestable.C (T a) where
isZero = isZero . numerator
instance (Read a, PID.C a) => Read (T a) where
readsPrec p =
readParen (p >= ratioPrec)
(\r -> [(x%y,u) | (x,s) <- readsPrec ratioPrec r,
("%",t) <- lex s,
(y,u) <- readsPrec ratioPrec t ])
instance (Show a, PID.C a) => Show (T a) where
showsPrec p (x:%y) = showParen (p >= ratioPrec)
(shows x . showString " % " . shows y)
showsPrecAuto :: (Eq a, PID.C a, Show a) =>
P.Int -> T a -> String -> String
showsPrecAuto p (x:%y) =
if y == 1
then showsPrec p x
else showParen (p > ratioPrec)
(showsPrec (ratioPrec+1) x . showString "/" .
showsPrec (ratioPrec+1) y)
instance (Arbitrary a, PID.C a, ZeroTestable.C a) => Arbitrary (T a) where
arbitrary =
liftM2 (%) arbitrary
(liftM (\x -> if isZero x then one else x) arbitrary)
coarbitrary = undefined
toRational98 :: (P.Integral a, PID.C a) => T a -> Ratio98.Ratio a
toRational98 x = numerator x Ratio98.% denominator x
legacyInstance :: a
legacyInstance = error "legacy Ring instance for simple input of numeric literals"
instance (P.Num a, PID.C a) => P.Num (T a) where
fromInteger n = P.fromInteger n % 1
negate = negate
(+) = legacyInstance
(*) = legacyInstance
abs = legacyInstance
signum = legacyInstance
instance (P.Num a, PID.C a) => P.Fractional (T a) where
fromRational x =
fromInteger (Ratio98.numerator x) :%
fromInteger (Ratio98.denominator x)
(/) = legacyInstance