AERN-Real 0.9.5 → 0.9.6
raw patch · 14 files changed
+377/−234 lines, 14 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Data.Number.ER.Real.DomainBox: fromMap :: (DomainBox box varid ira) => Map varid ira -> box
- Data.Number.ER.Real.DomainBox: toMap :: (DomainBox box varid ira) => box -> Map varid ira
- Data.Number.ER.Real.DomainBox.IntMap: instance (Show ira) => DomainBox (Box ira) VarID ira
+ Data.Number.ER.Misc: showFirstLastLines :: (Show a) => Int -> Int -> a -> String
+ Data.Number.ER.Real.DomainBox: class (DomainBox box1 varid val1, DomainBox box2 varid val2) => DomainBoxMappable box1 box2 varid val1 val2
+ Data.Number.ER.Real.DomainBox: difference :: (DomainBoxMappable box1 box2 varid val1 val2) => box1 -> box2 -> box1
+ Data.Number.ER.Real.DomainBox: filter :: (DomainBox box varid val) => (val -> Bool) -> box -> box
+ Data.Number.ER.Real.DomainBox: mapWithKey :: (DomainBoxMappable box1 box2 varid val1 val2) => (varid -> val1 -> val2) -> box1 -> box2
+ Data.Number.ER.Real.DomainBox: split :: (DomainIntBox box varid ira) => box -> varid -> ira -> (box, box)
+ Data.Number.ER.Real.DomainBox: zipWithDefault :: (DomainBox box varid val) => val -> (val -> val -> a) -> box -> box -> [(varid, a)]
+ Data.Number.ER.Real.DomainBox: zipWithDefaultSecond :: (DomainBox box varid val) => val -> (val -> val -> a) -> box -> box -> [(varid, a)]
+ Data.Number.ER.Real.DomainBox.IntMap: instance (Show val) => DomainBox (Box val) VarID val
+ Data.Number.ER.Real.DomainBox.IntMap: instance (Show val1, Show val2) => DomainBoxMappable (Box val1) (Box val2) VarID val1 val2
- Data.Number.ER.Misc: intLog :: (Num n1, Num n2, Ord n1) => n1 -> n1 -> n2
+ Data.Number.ER.Misc: intLog :: (Num n1, Num n2, Ord n1, Integral n2) => n1 -> n1 -> (n2, n2)
- Data.Number.ER.Real.Arithmetic.LinearSolver: linearSolver :: (ERIntApprox ira, DomainIntBox box varid ira) => [(box, ira)] -> box -> ira -> Maybe box
+ Data.Number.ER.Real.Arithmetic.LinearSolver: linearSolver :: (ERIntApprox ira, DomainIntBox box varid ira, DomainBoxMappable box box varid ira ira) => [(box, ira)] -> box -> ira -> Maybe box
- Data.Number.ER.Real.DomainBox: class (VariableID varid) => DomainBox box varid ira | box -> varid ira, varid ira -> box
+ Data.Number.ER.Real.DomainBox: class (VariableID varid) => DomainBox box varid val | box -> varid val, varid val -> box
- Data.Number.ER.Real.DomainBox: delete :: (DomainBox box varid ira) => varid -> box -> box
+ Data.Number.ER.Real.DomainBox: delete :: (DomainBox box varid val) => varid -> box -> box
- Data.Number.ER.Real.DomainBox: elems :: (DomainBox box varid ira) => box -> [ira]
+ Data.Number.ER.Real.DomainBox: elems :: (DomainBox box varid val) => box -> [val]
- Data.Number.ER.Real.DomainBox: findWithDefault :: (DomainBox box varid ira) => ira -> varid -> box -> ira
+ Data.Number.ER.Real.DomainBox: findWithDefault :: (DomainBox box varid val) => val -> varid -> box -> val
- Data.Number.ER.Real.DomainBox: fold :: (DomainBox box varid ira) => (ira -> a -> a) -> a -> box -> a
+ Data.Number.ER.Real.DomainBox: fold :: (DomainBox box varid val) => (val -> a -> a) -> a -> box -> a
- Data.Number.ER.Real.DomainBox: foldWithKey :: (DomainBox box varid ira) => (varid -> ira -> a -> a) -> a -> box -> a
+ Data.Number.ER.Real.DomainBox: foldWithKey :: (DomainBox box varid val) => (varid -> val -> a -> a) -> a -> box -> a
- Data.Number.ER.Real.DomainBox: fromAscList :: (DomainBox box varid ira) => [(varid, ira)] -> box
+ Data.Number.ER.Real.DomainBox: fromAscList :: (DomainBox box varid val) => [(varid, val)] -> box
- Data.Number.ER.Real.DomainBox: fromList :: (DomainBox box varid ira) => [(varid, ira)] -> box
+ Data.Number.ER.Real.DomainBox: fromList :: (DomainBox box varid val) => [(varid, val)] -> box
- Data.Number.ER.Real.DomainBox: insert :: (DomainBox box varid ira) => varid -> ira -> box -> box
+ Data.Number.ER.Real.DomainBox: insert :: (DomainBox box varid val) => varid -> val -> box -> box
- Data.Number.ER.Real.DomainBox: insertWith :: (DomainBox box varid ira) => (ira -> ira -> ira) -> varid -> ira -> box -> box
+ Data.Number.ER.Real.DomainBox: insertWith :: (DomainBox box varid val) => (val -> val -> val) -> varid -> val -> box -> box
- Data.Number.ER.Real.DomainBox: intersectionWith :: (DomainBox box varid ira) => (ira -> ira -> ira) -> box -> box -> box
+ Data.Number.ER.Real.DomainBox: intersectionWith :: (DomainBoxMappable box1 box2 varid val1 val2) => (val1 -> val2 -> val1) -> box1 -> box2 -> box1
- Data.Number.ER.Real.DomainBox: isNoinfo :: (DomainBox box varid ira) => box -> Bool
+ Data.Number.ER.Real.DomainBox: isNoinfo :: (DomainBox box varid val) => box -> Bool
- Data.Number.ER.Real.DomainBox: keys :: (DomainBox box varid ira) => box -> [varid]
+ Data.Number.ER.Real.DomainBox: keys :: (DomainBox box varid val) => box -> [varid]
- Data.Number.ER.Real.DomainBox: lookup :: (DomainBox box varid ira) => String -> varid -> box -> ira
+ Data.Number.ER.Real.DomainBox: lookup :: (DomainBox box varid val) => String -> varid -> box -> val
- Data.Number.ER.Real.DomainBox: map :: (DomainBox box varid ira) => (ira -> ira) -> box -> box
+ Data.Number.ER.Real.DomainBox: map :: (DomainBoxMappable box1 box2 varid val1 val2) => (val1 -> val2) -> box1 -> box2
- Data.Number.ER.Real.DomainBox: member :: (DomainBox box varid ira) => varid -> box -> Bool
+ Data.Number.ER.Real.DomainBox: member :: (DomainBox box varid val) => varid -> box -> Bool
- Data.Number.ER.Real.DomainBox: noinfo :: (DomainBox box varid ira) => box
+ Data.Number.ER.Real.DomainBox: noinfo :: (DomainBox box varid val) => box
- Data.Number.ER.Real.DomainBox: notMember :: (DomainBox box varid ira) => varid -> box -> Bool
+ Data.Number.ER.Real.DomainBox: notMember :: (DomainBox box varid val) => varid -> box -> Bool
- Data.Number.ER.Real.DomainBox: singleton :: (DomainBox box varid ira) => varid -> ira -> box
+ Data.Number.ER.Real.DomainBox: singleton :: (DomainBox box varid val) => varid -> val -> box
- Data.Number.ER.Real.DomainBox: toAscList :: (DomainBox box varid ira) => box -> [(varid, ira)]
+ Data.Number.ER.Real.DomainBox: toAscList :: (DomainBox box varid val) => box -> [(varid, val)]
- Data.Number.ER.Real.DomainBox: toList :: (DomainBox box varid ira) => box -> [(varid, ira)]
+ Data.Number.ER.Real.DomainBox: toList :: (DomainBox box varid val) => box -> [(varid, val)]
- Data.Number.ER.Real.DomainBox: unary :: (DomainBox box varid ira) => ira -> box
+ Data.Number.ER.Real.DomainBox: unary :: (DomainBox box varid val) => val -> box
- Data.Number.ER.Real.DomainBox: union :: (DomainBox box varid ira) => box -> box -> box
+ Data.Number.ER.Real.DomainBox: union :: (DomainBox box varid val) => box -> box -> box
- Data.Number.ER.Real.DomainBox: unionWith :: (DomainBox box varid ira) => (ira -> ira -> ira) -> box -> box -> box
+ Data.Number.ER.Real.DomainBox: unionWith :: (DomainBox box varid val) => (val -> val -> val) -> box -> box -> box
- Data.Number.ER.Real.DomainBox: zipWith :: (DomainBox box varid ira) => (ira -> ira -> a) -> box -> box -> [(varid, a)]
+ Data.Number.ER.Real.DomainBox: zipWith :: (DomainBox box varid val) => (val -> val -> a) -> box -> box -> [(varid, a)]
- Data.Number.ER.Real.DomainBox.IntMap: type Box ira = Map VarID ira
+ Data.Number.ER.Real.DomainBox.IntMap: type Box ira = IntMap ira
Files
- AERN-Real.cabal +5/−3
- ChangeLog +5/−0
- src/Data/Number/ER/Misc.hs +54/−13
- src/Data/Number/ER/Real.hs +6/−5
- src/Data/Number/ER/Real/Arithmetic/Elementary.hs +1/−1
- src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs +4/−2
- src/Data/Number/ER/Real/Base/CombinedMachineAP.hs +2/−2
- src/Data/Number/ER/Real/Base/Float.hs +3/−3
- src/Data/Number/ER/Real/Base/MachineDouble.hs +1/−1
- src/Data/Number/ER/Real/Base/Rational.hs +3/−3
- src/Data/Number/ER/Real/DomainBox.hs +61/−24
- src/Data/Number/ER/Real/DomainBox/IntMap.hs +94/−39
- tests/Demo.hs +138/−0
- tests/Test1.hs +0/−138
AERN-Real.cabal view
@@ -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
ChangeLog view
@@ -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
src/Data/Number/ER/Misc.hs view
@@ -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]
src/Data/Number/ER/Real.hs view
@@ -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
src/Data/Number/ER/Real/Arithmetic/Elementary.hs view
@@ -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 =
src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs view
@@ -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
src/Data/Number/ER/Real/Base/CombinedMachineAP.hs view
@@ -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)
src/Data/Number/ER/Real/Base/Float.hs view
@@ -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 }
src/Data/Number/ER/Real/Base/MachineDouble.hs view
@@ -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
src/Data/Number/ER/Real/Base/Rational.hs view
@@ -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
src/Data/Number/ER/Real/DomainBox.hs view
@@ -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@? -}-
src/Data/Number/ER/Real/DomainBox/IntMap.hs view
@@ -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))
+ tests/Demo.hs view
@@ -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)
− tests/Test1.hs
@@ -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)