1 module BasicNumberApprox (equ, lt, gt, lte, gte, ne, rabs, rsignum, 2 rtoRational, basicNumber2str) where 3 4 import RealM 5 import BasicNumber 6 import Ratio--1.3 7 import List(genericDrop, genericTake)--1.3 8 9 -- This module contains a set of routines which need a precision 10 -- argument to work for reals. For example, two real numbers can 11 -- be compared for equality only to a cerain precision. 12 13 -- Compare a and b for equality to a precision n. 14 equ :: BasicNumber -> BasicNumber -> Integer -> Bool 15 equ (BasRealC a) b n = if (diff <= 2) then True 16 else False 17 where 18 diff = abs ((evalReal a n) - (evalReal c n)) 19 (BasRealC c) = makeReal b 20 equ a (b@(BasRealC _)) n = equ b a n 21 equ a b _ = a == b 22 ------------------------------------------------------------------------------- 23 24 -- Check if a < b to a precision n. 25 lt :: BasicNumber -> BasicNumber -> Integer -> Bool 26 lt (BasRealC a) b n = if (diff < -2) then True 27 else False 28 where 29 diff = ((evalReal a n) - (evalReal c n)) 30 (BasRealC c) = makeReal b 31 lt a (b@(BasRealC _)) n = gt b a n 32 lt a b _ = a < b 33 ------------------------------------------------------------------------------- 34 35 -- Check if a > b to a precision n. 36 gt :: BasicNumber -> BasicNumber -> Integer -> Bool 37 gt (BasRealC a) b n = if (diff > 2) then True 38 else False 39 where 40 diff = ((evalReal a n) - (evalReal c n)) 41 (BasRealC c) = makeReal b 42 gt a (b@(BasRealC _)) n = lt b a n 43 gt a b _ = b < a 44 ------------------------------------------------------------------------------- 45 46 -- Check if a <= b to a precision n. 47 lte :: BasicNumber -> BasicNumber -> Integer -> Bool 48 lte a b n = not (gt a b n) 49 ------------------------------------------------------------------------------- 50 51 -- Check if a >= b to a precision n. 52 gte :: BasicNumber -> BasicNumber -> Integer -> Bool 53 gte a b n = not (lt a b n) 54 ------------------------------------------------------------------------------- 55 56 -- Check if a /= b to a precision n. 57 ne :: BasicNumber -> BasicNumber -> Integer -> Bool 58 ne a b n = not (equ a b n) 59 ------------------------------------------------------------------------------- 60 61 -- Get the absolute value of a. 62 rabs :: BasicNumber -> Integer -> BasicNumber 63 rabs (a@(BasRealC ar)) n = if (evalReal ar n) < 0 then (fromInteger(-1))*a 64 else a 65 rabs a n = abs a 66 ------------------------------------------------------------------------------- 67 68 -- Get the sign of a number. 69 rsignum :: BasicNumber -> Integer -> BasicNumber 70 rsignum (a@(BasRealC ar)) n = if ev_ar < 0 71 then fromInteger (-1) 72 else if ev_ar == 0 73 then fromInteger 0 74 else fromInteger 1 75 where 76 ev_ar = evalReal ar n 77 rsignum a n = signum a 78 ------------------------------------------------------------------------------- 79 80 -- Convert a BasicNumber to a rational with precision n. 81 rtoRational :: BasicNumber -> Integer -> BasicNumber 82 rtoRational (BasRealC a) n = if n <= 0 83 then (BasRationalC ((evalReal a n) % (10^(-n)))) 84 else (BasRationalC (((evalReal a n)*(10^n)) % 1)) 85 rtoRational a _ = makeRational a 86 ------------------------------------------------------------------------------- 87 88 -- Convert a BasicNumber to a string with precision n. 89 basicNumber2str :: BasicNumber -> Integer -> String 90 basicNumber2str (BasRealC x) prec = 91 intPart ++ "." ++ fracPart 92 where 93 evalX = show (evalReal x prec) 94 lenBeforeDecimal = (toInteger (length evalX)) 95 + prec 96 intPart = if lenBeforeDecimal <= 0 97 then "0" 98 else genericTake lenBeforeDecimal 99 evalX 100 fracPart = if lenBeforeDecimal < 0 101 then (pad (- lenBeforeDecimal) 102 '0') ++ 103 evalX 104 else genericDrop lenBeforeDecimal 105 evalX 106 pad 0 a = [] 107 --WAS:pad (n+1) a = a:(pad n a) 108 pad n a = a:(pad (n-1) a) 109 basicNumber2str (BasRationalC x) _ = show x 110 basicNumber2str (BasIntegerC x) _ = show x 111 -------------------------------------------------------------------------------