ghc/lib/required/Ratio.hs

   1 -- Standard functions on rational numbers
   2
   3 module  Ratio (
   4     Ratio, Rational, (%), numerator, denominator, approxRational ) where
   5
   6 infixl 7  %
   7 --partain:infixl 7  :%
   8
   9 prec = 7
  10
  11 data  (Integral a)      => Ratio a = a :% a  deriving (Eq)
  12 type  Rational          =  Ratio Integer
  13
  14 (%)                     :: (Integral a) => a -> a -> Ratio a
  15 numerator, denominator  :: (Integral a) => Ratio a -> a
  16 approxRational          :: (RealFrac a) => a -> a -> Rational
  17
  18
  19 reduce _ 0              =  error "{Ratio.%}: zero denominator"
  20 reduce x y              =  (x `quot` d) :% (y `quot` d)
  21                            where d = gcd x y
  22
  23 x % y                   =  reduce (x * signum y) (abs y)
  24
  25 numerator (x:%y)        =  x
  26
  27 denominator (x:%y)      =  y
  28
  29
  30 instance  (Integral a)  => Ord (Ratio a)  where
  31     (x:%y) <= (x':%y')  =  x * y' <= x' * y
  32     (x:%y) <  (x':%y')  =  x * y' <  x' * y
  33
  34 instance  (Integral a)  => Num (Ratio a)  where
  35     (x:%y) + (x':%y')   =  reduce (x*y' + x'*y) (y*y')
  36     (x:%y) * (x':%y')   =  reduce (x * x') (y * y')
  37     negate (x:%y)       =  (-x) :% y
  38     abs (x:%y)          =  abs x :% y
  39     signum (x:%y)       =  signum x :% 1
  40     fromInteger x       =  fromInteger x :% 1
  41
  42 instance  (Integral a)  => Real (Ratio a)  where
  43     toRational (x:%y)   =  toInteger x :% toInteger y
  44
  45 instance  (Integral a)  => Fractional (Ratio a)  where
  46     (x:%y) / (x':%y')   =  (x*y') % (y*x')
  47     recip (x:%y)        =  if x < 0 then (-y) :% (-x) else y :% x
  48     fromRational (x:%y) =  fromInteger x :% fromInteger y
  49
  50 instance  (Integral a)  => RealFrac (Ratio a)  where
  51     properFraction (x:%y) = (fromIntegral q, r:%y)
  52                             where (q,r) = quotRem x y
  53
  54 instance  (Integral a)  => Enum (Ratio a)  where
  55     enumFrom            =  iterate ((+)1)
  56     enumFromThen n m    =  iterate ((+)(m-n)) n
  57     toEnum n            =  fromIntegral n :% 1
  58     fromEnum            =  fromInteger . truncate
  59
  60 instance  (Integral a, Read a)  => Read (Ratio a)  where
  61     readsPrec p  =  readParen (p > prec)
  62                               (\r -> [(x%y,u) | (x,s)   <- reads r,
  63                                                 ("%",t) <- lex s,
  64                                                 (y,u)   <- reads t ])
  65
  66 instance  (Integral a)  => Show (Ratio a)  where
  67     showsPrec p (x:%y)  =  showParen (p > prec)
  68                                (shows x . showString " % " . shows y)
  69
  70
  71 -- approxRational, applied to two real fractional numbers x and epsilon,
  72 -- returns the simplest rational number within epsilon of x.  A rational
  73 -- number n%d in reduced form is said to be simpler than another n'%d' if
  74 -- abs n <= abs n' && d <= d'.  Any real interval contains a unique
  75 -- simplest rational; here, for simplicity, we assume a closed rational
  76 -- interval.  If such an interval includes at least one whole number, then
  77 -- the simplest rational is the absolutely least whole number.  Otherwise,
  78 -- the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d
  79 -- and abs r' < d', and the simplest rational is q%1 + the reciprocal of
  80 -- the simplest rational between d'%r' and d%r.
  81
  82 approxRational x eps    =  simplest (x-eps) (x+eps)
  83         where simplest x y | y < x      =  simplest y x
  84                            | x == y     =  xr
  85                            | x > 0      =  simplest' n d n' d'
  86                            | y < 0      =  - simplest' (-n') d' (-n) d
  87                            | otherwise  =  0 :% 1
  88                                         where xr@(n:%d) = toRational x
  89                                               (n':%d')  = toRational y
  90
  91               simplest' n d n' d'       -- assumes 0 < n%d < n'%d'
  92                         | r == 0     =  q :% 1
  93                         | q /= q'    =  (q+1) :% 1
  94                         | otherwise  =  (q*n''+d'') :% n''
  95                                      where (q,r)      =  quotRem n d
  96                                            (q',r')    =  quotRem n' d'
  97                                            (n'':%d'') =  simplest' d' r' d r