packages feed

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