ghc/lib/prelude/IRatio.hs

   1 --*** All of PreludeRatio, except the actual data/type decls.
   2 --*** data Ratio ... is builtin (no need to import TyRatio)
   3
   4 module PreludeRatio where
   5
   6 import Cls
   7 import Core
   8 import IChar
   9 import IDouble
  10 import IFloat
  11 import IInt
  12 import IInteger
  13 import IList
  14 import List             ( iterate, (++), foldr, takeWhile )
  15 import Prel             ( (&&), (||), (.), otherwise, gcd, fromIntegral, id )
  16 import PS               ( _PackedString, _unpackPS )
  17 import Text
  18
  19 --infixl 7  %, :%
  20
  21 prec = (7 :: Int)
  22
  23 {-# GENERATE_SPECS (%) a{Integer} #-}
  24 (%)             :: (Integral a) => a -> a -> Ratio a
  25
  26 numerator :: Ratio a -> a
  27 numerator (x:%y)        =  x
  28
  29 denominator :: Ratio a -> a
  30 denominator (x:%y)      =  y
  31
  32
  33 x % y                   =  reduce (x * signum y) (abs y)
  34
  35 reduce _ 0              =  error "(%){PreludeRatio}: zero denominator\n"
  36 reduce x y              =  (x `quot` d) :% (y `quot` d)
  37                            where d = gcd x y
  38
  39 instance (Integral a) => Eq (Ratio a) where
  40     {- works because Ratios held in reduced form -}
  41     (x :% y) == (x2 :% y2)  =  x == x2 && y == y2
  42     (x :% y) /= (x2 :% y2)  =  x /= x2 || y /= y2
  43
  44 instance (Integral a) => Ord (Ratio a) where
  45     (x1:%y1) <= (x2:%y2) =  x1 * y2 <= x2 * y1
  46     (x1:%y1) <  (x2:%y2) =  x1 * y2 <  x2 * y1
  47     (x1:%y1) >= (x2:%y2) =  x1 * y2 >= x2 * y1
  48     (x1:%y1) >  (x2:%y2) =  x1 * y2 >  x2 * y1
  49     min x y | x <= y    = x
  50     min x y | otherwise = y
  51     max x y | x >= y    = x
  52     max x y | otherwise = y
  53     _tagCmp (x1:%y1) (x2:%y2)
  54       = if x1y2 == x2y1 then _EQ else if x1y2 < x2y1 then _LT else _GT
  55       where x1y2 = x1 * y2
  56             x2y1 = x2 * y1
  57
  58 instance (Integral a) => Num (Ratio a) where
  59     (x1:%y1) + (x2:%y2) =  reduce (x1*y2 + x2*y1) (y1*y2)
  60     (x1:%y1) - (x2:%y2) =  reduce (x1*y2 - x2*y1) (y1*y2)
  61     (x1:%y1) * (x2:%y2) =  reduce (x1 * x2) (y1 * y2)
  62     negate (x:%y)       =  (-x) :% y
  63     abs (x:%y)          =  abs x :% y
  64     signum (x:%y)       =  signum x :% 1
  65     fromInteger x       =  fromInteger x :% 1
  66     fromInt x           =  fromInt x :% 1
  67
  68 instance (Integral a) => Real (Ratio a) where
  69     toRational (x:%y)   =  toInteger x :% toInteger y
  70
  71 instance (Integral a) => Fractional (Ratio a) where
  72     (x1:%y1) / (x2:%y2) =  (x1*y2) % (y1*x2)
  73     recip (x:%y)        =  if x < 0 then (-y) :% (-x) else y :% x
  74     fromRational (x:%y) =  fromInteger x :% fromInteger y
  75
  76 instance (Integral a) => RealFrac (Ratio a) where
  77     properFraction (x:%y) = (fromIntegral q, r:%y)
  78                             where (q,r) = quotRem x y
  79
  80     -- just call the versions in Core.hs
  81     truncate x  =  _truncate x
  82     round x     =  _round x
  83     ceiling x   =  _ceiling x
  84     floor x     =  _floor x
  85
  86 instance (Integral a) => Enum (Ratio a) where
  87     enumFrom             = iterate ((+)1)
  88     enumFromThen n m     = iterate ((+)(m-n)) n
  89     enumFromTo n m       = takeWhile (<= m) (enumFrom n)
  90     enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
  91                                      (enumFromThen n m)
  92
  93 instance  (Integral a) => Text (Ratio a)  where
  94     readsPrec p  =  readParen (p > prec)
  95                               (\r -> [(x%y,u) | (x,s)   <- reads r,
  96                                                 ("%",t) <- lex s,
  97                                                 (y,u)   <- reads t ])
  98
  99     showsPrec p (x:%y)  =  showParen (p > prec)
 100                                (shows x . showString " % " . shows y)
 101
 102 {-# SPECIALIZE instance Eq          (Ratio Integer) #-}
 103 {-# SPECIALIZE instance Ord         (Ratio Integer) #-}
 104 {-# SPECIALIZE instance Num         (Ratio Integer) #-}
 105 {-# SPECIALIZE instance Real        (Ratio Integer) #-}
 106 {-# SPECIALIZE instance Fractional  (Ratio Integer) #-}
 107 {-# SPECIALIZE instance RealFrac    (Ratio Integer) #-}
 108 {-# SPECIALIZE instance Enum        (Ratio Integer) #-}
 109 {-# SPECIALIZE instance Text        (Ratio Integer) #-}
 110
 111 {- ToDo: Ratio Int# ???
 112 #if defined(__UNBOXED_INSTANCES__)
 113
 114 {-# SPECIALIZE instance Eq          (Ratio Int#) #-}
 115 {-# SPECIALIZE instance Ord         (Ratio Int#) #-}
 116 {-# SPECIALIZE instance Num         (Ratio Int#) #-}
 117 {-# SPECIALIZE instance Real        (Ratio Int#) #-}
 118 {-# SPECIALIZE instance Fractional  (Ratio Int#) #-}
 119 {-# SPECIALIZE instance RealFrac    (Ratio Int#) #-}
 120 {-# SPECIALIZE instance Enum        (Ratio Int#) #-}
 121 {-# SPECIALIZE instance Text        (Ratio Int#) #-}
 122
 123 #endif
 124 -}
 125
 126 -- approxRational, applied to two real fractional numbers x and epsilon,
 127 -- returns the simplest rational number within epsilon of x.  A rational
 128 -- number n%d in reduced form is said to be simpler than another n'%d' if
 129 -- abs n <= abs n' && d <= d'.  Any real interval contains a unique
 130 -- simplest rational; here, for simplicity, we assume a closed rational
 131 -- interval.  If such an interval includes at least one whole number, then
 132 -- the simplest rational is the absolutely least whole number.  Otherwise,
 133 -- the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d
 134 -- and abs r' < d', and the simplest rational is q%1 + the reciprocal of
 135 -- the simplest rational between d'%r' and d%r.
 136
 137 --{-# GENERATE_SPECS approxRational a{Double#,Double} #-}
 138 {-# GENERATE_SPECS approxRational a{Double} #-}
 139 approxRational  :: (RealFrac a) => a -> a -> Rational
 140
 141 approxRational x eps    =  simplest (x-eps) (x+eps)
 142         where simplest x y | y < x      =  simplest y x
 143                            | x == y     =  xr
 144                            | x > 0      =  simplest' n d n' d'
 145                            | y < 0      =  - simplest' (-n') d' (-n) d
 146                            | otherwise  =  0 :% 1
 147                                         where xr@(n:%d) = toRational x
 148                                               (n':%d')  = toRational y
 149
 150               simplest' n d n' d'       -- assumes 0 < n%d < n'%d'
 151                         | r == 0     =  q :% 1
 152                         | q /= q'    =  (q+1) :% 1
 153                         | otherwise  =  (q*n''+d'') :% n''
 154                                      where (q,r)      =  quotRem n d
 155                                            (q',r')    =  quotRem n' d'
 156                                            (n'':%d'') =  simplest' d' r' d r