```{-# LANGUAGE NoImplicitPrelude #-}
{- |
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.Absolute                 as Absolute
import qualified Algebra.Ring                 as Ring
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 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  {- (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.RealRing.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 (Absolute.C a, PID.C a) => Absolute.C (T a) where
abs (x:%y)          =  Absolute.abs x :% y
signum (x:%_)       =  Absolute.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

(\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)

*Main> Test.QuickCheck.test (\x -> x==(x::Rational))
Interrupted.
-}
arbitrary =
liftM2 (%) arbitrary
(liftM (\x -> if isZero x then one else x) arbitrary)

instance (Storable a, PID.C a) => Storable (T a) where
sizeOf    = Store.sizeOf store
alignment = Store.alignment store
peek      = Store.peek store
poke      = Store.poke store

store ::
(Storable a, PID.C a) =>
Store.Dictionary (T a)
store =
Store.run \$
liftA2 (%)
(Store.element numerator)
(Store.element denominator)

{-
This instance may not be appropriate for mathematical objects other than numbers.
If we encounter such a type of object
we should define an intermediate class
which provides the necessary functions.
I should remark that methods of Random like 'randomR'
cannot sensibly be defined for ratios of polynomials.
-}
instance (Random a, PID.C a, ZeroTestable.C a) => Random (T a) where
random g0 =
let (numer, g1) = random g0
(denom, g2) = random g1
in  (numer % if isZero denom then one else denom, g2)
randomR (lower,upper) g0 =
let (k, g1) = randomR01 g0
in  (lower + k*(upper-lower), g1)

randomR01 ::
(Random a, PID.C a, RandomGen g) =>
g -> (T a, g)
randomR01 g0 =
let (denom0, g1) = random g0
denom = if isZero denom0 then one else denom0
(numer, g2) = randomR (zero,denom) g1
in  (numer % denom, g2)

-- * Legacy Instances

-- | Necessary when mixing NumericPrelude.Numeric Rationals with Prelude98 Rationals

toRational98 :: (P.Integral a, PID.C a) => T a -> Ratio98.Ratio a
toRational98 x = numerator x Ratio98.% denominator x

legacyInstance :: String -> a
legacyInstance op =
error ("Ratio." ++ op ++ ": legacy Ring instance for simple input of numeric literals")

-- instance (P.Num a, PID.C a) => P.Num (T a) where
instance (P.Num a, PID.C a, Absolute.C a) => P.Num (T a) where
fromInteger n = P.fromInteger n % 1
negate = negate -- for unary minus
(+)    = legacyInstance "(+)"
(*)    = legacyInstance "(*)"
abs    = Absolute.abs -- needed for Arbitrary instance of NonNegative.Ratio
signum = legacyInstance "signum"

-- instance (P.Num a, PID.C a) => P.Fractional (T a) where
instance (P.Num a, PID.C a, Absolute.C a) => P.Fractional (T a) where
--   fromRational = Field.fromRational
fromRational x =
fromInteger (Ratio98.numerator x) :%
fromInteger (Ratio98.denominator x)
(/) = legacyInstance "(/)"
```