AERN-Real 0.9.4 → 0.9.5
raw patch · 12 files changed
+386/−123 lines, 12 filesdep −haskell98PVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies removed: haskell98
API changes (from Hackage documentation)
- Data.Number.ER.BasicTypes: defaultVar :: VarID
- Data.Number.ER.BasicTypes: type Box ira = Map VarID ira
- Data.Number.ER.BasicTypes: type VarID = Int
+ Data.Number.ER.Real.Approx: eqSingletons :: (ERApprox ra) => ra -> ra -> Bool
+ Data.Number.ER.Real.Approx: equalIntervals :: (ERIntApprox ira) => ira -> ira -> Bool
+ Data.Number.ER.Real.Approx: isInteriorDisjoint :: (ERApprox ra) => ra -> ra -> Bool
+ Data.Number.ER.Real.Approx: leqSingletons :: (ERApprox ra) => ra -> ra -> Bool
+ Data.Number.ER.Real.Approx: ltSingletons :: (ERApprox ra) => ra -> ra -> Bool
+ Data.Number.ER.Real.DomainBox: bestSplit :: (DomainIntBox box varid ira) => box -> (varid, ira)
+ Data.Number.ER.Real.DomainBox: class (VariableID varid) => DomainBox box varid ira | box -> varid ira, varid ira -> box
+ Data.Number.ER.Real.DomainBox: class (DomainBox box varid ira) => DomainIntBox box varid ira | box -> varid ira, varid ira -> box
+ Data.Number.ER.Real.DomainBox: class (Ord varid) => VariableID varid
+ Data.Number.ER.Real.DomainBox: classifyPosition :: (DomainIntBox box varid ira) => box -> box -> (Bool, Bool, Bool, Bool)
+ Data.Number.ER.Real.DomainBox: compatible :: (DomainIntBox box varid ira) => box -> box -> Bool
+ Data.Number.ER.Real.DomainBox: defaultVar :: (VariableID varid) => varid
+ Data.Number.ER.Real.DomainBox: delete :: (DomainBox box varid ira) => varid -> box -> box
+ Data.Number.ER.Real.DomainBox: elems :: (DomainBox box varid ira) => box -> [ira]
+ Data.Number.ER.Real.DomainBox: findWithDefault :: (DomainBox box varid ira) => ira -> varid -> box -> ira
+ Data.Number.ER.Real.DomainBox: fold :: (DomainBox box varid ira) => (ira -> 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: fromAscList :: (DomainBox box varid ira) => [(varid, ira)] -> box
+ Data.Number.ER.Real.DomainBox: fromList :: (DomainBox box varid ira) => [(varid, ira)] -> box
+ Data.Number.ER.Real.DomainBox: fromMap :: (DomainBox box varid ira) => Map varid ira -> box
+ Data.Number.ER.Real.DomainBox: insert :: (DomainBox box varid ira) => varid -> ira -> box -> box
+ Data.Number.ER.Real.DomainBox: insertWith :: (DomainBox box varid ira) => (ira -> ira -> ira) -> varid -> ira -> box -> box
+ Data.Number.ER.Real.DomainBox: intersectionWith :: (DomainBox box varid ira) => (ira -> ira -> ira) -> box -> box -> box
+ Data.Number.ER.Real.DomainBox: isNoinfo :: (DomainBox box varid ira) => box -> Bool
+ Data.Number.ER.Real.DomainBox: keys :: (DomainBox box varid ira) => box -> [varid]
+ Data.Number.ER.Real.DomainBox: lookup :: (DomainBox box varid ira) => String -> varid -> box -> ira
+ Data.Number.ER.Real.DomainBox: map :: (DomainBox box varid ira) => (ira -> ira) -> box -> box
+ Data.Number.ER.Real.DomainBox: member :: (DomainBox box varid ira) => varid -> box -> Bool
+ Data.Number.ER.Real.DomainBox: newVarID :: (VariableID varid) => Set varid -> varid
+ Data.Number.ER.Real.DomainBox: noinfo :: (DomainBox box varid ira) => box
+ Data.Number.ER.Real.DomainBox: notMember :: (DomainBox box varid ira) => varid -> box -> Bool
+ Data.Number.ER.Real.DomainBox: showVar :: (VariableID varid) => varid -> String
+ Data.Number.ER.Real.DomainBox: singleton :: (DomainBox box varid ira) => varid -> ira -> box
+ Data.Number.ER.Real.DomainBox: toAscList :: (DomainBox box varid ira) => box -> [(varid, ira)]
+ Data.Number.ER.Real.DomainBox: toList :: (DomainBox box varid ira) => box -> [(varid, ira)]
+ Data.Number.ER.Real.DomainBox: toMap :: (DomainBox box varid ira) => box -> Map varid ira
+ Data.Number.ER.Real.DomainBox: unary :: (DomainBox box varid ira) => ira -> box
+ Data.Number.ER.Real.DomainBox: unify :: (DomainIntBox box varid ira) => String -> box -> box -> box
+ Data.Number.ER.Real.DomainBox: union :: (DomainBox box varid ira) => box -> box -> box
+ Data.Number.ER.Real.DomainBox: unionWith :: (DomainBox box varid ira) => (ira -> ira -> ira) -> 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.IntMap: instance (ERIntApprox ira) => DomainIntBox (Box ira) VarID ira
+ Data.Number.ER.Real.DomainBox.IntMap: instance (Show ira) => DomainBox (Box ira) VarID ira
+ Data.Number.ER.Real.DomainBox.IntMap: instance VariableID VarID
+ Data.Number.ER.Real.DomainBox.IntMap: type Box ira = Map VarID ira
+ Data.Number.ER.Real.DomainBox.IntMap: type VarID = Int
- Data.Number.ER.Real.Approx: bounds2ira :: (ERIntApprox ira) => ira -> ira -> ira
+ Data.Number.ER.Real.Approx: bounds2ira :: (ERIntApprox ira) => (ira, ira) -> ira
- Data.Number.ER.Real.Approx: class (Fractional ra, Ord ra) => ERApprox ra
+ Data.Number.ER.Real.Approx: class (Fractional ra) => ERApprox ra
- Data.Number.ER.Real.Approx.Elementary: class (ERIntApprox ra) => ERApproxElementary ra
+ Data.Number.ER.Real.Approx.Elementary: class (ERIntApprox ra, Ord ra) => ERApproxElementary ra
- Data.Number.ER.Real.Arithmetic.Elementary: erPow_IR :: (ERIntApprox ira) => EffortIndex -> Integer -> ira -> ira
+ Data.Number.ER.Real.Arithmetic.Elementary: erPow_IR :: (ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira
- Data.Number.ER.Real.Arithmetic.Elementary: erPow_R :: (ERIntApprox ira) => EffortIndex -> Integer -> ira -> ira
+ Data.Number.ER.Real.Arithmetic.Elementary: erPow_R :: (ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira
- Data.Number.ER.Real.Arithmetic.Elementary: erRoot_IR :: (ERIntApprox ira) => EffortIndex -> Integer -> ira -> ira
+ Data.Number.ER.Real.Arithmetic.Elementary: erRoot_IR :: (ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira
- Data.Number.ER.Real.Arithmetic.Elementary: erRoot_R :: (ERIntApprox ira) => EffortIndex -> Integer -> ira -> ira
+ Data.Number.ER.Real.Arithmetic.Elementary: erRoot_R :: (ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira
- Data.Number.ER.Real.Arithmetic.Elementary: erSqr_IR :: (ERIntApprox ira) => EffortIndex -> ira -> ira
+ Data.Number.ER.Real.Arithmetic.Elementary: erSqr_IR :: (ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira
- Data.Number.ER.Real.Arithmetic.Elementary: erSqr_R :: (ERIntApprox ira) => EffortIndex -> ira -> ira
+ Data.Number.ER.Real.Arithmetic.Elementary: erSqr_R :: (ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira
- Data.Number.ER.Real.Arithmetic.Elementary: erSqrt_IR :: (ERIntApprox ira) => EffortIndex -> ira -> ira
+ Data.Number.ER.Real.Arithmetic.Elementary: erSqrt_IR :: (ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira
- Data.Number.ER.Real.Arithmetic.Elementary: erSqrt_R :: (ERIntApprox ira) => EffortIndex -> ira -> ira
+ Data.Number.ER.Real.Arithmetic.Elementary: erSqrt_R :: (ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira
- Data.Number.ER.Real.Arithmetic.LinearSolver: linearSolver :: (ERIntApprox ira) => [(Map VarID ira, ira)] -> Box ira -> ira -> Maybe (Box ira)
+ Data.Number.ER.Real.Arithmetic.LinearSolver: linearSolver :: (ERIntApprox ira, DomainIntBox box varid ira) => [(box, ira)] -> box -> ira -> Maybe box
Files
- AERN-Real.cabal +7/−5
- ChangeLog +8/−1
- src/Data/Number/ER/BasicTypes.hs +0/−14
- src/Data/Number/ER/Misc.hs +1/−1
- src/Data/Number/ER/Real/Approx.hs +59/−57
- src/Data/Number/ER/Real/Approx/Elementary.hs +1/−1
- src/Data/Number/ER/Real/Approx/Interval.hs +3/−5
- src/Data/Number/ER/Real/Arithmetic/Elementary.hs +12/−12
- src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs +19/−23
- src/Data/Number/ER/Real/Base/Float.hs +6/−4
- src/Data/Number/ER/Real/DomainBox.hs +142/−0
- src/Data/Number/ER/Real/DomainBox/IntMap.hs +128/−0
AERN-Real.cabal view
@@ -1,5 +1,5 @@ Name: AERN-Real-Version: 0.9.4+Version: 0.9.5 Cabal-Version: >= 1.2 Build-Type: Simple License: BSD3@@ -9,7 +9,7 @@ Maintainer: mik@konecny.aow.cz Stability: experimental Category: Data, Math-Synopsis: datatypes and abstractions for approximating exact real numbers+Synopsis: arbitrary precision interval arithmetic for approximating exact real numbers Tested-with: GHC ==6.8.2 Description: Datatypes and abstractions for approximating exact real numbers@@ -56,10 +56,10 @@ hs-source-dirs: src if flag(containers-in-base) Build-Depends:- base < 3, binary >= 0.4, haskell98+ base < 3, binary >= 0.4 else Build-Depends:- base >= 3, containers, binary >= 0.4, haskell98+ base >= 3, containers, binary >= 0.4 Exposed-modules: Data.Number.ER, Data.Number.ER.Real,@@ -78,9 +78,11 @@ Data.Number.ER.Real.Approx.Elementary, Data.Number.ER.Real.Approx.Interval, Data.Number.ER.Real.Approx,+ Data.Number.ER.Real.DomainBox,+ Data.Number.ER.Real.DomainBox.IntMap, Data.Number.ER.PlusMinus, Data.Number.ER.BasicTypes, Data.Number.ER.Misc, Data.Number.ER.ExtendedInteger- Extensions: DeriveDataTypeable, ForeignFunctionInterface, ScopedTypeVariables+ Extensions: DeriveDataTypeable, ForeignFunctionInterface, ScopedTypeVariables, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances
ChangeLog view
@@ -1,4 +1,11 @@-0.9.4:+0.9.5: 24 July 2008+ * new operation for testing disjoing interiors+ * real approximations not automatically instances of Ord+ because comparison is not decidable in general;+ one should use the four-valued compareReals instead of <, =<, ==+ * removed rependency on haskell98++0.9.4: 15 July 2008 * fixed buggy formatting of floating point numbers * added a simple although inefficient linear solver
src/Data/Number/ER/BasicTypes.hs view
@@ -15,8 +15,6 @@ import qualified Data.Number.ER.ExtendedInteger as EI -import qualified Data.Map as Map- {-| Precision represents an upper bound on the measure of an approximation viewed as a set;@@ -70,16 +68,4 @@ gran2effIx :: Granularity -> EffortIndex gran2effIx = fromInteger . toInteger--{-| - A variable identifier for axes in function domains, polynomials etc.--}-type VarID = Int-defaultVar :: VarID-defaultVar = 0--{-|- A many-dimensional point or interval.--}-type Box ira = Map.Map VarID ira
src/Data/Number/ER/Misc.hs view
@@ -12,7 +12,7 @@ -} module Data.Number.ER.Misc where -import List+import Data.List import System.IO.Unsafe unsafePrint msg val =
src/Data/Number/ER/Real/Approx.hs view
@@ -33,7 +33,10 @@ effIx2ra, splitIRA, -- checkShrinking,--- eqSingletons,+ eqSingletons,+ leqSingletons,+ ltSingletons,+ equalIntervals, exactMiddle, maxExtensionR2R )@@ -48,7 +51,7 @@ A type whose elements represent sets that can be used to approximate a single extended real number with arbitrary precision. -}-class (Fractional ra, Ord ra) => ERApprox ra where+class (Fractional ra) => ERApprox ra where getPrecision :: ra -> Precision {-^ Precision is a measure of the set size.@@ -72,6 +75,11 @@ -- ^ true if this is a singleton isDisjoint :: ra -> ra -> Bool isDisjoint a b = isEmpty $ a /\ b+ isInteriorDisjoint :: ra -> ra -> Bool+ isInteriorDisjoint a b = + isEmpty isect || isExact isect + where+ isect = a /\ b isBounded :: ra -> Bool -- ^ true if the approximation excludes infinity bottomApprox :: ra @@ -110,34 +118,6 @@ String {-|- Assuming the arguments are singletons, equality is decidable.--}-eqSingletons :: (ERApprox ra) => ra -> ra -> Bool-eqSingletons s1 s2 = - case equalReals s1 s2 of - Just b -> b- _ -> False --{-|- Assuming the arguments are singletons, @<=@ is decidable.--}-leqSingletons :: (ERApprox ra) => ra -> ra -> Bool-leqSingletons s1 s2 = - case compareReals s1 s2 of - Just EQ -> True- Just LT -> True- _ -> False - -{-|- Assuming the arguments are singletons, @<@ is decidable.--}-ltSingletons :: (ERApprox ra) => ra -> ra -> Bool-ltSingletons s1 s2 = - case compareReals s1 s2 of - Just LT -> True- _ -> False - -{-| For a finite sequence of real approximations, determine whether it is a shrinking sequence. -} @@ -189,40 +169,62 @@ -} (\/) :: ira -> ira -> ira +{-| + Inverse of 'bounds'.+-} bounds2ira :: (ERIntApprox ira) =>- ira -> ira -> ira-bounds2ira = (\/)- -{- old stuff that will probably never be resurrected:---- It is intended that ra and ira are the same type.--- We distinguish them so that we can conveniently--- switch between two levels of abstraction when--- working with values of this one type. ------ Given some ra or ira, the other type is determined uniquely. + (ira, ira) -> ira+bounds2ira (a,b) = a \/ b --- -- | coercion to more concrete view (allows a more intentional computation)--- ra2ira :: ra -> ira--- -- | coercion to more abstract view (guarantees certain extensionality and convergence properties)--- ira2ra :: ira -> ra+{-|+ Assuming the arguments are singletons, equality is decidable.+-}+eqSingletons :: (ERApprox ra) => ra -> ra -> Bool+eqSingletons s1 s2 = + case equalReals s1 s2 of + Just b -> b+ _ -> False --- -- | coercion--- ira2sra :: ira -> sra --- sraCover :: sra -> ira--- sraAllIntervals :: sra -> [ira] -- ^ disjoint, in natural order+{-|+ Assuming the arguments are singletons, @<=@ is decidable. -}+leqSingletons :: (ERApprox ra) => ra -> ra -> Bool+leqSingletons s1 s2 = + case compareReals s1 s2 of + Just EQ -> True+ Just LT -> True+ _ -> False + +{-|+ Assuming the arguments are singletons, @<@ is decidable.+-}+ltSingletons :: (ERApprox ra) => ra -> ra -> Bool+ltSingletons s1 s2 = + case compareReals s1 s2 of + Just LT -> True+ _ -> False + +{-|+ Return true if and only if the two intervals have equal endpoints.+-}+equalIntervals ::+ (ERIntApprox ira) => ira -> ira -> Bool+equalIntervals d1 d2 =+ d1L == d2L && d1U == d2U+ where+ (==) = eqSingletons+ (d1L, d1U) = bounds d1+ (d2L, d2U) = bounds d2 ------bounds2ira :: --- (ERIntApprox ira) => --- ra -> --- ra -> --- ira---bounds2ira leftRA rightRA =--- (ra2ira leftRA) \/ (ra2ira rightRA) +{-| + This function converts+ an effort index to a real number approximation.+ + Useful when an effort index is used in a formula+ mixed with real approximations. +-} effIx2ra :: (ERApprox ra) => EffortIndex -> ra
src/Data/Number/ER/Real/Approx/Elementary.hs view
@@ -30,7 +30,7 @@ All operations here have default implementations based on "Data.Number.ER.Real.Arithmetic.Elementary". -}-class (RA.ERIntApprox ra) => (ERApproxElementary ra) +class (RA.ERIntApprox ra, Ord ra) => (ERApproxElementary ra) where abs :: EffortIndex -> ra -> ra abs ix = Prelude.abs
src/Data/Number/ER/Real/Approx/Interval.hs view
@@ -410,8 +410,6 @@ normaliseERInterval $ (ERInterval (- (B.setGranularity gr (-l))) (B.setGranularity gr r)) setGranularity _ i = i- {- isDisjoint -}- isDisjoint i1 i2 = RA.isEmpty $ i1 RA./\ i2 {- bottomApprox -} bottomApprox = ERIntervalAny {- emptyApprox -} @@ -486,21 +484,21 @@ where infinity = 1/0 doubleBounds ERIntervalEmpty = - error "SuiteERInterval: iraDoubleBounds: empty interval"+ error "ERInterval: doubleBounds: empty interval" doubleBounds (ERInterval l r) = (B.toDouble l, B.toDouble r) floatBounds ERIntervalAny = (- infinity, infinity) where infinity = 1/0 floatBounds ERIntervalEmpty = - error "SuiteERInterval: iraFloatBounds: empty interval"+ error "ERInterval: floatBounds: empty interval" floatBounds (ERInterval l r) = (B.toFloat l, B.toFloat r) integerBounds ERIntervalAny = (- infinity, infinity) where infinity = EI.PlusInfinity integerBounds ERIntervalEmpty = - error "SuiteERInterval: iraIntegerBounds: empty interval"+ error "ERInterval: integerBounds: empty interval" integerBounds (ERInterval l r) = (- (mkEI (- l)), mkEI r) where
src/Data/Number/ER/Real/Arithmetic/Elementary.hs view
@@ -51,13 +51,13 @@ -} erSqr_IR ::- (RA.ERIntApprox ira) =>+ (RA.ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira erSqr_IR = erSqr_R erSqr_R ::- (RA.ERIntApprox ira) =>+ (RA.ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira erSqr_R ix a@@ -74,14 +74,14 @@ -} erPow_IR ::- (RA.ERIntApprox ira) =>+ (RA.ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira erPow_IR = erPow_R erPow_R ::- (RA.ERIntApprox ira) =>+ (RA.ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira@@ -105,12 +105,12 @@ -} erSqrt_R ::- (RA.ERIntApprox ira) => + (RA.ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira erSqrt_R = erSqrtNewton_R erSqrt_IR ::- (RA.ERIntApprox ira) => + (RA.ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira erSqrt_IR = RA.maxExtensionR2R @@ -124,12 +124,12 @@ erSqrtContFr_R ::- (RA.ERIntApprox ira) => + (RA.ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira erSqrtContFr_R ix a | aR == 0 = 0 | aL == 1/0 = 1/0- | aR < 0 = RA.emptyApprox+ | aR `RA.ltSingletons` 0 = RA.emptyApprox | otherwise = contFrIter (ix + 3) $ RA.setMinGranularity gran $ max 0 (0 RA.\/ a) @@ -147,7 +147,7 @@ x_iPlus1 = contFrIter (i - 1) x_i erSqrtNewton_R ::- (RA.ERIntApprox ira) => + (RA.ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira erSqrtNewton_R ix a | RA.isEmpty a = RA.emptyApprox@@ -177,12 +177,12 @@ -} erRoot_R ::- (RA.ERIntApprox ira) => + (RA.ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira erRoot_R = erRootNewton_R erRoot_IR ::- (RA.ERIntApprox ira) => + (RA.ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira erRoot_IR ix p = RA.maxExtensionR2R @@ -195,7 +195,7 @@ | otherwise = [] erRootNewton_R ::- (RA.ERIntApprox ira) => + (RA.ERIntApprox ira, Ord ira) => EffortIndex -> Integer -> ira -> ira erRootNewton_R ix p a | RA.isEmpty a = RA.emptyApprox
src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs view
@@ -19,13 +19,17 @@ where 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.BasicTypes import Data.List import Data.Maybe-import qualified Data.Map as Map+--import qualified Data.Map as Map +-- the following is code for unit testing {-+ import Data.Number.ER.Real.DefaultRepr eq1 :: (Box IRA, IRA)@@ -44,14 +48,14 @@ -} linearSolver ::- (RA.ERIntApprox ira) =>- [(Map.Map VarID ira, ira)] + (RA.ERIntApprox ira, DomainIntBox box varid ira) =>+ [(box, ira)] {-^ the equations; each equation has coefficients of linear terms + constant term -} ->- Box ira {-^ the domain of the variables -} ->+ box {-^ the domain of the variables -} -> ira {-^ an upper bound on the size of an acceptable solution box -} ->- Maybe (Box ira) + Maybe box {-^ A box containing at least one solution within the domain; Nothing if there is no solution. @@ -64,10 +68,13 @@ linearSolver' eqns (b:bs) tolerance | not $ evalEqns b eqns = -- no solutions in the box linearSolver' eqns bs tolerance- | width (b Map.! (widestVar b)) < tolerance = + | belowTolerance = Just b | otherwise = - linearSolver' eqns (splitBox b ++ bs) tolerance + linearSolver' eqns (splitBox b ++ bs) tolerance+ where+ belowTolerance =+ and $ map (\d -> width d `RA.ltSingletons` tolerance) $ DBox.elems b evalEqns box eqns = and $ map (evalEqn box) eqns@@ -78,38 +85,27 @@ evalEqn box (expr,cons) = cons `RA.refines` (evalExpr expr box) where- evalExpr expr box = Map.fold (+) 0 $ Map.unionWith (*) expr box+ evalExpr expr box = sum $ DBox.elems $ DBox.intersectionWith (*) expr box {-| returns the list of (two) boxes resulting from splitting the widest edge of the box in half -} splitBox box =- [Map.insert k (iLg RA.\/ iMg) box, Map.insert k (iMg RA.\/ iRg) box]+ [DBox.insert k (iLg RA.\/ iMg) box, + DBox.insert k (iMg RA.\/ iRg) box] where iMg = (iLg+iRg)/2 iLg = incrementGranularity iL iRg = incrementGranularity iR (iL,iR) = RA.bounds i- i = box Map.! k+ i = DBox.lookup "ER: LinearSolver: splitBox: " k box k = widestVar box incrementGranularity x = RA.setMinGranularity (RA.getGranularity x + 1) x widestVar box =- fst $ maxm (head widthMap) $ tail widthMap- where- widthMap = - Map.assocs $ Map.map width box- maxm m [] = m- maxm m (x:xs) = - if mW < xW then - maxm x xs - else - maxm m xs- where- mW = snd m- xW = snd x+ fst $ DBox.bestSplit box width i = snd $ RA.bounds (iR-iL)
src/Data/Number/ER/Real/Base/Float.hs view
@@ -282,10 +282,12 @@ instance Ord ERFloat where {- compare NaN -}- compare _ (ERFloatNaN _) = - error "ERFloat: comparing NaN - aborting"- compare (ERFloatNaN _) _ = - error "ERFloat: comparing NaN - aborting"+ compare a b@(ERFloatNaN _) =+ unsafePrint ("ERFloat: comparing NaN: " ++ show a ++ " vs. " ++ show b) EQ +-- error $ "ERFloat: comparing NaN: " ++ show a ++ " vs. " ++ show b + compare a@(ERFloatNaN _) b = + unsafePrint ("ERFloat: comparing NaN: " ++ show a ++ " vs. " ++ show b) EQ +-- error $ "ERFloat: comparing NaN: " ++ show a ++ " vs. " ++ show b {- compare infty -} compare (ERFloatInfty gr1 pm1) (ERFloatInfty gr2 pm2) = compare pm1 pm2
+ src/Data/Number/ER/Real/DomainBox.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-|+ Module : Data.Number.ER.Real.DomainBox+ Description : portions of many-dimensional domains + Copyright : (c) Michal Konecny+ License : BSD3++ Maintainer : mik@konecny.aow.cz+ Stability : experimental+ Portability : portable++ Abstractions of the 'Box' datatype, often used to represent+ sections of multi-dimensional function domains.+ + To be imported qualified, usually with prefix DBox.+ + VariableID(..) and DomainBox + are usually imported separately and not qualified.+-}+module Data.Number.ER.Real.DomainBox +(+ VariableID(..),+ DomainBox(..),+ DomainIntBox(..)+)+where++import qualified Data.Number.ER.Real.Approx as RA++import Data.Number.ER.BasicTypes++import qualified Data.Set as Set+import qualified Data.Map as Map++import Prelude hiding (lookup)+++{-| + A class abstracting a type of variable identifiers + for axes in function domains, polynomials etc.+-}+class (Ord varid) => VariableID varid+ where+ newVarID :: Set.Set varid -> varid+ defaultVar :: varid+ defaultVar = newVarID Set.empty+ showVar :: varid -> String++{-|+ A class abstracting a type of many-dimensional points or intervals.+-}+class (VariableID varid) => DomainBox box varid ira+ | box -> varid ira, varid ira -> 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+ delete :: varid -> box -> box+ member :: varid -> box -> Bool+ notMember :: varid -> box -> Bool+ union :: box -> box -> box+ unionWith :: (ira -> ira -> ira) -> 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+ {-|+ Pick the extents of a single variable in a domain box.+ If there is no information for this variable, assume the+ variable ranges over the whole real line.+ -}+ lookup :: + String {-^ identification of caller location to use in error messages -} ->+ varid ->+ box ->+ ira+ + +{-|+ A class abstracting a type of many-dimensional intervals.+-}+class (DomainBox box varid ira) => DomainIntBox box varid ira+ | box -> varid ira, varid ira -> box+ where+ {-|+ Check whether the two domains specify the same+ interval for each variable that they share.+ -}+ compatible ::+ box ->+ box ->+ Bool+ {-|+ Assuming that two domains are compatible, take the+ most information from both of the domains about the+ ranges of variables.+ -}+ unify ::+ String {-^ identification of caller location to use in error messages -} ->+ box ->+ box ->+ box+ {-|+ Find the variable with the largest interval+ and return it together with the default splitting point+ in its domain.+ -}+ bestSplit ::+ box ->+ (varid, ira)+ classifyPosition ::+ box {-^ domain @d1@ -} ->+ box {-^ domain @d2@ -} ->+ (Bool, Bool, Bool, Bool) + {-^ + Answers to these (mutually exclusive) questions:+ + * is @d1@ outside and /not/ touching @d2@?+ + * is @d1@ outside and touching @d2@?+ + * is @d1@ intersecting and not inside @d2@?+ + * is @d1@ inside @d2@?+ -}++
+ src/Data/Number/ER/Real/DomainBox/IntMap.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-|+ Module : Data.Number.ER.Real.DomainBox.IntMap+ Description : implementation of DomainBox based on Data.Map + Copyright : (c) Michal Konecny+ License : BSD3++ Maintainer : mik@konecny.aow.cz+ Stability : experimental+ Portability : portable++ A simple implementation of the 'VariableID' and 'DomainBox' classes.+-}+module Data.Number.ER.Real.DomainBox.IntMap +(+ VarID, Box+)+where++import qualified Data.Number.ER.Real.Approx as RA+import Data.Number.ER.Real.DomainBox++import qualified Data.Map as Map+import qualified Data.Set as Set++type VarID = Int+type Box ira = Map.Map VarID ira++instance VariableID VarID+ where+ newVarID prevVars + | Set.null prevVars = 0+ | otherwise =+ 1 + (Set.findMax prevVars)+ showVar v = "x" ++ show v++instance (Show ira) => (DomainBox (Box ira) VarID ira)+ 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+ lookup locspec var dom =+ Map.findWithDefault err var dom+ where+ err =+ error $+ locspec ++ "DomainBox.IntMap lookup: domain box " ++ show dom + ++ " ignores variable " ++ show var++instance (RA.ERIntApprox ira) => DomainIntBox (Box ira) VarID ira+ where+ compatible dom1 dom2 =+ Map.fold (&&) True $+ Map.intersectionWith RA.equalIntervals dom1 dom2+ unify locspec dom1 dom2+ | compatible dom1 dom2 =+ Map.union dom1 dom2+ | otherwise =+ error $+ locspec ++ "incompatible domains " ++ show dom1 ++ " and " ++ show dom2+ bestSplit dom =+ (var, pt)+ where+ pt = + RA.defaultBisectPt varDom+ (_, (varDom, var)) = + foldl findWidestVar (0, err) $ Map.toList dom+ err =+ error $ "DomainBox: bestSplit: failed to find a split for " ++ show dom + findWidestVar (prevWidth, prevRes) (v, d)+ | currWidth `RA.leqSingletons` prevWidth = (prevWidth, prevRes)+ | otherwise = (currWidth, (d, v))+ where+ currWidth = snd $ RA.bounds $ domHI - domLO+ (domLO, domHI) = RA.bounds d+ classifyPosition dom sdom = + (away, touch, intersect, inside)+ where+ (away, touch, inside, intersect) =+ Map.fold addDimension (True, True, True, False) awayTouchInsides+ addDimension + (prevAway, prevTouch, prevInside, prevIntersect) + (thisAway, thisTouch, thisInside, thisIntersect) =+ (prevAway && thisAway, + (prevTouch || prevAway) && (thisTouch || thisAway) && (prevTouch || thisTouch),+ prevInside && thisInside,+ prevIntersect || thisIntersect)+ awayTouchInsides =+ Map.intersectionWith classifyRA dom sdom+ classifyRA d sd =+ (outsideNoTouch, outsideTouch, inside,+ not (outsideNoTouch || outsideTouch || inside))+ where+ outsideNoTouch = sdR < dL || dR < sdL+ outsideTouch = sdR == dL || dR == sdL+ inside = sdL =< dL && dR =< sdR+ (==) = RA.eqSingletons+ (<) = RA.ltSingletons+ (=<) = RA.leqSingletons+ (dL, dR) = RA.bounds d + (sdL, sdR) = RA.bounds sd + ++