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 -------------------------------------------------------------------------------