packages feed

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