{-# OPTIONS -fno-implicit-prelude #-}
{- |
Module : Number.Ratio
Copyright : (c) Henning Thielemann, Dylan Thurston 2006
Maintainer : numericprelude@henning-thielemann.de
Stability : provisional
Portability : portable (?)
Ratios of mathematical objects.
-}
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 NumericPrelude.Monad(untilM)
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 {- (PID.C a) => -} 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 {- x and y are cancelled,
thus we can only have common divisors in s and y -}
(n:%d) = s%y
in ((n*x):%d)
{- | similar to 'Algebra.RealField.splitFraction' -}
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)
{- |
This is an alternative show method
that is more user-friendly but also potentially more ambigious.
-}
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 (untilM (not . isZero) arbitrary)
This implementation leads to blocking:
*Main> Test.QuickCheck.test (\x -> x==(x::Rational))
Interrupted.
-}
arbitrary =
liftM2 (%) arbitrary
(liftM (\x -> if isZero x then one else x) arbitrary)
coarbitrary = undefined
-- * Legacy Instances
-- | Necessary when mixing NumericPrelude Rationals with Prelude98 Rationals
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 -- for unary minus
(+) = legacyInstance
(*) = legacyInstance
abs = legacyInstance
signum = legacyInstance
instance (P.Num a, PID.C a) => P.Fractional (T a) where
-- fromRational = Field.fromRational
fromRational x =
fromInteger (Ratio98.numerator x) :%
fromInteger (Ratio98.denominator x)
(/) = legacyInstance