AERN-RnToRm 0.4.9.1 → 0.5

raw patch · 57 files changed

+5234/−2182 lines, 57 filesdep ~AERN-RealPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: AERN-Real

API changes (from Hackage documentation)

Files

• AERN-RnToRm.cabal +51/−42
• ChangeLog +10/−0
• demos/Demo.hs +117/−0
• demos/ISin3.hs +54/−0
• src/Data/Number/ER/RnToRm.hs +2/−2
• src/Data/Number/ER/RnToRm/Approx.hs +35/−5
• src/Data/Number/ER/RnToRm/Approx/DomEdges.hs +6/−5
• src/Data/Number/ER/RnToRm/Approx/DomTransl.hs +38/−12
• src/Data/Number/ER/RnToRm/Approx/PieceWise.hs +5/−4
• src/Data/Number/ER/RnToRm/Approx/Tuple.hs +4/−3
• src/Data/Number/ER/RnToRm/BisectionTree.hs +72/−73
• src/Data/Number/ER/RnToRm/BisectionTree/Integration.hs +37/−37
• src/Data/Number/ER/RnToRm/BisectionTree/Path.hs +1/−1
• src/Data/Number/ER/RnToRm/DefaultRepr.hs +8/−4
• src/Data/Number/ER/RnToRm/TestingDefs.hs +4/−1
• src/Data/Number/ER/RnToRm/UnitDom/Approx.hs +2/−2
• src/Data/Number/ER/RnToRm/UnitDom/Approx/Interval.hs +132/−129
• src/Data/Number/ER/RnToRm/UnitDom/Approx/IntervalOI.hs +1086/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base.hs +335/−82
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Generate.hs +375/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Bounds.hs +54/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Common.hs +276/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Compose.hs +121/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Division.hs +88/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Elementary.hs +140/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Enclosure.hs +176/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Integration.hs +49/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Reduce.hs +44/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Ring.hs +70/−0
• src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Run.hs +134/−0
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom.hs +97/−16
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Basic.hs +5/−6
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Bounds.hs +330/−114
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Compose.hs +23/−5
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Derivative.hs +90/−0
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Division.hs +10/−7
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/DivisionInner.hs +78/−0
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Elementary.hs +96/−22
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/ElementaryInner.hs +415/−0
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Enclosure.hs +78/−57
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/EnclosureInner.hs +355/−0
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Eval.hs +2/−4
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Integration.hs +4/−20
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Reduce.hs +2/−2
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Ring.hs +72/−64
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Bounds.hs +0/−46
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Compose.hs +0/−114
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Division.hs +0/−78
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Elementary.hs +0/−120
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Enclosure.hs +0/−106
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Generate.hs +0/−592
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Reduce.hs +0/−37
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Ring.hs +0/−47
• src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Run.hs +0/−159
• tests/Demo.hs +0/−117
• tests/ISin3.hs +0/−47
• tests/RunPolynomTests.hs +51/−0

@@ -1,12 +1,13 @@ Name:           AERN-RnToRm-Version:        0.4.9.1+Version:        0.5 Cabal-Version:  >= 1.2 Build-Type:     Simple License:        BSD3 License-File:   LICENCE Author:         Michal Konecny (Aston University)-Copyright:      (c) 2007-2008 Michal Konecny-Maintainer:     mik@konecny.aow.cz+Copyright:      (c) 2007-2009 Michal Konecny, Jan Duracz+Maintainer:     mikkonecny@gmail.com+Homepage:       http://www-users.aston.ac.uk/~konecnym/DISCERN Stability:      experimental Category:       Data, Math Synopsis:       polynomial function enclosures (PFEs) approximating exact real functions@@ -32,49 +33,57 @@     with Taylor Models is included in the     paper <http://www-users.aston.ac.uk/~konecnym/papers/cfv08.html>.     .-    Simple examples of usage can be found in folder @tests@.+    Simple examples of usage can be found in folder @demos@+    and a test suite can be run via the module in the folder @tests@.+ Extra-source-files:-    tests/Demo.hs tests/ISin3.hs-Data-files:+    demos/Demo.hs demos/ISin3.hs+    tests/RunPolynomTests.hs     ChangeLog  Library   hs-source-dirs:  src   Build-Depends:-    AERN-Real >= 0.9.9, base >= 3, base < 4, containers, binary >= 0.4, html >= 1.0, QuickCheck >= 1.2, QuickCheck < 2, time, filepath, directory+    AERN-Real >= 0.10, AERN-Real < 0.10.1, base >= 3, base < 4, containers, binary >= 0.4, html >= 1.0, QuickCheck >= 1.2, QuickCheck < 2, time, filepath, directory   Exposed-modules:-    Data.Number.ER.RnToRm,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Integration,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Compose,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Eval,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Bounds,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Elementary,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Reduce,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Division,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Compose,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Bounds,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Ring,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Enclosure,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Elementary,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Reduce,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Division,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Run,-    Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom,-    Data.Number.ER.RnToRm.UnitDom.Base,-    Data.Number.ER.RnToRm.UnitDom.Approx.Interval,-    Data.Number.ER.RnToRm.UnitDom.Approx,-    Data.Number.ER.RnToRm.TestingDefs,-    Data.Number.ER.RnToRm.DefaultRepr,-    Data.Number.ER.RnToRm.BisectionTree.Integration,-    Data.Number.ER.RnToRm.BisectionTree.Path,-    Data.Number.ER.RnToRm.BisectionTree,-    Data.Number.ER.RnToRm.Approx.DomEdges,-    Data.Number.ER.RnToRm.Approx.DomTransl,-    Data.Number.ER.RnToRm.Approx.PieceWise,-    Data.Number.ER.RnToRm.Approx.Tuple,-    Data.Number.ER.RnToRm.Approx-+        Data.Number.ER.RnToRm,+        Data.Number.ER.RnToRm.Approx,+        Data.Number.ER.RnToRm.Approx.DomEdges,+        Data.Number.ER.RnToRm.Approx.DomTransl,+        Data.Number.ER.RnToRm.Approx.PieceWise,+        Data.Number.ER.RnToRm.Approx.Tuple,+        Data.Number.ER.RnToRm.BisectionTree,+        Data.Number.ER.RnToRm.BisectionTree.Integration,+        Data.Number.ER.RnToRm.BisectionTree.Path,+        Data.Number.ER.RnToRm.DefaultRepr,+        Data.Number.ER.RnToRm.TestingDefs,+        Data.Number.ER.RnToRm.UnitDom.Approx,+        Data.Number.ER.RnToRm.UnitDom.Approx.Interval,+        Data.Number.ER.RnToRm.UnitDom.Approx.IntervalOI,+        Data.Number.ER.RnToRm.UnitDom.Base,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Bounds,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Compose,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Division,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Elementary,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Enclosure,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Integration,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Reduce,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Ring,+        Data.Number.ER.RnToRm.UnitDom.Base.Tests.Run,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Bounds,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Compose,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Derivative,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Division,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.DivisionInner,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Elementary,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.ElementaryInner,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.EnclosureInner,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Eval,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Integration,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Reduce,+        Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring

@@ -1,3 +1,13 @@+0.5.0: 28 July 2009+    * Made the testing harness more generic so that it can be used+      for any base.  Also a readable report is produced for each+      tested property with statistics for timing and precision.+    * New support for anti-consistent function enclosures and twin arithmetic+      (analogous to directed/improper intervals such as [2,0] and+       outer+inner rounded Kaucher arithmetic over them).+    * Fixed many bugs.+    * Improved precision of enclosure comparison.+ 0.4.9.1: 24 February 2009: fixed errors in haddoc comments 0.4.9: 23 February 2009     * Added a quickcheck testing harness for the polynomial arithmetic core.

@@ -0,0 +1,117 @@+{-| +    Module      :  Main+    Description :  simple examples of using AERN-RnToRm+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable++    Simple examples of using AERN-RnToRm.+-}+module Main where++import qualified Data.Number.ER.RnToRm as AERNFunc+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox++import qualified Data.Number.ER.Real as AERN++import Data.Number.ER.Misc++type B = AERN.BM -- use machine double as a basis+type RA = AERN.RA B +type IRA = AERN.IRA B+type FAPWP = AERNFunc.FAPWP B ++-- function f(x) = x for x in [0,1]:+x :: FAPWP+x =+    AERNFunc.setMaxDegree 2 $+    AERNFunc.proj (DBox.fromAscList [(0,(0) AERN.\/ 1)]) 0+-- function f(x1) = x1 for x1 in [0,1]:+x1 :: FAPWP+x1 =+    AERNFunc.setMaxDegree 2 $+    AERNFunc.proj (DBox.fromAscList [(1,(0) AERN.\/ 1)]) 1++-- domains combined automatically:+fn1 :: FAPWP+fn1 = 2*x + x1++-- ensure the piecewise representation has 4 segments:+fn1depth2 :: FAPWP+fn1depth2 = AERNFunc.bisectUnbisectDepth 2 fn1++-- apply sine pointwise to the function enclosure:+fn2 :: FAPWP+fn2 = +--    AERN.sin 10 fn1depth2+    AERN.sin 15 fn1depth2++-- evaluate the function at point x = 0.1, x1 = 0.1:+fn2at0101 :: IRA+[fn2at0101] = +    AERNFunc.eval (DBox.fromList [(0,0.1), (1,0.1)]) fn2++-- partially evaluate fn2 at x1 = 1:+fn3 :: FAPWP+fn3 = AERNFunc.partialEval (DBox.fromList [(1,1)]) fn2++-- integrate fn3 by x with value 1 at origin x = 1:+fn4 :: FAPWP+fn4 = +    AERNFunc.integrate ix fn2 var span origin value+    where+    ix = 2 -- effort index+    var = 0+    span = DBox.noinfo -- integrate over the whole domain+    origin = 1+    value = 1++-- integrate fn2 by x1 with value (1 - x) at origin x1 = 0:+fn5 :: FAPWP+fn5 =+    AERNFunc.integrate ix fn2 var span origin value+    where+    ix = 2 -- effort index+    var = 1+    span = DBox.noinfo -- integrate over the whole domain+    origin = 0+    value = 1 - x+++main = +    do+    AERN.initialiseBaseArithmetic (0 :: RA)+    putStrLn "****************************************"+    putStrLn "Testing polynomial enclosure arithmetic:"+    putStrLn "****************************************"+    putStrLn "**** Projections:"+    putStrLn $+        "x =\n  " ++ show x+    putStrLn $+        "\nx1 =\n  " ++ show x1+    putStrLn "\n**** Merging domains:"+    putStrLn $+        "2*x + x1 =\n  " ++ showHead 12 fn1+    putStrLn "\n**** Bisection depth 2:"+    putStrLn $+        "2*x + x1 =\n  " ++ showHead 17 fn1depth2+    putStrLn "\n**** Elementary functions:"+    putStrLn $+        "sin(2*x + x1) =\n  " ++ showHead 17 fn2+    putStrLn "\n**** Evaluation:"+    putStrLn $+        "sin(2*x + x1)[x = 0.1, x1 = 0.1] = sin(0.3) = \n  " ++ show fn2at0101+    putStrLn "\n**** Partial evaluation:"+    putStrLn $+        "sin(2*x + x1)[x1 = 1] = sin(5*x + 1) = \n  " ++ showHead 15 fn3+    putStrLn "\n**** Integration of 1-dim function:"+    putStrLn $+        "f(x) = (Int sin(2*x + 1) dx) [f(1) = 1] =\n  " ++ showHead 15 fn4+    putStrLn "\n**** Integration of 2-dim function:"+    putStrLn $+        "f(x,x1) = (Int sin(2*x + x1) dx1) [f(x,1) = 1 - x] =\n  " ++ showHead 17 fn5++showHead n = showFirstLastLines n 0

@@ -0,0 +1,54 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Main++where++import qualified Data.Number.ER.Real as AERN+import qualified Data.Number.ER.RnToRm as AERNFunc+import Data.Number.ER.BasicTypes+import Data.Number.ER.Misc+import Data.Number.ER.RnToRm.TestingDefs++import Data.Maybe+import qualified Data.List as List+import qualified Data.Map as Map++#ifdef USE_MPFR+type B = AERN.BMPFR -- use MPFR floats+#else+type B = AERN.BAP -- use pure Haskell floats+--type B = AERN.BMAP -- use combination of double and pure Haskell floats+#endif+type RA = AERN.RA B+type IRA = AERN.IRA B++main =+    do+    AERN.initialiseBaseArithmetic (0 :: RA)+    putStrLn $ "ix = " ++ show ix ++ "; deg = " ++ show deg ++ "; gran = " ++ show gran+--    putStrLn $ "sin(sin(sin(x))) = " ++ show sin3+--    putStrLn $ "integ(sin(sin(sin(x)))dx = " ++ show integrSin3+    putStrLn $ "integ_0^1(sin(sin(sin(x)))dx] = " ++ show result+    putStrLn $ " precision = " ++ show (AERN.getPrecision result)+    where+    result = +        head $ AERNFunc.eval (AERNFunc.unary 1) integrSin3+    integrSin3 = +        AERNFunc.integrateUnary 0 sin3 (0 AERN.\/ 1) 0 [0]+    ix = 100+    deg = 50+    size = 1000+    gran = 5000+    depth = 0+    sin3 = +        AERN.sin ix $ +            AERN.sin ix $ +                AERN.sin ix $ +                    AERNFunc.bisectUnbisectDepth depth $ +                        AERNFunc.bisectUnbisectDepth depth $ +                            AERNFunc.setMaxSize size $ +                                AERNFunc.setMaxDegree deg fapwUPX0+

@@ -77,13 +77,13 @@ (     module Data.Number.ER.RnToRm.DefaultRepr,     module Data.Number.ER.RnToRm.Approx,-    module Data.Number.ER.Real.DomainBox+    module Data.Number.ER.BasicTypes.DomainBox ) where  import Data.Number.ER.RnToRm.DefaultRepr import Data.Number.ER.RnToRm.Approx-import Data.Number.ER.Real.DomainBox+import Data.Number.ER.BasicTypes.DomainBox  import qualified Data.Number.ER.RnToRm.UnitDom.Approx as UFA import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB

@@ -20,15 +20,16 @@     ERFnDomApprox(..),     bisectUnbisectDepth,     keyPointsConsistencyCheck,-    keyPointsPointwiseConsistencyCheck+    keyPointsPointwiseConsistencyCheck,+    ERFnApproxApprox(..) ) where  import Prelude hiding (const)  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 qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox) import Data.Number.ER.BasicTypes  import Data.Number.ER.Misc@@ -49,7 +50,7 @@     * two real number types (instances of 'RA.ERIntApprox') for working with parts of the function's domain and range;          * a type of boxes indexed by variables (instance of 'DomainBox') for working with-      parts of the function's domain.+      multiple-dimension function domains. -} class      (RA.ERApprox fa, RA.ERIntApprox fa, RA.ERIntApprox domra, RA.ERIntApprox ranra, @@ -397,4 +398,33 @@         [fResPt] = eval ptB fRes     isInConsistent (_, gResPt, fResPt) =         RA.isDisjoint gResPt fResPt-        +++{-|+    A class of types that approximate function enclosures of first-order real functions+    @R^n -> R^m@ eg using a pair of function enclosures.  The domains+    of the functions can be neither specified nor investigated +    by operations in this class.++    This class extends 'RA.ERApproxApprox' so that we could perform point-wise+    operations on the function enclosures.++    This class is associated with:+    +    * a real number type (instance of 'RA.ERIntApprox') for working with parts of the function's domain+    +    * a real number approximation approximation for approximating the function enclosure +      range at an individual point or uniformly over many points;+    +    * a type of boxes indexed by variables (instance of 'DomainBox') for working with+      multiple-dimension function domains.+-}+class +    (RA.ERIntApprox domra, RA.ERApproxApprox ranraa, +     DomainBox box varid domra) => +    ERFnApproxApprox box varid domra ranraa fa+    | fa -> box varid domra ranraa+    where+    evalAA :: box -> fa -> [ranraa]++    

@@ -25,11 +25,11 @@ import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Approx.Elementary as RAEL -import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox) import Data.Number.ER.BasicTypes import Data.Number.ER.Misc-import Data.Number.ER.PlusMinus+import Data.Number.ER.BasicTypes.PlusMinus  import Data.Number.ER.ShowHTML import qualified Text.Html as H@@ -226,8 +226,8 @@     	RA.initialiseBaseArithmetic (0 :: fa)     getGranularity (ERFnDomEdgesApprox mainEncl edges) =         RA.getGranularity mainEncl-    setGranularity gran = edgesLift1 (RA.setGranularity gran) -    setMinGranularity gran = edgesLift1 (RA.setMinGranularity gran)+    setGranularityOuter gran = edgesLift1 (RA.setGranularityOuter gran) +    setMinGranularityOuter gran = edgesLift1 (RA.setMinGranularityOuter gran)     f1 /\ f2 = edgesLift2 (RA./\) f1 f2     intersectMeasureImprovement ix              f1@(ERFnDomEdgesApprox mainEncl1 edges1) @@ -345,6 +345,7 @@     ranra2domra fa r =         FA.ranra2domra (erfnMainVolume fa) r     setMaxDegree maxDegree = edgesLift1 (FA.setMaxDegree maxDegree)+    setMaxSize maxSize = edgesLift1 (FA.setMaxSize maxSize)     getTupleSize (ERFnDomEdgesApprox mainEncl _) =         FA.getTupleSize mainEncl     tuple [] = error "ERFnDomEdgesApprox: FA.tuple: empty list"

@@ -29,8 +29,8 @@ import qualified Data.Number.ER.RnToRm.UnitDom.Approx as UFA import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Approx.Elementary as RAEL-import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainIntBox, DomainBoxMappable)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainIntBox, DomainBoxMappable) import Data.Number.ER.BasicTypes import Data.Number.ER.Misc @@ -149,7 +149,7 @@     (dL, dH) = RA.bounds dom     dHPdL = dH + dL     dHMdL = dH - dL-    dHMdLgr = RA.setMinGranularity 100 dHMdL+    dHMdLgr = RA.setMinGranularityOuter 100 dHMdL --    fromUnit x = (x * (dHMdL) + dHPdL) / 2  --    toUnit y = (2 * y - dHPdL) / dHMdL @@ -303,10 +303,11 @@     	RA.initialiseBaseArithmetic (0 :: ufa)     getGranularity (ERFnDomTranslApprox ufa dtrB) =         RA.getGranularity ufa-    setGranularity gran (ERFnDomTranslApprox ufa dtrB) =-        ERFnDomTranslApprox (RA.setGranularity gran ufa) dtrB-    setMinGranularity gran (ERFnDomTranslApprox ufa dtrB) =-        ERFnDomTranslApprox (RA.setMinGranularity gran ufa) dtrB+    setGranularityOuter gran (ERFnDomTranslApprox ufa dtrB) =+        ERFnDomTranslApprox (RA.setGranularityOuter gran ufa) dtrB+    setMinGranularityOuter gran (ERFnDomTranslApprox ufa dtrB) =+        ERFnDomTranslApprox (RA.setMinGranularityOuter gran ufa) dtrB+    isBottom = RA.isBottom . erfnUnitApprox     (ERFnDomTranslApprox ufa1 dtrB1) /\ (ERFnDomTranslApprox ufa2 dtrB2) =         ERFnDomTranslApprox (ufa1 RA./\ ufa2) (dtrUnion msg dtrB1 dtrB2)         where@@ -333,6 +334,16 @@                 compare dtrB1 dtrB2             ] +instance (RA.ERApproxApprox ufa) => +    RA.ERApproxApprox (ERFnDomTranslApprox dtrbox varid ufa domra)+    where+    safeIncludes fa1 fa2 =+        RA.safeIncludes (erfnUnitApprox fa1) (erfnUnitApprox fa2)+    safeNotIncludes fa1 fa2 =+        RA.safeNotIncludes (erfnUnitApprox fa1) (erfnUnitApprox fa2)+    includes fa1 fa2 =+        RA.includes (erfnUnitApprox fa1) (erfnUnitApprox fa2)+ instance     (UFA.ERUnitFnApprox box varid domra ranra ufa, RA.ERIntApprox ufa      , DomainBoxMappable dtrbox box varid (DomTransl domra) domra, Eq dtrbox, Ord dtrbox) =>@@ -363,6 +374,8 @@     where     abs ix (ERFnDomTranslApprox ufa dtrB) =         ERFnDomTranslApprox (RAEL.abs ix ufa) dtrB+    sqrt ix f@(ERFnDomTranslApprox ufa dtrB) =+        ERFnDomTranslApprox (RAEL.sqrt ix ufa) dtrB     exp ix f@(ERFnDomTranslApprox ufa dtrB) = --        unsafePrintReturn ("DomTransl: exp of " ++ show f ++ "\n = ") $         ERFnDomTranslApprox (RAEL.exp ix ufa) dtrB@@ -570,9 +583,9 @@             size = domRgr - domLgr             sizeLeft = ptGr - domLgr             sizeRight = domRgr - ptGr-            domRgr = RA.setMinGranularity gran $ FA.domra2ranra ufa domR-            domLgr = RA.setMinGranularity gran $ FA.domra2ranra ufa domL-            ptGr = RA.setMinGranularity gran $ FA.domra2ranra ufa pt+            domRgr = RA.setMinGranularityOuter gran $ FA.domra2ranra ufa domR+            domLgr = RA.setMinGranularityOuter gran $ FA.domra2ranra ufa domL+            ptGr = RA.setMinGranularityOuter gran $ FA.domra2ranra ufa pt     integrate             ix fD@(ERFnDomTranslApprox ufaD dtrBD) x integdomBox             origin fI@(ERFnDomTranslApprox ufaInit dtrBInit) =@@ -609,5 +622,18 @@             error $                 "DomTransl: faIntegrate: variable " ++ showVar x ++                 " not in the domain of the function " ++ show fD -            -            ++instance +    (DomainBoxMappable box dtrbox varid domra (DomTransl domra),+     FA.ERFnApproxApprox box varid domra ranraa ufa) =>+     FA.ERFnApproxApprox box varid domra ranraa (ERFnDomTranslApprox dtrbox varid ufa domra)+    where+    evalAA box (ERFnDomTranslApprox ufa dtrB) =+        FA.evalAA translBox ufa+        where+        translBox = domToUnit dtrB box+++++

@@ -36,8 +36,8 @@ import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Approx.Elementary as RAEL -import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox) import Data.Number.ER.BasicTypes import Data.Number.ER.Misc @@ -182,8 +182,8 @@     	RA.initialiseBaseArithmetic (0 :: fa)     getGranularity (ERFnPiecewise bistr) =         foldl max 10 $ map RA.getGranularity $ BISTR.collectValues bistr-    setGranularity gran = pwLift1 (RA.setGranularity gran) -    setMinGranularity gran = pwLift1 (RA.setMinGranularity gran)+    setGranularityOuter gran = pwLift1 (RA.setGranularityOuter gran) +    setMinGranularityOuter gran = pwLift1 (RA.setMinGranularityOuter gran)     f1 /\ f2 = pwLift2 (RA./\) 10 f1 f2     intersectMeasureImprovement ix f1@(ERFnPiecewise bistr1) f2@(ERFnPiecewise bistr2) = --        unsafePrint@@ -269,6 +269,7 @@         where         (fa : _) = BISTR.collectValues bistr     setMaxDegree maxDegree = pwLift1 (FA.setMaxDegree maxDegree)+    setMaxSize maxSize = pwLift1 (FA.setMaxSize maxSize)     getTupleSize (ERFnPiecewise bistr) =         FA.getTupleSize $ head $ BISTR.collectValues bistr     tuple fs =

@@ -25,7 +25,7 @@ import qualified Data.Number.ER.RnToRm.Approx as FA  import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Approx.Elementary as RAEL-import qualified Data.Number.ER.Real.DomainBox as DBox+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox import Data.Number.ER.BasicTypes import Data.Number.ER.Misc @@ -172,8 +172,8 @@     	RA.initialiseBaseArithmetic (0 :: fa)     getGranularity (ERFnTuple fas) =         foldl max 10 $ map RA.getGranularity fas-    setGranularity gran = tuplesLift1 (RA.setGranularity gran) -    setMinGranularity gran = tuplesLift1 (RA.setMinGranularity gran)+    setGranularityOuter gran = tuplesLift1 (RA.setGranularityOuter gran) +    setMinGranularityOuter gran = tuplesLift1 (RA.setMinGranularityOuter gran)     f1 /\ f2 = tuplesLift2 "ERFnTuple: /\\: " (RA./\) f1 f2     refines f1@(ERFnTuple fas1) f2@(ERFnTuple fas2) =         and $ zipWith RA.refines fas1 fas2@@ -242,6 +242,7 @@     ranra2domra (ERFnTuple (fa:_)) r =         FA.ranra2domra fa r     setMaxDegree maxDegree = tuplesLift1 (FA.setMaxDegree maxDegree)+    setMaxSize maxSize = tuplesLift1 (FA.setMaxSize maxSize)     getTupleSize (ERFnTuple fas) = length fas     tuple fs          | sameDomains doms = 

@@ -46,8 +46,8 @@ import qualified Prelude  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, DomainBoxMappable, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox) import Data.Number.ER.BasicTypes  import Data.Number.ER.Misc@@ -113,18 +113,18 @@ showBisectionTree showValue =     showB     where-    showB (Leaf depth dom val) =+    showB (Leaf depth domB val) =         "\n" ++         (concat (replicate (depth * 2) ".")) ++ "o "         ++-        (concatWith "," (Prelude.map showVD $ DBox.toList dom))+        (concatWith "," (Prelude.map showVD $ DBox.toList domB))         ++         " |---> " ++ showValue val-    showB (Node depth dom dir pt lo hi) =+    showB (Node depth domB dir pt lo hi) =         "\n" ++         (concat (replicate (depth * 2) ".")) ++ "o "         ++-        (concatWith "," (Prelude.map showVD $ DBox.toList dom))+        (concatWith "," (Prelude.map showVD $ DBox.toList domB))         ++         " //" ++ showVar dir ++ "\\\\"         ++@@ -135,10 +135,10 @@ instance (Show d, H.HTML v, DomainBox box varid d) =>      H.HTML (BisectionTree box varid d v)     where-    toHtml (Leaf depth dom val) =+    toHtml (Leaf depth domB val) =         H.toHtmlFromList $             [-                H.toHtml $ concatWith "," (Prelude.map showVD $ DBox.toList dom)+                H.toHtml $ concatWith "," (Prelude.map showVD $ DBox.toList domB)             ,                 H.primHtml " &rarr; "             , @@ -147,7 +147,7 @@         where         showVD (v,d) =             showVar v ++ " in " ++ show d-    toHtml (Node depth dom dir pt lo hi) =+    toHtml (Node depth domB dir pt lo hi) =         H.toHtml $         besidesTable [H.border 2]             [@@ -168,8 +168,8 @@     box ->     v ->     BisectionTree box varid d v     -const dom value =-    Leaf 0 dom value+const domB value =+    Leaf 0 domB value      {-|      value splitter function - parameters are: @@ -213,46 +213,46 @@     resultBistr     where     resultBistr = spl bistr-    spl (Leaf depth dom val) =-        Node depth dom splitDir splitPt childLO childHI+    spl (Leaf depth domB val) =+        Node depth domB splitDir splitPt childLO childHI         where         childLO =             Leaf depthInc domLO valLO         childHI =             Leaf depthInc domHI valHI          (valLO, valHI) = -            valSplitter ix depth dom val splitDir splitPt+            valSplitter ix depth domB val splitDir splitPt         depthInc = depth + 1         domLO = -            DBox.insert splitDir dirDomLO dom+            DBox.insert splitDir dirDomLO domB         domHI = -            DBox.insert splitDir dirDomHI dom+            DBox.insert splitDir dirDomHI domB         (dirDomLO, dirDomHI) =             RA.bisectDomain (Just splitPt) dirDom         dirDom =             DBox.findWithDefault                  (DBox.lookup "BisectionTree: split: fallbackDom: " splitDir fallbackDom)-                splitDir dom-    spl bistr@(Node depth dom dir pt childLO childHI)+                splitDir domB+    spl bistr@(Node depth domB dir pt childLO childHI)         | dir == splitDir =             case RA.compareReals pt splitPt of                 Just LT -> -- split on lower half-                    Node depth dom dir pt+                    Node depth domB dir pt                         (Node depthInc domChildLO splitDir splitPt childLOsplitLO childLOsplitHI)                         childHI                 Just GT -> -- split on higher half-                    Node depth dom dir pt+                    Node depth domB dir pt                         childLO                         (Node depthInc domChildHI splitDir splitPt childHIsplitLO childHIsplitHI)                 _ -> bistr         | otherwise = -- splitDir < dir =-            Node depth dom dir pt+            Node depth domB dir pt                 (Node                      depthInc domChildLO splitDir splitPt childLOsplitLO childLOsplitHI)                 (Node                      depthInc domChildHI splitDir splitPt childHIsplitLO childHIsplitHI)     --    | dir < splitDir =-    --        Node depth dom dir childLOsplit childHIsplit+    --        Node depth domB dir childLOsplit childHIsplit         where         depthInc = depth + 1         domChildLO = bistrDom childLO@@ -270,8 +270,8 @@     (box -> v1 -> v2) ->     BisectionTree box varid d v1 ->     BisectionTree box varid d v2-mapWithDom f bistr@(Leaf _ dom val) =-    bistr { bistrVal = f dom val }+mapWithDom f bistr@(Leaf _ domB val) =+    bistr { bistrVal = f domB val } mapWithDom f bistr@(Node _ _ _ _ cLO cHI) =     bistr          { @@ -286,7 +286,7 @@     (BisectionTree box varid d v1 -> BisectionTree box varid d v2) ->     BisectionTree box varid d v1 ->     BisectionTree box varid d v2-mapLeaves f bistr@(Leaf _ dom val) =+mapLeaves f bistr@(Leaf _ domB val) =     f bistr mapLeaves f bistr@(Node _ _ _ _ cLO cHI) =     bistr @@ -302,7 +302,7 @@     (BisectionTree box varid d v1 -> [BisectionTree box varid d v2]) ->     BisectionTree box varid d v1 ->     [BisectionTree box varid d v2]-mapMultiLeaves f bistr@(Leaf _ dom val) =+mapMultiLeaves f bistr@(Leaf _ domB val) =     f bistr mapMultiLeaves f bistr@(Node _ _ _ _ cLO cHI) =     Prelude.map (replaceChildren bistr) $ zip (mapMultiLeaves f cLO) (mapMultiLeaves f cHI)@@ -330,24 +330,24 @@         do         m lo         m hi-    m (Leaf _ dom val) =-        f dom val        +    m (Leaf _ domB val) =+        f domB val         doBistr f (Just maxDepth) bistr =     m maxDepth bistr     where-    m maxDepth (Node depth dom _ _ lo hi) +    m maxDepth (Node depth domB _ _ lo hi)          | maxDepth > 0 =             do             m (maxDepth - 1) lo             m (maxDepth - 1) hi         | otherwise =             error $ "BisectionTree: doBistr: maxDepth (=" ++ show maxDepth ++ ") breached"---            m err (Leaf depth dom val)+--            m err (Leaf depth domB val) --        where --        val = head $ collectValues lo --        err =  -    m _ (Leaf _ dom val) =-        f dom val+    m _ (Leaf _ domB val) =+        f domB val  {-|     Perform a given action on all branches of a bisection tree, left to right.@@ -366,14 +366,14 @@         newLo <- m lo         newHi <- m hi         return $ bistr { bistrLO = newLo, bistrHI = newHi }-    m bistr@(Leaf depth dom val) =+    m bistr@(Leaf depth domB val) =         do-        newVal <- f depth dom val+        newVal <- f depth domB val         return $ bistr { bistrVal = newVal } doMap f (Just maxDepth) bistr =     m maxDepth bistr     where-    m maxDepth bistr@(Node depth dom _ _ lo hi) +    m maxDepth bistr@(Node depth domB _ _ lo hi)          | maxDepth > 0 =             do             newLo <- m (maxDepth - 1) lo@@ -381,13 +381,13 @@             return $ bistr { bistrLO = newLo, bistrHI = newHi }         | otherwise =             error $ "BisectionTree: doBistr: maxDepth (=" ++ show maxDepth ++ ") breached"---            m err (Leaf depth dom val)+--            m err (Leaf depth domB val) --        where --        val = head $ collectValues lo --        err =  -    m _ bistr@(Leaf depth dom val) =+    m _ bistr@(Leaf depth domB val) =         do-        newVal <- f depth dom val+        newVal <- f depth domB val         return $ bistr { bistrVal = newVal }          {-|@@ -408,13 +408,13 @@         newLo <- m lo         newHi <- m hi         return $ bistr { bistrLO = newLo, bistrHI = newHi }-    m bistr@(Leaf depth dom val) =+    m bistr@(Leaf depth domB val) =         do         f bistr doMapLeaves f (Just maxDepth) bistr =     m maxDepth bistr     where-    m maxDepth bistr@(Node depth dom _ _ lo hi) +    m maxDepth bistr@(Node depth domB _ _ lo hi)          | maxDepth > 0 =             do             newLo <- m (maxDepth - 1) lo@@ -422,11 +422,11 @@             return $ bistr { bistrLO = newLo, bistrHI = newHi }         | otherwise =             error $ "BisectionTree: doBistr: maxDepth (=" ++ show maxDepth ++ ") breached"---            m err (Leaf depth dom val)+--            m err (Leaf depth domB val) --        where --        val = head $ collectValues lo --        err =  -    m _ bistr@(Leaf depth dom val) =+    m _ bistr@(Leaf depth domB val) =         do         f bistr @@ -439,12 +439,12 @@ removeVars substitutions bistr =     aux (bistrDepth bistr) bistr     where-    aux depth (Leaf _ dom val) =+    aux depth (Leaf _ domB val) =         Leaf depth domNoVars val         where         domNoVars =-            DBox.difference dom substitutions-    aux depth (Node _ dom v pt lo hi) +            DBox.difference domB substitutions+    aux depth (Node _ domB v pt lo hi)          | v `DBox.member` substitutions =             case (vVal `RA.refines` vDomLO, vVal `RA.refines` vDomHI) of                 (True, _) -> aux depth lo@@ -457,7 +457,7 @@         vDomHI = DBox.lookup loc v $ bistrDom hi         loc = "RnToRm.BisectionTree: removeVars: "         domNoVars =-            DBox.difference dom substitutions+            DBox.difference domB substitutions         loNoVars = aux (depth + 1) lo                     hiNoVars = aux (depth + 1) hi             @@ -480,10 +480,10 @@     case getPt bistr1 bistr2 of         Nothing ->              unifyDom bistr1 bistr2-        Just (var, pt, dom) ->+        Just (var, pt, domB) ->           unifyDom-            (split valSplitter1 ix var pt dom bistr1)-            (split valSplitter2 ix var pt dom bistr2)+            (split valSplitter1 ix var pt domB bistr1)+            (split valSplitter2 ix var pt domB bistr2)     where     getPt bistr1 bistr2          | isLeaf bistr1 && isLeaf bistr2 = Nothing@@ -492,10 +492,10 @@         | otherwise =             Just (bistrDir bistr1, bistrPt bistr1, bistrDom bistr1)       unifyDom bistr1 bistr2 =-        (bistr1 { bistrDom = dom }, -         bistr2 { bistrDom = dom })+        (bistr1 { bistrDom = domB }, +         bistr2 { bistrDom = domB })         where-        dom =+        domB =             DBox.unify "RnToRm.BisectionTree: sync: " dom1 dom2         dom1 = bistrDom bistr1          dom2 = bistrDom bistr2 @@ -516,19 +516,19 @@ syncMany valSplitter ix bistrs =     case getPt bistrs of         Nothing -> unifyDom bistrs-        Just (var, pt, dom) ->+        Just (var, pt, domB) ->           unifyDom $-            Prelude.map (split valSplitter ix var pt dom) bistrs+            Prelude.map (split valSplitter ix var pt domB) bistrs     where     getPt [] = Nothing     getPt (bistr : rest)          | isLeaf bistr = getPt rest         | otherwise = Just (bistrDir bistr, bistrPt bistr, bistrDom bistr)       unifyDom bistrs =-        Prelude.map (setDom dom) bistrs+        Prelude.map (setDom domB) bistrs         where-        setDom dom bistr = bistr { bistrDom = dom }-        dom = +        setDom domB bistr = bistr { bistrDom = domB }+        domB =              foldl (DBox.unify "RnToRm.BisectionTree: sync: ") DBox.noinfo $                 Prelude.map bistrDom bistrs          @@ -556,13 +556,13 @@     (bistr1sync, bistr2sync) =          sync2 valSplitter1 valSplitter2 ix bistr1 bistr2     combineAux-            bistr1@(Leaf _ dom val1) +            bistr1@(Leaf _ domB val1)              bistr2@(Leaf _ _ val2) =-        case f dom val1 val2 of+        case f domB val1 val2 of             (Nothing, aux) -> (Nothing, [aux])             (Just val, aux) -> (Just $ bistr1 { bistrVal = val }, [aux])     combineAux -            bistr1@(Node _ dom _ _ lo1 hi1)+            bistr1@(Node _ domB _ _ lo1 hi1)             bistr2@(Node _ _   _ _ lo2 hi2) =         (             Just $ bistr1 @@ -597,7 +597,7 @@ -}    collectDomValues ::     BisectionTree box varid d v -> [(box, v)]-collectDomValues (Leaf _ dom val) = [(dom,val)]+collectDomValues (Leaf _ domB val) = [(domB,val)] collectDomValues (Node _ _ _ _ cLO cHI) =     (collectDomValues cLO) ++ (collectDomValues cHI)    @@ -640,7 +640,7 @@     (BisectionTree box varid d v) ->     box {-^ domain to look up within the tree -} ->     [BisectionTree box varid d v]-lookupSubtreeDoms origBistr dom = +lookupSubtreeDoms origBistr domB =      lk origBistr     where     lk bistr@(Leaf _ _ _) = [bistr]@@ -651,10 +651,10 @@         where         loDisjoint =             and $ Prelude.map snd $ -                DBox.zipWithDefault RA.bottomApprox (RA.isDisjoint) dom domLO  +                DBox.zipWithDefault RA.bottomApprox (RA.isDisjoint) domB domLO           hiDisjoint =             and $ Prelude.map snd $ -                DBox.zipWithDefault RA.bottomApprox (RA.isDisjoint) dom domHI  +                DBox.zipWithDefault RA.bottomApprox (RA.isDisjoint) domB domHI           domLO = bistrDom lo         domHI = bistrDom hi @@ -695,18 +695,18 @@             mapLeaves updateLeaf bistr         | otherwise =              -- divide and conquer:-            Node depth dom dir pt bistrLdone bistrRdone +            Node depth domB dir pt bistrLdone bistrRdone          where         updateLeaf bistr =             bistr { bistrVal = updateFn (bistrDom bistr) (bistrVal bistr) }         noOverlap = -            or $ Prelude.map RA.isEmpty $ DBox.elems domOverlap+            or $ Prelude.map (not . RA.isConsistent) $ DBox.elems domOverlap         domOverlap = -            DBox.intersectionWith (RA./\) dom updateDom+            DBox.intersectionWith (RA./\) domB updateDom         insideUpdateDom = -            and $ Prelude.map snd $ DBox.zipWith RA.refines dom updateDom+            and $ Prelude.map snd $ DBox.zipWith RA.refines domB updateDom         edgeTouch =-            and $ Prelude.map snd $ DBox.zipWithDefaultSecond RA.bottomApprox endPointTouch dom updateDom+            and $ Prelude.map snd $ DBox.zipWithDefaultSecond RA.bottomApprox endPointTouch domB updateDom         endPointTouch i1 i2 =             i1L == i2R || i1R == i2L             where@@ -714,13 +714,12 @@             (i1L, i1R) = RA.bounds i1             (i2L, i2R) = RA.bounds i2                     depth = bistrDepth bistr-        dom = bistrDom bistr+        domB = bistrDom bistr         bistrLdone = upd bistrL         bistrRdone = upd bistrR         (Node _ _ _ _ bistrL bistrR)              | (isLeaf bistr) =                 split valSplitter ix dir pt DBox.noinfo bistr-            | otherwise = bistr -        (dir, pt) =-            DBox.bestSplit dom+            | otherwise = bistr+        (dir, (_,pt)) = DBox.bestSplit domB         

@@ -19,8 +19,8 @@ import qualified Data.Number.ER.RnToRm.BisectionTree as BISTR 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 qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox) import Data.Number.ER.BasicTypes import Data.Number.ER.Misc @@ -89,18 +89,18 @@                 True -> DBox.insertWith (RA.\/) ivar origin domB                 False -> domB     -- the following function is used when we know the origin is within the current sub-domain:-    integrateBistrOriginHere bistrs@((BISTR.Leaf depth dom _) : _)-        | decideShouldSplit ix depth dom vals integrVals =  -- must descend+    integrateBistrOriginHere bistrs@((BISTR.Leaf depth domB _) : _)+        | decideShouldSplit ix depth domB vals integrVals =  -- must descend             integrateBistrOriginHere $ -                map (BISTR.split valSplitter ix var pt dom) bistrs+                map (BISTR.split valSplitter ix var pt domB) bistrs         | otherwise =-            (Just lVal, map (\v -> BISTR.Leaf depth dom v) integrVals, Just rVal)+            (Just lVal, map (\v -> BISTR.Leaf depth domB v) integrVals, Just rVal)         where-        (var, pt) = DBox.bestSplit dom+        (var, (_,pt)) = DBox.bestSplit domB         vals = map BISTR.bistrVal bistrs         (lVal, integrVals, rVal) =-            integrLeafOH ix depth dom vals-    integrateBistrOriginHere bistrs@((BISTR.Node depth dom var pt lBounds rBounds):_)+            integrLeafOH ix depth domB vals+    integrateBistrOriginHere bistrs@((BISTR.Node depth domB var pt lBounds rBounds):_)         | origin `RA.refines` rDom = --            unsafePrint  --                ("BTINTEG: integrateBistrOriginHere: rDom = " ++ show rDom ++ @@ -118,14 +118,14 @@         | otherwise = -- origin overlaps both sides             -- have to amalgamate these trees:             integrateBistrOriginHere $-                map (\b -> BISTR.Leaf depth dom (valCombiner ix depth b)) bistrs+                map (\b -> BISTR.Leaf depth domB (valCombiner ix depth b)) bistrs         where         lDom = DBox.lookup "BTINTEG: zipFromOrigin: Here: L: " var (BISTR.bistrDom lBounds)         rDom = DBox.lookup "BTINTEG: zipFromOrigin: Here: R: " var (BISTR.bistrDom rBounds)         -- recursion when origin is entirely to the right of the centre:         bistrsIntgHI =              zipWith -                (\lo hi -> BISTR.Node depth dom var pt lo hi) +                (\lo hi -> BISTR.Node depth domB var pt lo hi)                  lBoundsIntgHI rBoundsIntgHI          (lValHIHI, rBoundsIntgHI, rValHI) =             integrateBistrOriginHere $ @@ -137,7 +137,7 @@         -- recursion when origin is entirely to the left of the centre:         bistrsIntgLO =              zipWith -                (\lo hi -> BISTR.Node depth dom var pt lo hi) +                (\lo hi -> BISTR.Node depth domB var pt lo hi)                  lBoundsIntgLO rBoundsIntgLO          (lValLO, lBoundsIntgLO, rValLOLO) =             integrateBistrOriginHere $ @@ -159,23 +159,23 @@                     (fromJust maybeSupport)) =              -- outside the integration domain              (outerValTransformer (Just lVal) Nothing bistrs, Nothing)-    integrateBistrOriginLeft (Just lVal) bistrs@((BISTR.Leaf depth dom _) : _)-        | decideShouldSplit ix depth dom vals integrVals = -- improve granularity by splitting+    integrateBistrOriginLeft (Just lVal) bistrs@((BISTR.Leaf depth domB _) : _)+        | decideShouldSplit ix depth domB vals integrVals = -- improve granularity by splitting             integrateBistrOriginLeft (Just lVal) $ -                map (BISTR.split valSplitter ix var pt dom) bistrs+                map (BISTR.split valSplitter ix var pt domB) bistrs         | otherwise = -            (map (\v -> BISTR.Leaf depth dom v) integrVals, +            (map (\v -> BISTR.Leaf depth domB v) integrVals,               Just rVal)         where-        (var, pt) = DBox.bestSplit dom+        (var, (_,pt)) = DBox.bestSplit domB         vals = map BISTR.bistrVal bistrs         (integrVals, rVal) =-            integrLeafOL ix depth dom lVal vals-    integrateBistrOriginLeft mlVal bistrs@((BISTR.Node depth dom var pt _ _):_) =+            integrLeafOL ix depth domB lVal vals+    integrateBistrOriginLeft mlVal bistrs@((BISTR.Node depth domB var pt _ _):_) =         (bistrsIntg, mrVal2)         where         bistrsIntg = -            zipWith (\lo hi -> BISTR.Node depth dom var pt lo hi) lBoundsINT rBoundsINT +            zipWith (\lo hi -> BISTR.Node depth domB var pt lo hi) lBoundsINT rBoundsINT          (lBoundsINT, mrVal1) =              integrateBistrOriginLeft mlVal $                  BISTR.syncMany valSplitter ix $ map BISTR.bistrLO bistrs @@ -195,24 +195,24 @@                     (fromJust maybeSupport)) =              -- outside the integration domain              (Nothing, outerValTransformer Nothing (Just rVal) bistrs)-    integrateBistrOriginRight bistrs@((BISTR.Leaf depth dom _) : _) (Just rVal)-        | decideShouldSplit ix depth dom vals integrVals = -- improve granularity by splitting+    integrateBistrOriginRight bistrs@((BISTR.Leaf depth domB _) : _) (Just rVal)+        | decideShouldSplit ix depth domB vals integrVals = -- improve granularity by splitting             integrateBistrOriginRight -                (map (BISTR.split valSplitter ix var pt dom) bistrs)+                (map (BISTR.split valSplitter ix var pt domB) bistrs)                 (Just rVal)         | otherwise =              (Just lVal,-             map (\v -> BISTR.Leaf depth dom v) integrVals)+             map (\v -> BISTR.Leaf depth domB v) integrVals)         where-        (var, pt) = DBox.bestSplit dom+        (var, (_,pt)) = DBox.bestSplit domB         vals = map BISTR.bistrVal bistrs         (lVal, integrVals) =-            integrLeafOR ix depth dom vals rVal-    integrateBistrOriginRight bistrs@((BISTR.Node depth dom var pt _ _):_) mrVal =+            integrLeafOR ix depth domB vals rVal+    integrateBistrOriginRight bistrs@((BISTR.Node depth domB var pt _ _):_) mrVal =         (mlVal2, bistrsIntg)         where         bistrsIntg = -            zipWith (\lo hi -> BISTR.Node depth dom var pt lo hi) lBoundsINT rBoundsINT +            zipWith (\lo hi -> BISTR.Node depth domB var pt lo hi) lBoundsINT rBoundsINT          (mlVal2, lBoundsINT) =              integrateBistrOriginRight                  (BISTR.syncMany valSplitter ix $ map BISTR.bistrLO bistrs) mlVal1 @@ -247,32 +247,32 @@         {-^ what to do with values /outside/ @sd@ -} ->     [BISTR.BisectionTree box varid d v1] ->     [BISTR.BisectionTree box varid d v2]-zipOnSubdomain valSplitter ix maxDepth sdom updateInside updateTouch updateAway bistrs =+zipOnSubdomain valSplitter ix maxDepth sdomB updateInside updateTouch updateAway bistrs =     resultBistrs     where     resultBistrs =          zz $ BISTR.syncMany valSplitter ix bistrs-    zz bistrs@(BISTR.Leaf depth dom _ : _) +    zz bistrs@(BISTR.Leaf depth domB _ : _)          | intersect =              case depth < maxDepth of                 True ->-                    zz $ map (BISTR.split valSplitter ix var pt dom) bistrs  +                    zz $ map (BISTR.split valSplitter ix var pt domB) bistrs                   False ->                     error "BTINTEG: zipOnSubdomain: maxDepth reached but irregular splitting not implemented yet"         | away = lift updateAway         | touch = lift updateTouch         | inside = lift updateInside         where-        (var, pt) = DBox.bestSplit dom+        (var, (_,pt)) = DBox.bestSplit domB         lift updateFn =-            map (BISTR.Leaf depth dom) $ -                updateFn dom $ +            map (BISTR.Leaf depth domB) $ +                updateFn domB $                      map BISTR.bistrVal bistrs         (away, touch, intersect, inside) =-            DBox.classifyPosition dom sdom-    zz bistrs@(BISTR.Node depth dom var pt _ _ : _) =+            DBox.classifyPosition domB sdomB+    zz bistrs@(BISTR.Node depth domB var pt _ _ : _) =         zipWith -            (\bLO bHI -> BISTR.Node depth dom var pt bLO bHI) +            (\bLO bHI -> BISTR.Node depth domB var pt bLO bHI)              (zz $ map BISTR.bistrLO bistrs)              (zz $ map BISTR.bistrHI bistrs)  

@@ -16,7 +16,7 @@  import qualified Data.Number.ER.RnToRm.Approx as FA import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.Real.DomainBox (VariableID(..))+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..)) import Data.Number.ER.BasicTypes  import Data.Typeable

@@ -27,7 +27,7 @@ module Data.Number.ER.RnToRm.DefaultRepr (     module Data.Number.ER.RnToRm.DefaultRepr,-    module Data.Number.ER.Real.DomainBox.IntMap+    module Data.Number.ER.BasicTypes.DomainBox.IntMap ) where @@ -36,14 +36,15 @@ import qualified Data.Number.ER.RnToRm.UnitDom.Approx as UFA import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Approx.Elementary as RAEL-import qualified Data.Number.ER.Real.DomainBox as DBox+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox import Data.Number.ER.BasicTypes -import Data.Number.ER.Real.DomainBox.IntMap+import Data.Number.ER.BasicTypes.DomainBox.IntMap  import Data.Number.ER.RnToRm.UnitDom.Base import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom import Data.Number.ER.RnToRm.UnitDom.Approx.Interval+import Data.Number.ER.RnToRm.UnitDom.Approx.IntervalOI import Data.Number.ER.RnToRm.Approx.DomTransl import Data.Number.ER.RnToRm.Approx.DomEdges import Data.Number.ER.RnToRm.Approx.Tuple@@ -53,8 +54,11 @@  import qualified Data.Map as Map -type FAPU b = ERFnInterval (ERChebPoly (Box Int) b) (IRA b)+type P b = ERChebPoly (Box Int) b+type FAPU b = ERFnInterval (P b)+type FAPUOI b = ERFnIntervalOI (P b) type FAPD b = ERFnDomTranslApprox (Box (DomTransl (IRA b))) VarID (FAPU b) (IRA b)+type FAPDOI b = ERFnDomTranslApprox (Box (DomTransl (IRA b))) VarID (FAPUOI b) (IRA b) type FAPT b = ERFnTuple (FAPD b) type FAPE b = ERFnDomEdgesApprox VarID (FAPT b) type FAPWP b = ERFnPiecewise (Box (IRA b)) VarID (IRA b) (FAPE b)

@@ -19,7 +19,10 @@ import qualified Data.Number.ER.RnToRm.UnitDom.Approx as UFA import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Approx.Elementary as RAEL-import qualified Data.Number.ER.Real.DomainBox as DBox+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox++import Data.Number.ER.Real.Approx.Interval+import Data.Number.ER.Misc  import qualified Data.Map as Map 

@@ -25,8 +25,8 @@  import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.RnToRm.Approx as FA-import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox) import Data.Number.ER.BasicTypes  import Data.Number.ER.Misc

@@ -21,7 +21,9 @@ module Data.Number.ER.RnToRm.UnitDom.Approx.Interval  (     ERFnInterval(..),-    ERFnContext(..)+    ERFnContext(..),+    erfnContextDefault,+    erfnContextUnify ) where @@ -36,8 +38,8 @@ import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Approx.Elementary as RAEL -import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox) import Data.Number.ER.BasicTypes  import Data.Number.ER.Misc@@ -60,7 +62,7 @@ --fapuConst2 = (UFA.const 0 [2]) :: FAPU {- end of testing specific code -} -data ERFnInterval fb ra =+data ERFnInterval fb =     ERFnIntervalAny      {         erfnContext :: ERFnContext@@ -70,19 +72,23 @@     {         erfnLowerNeg :: fb,         erfnUpper :: fb,-        erfnContext :: ERFnContext,-        erfnGlobal :: ra+        erfnContext :: ERFnContext+--        ,+--        erfnIsDefinitelyConsistent :: Bool,+--        erfnIsDefinitelyAntiConsistent :: Bool     }     deriving (Typeable, Data) -instance (Binary a, Binary b) => Binary (ERFnInterval a b) where+instance (Binary a) => Binary (ERFnInterval a) where   put (ERFnIntervalAny a) = putWord8 0 >> put a-  put (ERFnInterval a b c d) = putWord8 1 >> put a >> put b >> put c >> put d+  put (ERFnInterval a b c) = putWord8 1 >> put a >> put b >> put c+--  put (ERFnInterval a b c d e) = putWord8 1 >> put a >> put b >> put c >> put d >> put e   get = do     tag_ <- getWord8     case tag_ of       0 -> get >>= \a -> return (ERFnIntervalAny a)-      1 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (ERFnInterval a b c d)+      1 -> get >>= \a -> get >>= \b -> get >>= \c -> return (ERFnInterval a b c)+--      1 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> return (ERFnInterval a b c d e)       _ -> fail "no parse"      @@ -114,11 +120,13 @@      instance      (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>-    Show (ERFnInterval fb ra)+    Show (ERFnInterval fb)     where     show (ERFnIntervalAny _) = "ERFnIntervalAny"-    show (ERFnInterval ln h ctxt gl) =-        "\nERFnInterval"+    show (ERFnInterval ln h ctxt) =+        "\nERFnInterval {" ++ show ctxt ++ "}"+--        ++ " (definitely consistent: " ++ show isC +--        ++ "anticonsistent: " ++ show isAC ++ ")"         ++ "\n  upper = " ++ ufbShow h         ++ "\n  lower = " ++ ufbShow (UFB.neg ln) --        ++ "  global = " ++ show gl ++ "\n"@@ -128,11 +136,11 @@  instance     (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>-    H.HTML (ERFnInterval fb ra)+    H.HTML (ERFnInterval fb)     where     toHtml (ERFnIntervalAny ctxt) =         H.toHtml "ERFnIntervalAny"-    toHtml (ERFnInterval ln h ctxt gl) =+    toHtml (ERFnInterval ln h ctxt) = --        H.toHtml $ --            abovesTable --                [@@ -148,37 +156,37 @@  instance     (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>-    Eq (ERFnInterval fb ra)+    Eq (ERFnInterval fb)     where-    (ERFnInterval ln1 h1 ctxt1 gl1) -            == (ERFnInterval ln2 h2 ctxt2 gl2) =+    (ERFnInterval ln1 h1 ctxt1) +            == (ERFnInterval ln2 h2 ctxt2) =         error "ERFnInterval: equality not implemented"     _ == _ =         error "ERFnInterval: equality not implemented"  instance      (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>-    Ord (ERFnInterval fb ra) +    Ord (ERFnInterval fb)      where     compare -            (ERFnInterval ln1 h1 ctxt1 gl1) -            (ERFnInterval ln2 h2 ctxt2 gl2) =+            (ERFnInterval ln1 h1 ctxt1) +            (ERFnInterval ln2 h2 ctxt2) =         error "ERFnInterval: comparison not implemented; consider leqReals or compareApprox from class ERApprox instead"     compare _ _ =         error "ERFnInterval: comparison not implemented; consider leqReals or compareApprox from class ERApprox instead"           instance -    (UFB.ERUnitFnBase boxb boxra varid b ra fb, Show varid, Show boxra) =>-    Num (ERFnInterval fb ra)+    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, Show varid, Show boxra) =>+    Num (ERFnInterval fb)     where     fromInteger n = UFA.const [fromInteger n]     negate f@(ERFnIntervalAny _) = f-    negate (ERFnInterval ln h ctxt gl) =-        (ERFnInterval h ln ctxt (negate gl))-    (ERFnInterval ln1 h1 ctxt1 gl1) + (ERFnInterval ln2 h2 ctxt2 gl2) =+    negate (ERFnInterval ln h ctxt) =+        (ERFnInterval h ln ctxt)+    (ERFnInterval ln1 h1 ctxt1) + (ERFnInterval ln2 h2 ctxt2) =         normalise $-        ERFnInterval (reduceSzUp ln) (reduceSzUp h) ctxt (gl1 + gl2)+        ERFnInterval (reduceSzUp ln) (reduceSzUp h) ctxt         where         ln = ln1 +^ ln2         h = h1 +^ h2@@ -188,9 +196,9 @@     f1 + f2 = ERFnIntervalAny ctxt         where         ctxt = erfnContextUnify (erfnContext f1) (erfnContext f2)-    (ERFnInterval ln1 h1 ctxt1 gl1) * (ERFnInterval ln2 h2 ctxt2 gl2) =+    (ERFnInterval ln1 h1 ctxt1) * (ERFnInterval ln2 h2 ctxt2) =         normalise $-        ERFnInterval ln h ctxt (gl1 * gl2)+        ERFnInterval ln h ctxt         where         (ln, h) = multiplyEncl maxDegr maxSize (ln1, h1) (ln2, h2)         maxDegr = erfnMaxDegree ctxt@@ -201,15 +209,15 @@         ctxt = erfnContextUnify (erfnContext f1) (erfnContext f2)          instance -    (UFB.ERUnitFnBase boxb boxra varid b ra fb, Show varid, Show boxra) =>-    Fractional (ERFnInterval fb ra)+    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, Show varid, Show boxra) =>+    Fractional (ERFnInterval fb)     where     fromRational r = UFA.const [fromRational r]     recip f@(ERFnIntervalAny _) = f-    recip (ERFnInterval ln h ctxt gl)+    recip (ERFnInterval ln h ctxt)         | certainNoZero =             normalise $-            ERFnInterval lnR hR ctxt (recip gl)+            ERFnInterval lnR hR ctxt         | otherwise = ERFnIntervalAny ctxt         where         (hR, lnR) = UFB.recipEncl maxDegr maxSize ix (h,ln)@@ -228,31 +236,31 @@         ix = int2effIx $ 3 * maxDegr           instance-    (UFB.ERUnitFnBase boxb boxra varid b ra fb, Show varid, Show boxra) =>-    RA.ERApprox (ERFnInterval fb ra) +    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, Show varid, Show boxra) =>+    RA.ERApprox (ERFnInterval fb)      where     initialiseBaseArithmetic _ =     	UFB.initialiseBaseArithmetic (UFB.const 0 :: fb)     getGranularity (ERFnIntervalAny ctxt) = erfnCoeffGranularity ctxt-    getGranularity (ERFnInterval ln h ctxt gl) =+    getGranularity (ERFnInterval ln h ctxt) =         max (erfnCoeffGranularity ctxt) $              max (UFB.getGranularity ln) (UFB.getGranularity h)-    setGranularity gran (ERFnIntervalAny ctxt) = +    setGranularityOuter gran (ERFnIntervalAny ctxt) =          ERFnIntervalAny $ ctxt { erfnCoeffGranularity = gran }-    setGranularity gran (ERFnInterval ln h ctxt gl) =+    setGranularityOuter gran (ERFnInterval ln h ctxt) =         ERFnInterval              (UFB.setGranularity gran ln) (UFB.setGranularity gran h) -            (ctxt { erfnCoeffGranularity = gran }) gl-    setMinGranularity gran (ERFnIntervalAny ctxt) = +            (ctxt { erfnCoeffGranularity = gran })+    setMinGranularityOuter gran (ERFnIntervalAny ctxt) =          ERFnIntervalAny             (ctxt { erfnCoeffGranularity = max gran (erfnCoeffGranularity ctxt) })-    setMinGranularity gran (ERFnInterval ln h ctxt gl) =+    setMinGranularityOuter gran (ERFnInterval ln h ctxt) =         ERFnInterval              (UFB.setMinGranularity gran ln) (UFB.setMinGranularity gran h) -            (ctxt { erfnCoeffGranularity = max gran (erfnCoeffGranularity ctxt) }) gl+            (ctxt { erfnCoeffGranularity = max gran (erfnCoeffGranularity ctxt) }) --    getPrecision (ERFnIntervalAny _) = 0 --    getPrecision f = intLog 2 (1 + (fst $ RA.integerBounds (FA.volume f))) -- wrong! -    f1@(ERFnInterval ln1 h1 ctxt1 gl1) /\ f2@(ERFnInterval ln2 h2 ctxt2 gl2) =+    f1@(ERFnInterval ln1 h1 ctxt1) /\ f2@(ERFnInterval ln2 h2 ctxt2) = ---- #ifdef RUNTIME_CHECKS ----         check ("ERFnInterval: /\\:\n f1:\n" ++ show f1 ++ " f2:\n" ++ show f2 ++ "\n result:\n") $ ---- #endif@@ -260,17 +268,17 @@         ERFnInterval              (UFB.minUp maxDegr maxSize ln1 ln2)              (UFB.minUp maxDegr maxSize h1 h2) -            ctxt (gl1 RA./\ gl2)+            ctxt         where         ctxt = erfnContextUnify ctxt1 ctxt2         maxDegr = erfnMaxDegree ctxt         maxSize = erfnMaxSize ctxt-    (ERFnIntervalAny ctxt1) /\ (ERFnInterval ln2 h2 ctxt2 gl2) =-        ERFnInterval ln2 h2 ctxt gl2+    (ERFnIntervalAny ctxt1) /\ (ERFnInterval ln2 h2 ctxt2) =+        ERFnInterval ln2 h2 ctxt         where         ctxt = erfnContextUnify ctxt1 ctxt2-    (ERFnInterval ln1 h1 ctxt1 gl1) /\ (ERFnIntervalAny ctxt2) =-        ERFnInterval ln1 h1 ctxt gl1+    (ERFnInterval ln1 h1 ctxt1) /\ (ERFnIntervalAny ctxt2) =+        ERFnInterval ln1 h1 ctxt         where         ctxt = erfnContextUnify ctxt1 ctxt2     f1 /\ f2 = ERFnIntervalAny ctxt@@ -281,14 +289,14 @@         erfnintLeq f1 f2     refines _ (ERFnIntervalAny _) = True     refines (ERFnIntervalAny _) _ = False-    refines (ERFnInterval ln1 h1 _ _) (ERFnInterval ln2 h2 _ _) = +    refines (ERFnInterval ln1 h1 _) (ERFnInterval ln2 h2 _) =          (UFB.upperBound 10 (ln2 -^ ln1) >= 0)         &&         (UFB.upperBound 10 (h2 -^ h1) >= 0)     compareApprox (ERFnIntervalAny _) (ERFnIntervalAny _) = EQ     compareApprox (ERFnIntervalAny _) _ = LT     compareApprox _ (ERFnIntervalAny _) = GT-    compareApprox (ERFnInterval ln1 h1 _ _) (ERFnInterval ln2 h2 _ _) =+    compareApprox (ERFnInterval ln1 h1 _) (ERFnInterval ln2 h2 _) =         compareComposeMany         [             UFB.compareApprox h1 h2,@@ -312,46 +320,46 @@         | otherwise = False  instance-    (UFB.ERUnitFnBase boxb boxra varid b ra fb, Show varid, Show boxra) =>-    RA.ERIntApprox (ERFnInterval fb ra) +    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, Show varid, Show boxra) =>+    RA.ERIntApprox (ERFnInterval fb)      where --    doubleBounds = :: ira -> (Double, Double)  --    floatBounds :: ira -> (Float, Float) --    integerBounds :: ira -> (ExtendedInteger, ExtendedInteger)     bisectDomain maybePt (ERFnIntervalAny c) =         error "ERFnInterval: RA.bisectDomain: cannot bisect ERFnIntervalAny"-    bisectDomain maybePt (ERFnInterval ln h c g) =-        (ERFnInterval ln midUp c g,-         ERFnInterval midDownNeg h c g)+    bisectDomain maybePt (ERFnInterval ln h c) =+        (ERFnInterval ln midUp c,+         ERFnInterval midDownNeg h c)          where          (midDownNeg, midUp) =             case maybePt of                 Nothing ->                     (UFB.scaleUp (1/2) $ ln -^ h, UFB.scaleUp (1/2) $ h -^ ln)-                Just (ERFnInterval lnPt hPt _ _) ->+                Just (ERFnInterval lnPt hPt _) ->                     (lnPt, hPt)     bounds (ERFnIntervalAny c) =         error "ERFnInterval: RA.bounds: cannot get bounds for ERFnIntervalAny"-    bounds (ERFnInterval ln h c g) =-        (ERFnInterval ln (UFB.neg ln) c g,-         ERFnInterval (UFB.neg h) h c g) -    f1@(ERFnInterval ln1 h1 c1 g1) \/ f2@(ERFnInterval ln2 h2 c2 g2) =+    bounds (ERFnInterval ln h c) =+        (ERFnInterval ln (UFB.neg ln) c,+         ERFnInterval (UFB.neg h) h c) +    f1@(ERFnInterval ln1 h1 c1) \/ f2@(ERFnInterval ln2 h2 c2) = ---- #ifdef RUNTIME_CHECKS ----         check ("ERFnInterval: abs:\n f1:\n" ++ show f1 ++ " f2:\n" ++ show f2 ++ "\n result:\n") $ ---- #endif         normalise $-        ERFnInterval ln h c (g1 RA.\/ g2)+        ERFnInterval ln h c         where         ln = UFB.maxUp maxDegree maxSize ln1 ln2         h = UFB.maxUp maxDegree maxSize h1 h2         c = erfnContextUnify c1 c2         maxDegree = erfnMaxDegree c         maxSize = erfnMaxSize c-    (ERFnIntervalAny ctxt1) \/ (ERFnInterval ln2 h2 ctxt2 gl2) =+    (ERFnIntervalAny ctxt1) \/ (ERFnInterval ln2 h2 ctxt2) =         ERFnIntervalAny ctxt         where         ctxt = erfnContextUnify ctxt1 ctxt2-    (ERFnInterval ln1 h1 ctxt1 gl1) \/ (ERFnIntervalAny ctxt2) =+    (ERFnInterval ln1 h1 ctxt1) \/ (ERFnIntervalAny ctxt2) =         ERFnIntervalAny ctxt         where         ctxt = erfnContextUnify ctxt1 ctxt2@@ -360,19 +368,19 @@         ctxt = erfnContextUnify (erfnContext f1) (erfnContext f2)  instance-    (UFB.ERUnitFnBase boxb boxra varid b ra fb, -     RAEL.ERApproxElementary ra, RealFrac b, +    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, +     RAEL.ERApproxElementary ra,       Show varid, Show boxra) =>-    RAEL.ERApproxElementary (ERFnInterval fb ra) +    RAEL.ERApproxElementary (ERFnInterval fb)      where     -- default abs does not work because we do not have Prelude.abs     abs _ f@(ERFnIntervalAny _) = f-    abs _ f@(ERFnInterval ln h c g) =+    abs _ f@(ERFnInterval ln h c) = ---- #ifdef RUNTIME_CHECKS ----         check ("ERFnInterval: abs:\n f:\n" ++ show f ++ "\n result:\n") $ ---- #endif         normalise $-        ERFnInterval minhln0Up maxhlnUp c (abs g)+        ERFnInterval minhln0Up maxhlnUp c         where         maxhlnUp = UFB.maxUp maxDegree maxSize h ln          minhln0Up =@@ -381,9 +389,9 @@         maxDegree = erfnMaxDegree c         maxSize = erfnMaxSize c     exp ix f@(ERFnIntervalAny _) = f-    exp ix f@(ERFnInterval ln h c g) = +    exp ix f@(ERFnInterval ln h c) =          normalise $-        ERFnInterval lExpNeg hExp c (RAEL.exp ix g)+        ERFnInterval lExpNeg hExp c         where         maxDegree = erfnMaxDegree c         maxSize = erfnMaxSize c@@ -397,10 +405,10 @@                     (lExpNeg, _) = UFB.expEncl maxDegree maxSize ix (ln, UFB.neg ln)                     (_, hExp) = UFB.expEncl maxDegree maxSize ix (UFB.neg h,h)     sin ix f@(ERFnIntervalAny c) = -        ERFnInterval one one c ((-1) RA.\/ 1)+        ERFnInterval one one c         where         one = UFB.const 1-    sin ix f@(ERFnInterval ln h c g) =+    sin ix f@(ERFnInterval ln h c) = --        unsafePrint --        ( --            "ERFnInterval: RAEL.sin: "@@ -413,16 +421,16 @@ ----        check ("ERFnInterval: sin:\n f:\n" ++ show f ++ "\n result:\n") $ ---- #endif         normalise $-        ERFnInterval lSinNeg hSin c (RAEL.sin ix g)+        ERFnInterval lSinNeg hSin c         where         (lSinNeg, hSin) = sincos True maxDegree maxSize ix (ln, h)         maxDegree = erfnMaxDegree c         maxSize = erfnMaxSize c     cos ix f@(ERFnIntervalAny c) =-        ERFnInterval one one c ((-1) RA.\/ 1)+        ERFnInterval one one c         where         one = UFB.const 1-    cos ix f@(ERFnInterval ln h c g) =+    cos ix f@(ERFnInterval ln h c) = --        unsafePrint --        ( --            "ERFnInterval: RAEL.cos: "@@ -432,16 +440,16 @@ --            ++ "\n lCosNeg = " ++ show lCosNeg --        ) $         normalise $-        ERFnInterval lCosNeg hCos c (RAEL.cos ix g)+        ERFnInterval lCosNeg hCos c         where         (lCosNeg, hCos) = sincos False maxDegree maxSize ix (ln,h)          maxDegree = erfnMaxDegree c         maxSize = erfnMaxSize c     atan ix f@(ERFnIntervalAny c) =-        ERFnInterval one one c ((-1) RA.\/ 1)+        ERFnInterval one one c         where         one = UFB.const 1-    atan ix f@(ERFnInterval ln h c g) =+    atan ix f@(ERFnInterval ln h c) = --        unsafePrint --        ( --            "ERFnInterval: RAEL.atan: "@@ -451,7 +459,7 @@ --            ++ "\n lAtanNeg = " ++ show lAtanNeg --        ) $         normalise $-        ERFnInterval lAtanNeg hAtan c (RAEL.atan ix g)+        ERFnInterval lAtanNeg hAtan c         where         maxDegree = erfnMaxDegree c         maxSize = erfnMaxSize c@@ -467,7 +475,7 @@                     (_, hAtan) = UFB.atanEncl maxDegree maxSize ix (UFB.neg h,h)  sincos ::-    (UFB.ERUnitFnBase boxb boxra varid b ra fb, RAEL.ERApproxElementary ra, RealFrac b) =>+    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, RAEL.ERApproxElementary ra) =>     Bool {-^ True iff sine, False iff cosine -} ->      Int {-^ maximum representation degree -} ->      Int {-^ maximum approx size -} -> @@ -608,57 +616,55 @@         errPoly = UFB.const errB  normalise f@(ERFnIntervalAny c) = f-normalise f@(ERFnInterval ln h c g)+normalise f@(ERFnInterval ln h c)     | UFB.isValid h && UFB.isValid ln = f     | otherwise = ERFnIntervalAny c       check callerLocation f@(ERFnIntervalAny c) = f-check callerLocation f@(ERFnInterval ln h c g) =+check callerLocation f@(ERFnInterval ln h c) =     ERFnInterval          (UFB.check (callerLocation ++ "upper: ") h)          (UFB.check (callerLocation ++ "neg lower: ") ln) -        c g +        c   instance -    (UFB.ERUnitFnBase boxb boxra varid b ra fb, Show varid, Show boxra) =>-    FA.ERFnApprox boxra varid ra ra (ERFnInterval fb ra)+    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, Show varid, Show boxra) =>+    FA.ERFnApprox boxra varid ra ra (ERFnInterval fb)     where     check = check     domra2ranra _ = id     ranra2domra _ = id     getMaxDegree (ERFnIntervalAny c) =         erfnMaxDegree c-    getMaxDegree (ERFnInterval _ _ c _) =+    getMaxDegree (ERFnInterval _ _ c) =         erfnMaxDegree c     setMaxDegree maxDegr (ERFnIntervalAny c) =         ERFnIntervalAny (c { erfnMaxDegree = maxDegr } )-    setMaxDegree maxDegr (ERFnInterval ln h c g) =+    setMaxDegree maxDegr (ERFnInterval ln h c) =         ERFnInterval              (UFB.reduceDegreeUp maxDegr ln)             (UFB.reduceDegreeUp maxDegr h)             (c { erfnMaxDegree = maxDegr } )-            g     getSize (ERFnIntervalAny c) = 0-    getSize (ERFnInterval ln h c g) =+    getSize (ERFnInterval ln h c) =         max (UFB.getSize ln) (UFB.getSize h)     getMaxSize (ERFnIntervalAny c) =         erfnMaxSize c-    getMaxSize (ERFnInterval _ _ c _) =+    getMaxSize (ERFnInterval _ _ c) =         erfnMaxSize c     setMaxSize maxSize (ERFnIntervalAny c) =         ERFnIntervalAny (c { erfnMaxDegree = maxSize } )-    setMaxSize maxSize (ERFnInterval ln h c g) =+    setMaxSize maxSize (ERFnInterval ln h c) =         ERFnInterval              (UFB.reduceSizeUp maxSize ln)             (UFB.reduceSizeUp maxSize h)             (c { erfnMaxSize = maxSize } )-            g     getVariables (ERFnIntervalAny _) = []-    getVariables (ERFnInterval ln h _ _) = UFB.getVariables h +    getVariables (ERFnInterval ln h _) = UFB.getVariables h      getRangeApprox (ERFnIntervalAny _) =          RA.bottomApprox -    getRangeApprox (ERFnInterval ln h c g) =+    getRangeApprox (ERFnInterval ln h c) =         UFB.raFromEndpoints h         (          (- (UFB.upperBound 10 ln))@@ -667,16 +673,16 @@         )     scale ratio f@(ERFnIntervalAny c) =          f-    scale ratio f@(ERFnInterval ln h c g) =+    scale ratio f@(ERFnInterval ln h c) = ---- #ifdef RUNTIME_CHECKS ----         FA.check ("ERFnInterval: scale:\n before:\n" ++ show f ++ "\n after:\n") $ ---- #endif         normalise $         case RA.compareReals ratio 0 of             Just GT -> -                ERFnInterval (scaleUp ratio ln) (scaleUp ratio h) c g+                ERFnInterval (scaleUp ratio ln) (scaleUp ratio h) c             Just LT -> -                ERFnInterval (scaleUp (- ratio) h) (scaleUp (- ratio) ln) c g+                ERFnInterval (scaleUp (- ratio) h) (scaleUp (- ratio) ln) c             _ ->                  (UFA.const [ratio]) * f         where@@ -684,22 +690,22 @@         maxDegree = erfnMaxDegree c         maxSize = erfnMaxSize c     eval ptBox (ERFnIntervalAny c) = [RA.bottomApprox]-    eval ptBox (ERFnInterval ln h c g) =+    eval ptBox (ERFnInterval ln h c) =         [lo RA.\/ up]         where         up = UFB.evalApprox ptBox h         lo = negate $ UFB.evalApprox ptBox ln     partialEval substitutions f@(ERFnIntervalAny c) = f-    partialEval substitutions f@(ERFnInterval ln h c g) =+    partialEval substitutions f@(ERFnInterval ln h c) =         normalise $-        (ERFnInterval lnP hP c g)+        ERFnInterval lnP hP c         where         hP = UFB.partialEvalApproxUp substitutions h         lnP = UFB.partialEvalApproxUp substitutions ln     composeNonDecreasing-            fOuter@(ERFnInterval lnOuter hOuter cOuter gOuter)+            fOuter@(ERFnInterval lnOuter hOuter cOuter)             varid-            fInner@(ERFnInterval lnInner hInner cInner gInner) =+            fInner@(ERFnInterval lnInner hInner cInner) = --        unsafePrintReturn --        ( --            "ER.RnToRm.UnitDom.Interval: composeNonDecreasing: "@@ -721,17 +727,17 @@                 FA.ranra2domra fInner $                 (\[x] -> x) $ FA.eval ptB fInner                 -        result = ERFnInterval ln h c gOuter+        result = ERFnInterval ln h c         h =             erfnUpper $                  UFA.composeWithThin fOuter $                     Map.singleton varid-                    (ERFnInterval (UFB.neg hInner) hInner cInner gInner)+                    (ERFnInterval (UFB.neg hInner) hInner cInner)         ln =             erfnLowerNeg $                 UFA.composeWithThin fOuter $                     Map.singleton varid $-                    (ERFnInterval lnInner (UFB.neg lnInner) cInner gInner)+                    (ERFnInterval lnInner (UFB.neg lnInner) cInner)         c = erfnContextUnify cOuter cInner              composeNonDecreasing fOuter varid fInner = @@ -740,8 +746,8 @@         c = erfnContextUnify (erfnContext fOuter) (erfnContext fInner)  instance -    (UFB.ERUnitFnBase boxb boxra varid b ra fb, Show varid, Show boxra) =>-    UFA.ERUnitFnApprox boxra varid ra ra (ERFnInterval fb ra)+    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, Show varid, Show boxra) =>+    UFA.ERUnitFnApprox boxra varid ra ra (ERFnInterval fb)     where     bottomApprox =         ERFnIntervalAny erfnContextDefault@@ -755,8 +761,7 @@             {                 erfnLowerNeg = fbLNeg,                 erfnUpper = fbH,-                erfnContext = context,-                erfnGlobal = val+                erfnContext = context             }         | otherwise =             ERFnIntervalAny context @@ -779,11 +784,12 @@             {                 erfnLowerNeg = fbLNeg,                 erfnUpper = fbH,-                erfnContext = context,-                erfnGlobal = -                    UFB.raFromEndpoints fbH-                        (valL - coeffCorr - coeffsAbsSum, -                         valH + coeffCorr + coeffsAbsSum)+                erfnContext = context+--                ,+--                erfnGlobal = +--                    UFB.raFromEndpoints fbH+--                        (valL - coeffCorr - coeffsAbsSum, +--                         valH + coeffCorr + coeffsAbsSum)             }         | otherwise =             ERFnIntervalAny context@@ -811,7 +817,7 @@             substitutions =         f     composeWithThin-            f@(ERFnInterval ln1 h1 ctxt1 gl1)+            f@(ERFnInterval ln1 h1 ctxt1)             substitutions = --        unsafePrintReturn --        (@@ -835,7 +841,7 @@             evalPtB fInner =                 FA.ranra2domra fInner $ (\[x] -> x) $ FA.eval ptB fInner                 -        result = ERFnInterval ln h ctxt1 gl1 +        result = ERFnInterval ln h ctxt1         ln = UFB.composeManyUp maxDegree maxSize ln1 ufbSubstitutions         h = UFB.composeManyUp maxDegree maxSize h1 ufbSubstitutions          ufbSubstitutions = Map.map erfnUpper substitutions@@ -850,19 +856,19 @@         ctxt = erfnContextUnify ctxt1 ctxt2     intersectMeasureImprovement ix vars             f1@(ERFnIntervalAny ctxt1) -            f2@(ERFnInterval ln2 h2 ctxt2 gl2) =-        (ERFnInterval ln2 h2 ctxt gl2, 1 / 0)+            f2@(ERFnInterval ln2 h2 ctxt2) =+        (ERFnInterval ln2 h2 ctxt, RA.plusInfinity)         where         ctxt = erfnContextUnify ctxt1 ctxt2     intersectMeasureImprovement ix vars-            f1@(ERFnInterval ln1 h1 ctxt1 gl1) +            f1@(ERFnInterval ln1 h1 ctxt1)              f2@(ERFnIntervalAny ctxt2) = -        (ERFnInterval ln1 h1 ctxt gl1, 1)+        (ERFnInterval ln1 h1 ctxt, 1)         where         ctxt = erfnContextUnify ctxt1 ctxt2     intersectMeasureImprovement ix vars-            f1@(ERFnInterval ln1 h1 ctxt1 gl1) -            f2@(ERFnInterval ln2 h2 ctxt2 gl2) =+            f1@(ERFnInterval ln1 h1 ctxt1) +            f2@(ERFnInterval ln2 h2 ctxt2) =         case RA.compareReals improvementRA 1 of             Just LT -> (f1, 1) -- intersection made it worse, keep original             _ ->  (intersection, improvementRA)@@ -883,8 +889,8 @@         intersectionVolume = UFA.volume vars intersection         f1Volume = UFA.volume vars f1         ctxt = erfnContextUnify ctxt1 ctxt2-    volume vars (ERFnIntervalAny c) = 1/0-    volume vars (ERFnInterval ln h c g) =+    volume vars (ERFnIntervalAny c) = RA.plusInfinity+    volume vars (ERFnInterval ln h c) =         UFB.raFromEndpoints h (volL, volH)         where          volH = UFB.volumeAboveZeroUp vars (ln +^ h)@@ -893,8 +899,8 @@         hn = UFB.neg h     integrate _ f@(ERFnIntervalAny c) _ _ _ = f      integrate -            ix fD@(ERFnInterval ln h c g) x -            origin fI@(ERFnInterval lnInit hInit cInit gInit) =+            ix fD@(ERFnInterval ln h c) x +            origin fI@(ERFnInterval lnInit hInit cInit) = --        unsafePrintReturn --        ( --            "ERFnInterval: integrate: " @@ -920,7 +926,7 @@ ----         check ("ERFnInterval: integrate:\n fD:\n" ++ show fD ++ "\n fI:\n" ++ show fI ++ "\n result:\n") $ ---- #endif         normalise $-        (ERFnInterval lnIov hIov c gIov)+        (ERFnInterval lnIov hIov c)         where         -- perform raw integration of both bounds:         (hIuL, hIuH) = @@ -944,7 +950,4 @@         lnIov =              UFB.reduceSizeUp maxSize $                 lnIuH +^ lnInit +^ lnIuOriginLNeg +^ (lnIuOriginH +^ lnIuOriginLNeg)-        -        gIov = -            gInit + g * ((1 - origin) RA.\/ (-1 - origin)) 

@@ -0,0 +1,1086 @@+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE UndecidableInstances   #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Approx.IntervalOI+    Description :  arbitrary precision outer/inner function enclosures on @[-1,1]^n@+    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable++    A construction of an outer/inner enclosure of a real function on+    the domain [-1,1]^n for some n using elements of some+    base (eg rational functions or polynomials).+-}+module Data.Number.ER.RnToRm.UnitDom.Approx.IntervalOI +(+    ERFnIntervalOI(..)+)+where++import qualified Data.Number.ER.Real.Base as B+import Data.Number.ER.Real.Approx.Interval+import Data.Number.ER.Real.Approx.OI+import Data.Number.ER.Real.Arithmetic.Elementary+++import qualified Data.Number.ER.RnToRm.Approx as FA+import qualified Data.Number.ER.RnToRm.UnitDom.Approx as UFA+import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB +import Data.Number.ER.RnToRm.UnitDom.Base ((+^),(-^),(*^),multiplyEncl)+import Data.Number.ER.RnToRm.UnitDom.Approx.Interval++import qualified Data.Number.ER.Real.Approx as RA+import qualified Data.Number.ER.Real.Approx.Elementary as RAEL++import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox)+import Data.Number.ER.BasicTypes++import Data.Number.ER.Misc++import Data.Number.ER.ShowHTML+import qualified Text.Html as H++import qualified Data.Map as Map++import Data.Typeable+import Data.Generics.Basics+import Data.Binary++{- only for testing in ghci, to be removed: -}+--import Data.Number.ER.Real.DefaultRepr+--import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom+--import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.PolynomBase+--type FAPU = ERFnInterval (ERChebPoly (Box Int) B)+--fapuConst1 = (UFA.const 0 [1]) :: FAPU+--fapuConst2 = (UFA.const 0 [2]) :: FAPU+{- end of testing specific code -}++data ERFnIntervalOI fb =+    ERFnIntervalOIAny +    {+        erfnoiContext :: ERFnContext+    }+    |+    ERFnIntervalOI+    {+--        erfnLowerNeg :: fb,+--        erfnUpper :: fb,+        erfnoiContext :: ERFnContext,+        erfnoiOuter :: (fb, fb), +        erfnoiInner :: ((fb, fb), Bool) +--        ,+--        erfnIsDefinitelyConsistent :: Bool,+--        erfnIsDefinitelyAntiConsistent :: Bool+    }+    deriving (Typeable, Data)++instance (Binary a) => Binary (ERFnIntervalOI a) where+  put (ERFnIntervalOIAny a) = putWord8 0 >> put a+  put (ERFnIntervalOI a b c) = putWord8 1 >> put a >> put b >> put c+--  put (ERFnInterval a b c d e) = putWord8 1 >> put a >> put b >> put c >> put d >> put e+  get = do+    tag_ <- getWord8+    case tag_ of+      0 -> get >>= \a -> return (ERFnIntervalOIAny a)+      1 -> get >>= \a -> get >>= \b -> get >>= \c -> return (ERFnIntervalOI a b c)+--      1 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> return (ERFnInterval a b c d e)+      _ -> fail "no parse"+    +instance +    (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>+    Show (ERFnIntervalOI fb)+    where+    show (ERFnIntervalOIAny _) = "ERFnIntervalIOAny"+    show (ERFnIntervalOI ctxt (oln,oh) ((iln,ih),isDefinitelyAC)) =+        "\nERFnIntervalOI"+--        ++ " (definitely consistent: " ++ show isC +--        ++ "anticonsistent: " ++ show isDefinitelyAC ++ ")"        +        ++ "\n  context = " ++ show ctxt+        ++ "\n  outer upper = " ++ ufbShow oh+        ++ "\n  outer lower = " ++ ufbShow (UFB.neg oln)+        ++ "\n  inner upper = " ++ ufbShow ih+        ++ "\n  inner lower = " ++ ufbShow (UFB.neg iln)+        ++ "\n  inner is definitely anticonsistent: " ++ show isDefinitelyAC ++ "\n"+--        ++ "  global = " ++ show gl ++ "\n"+        where+        ufbShow = UFB.showDiGrCmp 10 False False++instance+    (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>+    H.HTML (ERFnIntervalOI fb)+--    where+--    toHtml (ERFnIntervalAny ctxt) =+--        H.toHtml "ERFnIntervalAny"+--    toHtml (ERFnInterval ln h ctxt) =+----        H.toHtml $+----            abovesTable+----                [+----                    H.toHtml "ERFnInterval",+--                    H.toHtml $ H.simpleTable [H.border 2] [] +--                        [+--                            [H.toHtml "upper = ", H.toHtml $ ufbShow h],+--                            [H.toHtml "lower = ", H.toHtml $ ufbShow (UFB.neg ln)]+--                        ]+----                ]+--        where+--        ufbShow = UFB.showDiGrCmp 10 False False+--+instance+    (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>+    Eq (ERFnIntervalOI fb)+    where+    (ERFnIntervalOI ctxt1 o1 i1) +            == (ERFnIntervalOI ctxt2 o2 i2) =+        error "ERFnIntervalIO: equality not implemented"+    _ == _ =+        error "ERFnIntervalIO: equality not implemented"++instance +    (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>+    Ord (ERFnIntervalOI fb) +    where+    compare +            (ERFnIntervalOI ctxt1 o1 i1) +            (ERFnIntervalOI ctxt2 o2 i2) =+        error "ERFnIntervalOI: comparison not implemented; consider leqReals or compareApprox from class ERApprox instead"+    compare _ _ =+        error "ERFnIntervalOI: comparison not implemented; consider leqReals or compareApprox from class ERApprox instead"+    +    +instance +    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, +     UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb,+     Show varid, Show boxra) =>+    Num (ERFnIntervalOI fb)+    where+    fromInteger n = UFA.const [fromInteger n]+    negate f@(ERFnIntervalOIAny _) = f+    negate (ERFnIntervalOI ctxt (oln,oh) ((iln,ih),isDefinitelyAC)) =+        ERFnIntervalOI ctxt (oh,oln) ((ih,iln),isDefinitelyAC)+    (ERFnIntervalOI ctxt1 oe1 ie1) + +        (ERFnIntervalOI ctxt2 oe2 ie2) =+        normalise $+        ERFnIntervalOI ctxt oe ie+        where+        oe = UFB.addEncl maxDegr maxSize oe1 oe2+        ie = UFB.addIEncl maxDegr maxSize ie1 ie2+        maxDegr = erfnMaxDegree ctxt+        maxSize = erfnMaxSize ctxt+        ctxt = erfnContextUnify ctxt1 ctxt2+    f1 + f2 = ERFnIntervalOIAny ctxt+        where+        ctxt = erfnContextUnify (erfnoiContext f1) (erfnoiContext f2)+    (ERFnIntervalOI ctxt1 oe1 ie1) * +        (ERFnIntervalOI ctxt2 oe2 ie2) =+        normalise $+        ERFnIntervalOI ctxt oe ie+        where+        oe = UFB.multiplyEncl maxDegr maxSize oe1 oe2+        ie = UFB.multiplyIEncl maxDegr maxSize ie1 ie2+        maxDegr = erfnMaxDegree ctxt+        maxSize = erfnMaxSize ctxt+        ctxt = erfnContextUnify ctxt1 ctxt2+    f1 * f2 = ERFnIntervalOIAny ctxt+        where+        ctxt = erfnContextUnify (erfnoiContext f1) (erfnoiContext f2)++instance +    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, +     UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb, +     Show varid, Show boxra) =>+    Fractional (ERFnIntervalOI fb)+    where+    fromRational r = UFA.const [fromRational r]+    recip f@(ERFnIntervalOIAny _) = f+    recip (ERFnIntervalOI ctxt oe@(oln,oh) ie@((iln,ih),isDAC))+        | certainAboveZero =+            normalise $+            ERFnIntervalOI ctxt oeR posieR+        | certainBelowZero =+            normalise $+            ERFnIntervalOI ctxt oeR negieR+--        | certainNoZero =+--            normalise $+--            ERFnIntervalOI ctxt oeR ieR+        | otherwise = ERFnIntervalOIAny ctxt+        where+--        certainNoZero =+--            certainAboveZero || certainBelowZero+        certainAboveZero =+            certainOuterAboveZero && certainInnerACAboveZero+        certainBelowZero =+             certainOuterBelowZero && certainInnerACBelowZero+        certainOuterAboveZero =+             UFB.upperBound ix oln < 0+        certainInnerACAboveZero =+             UFB.upperBound ix (UFB.neg ih) < 0+        certainOuterBelowZero =         +             UFB.upperBound ix oh < 0 +        certainInnerACBelowZero =         +             UFB.upperBound ix (UFB.neg iln) < 0 +        oeR = +            UFB.recipEncl maxDegr maxSize ix oe+        posieR = +            UFB.recipIEnclPositive maxDegr maxSize ix ((iln,ih),isDAC)+        negieR = +            negIEncl $ +            UFB.recipIEnclPositive maxDegr maxSize ix $ +            ((ih,iln),isDAC)+        negIEncl ((a,b),c) = ((b,a),c)+--        hnRecipUp =+--            UFB.recipUp maxDegr maxSize ix (negate h) +--        lRecipUp =+--            UFB.recipUp maxDegr maxSize ix (negate ln)+        maxDegr = erfnMaxDegree ctxt+        maxSize = erfnMaxSize ctxt+        ix = int2effIx $ 3 * maxDegr         ++instance+    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb, +     Show varid, Show boxra) =>+    RA.ERApprox (ERFnIntervalOI fb) +    where+    initialiseBaseArithmetic _ =+    	UFB.initialiseBaseArithmetic (UFB.const 0 :: fb)+--    getGranularity (ERFnIntervalOIAny ctxt) = erfnCoeffGranularity ctxt+--    getGranularity (ERFnIntervalOI ctxt (oln,oh) ((iln,ih),_)) =+--        maximum $ +--            erfnCoeffGranularity ctxt : map UFB.getGranularity [oln,oh,iln,ih]+--    setGranularity gran (ERFnIntervalAny ctxt) = +--        ERFnIntervalAny $ ctxt { erfnCoeffGranularity = gran }+--    setGranularity gran (ERFnInterval ln h ctxt) =+--        ERFnInterval +--            (UFB.setGranularity gran ln) (UFB.setGranularity gran h) +--            (ctxt { erfnCoeffGranularity = gran })+--    setMinGranularity gran (ERFnIntervalAny ctxt) = +--        ERFnIntervalAny+--            (ctxt { erfnCoeffGranularity = max gran (erfnCoeffGranularity ctxt) })+--    setMinGranularity gran (ERFnInterval ln h ctxt) =+--        ERFnInterval +--            (UFB.setMinGranularity gran ln) (UFB.setMinGranularity gran h) +--            (ctxt { erfnCoeffGranularity = max gran (erfnCoeffGranularity ctxt) })+----    getPrecision (ERFnIntervalAny _) = 0+----    getPrecision f = intLog 2 (1 + (fst $ RA.integerBounds (FA.volume f))) -- wrong! +    isBottom (ERFnIntervalOIAny _) = True+    isBottom _ = False+--    f1@(ERFnInterval ln1 h1 ctxt1) /\ f2@(ERFnInterval ln2 h2 ctxt2) =+------ #ifdef RUNTIME_CHECKS+------         check ("ERFnInterval: /\\:\n f1:\n" ++ show f1 ++ " f2:\n" ++ show f2 ++ "\n result:\n") $+------ #endif+--        normalise $+--        ERFnInterval +--            (UFB.minUp maxDegr maxSize ln1 ln2) +--            (UFB.minUp maxDegr maxSize h1 h2) +--            ctxt+--        where+--        ctxt = erfnContextUnify ctxt1 ctxt2+--        maxDegr = erfnMaxDegree ctxt+--        maxSize = erfnMaxSize ctxt+--    (ERFnIntervalAny ctxt1) /\ (ERFnInterval ln2 h2 ctxt2) =+--        ERFnInterval ln2 h2 ctxt+--        where+--        ctxt = erfnContextUnify ctxt1 ctxt2+--    (ERFnInterval ln1 h1 ctxt1) /\ (ERFnIntervalAny ctxt2) =+--        ERFnInterval ln1 h1 ctxt+--        where+--        ctxt = erfnContextUnify ctxt1 ctxt2+--    f1 /\ f2 = ERFnIntervalAny ctxt+--        where+--        ctxt = erfnContextUnify (erfnContext f1) (erfnContext f2)+    leqReals f1 f2 = +--        unsafePrint ("ERInterval: leqReals: sizes: " ++ show (FA.getSize f1) ++ ", " ++ show (FA.getSize f2)) $ +        erfnintLeq f1 f2+    {-+        The relation 'refines' corresponds to enclosure inclusion of the outer +        enclosure of the left argument in the inner enclosure of the right +        argument. Probably wrong way to implement this... should split into+        refinesI and refinesO? +    -}+--    refines _ (ERFnIntervalOIAny _) = True+--    refines (ERFnIntervalOIAny _) _ = False+--    refines (ERFnIntervalOI _ (oln,oh) _) (ERFnIntervalOI _ _ ((iln,ih),_)) = +--        (UFB.upperBound 10 (iln -^ oln) >= 0)+--        &&+--        (UFB.upperBound 10 (ih -^ oh) >= 0)+--    compareApprox (ERFnIntervalAny _) (ERFnIntervalAny _) = EQ+--    compareApprox (ERFnIntervalAny _) _ = LT+--    compareApprox _ (ERFnIntervalAny _) = GT+--    compareApprox (ERFnInterval ln1 h1 _) (ERFnInterval ln2 h2 _) =+--        compareComposeMany+--        [+--            UFB.compareApprox h1 h2,+--            UFB.compareApprox ln1 ln2+--        ]+--+erfnintLeq left right+    | left `isClearlyBelow` right = Just True+    | right `isClearlyStrictlyBelow` left = Just False+    | otherwise = Nothing+    where+    isClearlyBelow (ERFnIntervalOIAny _) _ = False+    isClearlyBelow _ (ERFnIntervalOIAny _) = False+    isClearlyBelow +        f@(ERFnIntervalOI _ (_,ohf) _) +        g@(ERFnIntervalOI _ (olng,_) _)+        | UFB.upperBoundPrecise 10 (ohf +^ olng) <= 0 = True+--        | UFB.upperBoundPrecise 10 (erfnUpper f +^ erfnLowerNeg g) <= 0 = True+        | otherwise = False+    isClearlyStrictlyBelow (ERFnIntervalOIAny _) _ = False+    isClearlyStrictlyBelow _ (ERFnIntervalOIAny _) = False+    isClearlyStrictlyBelow+        f@(ERFnIntervalOI _ (_,ohf) _) +        g@(ERFnIntervalOI _ (olng,_) _)+        | UFB.upperBoundPrecise 10 (ohf +^ olng) < 0 = True    +--        | UFB.upperBoundPrecise 10 (erfnUpper f +^ erfnLowerNeg g) < 0 = True+        | otherwise = False++instance+    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb,+     UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb,+     Show varid, Show boxra) =>+    RA.ERIntApprox (ERFnIntervalOI fb) +    where+----    doubleBounds = :: ira -> (Double, Double) +----    floatBounds :: ira -> (Float, Float)+----    integerBounds :: ira -> (ExtendedInteger, ExtendedInteger)+--    bisectDomain maybePt (ERFnIntervalAny c) =+--        error "ERFnInterval: RA.bisectDomain: cannot bisect ERFnIntervalAny"+--    bisectDomain maybePt (ERFnInterval ln h c) =+--        (ERFnInterval ln midUp c,+--         ERFnInterval midDownNeg h c)+--         where+--         (midDownNeg, midUp) =+--            case maybePt of+--                Nothing ->+--                    (UFB.scaleUp (1/2) $ ln -^ h, UFB.scaleUp (1/2) $ h -^ ln)+--                Just (ERFnInterval lnPt hPt _) ->+--                    (lnPt, hPt)+--    bounds (ERFnIntervalAny c) =+--        error "ERFnInterval: RA.bounds: cannot get bounds for ERFnIntervalAny"+--    bounds (ERFnInterval ln h c) =+--        (ERFnInterval ln (UFB.neg ln) c,+--         ERFnInterval (UFB.neg h) h c) +    f1@(ERFnIntervalOI ctxt1 oe1@(oln1,oh1) ie1@((iln1,ih1),isDAC1)) \/ +        f2@(ERFnIntervalOI ctxt2 oe2@(oln2,oh2) ie2@((iln2,ih2),isDAC2)) =+---- #ifdef RUNTIME_CHECKS+----         check ("ERFnInterval: abs:\n f1:\n" ++ show f1 ++ " f2:\n" ++ show f2 ++ "\n result:\n") $+---- #endif+        normalise $+        ERFnIntervalOI ctxt oe ie+        where+        ctxt = erfnContextUnify ctxt1 ctxt2+        oe = (oln,oh)+        oln = UFB.maxUp maxDegree maxSize oln1 oln2+        oh = UFB.maxUp maxDegree maxSize oh1 oh2+        ie = ((iln,ih),isDAC)+        iln = UFB.maxDown maxDegree maxSize iln1 iln2+        ih = UFB.maxDown maxDegree maxSize ih1 ih2+        {-^+            Note that using maxDown here is safe, but very wasteful. It should+            be possible to find a safe yet more precise way of computing this+            type of min/max for bound functions...+        -}+        isDAC = False+        maxDegree = erfnMaxDegree ctxt+        maxSize = erfnMaxSize ctxt+    (ERFnIntervalOIAny ctxt1) \/ (ERFnIntervalOI ctxt2 _ _) =+        ERFnIntervalOIAny ctxt+        where+        ctxt = erfnContextUnify ctxt1 ctxt2+    (ERFnIntervalOI ctxt1 _ _) \/ (ERFnIntervalOIAny ctxt2) =+        ERFnIntervalOIAny ctxt+        where+        ctxt = erfnContextUnify ctxt1 ctxt2+    f1 \/ f2 = ERFnIntervalOIAny ctxt+        where+        ctxt = erfnContextUnify (erfnoiContext f1) (erfnoiContext f2)++instance+    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, +     UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb,+     RAEL.ERApproxElementary ra, +     Show varid, Show boxra) =>+    RAEL.ERApproxElementary (ERFnIntervalOI fb) +    where+--    -- default abs does not work because we do not have Prelude.abs+--    abs _ f@(ERFnIntervalAny _) = f+--    abs _ f@(ERFnInterval ln h c) =+------ #ifdef RUNTIME_CHECKS+------         check ("ERFnInterval: abs:\n f:\n" ++ show f ++ "\n result:\n") $+------ #endif+--        normalise $+--        ERFnInterval minhln0Up maxhlnUp c+--        where+--        maxhlnUp = UFB.maxUp maxDegree maxSize h ln +--        minhln0Up =+--            UFB.minUp maxDegree maxSize (UFB.const 0) $+--                UFB.minUp maxDegree maxSize h ln+--        maxDegree = erfnMaxDegree c+--        maxSize = erfnMaxSize c+    sqrt ix f@(ERFnIntervalOIAny _) = f+    sqrt ix f@(ERFnIntervalOI ctxt oe@(oln,_) ie@((iln,ih),_))+        | certainAboveZero =+            normalise $+            ERFnIntervalOI ctxt oeR ieR+        | otherwise = ERFnIntervalOIAny ctxt+        where+        certainAboveZero = -- OK since consistent inner will be inside outer+            certainOuterAboveZero && certainInnerACAboveZero+        certainOuterAboveZero =+             UFB.upperBound ix oln < 0+        certainInnerACAboveZero =+             UFB.upperBound ix (UFB.neg ih) < 0+             &&+             UFB.upperBound ix iln < 0+        oeR = +            UFB.sqrtEncl maxDegr maxSize ix oe+        ieR = +            UFB.sqrtIEncl maxDegr maxSize ix ie+        maxDegr = erfnMaxDegree ctxt+        maxSize = erfnMaxSize ctxt+        +--    exp ix f@(ERFnIntervalAny _) = f+--    exp ix f@(ERFnInterval ln h c) = +--        normalise $+--        ERFnInterval lExpNeg hExp c+--        where+--        maxDegree = erfnMaxDegree c+--        maxSize = erfnMaxSize c+--        (lExpNeg, hExp) =+--            case (UFB.upperBound ix (h +^ ln) <= 1) of+--                True -> +--                    UFB.expEncl maxDegree maxSize ix (ln, h)+--                False ->+--                    (lExpNeg, hExp)+--                    where+--                    (lExpNeg, _) = UFB.expEncl maxDegree maxSize ix (ln, UFB.neg ln)+--                    (_, hExp) = UFB.expEncl maxDegree maxSize ix (UFB.neg h,h)+--    sin ix f@(ERFnIntervalAny c) = +--        ERFnInterval one one c+--        where+--        one = UFB.const 1+--    sin ix f@(ERFnInterval ln h c) =+----        unsafePrint+----        (+----            "ERFnInterval: RAEL.sin: "+----            ++ "\n h = " ++ show h+----            ++ "\n ln = " ++ show ln+----            ++ "\n hSin = " ++ show hSin+----            ++ "\n lSinNeg = " ++ show lSinNeg+----        ) $+------ #ifdef RUNTIME_CHECKS+------        check ("ERFnInterval: sin:\n f:\n" ++ show f ++ "\n result:\n") $+------ #endif+--        normalise $+--        ERFnInterval lSinNeg hSin c+--        where+--        (lSinNeg, hSin) = sincos True maxDegree maxSize ix (ln, h)+--        maxDegree = erfnMaxDegree c+--        maxSize = erfnMaxSize c+--    cos ix f@(ERFnIntervalAny c) =+--        ERFnInterval one one c+--        where+--        one = UFB.const 1+--    cos ix f@(ERFnInterval ln h c) =+----        unsafePrint+----        (+----            "ERFnInterval: RAEL.cos: "+----            ++ "\n h = " ++ show h+----            ++ "\n ln = " ++ show ln+----            ++ "\n uCos = " ++ show uCos+----            ++ "\n lCosNeg = " ++ show lCosNeg+----        ) $+--        normalise $+--        ERFnInterval lCosNeg hCos c+--        where+--        (lCosNeg, hCos) = sincos False maxDegree maxSize ix (ln,h) +--        maxDegree = erfnMaxDegree c+--        maxSize = erfnMaxSize c+--    atan ix f@(ERFnIntervalAny c) =+--        ERFnInterval one one c+--        where+--        one = UFB.const 1+--    atan ix f@(ERFnInterval ln h c) =+----        unsafePrint+----        (+----            "ERFnInterval: RAEL.atan: "+----            ++ "\n u = " ++ show u+----            ++ "\n ln = " ++ show ln+----            ++ "\n uAtan = " ++ show uAtan+----            ++ "\n lAtanNeg = " ++ show lAtanNeg+----        ) $+--        normalise $+--        ERFnInterval lAtanNeg hAtan c+--        where+--        maxDegree = erfnMaxDegree c+--        maxSize = erfnMaxSize c+----        ix = int2effIx maxDegree+--        (lAtanNeg, hAtan) = +--            case (UFB.upperBound ix (h +^ ln) <= 1) of+--                True ->+--                    UFB.atanEncl maxDegree maxSize ix (ln, h)+--                False ->+--                    (lAtanNeg, hAtan)+--                    where+--                    (lAtanNeg, _) = UFB.atanEncl maxDegree maxSize ix (ln, UFB.neg ln)+--                    (_, hAtan) = UFB.atanEncl maxDegree maxSize ix (UFB.neg h,h)+--+--sincos ::+--    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, RAEL.ERApproxElementary ra, RealFrac b) =>+--    Bool {-^ True iff sine, False iff cosine -} -> +--    Int {-^ maximum representation degree -} -> +--    Int {-^ maximum approx size -} -> +--    EffortIndex {-^ how hard to try to eliminate truncation errors -} -> +--    (fb, fb) ->+--    (fb, fb)+--sincos isSine maxDegree maxSize ix (ln,h)+--    -- p - 2k*pi range within [-pi/2, pi/2]: +--    | ranfNear0 `RA.refines` plusMinusPiHalf =+----        unsafePrint+----        (+----            "ERFnInterval: sincos: [-pi/2, pi/2]: "+----            ++ "\n u = " ++ show u+----            ++ "\n l = " ++ show l+----            ++ "\n ranf = " ++ show ranf+----            ++ "\n k = " ++ show k+----            ++ "\n ranfNear0 = " ++ show ranfNear0+----        ) $+--        case isSine of+--            True -> sineShifted (- k2pi)+--            False -> cosineShifted (- k2pi)+--    -- p - 2k*pi range within [0, pi]: +--    | (ranfNear0 - piHalf) `RA.refines` plusMinusPiHalf =+----        unsafePrint+----        (+----            "ERFnInterval: sincos: [0, pi]: "+----            ++ "\n u = " ++ show u+----            ++ "\n l = " ++ show l+----            ++ "\n ranf = " ++ show ranf+----            ++ "\n k = " ++ show k+----            ++ "\n ranfNear0 = " ++ show ranfNear0+----        ) $+--        case isSine of+--            -- use sin(x) = cos(x - pi/2) and cos(x) = - sin(x - pi/2):+--            True -> cosineShifted (- k2pi - piHalf)+--            False -> sineShiftedNegated (- k2pi - piHalf)+--    -- p - 2k*pi range within [-pi, 0]: +--    | (ranfNear0 + piHalf) `RA.refines` plusMinusPiHalf =+----        unsafePrint+----        (+----            "ERFnInterval: sincos: [-pi, 0]: "+----            ++ "\n u = " ++ show u+----            ++ "\n l = " ++ show l+----            ++ "\n ranf = " ++ show ranf+----            ++ "\n k = " ++ show k+----            ++ "\n ranfNear0 = " ++ show ranfNear0+----        ) $+--        case isSine of+--            -- use sin(x) = - cos(x + pi/2) and cos(x) = sin(x + pi/2):+--            True -> cosineShiftedNegated (-k2pi + piHalf)+--            False -> sineShifted (-k2pi + piHalf)+--    -- p - 2k*pi range within [pi/2, 3pi/2]: +--    | (ranfNear0 - pi) `RA.refines` plusMinusPiHalf =+----        unsafePrint+----        (+----            "ERFnInterval: sincos: [pi/2, 3pi/2]: "+----            ++ "\n u = " ++ show u+----            ++ "\n l = " ++ show l+----            ++ "\n ranf = " ++ show ranf+----            ++ "\n k = " ++ show k+----            ++ "\n ranfNear0 = " ++ show ranfNear0+----        ) $+--        -- use sin(x) = - sin(x - pi) and cos(x) = - cos(x - pi)+--        case isSine of+--            True -> sineShiftedNegated (- k2pi - pi)+--            False -> cosineShiftedNegated (- k2pi - pi)+--    | otherwise = +----        unsafePrint+----        (+----            "ERFnInterval: sincos: big range: "+----            ++ "\n u = " ++ show u+----            ++ "\n l = " ++ show l+----            ++ "\n ranf = " ++ show ranf+----            ++ "\n k = " ++ show k+----            ++ "\n ranfNear0 = " ++ show ranfNear0+----        ) $+--        (UFB.const (-1), UFB.const 1)+----    (expDownwards, expUpwards + valueAtRDnNeg + (UFB.const expRUp))+--    where+----    l = UFB.neg ln+--    ranfNear0 = ranf - k2pi+--    k2pi = k * 2 * pi+--    plusMinusPiHalf = (-piHalfLO) RA.\/ piHalfLO+--    pi = RAEL.pi ix  +--    piHalf = pi / 2+--    (piHalfLO, piHalfHI) = RA.bounds piHalf+--    ranf = +--        ERInterval +--            (negate $ UFB.upperBound 10 ln) +--            (UFB.upperBound 10 h)+--    k = fromInteger $ toInteger kEI+--    (kEI,_) = RA.integerBounds $ 0.5 + (ranf / (2*pi))+--+--    sineShiftedNegated shift =+--        boundsNegate $ sineShifted shift+--        +--    cosineShiftedNegated shift =+--        boundsNegate $ cosineShifted shift+--+--    boundsNegate (pLONeg, pHI) = (pHI, pLONeg)+--        +--    sineShifted shift = -- moving to domain where sinus is non-decreasing+--        case (UFB.upperBound ix (h +^ ln) <= 0.25) of+--            True -> +--                UFB.sinEncl maxDegree maxSize ix (lnShifted, hShifted)+--            False ->+--                (lSinNeg, hSin)+--                where+--                (lSinNeg, _) = UFB.sinEncl maxDegree maxSize ix (ln, UFB.neg ln)+--                (_, hSin) = UFB.sinEncl maxDegree maxSize ix (UFB.neg h,h)+--        where+--        lnShifted = ln +^ (UFB.const (- shiftLOB))+--        hShifted = h +^ (UFB.const shiftHIB)+--        ERInterval shiftLOB shiftHIB = shift+--+--+--    +--    cosineShifted shift = -- moving to domain where cosinus is non-decreasing+--        case (UFB.upperBound ix (h +^ ln) <= 0.25) of+--            True -> +--                UFB.cosEncl maxDegree maxSize ix (lnShifted, hShifted)+--            False ->+--                (UFB.minUp maxDegree maxSize lCosDownNeg hCosDownNeg,+--                 UFB.maxUp maxDegree maxSize lCosUp hCosUp +--                    +^ (UFB.scaleUp 0.5 (h +^ ln))) +--                        -- this term is important when enclosure hits 0;+--                        -- without it, the result could miss cosine's maximum at 0+--        where+--        (lCosDownNeg, lCosUp) = UFB.cosEncl maxDegree maxSize ix (ln, UFB.neg ln)+--        (hCosDownNeg, hCosUp) = UFB.cosEncl maxDegree maxSize ix (UFB.neg h,h)+--        lnShifted = ln +^ (UFB.const (- shiftLOB))+--        hShifted = h +^ (UFB.const shiftHIB)+--        ERInterval shiftLOB shiftHIB = shift+--    +--    boundsAddErr errB (pLONeg, pHI) =+--        (pLONeg +^ errPoly, pHI +^ errPoly)+--        where+--        errPoly = UFB.const errB++normalise f@(ERFnIntervalOIAny _) = f+normalise f@(ERFnIntervalOI ctxt (oln,oh) ((iln,ih),_))+    | UFB.isValid oh && UFB.isValid oln && UFB.isValid ih && UFB.isValid iln = f+    | otherwise = ERFnIntervalOIAny ctxt+    +--check callerLocation f@(ERFnIntervalAny c) = f+--check callerLocation f@(ERFnInterval ln h c) =+--    ERFnInterval +--        (UFB.check (callerLocation ++ "upper: ") h) +--        (UFB.check (callerLocation ++ "neg lower: ") ln) +--        c+--+--+instance +    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, +     UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb,+    Show varid, Show boxra) =>+    FA.ERFnApprox boxra varid ra ra (ERFnIntervalOI fb)+    where+--    check = check+    domra2ranra _ = id+    ranra2domra _ = id+    getMaxDegree (ERFnIntervalOIAny ctxt) =+        erfnMaxDegree ctxt+    getMaxDegree (ERFnIntervalOI ctxt _ _) =+        erfnMaxDegree ctxt+    setMaxDegree maxDegr (ERFnIntervalOIAny c) =+        ERFnIntervalOIAny (c { erfnMaxDegree = maxDegr } )+    setMaxDegree maxDegr (ERFnIntervalOI ctxt oe@(oln,oh) ie@((iln,ih),isDAC)) =+        ERFnIntervalOI +            (ctxt { erfnMaxDegree = maxDegr } )+            (UFB.reduceDegreeUp maxDegr oln, UFB.reduceDegreeUp maxDegr oh)+            ((UFB.neg $ UFB.reduceDegreeUp maxDegr (UFB.neg iln),+              UFB.neg $ UFB.reduceDegreeUp maxDegr (UFB.neg ih)),isDAC)+--    getSize (ERFnIntervalAny c) = 0+--    getSize (ERFnInterval ln h c) =+--        max (UFB.getSize ln) (UFB.getSize h)+--    getMaxSize (ERFnIntervalOIAny ctxt) =+--        erfnMaxSize ctxt+--    getMaxSize (ERFnIntervalOI ctxt _ _) =+--        erfnMaxSize ctxt+--    setMaxSize maxSize (ERFnIntervalOIAny ctxt) =+--        ERFnIntervalOIAny (ctxt { erfnMaxDegree = maxSize } )+--    setMaxSize maxSize (ERFnIntervalOI ctxt oe@(oln,oh) ie@((iln,ih),isDAC)) =+--        ERFnIntervalOI +--            (ctxt { erfnMaxSize = maxSize } )+--            (UFB.neg $ UFB.reduceSizeUp maxSize (UFB.neg oln), UFB.reduceSizeUp maxSize oh)+--            ((UFB.neg $ UFB.reduceSizeUp maxSize (UFB.neg iln), UFB.neg $ UFB.reduceSizeUp maxSize ih),isDAC)+--    getVariables (ERFnIntervalAny _) = []+--    getVariables (ERFnInterval ln h _) = UFB.getVariables h +--    getRangeApprox (ERFnIntervalAny _) = +--        RA.bottomApprox +--    getRangeApprox (ERFnInterval ln h c) =+--        UFB.raFromEndpoints h+--        (+--         (- (UFB.upperBound 10 ln))+--        ,+--         (UFB.upperBound 10 h)+--        )+--    scale ratio f@(ERFnIntervalAny c) = +--        f+--    scale ratio f@(ERFnInterval ln h c) =+------ #ifdef RUNTIME_CHECKS+------         FA.check ("ERFnInterval: scale:\n before:\n" ++ show f ++ "\n after:\n") $+------ #endif+--        normalise $+--        case RA.compareReals ratio 0 of+--            Just GT -> +--                ERFnInterval (scaleUp ratio ln) (scaleUp ratio h) c+--            Just LT -> +--                ERFnInterval (scaleUp (- ratio) h) (scaleUp (- ratio) ln) c+--            _ -> +--                (UFA.const [ratio]) * f+--        where+--        scaleUp = UFB.scaleApproxUp maxDegree maxSize+--        maxDegree = erfnMaxDegree c+--        maxSize = erfnMaxSize c+--    eval ptBox (ERFnIntervalAny c) = [RA.bottomApprox]+--    eval ptBox (ERFnInterval ln h c) =+--        [lo RA.\/ up]+--        where+--        up = UFB.evalApprox ptBox h+--        lo = negate $ UFB.evalApprox ptBox ln+--    partialEval substitutions f@(ERFnIntervalAny c) = f+--    partialEval substitutions f@(ERFnInterval ln h c) =+--        normalise $+--        ERFnInterval lnP hP c+--        where+--        hP = UFB.partialEvalApproxUp substitutions h+--        lnP = UFB.partialEvalApproxUp substitutions ln+--    composeNonDecreasing+--            fOuter@(ERFnInterval lnOuter hOuter cOuter)+--            varid+--            fInner@(ERFnInterval lnInner hInner cInner) =+----        unsafePrintReturn+----        (+----            "ER.RnToRm.UnitDom.Interval: composeNonDecreasing: "+----            ++ "\n fOuter = " ++ show fOuter+----            ++ "\n varid = " ++ show varid+----            ++ "\n fInner = " ++ show fInner+----            ++ "\n inconsistencies = " ++ show (UFA.keyPointsConsistencyCheck resultReals result)+----            ++ "\n result = "+----        )+----        $+--        result+--        where+--        resultReals ptB = -- this is only used for consistency checking...+--            (\[x] -> x) $ FA.eval ptBOuter fOuter+--            where+--            ptBOuter =+--                DBox.insert varid fInnerVal ptB+--            fInnerVal =+--                FA.ranra2domra fInner $+--                (\[x] -> x) $ FA.eval ptB fInner+--                +--        result = ERFnInterval ln h c+--        h =+--            erfnUpper $ +--                UFA.composeWithThin fOuter $+--                    Map.singleton varid+--                    (ERFnInterval (UFB.neg hInner) hInner cInner)+--        ln =+--            erfnLowerNeg $+--                UFA.composeWithThin fOuter $+--                    Map.singleton varid $+--                    (ERFnInterval lnInner (UFB.neg lnInner) cInner)+--        c = erfnContextUnify cOuter cInner+--        +--    composeNonDecreasing fOuter varid fInner = +--        ERFnIntervalAny c+--        where+--        c = erfnContextUnify (erfnContext fOuter) (erfnContext fInner)+--+instance +    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb,+     UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb,+     Show varid, Show boxra) =>+    UFA.ERUnitFnApprox boxra varid ra ra (ERFnIntervalOI fb)+    where+    bottomApprox =+        ERFnIntervalOIAny erfnContextDefault+      {- +        Can't get 'const' through the type checker, even when adding the+        suggested declaration... why doesn't the trick used for ERFnInterval+        work here?+      -}+    const [val] +        | RA.isBounded val =+---- #ifdef RUNTIME_CHECKS+----             check ("ERFnInterval: const:\n") $+---- #endif+            normalise $+            ERFnIntervalOI ctxt oe ie+--            ERFnIntervalOI+--            {+--                erfnoiContext = ctxt,+--                erfnoiOuter = oe, +--                erfnoiInner = ie +--            }+        | otherwise =+            ERFnIntervalOIAny ctxt +        where+        oe@(_,h) = UFB.constEncl valEndpoints+        ie = UFB.constIEncl valEndpoints+        valEndpoints = UFB.raEndpoints h val+        ctxt = +            erfnContextDefault+            {+                erfnCoeffGranularity = RA.getGranularity val+            }+    affine [val] coeffsSingletons+        | RA.isBounded val && (and $ map (RA.isBounded . head) $ Map.elems coeffsSingletons) =+---- #ifdef RUNTIME_CHECKS+----             check ("ERFnInterval: affine:\n") $+---- #endif+            normalise $+            ERFnIntervalOI ctxt oe ie+        | otherwise =+            ERFnIntervalOIAny ctxt+        where+        ctxt = +            erfnContextDefault+            {+                erfnCoeffGranularity = coeffGranularity+            }+        coeffGranularity =+            Map.fold max (RA.getGranularity val) (Map.map RA.getGranularity coeffs)+        coeffs = Map.map (\[a] -> a) coeffsSingletons++        oe = (oln, oh)+        oh = UFB.affine (valH + coeffTotalRadius) (Map.map fst coeffsMidsAndErrbnds)+        oln = UFB.affine (coeffTotalRadius - valL) (Map.map (negate . fst) coeffsMidsAndErrbnds)+        +        ie = ((iln, ih), True)+        ih = +            UFB.affine +                (valH `plusDown` (- coeffTotalErrbnd)) +                (Map.map fst coeffsMidsAndErrbnds)+        iln = +            UFB.affine +                (negate $ coeffTotalErrbnd + valL) +                (Map.map (negate . fst) coeffsMidsAndErrbnds)+        coeffTotalErrbnd =+            Map.fold (+) 0 $ Map.map snd coeffsMidsAndErrbnds+        +        (valL, valH) = UFB.raEndpoints oh val+        +        coeffTotalRadius = +            Map.fold (+) 0 coeffsRads+        coeffsRads =+            Map.map (\(l,h) -> (h - l)/2) coeffsEndpoints+        coeffsEndpoints =+            Map.map+                (mapPairHomog (B.setMinGranularity coeffGranularity) +                 . +                 UFB.raEndpoints oh) +                coeffs+        coeffsMidsAndErrbnds =+            Map.map computeMidCorr coeffsEndpoints+            where+            computeMidCorr (l,h) =+                (midUp, midUp - midDown)+                where+                midUp = (l+h)/2+                midDown = negate $ ((negate l) + (negate h)) / 2+    composeWithThin+            f@(ERFnIntervalOIAny ctxt)+            substitutions =+        f+    composeWithThin+            f@(ERFnIntervalOI ctxt oe@(oln,oh) ie@((iln,ih),isDefinitelyAC))+            substitutions =+--        unsafePrintReturn+--        (+--            "ER.RnToRm.UnitDom.Interval: composeWithThin: "+--            ++ "\n f = " ++ show f+--            ++ "\n substitutions = " ++ show substitutions+--            ++ "\n inconsistencies = " ++ show (UFA.keyPointsConsistencyCheck resultReals result)+--            ++ "\n result = "+--        )+--        $+        result+        where+        resultReals ptB = -- this is only used for consistency checking...+            (\[x] -> x) $+            FA.eval ptBOuter f+            where+            ptBOuter =+                foldl insertVal ptB $ Map.toList substitutions+            insertVal  ptB (varid, fInner) =+                DBox.insert varid (evalPtB fInner) ptB+            evalPtB fInner =+                FA.ranra2domra fInner $ (\[x] -> x) $ FA.eval ptB fInner+                +        result = ERFnIntervalOI ctxt oeNew ieNew+        oeNew = (olnNew, ohNew)+        ieNew = ((ilnNew, ihNew), isDefinitelyAC)+        olnNew = UFB.composeManyUp maxDegree maxSize oln ufbSubstitutions+        ohNew = UFB.composeManyUp maxDegree maxSize oh ufbSubstitutions +        ilnNew = UFB.composeManyDown maxDegree maxSize iln ufbSubstitutions+        ihNew = UFB.composeManyDown maxDegree maxSize ih ufbSubstitutions +        ufbSubstitutions = Map.map (snd . erfnoiOuter) substitutions+        maxDegree = erfnMaxDegree ctxt+        maxSize = erfnMaxSize ctxt+--        ctxt = erfnContextUnify ctxt1 ctxt2+--    intersectMeasureImprovement ix vars+--            f1@(ERFnIntervalAny ctxt1) +--            f2@(ERFnIntervalAny ctxt2) =+--        (ERFnIntervalAny ctxt, RA.bottomApprox)+--        where+--        ctxt = erfnContextUnify ctxt1 ctxt2+--    intersectMeasureImprovement ix vars+--            f1@(ERFnIntervalAny ctxt1) +--            f2@(ERFnInterval ln2 h2 ctxt2) =+--        (ERFnInterval ln2 h2 ctxt, RA.plusInfinity)+--        where+--        ctxt = erfnContextUnify ctxt1 ctxt2+--    intersectMeasureImprovement ix vars+--            f1@(ERFnInterval ln1 h1 ctxt1) +--            f2@(ERFnIntervalAny ctxt2) = +--        (ERFnInterval ln1 h1 ctxt, 1)+--        where+--        ctxt = erfnContextUnify ctxt1 ctxt2+--    intersectMeasureImprovement ix vars+--            f1@(ERFnInterval ln1 h1 ctxt1) +--            f2@(ERFnInterval ln2 h2 ctxt2) =+--        case RA.compareReals improvementRA 1 of+--            Just LT -> (f1, 1) -- intersection made it worse, keep original+--            _ ->  (intersection, improvementRA)+--        where+--        intersection = +------ #ifdef RUNTIME_CHECKS+------             check ("ERFnInterval: intersectMeasureImprovement:\n f1:\n" ++ show f1 ++ "\n f2:\n" ++ show f2 ++ "\n intersection:\n") $+------ #endif+--            normalise $+--            f1 RA./\ f2+--        improvementRA +--            | 0 `RA.refines` intersectionVolume && 0 `RA.refines` f1Volume = 1+----                error $ +----                    "ERFnInterval: intersectMeasureImprovement: inconsistent result: " +----                    ++ show intersection+--            | otherwise =+--                 f1Volume / intersectionVolume+--        intersectionVolume = UFA.volume vars intersection+--        f1Volume = UFA.volume vars f1+--        ctxt = erfnContextUnify ctxt1 ctxt2+--    volume vars (ERFnIntervalOIAny c) = RA.plusInfinity+--    volume vars (ERFnIntervalOI ctxt (oln,oh) ((iln,ih),_)) =+--        UFB.raFromEndpoints h (volL, volH)+--        where +--        ovolH = UFB.volumeAboveZeroUp vars (ln +^ h)+--        ovolL = negate $ UFB.volumeAboveZeroUp vars (l +^ hn)+--        ivolH = UFB.volumeAboveZeroUp vars (ln +^ h)+--        l = UFB.neg ln+--        hn = UFB.neg h+--    integrate _ f@(ERFnIntervalAny c) _ _ _ = f +--    integrate +--            ix fD@(ERFnInterval ln h c) x +--            origin fI@(ERFnInterval lnInit hInit cInit) =+----        unsafePrintReturn+----        (+----            "ERFnInterval: integrate: " +----            ++ "\n u = " ++ show u+----            ++ "\n ln = " ++ show ln+----            ++ "\n origin = " ++ show origin+----            ++ "\n uInit = " ++ show uInit+----            ++ "\n lnInit = " ++ show lnInit+----            ++ "\n uIuL = " ++ show uIuL+----            ++ "\n uIuU = " ++ show uIuU+----            ++ "\n uIuOriginL = " ++ show uIuOriginL+----            ++ "\n uIuOriginU = " ++ show uIuOriginU+----            ++ "\n lnIuL = " ++ show lnIuL+----            ++ "\n lnIuU = " ++ show lnIuU+----            ++ "\n lnIuOriginL = " ++ show lnIuOriginL+----            ++ "\n lnIuOriginU = " ++ show lnIuOriginU+----            ++ "\n uIov = " ++ show uIov+----            ++ "\n lnIov = " ++ show lnIov+----            ++ "\n result = "+----        )+----        $+------ #ifdef RUNTIME_CHECKS+------         check ("ERFnInterval: integrate:\n fD:\n" ++ show fD ++ "\n fI:\n" ++ show fI ++ "\n result:\n") $+------ #endif+--        normalise $+--        (ERFnInterval lnIov hIov c)+--        where+--        -- perform raw integration of both bounds:+--        (hIuL, hIuH) = +----            mapPair (UFB.reduceDegreeDown maxDegree, UFB.reduceDegreeUp maxDegree) $ +--                UFB.integrate x h+--        (lnIuL, lnIuH) = +----            mapPair (UFB.reduceDegreeDown maxDegree, UFB.reduceDegreeUp maxDegree) $ +--                UFB.integrate x ln+--        maxDegree = erfnMaxDegree c+--        maxSize = erfnMaxSize c+--        -- constrain the raw integrals to the origin:+--        (hIuOriginLNeg, hIuOriginH) =+--            UFB.composeEncl maxDegree maxSize hIuL x originEncl+--        (lnIuOriginLNeg, lnIuOriginH) = +--            UFB.composeEncl maxDegree maxSize lnIuL x originEncl+--        originEncl = UFB.constEncl $ UFB.raEndpoints h origin+--        -- adjust the raw integrated functions to enclose the initial condition function:                        +--        hIov = +--            UFB.reduceSizeUp maxSize $+--                hIuH +^ hInit +^ hIuOriginLNeg +^ (hIuOriginH +^ hIuOriginLNeg)+--        lnIov = +--            UFB.reduceSizeUp maxSize $+--                lnIuH +^ lnInit +^ lnIuOriginLNeg +^ (lnIuOriginH +^ lnIuOriginLNeg)+--++instance+    (UFB.ERUnitFnBase boxb boxra varid b ra fb) =>+    RA.ERApproxApprox (ERFnIntervalOI fb)+    where+    safeIncludes _ (ERFnIntervalOIAny _) = False+    safeIncludes (ERFnIntervalOIAny _) _ = True+    safeIncludes f g =+        (UFB.upperBound 10 (olng -^ ilnf) <= 0)+        &&+        (UFB.upperBound 10 (ohg -^ ihf) <= 0)+        where+        (ERFnIntervalOI _ _ ((ilnf,ihf),_)) = f +        (ERFnIntervalOI _ (olng,ohg) _) = g+    safeNotIncludes _ (ERFnIntervalOIAny _) = True+    safeNotIncludes (ERFnIntervalOIAny _) _ = False+    safeNotIncludes f g =+        (UFB.upperBound 10 (olnf -^ ilng) < 0)+        ||+        (UFB.upperBound 10 (ohf -^ ihg) < 0)+        where+        (ERFnIntervalOI _ (olnf,ohf) _) = f+        (ERFnIntervalOI _ _ ((ilng,ihg),_)) = g+    includes _ (ERFnIntervalOIAny _) = Just False+    includes (ERFnIntervalOIAny _) _ = Just True+    includes f g+        | RA.safeIncludes f g = Just True+        | RA.safeNotIncludes f g = Just False+        | otherwise = Nothing++instance+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra fb,+     UFB.ERUnitFnBaseIEncl boxb boxra varid b ra fb) +    =>+    FA.ERFnApproxApprox boxra varid ra (ERApproxOI ra) (ERFnIntervalOI fb)+    where+    evalAA box (ERFnIntervalOIAny _) = +        [ERApproxOI (RA.bottomApprox) (RA.topApprox)]+    evalAA box (ERFnIntervalOI _ oe ie) =+        [ERApproxOI (UFB.evalEncl box oe) (UFB.evalIEncl box ie)]+

@@ -11,8 +11,8 @@     Stability   :  experimental     Portability :  portable -    A class  abstracting function arithmetic with directed rounding.-    It is used to describe a boundary for an approximation+    Classes  abstracting function arithmetic with directed rounding.+    Instances are used to describe a boundary for an approximation     to a real function on the interval [-1,1]^n.          To be imported qualified, usually with the synonym UFB.@@ -21,8 +21,8 @@  import Prelude hiding (min, max, recip, const) -import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox) import Data.Number.ER.BasicTypes import qualified Data.Number.ER.Real.Base as B import qualified Data.Number.ER.Real.Approx as RA@@ -33,7 +33,7 @@  import Data.Typeable -class +class     (B.ERRealBase b, RA.ERIntApprox ra, Ord ufb,      DomainBox boxb varid b, DomainIntBox boxra varid ra) =>      ERUnitFnBase boxb boxra varid b ra ufb@@ -135,9 +135,6 @@     {-| Construct a constant basic function. -}     const :: b -> ufb     -    {-| Construct a constant basic enclosure (negated lower bound, upper bound). -}-    constEncl :: (b,b) -> (ufb, ufb)-         {-| Construct an affine basic function. -}     affine ::          b {-^ value at 0 -} ->@@ -151,9 +148,19 @@     {-|         Find an upper bound of a basic function over @[-1,1]^n@.     -}+    bounds :: EffortIndex -> ufb -> (b,b)+    +    {-|+        Find an upper bound of a basic function over @[-1,1]^n@.+    -}     upperBound :: EffortIndex -> ufb -> b          {-|+        Find an upper bound of a basic function over @[-1,1]^n@.+    -}+    upperBoundPrecise :: EffortIndex -> ufb -> b+    +    {-|         Approximate the function @max(f1,f2)@ from above.     -}     maxUp :: @@ -171,7 +178,25 @@         ufb {-^ @f1@ -} ->          ufb {-^ @f2@ -} ->          ufb-    +    {-|+        Approximate the function @max(f1,f2)@ from below.+    -}+    maxDown :: +        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        ufb {-^ @f1@ -} -> +        ufb {-^ @f2@ -} -> +        ufb+    {-|+        Approximate the function @min(f1,f2)@ from below.+    -}+    minDown :: +        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        ufb {-^ @f1@ -} -> +        ufb {-^ @f2@ -} -> +        ufb+     {--------------}             {----- Field operations ----------}     {--------------}        @@ -180,6 +205,11 @@     neg :: ufb -> ufb      {-|+        Add a scalar to a basic function, rounding upwards.+    -}+    addConstUp :: b -> ufb -> ufb+    +    {-|         Multiply a basic function by a scalar, rounding upwards.     -}     scaleUp :: b -> ufb -> ufb@@ -200,34 +230,12 @@     {-| Pointwise upwards rounded multiplication -}     (*^) :: ufb -> ufb -> ufb     -    {-| Enclosure multiplication --        IMPORTANT: enclosure = (negated lower bound, upper bound)    -     -}-    multiplyEncl :: -        Int {-^ maximum polynomial degree -} -> -        Int {-^ maximum term count -} -> -        (ufb,ufb) -> (ufb,ufb) -> (ufb, ufb)-           {-|          Approximate the function @1/f@ from above, assuming         @f@ does not hit zero in the unit domain.     -}     recipUp :: Int -> Int -> EffortIndex -> ufb -> ufb -    {-|-        Approximate the reciprocal of an enclosure, assuming-        @f@ does not hit zero in the unit domain.-        -        IMPORTANT: enclosure = (negated lower bound, upper bound)    -    -}-    recipEncl :: -        Int {-^ max degree for result -} ->-        Int {-^ max approx size for result -} ->-        EffortIndex -> -        (ufb,ufb) {-^ enclosure of @f@ -} -> -        (ufb,ufb)-     {--------------}     {----- Evaluation and composition of functions -----}     {--------------}@@ -239,6 +247,12 @@     evalUp :: boxb -> ufb -> b      {-|+        Evaluate a basic function at a point rounding downwards +        using a basic number for both the point and the result.+    -}+--    evalDown :: boxb -> ufb -> b++    {-|         Safely evaluate a basic function at a point using a real number approximation         for both the point and the result.     -}@@ -252,7 +266,7 @@     partialEvalApproxUp :: boxra -> ufb -> ufb      {-| -        Compose two basic functions, rounding downwards and upwards, +        Compose two basic functions, rounding upwards,          assuming @f_v@ ranges within the domain @[-1,1]@.      -}     composeUp ::@@ -266,25 +280,40 @@         ufb {-^ pointwise upper bound of @f[v |-> f_v]@ -}      {-| -        Compose two basic functions, rounding downwards and upwards, +        Substitute several variables in a basic function with other basic functions, +        rounding upwards, assuming each @f_v@ ranges +        within the domain @[-1,1]@. +    -} +    composeManyUp ::+        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        ufb {-^ function @f@ -} -> +        Map.Map varid ufb +         {-^ variables to substitute and for each variable @v@, +             function @f_v@ to substitute for @v@ +             that maps @[-1,1]@ into @[-1,1]@  -} ->+        ufb {-^ pointwise upper bound of @f[v |-> f_v]@ -}++    {-| +        Compose two basic functions, rounding downwards,          assuming @f_v@ ranges within the domain @[-1,1]@.      -}-    composeEncl ::+    composeDown ::         Int {-^ max degree for result -} ->          Int {-^ max approx size for result -} ->         ufb {-^ function @f@ -} ->          varid {-^ variable @v@ to substitute in @f@ -} -> -        (ufb, ufb) -         {-^ enclosure of a function @f_v@ to substitute for @v@ +        ufb +         {-^ function @f_v@ to substitute for @v@               that maps @[-1,1]@ into @[-1,1]@  -} ->-        (ufb, ufb) {-^ enclosure of @f[v |-> f_v]@ -}+        ufb {-^ pointwise lower bound of @f[v |-> f_v]@ -}      {-|          Substitute several variables in a basic function with other basic functions, -        rounding downwards and upwards, assuming each @f_v@ ranges +        rounding downwards, assuming each @f_v@ ranges          within the domain @[-1,1]@.      -} -    composeManyUp ::+    composeManyDown ::         Int {-^ max degree for result -} ->          Int {-^ max approx size for result -} ->         ufb {-^ function @f@ -} -> @@ -292,9 +321,138 @@          {-^ variables to substitute and for each variable @v@,               function @f_v@ to substitute for @v@               that maps @[-1,1]@ into @[-1,1]@  -} ->-        ufb {-^ pointwise upper bound of @f[v |-> f_v]@ -}+        ufb {-^ pointwise lower bound of @f[v |-> f_v]@ -} +    {--------------}+    {----- Approximate symbolic integration ----------}    +    {--------------}++    {-|+        Approximate the primitive function of @f@ from below and from above.+    -}+    integrate ::+        varid {-^ variable to integrate by -} -> +        ufb {-^ @f@ -} -> +        (ufb, ufb)+    +    {-|+        Approximate the derivative of @f@ from below and from above.+    -}+    differentiate ::+        varid {-^ variable to differentiate by -} -> +        ufb {-^ @f@ -} -> +        (ufb, ufb)+         {-| +        Measure the volume between a function +        and the zero hyperplane on the domain @[-1,1]^n@.+    -}+    volumeAboveZeroUp :: +        [varid] +            {-^ dimensions to include in the measuring domain; +                have to include all those present in @f@ -} -> +        ufb {-^ @f@ -} -> +        b+    volumeAboveZeroUp vars p =+--    unsafePrint ("chplVolumeAboveZero: returning:" ++ show result) $+--    unsafePrint ("chplVolumeAboveZero: vars = " ++ show vars) $+        result+        where+        result = integUpAtEvenCorners - integDownAtOddCorners+        integUpAtEvenCorners = sumUp $ map (\pt -> evalUp pt integUp) evenCorners+        integDownAtOddCorners = sumUp $ map (\pt -> evalUp pt integDownNeg) oddCorners+        evenCorners = map (DBox.fromList) evenCornersL+        oddCorners = map (DBox.fromList) oddCornersL+        (evenCornersL, oddCornersL) =+            allPairsCombinationsEvenOdd $ zip vars $ repeat (1,-1)+        integUp = integrateByAllVars snd p vars+        integDownNeg = neg $ integrateByAllVars fst p vars+        integrateByAllVars pick p [] = p+        integrateByAllVars pick p (x : xs) =+            integrateByAllVars pick ip xs+            where+            ip = pick $ integrate x p+        ++class+    (ERUnitFnBase boxb boxra varid b ra ufb) => +    ERUnitFnBaseEncl boxb boxra varid b ra ufb+    | ufb -> boxb boxra varid b ra+    where+    boundsEncl :: EffortIndex -> (ufb,ufb) -> (b,b)+    +    {-| Construct a constant basic enclosure (negated lower bound fn, upper bound fn) +        from bounds given as coeffients (lower bound, upper bound). -}+    constEncl :: (b,b) -> (ufb, ufb)+    +    evalEncl :: boxra -> (ufb,ufb) -> ra+    +    evalEnclInner :: boxra -> (ufb,ufb) -> ra+    +    {-| Enclosure and base constant addition++        IMPORTANT: enclosure = (NEGATED lower bound, upper bound)    +     -}+    addConstEncl :: +        Int {-^ maximum polynomial degree -} -> +        Int {-^ maximum term count -} -> +        b -> (ufb,ufb) -> (ufb, ufb)+      +    {-| Enclosure scaling by a base constant++        IMPORTANT: enclosure = (NEGATED lower bound, upper bound)    +     -}+    scaleEncl :: +        Int {-^ maximum polynomial degree -} -> +        Int {-^ maximum term count -} -> +        b -> (ufb,ufb) -> (ufb, ufb)+      +    {-| Enclosure addition++        IMPORTANT: enclosure = (NEGATED lower bound, upper bound)    +     -}+    addEncl :: +        Int {-^ maximum polynomial degree -} -> +        Int {-^ maximum term count -} -> +        (ufb,ufb) -> (ufb,ufb) -> (ufb, ufb)+      +    {-| Enclosure multiplication ++        IMPORTANT: enclosure = (NEGATED lower bound, upper bound)    +     -}+    multiplyEncl :: +        Int {-^ maximum polynomial degree -} -> +        Int {-^ maximum term count -} -> +        (ufb,ufb) -> (ufb,ufb) -> (ufb, ufb)+      +    {-|+        Approximate the reciprocal of an enclosure, assuming+        @f@ does not hit zero in the unit domain.+        +        IMPORTANT: enclosure = (negated lower bound, upper bound)    +    -}+    recipEncl :: +        Int {-^ max degree for result -} ->+        Int {-^ max approx size for result -} ->+        EffortIndex -> +        (ufb,ufb) {-^ enclosure of @f@ -} -> +        (ufb,ufb)++    {-| +        Compose two basic functions, rounding downwards and upwards, +        assuming @f_v@ ranges within the domain @[-1,1]@. +    -}+    composeEncl ::+        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        ufb {-^ function @f@ -} -> +        varid {-^ variable @v@ to substitute in @f@ -} -> +        (ufb, ufb) +         {-^ enclosure of a function @f_v@ to substitute for @v@ +             that maps @[-1,1]@ into @[-1,1]@  -} ->+        (ufb, ufb) {-^ enclosure of @f[v |-> f_v]@ -}++    {-|          Substitute several variables in a basic function with other basic functions,          rounding downwards and upwards, assuming each @f_v@ ranges          within the domain @[-1,1]@. @@ -309,10 +467,12 @@              that maps @[-1,1]@ into @[-1,1]@  -} ->         (ufb, ufb) {-^ enclosure of @f[v |-> f_v]@ -} -    {--------------}-    {----- Selected elementary operations ----------}    -    {--------------}-    ++class+    (ERUnitFnBaseEncl boxb boxra varid b ra ufb) => +    ERUnitFnBaseElementary boxb boxra varid b ra ufb+    | ufb -> boxb boxra varid b ra+    where     {-|         Approximate @sqrt(f)@ for enclosures.     -}@@ -369,47 +529,140 @@         EffortIndex {-^ how hard to try when approximating cos as a polynomial -} ->          (ufb, ufb) {-^ @f@ -} ->          (ufb, ufb)-        -    {--------------}-    {----- Approximate symbolic integration ----------}    -    {--------------} -    {-|-        Approximate the primitive function of @f@ from below and from above.+class+    (ERUnitFnBase boxb boxra varid b ra ufb) => +    ERUnitFnBaseIEncl boxb boxra varid b ra ufb+    | ufb -> boxb boxra varid b ra+    where+    {-| Construct a constant basic inner enclosure +            (negated lower bound fn, upper bound fn, is enclosure definitely anticonsistent?) +        from bounds given as coeffients (lower bound, upper bound).+        An inner enclosure @(lnI,hI)@ is anticonsistent+        iff @hI + lnI  <= 0@, ie upper bound is never above lower bound.     -}-    integrate ::-        varid {-^ variable to integrate by -} -> -        ufb {-^ @f@ -} -> -        (ufb, ufb)+    constIEncl :: (b,b) -> ((ufb, ufb), Bool)     +    evalIEncl :: boxra -> ((ufb,ufb),Bool) -> ra+    {-|+        Inner enclosure addition.+     -}+    addIEncl :: +        Int {-^ maximum polynomial degree -} -> +        Int {-^ maximum term count -} ->+        ((ufb, ufb), Bool) ->+        ((ufb, ufb), Bool) ->+        ((ufb, ufb), Bool)+      +    {-|+        Inner enclosure multiplication.+     -}+    multiplyIEncl :: +        Int {-^ maximum polynomial degree -} -> +        Int {-^ maximum term count -} ->+        ((ufb, ufb), Bool) ->+        ((ufb, ufb), Bool) ->+        ((ufb, ufb), Bool)+      +    {-|+        Approximate the reciprocal of an inner enclosure, assuming+        @f@ is positive in the unit domain.+    -}+    recipIEnclPositive :: +        Int {-^ max degree for result -} ->+        Int {-^ max approx size for result -} ->+        EffortIndex ->+        ((ufb, ufb), Bool) ->+        ((ufb, ufb), Bool) +     {-| -        Measure the volume between a function -        and the zero hyperplane on the domain @[-1,1]^n@.+        Compose two basic functions, rounding downwards and upwards, +        assuming @f_v@ ranges within the domain @[-1,1]@.      -}-    volumeAboveZeroUp :: -        [varid] -            {-^ dimensions to include in the measuring domain; -                have to include all those present in @f@ -} -> -        ufb {-^ @f@ -} -> -        b-    volumeAboveZeroUp vars p =---    unsafePrint ("chplVolumeAboveZero: returning:" ++ show result) $---    unsafePrint ("chplVolumeAboveZero: vars = " ++ show vars) $-        result-        where-        result = integUpAtEvenCorners - integDownAtOddCorners-        integUpAtEvenCorners = sumUp $ map (\pt -> evalUp pt integUp) evenCorners-        integDownAtOddCorners = sumUp $ map (\pt -> evalUp pt integDownNeg) oddCorners-        evenCorners = map (DBox.fromList) evenCornersL-        oddCorners = map (DBox.fromList) oddCornersL-        (evenCornersL, oddCornersL) =-            allPairsCombinationsEvenOdd $ zip vars $ repeat (1,-1)-        integUp = integrateByAllVars snd p vars-        integDownNeg = neg $ integrateByAllVars fst p vars-        integrateByAllVars pick p [] = p-        integrateByAllVars pick p (x : xs) =-            integrateByAllVars pick ip xs-            where-            ip = pick $ integrate x p-        +    composeIEncl ::+        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        ufb {-^ function @f@ -} -> +        varid {-^ variable @v@ to substitute in @f@ -} -> +        ((ufb, ufb), Bool) +         {-^ inverse enclosure of a function @f_v@ to substitute for @v@ +             that maps @[-1,1]@ into @[-1,1]@  -} ->+        ((ufb, ufb), Bool) {-^ inverse enclosure of @f[v |-> f_v]@ -} +    {-| +        Substitute several variables in a basic function with other basic functions, +        rounding downwards and upwards, assuming each @f_v@ ranges +        within the domain @[-1,1]@. +    -} +    composeManyIEncls ::+        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        ufb {-^ function @f@ -} -> +        Map.Map varid ((ufb, ufb), Bool) +         {-^ variables to substitute and for each variable @v@ +             inverse enclosure of a function @f_v@ to substitute for @v@ +             that maps @[-1,1]@ into @[-1,1]@  -} ->+        ((ufb, ufb), Bool) {-^ inverse enclosure of @f[v |-> f_v]@ -}++class+    (ERUnitFnBaseIEncl boxb boxra varid b ra ufb) => +    ERUnitFnBaseIElementary boxb boxra varid b ra ufb+    | ufb -> boxb boxra varid b ra+    where+    {-|+        Approximate @sqrt(f)@ for enclosures.+    -}+    sqrtIEncl :: +        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        EffortIndex {-^ how hard to try when approximating exp as a polynomial -} -> +        ((ufb, ufb), Bool) {-^ @f@ -} -> +        ((ufb, ufb), Bool)+    {-|+        Approximate @exp(f)@ for enclosures.+    -}+    expIEncl :: +        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        EffortIndex {-^ how hard to try when approximating exp as a polynomial -} -> +        ((ufb, ufb), Bool) {-^ @f@ -} -> +        ((ufb, ufb), Bool)+    {-| +        Approximate @log(f)@ for enclosures.+    -}+    logIEncl :: +        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        EffortIndex {-^ how hard to try when approximating log as a polynomial -} -> +        ((ufb, ufb), Bool) {-^ @f@ -} -> +        ((ufb, ufb), Bool)+    {-| +        Approximate @sin(f)@ for enclosures,+        assuming the range of @f@ is within @[-pi/2,pi/2]@.+    -}+    sinIEncl :: +        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        EffortIndex {-^ how hard to try when approximating sin as a polynomial -} -> +        ((ufb, ufb), Bool) {-^ @f@ -} -> +        ((ufb, ufb), Bool)     +    {-|+        Approximate @cos(f)@ for enclosures,+        assuming the range of @f@ is within @[-pi/2,pi/2]@.+    -}+    cosIEncl :: +        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        EffortIndex {-^ how hard to try when approximating cos as a polynomial -} -> +        ((ufb, ufb), Bool) {-^ @f@ -} -> +        ((ufb, ufb), Bool)+    {-|+        Approximate @atan(f)@ for enclosures.+    -}+    atanIEncl :: +        Int {-^ max degree for result -} -> +        Int {-^ max approx size for result -} ->+        EffortIndex {-^ how hard to try when approximating cos as a polynomial -} -> +        ((ufb, ufb), Bool) {-^ @f@ -} -> +        ((ufb, ufb), Bool)+    

@@ -0,0 +1,375 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate+    Description :  (testing) generating basic functions for testing+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    A collection of basic functions to pick from when testing.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate+(+    FBSize10(..), +    FBSize10Small(..), +    FBSize10Degree3(..), +    FBEnclThinSize10(..), +    FBEnclThinSize10Small(..),+    FBEnclThinSize10Degree3(..), +    FBEnclParalSize10(..), +    FBEnclParalSize10Small(..),+    FBEnclParalSize10Degree3(..), +    FBEnclThickSize10(..), +    FBEnclThickSize10Small(..),+    FBEnclThickSize10Degree3(..),+    Deg20Size20(..),+    Deg10Size10(..),+    Deg5Size10(..),+    polynomials1200ishSize10,+    polynomials1200ishSize10Small,+    polynomials1200ishSize10Degree3,+    makeThinEncl,+    makeThickEncl,+    makeParalEncl+)+where++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB+import Data.Number.ER.RnToRm.UnitDom.Base ((+^),(-^),(*^))++import qualified Data.Number.ER.BasicTypes.DomainBox as DBox++import Data.Number.ER.BasicTypes.Tests.Generate++import qualified Data.Map as Map++import Test.QuickCheck++{---------------------}+{----- Generation of maximum size and degree limits -----}+{---------------------}++data Deg20Size20 = Deg20Size20 Int Int deriving (Show)+data Deg10Size10 = Deg10Size10 Int Int deriving (Show)+data Deg5Size10 = Deg5Size10 Int Int deriving (Show)++instance (Arbitrary Deg20Size20)+    where+    arbitrary =+        do+        maxDegree <- choose (2,20)+        maxSize <- choose (10,20)+        return $ Deg20Size20 maxDegree maxSize+    coarbitrary (Deg20Size20 maxDegree maxSize) =+        error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for Deg20Size20"++instance (Arbitrary Deg10Size10)+    where+    arbitrary =+        do+        maxDegree <- choose (1,10)+        maxSize <- choose (5,10)+        return $ Deg10Size10 maxDegree maxSize+    coarbitrary (Deg10Size10 maxDegree maxSize) =+        error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for Deg10Size10"++instance (Arbitrary Deg5Size10)+    where+    arbitrary =+        do+        maxDegree <- choose (1,5)+        maxSize <- choose (5,10)+        return $ Deg5Size10 maxDegree maxSize+    coarbitrary (Deg5Size10 maxDegree maxSize) =+        error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for Deg5Size10"++{---------------------}+{----- Types for different function enclosure generation distributions ----}+{---------------------}++type E fb = (fb,fb)++newtype FBEnclThinSize10 fb = FBEnclThinSize10 ((Int, Int), E fb) deriving (Show)+newtype FBEnclThinSize10Small fb = FBEnclThinSize10Small (Int, E fb) deriving (Show)+newtype FBEnclThinSize10Degree3 fb = FBEnclThinSize10Degree3 (Int, E fb) deriving (Show)++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThinSize10 fb)) +    where+    arbitrary =+        do+        (FBSize10 (fbId, fb)) <- arbitrary+        return $ FBEnclThinSize10 (fbId, makeThinEncl fb)+    coarbitrary (FBEnclThinSize10 p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThinSize10Small fb)) +    where+    arbitrary =+        do+        (FBSize10Small (fbId, fb)) <- arbitrary+        return $ FBEnclThinSize10Small (fbId, makeThinEncl fb)+    coarbitrary (FBEnclThinSize10Small p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThinSize10Degree3 fb)) +    where+    arbitrary =+        do+        (FBSize10Degree3 (fbId, fb)) <- arbitrary+        return $ FBEnclThinSize10Degree3 (fbId, makeThinEncl fb)+    coarbitrary (FBEnclThinSize10Degree3 p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++makeThinEncl fb = (UFB.neg fb, fb)++newtype FBEnclParalSize10 fb = FBEnclParalSize10 (((Int, Int), SmallRatio), E fb) deriving (Show)+newtype FBEnclParalSize10Small fb = FBEnclParalSize10Small ((Int, SmallRatio), E fb) deriving (Show)+newtype FBEnclParalSize10Degree3 fb = FBEnclParalSize10Degree3 ((Int, SmallRatio), E fb) deriving (Show)++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclParalSize10 fb)) +    where+    arbitrary =+        do+        (FBSize10 (fbId, fb)) <- arbitrary+        rat <- arbitrary+        return $ FBEnclParalSize10 ((fbId, rat), makeParalEncl fb rat)+    coarbitrary (FBEnclParalSize10 p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclParalSize10Small fb)) +    where+    arbitrary =+        do+        (FBSize10Small (fbId, fb)) <- arbitrary+        rat <- arbitrary+        return $ FBEnclParalSize10Small ((fbId, rat), makeParalEncl fb rat)+    coarbitrary (FBEnclParalSize10Small p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclParalSize10Degree3 fb)) +    where+    arbitrary =+        do+        (FBSize10Degree3 (fbId, fb)) <- arbitrary+        rat <- arbitrary+        return $ FBEnclParalSize10Degree3 ((fbId, rat), makeParalEncl fb rat)+    coarbitrary (FBEnclParalSize10Degree3 p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++makeParalEncl fb (SmallRatio num denom) =+--    unsafePrintReturn+--    (+--        "makeThinEncl: result = "+--    )+    (fbNeg, fb +^ cFB)+    where+    fbNeg = UFB.neg fb+    cFB = UFB.const cB+    cB = abs $ numB / (1000 * denomB)+    numB = fromInteger $ toInteger num+    denomB = fromInteger $ toInteger denom++newtype FBEnclThickSize10 fb = FBEnclThickSize10 (((Int, Int), (Int, Int)), E fb) deriving (Show)+newtype FBEnclThickSize10Small fb = FBEnclThickSize10Small ((Int, Int), E fb) deriving (Show)+newtype FBEnclThickSize10Degree3 fb = FBEnclThickSize10Degree3 ((Int, Int), E fb) deriving (Show)++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThickSize10 fb)) +    where+    arbitrary =+        do+        (FBSize10 (fbId1, fb1)) <- arbitrary+        (FBSize10 (fbId2, fb2)) <- arbitrary+        return $ FBEnclThickSize10 ((fbId1, fbId2), makeThickEncl 5 10 fb1 fb2)+    coarbitrary (FBEnclThickSize10 p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThickSize10Small fb)) +    where+    arbitrary =+        do+        (FBSize10Small (fbId1, fb1)) <- arbitrary+        (FBSize10Small (fbId2, fb2)) <- arbitrary+        return $ FBEnclThickSize10Small ((fbId1, fbId2), makeThickEncl 5 10 fb1 fb2)+    coarbitrary (FBEnclThickSize10Small p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThickSize10Degree3 fb)) +    where+    arbitrary =+        do+        (FBSize10Degree3 (fbId1, fb1)) <- arbitrary+        (FBSize10Degree3 (fbId2, fb2)) <- arbitrary+        return $ FBEnclThickSize10Degree3 ((fbId1, fbId2), makeThickEncl 5 10 fb1 fb2)+    coarbitrary (FBEnclThickSize10Degree3 p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++makeThickEncl maxDegree maxSize p1 p2 =+    (pMax q1Neg q2Neg, pMax q1 q2)+    where+    q1Neg = UFB.neg q1+    q2Neg = UFB.neg q2+    q1 = p1 +^ p2Mp1ScaledDown+    q2 = p1 -^ p2Mp1ScaledDown+    p2Mp1ScaledDown =+        UFB.scaleUp (10/sizeB) p2Mp1+        where+        sizeB = max (abs upperB) (abs lowerB)+        (lowerB, upperB) = UFB.bounds 10 p2Mp1+        p2Mp1 = p2 -^ p1+    pMax = UFB.maxUp maxDegree maxSize+    ++{---------------------}+{----- Types for different function generation distributions ----}+{---------------------}++newtype FBSize10 fb = FBSize10 ((Int, Int), fb) deriving (Show)+newtype FBSize10Small fb = FBSize10Small (Int, fb) deriving (Show)+newtype FBSize10Degree3 fb = FBSize10Degree3 (Int, fb) deriving (Show)++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBSize10 fb)) +    where+    arbitrary =+        sized arbitrarySized+        where+        arbitrarySized n +            | n <= 28 =+                elements $ map FBSize10 $ +                    zip (map (\n -> (0,n)) [0..]) $ +                        polynomials1200ishSize10Small $ UFB.const 0+            | otherwise =+                elements $ map FBSize10 $ +                    zip (map (\n -> (1,n)) [0..]) $ +                        polynomials1200ishSize10 $ UFB.const 0+    coarbitrary (FBSize10 p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBSize10Degree3 fb)) +    where+    arbitrary =+        sized arbitrarySized+        where+        arbitrarySized n = +            elements $ map FBSize10Degree3 $ +                zip [0..] $ +                    polynomials1200ishSize10Degree3 $ UFB.const 0+    coarbitrary (FBSize10Degree3 p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBSize10Small fb)) +    where+    arbitrary =+        sized arbitrarySized+        where+        arbitrarySized n = +            elements $ map FBSize10Small $ +                zip [0..] $ +                    polynomials1200ishSize10Small $ UFB.const 0+    coarbitrary (FBSize10Small p) =+        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"++polynomials1200ishSize10 sample =+    polynomials1200ish sample $ UFB.reduceSizeUp 10+    +polynomials1200ishSize10Small sample =+    polynomials1200ishSmall sample $ UFB.reduceSizeUp 10+    +polynomials1200ishSize10Degree3 sample =+    polynomials1200ish sample $ UFB.reduceSizeUp 10 . UFB.reduceDegreeUp 3+    +polynomials1200ishSmallSize10Degree3 sample =+    polynomials1200ishSmall sample $ UFB.reduceSizeUp 10 . UFB.reduceDegreeUp 3+    +polynomials1200ish sample rdc =+    polynomials1200ishBoth False sample rdc++polynomials1200ishSmall sample rdc =+    polynomials1200ishBoth True sample rdc+    ++{------------------}+{--------   A diverse collection of polynomials to pick from:    ----------}+{------------------}++polynomials1200ishBoth ::+    (UFB.ERUnitFnBase boxb boxra varid b ra fb) => +    Bool -> fb -> (fb -> fb) -> [fb]+polynomials1200ishBoth isSmall sample rdc +    | isSmall = +        concat $ map (powers2 rdc) $+        concat $ map addConsts5 $+        concat $ map multConsts5 $+        concat $ map addConsts2 $+        polyBase12+    | otherwise = +        concat $ map (powers4 rdc) $+        concat $ map addConsts5 $+        concat $ map multConsts5 $+        polyBase12+    where+    _ = [x0,one,sample] -- help type inference+    [x0,x1,x2,x3,x4] = map makeVar $ DBox.getNVars 5+        where+        makeVar i = UFB.affine 0 (Map.singleton i 1)+    [mone, one, two, three, seven, thousand, million, tiny, huge] = +        map UFB.const [-1,1,2,3,7,1000,1000000,10^^(-200),10^^200]+    polyBase12 =+            [+             x0+            ,+             x0 +^ x1+            ,+             x0 -^ x1+            ,+             (two *^ x0) +^ x1+            ,+             (two *^ x0) -^ x1+            ,+             (seven *^ x0) +^ x1+            ,+             (seven *^ x0) -^ x1+            ,+             (tiny *^ x0) +^ x1+            ,+             (tiny *^ x0) -^ x1+            ,+             x0 -^ x1 *^ x2+            ,+             x0 *^ x1 +^ x2 *^ x3 +^ x4+            ,+             x0 -^ x1 +^ x2 -^ x3 +^ x4+            ]+    powersAll rdc p =+        powersAux [p, rdc $ p *^ p]+        where+        powersAux (pNHalfM1 : pNHalf : rest) = +            pNHalfM1 : (powersAux $ (pNHalf : rest) ++ [pNM1, pN])+            where+            pNM1 = rdc $ pNHalf *^ pNHalfM1+            pN = rdc $ pNHalf *^ pNHalf+    +    powersForExps rdc p exponents =+        map pw exponents+        where+        pw n = pws !! (n - 1)+        pws = powersAll rdc p+    +    powers4 rdc p =+        powersForExps rdc p [1,2,3,4]+        +    powers2 rdc p =+        powersForExps rdc p [1,2]+        +    addConsts5 p =+        [p, p +^ mone, p +^ three, p +^ seven, p +^ thousand]+    +    multConsts5 p =+        [p, p *^ mone, p *^ two, p *^ three, p *^ seven]+    +    addConsts2 p =+        [p, p +^ mone]+    

@@ -0,0 +1,54 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Bounds+    Description :  (testing) properties of bounding operations+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Quickcheck properties of bounding operations, ie constant bounds and binary min/max.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Bounds+where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB++import Data.Number.ER.BasicTypes+import Data.Number.ER.BasicTypes.Tests.Generate++import Test.QuickCheck++prop_fbBounds_consistent sample reportFileName (Ix20 ix, FBSize10 (n,fb)) =+    fbAtKeyPointsCanBeLeq reportFileName (ix,n,True) fb fbHigh+    &&+    fbAtKeyPointsCanBeLeq reportFileName (ix,n,False) fbLow fb+    where+    _ = [fb,sample]+    fbLow = UFB.const cLow+    fbHigh = UFB.const cHigh+    (cLow, cHigh) = UFB.bounds ix fb++prop_fbMax_consistent sample reportFileName+        (Deg20Size20 maxDegree maxSize, FBSize10 (n1,fb1), FBSize10 (n2, fb2)) =+    fbAtKeyPointsPointwiseBinaryDownUpConsistent +        reportFileName ((maxDegree, maxSize), n1, n2) +        max fb1 fb2 (maxLow, maxHigh)+    where+    _ = [fb1,sample]+    maxLow = UFB.maxDown maxDegree maxSize fb1 fb2+    maxHigh = UFB.maxUp maxDegree maxSize fb1 fb2++prop_fbMin_consistent sample reportFileName+        (Deg20Size20 maxDegree maxSize, FBSize10 (n1,fb1), FBSize10 (n2, fb2)) =+    fbAtKeyPointsPointwiseBinaryDownUpConsistent +        reportFileName ((maxDegree, maxSize), n1, n2) +        min fb1 fb2 (minLow, minHigh)+    where+    _ = [fb1,sample]+    minLow = UFB.minDown maxDegree maxSize fb1 fb2+    minHigh = UFB.minUp maxDegree maxSize fb1 fb2

@@ -0,0 +1,276 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common+    Description :  (testing) generating polynomials for tests+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Auxiliary functions for use in test for polynomial enclosure arithmetic.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common +where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB+import Data.Number.ER.RnToRm.UnitDom.Base ((+^),(-^),(*^))++import Data.Number.ER.Real.Approx.Tests.Reporting++import qualified Data.Number.ER.Real.Base as B+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)+import Data.Number.ER.Misc++import qualified Data.Number.ER.Real.Approx as RA++fbAtKeyPointsCanBeLeq ::+    (UFB.ERUnitFnBase boxb boxra varid b ra fb, Show boxra, Show testId) => +    String {-^ report file name -} ->+    testId {-^ item to identify the random input given to the test -} ->+    fb ->+    fb ->+    Bool+fbAtKeyPointsCanBeLeq reportFileName testId fb1 fb2 =+    and $ map testPoint points+    where+    points = getKeyPoints (fb1 +^ fb2)+    testPoint point +        | lower1 <= upper2 =+            unsafeERTestReport reportFileName+                (testId, point, val1, val2) $+            True+        | otherwise =+            unsafePrint+            (+                "Failure at point = " ++ (show point)+            ) $+            False+        where+        val1 = UFB.evalApprox point fb1+        val2 = UFB.evalApprox point fb2+        (lower1, upper1) = UFB.raEndpoints fb1 val1 +        (lower2, upper2) = UFB.raEndpoints fb1 val2+    +getKeyPoints fb =+    getKeyPointsForVars $ UFB.getVariables fb+    +getKeyPointsForVars vars =+    points+    where+    points = map DBox.fromList $ allCombinations $ varDomPoints+    varDomPoints = map (\v -> (v,[-1,0,1])) vars++fbAtKeyPointsPointwiseBinaryDownUpConsistent ::+    (UFB.ERUnitFnBase boxb boxra varid b ra fb, Show boxra, Show testId) => +    String {-^ report file name -} ->+    testId {-^ item to identify the random input given to the test -} ->+    (ra -> ra -> ra) -> +    fb -> fb ->+    (fb, fb) ->+    Bool+fbAtKeyPointsPointwiseBinaryDownUpConsistent reportFileName testId raOp fb1 fb2 (resLow, resHigh) =+    and $ map testPoint points+    where+    points = getKeyPoints (fb1 +^ fb2)+    testPoint point +        | ok =+            unsafeERTestReport reportFileName+                (testId, point, raOpAtPoint, resAtPoint) $+            True+        | otherwise =+            unsafePrint+            (+                "fbAtKeyPointsPointwiseBinaryDownUpConsistent failed:"+                ++ "\n point = " ++ show point+                ++ "\n raOpAtPoint = " ++ show raOpAtPoint+                ++ "\n resAtPoint = " ++ show resAtPoint+            )+            False+        where+        ok = not $ RA.isDisjoint resAtPoint raOpAtPoint+        resAtPoint = valLow RA.\/ valHigh +        resAtPointLow = fst $ UFB.raEndpoints fb1 $ valLow +        resAtPointHigh = snd $ UFB.raEndpoints fb1 $ valHigh+        valLow = UFB.evalApprox point resLow+        valHigh = UFB.evalApprox point resHigh+        +        raOpAtPoint= raOp fb1AtPoint fb2AtPoint +        fb1AtPoint = UFB.evalApprox point fb1+        fb2AtPoint = UFB.evalApprox point fb2+++enclRestrictRange ix md ms (Nothing, Nothing) preEncl = (True, preEncl)+enclRestrictRange ix md ms (maybeLower, maybeUpper) preEncl =+    (succeeded, fbEncl)+    where+    succeeded = lowerSucceeded && upperSucceeded+    lowerSucceeded =+        case maybeLower of+            Nothing -> True+            Just lower -> lower < pLowerBound +    upperSucceeded =+        case maybeUpper of+            Nothing -> True+            Just upper -> pUpperBound < upper+    (pLowerBound, pUpperBound) = UFB.boundsEncl ix fbEncl+    fbEncl =+        case (maybeLower, maybeUpper) of+            (Just lowerB, Nothing) ->+                case lowerB < preLowerBoundB of+                    True -> preEncl -- enclosure already in the range+                    False -> -- a shift needed to get above the lower bound+                        UFB.addEncl md ms (b2encl $ lowerB - preLowerBoundB + sepB) preEncl+            (Nothing, Just upperB) ->+                case preUpperBoundB < upperB of+                    True -> preEncl -- enclosure already in the range+                    False -> -- a shift needed to get below the upper bound+                        UFB.addEncl md ms (b2encl $ upperB - preUpperBoundB - sepB) preEncl+            (Just lowerB, Just upperB) ->+                case lowerB < preLowerBoundB && preUpperBoundB < upperB of+                    True -> preEncl -- enclosure already in the range+                    _ -> +                        case preWidthB + sepB <= widthB of+                            True -> -- no scaling needed, only shifting by a constant to the centre of the range+                                UFB.addEncl md ms +                                    (b2encl $ lowerB - preLowerBoundB + (preWidthB - widthB)/2) +                                    preEncl+                            _ -> -- full affine transformation needed+                                UFB.addEncl md ms+                                    (b2encl $ lowerB + sepB) $+                                    UFB.multiplyEncl md ms -- scale preEncl so that it fits inside the range+                                        (b2encl $ widthB / saferPreWidthB) $+                                        UFB.addEncl md ms -- shift preEncl so that it is non-negative and as close to 0 as safely possible+                                            (b2encl $ sepB - preLowerBoundB)+                                            preEncl+                where +                widthB = upperB - lowerB+                saferPreWidthB = preWidthB + 2 * sepB+    sepB = preWidthB / 1000000+    preWidthB = preUpperBoundB - preLowerBoundB+    (preLowerBoundB, preUpperBoundB) = UFB.boundsEncl ix preEncl++b2encl b = UFB.constEncl (b,b)+    +enclAtKeyPointsPointwiseBinaryInnerInOuter ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra fb, Show boxra, Show testId) => +    String {-^ report file name -} ->+    testId {-^ item to identify the random input given to the test -} ->+    (ra -> ra -> ra)+        {-^ this real approx operation has to return an *inner* approximation of the exact result set, +            ie each number that the approximation supports is in the maximal extension -} ->+    (fb, fb) {-^ enclosure of argument 1 -} ->+    (fb, fb) {-^ enclosure of argument 2 -} ->+    (fb, fb) {-^ alleged enclosure of result -} ->+    Bool+enclAtKeyPointsPointwiseBinaryInnerInOuter+        reportFileName testId+        raOpInner +        p1Encl@(p1LowNeg, p1High) p2Encl@(p2LowNeg, p2High) resEncl =+    and $ map testPoint points+    where+    points = getKeyPoints (p1High +^ p2High +^ p1LowNeg +^ p2LowNeg)+    testPoint point +        | result =+            unsafeERTestReport reportFileName+                (testId, point, p1OpInnerP2AtPoint, resAtPoint) $+            result+        | otherwise = +            unsafePrint+            (+                "enclAtKeyPointsPointwiseBinaryInnerInOuter failed"+                ++ "\n point = " ++ show point+                ++ "\n p1AtPoint = " ++ show p1AtPoint+                ++ "\n p2AtPoint = " ++ show p2AtPoint+                ++ "\n p1OpInnerP2AtPoint = " ++ show p1OpInnerP2AtPoint+                ++ "\n resAtPoint = " ++ show resAtPoint+            ) $+            result+        where+        result = p1OpInnerP2AtPoint `RA.refines` resAtPoint+        p1OpInnerP2AtPoint = p1AtPoint `raOpInner` p2AtPoint+        resAtPoint = UFB.evalEncl point resEncl+--        resAtPoint = p1OpInnerP2AtPoint -- for dummy testing that never <<loop>>s+        p1AtPoint =  UFB.evalEnclInner point p1Encl+        p2AtPoint = UFB.evalEnclInner point p2Encl++enclAtKeyPointsPointwiseUnaryInnerInOuter ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra fb, Show boxra, Show testId) => +    String {-^ report file name -} ->+    testId {-^ item to identify the random input given to the test -} ->+    (ra -> ra)+        {-^ this real approx operation has to return an inner approximation of the exact result set, +            ie each number that the approximation supports is in the maximal extension -} ->+    (fb, fb) {-^ enclosure of argument -} ->+    (fb, fb) {-^ alleged enclosure of result -} ->+    Bool+enclAtKeyPointsPointwiseUnaryInnerInOuter+        reportFileName testId+        raOpInner+        fbEncl@(pLowNeg, pHigh) resEncl =+    and $ map testPoint points+    where+    points = getKeyPoints (pHigh +^ pLowNeg)+    testPoint point +        | result =+            unsafeERTestReport reportFileName+                (testId, point, opInnerPAtPoint, resAtPoint) $+            result +        | otherwise = +            unsafePrint+            (+                "enclAtKeyPointsPointwiseUnaryInnerInOuter failed"+                ++ "\n point = " ++ show point+                ++ "\n pAtPoint = " ++ show pAtPoint+                ++ "\n opInnerPAtPoint = " ++ show opInnerPAtPoint+                ++ "\n resAtPoint = " ++ show resAtPoint+            ) $+            result+        where+        result = opInnerPAtPoint `RA.refines` resAtPoint+        opInnerPAtPoint = raOpInner pAtPoint+        resAtPoint = UFB.evalEncl point resEncl+        pAtPoint = +--            normaliseERInterval $ +            UFB.evalEnclInner point fbEncl+++enclAtKeyPointsConsistent ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra fb, Show boxra, Show testId) => +    String {-^ report file name -} ->+    testId {-^ item to identify the random input given to the test -} ->+    (boxra -> ra)+        {-^ this operation has to return an inner approximation of the exact result set, +            ie each number that the approximation supports is a solution in the maximal extension -} ->+    [varid] {-^ variables to test over -} ->+    (fb, fb) {-^ alleged enclosure of result -} ->+    Bool+enclAtKeyPointsConsistent+        reportFileName testId+        opInner allVars resEncl@(resLowNeg, resHigh) =+    and $ map testPoint points+    where+    points = getKeyPointsForVars allVars+    testPoint point +        | result =+            unsafeERTestReport reportFileName+                (testId, point, opInnerAtPoint, resAtPoint) $+            result +        | otherwise = +            unsafePrint+            (+                "enclAtKeyPointsConsistent failed"+                ++ "\n point = " ++ show point+                ++ "\n opInnerAtPoint = " ++ show opInnerAtPoint+                ++ "\n resAtPoint = " ++ show resAtPoint+            ) $+            result+        where+        result = opInnerAtPoint `RA.refines` resAtPoint+        opInnerAtPoint = opInner point+        resAtPoint = UFB.evalEncl point resEncl++    

@@ -0,0 +1,121 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Compose+    Description :  (testing) properties of enclosure composition+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Quickcheck properties of polynomial enclosure composition.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Compose+where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate++import qualified Data.Number.ER.Real.Approx as RA+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox++import Data.Number.ER.BasicTypes+import Data.Number.ER.BasicTypes.Tests.Generate++import Data.Number.ER.Misc++import Test.QuickCheck++prop_enclCompose_ThinEncl_consistent+        sampleE reportFileName+        (Deg10Size10 maxDegree maxSize,+         varSelector,+         (FBEnclThinSize10 (n1,e1)),+         (FBEnclThinSize10 (n2,e2))) =+    compose_encl_consistent+        sampleE reportFileName +        maxDegree maxSize+        varSelector+        n1 e1 n2 e2++prop_enclCompose_ThickEncl_consistent+        sampleE reportFileName+        (Deg10Size10 maxDegree maxSize,+         varSelector,+         (FBEnclThinSize10 (n1,e1)),+         (FBEnclThickSize10 (n2,e2))) =+    compose_encl_consistent+        sampleE reportFileName +        maxDegree maxSize+        varSelector+        n1 e1 n2 e2++prop_enclCompose_ParalEncl_consistent+        sampleE reportFileName+        (Deg10Size10 maxDegree maxSize,+         varSelector,+         (FBEnclThinSize10 (n1, e1)),+         (FBEnclParalSize10 (n2,e2))) =+    compose_encl_consistent+        sampleE reportFileName +        maxDegree maxSize+        varSelector+        n1 e1 n2 e2++compose_encl_consistent +        sampleE reportFileName +        maxDegree maxSize +        varSelector+        e1Id e1@(e1LowNeg, e1High) e2Id e2@(e2LowNeg, e2High) =+--    unsafePrint+--    (+--        "compose_encl_consistent: "+--        ++ "\n e1High = " ++ show e1High+--        ++ "\n substVar = " ++ show substVar+--        ++ "\n e2High = " ++ show e2High+--        ++ "\n e2Low = " ++ show (UFB.neg e2LowNeg)+--        ++ "\n composition = " ++ show resEncl+--        ++ "\n**********************"+--    ) $+    enclAtKeyPointsConsistent+        reportFileName+        ((maxDegree, maxSize), varSelector, e1Id, e2Id)+        composeAtPointInner+        allVars+        resEncl+    where+    _ = [sampleE,e1]+    resEncl = UFB.composeEncl maxDegree maxSize e1High substVar e2+    substVar = e1Vars !! (varSelector `mod` (length e1Vars))+    e1Vars = UFB.getVariables e1High+    allVars = +        UFB.getVariables $ +            e1High UFB.+^ e2High UFB.+^ e2Low+            where+            e2Low = UFB.neg e2LowNeg+    composeAtPointInner point =+--        unsafePrintReturn+--        (+--            "\n point = " ++ show point+--            ++ "\n substVar = " ++ show substVar+--            ++ " substVal = " ++ show substVal+--            ++ "\n result = "+--        ) $+        result+        where+        result +            | RA.isConsistent substVal =+                UFB.evalEnclInner pointWithSubst (UFB.neg e1High, e1High)+            | otherwise =+                RA.toggleConsistency $+                    UFB.evalEncl pointWithSubstReversed (UFB.neg e1High, e1High)+        pointWithSubstReversed =+            DBox.insert substVar (RA.toggleConsistency substVal) point+        pointWithSubst =+            DBox.insert substVar substVal point+        substVal =+            UFB.evalEnclInner point e2+    +        

@@ -0,0 +1,88 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Division+    Description :  (testing) properties of polynomial enclosure division+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Quickcheck properties of polynomial enclosure division.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Division+where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate++import qualified Data.Number.ER.Real.Approx as RA+import Data.Number.ER.Real.Approx.Interval++import Data.Number.ER.BasicTypes+import Data.Number.ER.BasicTypes.Tests.Generate ++import Test.QuickCheck++prop_enclRecip_ThickEncl_consistent+        sampleE reportFileName+        (Deg5Size10 maxDegree maxSize,+         Ix10 ix,+         SmallRatio sepNum sepDenom,+         (isNegative, FBEnclThickSize10Small (n,preEncl))) =+    recip_encl_consistent+        sampleE reportFileName+        maxDegree maxSize +        ix +        sepNum sepDenom isNegative n preEncl++prop_enclRecip_ParalEncl_consistent+        sampleE reportFileName+        (Deg5Size10 maxDegree maxSize,+         Ix10 ix,+         SmallRatio sepNum sepDenom,+         (isNegative, FBEnclParalSize10Small (n,preEncl))) =+    recip_encl_consistent +        sampleE reportFileName+        maxDegree maxSize +        ix +        sepNum sepDenom isNegative n preEncl++prop_enclRecip_ThinEncl_consistent+        sampleE reportFileName+        (Deg5Size10 maxDegree maxSize,+         Ix10 ix,+         SmallRatio sepNum sepDenom,+         (isNegative, FBEnclThinSize10Small (n,preEncl))) =+    recip_encl_consistent +        sampleE reportFileName+        maxDegree maxSize +        ix +        sepNum sepDenom isNegative n preEncl++recip_encl_consistent +        sampleE reportFileName+        maxDegree maxSize +        ix +        sepNum sepDenom isNegative pId preEncl =+    excludedZero ==>+    enclAtKeyPointsPointwiseUnaryInnerInOuter+        reportFileName+        ((maxDegree, maxSize), ix, (sepNum, sepDenom), (isNegative, pId)) +        ((RA./:) 1)+        pEncl resEncl+    where+    _ = [sampleE, pEncl]+    resEncl = UFB.recipEncl maxDegree maxSize ix pEncl+    (excludedZero, pEncl) =+        enclRestrictRange ix maxDegree maxSize rangeNoZero preEncl+    rangeNoZero+        | isNegative = (Nothing, Just (-sepB))+        | otherwise = (Just sepB, Nothing)+    sepB = abs sepNumB / sepDenomB+    sepNumB = fromInteger $ toInteger sepNum+    sepDenomB = fromInteger $ toInteger sepDenom+        +    

@@ -0,0 +1,140 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Elementary+    Description :  (testing) properties of enclosure elementary operations+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Quickcheck properties of some elementary operations on primitive polynomial+    enclosures.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Elementary+where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate++import qualified Data.Number.ER.Real.Approx as RA+import qualified Data.Number.ER.Real.Base as B+import Data.Number.ER.Real.Arithmetic.Elementary++import Data.Number.ER.BasicTypes+import Data.Number.ER.BasicTypes.Tests.Generate ++import Test.QuickCheck++prop_enclSqrt_ThickEncl_consistent sampleE =+    encl_op_ThickEncl_consistent sampleE UFB.sqrtEncl erSqrt_IR_Inner positiveDomain++prop_enclSqrt_ParalEncl_consistent sampleE =+    encl_op_ParalEncl_consistent sampleE UFB.sqrtEncl erSqrt_IR_Inner positiveDomain++prop_enclSqrt_ThinEncl_consistent sampleE =+    encl_op_ThinEncl_consistent sampleE UFB.sqrtEncl erSqrt_IR_Inner positiveDomain+++prop_enclExp_ThickEncl_consistent sampleE =+    encl_op_ThickEncl_consistent sampleE UFB.expEncl erExp_IR_Inner noDomainRestriction++prop_enclExp_ParalEncl_consistent sampleE =+    encl_op_ParalEncl_consistent sampleE UFB.expEncl erExp_IR_Inner noDomainRestriction+    +prop_enclExp_ThinEncl_consistent sampleE =+    encl_op_ThinEncl_consistent sampleE UFB.expEncl erExp_IR_Inner noDomainRestriction+    +prop_enclSine_ThickEncl_consistent sampleE =+    encl_op_ThickEncl_consistent sampleE UFB.sinEncl erSine_IR_Inner sincosDomain++prop_enclSine_ParalEncl_consistent sampleE =+    encl_op_ParalEncl_consistent sampleE UFB.sinEncl erSine_IR_Inner sincosDomain+    +prop_enclSine_ThinEncl_consistent sampleE =+    encl_op_ThinEncl_consistent sampleE UFB.sinEncl erSine_IR_Inner sincosDomain+    +prop_enclCosine_ThickEncl_consistent sampleE =+    encl_op_ThickEncl_consistent sampleE UFB.cosEncl erCosine_IR_Inner sincosDomain++prop_enclCosine_ParalEncl_consistent sampleE =+    encl_op_ParalEncl_consistent sampleE UFB.cosEncl erCosine_IR_Inner sincosDomain+    +prop_enclCosine_ThinEncl_consistent sampleE =+    encl_op_ThinEncl_consistent sampleE UFB.cosEncl erCosine_IR_Inner sincosDomain+    +prop_enclAtan_ThickEncl_consistent sampleE =+    encl_op_ThickEncl_consistent sampleE UFB.atanEncl erATan_IR_Inner noDomainRestriction++prop_enclAtan_ParalEncl_consistent sampleE =+    encl_op_ParalEncl_consistent sampleE UFB.atanEncl erATan_IR_Inner noDomainRestriction+    +prop_enclAtan_ThinEncl_consistent sampleE =+    encl_op_ThinEncl_consistent sampleE UFB.atanEncl erATan_IR_Inner noDomainRestriction++sincosDomain :: (B.ERRealBase b) => (Maybe b, Maybe b)+sincosDomain = (Just (-1.57), Just 1.57) -- almost (-pi/2, pi/2)++noDomainRestriction :: (B.ERRealBase b) => (Maybe b, Maybe b)+noDomainRestriction = (Nothing, Nothing)++positiveDomain :: (B.ERRealBase b) => (Maybe b, Maybe b)+positiveDomain = (Just 0, Nothing) +    +encl_op_ThickEncl_consistent+        sampleE+        opEncl opInner rangeRestriction+        reportFileName+        (Deg5Size10 maxDegree maxSize,+         (Ix10 ix),+         (FBEnclThickSize10Degree3 (n,preE))) = +    enclAtKeyPointsPointwiseUnaryInnerInOuter+        reportFileName+        ((maxDegree, maxSize), ix, n) +        (opInner ix)+        e resEncl+    where+    _ = [sampleE, preE]+    (succeeded, e) = +        enclRestrictRange ix maxDegree maxSize rangeRestriction preE +    resEncl = opEncl maxDegree maxSize ix e+    +encl_op_ParalEncl_consistent+        sampleE+        opEncl opInner rangeRestriction+        reportFileName+        (Deg5Size10 maxDegree maxSize,+         (Ix10 ix),+         (FBEnclParalSize10Degree3 (n,preE))) = +    enclAtKeyPointsPointwiseUnaryInnerInOuter+        reportFileName+        ((maxDegree, maxSize), ix, n) +        (opInner ix)+        e resEncl+    where+    _ = [sampleE, preE]+    (succeeded, e) = +        enclRestrictRange ix maxDegree maxSize rangeRestriction preE +    resEncl = opEncl maxDegree maxSize ix e+    +encl_op_ThinEncl_consistent+        sampleE+        opEncl opInner rangeRestriction+        reportFileName+        (Deg5Size10 maxDegree maxSize,+         (Ix10 ix),+         (FBEnclThinSize10Degree3 (n,preE))) = +    enclAtKeyPointsPointwiseUnaryInnerInOuter+        reportFileName+        ((maxDegree, maxSize), ix, n) +        (opInner ix)+        e resEncl+    where+    _ = [sampleE, preE]+    (succeeded, e) = +        enclRestrictRange ix maxDegree maxSize rangeRestriction preE +    resEncl = opEncl maxDegree maxSize ix e+    +    

@@ -0,0 +1,176 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Enclosure+    Description :  (testing) properties of basic enclosure operations+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Quickcheck properties of basic enclosure operations, +    mainly ring operations.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Enclosure+where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB++import Data.Number.ER.BasicTypes.Tests.Generate++import qualified Data.Number.ER.Real.Approx as RA++{--- addition ----}++prop_enclAdd_ThickEncls_consistent ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra t, Show boxra, RA.ERInnerOuterApprox ra) =>+    (t,t) -> String -> (Deg5Size10, (FBEnclThickSize10 t, FBEnclThickSize10 t)) -> +    Bool+prop_enclAdd_ThickEncls_consistent =+    prop_binary_ThickEncls_consistent (RA.+:) UFB.addEncl+++prop_enclAdd_ParalEncls_consistent ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra t, Show boxra, RA.ERInnerOuterApprox ra) =>+    (t,t) -> String -> (Deg5Size10, (FBEnclParalSize10 t, FBEnclParalSize10 t)) -> +    Bool    +prop_enclAdd_ParalEncls_consistent =+    prop_binary_ParalEncls_consistent (RA.+:) UFB.addEncl++    +prop_enclAdd_ThinEncls_consistent ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra t, Show boxra, RA.ERInnerOuterApprox ra) =>+    (t,t) -> String -> (Deg5Size10, (FBEnclThinSize10 t, FBEnclThinSize10 t)) -> +    Bool+prop_enclAdd_ThinEncls_consistent =+    prop_binary_ThinEncls_consistent (RA.+:) UFB.addEncl++{--- multiplication ----}++prop_enclMult_ThickEncls_consistent ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra t, Show boxra, RA.ERInnerOuterApprox ra) =>+    (t,t) -> String -> (Deg5Size10, (FBEnclThickSize10 t, FBEnclThickSize10 t)) -> +    Bool+prop_enclMult_ThickEncls_consistent =+    prop_binary_ThickEncls_consistent (RA.*:) UFB.multiplyEncl+++prop_enclMult_ParalEncls_consistent ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra t, Show boxra, RA.ERInnerOuterApprox ra) =>+    (t,t) -> String -> (Deg5Size10, (FBEnclParalSize10 t, FBEnclParalSize10 t)) -> +    Bool    +prop_enclMult_ParalEncls_consistent =+    prop_binary_ParalEncls_consistent (RA.*:) UFB.multiplyEncl++    +prop_enclMult_ThinEncls_consistent ::+    (UFB.ERUnitFnBaseEncl boxb boxra varid b ra t, Show boxra, RA.ERInnerOuterApprox ra) =>+    (t,t) -> String -> (Deg5Size10, (FBEnclThinSize10 t, FBEnclThinSize10 t)) -> +    Bool+prop_enclMult_ThinEncls_consistent =+    prop_binary_ThinEncls_consistent (RA.*:) UFB.multiplyEncl+    +{--- scaling ----}++prop_enclScale_ThickEncl_consistent+        sampleE reportFileName+        (Deg10Size10 maxDegree maxSize,+         SmallRatio num denom,+         FBEnclThickSize10 (n, e)) =+    enclAtKeyPointsPointwiseBinaryInnerInOuter+        reportFileName +        ((maxDegree, maxSize), (num, denom), n)+        (RA.*:)+        cEncl e scaledEncl+    where+    _ = [e,sampleE]+    scaledEncl = UFB.scaleEncl maxDegree maxSize cB e+    cEncl = UFB.constEncl (cB,cB)+    cB = numB / denomB+    numB = fromInteger $ toInteger num+    denomB = fromInteger $ toInteger denom++prop_enclScale_ParalEncl_consistent+        sampleE reportFileName+        (Deg10Size10 maxDegree maxSize,+         SmallRatio num denom,+         FBEnclParalSize10 (n, e)) =+    enclAtKeyPointsPointwiseBinaryInnerInOuter+        reportFileName +        ((maxDegree, maxSize), (num, denom), n)+        (RA.*:)+        cEncl e scaledEncl+    where+    _ = [e,sampleE]+    scaledEncl = UFB.scaleEncl maxDegree maxSize cB e+    cEncl = UFB.constEncl (cB,cB)+    cB = numB / denomB+    numB = fromInteger $ toInteger num+    denomB = fromInteger $ toInteger denom++prop_enclScale_ThinEncl_consistent+        sampleE reportFileName+        (Deg10Size10 maxDegree maxSize,+         SmallRatio num denom,+         FBEnclThinSize10 (n, e)) =+    enclAtKeyPointsPointwiseBinaryInnerInOuter+        reportFileName +        ((maxDegree, maxSize), (num, denom), n)+        (RA.*:)+        cEncl e scaledEncl+    where+    _ = [e,sampleE]+    scaledEncl = UFB.scaleEncl maxDegree maxSize cB e+    cEncl = UFB.constEncl (cB,cB)+    cB = numB / denomB+    numB = fromInteger $ toInteger num+    denomB = fromInteger $ toInteger denom+    +prop_binary_ThickEncls_consistent+        opInner opEncl +        sampleE reportFileName+        (Deg5Size10 maxDegree maxSize,+         (FBEnclThickSize10 (n1,e1), +          FBEnclThickSize10 (n2,e2))) =+    enclAtKeyPointsPointwiseBinaryInnerInOuter+        reportFileName+        ((maxDegree, maxSize), (n1, n2))+        opInner+        e1 e2 resE+    where+    _ = [sampleE, e1]+    resE = opEncl maxDegree maxSize e1 e2+    +prop_binary_ParalEncls_consistent+        opInner opEncl +        sampleE reportFileName+        (Deg5Size10 maxDegree maxSize,+         (FBEnclParalSize10 (n1,e1), +          FBEnclParalSize10 (n2,e2))) =+    enclAtKeyPointsPointwiseBinaryInnerInOuter+        reportFileName+        ((maxDegree, maxSize), (n1, n2))+        opInner+        e1 e2 sumE+    where+    _ = [sampleE, e1]+    sumE = opEncl maxDegree maxSize e1 e2+    +prop_binary_ThinEncls_consistent+        opInner opEncl +        sampleE reportFileName+        (Deg5Size10 maxDegree maxSize,+         (FBEnclThinSize10 (n1,e1), +          FBEnclThinSize10 (n2,e2))) =+    enclAtKeyPointsPointwiseBinaryInnerInOuter+        reportFileName+        ((maxDegree, maxSize), (n1, n2))+        opInner+        e1 e2 sumE+    where+    _ = [sampleE, e1]+    sumE = opEncl maxDegree maxSize e1 e2+

@@ -0,0 +1,49 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Integration+    Description :  (testing) properties of ring operations+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Quickcheck properties for checking that polynomial intergration +    is consistent with polynomial differentiation.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Integration+where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB++import Data.Number.ER.BasicTypes.Tests.Generate+++prop_fbIntegrateDiffUp_consistent sample reportFileName +        (FBSize10 (n1,fb1), Nat10 varSelector) =+    fbAtKeyPointsCanBeLeq +        reportFileName (n1,var)+        fb1 fb1ID+    where+    _ = [fb1,sample]+    fb1ID = snd $ UFB.differentiate var fb1I+    fb1I = snd $ UFB.integrate var fb1+    +    var = vars !! (varSelector `mod` (length vars))+    vars = UFB.getVariables fb1++prop_fbIntegrateDiffDown_consistent sample reportFileName +        (FBSize10 (n1,fb1), Nat10 varSelector) =+    fbAtKeyPointsCanBeLeq +        reportFileName (n1,var)+        fb1ID fb1+    where+    _ = [fb1,sample]+    fb1ID = fst $ UFB.differentiate var fb1I+    fb1I = fst $ UFB.integrate var fb1+    +    var = vars !! (varSelector `mod` (length vars))+    vars = UFB.getVariables fb1

@@ -0,0 +1,44 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Reduce+    Description :  (testing) properties of reduction operations+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Quickcheck properties of operations that reduce the size of polynomials.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Reduce+where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB+++import Test.QuickCheck++prop_fbReduceTermCount_consistent sample reportFileName +        (FBSize10 (n,fb), Deg5Size10 _ maxSize) =+    maxSize < UFB.getSize fb ==>+    fbAtKeyPointsCanBeLeq reportFileName (n, maxSize, True) fb fbUp+    && +    fbAtKeyPointsCanBeLeq reportFileName (n, maxSize, False) fbDown fb+    where+    _ = [fb,sample]+    fbUp = UFB.reduceSizeUp maxSize fb +    fbDown = UFB.neg $ UFB.reduceSizeUp maxSize $ UFB.neg fb +    +prop_fbReduceDegree_consistent sample reportFileName +        (FBSize10 (n,fb), Deg5Size10 maxDegree _) =+    maxDegree < UFB.getDegree fb ==>+    fbAtKeyPointsCanBeLeq reportFileName (n, maxDegree, True) fb fbUp+    && +    fbAtKeyPointsCanBeLeq reportFileName (n, maxDegree, False) fbDown fb+    where+    _ = [fb,sample]+    fbUp = UFB.reduceDegreeUp maxDegree fb +    fbDown = UFB.neg $ UFB.reduceDegreeUp maxDegree $ UFB.neg fb 

@@ -0,0 +1,70 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Ring+    Description :  (testing) properties of ring operations+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Quickcheck properties of ring operations, ie addition and multiplication.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Ring+where++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB++import Data.Number.ER.BasicTypes.Tests.Generate++prop_fbAddConst_consistent sample reportFileName +        (SmallRatio num denom, FBSize10 (n, fb)) =+    fbAtKeyPointsPointwiseBinaryDownUpConsistent+        reportFileName ((num, denom), n) +        (+) cFB fb (sumLow, sumHigh)+    where+    _ = [fb,sample]+    sumHigh = UFB.addConstUp cB fb+    sumLow = UFB.neg $ UFB.addConstUp (-cB) (UFB.neg fb)+    cFB = UFB.const cB+    cB = numB / denomB+    numB = fromInteger $ toInteger num+    denomB = fromInteger $ toInteger denom++prop_fbScale_consistent sample reportFileName+        (SmallRatio num denom, FBSize10 (n, fb)) =+    fbAtKeyPointsPointwiseBinaryDownUpConsistent +        reportFileName ((num, denom), n) +        (*) cP fb (prodLow, prodHigh)+    where+    _ = [fb,sample]+    prodHigh = UFB.scaleUp cB fb+    prodLow = UFB.neg $ UFB.scaleUp (-cB) fb+    cP = UFB.const cB+    cB = numB / denomB+    numB = fromInteger $ toInteger num+    denomB = fromInteger $ toInteger denom++prop_fbAdd_consistent sample reportFileName +        (FBSize10 (n1,fb1), FBSize10 (n2, fb2)) =+    fbAtKeyPointsPointwiseBinaryDownUpConsistent +        reportFileName (n1,n2)+        (+) fb1 fb2 (sumLow, sumHigh)+    where+    _ = [fb1,sample]+    sumLow = UFB.neg $ (UFB.neg fb1) UFB.+^ (UFB.neg fb2)+    sumHigh = fb1 UFB.+^ fb2++prop_fbMult_consistent sample reportFileName+        (FBSize10 (n1,fb1), FBSize10 (n2, fb2)) =+    fbAtKeyPointsPointwiseBinaryDownUpConsistent+        reportFileName (n1,n2) +        (*) fb1 fb2 (prodLow, prodHigh)+    where+    _ = [fb1,sample]+    prodHigh = fb1 UFB.*^ fb2+    prodLow = UFB.neg $ (UFB.neg fb1) UFB.*^ fb2+

@@ -0,0 +1,134 @@+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.BaseTests.Run+    Description :  (testing) running all function enclosure base tests in a batch+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Support for running all function enclosure base tests in a batch.+-}+module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Run+where++import Data.Number.ER.Real.Approx.Tests.Reporting++import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Reduce+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Bounds+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Ring+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Integration+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Enclosure+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Division+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Compose+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Elementary++import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB+import qualified Data.Number.ER.Real.Approx as RA++import Data.Number.ER.Misc.Tests+import Data.Number.ER.Misc++import Test.QuickCheck+import Test.QuickCheck.Batch++import System.Directory+import qualified System.FilePath as FP+import Data.Time.Clock+import Data.Time.Calendar++runUFBTests :: +    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, +     UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb,+     RA.ERInnerOuterApprox ra,+     Ord ra, Show fb, Show boxra, Show varid) =>+    String -> fb -> IO () -> IO ()+runUFBTests title sample initialise =+    do+    (UTCTime (ModifiedJulianDay days) secs) <- getCurrentTime+    let folder = "tests-" ++ title ++ "-" ++ (show days) ++ "-" ++ (show $ floor $ toRational secs)+    createDirectory folder+--    erRunTests (title ++ " ufb tests") ufbTestOptions initialise (ufbTests sample folder)+    erRunTests (title ++ " ufb encl tests") ufbTestOptions initialise (ufbEnclTests (sample,sample) folder)++ufbTestOptions = +    TestOptions+      { +--        no_of_tests = 10+--        no_of_tests = 50+        no_of_tests = 200+--        no_of_tests = 500+      , +        length_of_tests = 240 * 3600 -- ie 4h time limit+      ,+        debug_tests = False +      }++ufbTests sample folder =+    [+        ("reduce term count", runR (prop_fbReduceTermCount_consistent sample) "reduceSize"),+        ("reduce degree", runR (prop_fbReduceDegree_consistent sample) "reduceDegree"),+        ("bounds of poly", runR (prop_fbBounds_consistent sample) "bounds"),+        ("max of two functions", runR (prop_fbMax_consistent sample) "max"),+        ("min of two functions", runR (prop_fbMin_consistent sample) "min"),+        ("add const to poly", runR (prop_fbAddConst_consistent sample) "addConst"),+        ("scale poly", runR (prop_fbScale_consistent sample) "scale"),+        ("add two polys", runR (prop_fbAdd_consistent sample) "add"),+        ("mult two polys", runR (prop_fbMult_consistent sample) "mult"),+        ("integrate + diff up", runR (prop_fbIntegrateDiffUp_consistent sample) "integrateDiffUp"),+        ("integrate + diff down", runR (prop_fbIntegrateDiffDown_consistent sample) "integrateDiffDown")+    ]+    where+    runR test filename opts =+        unsafeReport filepath "started" $+            do +            run (test filepath) opts+        where+        filepath = addFolder filename+    addFolder name = FP.combine folder name++ufbEnclTests sampleE folder =+    [+        ("add thick encls", runR (prop_enclAdd_ThickEncls_consistent sampleE) "enclAdd_Thick"),+        ("add paral encls", runR (prop_enclAdd_ParalEncls_consistent sampleE) "enclAdd_Paral"),+        ("add thin encls", runR (prop_enclAdd_ThinEncls_consistent sampleE) "enclAdd_Thin"),+        ("scale thick encl", runR (prop_enclScale_ThickEncl_consistent sampleE) "enclScale_Thick"),+        ("scale paral encl", runR (prop_enclScale_ParalEncl_consistent sampleE) "enclScale_Paral"),+        ("scale thin encl", runR (prop_enclScale_ThinEncl_consistent sampleE) "enclScale_Thin"),+        ("mult thick encls", runR (prop_enclMult_ThickEncls_consistent sampleE) "enclMultiply_Thick"),+        ("mult paral encls", runR (prop_enclMult_ParalEncls_consistent sampleE) "enclMultiply_Paral"),+        ("mult thin encls", runR (prop_enclMult_ThinEncls_consistent sampleE) "enclMultiply_Thin"),+        ("recip thick encl", runR (prop_enclRecip_ThickEncl_consistent sampleE) "enclRecip_Thick"),+        ("recip paral encl", runR (prop_enclRecip_ParalEncl_consistent sampleE) "enclRecip_Paral"),+        ("recip thin encl", runR (prop_enclRecip_ThinEncl_consistent sampleE) "enclRecip_Thin"),+        ("compose thick encl", runR (prop_enclCompose_ThickEncl_consistent sampleE) "enclCompose_Thick"),+        ("compose paral encl", runR (prop_enclCompose_ParalEncl_consistent sampleE) "enclCompose_Paral"),+        ("compose thin encl", runR (prop_enclCompose_ThinEncl_consistent sampleE) "enclCompose_Thin"),+        ("sqrt thin encl", runR (prop_enclSqrt_ThinEncl_consistent sampleE) "enclSqrt_Thin"),+        ("sqrt paral encl", runR (prop_enclSqrt_ParalEncl_consistent sampleE) "enclSqrt_Paral"),+        ("sqrt thick encl", runR (prop_enclSqrt_ThickEncl_consistent sampleE) "enclSqrt_Thick"),+        ("exp thin encl", runR (prop_enclExp_ThinEncl_consistent sampleE) "enclExp_Thin"),+        ("exp paral encl", runR (prop_enclExp_ParalEncl_consistent sampleE) "enclExp_Paral"),+        ("exp thick encl", runR (prop_enclExp_ThickEncl_consistent sampleE) "enclExp_Thick"),+        ("sine thin encl", runR (prop_enclSine_ThinEncl_consistent sampleE) "enclSine_Thin"),+        ("sine paral encl", runR (prop_enclSine_ParalEncl_consistent sampleE) "enclSine_Paral"),+        ("sine thick encl", runR (prop_enclSine_ThickEncl_consistent sampleE) "enclSine_Thick"),+        ("cosine thin encl", runR (prop_enclCosine_ThinEncl_consistent sampleE) "enclCosine_Thin"),+        ("cosine paral encl", runR (prop_enclCosine_ParalEncl_consistent sampleE) "enclCosine_Paral"),+        ("cosine thick encl", runR (prop_enclCosine_ThickEncl_consistent sampleE) "enclCosine_Thick"),+        ("atan thin encl", runR (prop_enclAtan_ThinEncl_consistent sampleE) "enclAtan_Thin"),+        ("atan paral encl", runR (prop_enclAtan_ParalEncl_consistent sampleE) "enclAtan_Paral"),+        ("atan thick encl", runR (prop_enclAtan_ThickEncl_consistent sampleE) "enclAtan_Thick")+    ]+    where+    runR test filename opts =+        unsafeReport filepath "started" $+            do +            result <- run (test filepath) opts+            produceSummary filepath+            return result +        where+        filepath = FP.combine folder filename+    

@@ -3,7 +3,7 @@ {-# LANGUAGE UndecidableInstances #-} {-|     Module      :  Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom-    Description :  multivariate polynomials in the Chebyshev basis+    Description :  polynoms in the Chebyshev basis of the 1st kind     Copyright   :  (c) 2007-2008 Michal Konecny     License     :  BSD3 @@ -29,23 +29,28 @@ import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Eval import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Reduce import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Derivative import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Bounds import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.EnclosureInner import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Compose import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Integration+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Derivative import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Division+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.DivisionInner import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Elementary+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.ElementaryInner  import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB import qualified Data.Number.ER.Real.Base as B import Data.Number.ER.Real.Approx.Interval-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)  import qualified Data.Map as Map  {- code for testing purpose, to be deleted later -} import Data.Number.ER.Real.DefaultRepr-import Data.Number.ER.Real.DomainBox.IntMap+import Data.Number.ER.BasicTypes.DomainBox.IntMap type P = ERChebPoly (Box Int) B x0 = chplVar 0 :: P x1 = chplVar 1 :: P@@ -53,11 +58,26 @@ x3 = chplVar 3 :: P x4 = chplVar 4 :: P p1 = x1 *^ x1 *^ x1 +^ x1 *^ (x2 +^ (chplConst 2)) *^ (x3 -^ (chplConst 3))++e23 = enclRAConst (ERInterval 2 3)  :: (P,P)+e32 = enclRAConst (ERInterval 3 2)  :: (P,P)+em12 = enclRAConst (ERInterval (-1) 2)  :: (P,P)+e2m1 = enclRAConst (ERInterval 2 (-1))  :: (P,P)+ex0 = enclThin x0+ex0sq = enclMultiply 3 10 ex0 ex0+ep = enclAdd 3 10 (enclConst 2) (enclAdd 3 10 ex0 ex0sq) ++i23 = ienclRAConst (ERInterval 2 3)  :: ((P,P),Bool)+i32 = ienclRAConst (ERInterval 3 2)  :: ((P,P),Bool)+im12 = ienclRAConst (ERInterval (-1) 2)  :: ((P,P),Bool)+i2m1 = ienclRAConst (ERInterval 2 (-1))  :: ((P,P),Bool)+ix0 = ienclThin x0+ {- end of code for testing purposes -}  instance      (B.ERRealBase rb, RealFrac rb,-     DomainBox box varid Int, Ord box,+     DomainBox box varid Int, Ord box, Show varid,      DomainBoxMappable boxb boxras varid rb [ERInterval rb],      DomainBoxMappable boxra boxras varid (ERInterval rb) [ERInterval rb],      DomainIntBox boxra varid (ERInterval rb)) =>@@ -65,8 +85,7 @@     where     {----- Miscellaneous associated operations -----}     raEndpoints _ (ERInterval l h) = (l,h)-    raEndpoints _ ERIntervalAny = (- B.plusInfinity, B.plusInfinity)-    raFromEndpoints _ (l,h) = normaliseERInterval (ERInterval l h)+    raFromEndpoints _ (l,h) = ERInterval l h     compareApprox = chplCompareApprox     showDiGrCmp = chplShow      @@ -84,45 +103,107 @@          {----- Construction of basic functions -----}     const = chplConst-    constEncl (low, high) = (chplConst (-low), chplConst high)     affine = chplAffine     -    {----- Pointwise order operations ----------}    +    {----- Pointwise order operations ----------}+    bounds = chplBounds       upperBound = chplUpperBound+    upperBoundPrecise = chplUpperBoundExpensive     maxUp = chplMaxUp     minUp = chplMinUp+    maxDown = chplMaxDn+    minDown = chplMinDn          {----- Field operations ----------}     neg = chplNeg+    addConstUp = chplAddConstUp     scaleUp = chplScaleUp     scaleApproxUp = chplScaleRAUp     (+^) = (+^)     (-^) = (-^)     (*^) = (*^)-    multiplyEncl = enclMultiply     recipUp md mt ix f = snd $ enclRecip md mt ix (md + 1) (chplNeg f, f)-    recipEncl md mt ix = enclRecip md mt ix (md + 1)          {----- Evaluation and composition of functions -----}     evalUp pt f = chplEvalUp f pt+--    evalDown pt f = chplEvalDown f pt     evalApprox x ufb = chplRAEval (\ b -> ERInterval b b) ufb x          partialEvalApproxUp substitutions ufb =         snd $          chplPartialRAEval (UFB.raEndpoints ufb) ufb substitutions     composeUp m n f v fv = snd $ enclCompose m n f v (enclThin fv) -    composeEncl = enclCompose     composeManyUp m n f subst = snd $ enclComposeMany m n f (Map.map enclThin subst)+    composeDown m n f v fv = chplNeg $ fst $ enclCompose m n f v (enclThin fv) +    composeManyDown m n f subst = chplNeg $ fst $ enclComposeMany m n f (Map.map enclThin subst)+    +    integrate = chplIntegrate+    differentiate var fb = chplDifferentiate fb var++instance+    (B.ERRealBase rb, RealFrac rb,+     DomainBox box varid Int, Ord box, Show varid,+     DomainBoxMappable boxb boxras varid rb [ERInterval rb],+     DomainBoxMappable boxra boxras varid (ERInterval rb) [ERInterval rb],+     DomainIntBox boxra varid (ERInterval rb)) =>+    (UFB.ERUnitFnBaseEncl boxb boxra varid rb (ERInterval rb) (ERChebPoly box rb))+    where+    boundsEncl = enclBounds+    constEncl (low, high) = (chplConst (-low), chplConst high)+    evalEncl pt encl = enclRAEval encl pt +    evalEnclInner pt encl = enclRAEvalInner encl pt+    addConstEncl _ _ = enclAddConst+    scaleEncl = enclScale +    addEncl = enclAdd+    multiplyEncl = enclMultiply+    recipEncl md mt ix = enclRecip md mt ix (md + 1)+    composeEncl = enclCompose     composeManyEncls = enclComposeMany -    {----- Selected elementary operations ----------}-    sqrtEncl = enclSqrt    +instance+    (B.ERRealBase rb, RealFrac rb,+     DomainBox box varid Int, Ord box, Show varid,+     DomainBoxMappable boxb boxras varid rb [ERInterval rb],+     DomainBoxMappable boxra boxras varid (ERInterval rb) [ERInterval rb],+     DomainIntBox boxra varid (ERInterval rb)) =>+    (UFB.ERUnitFnBaseIEncl boxb boxra varid rb (ERInterval rb) (ERChebPoly box rb))+    where+    constIEncl (low, high) = ((chplConst (-low), chplConst high), low >= high)+    evalIEncl pt ie = ienclRAEval ie pt +    addIEncl = ienclAdd+    multiplyIEncl = ienclMultiply+    recipIEnclPositive md mt ix = ienclRecipPositive md mt ix (md + 1)+    composeIEncl = error "ERChebPoly: composeIEncl not yet" -- ienclCompose+    composeManyIEncls = error "ERChebPoly: composeManyIEncls not yet" -- ienclComposeMany++instance +    (B.ERRealBase rb, RealFrac rb,+     DomainBox box varid Int, Ord box, Show varid,+     DomainBoxMappable boxb boxras varid rb [ERInterval rb],+     DomainBoxMappable boxra boxras varid (ERInterval rb) [ERInterval rb],+     DomainIntBox boxra varid (ERInterval rb)) =>+    (UFB.ERUnitFnBaseElementary boxb boxra varid rb (ERInterval rb) (ERChebPoly box rb))+    where+    sqrtEncl md ms ix = enclSqrt md ms ix md         expEncl = enclExp     logEncl = enclLog     sinEncl = enclSine     cosEncl = enclCosine     atanEncl = enclAtan-    -    integrate = chplIntegrate -+instance +    (B.ERRealBase rb, RealFrac rb,+     DomainBox box varid Int, Ord box, Show varid,+     DomainBoxMappable boxb boxras varid rb [ERInterval rb],+     DomainBoxMappable boxra boxras varid (ERInterval rb) [ERInterval rb],+     DomainIntBox boxra varid (ERInterval rb)) =>+    (UFB.ERUnitFnBaseIElementary boxb boxra varid rb (ERInterval rb) (ERChebPoly box rb))+    where+    sqrtIEncl md ms ix = ienclSqrt md ms ix md+--        error "ERChebPoly: sqrtIEncl not yet" +    expIEncl = error "ERChebPoly: expIEncl not yet" -- ienclExp+    logIEncl = error "ERChebPoly: logIEncl not yet" -- ienclLog+    sinIEncl = error "ERChebPoly: sinIEncl not yet" -- ienclSine+    cosIEncl = error "ERChebPoly: cosIEncl not yet" -- ienclCosine+    atanIEncl = error "ERChebPoly: atanIEncl not yet" -- ienclAtan+        

@@ -20,8 +20,8 @@ where  import qualified Data.Number.ER.Real.Base as B-import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox) import Data.Number.ER.Misc  import qualified Data.Map as Map@@ -110,11 +110,10 @@     (ERChebPoly box b) ->     Maybe b chplGetConst (ERChebPoly coeffs) =-    case Map.keys coeffs of-        [key] | chplIsConstTermKey key ->-            Just $ head $ Map.elems coeffs+    case Map.toList coeffs of+        [] -> Just 0+        [(key,val)] | chplIsConstTermKey key -> Just val         _ -> Nothing-      -- chplGetArity = length . chplGetVars       

@@ -20,13 +20,14 @@ import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Reduce import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Eval+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Derivative  import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Base as B import Data.Number.ER.Real.Approx.Interval import Data.Number.ER.Real.Arithmetic.LinearSolver-import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox) import Data.Number.ER.BasicTypes import Data.Number.ER.Misc @@ -37,9 +38,15 @@ {-|     Find an upper bound on a polynomial over the      unit domain [-1,1]^n.  ++    Quick method that does not converge to exact result with increasing +    effort index. -} chplUpperBound ::-    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      EffortIndex {-^ how hard to try -} ->     ERChebPoly box b ->     b@@ -48,9 +55,15 @@ {-|     Find a lower bound on a polynomial over the      unit domain [-1,1]^n.  ++    Quick method that does not converge to exact result with increasing +    effort index. -} chplLowerBound ::-    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      EffortIndex {-^ how hard to try -} ->     ERChebPoly box b ->     b@@ -59,15 +72,70 @@ {-|     Find both lower and upper bounds on a polynomial over the      unit domain [-1,1]^n.  ++    Quick method that does not converge to exact result with increasing +    effort index. -} chplBounds ::-    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      EffortIndex {-^ how hard to try -} ->     ERChebPoly box b ->     (b,b)-chplBounds = chplBoundsAffine+chplBounds = +    chplBoundsAffine  {-|+    Find an upper bound on a polynomial over the +    unit domain [-1,1]^n.  +-}+chplUpperBoundExpensive ::+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) => +    EffortIndex {-^ how hard to try -} ->+    ERChebPoly box b ->+    b+chplUpperBoundExpensive ix p = snd $ chplBoundsExpensive ix p++{-|+    Find a lower bound on a polynomial over the +    unit domain [-1,1]^n.  +    +    Quick method that does not converge to exact result with increasing +    effort index.+-}+chplLowerBoundExpensive ::+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) => +    EffortIndex {-^ how hard to try -} ->+    ERChebPoly box b ->+    b+chplLowerBoundExpensive ix p = fst $ chplBoundsExpensive ix p++{-|+    Find both lower and upper bounds on a polynomial over the +    unit domain [-1,1]^n.+    +    Quick method that does not converge to exact result with increasing +    effort index.+-}+chplBoundsExpensive ::+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) => +    EffortIndex {-^ how hard to try -} ->+    ERChebPoly box b ->+    (b,b)+chplBoundsExpensive = chplBoundsByDerivative++{-|     Find bounds on a polynomial over the unit domain [-1,1]^n.          Fast but inaccurate method, in essence@@ -95,116 +163,253 @@     absCoeffs = Map.map abs $ Map.delete chplConstTermKey coeffs     constTerm = Map.findWithDefault 0 chplConstTermKey coeffs -{-|-    Find a close upper bound on a quadratic polynomial over the -    unit domain [-1,1]^n.   -    Much slower and somewhat more accurate method, in essence-    taking the maximum of the upper quadratic reduction.+{-|+    Find a close upper bound of a polynomial over the +    unit domain [-1,1]^n.     -    !!! Not yet properly tested !!!+    Approximates all local extrema and computes their maximum.   -}-chplUpperBoundQuadr ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box,-     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b],-     DomainBoxMappable boxra boxra varid (ERInterval b) (ERInterval b), -     DomainIntBox boxra varid (ERInterval b), Num varid, Enum varid) => +chplBoundsByDerivative ::+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      EffortIndex {-^ how hard to try looking for peaks -} ->     ERChebPoly box b ->-    b-chplUpperBoundQuadr ix p@(ERChebPoly coeffs) =-    quadBound (coeffsQ, vars)+    (b,b)+chplBoundsByDerivative ix p =+--    unsafePrint+--    (+--        "chplBoundsByDerivative: "+--        ++ "\n extremaValues = " ++ show extremaValues+--    ) $+    (lowerBound, upperBound)     where-    pQ@(ERChebPoly coeffsQ) = chplReduceDegreeUp 2 p-    vars = chplGetVars pQ-    quadBound (coeffs, vars)-        | null vars =-            Map.findWithDefault 0 chplConstTermKey coeffs-        | hasInteriorPeak =-            foldl max peakValue edgeBounds+    lowerBound = foldl1 min $ map fst extremaValues +    upperBound = foldl1 max $ map snd extremaValues+    ra2bb (ERInterval l r) = (l,r)+    b2ra b = ERInterval b b+    extremaValues = +        collectValuesOnFaces vars varDerivatives (p,p)+        where+        vars = chplGetVars p+        varDerivatives = -- var |-> (lower, upper) bounds on partial derivative+            Map.fromList $+                map getDerivatives vars+        getDerivatives var =+            (var,+                chplBall2DownUp $+                    ballDifferentiate p var)+    collectValuesOnFaces varsSpecialise varDerivatives (pDown, pUp) =+--        unsafePrint+--        (+--            "chplBoundsByDerivative: collectValuesOnFaces: "+--            ++ "\n vars = " ++ (show $ Map.keys varDerivatives)+--            ++ "\n valuesThisFace = " ++ show valuesThisFace+--        ) $+        valuesThisFace ++ (valuesSubFaces varsSpecialise)+        where+        valuesThisFace =+            collectExtremeValues varDerivatives (pDown, pUp)+        valuesSubFaces [] = []+        valuesSubFaces (var : vars) =+            (collectValuesOnFaces vars varDerivativesNoVarL (pDownNoVarL, pUpNoVarL))+            +++            (collectValuesOnFaces vars varDerivativesNoVarR (pDownNoVarR, pUpNoVarR))+            +++            (valuesSubFaces vars)+            where+            (pDownNoVarR, pUpNoVarR) = substVarR (pDown, pUp)+            (pDownNoVarL, pUpNoVarL) = substVarL (pDown, pUp)+            substVarL = substVar (-1)+            substVarR = substVar 1+            substVar val (pDown, pUp) =+                (fst $ chplPartialRAEval ra2bb pDown $ DBox.singleton var val,+                 snd $ chplPartialRAEval ra2bb pUp $ DBox.singleton var val)+            varDerivativesNoVarL =+                Map.map substVarL varDerivativesNoVar +            varDerivativesNoVarR =+                Map.map substVarR varDerivativesNoVar +            varDerivativesNoVar = +                Map.delete var varDerivatives+    collectExtremeValues varDerivatives (pDown, pUp)+        | null varsNoConst =+--            unsafePrint+--            (+--                "chplBoundsByDerivative: collectExtremeValues:" +--                ++ "\n null varsNoConst"+--                ++ "\n varDerivatives = " ++ show varDerivatives+--            )+            -- corner or near constant function +            [pEvalAt unitDomBox]          | otherwise =-            foldl1 max edgeBounds+--            unsafePrint+--            (+--                "chplBoundsByDerivative: collectExtremeValues:" +--                ++ "\n varDerivatives = " ++ show varDerivatives+--                ++ "\n boxesWithPotentialExtrema = " ++ show boxesWithPotentialExtrema+--            ) $+            map pEvalAt boxesWithPotentialExtrema         where-        edgeBounds =-            map quadBound $ concat $ map removeVar vars-        (hasInteriorPeak, peakValue) =-            case maybePeak of-                Just peak ->-                    (noPositiveSquare -- if any term x^2 has a positive coeff, there is no peak  -                     &&-                     (and $ map maybeInUnit $ DBox.elems peak)-                    ,-                     erintv_right $-                     chplRAEval makeInterval p peak-                    )-                Nothing -> (False, undefined)+        boxesWithPotentialExtrema = +            paveFindBoxes [(unitDomBox,0)] +        varDerivativesNoZeros =+            Map.filter (not . isConstWithZero) varDerivatives             where-            noPositiveSquare =-                and $ map (<= 0) $ map getQuadCoeff vars-            getQuadCoeff var = -                Map.findWithDefault 0 (DBox.singleton var 2) coeffs-            maybeInUnit r =-                case (RA.compareReals r (-1), RA.compareReals (1) r) of-                    (Just LT, _) -> False -- ie r < -1-                    (_, Just LT) -> False -- ie r > 1-                    _ -> True-        maybePeak =-            linearSolver-                (map derivZeroLinearEq vars)-                (DBox.fromList $ map (\v -> (v,(-1) RA.\/ 1)) vars)-                (2^^(-ix))+            isConstWithZero (pDown, pUp) =+                (snd $ chplBoundsAffine ix pDown) <= 0+                &&+                (fst $ chplBoundsAffine ix pUp) >= 0+--                case (chplGetConst pDown, chplGetConst pUp) of+--                    (Just cDown, Just cUp) ->+--                        cDown <= 0 && cUp >= 0 +--                    _ -> False +        vars = Map.keys varDerivatives+        varsNoConst = Map.keys varDerivativesNoZeros+        varsNoConstLength = length varsNoConst+        pEvalAt = evalAt (pDown, pUp)+        evalAt (pDown,pUp) box =+            (fst $ ra2bb $ chplRAEval b2ra pDown box,+             snd $ ra2bb $ chplRAEval b2ra pUp box)+        unitDomBox =+            DBox.fromList $ zip vars (repeat unitInterval)+        unitInterval = ((-1) RA.\/ 1)+        maxDepth = fromInteger $ toInteger $ max 3 ix+        keepBox box =+            and $ map evalDeriv $ Map.elems varDerivativesNoZeros             where-            derivZeroLinearEq var =-                (linCoeffs, - constCoeff)-                where-                constCoeff =-                    makeInterval $-                    Map.findWithDefault 0 (DBox.singleton var 1) coeffs-                      -- recall T_1(x) = x, T_1'(x) = 1-                linCoeffs =-                    DBox.fromList $-                        (var, 4 * quadCoeff) -- T_2(x) = 2*x^2 - 1; T_2'(x) = 4*x-                        : (map getVarVarCoeff $ var `delete` vars)-                quadCoeff =-                    makeInterval $-                    Map.findWithDefault 0 (DBox.singleton var 2) coeffs-                getVarVarCoeff var2 =-                    (var2,-                      makeInterval $-                      Map.findWithDefault 0 (DBox.fromList [(var,1), (var2,1)]) coeffs)-        makeInterval b = ERInterval b b-        removeVar var =-            [(substVar True, newVars), -             (substVar False, newVars)]+            evalDeriv derivBounds = hasZero $ evalAt derivBounds box  +            hasZero (l,h) = l <= 0 && h >= 0+        paveFindBoxes [] = [] +        paveFindBoxes boxes@((box, depth) : boxesRest) +            | keepBox box =+                case depth < maxDepth of+                    True ->+                        paveFindBoxes ((boxL, newDepth) : (boxR, newDepth) : boxesRest)+                    False ->+                        box : (paveFindBoxes boxesRest)+            | otherwise =+                paveFindBoxes boxesRest             where-            newVars = var `delete` vars-            substVar isOne =-                chplCoeffs $-                    foldl (+^) (chplConst 0) $ -                        map (makeMonomial isOne) $ -                            Map.toList coeffs-            makeMonomial isOne (term, coeff) =-                ERChebPoly $ Map.fromList $-                case (DBox.toList term) of-                    [(v,2)] | v == var ->-                        [(chplConstTermKey, coeff)]-                    [(v,1)] | v == var ->-                        [(chplConstTermKey, -                          case isOne of True -> coeff; False -> - coeff)]-                    [(v1,1), (v2,1)] | v1 == var ->-                        [(DBox.fromList [(v2,1)], -                          case isOne of True -> coeff; False -> - coeff)]-                    [(v1,1), (v2,1)] | v2 == var ->-                        [(DBox.fromList [(v1,1)], -                          case isOne of True -> coeff; False -> - coeff)]-                    _ ->-                        [(term, coeff)]+            var = varsNoConst !! (depth `mod` varsNoConstLength)+            (boxL, boxR) = DBox.split box var Nothing+            newDepth = depth + 1 ++--{-|+--    Find a close upper bound on a quadratic polynomial over the +--    unit domain [-1,1]^n.  +--+--    Much slower and somewhat more accurate method, in essence+--    taking the maximum of the upper quadratic reduction.+--    +--    !!! Not properly tested !!!+---}+--chplUpperBoundQuadr ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box,+--     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b],+--     DomainBoxMappable boxra boxra varid (ERInterval b) (ERInterval b), +--     DomainIntBox boxra varid (ERInterval b), Num varid, Enum varid) => +--    EffortIndex {-^ how hard to try looking for peaks -} ->+--    ERChebPoly box b ->+--    b+--chplUpperBoundQuadr ix p@(ERChebPoly coeffs) =+--    quadBound (coeffsQ, vars)+--    where+--    pQ@(ERChebPoly coeffsQ) = chplReduceDegreeUp 2 p+--    vars = chplGetVars pQ+--    quadBound (coeffs, vars)+--        | null vars =+--            Map.findWithDefault 0 chplConstTermKey coeffs+--        | hasInteriorPeak =+--            foldl max peakValue edgeBounds+--        | otherwise =+--            foldl1 max edgeBounds+--        where+--        edgeBounds =+--            map quadBound $ concat $ map removeVar vars+--        (hasInteriorPeak, peakValue) =+--            case maybePeak of+--                Just peak ->+--                    (noPositiveSquare -- if any term x^2 has a positive coeff, there is no peak  +--                     &&+--                     (and $ map maybeInUnit $ DBox.elems peak)+--                    ,+--                     erintv_right $+--                     chplRAEval makeInterval p peak+--                    )+--                Nothing -> (False, undefined)+--            where+--            noPositiveSquare =+--                and $ map (<= 0) $ map getQuadCoeff vars+--            getQuadCoeff var = +--                Map.findWithDefault 0 (DBox.singleton var 2) coeffs+--            maybeInUnit r =+--                case (RA.compareReals r (-1), RA.compareReals (1) r) of+--                    (Just LT, _) -> False -- ie r < -1+--                    (_, Just LT) -> False -- ie r > 1+--                    _ -> True+--        maybePeak =+--            linearSolver+--                (map derivZeroLinearEq vars)+--                (DBox.fromList $ map (\v -> (v,(-1) RA.\/ 1)) vars)+--                (2^^(-ix))+--            where+--            derivZeroLinearEq var =+--                (linCoeffs, - constCoeff)+--                where+--                constCoeff =+--                    makeInterval $+--                    Map.findWithDefault 0 (DBox.singleton var 1) coeffs+--                      -- recall T_1(x) = x, T_1'(x) = 1+--                linCoeffs =+--                    DBox.fromList $+--                        (var, 4 * quadCoeff) -- T_2(x) = 2*x^2 - 1; T_2'(x) = 4*x+--                        : (map getVarVarCoeff $ var `delete` vars)+--                quadCoeff =+--                    makeInterval $+--                    Map.findWithDefault 0 (DBox.singleton var 2) coeffs+--                getVarVarCoeff var2 =+--                    (var2,+--                      makeInterval $+--                      Map.findWithDefault 0 (DBox.fromList [(var,1), (var2,1)]) coeffs)+--        makeInterval b = ERInterval b b+--        removeVar var =+--            [(substVar True, newVars), +--             (substVar False, newVars)]+--            where+--            newVars = var `delete` vars+--            substVar isOne =+--                chplCoeffs $+--                    foldl (+^) (chplConst 0) $ +--                        map (makeMonomial isOne) $ +--                            Map.toList coeffs+--            makeMonomial isOne (term, coeff) =+--                ERChebPoly $ Map.fromList $+--                case (DBox.toList term) of+--                    [(v,2)] | v == var ->+--                        [(chplConstTermKey, coeff)]+--                    [(v,1)] | v == var ->+--                        [(chplConstTermKey, +--                          case isOne of True -> coeff; False -> - coeff)]+--                    [(v1,1), (v2,1)] | v1 == var ->+--                        [(DBox.fromList [(v2,1)], +--                          case isOne of True -> coeff; False -> - coeff)]+--                    [(v1,1), (v2,1)] | v2 == var ->+--                        [(DBox.fromList [(v1,1)], +--                          case isOne of True -> coeff; False -> - coeff)]+--                    _ ->+--                        [(term, coeff)]+ {-|      Approximate from below and  from above the pointwise maximum of two polynomials -} chplMax ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      ERChebPoly box b ->@@ -215,7 +420,7 @@     where     (differenceDown, _) = chplNonneg maxDegree maxSize p2MinusP1Down     (_, differenceUp) = chplNonneg maxDegree maxSize $ p2MinusP1Up-    (p2MinusP1Down, p2MinusP1Up, _) = chplAdd p2 (chplNeg p1)+    (p2MinusP1Down, p2MinusP1Up) = chplBall2DownUp $ ballAdd p2 (chplNeg p1)  chplMaxDn m s a b = fst $ chplMax m s a b chplMaxUp m s a b = snd $ chplMax m s a b@@ -226,7 +431,10 @@      Approximate from below and  from above the pointwise minimum of two polynomials -} chplMin ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      ERChebPoly box b ->@@ -252,7 +460,10 @@      and from above.  -} chplNonneg ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      ERChebPoly box b ->@@ -263,7 +474,10 @@     A version of 'chplNonneg' using a cubic approximation.  -} chplNonnegCubic ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      ERChebPoly box b ->@@ -271,7 +485,7 @@ chplNonnegCubic maxDegree maxSize p     | upperB <= 0 = (chplConst 0, chplConst 0)     | lowerB >= 0 = (p, p)-    | not allInterimsBounded = (chplConst (1/0), chplConst (1/0))+    | not allInterimsBounded = (chplConst (B.plusInfinity), chplConst (B.plusInfinity))     | otherwise = -- ie lowerB < 0 < upperB: polynomial may be crossing 0... --        unsafePrintReturn --        (@@ -319,13 +533,13 @@     addConsts (lo, hi, wd) (cLo, cHi) =         (alo, ahi, wd + wdlo + wdhi)         where-        (alo, _, wdlo) = chplAddConst cLo lo -        (_, ahi, wdhi) = chplAddConst cHi hi +        (alo, _, wdlo) = chplBall2DownUpWd $ ballAddConst cLo lo +        (_, ahi, wdhi) = chplBall2DownUpWd $ ballAddConst cHi hi      scaleByPositiveConsts (lo, hi, wd) (cLo, cHi) =         (slo, shi, wd + wdlo + wdhi)         where-        (slo, _, wdlo) = chplScale cLo lo -        (_, shi, wdhi) = chplScale cHi hi +        (slo, _, wdlo) = chplBall2DownUpWd $ ballScale cLo lo +        (_, shi, wdhi) = chplBall2DownUpWd $ ballScale cHi hi           -- convert interval coefficients to pairs of bounds:     ERInterval rbLo rbHi = rb@@ -394,26 +608,28 @@     valueAt0B =          case a0 / b of             ERInterval lo hi -> hi-            ERIntervalAny -> 1/0  {-|     Multiply a polynomial by an enclosure (with non-negated lower bound). -} chplTimesLoHi ::-    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      ERChebPoly box b ->     (ERChebPoly box b, ERChebPoly box b, b) ->     (ERChebPoly box b, ERChebPoly box b, b) chplTimesLoHi p1 (p2Low, p2High, p2Width) =     (prodMid -. (chplConst width), -     prodMid +^ (chplConst width), +     prodMid +^ (chplConst width),      2 * width)     where     prodMid = prodLowUp     (prodLowDown, prodLowUp, prodLowWidth) = -        chplMultiply p1 p2Low+        chplBall2DownUpWd $ ballMultiply p1 p2Low     (prodHighDown, prodHighUp, prodHighWidth) = -        chplMultiply p1 p2High+        chplBall2DownUpWd $ ballMultiply p1 p2High     width =          p1Norm `timesUp` p2Width `plusUp` prodLowWidth `plusUp` prodHighWidth     p1Norm = 

@@ -23,8 +23,10 @@  import qualified Data.Number.ER.Real.Approx as RA import qualified Data.Number.ER.Real.Base as B-import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox, DomainBoxMappable)++import Data.Number.ER.Real.Approx.Interval import Data.Number.ER.Misc  import qualified Data.Map as Map@@ -34,7 +36,10 @@     assuming the second polynomial maps [-1,1] into [-1,1]. -} enclCompose ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ max degree for result -} ->      Int {-^ max approx size for result -} ->     ERChebPoly box b {-^ @f@ -} ->@@ -105,7 +110,10 @@     provided the second polynomial maps [-1,1] into [-1,1]. -} enclComposeMany ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ max degree for result -} ->      Int {-^ max approx size for result -} ->     ERChebPoly box b ->@@ -114,6 +122,16 @@     (ERChebPoly box b, ERChebPoly box b)         {-^ lower bound (negated) and upper bound -} enclComposeMany maxDegree maxSize p@(ERChebPoly coeffs) substitutions =+--    unsafePrintReturn+--    (+--        "ChebyshevBase.Polynom.Compose: enclComposeMany:"+--        ++ "\n maxDegree = " ++ show maxDegree        +--        ++ "\n maxSize = " ++ show maxSize        +--        ++ "\n p = " ++ show p+--        ++ "\n substitutions = " ++ show substitutions+--        ++ "\n terms... \n" ++ (unlines $ map (show . (\t -> map evalVar (DBox.toList t) ) . fst) $ Map.toList coeffs)  +--        ++ "\n result = "        +--    )     result     where     result =@@ -134,5 +152,5 @@     substDegrees =         Map.map mkPVDegrees substitutions     mkPVDegrees pvEncl =-        enclEvalTs maxSize maxDegree pvEncl+        enclEvalTs maxDegree maxSize pvEncl         

@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Derivative+    Description :  (internal) derivative of polynomials  +    Copyright   :  (c) 2009 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Internal module for "Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom".+    +    Implementation of safely rounded derivative of polynomials.+-}+module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Derivative where++import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring++import qualified Data.Number.ER.Real.Base as B+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)+import Data.Number.ER.Misc++import qualified Data.Map as Map++{-|+    Differentiate a polynomial using one of its variables. +-}+chplDifferentiate ::+    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +    ERChebPoly box b ->+    varid {-^ variable to differentiate over -} ->+    (ERChebPoly box b, ERChebPoly box b)+chplDifferentiate p diffVar = chplBall2DownUp $ ballDifferentiate p diffVar ++{-|+    Differentiate a polynomial using one of its variables. +-}+ballDifferentiate ::+    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +    ERChebPoly box b ->+    varid {-^ variable to differentiate over -} ->+    (ERChebPoly box b, b)+ballDifferentiate (ERChebPoly coeffs) diffVar =+    (ERChebPoly diffCoeffs, diffRadius)+    where+    (diffCoeffs, diffRadius) =+        -- ((term |-> coeff), radius)+        Map.foldWithKey extractTerm (Map.empty, 0) coeffs+    extractTerm term c prevBall =+        addDiffTerms (diffVarDegree - 1) prevBall+        where+        diffVarDegree = DBox.findWithDefault 0 diffVar term+        cConstUp = c * (B.fromIntegerUp $ toInteger diffVarDegree)+        cConstDown = c `timesDown` (B.fromIntegerDown $ toInteger diffVarDegree)+        cConstErr = cConstUp - cConstDown+        cNonconstUp = 2 * cConstUp+        cNonconstDown = 2 `timesDown` cConstDown+        cNonconstErr = cNonconstUp - cNonconstDown+        addDiffTerms degreeToAdd ball@(coeffs, radius)+            | degreeToAdd < 0 = ball+            | degreeToAdd == 0 =+                addTermWithDegree 0 cConstDown cConstErr+            | otherwise =+                addDiffTerms (degreeToAdd - 2) $+                    addTermWithDegree degreeToAdd cNonconstUp cNonconstErr+            where+            addTermWithDegree diffVarDegree c cErr =+                (newCoeffs, radius + cErr + newCoeffErr)+                where+                newCoeffs = Map.insert newTerm newCoeffDown coeffs +                newCoeffUp = oldCoeff + c+                newCoeffDown = oldCoeff `plusDown` c+                newCoeffErr = newCoeffUp - newCoeffDown+                oldCoeff = +                    case Map.lookup newTerm coeffs of+                        Nothing -> 0+                        Just c -> c+                newTerm = DBox.insert diffVar degreeToAdd term  +            addRadius (p,r) = (p, r + radius) +--             +--                +--        (centrePolyWithDiffTerm, prevRadius + )+--        Map.insertWith Map.union substVarDegree (Map.singleton termNoSubstVar c) prevPolynomMap+    ++    +    

@@ -11,7 +11,7 @@          Internal module for "Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom".     -    Implementation of elementary functions applied to polynomials.+    Implementation of division applied to basic polynomial enclosures. -} module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Division  where@@ -28,21 +28,24 @@ import qualified Data.Number.ER.Real.Base as B import Data.Number.ER.Real.Approx.Interval import Data.Number.ER.Real.Arithmetic.Elementary-import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox, DomainBoxMappable) import Data.Number.ER.BasicTypes import Data.Number.ER.Misc  import qualified Data.Map as Map  {-|-    Approximate the pointwise cosine of a polynomial +    Approximate the pointwise reciprocal of a polynomial      by another polynomial from below and from above     using the tau method         as described in [Mason & Handscomb 2003, p 62].  -} enclRecip ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      EffortIndex {-^ minimum approx degree -} -> @@ -76,7 +79,7 @@ --        ) $         case allInterimsBounded of             True -> resEncl-            False -> (chplConst 0, chplConst (1/0))+            False -> (chplConst 0, chplConst (B.plusInfinity))     | otherwise = -- cannot establish 0 freedom         error $              "ERChebPoly: enclRecip: "@@ -107,7 +110,7 @@     trT1Encl =          enclAddConst (-1) (enclRAScale maxDegree maxSize nu (enclAddConst (-1) pAbove1Encl))     nu = recip nuInv -- auxiliary constant-    nuInv = (RA.setMinGranularity coeffGr (ERInterval upperBtr upperBtr) - 1) / 2+    nuInv = (RA.setMinGranularityOuter coeffGr (ERInterval upperBtr upperBtr) - 1) / 2          nuPlus1 = nu + 1     nuInvPlus1 = nuInv + 1

@@ -0,0 +1,78 @@+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.DivisionInner+    Description :  (internal) division of polynomials+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Internal module for "Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom".+    +    Implementation of inner-rounded division +    applied to basic polynomial enclosures.+-}+module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.DivisionInner+where++import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Reduce+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Eval+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Bounds+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.EnclosureInner+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Division++import qualified Data.Number.ER.Real.Approx as RA+import qualified Data.Number.ER.Real.Approx.Elementary as RAEL+import qualified Data.Number.ER.Real.Base as B+import Data.Number.ER.Real.Approx.Interval+import Data.Number.ER.Real.Arithmetic.Elementary+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox, DomainBoxMappable)+import Data.Number.ER.BasicTypes+import Data.Number.ER.Misc++import qualified Data.Map as Map++{-|+    Approximate the pointwise reciprocal of a positive polynomial +    by another polynomial from below and from above+    using the tau method+    as described in [Mason & Handscomb 2003, p 62]. +-}+ienclRecipPositive ::+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) => +    Int {-^ maximum polynomial degree -} -> +    Int {-^ maximum term count -} -> +    EffortIndex {-^ minimum approx degree -} -> +    Int {-^ degree of tau expansion -} -> +    ((ERChebPoly box b, ERChebPoly box b), Bool) ->+    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclRecipPositive maxDegree maxSize ix tauDegr (e@(ln, h), isAC) = +    ((hnRDown,lRDown), isAC)+    where+    hnRDown = chplNeg hRUp+    lRDown = chplNeg lnRUp+    (_, lnRUp) = enclRecip maxDegree maxSize ix tauDegr (chplNeg ln,ln)+    (_, hRUp) = enclRecip maxDegree maxSize ix tauDegr (chplNeg h,h)+    ++--    | lDefinitelyPositive && hDefinitelyPositive =+--        ((hnRDown,lRDown), isAC)+--    | lDefinitelyNegative && hDefinitelyNegative =+--        ienclRecip maxDegree maxSize ix tauDegr ((h, ln), isAC)+--    | otherwise = +--        error ""+--    where+--    lDefinitelyPositive = chplUpperBound ix ln < 0+--    hDefinitelyPositive = chplLowerBound ix h > 0+--    lDefinitelyNegative = chplLowerBound ix ln > 0+--    hDefinitelyNegative = chplUpperBound ix h < 0+    

@@ -29,31 +29,92 @@ import qualified Data.Number.ER.Real.Base as B import Data.Number.ER.Real.Approx.Interval import Data.Number.ER.Real.Arithmetic.Elementary-import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox, DomainBoxMappable) import Data.Number.ER.BasicTypes import Data.Number.ER.Misc  import qualified Data.Map as Map  {-|-    Approximate the pointwise exponential of a square root enclosure. +    Approximate the pointwise square root of a polynomial enclosure. -} enclSqrt ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} -> -    EffortIndex {-^  ?? -} -> +    EffortIndex {-^ for calls to other ER functions -} -> +    Int {-^ how many times to iterate -} ->      (ERChebPoly box b, ERChebPoly box b) ->     (ERChebPoly box b, ERChebPoly box b)-enclSqrt maxDegree maxSize ix p =-    error "ERChebPoly: chplSqrt: not implemented yet"-+enclSqrt maxDegree maxSize ix maxIters p =+    result+    where+    result+        | pLowerBound >= 1 =+            eSqrt p+        | pLowerBound > 0 = +            enclRAScale maxDegree maxSize (RAEL.sqrt ix pLowerBoundRA) $ +                eSqrt $ +                    enclRAScale maxDegree maxSize (recip pLowerBoundRA) p +        | otherwise = +            error $ "ERChebPoly: enclSqrt: cannot confirm positivity of " ++ show p+    pLowerBound = fst $ enclBounds ix p+    pLowerBoundRA = ERInterval pLowerBound pLowerBound+    eSqrt p@(ln,h)+--        | chplUpperBound ix ln >= 0 =+--            error $ "ERChebPoly: enclSqrt: internal error at eSqrt: cannot show l is positive"+--        | chplLowerBound ix h <= 0 =+--            error $ "ERChebPoly: enclSqrt: internal error at eSqrt: cannot show h is positive"+        | otherwise =+            -- assuming p >= 1, which implies 1 <= sqrt p <= p and 0 < 1/p <= 1/(sqrt p)+            (chplMultiplyUp ln lRecipSqrtDown,+             chplRecipUp hRecipSqrtDown)+        where+        lRecipSqrtDown = recipSqrtDown $ chplNeg ln+        hRecipSqrtDown = recipSqrtDown $ h+        chplMultiplyUp p1 p2 =+            chplReduceTermCountUp maxSize $+            chplReduceDegreeUp maxDegree $ p1 *^ p2+        chplMultiplyDown p1 p2 =+            chplReduceTermCountDown maxSize $+            chplReduceDegreeDown maxDegree $ p1 *. p2+        chplRecipUp p =+            snd $+                enclRecip maxDegree maxSize ix (maxDegree + 1) $ +                    enclThin p+        recipSqrtDown p +            | chplLowerBound ix pRecipDown > 0 =+                iterRecipSqrt maxIters pRecipDown+            | otherwise =+                chplConst $ negate $ recip $ negate $ chplUpperBound ix p+            where+            pRecipDown =+                chplNeg $ fst $ +                    enclRecip maxDegree maxSize ix (maxDegree + 1) $ +                        enclThin p+            iterRecipSqrt maxIters qNm1 +                | maxIters > 0 && qNpositive =+                    iterRecipSqrt (maxIters - 1) qN+                | otherwise = qNm1 +                where+                qNpositive =+                    chplLowerBound ix qN > 0 +                qN =+                    chplMultiplyDown +                        (chplScaleDown (0.5) qNm1)+                        ((chplConst 3) -. (chplMultiplyUp p $ chplMultiplyUp qNm1 qNm1))  {-|     Approximate the pointwise exponential of a polynomial enclosure. -} enclExp ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      EffortIndex {-^ used to derive minimum approx Taylor degree -} -> @@ -101,7 +162,7 @@         -- the difference between exact exp and finite Taylor expanstion is an increasing function         -- therefore it is enough to compensate the error at the right-most point     expTayNear0 =-        expAux pNear0Encl 1 (RA.setGranularity coeffGr 1)+        expAux pNear0Encl 1 (RA.setGranularityOuter coeffGr 1)     expAux p0Encl nextDegree thisCoeff             | nextDegree > taylorDegree =                 enclRAConst thisCoeff@@ -123,7 +184,7 @@     getConst p =          case chplGetConst p of Just c -> c; _ -> 0     (valueAtRNear0LowNeg, valueAtRNear0High) =-        expAux rNear0Encl 1 (RA.setGranularity coeffGr 1)+        expAux rNear0Encl 1 (RA.setGranularityOuter coeffGr 1)     rNear0Encl = enclRAConst rNear0     _ = [rNear0Encl, pEncl] -- help the typechecker... @@ -131,7 +192,10 @@     Approximate the pointwise integer power of an enclosure. -} enclPow ::-    (B.ERRealBase b, RealFrac b, Integral i, DomainBox box varid Int, Ord box) => +    (Integral i, B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      (ERChebPoly box b, ERChebPoly box b) ->@@ -158,7 +222,7 @@     Approximate the pointwise natural logarithm of an enclosure.  -} enclLog ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      EffortIndex {-^  ?? -} -> @@ -173,7 +237,10 @@     Assuming the polynomial range is [-pi/2, pi/2].  -} enclSine ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      EffortIndex {-^ how hard to try (determines Taylor degree and granularity) -} -> @@ -194,12 +261,11 @@             enclMultiply maxDegree maxSize pEncl sineTayEncl         (sineTayEncl, sineErrorTermDegree, sineErrorTermCoeffRA) =             sincosTaylorAux maxDegree maxSize True pSqrEncl taylorDegree 1 one-        one = RA.setGranularity coeffGr 1+        one = RA.setGranularityOuter coeffGr 1         pSqrEncl = enclMultiply maxDegree maxSize pEncl pEncl         sineErrorBound =             case sineErrorBoundRA of                  ERInterval lo hi -> hi-                ERIntervalAny -> 1/0             where             sineErrorBoundRA =                         (ranLargerEndpointRA ^ sineErrorTermDegree) * sineErrorTermCoeffHighRA@@ -219,7 +285,10 @@     Assuming the polynomial range is [-pi/2, pi/2].  -} enclCosine ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      EffortIndex {-^ how hard to try (determines Taylor degree and granularity) -} -> @@ -240,12 +309,11 @@             cosineTayEncl         (cosineTayEncl, cosineErrorTermDegree, cosineErrorTermCoeffRA) =             sincosTaylorAux maxDegree maxSize True pSqrEncl taylorDegree 0 one-        one = RA.setGranularity coeffGr 1+        one = RA.setGranularityOuter coeffGr 1         pSqrEncl = enclMultiply maxDegree maxSize pEncl pEncl         cosineErrorBound =             case cosineErrorBoundRA of                  ERInterval lo hi -> hi-                ERIntervalAny -> 1/0             where             cosineErrorBoundRA =                         (ranLargerEndpointRA ^ cosineErrorTermDegree) * cosineErrorTermCoeffHighRA@@ -260,7 +328,10 @@         coeffGr = effIx2gran $ ix      sincosTaylorAux ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->     Int {-^ maximum term count -} ->     Bool {-^ is sine ? -} -> @@ -315,7 +386,10 @@     Approximate the pointwise arcus tangens of an enclosure.  -} enclAtan ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      EffortIndex {-^ how far to go in the Euler's series -} ->@@ -346,7 +420,7 @@     (pLowerBound, pUpperBound) = enclBounds ix pEncl     onePlusSqrtOnePlusPSquare =         enclAddConst 1 $-            enclSqrt maxDegree maxSize ix pSquarePlus1Encl+            enclSqrt maxDegree maxSize ix maxDegree pSquarePlus1Encl     avoidingDivBy0 =         lower1 > 0 && lower2 > 0         where

@@ -0,0 +1,415 @@+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Elementary+    Description :  (internal) elementary functions applied to polynomials  +    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Internal module for "Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom".+    +    Implementation of inner-rounded +    elementary functions applied to polynomials.+-}+module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.ElementaryInner +where++import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Reduce+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Eval+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Bounds+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Division+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Elementary ++import qualified Data.Number.ER.Real.Approx as RA+import qualified Data.Number.ER.Real.Approx.Elementary as RAEL+import qualified Data.Number.ER.Real.Base as B+import Data.Number.ER.Real.Approx.Interval+import Data.Number.ER.Real.Arithmetic.Elementary+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox, DomainBoxMappable)+import Data.Number.ER.BasicTypes+import Data.Number.ER.Misc++import qualified Data.Map as Map++{-|+    +-}+ienclSqrt ::+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) => +    Int {-^ maximum polynomial degree -} -> +    Int {-^ maximum term count -} -> +    EffortIndex {-^ for calls to other ER functions -} -> +    Int {-^ how many times to iterate -} -> +    ((ERChebPoly box b, ERChebPoly box b), Bool) ->+    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclSqrt maxDegree maxSize ix maxIters (e@(ln, h), isDAC) = +    ((lnRDown,hRDown), isDAC)+    where+    lnRDown = chplNeg lRUp+    hRDown = chplNeg hnRUp+    (_, lRUp) = enclSqrt maxDegree maxSize ix maxIters (ln,chplNeg ln)+    (hnRUp, _) = enclSqrt maxDegree maxSize ix maxIters (chplNeg h,h)+    +--{-|+--    Approximate the pointwise exponential of a polynomial enclosure.+---}+--enclExp ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} -> +--    EffortIndex {-^ used to derive minimum approx Taylor degree -} -> +--    (ERChebPoly box b, ERChebPoly box b) ->+--    (ERChebPoly box b, ERChebPoly box b)+--enclExp maxDegree maxSize ix pEncl =+----    unsafePrintReturn+----    ( +----        "chplExp:" +++----        "\n pEncl = " ++ show pEncl +++----        "\n upperB = " ++ show upperB +++----        "\n lowerB = " ++ show lowerB +++----        "\n m = " ++ show m +++----        "\n expM = " ++ show expM +++----        "\n r = " ++ show r +++----        "\n a_int = " ++ show a_int +++----        "\n a_base = " ++ show a_base +++----        "\n pNear0Encl = " ++ show (pNear0Encl) +++----        "\n expNear0 = " ++ show (expNear0) +++------        "\n chplPow maxDegree (expNear0Up pNear0Up) a_int = " ++ show (chplPow maxDegree (expNear0Up pNear0Up) a_int)+----        "\n result = "+----    )+----    $ +--    result+--    where+--    result =+--        enclRAScale maxDegree maxSize expM $ enclPow maxDegree maxSize expNear0 a_int+--+--    (lowerB, upperB) = enclBounds ix pEncl+--    mB = (upperB + lowerB) / 2+--    rB = (upperB - lowerB) / 2+--    r = ERInterval rB rB+--    m = ERInterval mB mB+--    expM = max 0 $ erExp_IR ix m+--    +--    -- scale the problem down for polynomials whose value is always near zero:+--    pNear0Encl = +--        enclRAScale maxDegree maxSize (recip a_base) (pEncl -: (enclConst mB))+--    rNear0 = r / a_base+--    a_base = fromInteger a_int+--    a_int = max 1 $ floor rB -- could this be too high?+--    +--    expNear0 =+--        expTayNear0 +: (chplConst 0, chplConst (erintv_right truncCorrNear0))+--        -- the difference between exact exp and finite Taylor expanstion is an increasing function+--        -- therefore it is enough to compensate the error at the right-most point+--    expTayNear0 =+--        expAux pNear0Encl 1 (RA.setGranularity coeffGr 1)+--    expAux p0Encl nextDegree thisCoeff+--            | nextDegree > taylorDegree =+--                enclRAConst thisCoeff+--            | otherwise =+--                (enclRAConst thisCoeff) +: (p0Encl *: (expAux p0Encl (nextDegree + 1) nextCoeff))+--            where+--            (*:) = enclMultiply maxDegree maxSize+--            nextCoeff = +--                thisCoeff / (fromInteger nextDegree)+--    taylorDegree = 1 + 2 * (ix `div` 6)+--    coeffGr = effIx2gran $ 10 + 3 * taylorDegree+--    -- correction of truncation error (highest at the right-most point):+--    truncCorrNear0 = expRNear0 - tayRNear0+--    expRNear0 = erExp_R ix rNear0+--    tayRNear0 = +--        ERInterval+--            (negate $ getConst valueAtRNear0LowNeg) +--            (getConst valueAtRNear0High)+--    getConst p = +--        case chplGetConst p of Just c -> c; _ -> 0+--    (valueAtRNear0LowNeg, valueAtRNear0High) =+--        expAux rNear0Encl 1 (RA.setGranularity coeffGr 1)+--    rNear0Encl = enclRAConst rNear0+--    _ = [rNear0Encl, pEncl] -- help the typechecker...+--+--{-|+--    Approximate the pointwise integer power of an enclosure.+---}+--enclPow ::+--    (B.ERRealBase b, Integral i, DomainBox box varid Int, Ord box) => +--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} -> +--    (ERChebPoly box b, ERChebPoly box b) ->+--    i ->+--    (ERChebPoly box b, ERChebPoly box b)+--        {-^ lower (negated) and upper bound -}+--enclPow maxDegree maxSize pEncl n+--    | n == 0 =+--        enclConst 1+--    | n == 1 =+--        pEncl+--    | even n =+--        powEvenEncl +--    | odd n =+--        enclMultiply maxDegree maxSize powEvenEncl pEncl+--    where+--    powEvenEncl =+--        enclMultiply maxDegree maxSize powHalfEncl powHalfEncl +--    powHalfEncl = +--        enclPow maxDegree maxSize pEncl halfN+--    halfN = n `div` 2+--    +--{-|+--    Approximate the pointwise natural logarithm of an enclosure. +---}+--enclLog ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} -> +--    EffortIndex {-^  ?? -} -> +--    (ERChebPoly box b, ERChebPoly box b) ->+--    (ERChebPoly box b, ERChebPoly box b)+--enclLog maxDegree maxSize ix p =+--    error "ERChebPoly: chplLog: not implemented yet"+--+--{-|+--    Approximate the pointwise sine of an enclosure.+--    +--    Assuming the polynomial range is [-pi/2, pi/2]. +---}+--enclSine ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} -> +--    EffortIndex {-^ how hard to try (determines Taylor degree and granularity) -} -> +--    (ERChebPoly box b, ERChebPoly box b) ->+--    (ERChebPoly box b, ERChebPoly box b)+--enclSine maxDegree maxSize ix pEncl =+----        unsafePrint+----        (+----            "ERChebPoly: enclSine: "+----            ++ "\n pEncl = " ++ show pEncl+----            ++ "\n ranLargerEndpoint = " ++ show ranLargerEndpoint+----            ++ "\n sineEncl = " ++ show sineEncl+----        ) $+--        sineEncl+--        where+--        sineEncl =+--            enclAddErr sineErrorBound $+--            enclMultiply maxDegree maxSize pEncl sineTayEncl+--        (sineTayEncl, sineErrorTermDegree, sineErrorTermCoeffRA) =+--            sincosTaylorAux maxDegree maxSize True pSqrEncl taylorDegree 1 one+--        one = RA.setGranularity coeffGr 1+--        pSqrEncl = enclMultiply maxDegree maxSize pEncl pEncl+--        sineErrorBound =+--            case sineErrorBoundRA of +--                ERInterval lo hi -> hi+--                ERIntervalAny -> B.plusInfinity+--            where+--            sineErrorBoundRA =        +--                (ranLargerEndpointRA ^ sineErrorTermDegree) * sineErrorTermCoeffHighRA+--            sineErrorTermCoeffHighRA =+--                snd $ RA.bounds $ abs sineErrorTermCoeffRA+--        ranLargerEndpointRA =+--            ERInterval ranLargerEndpoint ranLargerEndpoint+--        ranLargerEndpoint =+--            max (abs ranLowB) (abs ranHighB)+--        (ranLowB, ranHighB) = enclBounds ix pEncl+--        taylorDegree = effIx2int $ ix `div` 3+--        coeffGr = effIx2gran $ ix+--        +--{-|+--    Approximate the pointwise cosine of an enclosure.+--    +--    Assuming the polynomial range is [-pi/2, pi/2]. +---}+--enclCosine ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} -> +--    EffortIndex {-^ how hard to try (determines Taylor degree and granularity) -} -> +--    (ERChebPoly box b, ERChebPoly box b) ->+--    (ERChebPoly box b, ERChebPoly box b)+--enclCosine maxDegree maxSize ix pEncl =+----        unsafePrint+----        (+----            "ERChebPoly: chplCosine: "+----            ++ "\n pEncl = " ++ show pEncl+----            ++ "\n ranLargerEndpoint = " ++ show ranLargerEndpoint+----            ++ "\n cosineEncl = " ++ show cosineEncl+----        ) $+--        cosineEncl+--        where+--        cosineEncl =+--            enclAddErr cosineErrorBound $+--            cosineTayEncl+--        (cosineTayEncl, cosineErrorTermDegree, cosineErrorTermCoeffRA) =+--            sincosTaylorAux maxDegree maxSize True pSqrEncl taylorDegree 0 one+--        one = RA.setGranularity coeffGr 1+--        pSqrEncl = enclMultiply maxDegree maxSize pEncl pEncl+--        cosineErrorBound =+--            case cosineErrorBoundRA of +--                ERInterval lo hi -> hi+--                ERIntervalAny -> B.plusInfinity+--            where+--            cosineErrorBoundRA =        +--                (ranLargerEndpointRA ^ cosineErrorTermDegree) * cosineErrorTermCoeffHighRA+--            cosineErrorTermCoeffHighRA =+--                snd $ RA.bounds $ abs cosineErrorTermCoeffRA+--        ranLargerEndpointRA =+--            ERInterval ranLargerEndpoint ranLargerEndpoint+--        ranLargerEndpoint =+--            max (abs ranLowB) (abs ranHighB)+--        (ranLowB, ranHighB) = enclBounds ix pEncl+--        taylorDegree = effIx2int $ ix `div` 3+--        coeffGr = effIx2gran $ ix+--    +--sincosTaylorAux ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+--    Int {-^ maximum polynomial degree -} ->+--    Int {-^ maximum term count -} ->+--    Bool {-^ is sine ? -} -> +--    (ERChebPoly box b, ERChebPoly box b) ->+--    Int {-^ how far to go in the Taylor series -} ->+--    Int {-^ degree of the term now being constructed -} ->+--    ERInterval b {-^ the coefficient of the term now being constructed -} -> +--    ((ERChebPoly box b, ERChebPoly box b),+--     Int,+--     ERInterval b)+--    {-^ +--        Bounds for the series result and information about the first discarded term,+--        from which some bound on the uniform error can be deduced.+--    -} +--sincosTaylorAux +--        maxDegree maxSize resultPositive pSqrEncl tayDegree +--        thisDegree thisCoeffRA =+--    sct thisDegree thisCoeffRA+--    where+--    sct thisDegree thisCoeffRA+--        | nextDegree > tayDegree =+----            unsafePrint+----            (+----                "ERChebPoly: sincosTaylorAux: "+----                ++ "\n thisCoeffRA = " ++ show thisCoeffRA+----                ++ "\n nextDegree = " ++ show nextDegree+----            )+--            (thisCoeffEncl, nextDegree, nextCoeffRA)+--        | otherwise =+----            unsafePrint+----            (+----                "ERChebPoly: chplSine: taylorAux: "+----                ++ "\n thisCoeffRA = " ++ show thisCoeffRA+----                ++ "\n nextDegree = " ++ show nextDegree+----                ++ "\n errorTermCoeffRA = " ++ show errorTermCoeffRA+----                ++ "\n errorTermDegree = " ++ show errorTermDegree+----            )+--            (resultEncl, errorTermDegree, errorTermCoeffRA) +--        where+--        thisCoeffEncl = enclRAConst thisCoeffRA+--        resultEncl =+--            thisCoeffEncl +: (enclMultiply maxDegree maxSize pSqrEncl restEncl)+--        (restEncl, errorTermDegree, errorTermCoeffRA) =+--            sct nextDegree nextCoeffRA+--        nextDegree = thisDegree + 2+--        nextCoeffRA = thisCoeffRA / nextCoeffDenominatorRA+--        nextCoeffDenominatorRA =+--            fromInteger $ toInteger $ +--                negate $ nextDegree * (nextDegree - 1)+--+--{-|+--    Approximate the pointwise arcus tangens of an enclosure. +---}+--enclAtan ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} -> +--    EffortIndex {-^ how far to go in the Euler's series -} ->+--    (ERChebPoly box b, ERChebPoly box b) ->+--    (ERChebPoly box b, ERChebPoly box b)+--{- arctan using Euler's series:+--    (http://en.wikipedia.org/wiki/Inverse_trigonometric_function#Infinite_series)+--    +--    (x / (1 + x^2)) * (1 + t*2*1/(2*1 + 1)*(1 + t*2*2/(2*2 + 1)*(1 + ... (1 + t*2*n/(2*n+1)*(1 + ...)))))+--    where+--    t = x^2/(1 + x^2)+--    +--    where the tail  (1 + t*2*n/(2*n+1)*(1 + ...)) is inside the interval:+--    [1, 1 + x^2]+---}+--enclAtan maxDegree maxSize ix pEncl@(pLowNeg, pHigh)+--    | True = -- pLowerBound >= (-3) && pUpperBound <= 3 =+--        enclAtanAux maxDegree maxSize ix (Just pSquareEncl) pEncl+--    | otherwise = -- too far from 0, needs atan(x) = 2*atan(x/(1+sqrt(1+x^2)))+--        case avoidingDivBy0 of+--            True ->+--                enclScale maxDegree maxSize 2 $+--                    enclAtanAux maxDegree maxSize ix Nothing $+--                        enclMultiply maxDegree maxSize pEncl $+--                            enclRecip maxDegree maxSize ix (maxDegree + 1) $+--                                onePlusSqrtOnePlusPSquare+--    where+--    (pLowerBound, pUpperBound) = enclBounds ix pEncl+--    onePlusSqrtOnePlusPSquare =+--        enclAddConst 1 $+--            enclSqrt maxDegree maxSize ix maxDegree pSquarePlus1Encl+--    avoidingDivBy0 =+--        lower1 > 0 && lower2 > 0+--        where+--        (lower1, _) = enclBounds ix pSquarePlus1Encl+--        (lower2, _) = enclBounds ix onePlusSqrtOnePlusPSquare+--    pSquareEncl = +--        enclSquare maxDegree maxSize pEncl+--    pSquarePlus1Encl = +--        pSquareEncl +: (enclConst 1)+--    +--    +--enclAtanAux maxDegree maxSize ix maybePSquareEncl pEncl@(pLowNeg, pHigh) +--    | avoidingDivBy0 = resultEncl+--    | otherwise = +--        (piHalfUp, piHalfUp) -- [-22/14,22/14] is always safe...    +--    where            +--    piHalfUp = chplConst $ 22/7+--    avoidingDivBy0 =+--        lower > 0+--        where+--        (lower, _) = enclBounds ix pSquarePlus1Encl+--    resultEncl =+--        enclMultiply maxDegree maxSize +--            pOverPSquarePlus1Encl preresEncl+--    preresEncl = +--        series termsCount 2+--    termsCount = +--        max 0 $ ix `div` 3+--    gran = effIx2gran ix+--    series termsCount coeffBase +--        | termsCount > 0 =+--            enclAddConst 1 $+--                enclRAScale maxDegree maxSize coeff $+--                    enclMultiply maxDegree maxSize +--                        pSquareOverPSquarePlus1Encl $+--                            series (termsCount - 1) (coeffBase + 2)+--        | otherwise =+--            enclAddConst 1 $+--            (chplConst 0, pSquareHigh)+--        where+--        coeff = coeffBase / (coeffBase + 1)+--        +--    pSquareEncl@(pSquareLowNeg, pSquareHigh) = +--        case maybePSquareEncl of+--            Just pSquareEncl -> pSquareEncl+--            Nothing ->+--                enclSquare maxDegree maxSize pEncl+--    pSquarePlus1Encl = +--        pSquareEncl +: (enclConst 1)+--    recipPSquarePlus1Encl = +--        enclRecip maxDegree maxSize ix (maxDegree + 1) pSquarePlus1Encl+--    pSquareOverPSquarePlus1Encl = +--         enclMultiply maxDegree maxSize pSquareEncl recipPSquarePlus1Encl+--    pOverPSquarePlus1Encl =+--         enclMultiply maxDegree maxSize pEncl recipPSquarePlus1Encl

@@ -2,7 +2,7 @@ {-# LANGUAGE UndecidableInstances #-} {-|     Module      :  Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure-    Description :  (internal) basic operations for primitive polynomial enclosures  +    Description :  (internal) field operations applied to polynomials       Copyright   :  (c) 2007-2008 Michal Konecny     License     :  BSD3 @@ -27,8 +27,8 @@ import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Eval  import qualified Data.Number.ER.Real.Base as B-import qualified Data.Number.ER.Real.DomainBox as DBox-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox, DomainBoxMappable) import Data.Number.ER.Real.Approx.Interval import qualified Data.Number.ER.Real.Approx as RA import Data.Number.ER.Misc@@ -50,56 +50,37 @@     (chplConst (-c), chplConst c)  enclBounds ix (ln, h) =-    (negate $ chplUpperBound ix ln, chplUpperBound ix h)+    (min lLower hLower, max lUpper hUpper)+    where+    (lLower, lUpper) = chplBounds ix $ chplNeg ln+    (hLower, hUpper) = chplBounds ix h +enclBoundsExpensive ix (ln, h) =+    (negate $ chplUpperBoundExpensive ix ln, chplUpperBoundExpensive ix h)+ enclEval e@(ln, h) pt -    | lB > hB =-        unsafePrintReturn-        (-            "ERChebPoly: enclEval: inverted result:"-            ++ "\n h = " ++ show h -            ++ "\n ln = " ++ show ln -            ++ "\n result = "-        )-        result-    | otherwise = result+--    | lB > hB =+--        unsafePrintReturn+--        (+--            "ERChebPoly: enclEval: inverted result:"+--            ++ "\n h = " ++ show h +--            ++ "\n ln = " ++ show ln +--            ++ "\n result = "+--        )+--        result+--    | otherwise = result+    = result     where     result = ERInterval lB hB     lB = negate $ chplEvalUp ln pt     hB = chplEvalUp h pt -enclEvalInner (ln, h) pt =---    normaliseERInterval $-    ERInterval -        (negate $ chplEvalDown ln pt)-        (chplEvalDown h pt)- enclRAEval e@(ln, h) pt =     result      where-    result = lRA RA.\/ hRA-    lRA = fst $ RA.bounds $ negate $ chplRAEval (\b -> ERInterval b b) ln pt-    hRA = snd $ RA.bounds $ chplRAEval (\b -> ERInterval b b) h pt--enclRAEvalInner e@(ln, h) pt =---    unsafePrintReturn---    (---        "ERChebPoly: enclRAEvalInner: "---        ++ "\n lB = " ++ show lB---        ++ "\n hB = " ++ show hB---        ++ "\n result = "---    )-    result -    where-    result =---        normaliseERInterval $ -        ERInterval lB hB-    lB = -        case negate $ chplRAEval (\b -> ERInterval b b) ln pt of-            ERInterval _ lB -> lB-    hB = -        case chplRAEval (\b -> ERInterval b b) h pt of-            ERInterval hB _ -> hB+    result = ERInterval lAtPt hAtPt+    ERInterval lAtPt _ = negate $ chplRAEval (\b -> ERInterval b b) ln pt+    ERInterval _ hAtPt = chplRAEval (\b -> ERInterval b b) h pt  enclAddErr errB (pLowNeg, pHigh) =     (chplAddConstUp errB pLowNeg, chplAddConstUp errB pHigh)@@ -110,7 +91,6 @@     (ERInterval b) ->     (ERChebPoly box b, ERChebPoly box b) enclRAConst (ERInterval lo hi) = (chplConst (-lo), chplConst hi)-enclRAConst ERIntervalAny = (chplConst (-1/0), chplConst (1/0))  enclReduceDegree maxDegree (pLowNeg, pHigh) =     (chplReduceDegreeUp maxDegree pLowNeg, chplReduceDegreeUp maxDegree pHigh)  @@ -129,8 +109,22 @@ (p1LowNeg, p1High) -: (p2LowNeg, p2High) =     (p1LowNeg +^ p2High, p1High +^ p2LowNeg) +enclAdd ::+    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+    Int {-^ maximum polynomial degree -} -> +    Int {-^ maximum term count -} -> +    (ERChebPoly box b, ERChebPoly box b) -> +    (ERChebPoly box b, ERChebPoly box b) ->+    (ERChebPoly box b, ERChebPoly box b)+enclAdd maxDegr maxSize (p1LowNeg, p1High) (p2LowNeg, p2High) =+    enclReduceSize maxSize $+    (p1LowNeg +^ p2LowNeg, p1High +^ p2High)+     enclMultiply ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      (ERChebPoly box b, ERChebPoly box b) -> @@ -141,13 +135,23 @@     enclReduceDegree maxDegr $     case (ln1UpperBound <= 0, h1UpperBound <= 0, ln2UpperBound <= 0, h2UpperBound <= 0) of         (True, _, True, _) -> -- both non-negative+--            unsafePrint "both non-negative" $             (l1l2Neg, h1h2)         (_, True, _, True) -> -- both non-positive+--            unsafePrint "both non-positive" $             (h1h2Neg, l1l2)         (True, _, _, True) -> -- first non-negative, second non-positive+--            unsafePrint "first non-negative, second non-positive" $             (h1l2Neg, l1h2)         (_, True, True, _) -> -- first non-positive, second non-negative-            (l1h2Neg, l1h2)+--            unsafePrint+--                ("ERChebPoly: enclMultiply: first non-positive, second non-negative:"+--                 ++ "\n l1 = " ++ show (chplNeg ln1)+--                 ++ "\n h1 = " ++ show h1+--                 ++ "\n l2 = " ++ show (chplNeg ln2)+--                 ++ "\n h2 = " ++ show h2+--                ) $+            (l1h2Neg, h1l2)         _ -> -- one of both may be crossing zero             (              (h1h2Neg `maxP` l1l2Neg) `maxP` (h1l2Neg `maxP` l1h2Neg)@@ -173,7 +177,10 @@   enclSquare ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      (ERChebPoly box b, ERChebPoly box b) ->@@ -197,8 +204,8 @@ --    maxNegSqUpperB = chplUpperBound 10 maxNegSq --    minZeroMaxNegSqUpperB = chplUpperBound 10 minZeroMaxNegSq      -    (ln2Down, ln2Up, _) = chplMultiply ln ln-    (h2Down, h2Up, _) = chplMultiply h h+    (ln2Down, ln2Up) = chplBall2DownUp $ ballMultiply ln ln+    (h2Down, h2Up) = chplBall2DownUp $ ballMultiply h h      --    reduceDegrSize = reduceSize maxSize . reduceDegree maxDegr     maxP = chplMaxUp maxDegr maxSize@@ -211,7 +218,7 @@     assuming the enclosure is non-negative on the whole unit domain. -}  enclScaleNonneg ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>     b {-^ ratio to scale by -} ->      (ERChebPoly box b, ERChebPoly box b) ->      (ERChebPoly box b, ERChebPoly box b)@@ -224,7 +231,10 @@     Multiply an enclosure by a scalar. -}  enclScale ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->     b {-^ ratio to scale by -} -> @@ -234,7 +244,10 @@     enclMultiply maxDegree maxSize pEncl (enclConst ratio)   enclRAScale ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->     (ERInterval b) -> @@ -247,14 +260,16 @@     Multiply a polynomial by a scalar interval, returning an enclosure. -}  chplScaleRA :: -    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      ERInterval b {-^ lower and upper bounds on the ratio to scale by -} ->      ERChebPoly box b ->     (ERChebPoly box b, ERChebPoly box b)-chplScaleRA maxDegr maxSize (ERIntervalAny) p = enclRAConst ERIntervalAny-chplScaleRA maxDegr maxSize (ERInterval ratioDown ratioUp) p =+chplScaleRA maxDegr maxSize ratio@(ERInterval ratioDown ratioUp) p =     (scaledPDownNeg, scaledPUp)     where     (scaledPDownNeg, scaledPUp) =@@ -269,7 +284,10 @@     applied to a given polynomial, yielding a list of polynomial enclosures.  -} enclEvalTs ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) =>+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ max degree for result -} ->      Int {-^ max approx size for result -} ->     (ERChebPoly box b, ERChebPoly box b) {-^ bounds of a polynomial enclosure to evaluate -} ->@@ -289,7 +307,10 @@     Multiply a polynomial by an enclosure using min/max -} enclThinTimes ::-    (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box) => +    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) =>      Int {-^ maximum polynomial degree -} ->      Int {-^ maximum term count -} ->      ERChebPoly box b ->

@@ -0,0 +1,355 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-|+    Module      :  Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.EnclosureInner+    Description :  (internal) basic operations for primitive polynomial inner-rounded enclosures+    Copyright   :  (c) 2007-2008 Michal Konecny+    License     :  BSD3++    Maintainer  :  mik@konecny.aow.cz+    Stability   :  experimental+    Portability :  portable+    +    Internal module for "Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom".+    +    Implementation of selected operations working on pairs+    of polynomials understood as *inner approximations* of function enclosures.+    These are needed to define full Kaucher arithmetic.+-}+module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.EnclosureInner++where++import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Reduce+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Bounds+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Eval+import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure++import qualified Data.Number.ER.Real.Base as B+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox, DomainBoxMappable)+import Data.Number.ER.Real.Approx.Interval+import qualified Data.Number.ER.Real.Approx as RA+import Data.Number.ER.Misc++import qualified Data.Map as Map++ienclThin ::+    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+    ERChebPoly box b ->+    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclThin p =+    ((chplNeg p, p), True)++ienclConst ::+    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+    b ->+    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclConst c =+    ((chplConst (-c), chplConst c), True)++--ienclBounds ix ((ln, h), isAC) =+--    (negate $ chplUpperBound ix ln, chplUpperBound ix h) ++ienclEval ((ln, h), isAC) pt =+    result+    where+    result = ERInterval lB hB+    lB = negate $ chplEvalDown ln pt+    hB = chplEvalDown h pt++enclEvalInner e pt = ienclEval (e, False) pt ++ienclRAEval (e@(ln, h), _) pt =+--    unsafePrintReturn+--    (+--        "ERChebPoly: ienclRAEval: "+--        ++ "\n lB = " ++ show lB+--        ++ "\n hB = " ++ show hB+--        ++ "\n result = "+--    )+    result +    where+    result = ERInterval lAtPt hAtPt+    ERInterval _ lAtPt = negate $ chplRAEval (\b -> ERInterval b b) ln pt+    ERInterval hAtPt _ = chplRAEval (\b -> ERInterval b b) h pt+            +enclRAEvalInner e pt = ienclRAEval (e, False) pt++ienclAddErr errB ((pLowNeg, pHigh), isAC) =+    ((chplAddConstDown (- errB) pLowNeg, +      chplAddConstDown (- errB) pHigh),+     isAC)+++ienclRAConst ::+    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+    (ERInterval b) ->+    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclRAConst (ERInterval lo hi) = ((chplConst (-lo), chplConst hi), lo >= hi)++ienclReduceDegree maxDegree ((pLowNeg, pHigh), isAC) =+    ((chplReduceDegreeDown maxDegree pLowNeg, +      chplReduceDegreeDown maxDegree pHigh),+     isAC)  +    +ienclReduceSize maxSize ((pLowNeg, pHigh), isAC) =+    ((chplReduceTermCountUp maxSize pLowNeg, +      chplReduceTermCountUp maxSize pHigh),+     isAC)  +    +ienclAddConst c ((pLowNeg, pHigh),isAC) =+    ((chplAddConstDown (-c) pLowNeg, +      chplAddConstDown c pHigh),+     isAC)++ienclNeg ((pLowNeg, pHigh), isAC) = ((pHigh, pLowNeg), isAC)++((p1LowNeg, p1High), isAC1) +:: ((p2LowNeg, p2High), isAC2) = +    ((p1LowNeg +. p2LowNeg, p1High +. p2High), isAC1 && isAC2)+    +((p1LowNeg, p1High), isAC1) -:: ((p2LowNeg, p2High), isAC2) = +    ((p1LowNeg +. p2High, p1High +. p2LowNeg), isAC1 && isAC2)++ienclAdd ::+    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+    Int {-^ maximum polynomial degree -} -> +    Int {-^ maximum term count -} -> +    ((ERChebPoly box b, ERChebPoly box b), Bool) -> +    ((ERChebPoly box b, ERChebPoly box b), Bool) ->+    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclAdd maxDegr maxSize ie1 ie2 =+    ienclReduceSize maxSize $ ie1 +:: ie2+    +ienclMultiply ::+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) => +    Int {-^ maximum polynomial degree -} -> +    Int {-^ maximum term count -} -> +    ((ERChebPoly box b, ERChebPoly box b), Bool) -> +    ((ERChebPoly box b, ERChebPoly box b), Bool) ->+    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclMultiply maxDegr maxSize ie1@(e1@(ln1, h1), isAC1_prev) ie2@(e2@(ln2, h2), isAC2_prev) =+--    unsafePrintReturn+--    (+--        "ERChebPoly: ienclMultiply: "+--        ++ "\n ie1 = " ++ show ie1+--        ++ "\n ie2 = " ++ show ie2+--        ++ "\n isPos1 = " ++ show isPos1+--        ++ "\n isNeg1 = " ++ show isNeg1+--        ++ "\n isPos2 = " ++ show isPos2+--        ++ "\n isNeg2 = " ++ show isNeg2+--        ++ "\n result = "+--    )+    result+    where+    result = +        ienclReduceSize maxSize $+        ienclReduceDegree maxDegr $+        (plainProduct, isAC1 && isAC2)+    plainProduct+        | isPos1 && isPos2 = multPosPos e1 e2  +        | isPos1 && isNeg2 = multPosNeg e1 e2  +        | isNeg1 && isNeg2 = multPosPos (enclNeg e1) (enclNeg e2)  +        | isNeg1 && isPos2 = multPosNeg e2 e1+        | isPos1 = multPosZer (e1, isC1, isAC1) e2+        | isNeg1 = multPosZer (enclNeg e1, isC1, isAC1) (enclNeg e2)+        | isPos2 = multPosZer (e2, isC2, isAC2) e1+        | isNeg2 = multPosZer (enclNeg e2, isC2, isAC2) (enclNeg e1)+        | otherwise = multZerZer (e1, isC1, isAC1) (e2, isC2, isAC2)+    isPos1 = chplUpperBound ix ln1 <= 0 && chplLowerBound ix h1 >= 0 +    isNeg1 = chplLowerBound ix ln1 >= 0 && chplUpperBound ix h1 <= 0+    isPos2 = chplUpperBound ix ln2 <= 0 && chplLowerBound ix h2 >= 0+    isNeg2 = chplLowerBound ix ln2 >= 0 && chplUpperBound ix h2 <= 0+    isAC1 = isAC1_prev || chplUpperBound ix (h1 +^ ln1) <= 0+    isAC2 = isAC2_prev || chplUpperBound ix (h2 +^ ln2) <= 0+    isC1 = chplLowerBound ix (h1 +. ln1) >= 0+    isC2 = chplLowerBound ix (h2 +. ln2) >= 0+    ix = 10++    multPosPos (ln1, h1) (ln2, h2) = +        (chplNeg $ ln1 *^ ln2, h1 *. h2)+    multPosNeg (ln1, h1) (ln2, h2) = +        (h1 *. ln2, (chplNeg ln1) *. h2)+    multPosZer ((ln1,h1), isC1, isAC1) (ln2, h2) = +        multAux ((l1,h1), isC1, isAC1) ln2 h2 +        where+        l1 = chplNeg ln1+        +    multZerZer ((ln1, h1), isC1, isAC1) ((ln2, h2), isC2, isAC2) +        | isC1 || isAC2 = multZZ12+        | isC2 || isAC1 = multZZ21+        | otherwise = isect multZZ12 multZZ21+        where+        multZZ12 +            | isC2 = union multZZ12L multZZ12R+            | otherwise = isect multZZ12L multZZ12R+        multZZ21 +            | isC1 = union multZZ21L multZZ21R+            | otherwise = isect multZZ21L multZZ21R+        multZZ12L = multAux ((l1,h1), isC1, isAC1) ln2 l2+        multZZ12R = multAux ((l1,h1), isC1, isAC1) hn2 h2+        multZZ21L = multAux ((l2,h2), isC2, isAC2) ln1 l1+        multZZ21R = multAux ((l2,h2), isC2, isAC2) hn1 h1+        l1 = chplNeg ln1+        l2 = chplNeg ln2+        hn1 = chplNeg h1+        hn2 = chplNeg h2+        +    isect (ln1, h1) (ln2, h2) = (minP ln1 ln2, minP h1 h2) +    union (ln1, h1) (ln2, h2) = (maxP ln1 ln2, maxP h1 h2)+    minP = chplMinDn maxDegr maxSize +    maxP = chplMaxDn maxDegr maxSize +    +    multAux ((l,h), isC, isAC) an b +        | isC =+            (+             maxP (an *. h) (an *. l)+            ,+             maxP (b *. h) (b *. l)+            )+        | isAC =+            (+             minP (an *. h) (an *. l)+            ,+             minP (b *. h) (b *. l)+            )+        | otherwise = -- enclosure could be a mix of consistent and inconsistent +            (+             ((nonnegP an) *. h) +             +. +             ((nonposP an) *. l)+             -- ie: if (l <= h) then max(an*h, an*l) else min(an*h, an*l)+            ,+             ((nonnegP b) *. h) +             +. +             ((nonposP b) *. l)+             -- ie: if (l <= h) then max(b*h, b*l) else min(b*h, b*l)+            )+    +    nonposP = chplNonposDown maxDegr maxSize+    nonnegP = chplNonnegDown maxDegr maxSize+    ++ienclSquare ::+    (B.ERRealBase b, +     DomainBox box varid Int, Ord box, Show varid,+     DomainIntBox boxra varid (ERInterval b),+     DomainBoxMappable boxra boxras varid (ERInterval b) [ERInterval b]) => +    Int {-^ maximum polynomial degree -} -> +    Int {-^ maximum term count -} -> +    ((ERChebPoly box b, ERChebPoly box b), Bool) ->+    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclSquare maxDegr maxSize ie@((ln, h), isAC) =+    ienclMultiply maxDegr maxSize ie ie ++--    {-+--        formula:+--            (ln, h)^2 =+--                ( minUp( 0, maxUp( - ln *. ln, - h *. h)), maxUp(ln *^ ln, h *^ h) )+--    -}+----    | minZeroHelps = +--    = (minZeroMaxNegSq, maxSq)+----    | otherwise =+----        (maxNegSq, maxSq)+--    where+--    maxSq = maxP ln2Up h2Up+--    maxNegSq = maxP (chplNeg ln2Down) (chplNeg h2Down)+--    minZeroMaxNegSq = chplNonposUp maxDegr maxSize maxNegSq +----    minZeroHelps =+----        (maxNegSqUpperB > 0) && (minZeroMaxNegSqUpperB / maxNegSqUpperB < 1/2)+----    maxNegSqUpperB = chplUpperBound 10 maxNegSq+----    minZeroMaxNegSqUpperB = chplUpperBound 10 minZeroMaxNegSq+--     +--    (ln2Down, ln2Up, _) = chplMultiply ln ln+--    (h2Down, h2Up, _) = chplMultiply h h+--    +----    reduceDegrSize = reduceSize maxSize . reduceDegree maxDegr+--    maxP = chplMaxUp maxDegr maxSize++{-| +    Multiply an enclosure by a scalar +    assuming the enclosure is non-negative on the whole unit domain.+-} +ienclScaleNonneg ::+    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+    b {-^ ratio to scale by -} -> +    ((ERChebPoly box b, ERChebPoly box b), Bool) -> +    ((ERChebPoly box b, ERChebPoly box b), Bool)+ienclScaleNonneg ratio pEncl@((ln, h), isAC) =+    ((ln *. pRatio, h *. pRatio), isAC)+    where+    pRatio = chplConst ratio++--{-| +--    Multiply an enclosure by a scalar.+---} +--enclScale ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} ->+--    b {-^ ratio to scale by -} -> +--    (ERChebPoly box b, ERChebPoly box b) -> +--    (ERChebPoly box b, ERChebPoly box b)+--enclScale maxDegree maxSize ratio pEncl =+--    enclMultiply maxDegree maxSize pEncl (enclConst ratio) +--+--enclRAScale ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} ->+--    (ERInterval b) -> +--    (ERChebPoly box b, ERChebPoly box b) ->+--    (ERChebPoly box b, ERChebPoly box b)+--enclRAScale maxDegree maxSize ra pEncl =+--    enclMultiply maxDegree maxSize pEncl (enclRAConst ra) +--+--{-|+--    Evaluate the Chebyshev polynomials of the first kind+--    applied to a given polynomial, yielding a list of polynomial enclosures. +---}+--enclEvalTs ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) =>+--    Int {-^ max degree for result -} -> +--    Int {-^ max approx size for result -} ->+--    (ERChebPoly box b, ERChebPoly box b) {-^ bounds of a polynomial enclosure to evaluate -} ->+--    [(ERChebPoly box b, ERChebPoly box b)]+--enclEvalTs maxDegree maxSize p1@(pLowNeg, pHigh) =+--    chebyIterate (enclConst 1) p1+--    where+--    chebyIterate pNm2 pNm1 =+--        pNm2 : (chebyIterate pNm1 pN)+--        where+--        pN = +--            (enclScale maxDegree maxSize 2 $ +--                enclMultiply maxDegree maxSize p1 pNm1) +--            -: pNm2+--+--{-|+--    Multiply a polynomial by an enclosure using min/max+---}+--enclThinTimes ::+--    (B.ERRealBase b, DomainBox box varid Int, Ord box) => +--    Int {-^ maximum polynomial degree -} -> +--    Int {-^ maximum term count -} -> +--    ERChebPoly box b ->+--    (ERChebPoly box b, ERChebPoly box b) ->+--    (ERChebPoly box b, ERChebPoly box b)+--enclThinTimes maxDegree maxSize p1 (p2LowNeg, p2High) =+--    (prodLowNeg, prodHigh)+--    where+--    prodHigh =+--        chplMaxUp maxDegree maxSize+--            (p1 *^ p2High)+--            (p1n *^ p2LowNeg) -- beware: p1 can cross zero+--    prodLowNeg =+--        chplMaxUp maxDegree maxSize+--            (p1n *^ p2High)+--            (p1 *^ p2LowNeg)+--    p1n = chplNeg p1+--+--