diff --git a/AERN-Real.cabal b/AERN-Real.cabal --- a/AERN-Real.cabal +++ b/AERN-Real.cabal @@ -1,5 +1,5 @@ Name: AERN-Real -Version: 0.9.5 +Version: 0.9.6 Cabal-Version: >= 1.2 Build-Type: Simple License: BSD3 @@ -45,9 +45,11 @@ . There is also some support for generic Taylor series, interval Newton method and simple numerical integration. - + . + Simple examples of usage can be found in tests/Demo.hs. + Extra-source-files: - ChangeLog tests/Test1.hs + ChangeLog tests/Demo.hs Flag containers-in-base Default: False diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +0.9.6: 7 August 2008 + * improved domain box class interface and implementation + * fixed broken domain box splitting function + * improved the integer logarithm auxiliary function + 0.9.5: 24 July 2008 * new operation for testing disjoing interiors * real approximations not automatically instances of Ord diff --git a/src/Data/Number/ER/Misc.hs b/src/Data/Number/ER/Misc.hs --- a/src/Data/Number/ER/Misc.hs +++ b/src/Data/Number/ER/Misc.hs @@ -187,22 +187,44 @@ {- numeric -} -intLog :: - (Num n1, Num n2, Ord n1) => +intLogDown b n = fst $ intLog b n +intLogUp b n = snd $ intLog b n + +intLog :: + (Num n1, Num n2, Ord n1, Integral n2) => n1 {-^ base -} -> n1 {-^ x -} -> - n2 -intLog b n - | n > 0 = p2 + (n2, n2) +intLog b n + | n == 1 = (0,0) + | n > 1 && n < b = (0,1) + | n >= b = + bisect (lgDn, pwDn) (lgUp, pwUp) + | otherwise = + error $ "Data.Number.ER.Misc: intLog: illegal argument n = " ++ show n where - (p2, pe2) = findSlow (p1, pe1) (p1 + 1, pe1 * b) - (p1, pe1) = findFast (1, b) (2, b*b) - findFast (p, pe) (pp, ppe) - | ppe < n = findFast (pp, ppe) (2 * pp, ppe * ppe) - | otherwise = (p, pe) - findSlow (p, pe) (pp, ppe) - | ppe < n = findSlow (pp, ppe) (pp + 1, ppe * b) - | otherwise = (pp, ppe) + ((lgDn, pwDn), (lgUp, pwUp)) = + findBounds (1, b) + -- lgDn <= log_b n < lgUp; pwDn = b^lgDn; pwUp = b^lgUp + findBounds (lg, pw) + | n < pwNext = ((lg, pw), (lgNext, pwNext)) + | otherwise = findBounds (lgNext, pwNext) + where + lgNext = 2 * lg + pwNext = pw * pw + bisect (lgDn, pwDn) (lgUp, pwUp) + | pwDn == n = (lgDn, lgDn) + | pwUp == n = (lgUp, lgUp) + | lgDn == lgMid = (lgDn, lgUp) + | lgUp == lgMid = (lgDn, lgUp) + | n < pwMid = + bisect (lgDn, pwDn) (lgMid, pwMid) + | otherwise = + bisect (lgMid, pwMid) (lgUp, pwUp) + where + lgMid = (lgDn + lgUp) `div` 2 + pwMid = pwDn * (b ^ (lgMid - lgDn)) + {-| Directionally rounded versions of @+,*,sum,prod@. @@ -229,6 +251,25 @@ [] -> Nothing (val,_) : _ -> Just val +showFirstLastLines :: + (Show a) => + Int {-^ how many initial lines to use -} -> + Int {-^ how many final lines to use -} -> + a -> + String +showFirstLastLines lineCountInit lineCountFinal x + | linesTotal > lineCount = + unlines $ + firstLines + ++ ["...(" ++ show (linesTotal - lineCount) ++ " lines omitted)..."] ++ + lastLines + | otherwise = unlines firstLines + where + lineCount = lineCountInit + lineCountFinal + firstLines = take lineCountInit allLines + lastLines = drop (linesTotal - lineCountFinal) allLines + allLines = lines $ show x + linesTotal = length allLines {- sequences -} listUpdate :: Int -> a -> [a] -> [a] diff --git a/src/Data/Number/ER/Real.hs b/src/Data/Number/ER/Real.hs --- a/src/Data/Number/ER/Real.hs +++ b/src/Data/Number/ER/Real.hs @@ -19,14 +19,15 @@ Abstractions are provided via 4 type classes: - * 'B.ERRealBase': abstracts floating point numbers + * 'B.ERRealBase': generalises floating point numbers (not exported here, used only internally) - - * 'ERApprox': abstracts neighbourhoods of real numbers + + * 'ERApprox': generalises measurable subsets of real numbers - * 'ERIntApprox': abstracts neighbourhoods of real numbers that are known to be intervals + * 'ERIntApprox': generalises interval neighbourhoods of real numbers - * 'ERApproxElementary': abstracts real number approximations that support elementary operations + * 'ERApproxElementary': generalises real number approximations + that support elementary operations For ERRealBase we give several implementations. The default is an arbitrary precision floating point type that uses Double diff --git a/src/Data/Number/ER/Real/Arithmetic/Elementary.hs b/src/Data/Number/ER/Real/Arithmetic/Elementary.hs --- a/src/Data/Number/ER/Real/Arithmetic/Elementary.hs +++ b/src/Data/Number/ER/Real/Arithmetic/Elementary.hs @@ -304,7 +304,7 @@ gran = effIx2gran ix posx = (RA.setMinGranularity gran x) RA./\ (0 RA.\/ (1/0)) nearLogx = - 0.69314718055994530941 * (fromInteger $ intLog 2 $ xCeiling) + 0.69314718055994530941 * (fromInteger $ intLogUp 2 $ xCeiling) remNearLogx = posx / (erExp_R ix nearLogx) -- should be very close to 1 xCeiling = diff --git a/src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs b/src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs --- a/src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs +++ b/src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs @@ -20,7 +20,7 @@ import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.DomainBox as DBox -import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox) +import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox) import Data.Number.ER.BasicTypes import Data.List @@ -48,7 +48,9 @@ -} linearSolver :: - (RA.ERIntApprox ira, DomainIntBox box varid ira) => + (RA.ERIntApprox ira, + DomainIntBox box varid ira, + DomainBoxMappable box box varid ira ira) => [(box, ira)] {-^ the equations; each equation has coefficients of linear terms diff --git a/src/Data/Number/ER/Real/Base/CombinedMachineAP.hs b/src/Data/Number/ER/Real/Base/CombinedMachineAP.hs --- a/src/Data/Number/ER/Real/Base/CombinedMachineAP.hs +++ b/src/Data/Number/ER/Real/Base/CombinedMachineAP.hs @@ -199,9 +199,9 @@ error $ "ERMachineAP: getApproxBinaryLog: negative argument " ++ show d | d == 0 = EI.MinusInfinity | d >= 1 = - fromInteger $ intLog 2 $ ceiling d + fromInteger $ intLogUp 2 $ ceiling d | d < 1 = - negate $ fromInteger $ intLog 2 $ ceiling $ recip d + negate $ fromInteger $ intLogUp 2 $ ceiling $ recip d getGranularity (ERMachineAPB b) = B.getGranularity b getGranularity (ERMachineAPMachineDouble gr _) = gr setMinGranularity gran (ERMachineAPMachineDouble g d) diff --git a/src/Data/Number/ER/Real/Base/Float.hs b/src/Data/Number/ER/Real/Base/Float.hs --- a/src/Data/Number/ER/Real/Base/Float.hs +++ b/src/Data/Number/ER/Real/Base/Float.hs @@ -240,8 +240,8 @@ | d == 0 = stripCountZeros (prevZeros + 1) dsRest | otherwise = (prevZeros, ds) dexpBound -- upper bound of dexp: f/10^dexpBound < 1 - | e >= 0 = intLog 10 (2^e) - | e < 0 = 2 - (intLog 10 (2^(-e))) + | e >= 0 = intLogUp 10 (2^e) + | e < 0 = 2 - (intLogUp 10 (2^(-e))) preDigits = getDigits $ (abs $ setERFloatGranularity gran f) / (ten ^^ dexpBound) ten = setERFloatGranularity gran 10 @@ -321,7 +321,7 @@ normaliseERFloat $ ERFloat gr Plus m e where gr = fromInteger e - e = max (toInteger (B.defaultGranularity zero)) $ (intLog 2 $ abs n) - 1 + e = max (toInteger (B.defaultGranularity zero)) $ (intLogUp 2 $ abs n) - 1 m = (abs n) - 2^gr abs f@(ERFloatNaN _) = f abs f = f { apfltSign = Plus } diff --git a/src/Data/Number/ER/Real/Base/MachineDouble.hs b/src/Data/Number/ER/Real/Base/MachineDouble.hs --- a/src/Data/Number/ER/Real/Base/MachineDouble.hs +++ b/src/Data/Number/ER/Real/Base/MachineDouble.hs @@ -69,7 +69,7 @@ | f == 0 = EI.MinusInfinity | otherwise = - intLog 2 (abs $ ceiling f) + intLogUp 2 (abs $ ceiling f) getGranularity _ = 53 setMinGranularity _ = id setGranularity _ = id diff --git a/src/Data/Number/ER/Real/Base/Rational.hs b/src/Data/Number/ER/Real/Base/Rational.hs --- a/src/Data/Number/ER/Real/Base/Rational.hs +++ b/src/Data/Number/ER/Real/Base/Rational.hs @@ -101,7 +101,7 @@ digit1 : digits = drop zerosCount preDigits dexpBound = -- upper bound of dexp: f/10^dexpBound < 1 - 2 + (intLog 10 num) - (intLog 10 dnm) + 2 + (intLogUp 10 num) - (intLogUp 10 dnm) num = numerator absr dnm = denominator absr absr = abs r @@ -211,9 +211,9 @@ | r == 0 = EI.MinusInfinity | otherwise = - (intLog 2 (abs $ numerator $ r)) + (intLogUp 2 (abs $ numerator $ r)) - - (intLog 2 (abs $ denominator $ r)) + (intLogUp 2 (abs $ denominator $ r)) getApproxBinaryLog (Infinity _) = EI.PlusInfinity getApproxBinaryLog (NaN) = error "RationalBase: getApproxBinaryLog: NaN" getGranularity _ = 0 diff --git a/src/Data/Number/ER/Real/DomainBox.hs b/src/Data/Number/ER/Real/DomainBox.hs --- a/src/Data/Number/ER/Real/DomainBox.hs +++ b/src/Data/Number/ER/Real/DomainBox.hs @@ -22,6 +22,7 @@ ( VariableID(..), DomainBox(..), + DomainBoxMappable(..), DomainIntBox(..) ) where @@ -48,37 +49,57 @@ showVar :: varid -> String {-| - A class abstracting a type of many-dimensional points or intervals. + A class abstracting a type of many-dimensional points, intervals + or anything indexed by a subset of dimensions. + + More generally, this class abstracts most of 'Data.Map.Map'. -} -class (VariableID varid) => DomainBox box varid ira - | box -> varid ira, varid ira -> box +class (VariableID varid) => DomainBox box varid val + | box -> varid val, varid val -> box where noinfo :: box isNoinfo :: box -> Bool {-| constructor using 'defaultVar' -} - unary :: ira -> box - singleton :: varid -> ira -> box - toList :: box -> [(varid, ira)] - fromList :: [(varid, ira)] -> box - toAscList :: box -> [(varid, ira)] - fromAscList :: [(varid, ira)] -> box - toMap :: box -> Map.Map varid ira - fromMap :: Map.Map varid ira -> box - insert :: varid -> ira -> box -> box - insertWith :: (ira -> ira -> ira) -> varid -> ira -> box -> box + unary :: val -> box + singleton :: varid -> val -> box + toList :: box -> [(varid, val)] + fromList :: [(varid, val)] -> box + toAscList :: box -> [(varid, val)] + fromAscList :: [(varid, val)] -> box +-- toMap :: box -> Map.Map varid val +-- fromMap :: Map.Map varid val -> box + insert :: varid -> val -> box -> box + insertWith :: (val -> val -> val) -> varid -> val -> box -> box delete :: varid -> box -> box member :: varid -> box -> Bool notMember :: varid -> box -> Bool union :: box -> box -> box - unionWith :: (ira -> ira -> ira) -> box -> box -> box + unionWith :: (val -> val -> val) -> box -> box -> box keys :: box -> [varid] - elems :: box -> [ira] - map :: (ira -> ira) -> box -> box - fold :: (ira -> a -> a) -> a -> box -> a - foldWithKey :: (varid -> ira -> a -> a) -> a -> box -> a - zipWith :: (ira -> ira -> a) -> box -> box -> [(varid, a)] - intersectionWith :: (ira -> ira -> ira) -> box -> box -> box - findWithDefault :: ira -> varid -> box -> ira + elems :: box -> [val] + filter :: (val -> Bool) -> box -> box + fold :: (val -> a -> a) -> a -> box -> a + foldWithKey :: (varid -> val -> a -> a) -> a -> box -> a + {-| + for all variables that appear in both boxes, + apply the function and add the result to the list + -} + zipWith :: (val -> val -> a) -> box -> box -> [(varid, a)] + {-| + For all variables that appear in either of the two boxes, + apply the function and add the result to the list. + + Supply the default value when the variable is missing from either box. + -} + zipWithDefault :: val -> (val -> val -> a) -> box -> box -> [(varid, a)] + {-| + For all variables that appear in the first box, + apply the function and add the result to the list. + + Supply the default value when the variable is missing from the second box. + -} + zipWithDefaultSecond :: val -> (val -> val -> a) -> box -> box -> [(varid, a)] + findWithDefault :: val -> varid -> box -> val {-| Pick the extents of a single variable in a domain box. If there is no information for this variable, assume the @@ -88,10 +109,22 @@ String {-^ identification of caller location to use in error messages -} -> varid -> box -> - ira - + val {-| + A class linking two domain box types that share the + index type so that boxes of the two types can be + converted etc. +-} +class (DomainBox box1 varid val1, DomainBox box2 varid val2) => + DomainBoxMappable box1 box2 varid val1 val2 + where + map :: (val1 -> val2) -> box1 -> box2 + mapWithKey :: (varid -> val1 -> val2) -> box1 -> box2 + intersectionWith :: (val1 -> val2 -> val1) -> box1 -> box2 -> box1 + difference :: box1 -> box2 -> box1 + +{-| A class abstracting a type of many-dimensional intervals. -} class (DomainBox box varid ira) => DomainIntBox box varid ira @@ -123,6 +156,11 @@ bestSplit :: box -> (varid, ira) + split :: + box -> + varid -> + ira -> + (box, box) classifyPosition :: box {-^ domain @d1@ -} -> box {-^ domain @d2@ -} -> @@ -138,5 +176,4 @@ * is @d1@ inside @d2@? -} - diff --git a/src/Data/Number/ER/Real/DomainBox/IntMap.hs b/src/Data/Number/ER/Real/DomainBox/IntMap.hs --- a/src/Data/Number/ER/Real/DomainBox/IntMap.hs +++ b/src/Data/Number/ER/Real/DomainBox/IntMap.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TypeSynonymInstances #-} {-| Module : Data.Number.ER.Real.DomainBox.IntMap - Description : implementation of DomainBox based on Data.Map + Description : implementation of DomainBox based on Data.IntMap Copyright : (c) Michal Konecny License : BSD3 @@ -20,13 +20,14 @@ where import qualified Data.Number.ER.Real.Approx as RA -import Data.Number.ER.Real.DomainBox +import qualified Data.Number.ER.Real.DomainBox as DBox +import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox) -import qualified Data.Map as Map +import qualified Data.IntMap as IMap import qualified Data.Set as Set type VarID = Int -type Box ira = Map.Map VarID ira +type Box ira = IMap.IntMap ira instance VariableID VarID where @@ -34,51 +35,97 @@ | Set.null prevVars = 0 | otherwise = 1 + (Set.findMax prevVars) - showVar v = "x" ++ show v + showVar v + | v == 0 = "x" + | otherwise = "x" ++ show v -instance (Show ira) => (DomainBox (Box ira) VarID ira) +instance (Show val) => (DomainBox (Box val) VarID val) where - noinfo = Map.empty - isNoinfo = Map.null - unary r = Map.singleton defaultVar r - singleton = Map.singleton - toList = Map.toList - fromList = Map.fromList - toAscList = Map.toAscList - fromAscList = Map.fromAscList - toMap = id - fromMap = id - insert = Map.insert - insertWith = Map.insertWith - delete = Map.delete - member = Map.member - notMember = Map.notMember - union = Map.union - unionWith = Map.unionWith - elems = Map.elems - keys = Map.keys - map = Map.map - fold = Map.fold - foldWithKey = Map.foldWithKey - zipWith f b1 b2 = Map.toList $ Map.intersectionWith f b1 b2 - intersectionWith = Map.intersectionWith - findWithDefault = Map.findWithDefault + noinfo = IMap.empty + isNoinfo = IMap.null + unary r = IMap.singleton defaultVar r + singleton = IMap.singleton + toList = IMap.toList + fromList = IMap.fromList + toAscList = IMap.toAscList + fromAscList = IMap.fromAscList +-- toMap = id +-- fromMap = id + insert = IMap.insert + insertWith = IMap.insertWith + delete = IMap.delete + member = IMap.member + notMember = IMap.notMember + union = IMap.union + unionWith = IMap.unionWith + elems = IMap.elems + keys = IMap.keys + filter = IMap.filter + fold = IMap.fold + foldWithKey = IMap.foldWithKey + zipWith f b1 b2 = + applyF (IMap.toAscList b1) (IMap.toAscList b2) + where + applyF [] _ = [] + applyF _ [] = [] + applyF bl1@((k1,v1):rest1) bl2@((k2,v2):rest2) + | k1 == k2 = + (k1, f v1 v2) : (applyF rest1 rest2) + | k1 < k2 = applyF rest1 bl2 + | otherwise = applyF bl1 rest2 + zipWithDefault defaultValue f b1 b2 = + applyF (IMap.toAscList b1) (IMap.toAscList b2) + where + applyF [] [] = [] + applyF bl1@((k1,v1):rest1) [] = + (k1, f v1 defaultValue) : (applyF rest1 []) + applyF [] bl2@((k2,v2):rest2) = + (k2, f defaultValue v2) : (applyF [] rest2) + applyF bl1@((k1,v1):rest1) bl2@((k2,v2):rest2) + | k1 == k2 = + (k1, f v1 v2) : (applyF rest1 rest2) + | k1 < k2 = + (k1, f v1 defaultValue) : (applyF rest1 bl2) + | otherwise = + (k2, f defaultValue v2) : (applyF bl1 rest2) + zipWithDefaultSecond defaultValue f b1 b2 = + applyF (IMap.toAscList b1) (IMap.toAscList b2) + where + applyF [] _ = [] + applyF bl1@((k1,v1):rest1) [] = + (k1, f v1 defaultValue) : (applyF rest1 []) + applyF bl1@((k1,v1):rest1) bl2@((k2,v2):rest2) + | k1 == k2 = + (k1, f v1 v2) : (applyF rest1 rest2) + | k1 < k2 = + (k1, f v1 defaultValue) : (applyF rest1 bl2) + | otherwise = + applyF bl1 rest2 + findWithDefault = IMap.findWithDefault lookup locspec var dom = - Map.findWithDefault err var dom + IMap.findWithDefault err var dom where err = error $ locspec ++ "DomainBox.IntMap lookup: domain box " ++ show dom ++ " ignores variable " ++ show var +instance (Show val1, Show val2) => + (DomainBoxMappable (Box val1) (Box val2) VarID val1 val2) + where + map = IMap.map + mapWithKey = IMap.mapWithKey + intersectionWith = IMap.intersectionWith + difference = IMap.difference + instance (RA.ERIntApprox ira) => DomainIntBox (Box ira) VarID ira where compatible dom1 dom2 = - Map.fold (&&) True $ - Map.intersectionWith RA.equalIntervals dom1 dom2 + foldl (&&) True $ map snd $ + DBox.zipWith RA.equalIntervals dom1 dom2 unify locspec dom1 dom2 - | compatible dom1 dom2 = - Map.union dom1 dom2 + | DBox.compatible dom1 dom2 = + IMap.union dom1 dom2 | otherwise = error $ locspec ++ "incompatible domains " ++ show dom1 ++ " and " ++ show dom2 @@ -88,7 +135,7 @@ pt = RA.defaultBisectPt varDom (_, (varDom, var)) = - foldl findWidestVar (0, err) $ Map.toList dom + foldl findWidestVar (0, err) $ IMap.toList dom err = error $ "DomainBox: bestSplit: failed to find a split for " ++ show dom findWidestVar (prevWidth, prevRes) (v, d) @@ -97,11 +144,18 @@ where currWidth = snd $ RA.bounds $ domHI - domLO (domLO, domHI) = RA.bounds d + split dom var pt = + (IMap.insert var varDomL dom, IMap.insert var varDomR dom) + where + varDomL = varDomLO RA.\/ varDomMid + varDomR = varDomMid RA.\/ varDomHI + (varDomLO, varDomMid, varDomHI, _) = RA.exactMiddle varDom + varDom = DBox.lookup "DomainBox.IntMap: split: " var dom classifyPosition dom sdom = (away, touch, intersect, inside) where (away, touch, inside, intersect) = - Map.fold addDimension (True, True, True, False) awayTouchInsides + foldl addDimension (True, True, True, False) awayTouchInsides addDimension (prevAway, prevTouch, prevInside, prevIntersect) (thisAway, thisTouch, thisInside, thisIntersect) = @@ -110,7 +164,8 @@ prevInside && thisInside, prevIntersect || thisIntersect) awayTouchInsides = - Map.intersectionWith classifyRA dom sdom + map snd $ + DBox.zipWith classifyRA dom sdom classifyRA d sd = (outsideNoTouch, outsideTouch, inside, not (outsideNoTouch || outsideTouch || inside)) diff --git a/tests/Demo.hs b/tests/Demo.hs new file mode 100644 --- /dev/null +++ b/tests/Demo.hs @@ -0,0 +1,138 @@ +{-| + Module : Main + Description : simple examples of using AERN-Real + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mik@konecny.aow.cz + Stability : experimental + Portability : portable + + Simple examples of using AERN-Real +-} +module Main where + +import qualified Data.Number.ER.Real as AERN +import Data.Number.ER.Real (RA, IRA, ConvergRealSeq(..), convertFuncRA2Seq) + +type R = ConvergRealSeq IRA + +one :: R +one = 1 + +two :: R +two = 2 + +piSeq :: R +piSeq = ConvergRealSeq $ AERN.pi + +seqExp = convertFuncRA2Seq $ AERN.exp +seqSine = convertFuncRA2Seq $ AERN.sin +seqCosine = convertFuncRA2Seq $ AERN.cos + +main = + do + AERN.initMachineDouble + putStrLn "****************************" + putStrLn "Testing interval arithmetic:" + putStrLn "****************************" + putStrLn "**** Fractions:" + putStrLn $ + "(default granularity, show internals) 1/3 =\n " ++ + AERN.showApprox 30 True True (1/3 :: RA) + putStrLn $ + "(granularity 50, show internals) 1/3 =\n " ++ + AERN.showApprox 30 True True ((AERN.setGranularity 50 1/3) :: RA) + putStrLn $ + "(granularity 100, show internals) 1/3 =\n " ++ + AERN.showApprox 40 True True ((AERN.setGranularity 100 1/3) :: RA) + putStrLn $ + "(granularity 100, do not show internals) 1/3 =\n " ++ + AERN.showApprox 40 True False ((AERN.setGranularity 100 1/3) :: RA) + putStrLn $ + "(granularity 100, default show) 1/3 =\n " ++ + show ((AERN.setGranularity 100 1/3) :: RA) + putStrLn "**** Exp:" + putStrLn $ + "(effort 5, granularity 50) exp 1 =\n " ++ + (show $ AERN.exp 5 (AERN.setGranularity 50 (1::RA))) + putStrLn $ + "(effort 10, granularity 50) exp 1 =\n " ++ + (show $ AERN.exp 10 (AERN.setGranularity 50 (1::RA))) + putStrLn $ + "(effort 10, granularity 100) exp 1 =\n " ++ + (show $ AERN.exp 10 (AERN.setGranularity 100 (1::RA))) + putStrLn $ + "(effort 20, granularity 50) exp 1 =\n " ++ + (show $ AERN.exp 20 (AERN.setGranularity 50 (1::RA))) + putStrLn $ + "(effort 20, granularity 100) exp 1 =\n " ++ + (show $ AERN.exp 20 (AERN.setGranularity 100 (1::RA))) + putStrLn "**** Pi:" + putStrLn $ + "(effort 10) pi =\n " ++ + (show $ (AERN.pi 10 :: RA)) + putStrLn $ + "(effort 50) pi =\n " ++ + (AERN.showApprox 20 True False $ (AERN.pi 50 :: RA)) + putStrLn $ + "(effort 100) pi =\n " ++ + (AERN.showApprox 35 True False $ (AERN.pi 100 :: RA)) + putStrLn $ + "(effort 200) pi =\n " ++ + (AERN.showApprox 65 True False $ (AERN.pi 200 :: RA)) + putStrLn $ + "(effort 400) pi =\n " ++ + (AERN.showApprox 125 True False $ (AERN.pi 400 :: RA)) + putStrLn "**** Sine:" + putStrLn $ + "(effort 10, granularity 50) sin 1 =\n " ++ + (show $ AERN.sin 10 (AERN.setGranularity 50 (1::RA))) + putStrLn $ + "(effort 10, granularity 100) sin 1 =\n " ++ + (show $ AERN.sin 10 (AERN.setGranularity 100 (1::RA))) + putStrLn "**** Integration:" + putStrLn $ + "(effort 10, granularity 50) integrate exp 0 1 =\n " ++ + (show $ AERN.integrateContAdapt_R AERN.exp 10 0 (AERN.setGranularity 50 (1::RA))) + putStrLn $ + "(effort 20, granularity 50) integrate exp 0 1 =\n " ++ + (show $ AERN.integrateContAdapt_R AERN.exp 20 0 (AERN.setGranularity 50 (1::RA))) +-- putStrLn $ +-- "(effort 30, granularity 50) integrate exp 0 1 =\n " ++ +-- (show $ AERN.integrateContAdapt_R AERN.exp 30 0 (AERN.setGranularity 50 (1::RA))) + putStrLn "*****************************" + putStrLn "Testing convergent sequences:" + putStrLn "*****************************" +-- putStrLn $ "1 =\n " ++ show one +-- putStrLn $ "1 + 2 =\n " ++ (show $ one + two) + putStrLn "**** Fractions:" + putStrLn $ + "(precision 20) 1/3 =\n " ++ + (AERN.showConvergRealSeqAuto 20 $ one / 3) + putStrLn $ + "(precision 20) 100000000001/300000000000 =\n " ++ + (AERN.showConvergRealSeqAuto 20 $ (one + 100000000000)/300000000000 ) + putStrLn $ + "100000000001/300000000000 =? 1/3:\n " ++ + (show $ one/3 == 100000000001/300000000000) +-- putStrLn $ "abs -1 = " ++ (show $ abs (- one)) +-- putStrLn $ "neg 2 = " ++ (show $ negate two) +-- putStrLn $ "1 + 2 = " ++ (show $ one + 2) + putStrLn "**** Elementary:" + putStrLn $ + "(precision 30) exp 1 =\n " ++ + (AERN.showConvergRealSeqAuto 30 $ seqExp one) + putStrLn $ + "(precision 500) pi =\n " ++ + (AERN.showConvergRealSeqAuto 500 $ piSeq) + putStrLn $ + "(precision 30) cosine(1) =\n " ++ + (AERN.showConvergRealSeqAuto 30 $ seqCosine one) + putStrLn $ + "(precision 30) sine(1) =\n " ++ + (AERN.showConvergRealSeqAuto 30 $ seqSine one) + putStrLn "**** Integration:" + putStrLn $ -- very slow for precision > 4 + "(precision 3) integrate exp 0 1 =\n " ++ + (AERN.showConvergRealSeqAuto 3 $ AERN.integrateCont AERN.exp 0 one) diff --git a/tests/Test1.hs b/tests/Test1.hs deleted file mode 100644 --- a/tests/Test1.hs +++ /dev/null @@ -1,138 +0,0 @@ -{-| - Module : Main - Description : simple examples of using AERN-Real - Copyright : (c) Michal Konecny - License : BSD3 - - Maintainer : mik@konecny.aow.cz - Stability : experimental - Portability : portable - - Simple examples of using AERN-Real --} -module Main where - -import qualified Data.Number.ER.Real as AERN -import Data.Number.ER.Real (RA, IRA, ConvergRealSeq(..), convertFuncRA2Seq) - -type R = ConvergRealSeq IRA - -one :: R -one = 1 - -two :: R -two = 2 - -piSeq :: R -piSeq = ConvergRealSeq $ AERN.pi - -seqExp = convertFuncRA2Seq $ AERN.exp -seqSine = convertFuncRA2Seq $ AERN.sin -seqCosine = convertFuncRA2Seq $ AERN.cos - -main = - do - AERN.initMachineDouble - putStrLn "****************************" - putStrLn "Testing interval arithmetic:" - putStrLn "****************************" - putStrLn "**** Fractions:" - putStrLn $ - "(default granularity, show internals) 1/3 =\n " ++ - AERN.showApprox 30 True True (1/3 :: RA) - putStrLn $ - "(granularity 50, show internals) 1/3 =\n " ++ - AERN.showApprox 30 True True ((AERN.setGranularity 50 1/3) :: RA) - putStrLn $ - "(granularity 100, show internals) 1/3 =\n " ++ - AERN.showApprox 40 True True ((AERN.setGranularity 100 1/3) :: RA) - putStrLn $ - "(granularity 100, do not show internals) 1/3 =\n " ++ - AERN.showApprox 40 True False ((AERN.setGranularity 100 1/3) :: RA) - putStrLn $ - "(granularity 100, default show) 1/3 =\n " ++ - show ((AERN.setGranularity 100 1/3) :: RA) - putStrLn "**** Exp:" - putStrLn $ - "(effort 5, granularity 50) exp 1 =\n " ++ - (show $ AERN.exp 5 (AERN.setGranularity 50 (1::RA))) - putStrLn $ - "(effort 10, granularity 50) exp 1 =\n " ++ - (show $ AERN.exp 10 (AERN.setGranularity 50 (1::RA))) - putStrLn $ - "(effort 10, granularity 100) exp 1 =\n " ++ - (show $ AERN.exp 10 (AERN.setGranularity 100 (1::RA))) - putStrLn $ - "(effort 20, granularity 50) exp 1 =\n " ++ - (show $ AERN.exp 20 (AERN.setGranularity 50 (1::RA))) - putStrLn $ - "(effort 20, granularity 100) exp 1 =\n " ++ - (show $ AERN.exp 20 (AERN.setGranularity 100 (1::RA))) - putStrLn "**** Pi:" - putStrLn $ - "(effort 10) pi =\n " ++ - (show $ (AERN.pi 10 :: RA)) - putStrLn $ - "(effort 50) pi =\n " ++ - (AERN.showApprox 20 True False $ (AERN.pi 50 :: RA)) - putStrLn $ - "(effort 100) pi =\n " ++ - (AERN.showApprox 35 True False $ (AERN.pi 100 :: RA)) - putStrLn $ - "(effort 200) pi =\n " ++ - (AERN.showApprox 65 True False $ (AERN.pi 200 :: RA)) - putStrLn $ - "(effort 400) pi =\n " ++ - (AERN.showApprox 125 True False $ (AERN.pi 400 :: RA)) - putStrLn "**** Sine:" - putStrLn $ - "(effort 10, granularity 50) sin 1 =\n " ++ - (show $ AERN.sin 10 (AERN.setGranularity 50 (1::RA))) - putStrLn $ - "(effort 10, granularity 100) sin 1 =\n " ++ - (show $ AERN.sin 10 (AERN.setGranularity 100 (1::RA))) - putStrLn "**** Integration:" - putStrLn $ - "(effort 10, granularity 50) integrate exp 0 1 =\n " ++ - (show $ AERN.integrateContAdapt_R AERN.exp 10 0 (AERN.setGranularity 50 (1::RA))) - putStrLn $ - "(effort 20, granularity 50) integrate exp 0 1 =\n " ++ - (show $ AERN.integrateContAdapt_R AERN.exp 20 0 (AERN.setGranularity 50 (1::RA))) --- putStrLn $ --- "(effort 30, granularity 50) integrate exp 0 1 =\n " ++ --- (show $ AERN.integrateContAdapt_R AERN.exp 30 0 (AERN.setGranularity 50 (1::RA))) - putStrLn "*****************************" - putStrLn "Testing convergent sequences:" - putStrLn "*****************************" --- putStrLn $ "1 =\n " ++ show one --- putStrLn $ "1 + 2 =\n " ++ (show $ one + two) - putStrLn "**** Fractions:" - putStrLn $ - "(precision 20) 1/3 =\n " ++ - (AERN.showConvergRealSeqAuto 20 $ one / 3) - putStrLn $ - "(precision 20) 100000000001/300000000000 =\n " ++ - (AERN.showConvergRealSeqAuto 20 $ (one + 100000000000)/300000000000 ) - putStrLn $ - "100000000001/300000000000 =? 1/3:\n " ++ - (show $ one/3 == 100000000001/300000000000) --- putStrLn $ "abs -1 = " ++ (show $ abs (- one)) --- putStrLn $ "neg 2 = " ++ (show $ negate two) --- putStrLn $ "1 + 2 = " ++ (show $ one + 2) - putStrLn "**** Elementary:" - putStrLn $ - "(precision 30) exp 1 =\n " ++ - (AERN.showConvergRealSeqAuto 30 $ seqExp one) - putStrLn $ - "(precision 500) pi =\n " ++ - (AERN.showConvergRealSeqAuto 500 $ piSeq) - putStrLn $ - "(precision 30) cosine(1) =\n " ++ - (AERN.showConvergRealSeqAuto 30 $ seqCosine one) - putStrLn $ - "(precision 30) sine(1) =\n " ++ - (AERN.showConvergRealSeqAuto 30 $ seqSine one) - putStrLn "**** Integration:" - putStrLn $ -- very slow for precision > 4 - "(precision 3) integrate exp 0 1 =\n " ++ - (AERN.showConvergRealSeqAuto 3 $ AERN.integrateCont AERN.exp 0 one)