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