{-# LANGUAGE RebindableSyntax #-}
module Number.Ratio
(
T((:%), numerator, denominator), (%),
Rational,
fromValue,
recip,
scale,
split,
showsPrecAuto,
toRational98,
) where
import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Units as Unit
import qualified Algebra.Absolute as Absolute
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 Foreign.Storable (Storable (..), )
import qualified Foreign.Storable.Record as Store
import Control.Applicative (liftA2, )
import Test.QuickCheck (Arbitrary(arbitrary))
import System.Random (Random(..), RandomGen, )
import qualified Data.Ratio as Ratio98
import qualified Prelude as P
import NumericPrelude.Base
infixl 7 %
data T a = (:%) {
T a -> a
numerator :: !a,
T a -> a
denominator :: !a
} deriving (T a -> T a -> Bool
(T a -> T a -> Bool) -> (T a -> T a -> Bool) -> Eq (T a)
forall a. Eq a => T a -> T a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T a -> T a -> Bool
$c/= :: forall a. Eq a => T a -> T a -> Bool
== :: T a -> T a -> Bool
$c== :: forall a. Eq a => T a -> T a -> Bool
Eq)
type Rational = T P.Integer
fromValue :: Ring.C a => a -> T a
fromValue :: a -> T a
fromValue a
x = a
x a -> a -> T a
forall a. a -> a -> T a
:% a
forall a. C a => a
one
scale :: (PID.C a) => a -> T a -> T a
scale :: a -> T a -> T a
scale a
s (a
x:%a
y) =
let
(a
n:%a
d) = a
sa -> a -> T a
forall a. C a => a -> a -> T a
%a
y
in ((a
na -> a -> a
forall a. C a => a -> a -> a
*a
x)a -> a -> T a
forall a. a -> a -> T a
:%a
d)
split :: (PID.C a) => T a -> (a, T a)
split :: T a -> (a, T a)
split (a
x:%a
y) =
let (a
q,a
r) = a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
x a
y
in (a
q, a
ra -> a -> T a
forall a. a -> a -> T a
:%a
y)
ratioPrec :: P.Int
ratioPrec :: Int
ratioPrec = Int
7
(%) :: (PID.C a) => a -> a -> T a
a
x % :: a -> a -> T a
% a
y =
if a -> Bool
forall a. C a => a -> Bool
isZero a
y
then [Char] -> T a
forall a. HasCallStack => [Char] -> a
error [Char]
"NumericPrelude.% : zero denominator"
else
let d :: a
d = a -> a -> a
forall a. C a => a -> a -> a
gcd a
x a
y
y0 :: a
y0 = a -> a -> a
forall a. C a => a -> a -> a
div a
y a
d
x0 :: a
x0 = a -> a -> a
forall a. C a => a -> a -> a
div a
x a
d
in (a -> a
forall a. C a => a -> a
stdUnitInv a
y0 a -> a -> a
forall a. C a => a -> a -> a
* a
x0) a -> a -> T a
forall a. a -> a -> T a
:% a -> a
forall a. C a => a -> a
stdAssociate a
y0
instance (PID.C a) => Additive.C (T a) where
zero :: T a
zero = a -> T a
forall a. C a => a -> T a
fromValue a
forall a. C a => a
zero
(a
x:%a
y) + :: T a -> T a -> T a
+ (a
x':%a
y') =
let d :: a
d = a -> a -> a
forall a. C a => a -> a -> a
gcd a
y a
y'
y0 :: a
y0 = a -> a -> a
forall a. C a => a -> a -> a
div a
y a
d
y0' :: a
y0' = a -> a -> a
forall a. C a => a -> a -> a
div a
y' a
d
in (a
xa -> a -> a
forall a. C a => a -> a -> a
*a
y0' a -> a -> a
forall a. C a => a -> a -> a
+ a
x'a -> a -> a
forall a. C a => a -> a -> a
*a
y0) a -> a -> T a
forall a. C a => a -> a -> T a
% (a
y0a -> a -> a
forall a. C a => a -> a -> a
*a
y')
negate :: T a -> T a
negate (a
x:%a
y) = (-a
x) a -> a -> T a
forall a. a -> a -> T a
:% a
y
instance (PID.C a) => Ring.C (T a) where
one :: T a
one = a -> T a
forall a. C a => a -> T a
fromValue a
forall a. C a => a
one
fromInteger :: Integer -> T a
fromInteger Integer
x = a -> T a
forall a. C a => a -> T a
fromValue (a -> T a) -> a -> T a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. C a => Integer -> a
fromInteger Integer
x
(a
x:%a
y) * :: T a -> T a -> T a
* (a
x':%a
y') = (a
x a -> a -> a
forall a. C a => a -> a -> a
* a
x') a -> a -> T a
forall a. C a => a -> a -> T a
% (a
y a -> a -> a
forall a. C a => a -> a -> a
* a
y')
(a
x:%a
y) ^ :: T a -> Integer -> T a
^ Integer
n = (a
x a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Integer
n) a -> a -> T a
forall a. a -> a -> T a
:% (a
y a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Integer
n)
instance (Absolute.C a, PID.C a) => Absolute.C (T a) where
abs :: T a -> T a
abs (a
x:%a
y) = a -> a
forall a. C a => a -> a
Absolute.abs a
x a -> a -> T a
forall a. a -> a -> T a
:% a
y
signum :: T a -> T a
signum (a
x:%a
_) = a -> a
forall a. C a => a -> a
Absolute.signum a
x a -> a -> T a
forall a. a -> a -> T a
:% a
forall a. C a => a
one
recip :: (ZeroTestable.C a, Unit.C a) => T a -> T a
recip :: T a -> T a
recip (a
x:%a
y) =
if a -> Bool
forall a. C a => a -> Bool
isZero a
y
then [Char] -> T a
forall a. HasCallStack => [Char] -> a
error [Char]
"Ratio.recip: division by zero"
else (a
y a -> a -> a
forall a. C a => a -> a -> a
* a -> a
forall a. C a => a -> a
stdUnitInv a
x) a -> a -> T a
forall a. a -> a -> T a
:% a -> a
forall a. C a => a -> a
stdAssociate a
x
liftOrd :: Ring.C a => (a -> a -> b) -> (T a -> T a -> b)
liftOrd :: (a -> a -> b) -> T a -> T a -> b
liftOrd a -> a -> b
f (a
x:%a
y) (a
x':%a
y') = a -> a -> b
f (a
x a -> a -> a
forall a. C a => a -> a -> a
* a
y') (a
x' a -> a -> a
forall a. C a => a -> a -> a
* a
y)
instance (Ord a, PID.C a) => Ord (T a) where
<= :: T a -> T a -> Bool
(<=) = (a -> a -> Bool) -> T a -> T a -> Bool
forall a b. C a => (a -> a -> b) -> T a -> T a -> b
liftOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
< :: T a -> T a -> Bool
(<) = (a -> a -> Bool) -> T a -> T a -> Bool
forall a b. C a => (a -> a -> b) -> T a -> T a -> b
liftOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
>= :: T a -> T a -> Bool
(>=) = (a -> a -> Bool) -> T a -> T a -> Bool
forall a b. C a => (a -> a -> b) -> T a -> T a -> b
liftOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
> :: T a -> T a -> Bool
(>) = (a -> a -> Bool) -> T a -> T a -> Bool
forall a b. C a => (a -> a -> b) -> T a -> T a -> b
liftOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
compare :: T a -> T a -> Ordering
compare = (a -> a -> Ordering) -> T a -> T a -> Ordering
forall a b. C a => (a -> a -> b) -> T a -> T a -> b
liftOrd a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, PID.C a) => Indexable.C (T a) where
compare :: T a -> T a -> Ordering
compare = T a -> T a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (ZeroTestable.C a, PID.C a) => ZeroTestable.C (T a) where
isZero :: T a -> Bool
isZero = a -> Bool
forall a. C a => a -> Bool
isZero (a -> Bool) -> (T a -> a) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
numerator
instance (Read a, PID.C a) => Read (T a) where
readsPrec :: Int -> ReadS (T a)
readsPrec Int
p =
Bool -> ReadS (T a) -> ReadS (T a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ratioPrec)
(\[Char]
r -> [(a
xa -> a -> T a
forall a. C a => a -> a -> T a
%a
y,[Char]
u) | (a
x,[Char]
s) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec Int
ratioPrec [Char]
r,
([Char]
"%",[Char]
t) <- ReadS [Char]
lex [Char]
s,
(a
y,[Char]
u) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec Int
ratioPrec [Char]
t ])
instance (Show a, PID.C a) => Show (T a) where
showsPrec :: Int -> T a -> ShowS
showsPrec Int
p (a
x:%a
y) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ratioPrec)
(a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" % " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
y)
showsPrecAuto :: (Eq a, PID.C a, Show a) =>
P.Int -> T a -> String -> String
showsPrecAuto :: Int -> T a -> ShowS
showsPrecAuto Int
p (a
x:%a
y) =
if a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1
then Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
x
else Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ratioPrec)
(Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
ratioPrecInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"/" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
ratioPrecInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) a
y)
instance (Arbitrary a, PID.C a, ZeroTestable.C a) => Arbitrary (T a) where
arbitrary :: Gen (T a)
arbitrary =
(a -> a -> T a) -> Gen a -> Gen a -> Gen (T a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> T a
forall a. C a => a -> a -> T a
(%) Gen a
forall a. Arbitrary a => Gen a
arbitrary
((a -> a) -> Gen a -> Gen a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
x -> if a -> Bool
forall a. C a => a -> Bool
isZero a
x then a
forall a. C a => a
one else a
x) Gen a
forall a. Arbitrary a => Gen a
arbitrary)
instance (Storable a, PID.C a) => Storable (T a) where
sizeOf :: T a -> Int
sizeOf = Dictionary (T a) -> T a -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary (T a)
forall a. (Storable a, C a) => Dictionary (T a)
store
alignment :: T a -> Int
alignment = Dictionary (T a) -> T a -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary (T a)
forall a. (Storable a, C a) => Dictionary (T a)
store
peek :: Ptr (T a) -> IO (T a)
peek = Dictionary (T a) -> Ptr (T a) -> IO (T a)
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary (T a)
forall a. (Storable a, C a) => Dictionary (T a)
store
poke :: Ptr (T a) -> T a -> IO ()
poke = Dictionary (T a) -> Ptr (T a) -> T a -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary (T a)
forall a. (Storable a, C a) => Dictionary (T a)
store
store ::
(Storable a, PID.C a) =>
Store.Dictionary (T a)
store :: Dictionary (T a)
store =
Access (T a) (T a) -> Dictionary (T a)
forall r. Access r r -> Dictionary r
Store.run (Access (T a) (T a) -> Dictionary (T a))
-> Access (T a) (T a) -> Dictionary (T a)
forall a b. (a -> b) -> a -> b
$
(a -> a -> T a)
-> Access (T a) a -> Access (T a) a -> Access (T a) (T a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> T a
forall a. C a => a -> a -> T a
(%)
((T a -> a) -> Access (T a) a
forall a r. Storable a => (r -> a) -> Access r a
Store.element T a -> a
forall a. T a -> a
numerator)
((T a -> a) -> Access (T a) a
forall a r. Storable a => (r -> a) -> Access r a
Store.element T a -> a
forall a. T a -> a
denominator)
instance (Random a, PID.C a, ZeroTestable.C a) => Random (T a) where
random :: g -> (T a, g)
random g
g0 =
let (a
numer, g
g1) = g -> (a, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random g
g0
(a
denom, g
g2) = g -> (a, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random g
g1
in (a
numer a -> a -> T a
forall a. C a => a -> a -> T a
% if a -> Bool
forall a. C a => a -> Bool
isZero a
denom then a
forall a. C a => a
one else a
denom, g
g2)
randomR :: (T a, T a) -> g -> (T a, g)
randomR (T a
lower,T a
upper) g
g0 =
let (T a
k, g
g1) = g -> (T a, g)
forall a g. (Random a, C a, RandomGen g) => g -> (T a, g)
randomR01 g
g0
in (T a
lower T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a
kT a -> T a -> T a
forall a. C a => a -> a -> a
*(T a
upperT a -> T a -> T a
forall a. C a => a -> a -> a
-T a
lower), g
g1)
randomR01 ::
(Random a, PID.C a, RandomGen g) =>
g -> (T a, g)
randomR01 :: g -> (T a, g)
randomR01 g
g0 =
let (a
denom0, g
g1) = g -> (a, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random g
g0
denom :: a
denom = if a -> Bool
forall a. C a => a -> Bool
isZero a
denom0 then a
forall a. C a => a
one else a
denom0
(a
numer, g
g2) = (a, a) -> g -> (a, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a
forall a. C a => a
zero,a
denom) g
g1
in (a
numer a -> a -> T a
forall a. C a => a -> a -> T a
% a
denom, g
g2)
toRational98 :: (P.Integral a) => T a -> Ratio98.Ratio a
toRational98 :: T a -> Ratio a
toRational98 T a
x = T a -> a
forall a. T a -> a
numerator T a
x a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
Ratio98.% T a -> a
forall a. T a -> a
denominator T a
x
fromRational98 :: (P.Integral a) => Ratio98.Ratio a -> T a
fromRational98 :: Ratio a -> T a
fromRational98 Ratio a
x = Ratio a -> a
forall a. Ratio a -> a
Ratio98.numerator Ratio a
x a -> a -> T a
forall a. a -> a -> T a
:% Ratio a -> a
forall a. Ratio a -> a
Ratio98.denominator Ratio a
x
{-# INLINE lift1 #-}
lift1 ::
(P.Integral a, P.Integral b) =>
(Ratio98.Ratio a -> Ratio98.Ratio b) -> T a -> T b
lift1 :: (Ratio a -> Ratio b) -> T a -> T b
lift1 Ratio a -> Ratio b
f T a
a = Ratio b -> T b
forall a. Integral a => Ratio a -> T a
fromRational98 (Ratio a -> Ratio b
f (T a -> Ratio a
forall a. Integral a => T a -> Ratio a
toRational98 T a
a))
{-# INLINE lift2 #-}
lift2 ::
(P.Integral a, P.Integral b, P.Integral c) =>
(Ratio98.Ratio a -> Ratio98.Ratio b -> Ratio98.Ratio c) -> T a -> T b -> T c
lift2 :: (Ratio a -> Ratio b -> Ratio c) -> T a -> T b -> T c
lift2 Ratio a -> Ratio b -> Ratio c
f T a
a T b
b = Ratio c -> T c
forall a. Integral a => Ratio a -> T a
fromRational98 (Ratio a -> Ratio b -> Ratio c
f (T a -> Ratio a
forall a. Integral a => T a -> Ratio a
toRational98 T a
a) (T b -> Ratio b
forall a. Integral a => T a -> Ratio a
toRational98 T b
b))
instance (P.Integral a) => P.Num (T a) where
fromInteger :: Integer -> T a
fromInteger Integer
n = Integer -> a
forall a. Num a => Integer -> a
P.fromInteger Integer
n a -> a -> T a
forall a. a -> a -> T a
:% Integer -> a
forall a. Num a => Integer -> a
P.fromInteger Integer
1
negate :: T a -> T a
negate = (Ratio a -> Ratio a) -> T a -> T a
forall a b.
(Integral a, Integral b) =>
(Ratio a -> Ratio b) -> T a -> T b
lift1 Ratio a -> Ratio a
forall a. Num a => a -> a
P.negate
+ :: T a -> T a -> T a
(+) = (Ratio a -> Ratio a -> Ratio a) -> T a -> T a -> T a
forall a b c.
(Integral a, Integral b, Integral c) =>
(Ratio a -> Ratio b -> Ratio c) -> T a -> T b -> T c
lift2 Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
(P.+)
* :: T a -> T a -> T a
(*) = (Ratio a -> Ratio a -> Ratio a) -> T a -> T a -> T a
forall a b c.
(Integral a, Integral b, Integral c) =>
(Ratio a -> Ratio b -> Ratio c) -> T a -> T b -> T c
lift2 Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
(P.*)
abs :: T a -> T a
abs = (Ratio a -> Ratio a) -> T a -> T a
forall a b.
(Integral a, Integral b) =>
(Ratio a -> Ratio b) -> T a -> T b
lift1 Ratio a -> Ratio a
forall a. Num a => a -> a
P.abs
signum :: T a -> T a
signum = (Ratio a -> Ratio a) -> T a -> T a
forall a b.
(Integral a, Integral b) =>
(Ratio a -> Ratio b) -> T a -> T b
lift1 Ratio a -> Ratio a
forall a. Num a => a -> a
P.signum
instance (P.Integral a) => P.Fractional (T a) where
fromRational :: Rational -> T a
fromRational Rational
x =
Integer -> a
forall a. Num a => Integer -> a
P.fromInteger (Rational -> Integer
forall a. Ratio a -> a
Ratio98.numerator Rational
x) a -> a -> T a
forall a. a -> a -> T a
:%
Integer -> a
forall a. Num a => Integer -> a
P.fromInteger (Rational -> Integer
forall a. Ratio a -> a
Ratio98.denominator Rational
x)
/ :: T a -> T a -> T a
(/) = (Ratio a -> Ratio a -> Ratio a) -> T a -> T a -> T a
forall a b c.
(Integral a, Integral b, Integral c) =>
(Ratio a -> Ratio b -> Ratio c) -> T a -> T b -> T c
lift2 Ratio a -> Ratio a -> Ratio a
forall a. Fractional a => a -> a -> a
(P./)
recip :: T a -> T a
recip = (Ratio a -> Ratio a) -> T a -> T a
forall a b.
(Integral a, Integral b) =>
(Ratio a -> Ratio b) -> T a -> T b
lift1 Ratio a -> Ratio a
forall a. Fractional a => a -> a
P.recip