{-# 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