ghc/interpreter/library/Ratio.hs

   1 -- Standard functions on rational numbers
   2
   3 #ifdef HEAD
   4 module  Ratio (
   5     Ratio, Rational, (%), numerator, denominator, approxRational ) where
   6
   7 #if STD_PRELUDE
   8 infixl 7  %
   9 #endif
  10
  11 import PreludeBuiltin
  12 #endif /* HEAD */
  13 #ifdef BODY
  14
  15 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
  16 type  Rational          =  Ratio BIGNUMTYPE
  17
  18 (%)                     :: (Integral a) => a -> a -> Ratio a
  19 numerator, denominator  :: (Integral a) => Ratio a -> a
  20 approxRational          :: (RealFrac a) => a -> a -> Rational
  21
  22
  23 -- "reduce" is a subsidiary function used only in this module.
  24 -- It normalises a ratio by dividing both numerator
  25 -- and denominator by their greatest common divisor.
  26 --
  27 -- E.g., 12 `reduce` 8    ==  3 :%   2
  28 --       12 `reduce` (-8) ==  3 :% (-2)
  29
  30 reduce _ 0              =  error "Ratio.% : zero denominator"
  31 reduce x y              =  (x `quot` d) :% (y `quot` d)
  32                            where d = gcd x y
  33
  34 x % y                   =  reduce (x * signum y) (abs y)
  35
  36 numerator   (x :% _)    =  x
  37
  38 denominator (_ :% y)    =  y
  39
  40
  41 instance  (Integral a)  => Ord (Ratio a)  where
  42     (x:%y) <= (x':%y')  =  x * y' <= x' * y
  43     (x:%y) <  (x':%y')  =  x * y' <  x' * y
  44
  45 instance  (Integral a)  => Num (Ratio a)  where
  46     (x:%y) + (x':%y')   =  reduce (x*y' + x'*y) (y*y')
  47     (x:%y) * (x':%y')   =  reduce (x * x') (y * y')
  48     negate (x:%y)       =  (-x) :% y
  49     abs (x:%y)          =  abs x :% y
  50     signum (x:%y)       =  signum x :% 1
  51     fromInteger x       =  fromInteger x :% 1
  52
  53 instance  (Integral a)  => Real (Ratio a)  where
  54     toRational (x:%y)   =  toInteger x :% toInteger y
  55
  56 instance  (Integral a)  => Fractional (Ratio a)  where
  57     (x:%y) / (x':%y')   =  (x*y') % (y*x')
  58     recip (x:%y)        =  if x < 0 then (-y) :% (-x) else y :% x
  59     fromRational (x:%y) =  fromInteger x :% fromInteger y
  60
  61 instance  (Integral a)  => RealFrac (Ratio a)  where
  62     properFraction (x:%y) = (fromIntegral q, r:%y)
  63                             where (q,r) = quotRem x y
  64
  65 instance  (Integral a)  => Enum (Ratio a)  where
  66     enumFrom            =  numericEnumFrom
  67     enumFromThen        =  numericEnumFromThen
  68     enumFromTo          =  numericEnumFromTo
  69     enumFromThenTo      =  numericEnumFromThenTo
  70     toEnum              =  fromInteger . toInteger
  71     fromEnum n          =  error "Ratio.fromEnum: can't use\
  72                                   \ fromEnum with Ratio"
  73
  74 instance  (Read a, Integral a)  => Read (Ratio a)  where
  75     readsPrec p  =  readParen (p > 7)
  76                               (\r -> [(x%y,u) | (x,s)   <- reads r,
  77                                                 ("%",t) <- lex s,
  78                                                 (y,u)   <- reads t ])
  79
  80 instance  (Integral a)  => Show (Ratio a)  where
  81     showsPrec p (x:%y)  =  showParen (p > 7)
  82                                (shows x . showString " % " . shows y)
  83
  84
  85
  86 approxRational x eps    =  simplest (x-eps) (x+eps)
  87         where simplest x y | y < x      =  simplest y x
  88                            | x == y     =  xr
  89                            | x > 0      =  simplest' n d n' d'
  90                            | y < 0      =  - simplest' (-n') d' (-n) d
  91                            | otherwise  =  0 :% 1
  92                                         where xr@(n:%d) = toRational x
  93                                               (n':%d')  = toRational y
  94
  95               simplest' n d n' d'       -- assumes 0 < n%d < n'%d'
  96                         | r == 0     =  q :% 1
  97                         | q /= q'    =  (q+1) :% 1
  98                         | otherwise  =  (q*n''+d'') :% n''
  99                                      where (q,r)      =  quotRem n d
 100                                            (q',r')    =  quotRem n' d'
 101                                            (n'':%d'') =  simplest' d' r' d r
 102
 103 #endif /* BODY */