1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 module QRationals 17 (QRational, (%%), qNumerator, qDenominator, 18 qInfinite, qUndefined, qRound, qFinite) where 19 import Ratio 20 infixl 7 %% , :%% 21 prec = 7::Int 22 23 data QRational = Integer :%% Integer deriving (Eq) 24 25 qReduce, (%%) :: Integer -> Integer -> QRational 26 qNumerator, qDenominator :: QRational -> Integer 27 28 29 30 31 qReduce x 0 = signum x :%% 0 32 qReduce x y = (signum x * (abs x `div` d)) :%% (y `div` d) 33 where d = gcd x y 34 35 x %% 0 = signum x :%% 0 36 x %% y = qReduce (x * signum y) (abs y) 37 38 qNumerator (x:%%y) = x 39 40 qDenominator (x:%%y) = y 41 42 instance Ord QRational where 43 (x:%%y) <= (x':%%y') = x * y' <= x' * y 44 (x:%%y) < (x':%%y') = x * y' < x' * y 45 46 instance Num QRational where 47 (x:%%y) + (x':%%y') = qReduce (x*y' + x'*y) (y*y') 48 (x:%%y) - (x':%%y') = qReduce (x*y' - x'*y) (y*y') 49 (x:%%y) * (x':%%y') = qReduce (x * x') (y * y') 50 negate (x:%% y) = (-x) :%% y 51 abs (x:%% y) = abs x :%% y 52 signum (x:%% y) = signum x :%% 1 53 fromInteger x = fromInteger x :%% 1 54 55 instance Real QRational where 56 toRational (x:%%y) = x%y 57 58 instance Fractional QRational where 59 (x:%%y) / (x':%%y') = (x*y') %% (y*x') 60 recip (x:%%y) = if x < 0 then (-y):%% (-x) else y:%%x 61 fromRational x = numerator x :%% denominator x 62 63 instance Enum QRational where 64 enumFrom x = enumFromBy x 1 65 enumFromThen x y = enumFromBy x (y - x) 66 67 enumFromBy n k = n : enumFromBy (n+k) k 68 69 instance Read QRational where 70 readsPrec p = readParen (p > prec) 71 (\r -> [(x%%y,u) | (x,s) <- reads r, 72 ("%%",t) <- lex s, 73 (y,u) <- reads t ]) 74 instance Show QRational where 75 showsPrec p (x:%%y) = showParen (p > prec) (shows x . 76 showString " %% " . 77 shows y) 78 79 80 81 qInfinite :: QRational -> Bool 82 qInfinite x = qDenominator x == 0 && qNumerator x /= 0 83 84 qUndefined :: QRational -> Bool 85 qUndefined x = qDenominator x == 0 && qNumerator x == 0 86 87 qRound :: QRational -> Integer 88 qRound x = if qUndefined x || qInfinite x 89 then error "qRound: undefined or infinite" 90 else (2*qNumerator x + d) `div` (2*d) where d = qDenominator x 91 92 qFinite :: QRational -> Bool 93 qFinite x = qDenominator x /= 0 94 95