summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichalKonecny <>2009-07-28 23:04:26 (GMT)
committerLuite Stegeman <luite@luite.com>2009-07-28 23:04:26 (GMT)
commit9ea559ff4a4eaf5c7232a45050e87fe99bbf9753 (patch)
tree87da3114ed0a01cb661829f3f3e8bf95d28fab58
parent70c7767589f1b4b993563dd05fe47c9c6b668a29 (diff)
version 0.50.5
-rw-r--r--AERN-RnToRm.cabal93
-rw-r--r--ChangeLog10
-rw-r--r--demos/Demo.hs (renamed from tests/Demo.hs)2
-rw-r--r--demos/ISin3.hs (renamed from tests/ISin3.hs)25
-rw-r--r--src/Data/Number/ER/RnToRm.hs4
-rw-r--r--src/Data/Number/ER/RnToRm/Approx.hs40
-rw-r--r--src/Data/Number/ER/RnToRm/Approx/DomEdges.hs11
-rw-r--r--src/Data/Number/ER/RnToRm/Approx/DomTransl.hs50
-rw-r--r--src/Data/Number/ER/RnToRm/Approx/PieceWise.hs9
-rw-r--r--src/Data/Number/ER/RnToRm/Approx/Tuple.hs7
-rw-r--r--src/Data/Number/ER/RnToRm/BisectionTree.hs145
-rw-r--r--src/Data/Number/ER/RnToRm/BisectionTree/Integration.hs74
-rw-r--r--src/Data/Number/ER/RnToRm/BisectionTree/Path.hs2
-rw-r--r--src/Data/Number/ER/RnToRm/DefaultRepr.hs12
-rw-r--r--src/Data/Number/ER/RnToRm/TestingDefs.hs5
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Approx.hs4
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Approx/Interval.hs261
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Approx/IntervalOI.hs1086
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base.hs417
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Generate.hs375
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Bounds.hs54
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Common.hs276
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Compose.hs121
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Division.hs88
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Elementary.hs140
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Enclosure.hs176
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Integration.hs49
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Reduce.hs44
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Ring.hs70
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Run.hs134
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom.hs113
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Basic.hs11
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Bounds.hs444
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Compose.hs28
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Derivative.hs90
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Division.hs17
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/DivisionInner.hs78
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Elementary.hs118
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/ElementaryInner.hs415
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Enclosure.hs135
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/EnclosureInner.hs355
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Eval.hs6
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Integration.hs24
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Reduce.hs4
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Ring.hs136
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Bounds.hs46
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Compose.hs114
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Division.hs78
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Elementary.hs120
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Enclosure.hs106
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Generate.hs592
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Reduce.hs37
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Ring.hs47
-rw-r--r--src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Run.hs159
-rw-r--r--tests/RunPolynomTests.hs51
55 files changed, 5080 insertions, 2028 deletions
diff --git a/AERN-RnToRm.cabal b/AERN-RnToRm.cabal
index a2dee5a..04773d8 100644
--- a/AERN-RnToRm.cabal
+++ b/AERN-RnToRm.cabal
@@ -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 @@ Description:
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
diff --git a/ChangeLog b/ChangeLog
index 56af5ad..f1fa3a9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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.
diff --git a/tests/Demo.hs b/demos/Demo.hs
index 52619f7..275ce21 100644
--- a/tests/Demo.hs
+++ b/demos/Demo.hs
@@ -13,7 +13,7 @@
module Main where
import qualified Data.Number.ER.RnToRm as AERNFunc
-import qualified Data.Number.ER.Real.DomainBox as DBox
+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox
import qualified Data.Number.ER.Real as AERN
diff --git a/tests/ISin3.hs b/demos/ISin3.hs
index baaa75a..131b64d 100644
--- a/tests/ISin3.hs
+++ b/demos/ISin3.hs
@@ -28,20 +28,27 @@ type IRA = AERN.IRA B
main =
do
AERN.initialiseBaseArithmetic (0 :: RA)
- putStrLn $ "integ(sin(sin(sin(x)))dx = " ++ show result
+ 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) $
- AERNFunc.integrateUnary 0
- (sin3 120 0 42 160)
- 0 (0 AERN.\/ 1) [0]
- sin3 ix depth deg gran =
+ 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 $
- AERN.setMinGranularity gran $
- AERNFunc.setMaxDegree deg fapwUPX0
+ AERNFunc.bisectUnbisectDepth depth $
+ AERNFunc.setMaxSize size $
+ AERNFunc.setMaxDegree deg fapwUPX0
diff --git a/src/Data/Number/ER/RnToRm.hs b/src/Data/Number/ER/RnToRm.hs
index cb87ff7..9a0b889 100644
--- a/src/Data/Number/ER/RnToRm.hs
+++ b/src/Data/Number/ER/RnToRm.hs
@@ -77,13 +77,13 @@ module Data.Number.ER.RnToRm
(
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
diff --git a/src/Data/Number/ER/RnToRm/Approx.hs b/src/Data/Number/ER/RnToRm/Approx.hs
index 86be60c..9377d58 100644
--- a/src/Data/Number/ER/RnToRm/Approx.hs
+++ b/src/Data/Number/ER/RnToRm/Approx.hs
@@ -20,15 +20,16 @@ module Data.Number.ER.RnToRm.Approx
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 @@ import qualified Data.Map as Map
* 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 @@ keyPointsConsistencyCheck g fRes =
[fResPt] = eval ptB fRes
isInConsistent (_, gResPt, fResPt) =
RA.isDisjoint gResPt fResPt
- \ No newline at end of file
+
+
+{-|
+ 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]
+
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/Approx/DomEdges.hs b/src/Data/Number/ER/RnToRm/Approx/DomEdges.hs
index 6a42104..b5c0823 100644
--- a/src/Data/Number/ER/RnToRm/Approx/DomEdges.hs
+++ b/src/Data/Number/ER/RnToRm/Approx/DomEdges.hs
@@ -25,11 +25,11 @@ 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 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 @@ instance
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 @@ instance
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"
diff --git a/src/Data/Number/ER/RnToRm/Approx/DomTransl.hs b/src/Data/Number/ER/RnToRm/Approx/DomTransl.hs
index d2c8282..1cabe29 100644
--- a/src/Data/Number/ER/RnToRm/Approx/DomTransl.hs
+++ b/src/Data/Number/ER/RnToRm/Approx/DomTransl.hs
@@ -29,8 +29,8 @@ import qualified Data.Number.ER.RnToRm.Approx as FA
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 @@ makeDomTransl dom
(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 @@ instance
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 @@ instance
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 @@ instance
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 @@ instance
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 @@ instance
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
+
+
+
+
+
diff --git a/src/Data/Number/ER/RnToRm/Approx/PieceWise.hs b/src/Data/Number/ER/RnToRm/Approx/PieceWise.hs
index a5d34ec..364f289 100644
--- a/src/Data/Number/ER/RnToRm/Approx/PieceWise.hs
+++ b/src/Data/Number/ER/RnToRm/Approx/PieceWise.hs
@@ -36,8 +36,8 @@ 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 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 @@ instance
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 @@ instance
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 =
diff --git a/src/Data/Number/ER/RnToRm/Approx/Tuple.hs b/src/Data/Number/ER/RnToRm/Approx/Tuple.hs
index bb16ab4..58fdecc 100644
--- a/src/Data/Number/ER/RnToRm/Approx/Tuple.hs
+++ b/src/Data/Number/ER/RnToRm/Approx/Tuple.hs
@@ -25,7 +25,7 @@ where
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 @@ instance
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 @@ instance
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 =
diff --git a/src/Data/Number/ER/RnToRm/BisectionTree.hs b/src/Data/Number/ER/RnToRm/BisectionTree.hs
index c73059f..974bf70 100644
--- a/src/Data/Number/ER/RnToRm/BisectionTree.hs
+++ b/src/Data/Number/ER/RnToRm/BisectionTree.hs
@@ -46,8 +46,8 @@ import Prelude hiding (const, map, compare)
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 @@ instance (VariableID varid, Show d, Show v, DomainBox box varid d) =>
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 @@ showBisectionTree showValue =
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 @@ instance (Show d, H.HTML v, DomainBox box varid d) =>
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 @@ const ::
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 @@ split valSplitter ix splitDir splitPt fallbackDom bistr =
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 @@ mapWithDom ::
(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 @@ mapLeaves ::
(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 @@ mapMultiLeaves ::
(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 @@ doBistr f Nothing bistr =
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 @@ doMap f Nothing bistr =
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 @@ doMap f (Just maxDepth) bistr =
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 @@ doMapLeaves f Nothing bistr =
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 @@ doMapLeaves f (Just maxDepth) bistr =
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 ::
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 @@ removeVars substitutions bistr =
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 @@ sync2 valSplitter1 valSplitter2 ix bistr1 bistr2 =
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 @@ sync2 valSplitter1 valSplitter2 ix bistr1 bistr2 =
| 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 ::
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 @@ combineWith valSplitter1 valSplitter2 f ix bistr1 bistr2 =
(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 @@ collectValues (Node _ _ _ _ cLO cHI) =
-}
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 @@ lookupSubtreeDoms ::
(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 @@ lookupSubtreeDoms origBistr dom =
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 @@ updateVal valSplitter ix maxDepth updateDom updateFn bistr =
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 @@ updateVal valSplitter ix maxDepth updateDom updateFn bistr =
(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
diff --git a/src/Data/Number/ER/RnToRm/BisectionTree/Integration.hs b/src/Data/Number/ER/RnToRm/BisectionTree/Integration.hs
index f7dc5ba..f4df50e 100644
--- a/src/Data/Number/ER/RnToRm/BisectionTree/Integration.hs
+++ b/src/Data/Number/ER/RnToRm/BisectionTree/Integration.hs
@@ -19,8 +19,8 @@ where
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 @@ zipFromOrigin
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 @@ zipFromOrigin
| 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 @@ zipFromOrigin
-- 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 @@ zipFromOrigin
(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 @@ zipFromOrigin
(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 @@ zipOnSubdomain ::
{-^ 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)
diff --git a/src/Data/Number/ER/RnToRm/BisectionTree/Path.hs b/src/Data/Number/ER/RnToRm/BisectionTree/Path.hs
index 9bd6ea7..568a523 100644
--- a/src/Data/Number/ER/RnToRm/BisectionTree/Path.hs
+++ b/src/Data/Number/ER/RnToRm/BisectionTree/Path.hs
@@ -16,7 +16,7 @@ module Data.Number.ER.RnToRm.BisectionTree.Path where
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
diff --git a/src/Data/Number/ER/RnToRm/DefaultRepr.hs b/src/Data/Number/ER/RnToRm/DefaultRepr.hs
index 0aa2f23..d98516c 100644
--- a/src/Data/Number/ER/RnToRm/DefaultRepr.hs
+++ b/src/Data/Number/ER/RnToRm/DefaultRepr.hs
@@ -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.Approx as FA
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 Data.Number.ER.RnToRm.Approx.PieceWise
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)
diff --git a/src/Data/Number/ER/RnToRm/TestingDefs.hs b/src/Data/Number/ER/RnToRm/TestingDefs.hs
index 378e17c..d368b78 100644
--- a/src/Data/Number/ER/RnToRm/TestingDefs.hs
+++ b/src/Data/Number/ER/RnToRm/TestingDefs.hs
@@ -19,7 +19,10 @@ import qualified Data.Number.ER.RnToRm.Approx as FA
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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Approx.hs b/src/Data/Number/ER/RnToRm/UnitDom/Approx.hs
index a529fd9..c0c80ee 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/Approx.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Approx.hs
@@ -25,8 +25,8 @@ where
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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Approx/Interval.hs b/src/Data/Number/ER/RnToRm/UnitDom/Approx/Interval.hs
index 5f409fd..836a873 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/Approx/Interval.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Approx/Interval.hs
@@ -21,7 +21,9 @@
module Data.Number.ER.RnToRm.UnitDom.Approx.Interval
(
ERFnInterval(..),
- ERFnContext(..)
+ ERFnContext(..),
+ erfnContextDefault,
+ erfnContextUnify
)
where
@@ -36,8 +38,8 @@ import Data.Number.ER.RnToRm.UnitDom.Base ((+^),(-^),(*^),multiplyEncl)
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 @@ import Data.Binary
--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 @@ data ERFnInterval fb ra =
{
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 @@ erfnContextUnify (ERFnContext dg1 sz1 gr1) (ERFnContext dg2 sz2 gr2) =
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
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
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 @@ instance
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 @@ instance
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 @@ instance
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 @@ instance
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 @@ instance
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 @@ erfnintLeq left right
| 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 @@ instance
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 @@ instance
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 @@ instance
(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 @@ instance
---- 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 @@ instance
-- ++ "\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 @@ instance
-- ++ "\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 @@ instance
(_, 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 @@ sincos isSine maxDegree maxSize ix (ln,h)
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 @@ instance
)
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 @@ instance
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 @@ instance
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 @@ instance
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 @@ instance
{
erfnLowerNeg = fbLNeg,
erfnUpper = fbH,
- erfnContext = context,
- erfnGlobal = val
+ erfnContext = context
}
| otherwise =
ERFnIntervalAny context
@@ -779,11 +784,12 @@ instance
{
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 @@ instance
substitutions =
f
composeWithThin
- f@(ERFnInterval ln1 h1 ctxt1 gl1)
+ f@(ERFnInterval ln1 h1 ctxt1)
substitutions =
-- unsafePrintReturn
-- (
@@ -835,7 +841,7 @@ instance
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 @@ instance
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 @@ instance
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 @@ instance
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 @@ instance
---- 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 @@ instance
lnIov =
UFB.reduceSizeUp maxSize $
lnIuH +^ lnInit +^ lnIuOriginLNeg +^ (lnIuOriginH +^ lnIuOriginLNeg)
-
- gIov =
- gInit + g * ((1 - origin) RA.\/ (-1 - origin))
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Approx/IntervalOI.hs b/src/Data/Number/ER/RnToRm/UnitDom/Approx/IntervalOI.hs
new file mode 100644
index 0000000..9ba4dca
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Approx/IntervalOI.hs
@@ -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)]
+
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base.hs
index 23011c7..cab9b16 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/Base.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base.hs
@@ -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 @@ module Data.Number.ER.RnToRm.UnitDom.Base where
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 qualified Data.Map as Map
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 @@ class
{-| 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 @@ class
{-|
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 @@ class
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 @@ class
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 @@ class
{-| 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 @@ class
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 @@ class
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 @@ class
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,7 +321,136 @@ class
{-^ 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,
@@ -309,10 +467,12 @@ class
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 @@ class
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)
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Generate.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Generate.hs
new file mode 100644
index 0000000..0c8935b
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Generate.hs
@@ -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]
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Bounds.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Bounds.hs
new file mode 100644
index 0000000..e5f6d54
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Bounds.hs
@@ -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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Common.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Common.hs
new file mode 100644
index 0000000..0ba662a
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Common.hs
@@ -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
+
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Compose.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Compose.hs
new file mode 100644
index 0000000..d7f2c16
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Compose.hs
@@ -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
+
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Division.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Division.hs
new file mode 100644
index 0000000..07fc905
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Division.hs
@@ -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
+
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Elementary.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Elementary.hs
new file mode 100644
index 0000000..68a3b43
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Elementary.hs
@@ -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
+
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Enclosure.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Enclosure.hs
new file mode 100644
index 0000000..ed06db8
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Enclosure.hs
@@ -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
+
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Integration.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Integration.hs
new file mode 100644
index 0000000..108f3dc
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Integration.hs
@@ -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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Reduce.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Reduce.hs
new file mode 100644
index 0000000..44f76e0
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Reduce.hs
@@ -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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Ring.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Ring.hs
new file mode 100644
index 0000000..a1f74ed
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Properties/Ring.hs
@@ -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
+
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Run.hs b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Run.hs
new file mode 100644
index 0000000..73e24ab
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/Base/Tests/Run.hs
@@ -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
+
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom.hs
index 1d1ba9f..115830c 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom.hs
@@ -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.Basic
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 @@ x2 = chplVar 2 :: P
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 @@ instance
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 @@ instance
{----- 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
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Basic.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Basic.hs
index 6135ee4..bde96fa 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Basic.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Basic.hs
@@ -20,8 +20,8 @@ module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
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 @@ chplGetConst ::
(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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Bounds.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Bounds.hs
index 3e9b949..ce2bb2e 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Bounds.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Bounds.hs
@@ -20,13 +20,14 @@ import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
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 @@ import Data.List
{-|
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 @@ chplUpperBound ix p = snd $ chplBounds 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.
-}
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,13 +72,68 @@ chplLowerBound ix p = fst $ chplBounds 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.
-}
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
+
+{-|
+ 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)
-chplBounds = chplBoundsAffine
+chplBoundsExpensive = chplBoundsByDerivative
{-|
Find bounds on a polynomial over the unit domain [-1,1]^n.
@@ -95,116 +163,253 @@ chplBoundsAffine ix p@(ERChebPoly coeffs) =
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 @@ chplMax maxDegree maxSize p1 p2 =
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 @@ chplMinUp m s a b = snd $ chplMin m s a b
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 @@ chplNonpos m s p =
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 @@ chplNonneg = chplNonnegCubic
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 ::
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 @@ chplNonnegCubic maxDegree maxSize p
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 @@ chplNonnegCubic maxDegree maxSize p
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 =
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Compose.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Compose.hs
index 9dd7353..4ef4209 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Compose.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Compose.hs
@@ -23,8 +23,10 @@ import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure
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 @@ import qualified Data.Map as Map
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 @@ enclCompose maxDegree maxSize p@(ERChebPoly coeffs) substVar substEncl =
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 @@ enclComposeMany ::
(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 @@ enclComposeMany maxDegree maxSize p@(ERChebPoly coeffs) substitutions =
substDegrees =
Map.map mkPVDegrees substitutions
mkPVDegrees pvEncl =
- enclEvalTs maxSize maxDegree pvEncl
+ enclEvalTs maxDegree maxSize pvEncl
\ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Derivative.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Derivative.hs
new file mode 100644
index 0000000..41c2003
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Derivative.hs
@@ -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
+
+
+
+ \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Division.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Division.hs
index e9e5700..34eb890 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Division.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Division.hs
@@ -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.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.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 @@ enclRecip maxDegree maxSize ix tauDegr pEncl@(pLowNeg, pHigh)
-- ) $
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 @@ enclRecip maxDegree maxSize ix tauDegr pEncl@(pLowNeg, pHigh)
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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/DivisionInner.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/DivisionInner.hs
new file mode 100644
index 0000000..748a34f
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/DivisionInner.hs
@@ -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
+
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Elementary.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Elementary.hs
index d1157bd..7aaeeb7 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Elementary.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Elementary.hs
@@ -29,31 +29,92 @@ 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.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 @@ enclExp maxDegree maxSize ix pEncl =
-- 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 @@ enclExp maxDegree maxSize ix pEncl =
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 @@ enclExp maxDegree maxSize ix pEncl =
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 @@ enclPow maxDegree maxSize pEncl n
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 @@ enclLog maxDegree maxSize ix p =
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 @@ enclSine maxDegree maxSize ix pEncl =
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 @@ enclSine maxDegree maxSize ix pEncl =
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 @@ enclCosine maxDegree maxSize ix pEncl =
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 @@ enclCosine maxDegree maxSize ix pEncl =
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 @@ sincosTaylorAux
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 @@ enclAtan maxDegree maxSize ix pEncl@(pLowNeg, pHigh)
(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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/ElementaryInner.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/ElementaryInner.hs
new file mode 100644
index 0000000..3363435
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/ElementaryInner.hs
@@ -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
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Enclosure.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Enclosure.hs
index 46eede1..b057f17 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Enclosure.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Enclosure.hs
@@ -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.Bounds
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 @@ enclConst c =
(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 @@ enclRAConst ::
(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 @@ enclNeg (pLowNeg, pHigh) = (pHigh, pLowNeg)
(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 @@ enclMultiply maxDegr maxSize (ln1, h1) (ln2, h2) =
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 @@ enclMultiply maxDegr maxSize (ln1, h1) (ln2, h2) =
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 @@ enclSquare maxDegr maxSize (ln, h)
-- 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 @@ enclSquare maxDegr maxSize (ln, h)
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 @@ enclScaleNonneg ratio pEncl@(ln, h) =
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 @@ enclScale maxDegree maxSize ratio pEncl =
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 @@ enclRAScale maxDegree maxSize ra pEncl =
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 @@ chplScaleRAUp m n r = snd . chplScaleRA m n r
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 @@ enclEvalTs maxDegree maxSize p1@(pLowNeg, pHigh) =
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 ->
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/EnclosureInner.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/EnclosureInner.hs
new file mode 100644
index 0000000..75f12ce
--- /dev/null
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/EnclosureInner.hs
@@ -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
+--
+--
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Eval.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Eval.hs
index 6e728e1..6025c1b 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Eval.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Eval.hs
@@ -20,8 +20,8 @@ import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
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, DomainBoxMappable, DomainIntBox)
import Data.Number.ER.Real.Approx.Interval
import Data.Number.ER.Misc
@@ -39,8 +39,6 @@ chplEval ::
chplEval (ERChebPoly coeffs) vals =
case resultRA of
ERInterval low high -> (low, high)
- ERIntervalAny -> (-1/0,1/0)
- ERIntervalEmpty -> (1/0, -1/0)
where
resultRA =
sum $ map evalTerm $ Map.toList coeffs
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Integration.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Integration.hs
index 400cf5a..dcb6f31 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Integration.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Integration.hs
@@ -1,8 +1,8 @@
{-# LANGUAGE FlexibleContexts #-}
{-|
Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Integration
- Description : (internal) integration of polynomials etc
- Copyright : (c) 2007-2008 Michal Konecny
+ Description : (internal) integration of polynomials
+ Copyright : (c) 2007-2009 Michal Konecny
License : BSD3
Maintainer : mik@konecny.aow.cz
@@ -23,8 +23,8 @@ import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Bounds
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, DomainBoxMappable, DomainIntBox)
import Data.Number.ER.Real.Approx.Interval
import Data.Number.ER.Misc
@@ -148,20 +148,4 @@ chplIntegrate x p@(ERChebPoly coeffs) =
-- ip = pick $ chplIntegrate x p
---- vars = chplGetVars p
---
---{-|
--- Differentiate a polynomial using one of its variables.
---
--- This is not implemented yet and will probably never be needed
--- because differentiation is not a computable operator
--- and thus we have to rely on automatic differentiation
--- when we need derivative enclosures.
----}
---chplDifferentiate ::
--- (B.ERRealBase b, DomainBox box varid Int, Ord box) =>
--- ERChebPoly box b ->
--- varid {-^ variable to differentiate over -} ->
--- ERChebPoly box b
---chplDifferentiate (ERChebPoly coeffs) varName =
--- errorModule "chplDifferentiate: not implemented yet"
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Reduce.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Reduce.hs
index 61b0e12..1d23cbf 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Reduce.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Reduce.hs
@@ -23,8 +23,8 @@ where
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
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.List as List
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Ring.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Ring.hs
index 7bf93c5..51a169c 100644
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Ring.hs
+++ b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Ring.hs
@@ -22,8 +22,8 @@ where
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
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
@@ -34,22 +34,52 @@ import qualified Data.Map as Map
chplNeg (ERChebPoly coeffs) =
ERChebPoly $ Map.map negate coeffs
+chplBall2DownUp ::
+ (B.ERRealBase b, DomainBox box varid Int, Ord box) =>
+ (ERChebPoly box b, b) ->
+ (ERChebPoly box b, ERChebPoly box b)
+chplBall2DownUp ball =
+ (down, up)
+ where
+ (down, up, _) = chplBall2DownUpWd ball
+
+chplBall2DownUpWd ::
+ (B.ERRealBase b, DomainBox box varid Int, Ord box) =>
+ (ERChebPoly box b, b) ->
+ (ERChebPoly box b, ERChebPoly box b, b)
+chplBall2DownUpWd (ERChebPoly coeffsCentre, radius) =
+ (ERChebPoly coeffsDown, ERChebPoly coeffsUp, 2 * radius)
+ where
+ coeffsDown =
+ Map.insertWith plusDown chplConstTermKey (- radius) coeffsCentre
+ coeffsUp =
+ Map.insertWith plusUp chplConstTermKey radius coeffsCentre
+
+chplBall2Down ::
+ (B.ERRealBase b, DomainBox box varid Int, Ord box) =>
+ (ERChebPoly box b, b) ->
+ (ERChebPoly box b)
+chplBall2Down = fst . chplBall2DownUp
+
+chplBall2Up ::
+ (B.ERRealBase b, DomainBox box varid Int, Ord box) =>
+ (ERChebPoly box b, b) ->
+ (ERChebPoly box b)
+chplBall2Up = snd . chplBall2DownUp
+
{-|
Add a constant to a polynomial, rounding downwards and upwards.
-}
-chplAddConst ::
+ballAddConst ::
(B.ERRealBase b, DomainBox box varid Int, Ord box) =>
b ->
- ERChebPoly box b ->
- (ERChebPoly box b, ERChebPoly box b, b)
- {-^ lower and upper bounds on the sum and an upper bound on their difference -}
-chplAddConst c (ERChebPoly coeffs) =
- (ERChebPoly sumCoeffsDown, ERChebPoly sumCoeffsUp, err)
+ (ERChebPoly box b) ->
+ (ERChebPoly box b, b)
+ballAddConst c (ERChebPoly coeffs) =
+ (ERChebPoly sumCoeffs, err)
where
- sumCoeffsUp =
+ sumCoeffs =
Map.insert chplConstTermKey newConstUp coeffs
- sumCoeffsDown =
- Map.insert chplConstTermKey newConstDown coeffs
oldConst =
case Map.lookup chplConstTermKey coeffs of
Just c -> c
@@ -58,29 +88,20 @@ chplAddConst c (ERChebPoly coeffs) =
newConstDown = oldConst `plusDown` c
err = newConstUp - newConstDown
-chplAddConstUp c p = (\(sumDown, sumUp, width) -> sumUp) $ chplAddConst c p
-chplAddConstDown c p = (\(sumDown, sumUp, width) -> sumDown) $ chplAddConst c p
+chplAddConstUp c p = chplBall2Up $ ballAddConst c p
+chplAddConstDown c p = chplBall2Down $ ballAddConst c p
{-|
Add two polynomials, rounding downwards and upwards.
-}
-chplAdd ::
+ballAdd ::
(B.ERRealBase b, DomainBox box varid Int, Ord box) =>
- ERChebPoly box b ->
- ERChebPoly box b ->
- (ERChebPoly box b, ERChebPoly box b, b)
- {-^ lower and upper bounds on the sum and an upper bound on their difference -}
-chplAdd (ERChebPoly coeffs1) (ERChebPoly coeffs2) =
- (ERChebPoly sumCoeffsDown, ERChebPoly sumCoeffsUp, 2 * maxError)
+ (ERChebPoly box b) ->
+ (ERChebPoly box b) ->
+ (ERChebPoly box b, b)
+ballAdd (ERChebPoly coeffs1) (ERChebPoly coeffs2) =
+ (ERChebPoly coeffsUp, maxError)
where
- sumCoeffsUp =
- Map.insertWith plusUp chplConstTermKey maxError coeffsDown
- -- point-wise sum of polynomials with coeff rounding errors
- -- compensated for by enlarging the constant term
- sumCoeffsDown =
- Map.insertWith plusDown chplConstTermKey (- maxError) coeffsUp
- -- point-wise sum of polynomials with coeff rounding errors
- -- compensated for by enlarging the constant term
coeffsUp =
(Map.unionWith plusUp coeffs1 coeffs2)
-- point-wise sum of polynomials with coeffs rounded upwards
@@ -95,33 +116,27 @@ chplAdd (ERChebPoly coeffs1) (ERChebPoly coeffs2) =
-- and thus can make the result drop below the exact result
-- -> to compensate add the rounding difference to the constant term
-p1 +^ p2 = (\(sumDown, sumUp, width) -> sumUp) $ chplAdd p1 p2
-p1 +. p2 = (\(sumDown, sumUp, width) -> sumDown) $ chplAdd p1 p2
-p1 -^ p2 = p1 +^ (chplNeg p2)
-p1 -. p2 = p1 +. (chplNeg p2)
+p1 +^ p2 = chplBall2Up $ ballAdd p1 p2
+p1 +. p2 = chplBall2Down $ ballAdd p1 p2
+p1 -^ p2 = chplBall2Up $ ballAdd p1 (chplNeg p2)
+p1 -. p2 = chplBall2Down $ ballAdd p1 (chplNeg p2)
{-|
Multiply two polynomials, rounding downwards and upwards.
-}
-chplMultiply ::
+ballMultiply ::
(B.ERRealBase b, DomainBox box varid Int, Ord box) =>
ERChebPoly box b ->
ERChebPoly box b ->
- (ERChebPoly box b, ERChebPoly box b, b)
+ (ERChebPoly box b, b)
{-^ lower and upper bounds on the product and an upper bound on their difference -}
-chplMultiply p1@(ERChebPoly coeffs1) p2@(ERChebPoly coeffs2) =
+ballMultiply p1@(ERChebPoly coeffs1) p2@(ERChebPoly coeffs2) =
case (chplGetConst p1, chplGetConst p2) of
- (Just c1, _) -> chplScale c1 p2
- (_, Just c2) -> chplScale c2 p1
+ (Just c1, _) -> ballScale c1 p2
+ (_, Just c2) -> ballScale c2 p1
_ ->
- (ERChebPoly prodCoeffsDown, ERChebPoly prodCoeffsUp, 2 * roundOffCompensation)
+ (ERChebPoly directProdCoeffsUp, roundOffCompensation)
where
- prodCoeffsUp =
- Map.insertWith plusUp chplConstTermKey roundOffCompensation $
- Map.map negate directProdCoeffsDownNeg
- prodCoeffsDown =
- Map.insertWith plusDown chplConstTermKey (- roundOffCompensation) $
- directProdCoeffsUp
roundOffCompensation =
Map.fold plusUp 0 $
Map.unionWith plusUp directProdCoeffsUp directProdCoeffsDownNeg
@@ -169,30 +184,26 @@ chplMultiply p1@(ERChebPoly coeffs1) p2@(ERChebPoly coeffs2) =
coeffs2List =
Map.toList coeffs2
-p1 *^ p2 = (\(prodDown,prodUp,width) -> prodUp) $ chplMultiply p1 p2
-p1 *. p2 = (\(prodDown,prodUp,width) -> prodDown) $ chplMultiply p1 p2
+p1 *^ p2 = chplBall2Up $ ballMultiply p1 p2
+p1 *. p2 = chplBall2Down $ ballMultiply p1 p2
{-| Multiply a polynomial by a scalar rounding downwards and upwards. -}
-chplScale ::
+ballScale ::
(B.ERRealBase b, DomainBox box varid Int, Ord box) =>
b ->
(ERChebPoly box b) ->
- (ERChebPoly box b, ERChebPoly box b, b)
+ (ERChebPoly box b, b)
{-^ lower and upper bounds on the product and an upper bound on their difference -}
-chplScale ratio p@(ERChebPoly coeffs) =
+ballScale ratio p@(ERChebPoly coeffs) =
case chplGetConst p of
Just c ->
- (chplConst cScaledDown, chplConst cScaledUp, cScaledUp - cScaledDown)
+ (chplConst cScaledDown, cScaledUp - cScaledDown)
where
cScaledUp = ratio `timesUp` c
cScaledDown = ratio `timesDown` c
- _ ->
- (ERChebPoly coeffsDown, ERChebPoly coeffsUp, 2 * errBound)
+ _ ->
+ (ERChebPoly coeffsScaled, errBound)
where
- coeffsDown =
- Map.insertWith plusDown chplConstTermKey (- errBound) coeffsScaled
- coeffsUp =
- Map.insertWith plusUp chplConstTermKey errBound coeffsScaled
(errBound, coeffsScaled) =
Map.mapAccum processTerm 0 coeffs
processTerm errBoundPrev coeff =
@@ -202,17 +213,14 @@ chplScale ratio p@(ERChebPoly coeffs) =
coeffScaledDown = ratio `timesDown` coeff
coeffScaledUp = ratio `timesUp` coeff
-chplScaleDown r p = (\(prodDown,prodUp,width) -> prodDown) $ chplScale r p
-chplScaleUp r p = (\(prodDown,prodUp,width) -> prodUp) $ chplScale r p
+chplScaleDown r p = chplBall2Down $ ballScale r p
+chplScaleUp r p = chplBall2Up $ ballScale r p
{-|
Multiply a polynomial by itself, rounding downwards and upwards.
-}
-chplSquare ::
+ballSquare ::
(B.ERRealBase b, DomainBox box varid Int, Ord box) =>
ERChebPoly box b ->
- (ERChebPoly box b, ERChebPoly box b)
-chplSquare p =
- (p2Down, p2Up)
- where
- (p2Down, p2Up, wd) = chplMultiply p p
+ (ERChebPoly box b, b)
+ballSquare p = ballMultiply p p
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Bounds.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Bounds.hs
deleted file mode 100644
index 31a448a..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Bounds.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.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.ChebyshevBase.Polynom.Tests.Bounds
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Bounds
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-
-import Data.Number.ER.BasicTypes
-
-import Test.QuickCheck
-
-prop_chplBounds_consistent (ixI, PSize30 (_,p)) =
- ixI >= 2 ==>
- ixI < 100 ==>
- chplAtKeyPointsCanBeLeq p pHigh
- &&
- chplAtKeyPointsCanBeLeq pLow p
- where
- pLow = chplConst cLow
- pHigh = chplConst cHigh
- (cLow, cHigh) = chplBounds ix p
- ix = int2effIx ixI
-
-prop_chplMax_consistent
- (Deg20Size20 maxDegree maxSize, PSize30 (_,p1), PSize30 (_, p2)) =
- chplAtKeyPointsPointwiseBinaryDownUpConsistent max p1 p2 (maxLow, maxHigh)
- where
- (maxLow, maxHigh) = chplMax maxDegree maxSize p1 p2
-
-prop_chplMin_consistent (Deg20Size20 maxDegree maxSize, PSize30 (_,p1), PSize30 (_, p2)) =
- chplAtKeyPointsPointwiseBinaryDownUpConsistent min p1 p2 (minLow, minHigh)
- where
- (minLow, minHigh) = chplMin maxDegree maxSize p1 p2
-
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Compose.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Compose.hs
deleted file mode 100644
index 983ebed..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Compose.hs
+++ /dev/null
@@ -1,114 +0,0 @@
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.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.ChebyshevBase.Polynom.Tests.Compose
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Compose
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-
-import Data.Number.ER.Real.Approx.Interval
-import qualified Data.Number.ER.Real.DomainBox as DBox
-import Data.Number.ER.BasicTypes
-
-import Data.Number.ER.Misc
-
-import Test.QuickCheck
-
-prop_enclCompose_ThinEncl_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- varSelector,
- (PSize30 (n1,p1)),
- (PSize30 (n2,p2))) =
- compose_encl_consistent
- reportFileName
- maxDegree maxSize
- varSelector
- n1 p1 n2 p2Encl
- where
- p2Encl = enclThin p2
-
-prop_enclCompose_ThickEncl_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- varSelector,
- (PSize30 (n1,p1)),
- (PSize30 (n21,p21), PSize30 (n22, p22))) =
- compose_encl_consistent
- reportFileName
- maxDegree maxSize
- varSelector
- n1 p1 (n21, n22) p2Encl
- where
- p2Encl = makeThickEncl maxDegree maxSize p21 p22
-
-prop_enclCompose_ParalEncl_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- varSelector,
- (PSize30 (n1, p1)),
- (SmallRatio w2Num w2Denom, PSize30 (n2, p2))) =
- compose_encl_consistent
- reportFileName
- maxDegree maxSize
- varSelector
- n1 p1 ((w2Num, w2Denom), n2) p2Encl
- where
- p2Encl = makeParalEncl p2 w2Num w2Denom
-
-compose_encl_consistent
- reportFileName
- maxDegree maxSize
- varSelector
- p1Id p1 p2Id p2Encl@(p2LowNeg, p2High) =
--- unsafePrint
--- (
--- "compose_encl_consistent: "
--- ++ "\n p1 = " ++ show p1
--- ++ "\n substVar = " ++ show substVar
--- ++ "\n p2Low = " ++ show (chplNeg p2LowNeg)
--- ++ "\n p2High = " ++ show p2High
--- ++ "\n composition = " ++ show resEncl
--- ++ "\n**********************"
--- ) $
- enclAtKeyPointsConsistent
- reportFileName
- ((maxDegree, maxSize), varSelector, p1Id, p2Id)
- composeAtPointInner
- allVars
- resEncl
- where
- resEncl = enclCompose maxDegree maxSize p1 substVar p2Encl
- substVar = p1Vars !! (varSelector `mod` (length p1Vars))
- p1Vars = chplGetVars p1
- allVars = chplGetVars $ p1 +^ p2LowNeg +^ p2High
- p1Encl = (chplNeg p1, p1)
- composeAtPointInner point =
--- unsafePrintReturn
--- (
--- "\n point = " ++ show point
--- ++ "\n substVar = " ++ show substVar
--- ++ " substVal = " ++ show substVal
--- ++ "\n result = "
--- ) $
- enclRAEvalInner p1Encl pointWithSubst
- where
- pointWithSubst =
- DBox.insert substVar substVal $ DBox.map (\b -> ERInterval b b) point
- substVal =
- enclEvalInner p2Encl point
-
- \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Division.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Division.hs
deleted file mode 100644
index ae88609..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Division.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.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.ChebyshevBase.Polynom.Tests.Division
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Division
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure
---import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-
-import Data.Number.ER.Real.Approx.Interval
-
-import Data.Number.ER.BasicTypes
-
-import Test.QuickCheck
-
-prop_enclRecip_ThickEncl_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- (Int20 ixInt, Int20 tauDegr),
- SmallRatio sepNum sepDenom,
- (isNegative, PSize30 (n1,p1), PSize30 (n2, p2))) =
- recip_encl_consistent
- reportFileName
- maxDegree maxSize
- ixInt tauDegr
- sepNum sepDenom isNegative (n1, n2) preEncl
- where
- preEncl = makeThickEncl maxDegree maxSize p1 p2
-
-prop_enclRecip_ParalEncl_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- (Int20 ixInt, Int20 tauDegr),
- SmallRatio sepNum sepDenom,
- (isNegative, SmallRatio wNum wDenom, PSize30 (n, p))) =
- recip_encl_consistent
- reportFileName
- maxDegree maxSize
- ixInt tauDegr
- sepNum sepDenom isNegative ((wNum, wDenom), n) preEncl
- where
- preEncl = makeParalEncl p wNum wDenom
-
-recip_encl_consistent
- reportFileName
- maxDegree maxSize
- ixInt tauDegr
- sepNum sepDenom isNegative pId preEncl =
- excludedZero ==>
- enclAtKeyPointsPointwiseUnaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), (ixInt, tauDegr), (sepNum, sepDenom), (isNegative, pId))
- (intervalDivideInner 1)
- pEncl resEncl
- where
- resEncl = enclRecip maxDegree maxSize ix tauDegr pEncl
- ix = int2effIx ixInt
- (excludedZero, pEncl) =
- enclRestrictRange ix rangeNoZero preEncl
- rangeNoZero
- | isNegative = (Nothing, Just (-sepB))
- | otherwise = (Just sepB, Nothing)
- sepB = abs sepNumB / sepDenomB
- sepNumB = fromInteger $ toInteger sepNum
- sepDenomB = fromInteger $ toInteger sepDenom
-
- \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Elementary.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Elementary.hs
deleted file mode 100644
index 0ef00d8..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Elementary.hs
+++ /dev/null
@@ -1,120 +0,0 @@
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.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.ChebyshevBase.Polynom.Tests.Elementary
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Elementary
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure
---import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-
-import qualified Data.Number.ER.Real.Approx as RA
-import Data.Number.ER.Real.Approx.Interval
-import Data.Number.ER.Real.Arithmetic.Elementary
-
-import Data.Number.ER.BasicTypes
-
-import Test.QuickCheck
-
-prop_enclExp_ThickEncl_consistent =
- encl_op_ThickEncl_consistent enclExp erExp_IR_Inner noDomainRestriction
-
-prop_enclExp_ParalEncl_consistent =
- encl_op_ParalEncl_consistent enclExp erExp_IR_Inner noDomainRestriction
-
-prop_enclExp_ThinEncl_consistent =
- encl_op_ThinEncl_consistent enclExp erExp_IR_Inner noDomainRestriction
-
-prop_enclSine_ThickEncl_consistent =
- encl_op_ThickEncl_consistent enclSine erSine_IR_Inner sincosDomain
-
-prop_enclSine_ParalEncl_consistent =
- encl_op_ParalEncl_consistent enclSine erSine_IR_Inner sincosDomain
-
-prop_enclSine_ThinEncl_consistent =
- encl_op_ThinEncl_consistent enclSine erSine_IR_Inner sincosDomain
-
-prop_enclCosine_ThickEncl_consistent =
- encl_op_ThickEncl_consistent enclCosine erCosine_IR_Inner sincosDomain
-
-prop_enclCosine_ParalEncl_consistent =
- encl_op_ParalEncl_consistent enclCosine erCosine_IR_Inner sincosDomain
-
-prop_enclCosine_ThinEncl_consistent =
- encl_op_ThinEncl_consistent enclCosine erCosine_IR_Inner sincosDomain
-
-prop_enclAtan_ThickEncl_consistent =
- encl_op_ThickEncl_consistent enclAtan erATan_IR_Inner noDomainRestriction
-
-prop_enclAtan_ParalEncl_consistent =
- encl_op_ParalEncl_consistent enclAtan erATan_IR_Inner noDomainRestriction
-
-prop_enclAtan_ThinEncl_consistent =
- encl_op_ThinEncl_consistent enclAtan erATan_IR_Inner noDomainRestriction
-
-sincosDomain = (Just (-1.57), Just 1.57) -- almost (-pi/2, pi/2)
-noDomainRestriction = (Nothing, Nothing)
-
-encl_op_ThickEncl_consistent
- opEncl opInner rangeRestriction
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- (Int20 ixInt),
- (PSize30 (n1,p1), PSize30 (n2, p2))) =
- enclAtKeyPointsPointwiseUnaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), ixInt, (n1, n2))
- (opInner ix)
- pEncl resEncl
- where
- (succeeded, pEncl) =
- enclRestrictRange ix rangeRestriction $ makeThickEncl maxDegree maxSize p1 p2
- resEncl = opEncl maxDegree maxSize ix pEncl
- ix = int2effIx ixInt
-
-encl_op_ParalEncl_consistent
- opEncl opInner rangeRestriction
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- (Int20 ixInt),
- (SmallRatio wNum wDenom, PSize30 (n, p))) =
- enclAtKeyPointsPointwiseUnaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), ixInt, ((wNum, wDenom), n))
- (opInner ix)
- pEncl resEncl
- where
- (succeeded, pEncl) =
- enclRestrictRange ix rangeRestriction $ makeParalEncl p wNum wDenom
- resEncl = opEncl maxDegree maxSize ix pEncl
- ix = int2effIx ixInt
-
-encl_op_ThinEncl_consistent
- opEncl opInner rangeRestriction
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- (Int20 ixInt),
- (PSize30 (n, p))) =
- enclAtKeyPointsPointwiseUnaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), ixInt, n)
- (opInner ix)
- pEncl resEncl
- where
- (succeeded, pEncl) =
- enclRestrictRange ix rangeRestriction $ enclThin p
- resEncl = opEncl maxDegree maxSize ix pEncl
- ix = int2effIx ixInt
-
- \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Enclosure.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Enclosure.hs
deleted file mode 100644
index 2fe024c..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Enclosure.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.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.ChebyshevBase.Polynom.Tests.Enclosure
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-
-import Data.Number.ER.Real.Approx.Interval
-
-prop_enclAdd_ThickEncls_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- (PSize30 (n11,p11), PSize30 (n12, p12)),
- (PSize30 (n21,p21), PSize30 (n22, p22))) =
- enclAtKeyPointsPointwiseBinaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), (n11, n12), (n21, n22))
- intervalPlusInner
- p1Encl p2Encl sumEncl
- where
- sumEncl = p1Encl +: p2Encl
- p1Encl = makeThickEncl maxDegree maxSize p11 p12
- p2Encl = makeThickEncl maxDegree maxSize p21 p22
-
-prop_enclMultiply_ThickEncls_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- (PSize30 (n11,p11), PSize30 (n12, p12)),
- (PSize30 (n21,p21), PSize30 (n22, p22))) =
- enclAtKeyPointsPointwiseBinaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), (n11, n12), (n21, n22))
- intervalTimesInner
- p1Encl p2Encl prodEncl
- where
- prodEncl = enclMultiply maxDegree maxSize p1Encl p2Encl
- p1Encl = makeThickEncl maxDegree maxSize p11 p12
- p2Encl = makeThickEncl maxDegree maxSize p21 p22
-
-prop_enclMultiply_ParalEncls_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- (SmallRatio num1 denom1,
- PSize30 (n1,p1)),
- (SmallRatio num2 denom2,
- PSize30 (n2,p2))) =
- enclAtKeyPointsPointwiseBinaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), ((num1, denom1), n1), ((num2, denom2), n2))
- intervalTimesInner
- p1Encl p2Encl prodEncl
- where
- prodEncl = enclMultiply maxDegree maxSize p1Encl p2Encl
- p1Encl = makeParalEncl p1 num1 denom1
- p2Encl = makeParalEncl p2 num2 denom2
-
-prop_enclScale_ThickEncl_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- SmallRatio num denom,
- PSize30 (n1, p1),
- PSize30 (n2, p2)) =
- enclAtKeyPointsPointwiseBinaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), (num, denom), (n1, n2))
- intervalTimesInner
- cEncl pEncl scaledEncl
- where
- scaledEncl = enclScale maxDegree maxSize cB pEncl
- pEncl = makeThickEncl maxDegree maxSize p1 p2
- cEncl = enclConst cB
- cB = numB / denomB
- numB = fromInteger $ toInteger num
- denomB = fromInteger $ toInteger denom
-
-prop_enclScale_ParalEncl_consistent
- reportFileName
- (Deg20Size20 maxDegree maxSize,
- SmallRatio cNum cDenom,
- (SmallRatio wNum wDenom, PSize30 (n, p))) =
- enclAtKeyPointsPointwiseBinaryDownUpConsistent
- reportFileName
- ((maxDegree, maxSize), (cNum, cDenom), ((wNum, wDenom), n))
- intervalTimesInner
- cEncl pEncl scaledEncl
- where
- scaledEncl = enclScale maxDegree maxSize cB pEncl
- pEncl = makeParalEncl p wNum wDenom
- cEncl = enclConst cB
- cB = cNumB / cDenomB
- cNumB = fromInteger $ toInteger cNum
- cDenomB = fromInteger $ toInteger cDenom
-
- \ No newline at end of file
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Generate.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Generate.hs
deleted file mode 100644
index 6f9c74c..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Generate.hs
+++ /dev/null
@@ -1,592 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
- Description : (testing) generating polynomials for tests
- Copyright : (c) 2007-2008 Michal Konecny
- License : BSD3
-
- Maintainer : mik@konecny.aow.cz
- Stability : experimental
- Portability : portable
-
- A collection of polynomials to pick from when testing.
--}
-module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
-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.Bounds
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure
-
-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 Data.Number.ER.Misc
-import Data.Number.ER.BasicTypes
-
-import Data.Number.ER.Real.DefaultRepr
-import Data.Number.ER.Real.DomainBox.IntMap
-import Data.Number.ER.Real.Approx.Interval
-import qualified Data.Number.ER.Real.Approx as RA
-
-
-import Test.QuickCheck hiding (two, three)
-
-import qualified Data.Map as Map
-
-{---------------------}
-{----- Type synonyms for different polynomial generation distributions ----}
-{---------------------}
-
-type P = ERChebPoly (Box Int) BM
-
-newtype PNoLimits = PNoLimits (Int, P) deriving (Show)
-newtype PSize10Degree3 = PSize10Degree3 (Int, P) deriving (Show)
-newtype PSize10Degree10 = PSize10Degree10 (Int, P) deriving (Show)
-newtype PSize10 = PSize10 (Int, P) deriving (Show)
-newtype PSize30 = PSize30 ((Int, Int), P) deriving (Show)
-
-instance (Arbitrary PNoLimits)
- where
- arbitrary =
- elements $ map PNoLimits $ zip [0..] $
- polynomials1200ish id
- coarbitrary p =
- error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for polynomials"
-
-instance (Arbitrary PSize10Degree3)
- where
- arbitrary =
- elements $ map PSize10Degree3 $ zip [0..] $ polynomials1200ishSize10Degree3
- coarbitrary (PSize10Degree3 p) =
- error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for polynomials"
-
-polynomials1200ishSize10Degree3 =
- polynomials1200ish $ chplReduceTermCountUp 10 . chplReduceDegreeUp 3
-
-instance (Arbitrary PSize10Degree10)
- where
- arbitrary =
- elements $ map PSize10Degree10 $ zip [0..] $
- polynomials1200ishSize10Degree10
- coarbitrary (PSize10Degree10 p) =
- error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for polynomials"
-
-polynomials1200ishSize10Degree10 =
- polynomials1200ish $ chplReduceTermCountUp 10 . chplReduceDegreeUp 10
-
-instance (Arbitrary PSize10)
- where
- arbitrary =
- elements $ map PSize10 $ zip [0..] $ polynomials1200ishSize10
-
- coarbitrary (PSize10 p) =
- error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for polynomials"
-
-polynomials1200ishSize10 =
- polynomials1200ish $ chplReduceTermCountUp 10
-
-instance (Arbitrary PSize30)
- where
- arbitrary =
- sized arbitrarySized
- where
- arbitrarySized n
- | n <= 28 =
- elements $ map PSize30 $
- zip (map (\n -> (0,n)) [0..]) $
- polynomials200ishSize30
- | otherwise =
- elements $ map PSize30 $
- zip (map (\n -> (1,n)) [0..]) $
- polynomials1200ishSize30
- coarbitrary (PSize30 p) =
- error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for polynomials"
-
-polynomials1200ishSize30 =
- polynomials1200ish $ chplReduceTermCountUp 30
-
-polynomials200ishSize30 =
- polynomials200ishSmall $ chplReduceTermCountUp 30
-
-data Int20 = Int20 Int deriving (Show)
-
-instance (Arbitrary Int20)
- where
- arbitrary =
- do
- n <- choose (2,20)
- return $ Int20 n
- coarbitrary (Int20 n) =
- error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for EffIx20"
-
-data Deg20Size20 = Deg20Size20 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"
-
-data SmallRatio = SmallRatio Int Int deriving (Show)
-
-instance (Arbitrary SmallRatio)
- where
- arbitrary =
- do
- num <- choose (-1000000,1000000)
- denom <- choose (1,1000000)
- return $ SmallRatio num denom
- coarbitrary (SmallRatio num denom) =
- error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for SmallRatio"
-
-
-{------------------}
-{-------- Functions commonly used in tests: ----------}
-{------------------}
-
-chplAtKeyPointsCanBeLeq ::
- (B.ERRealBase b, DomainBox box varid Int, Ord box,
- DomainBoxMappable boxb boxbb varid b [ERInterval b], Show boxb) =>
- ERChebPoly box b ->
- ERChebPoly box b ->
- Bool
-chplAtKeyPointsCanBeLeq p1 p2 =
- and $ map testPoint points
- where
- points = getKeyPoints (p1 +^ p2)
- testPoint point
- | lower1 <= upper2 =
- True
- | otherwise =
- unsafePrint
- (
- "Failure at point = " ++ (show point)
- ) $
- False
- where
- lower1 = chplEvalDown p1 point
- upper2 = chplEvalUp p2 point
-
-getKeyPoints p =
- getKeyPointsForVars $ chplGetVars p
-
-getKeyPointsForVars vars =
- points
- where
- points = map DBox.fromList $ allCombinations $ map getVarPoints varDoms
- varDoms = map (\v -> (v,unitInterval)) vars
- unitInterval = ERInterval (-1) 1
- getVarPoints (var, dom) =
- (var, [domLB, domMB, domRB])
- where
- ERInterval domLB domRB = dom
- domMB = (domLB + domRB)/2
-
-chplAtKeyPointsPointwiseBinaryDownUpConsistent ::
- (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box,
- DomainBoxMappable boxb boxbb varid b [ERInterval b], Show boxb) =>
- ((ERInterval b) -> (ERInterval b) -> (ERInterval b)) ->
- ERChebPoly box b ->
- ERChebPoly box b ->
- (ERChebPoly box b, ERChebPoly box b) ->
- Bool
-chplAtKeyPointsPointwiseBinaryDownUpConsistent raOp p1 p2 (resLow, resHigh) =
- and $ map testPoint points
- where
- points = getKeyPoints (p1 +^ p2)
- testPoint point
- | ok = ok
- | otherwise =
- unsafePrint
- (
- "chplAtKeyPointsPointwiseBinaryDownUpConsistent failed:"
- ++ "\n point = " ++ show point
- ++ "\n raOpAtPointHigh = " ++ show raOpAtPointHigh
- ++ "\n raOpAtPointLow = " ++ show raOpAtPointLow
- ++ "\n resAtPointHigh = " ++ show resAtPointHigh
- ++ "\n resAtPointLow = " ++ show resAtPointLow
- )
- ok
- where
- ok =
- raOpAtPointLow <= resAtPointHigh
- &&
- raOpAtPointHigh >= resAtPointLow
- resAtPointLow = chplEvalDown resLow point
- resAtPointHigh = chplEvalUp resHigh point
- raOpAtPoint@(ERInterval raOpAtPointLow raOpAtPointHigh) =
- raOp p1AtPoint p2AtPoint
- p1AtPoint = ERInterval p1AtPointLow p1AtPointHigh
- (p1AtPointLow, p1AtPointHigh) = chplEval p1 point
- p2AtPoint = ERInterval p2AtPointLow p2AtPointHigh
- (p2AtPointLow, p2AtPointHigh) = chplEval p2 point
-
-makeThickEncl maxDegree maxSize p1 p2 =
- (pMax q1Neg q2Neg, pMax q1 q2)
- where
- q1Neg = chplNeg q1
- q2Neg = chplNeg q2
- q1 = p1 +^ p2Mp1ScaledDown
- q2 = p1 -^ p2Mp1ScaledDown
- p2Mp1ScaledDown =
- chplScaleUp (10/sizeB) p2Mp1
- where
- sizeB = max (abs upperB) (abs lowerB)
- (lowerB, upperB) = chplBounds 10 p2Mp1
- p2Mp1 = p2 -^ p1
- pMax = chplMaxUp maxDegree maxSize
-
-makeParalEncl p num denom =
--- unsafePrintReturn
--- (
--- "makeThinEncl: result = "
--- )
- (pNeg, p +^ cP)
- where
- pNeg = chplNeg p
- cP = chplConst cB
- cB = abs $ numB / (1000 * denomB)
- numB = fromInteger $ toInteger num
- denomB = fromInteger $ toInteger denom
-
-enclRestrictRange ix (Nothing, Nothing) pEncl = (True, pEncl)
-enclRestrictRange ix (maybeLower, maybeUpper) preEncl =
- (succeeded, pEncl)
- where
- succeeded = lowerSucceeded && upperSucceeded
- lowerSucceeded =
- case maybeLower of
- Nothing -> True
- Just lower -> pLowerBound > lower
- upperSucceeded =
- case maybeUpper of
- Nothing -> True
- Just upper -> pUpperBound < upper
- (pLowerBound, pUpperBound) = enclBounds ix pEncl
- pEncl =
- 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
- enclAddConst (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
- enclAddConst (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
- enclAddConst
- (lowerB - preLowerBoundB + (preWidthB - widthB)/2)
- preEncl
- _ -> -- full affine transformation needed
- enclAddConst
- (lowerB + sepB) $
- enclScaleNonneg -- scale preEncl so that it fits inside the range
- (widthB / saferPreWidthB) $
- enclAddConst -- shift preEncl so that it is non-negative and as close to 0 as safely possible
- (sepB - preLowerBoundB)
- preEncl
- where
- widthB = upperB - lowerB
- saferPreWidthB = preWidthB + 2 * sepB
- sepB = preWidthB / 1000000
- preWidthB = preUpperBoundB - preLowerBoundB
- (preLowerBoundB, preUpperBoundB) = enclBounds ix preEncl
-
-
-
-enclAtKeyPointsPointwiseBinaryDownUpConsistent ::
- (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box,
- DomainBoxMappable boxb boxbb varid b [ERInterval b], Show boxb, Show testId) =>
- String {-^ report file name -} ->
- testId {-^ item to identify the random input given to the test -} ->
- ((ERInterval b) -> (ERInterval b) -> (ERInterval b))
- {-^ 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 -} ->
- (ERChebPoly box b, ERChebPoly box b) {-^ enclosure of argument 1 -} ->
- (ERChebPoly box b, ERChebPoly box b) {-^ enclosure of argument 2 -} ->
- (ERChebPoly box b, ERChebPoly box b) {-^ alleged enclosure of result -} ->
- Bool
-enclAtKeyPointsPointwiseBinaryDownUpConsistent
- reportFileName testId
- raOpInner
- p1Encl@(p1LowNeg, p1High) p2Encl@(p2LowNeg, p2High) resEncl =
- and $ map testPoint points
- where
- points = getKeyPoints (p1High +^ p2High +^ p1LowNeg +^ p2LowNeg)
- testPoint point
- | result =
- unsafeReport reportFileName
- (
- show $
- (testId, point, p1OpInnerP2AtPoint, resAtPoint)
- )
- result
- | otherwise =
- unsafePrint
- (
- "enclAtKeyPointsPointwiseBinaryDownUpConsistent 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 = enclEval resEncl point
--- resAtPoint = p1OpInnerP2AtPoint -- for dummy testing that never <<loop>>s
- p1AtPoint = normaliseERInterval $ enclEvalInner p1Encl point
- p2AtPoint = normaliseERInterval $ enclEvalInner p2Encl point
-
-enclAtKeyPointsPointwiseUnaryDownUpConsistent ::
- (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box,
- DomainBoxMappable boxb boxbb varid b [ERInterval b], Show boxb, Show testId) =>
- String {-^ report file name -} ->
- testId {-^ item to identify the random input given to the test -} ->
- ((ERInterval b) -> (ERInterval b))
- {-^ 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 -} ->
- (ERChebPoly box b, ERChebPoly box b) {-^ enclosure of argument -} ->
- (ERChebPoly box b, ERChebPoly box b) {-^ alleged enclosure of result -} ->
- Bool
-enclAtKeyPointsPointwiseUnaryDownUpConsistent
- reportFileName testId
- raOpInner
- pEncl@(pLowNeg, pHigh) resEncl =
- and $ map testPoint points
- where
- points = getKeyPoints (pHigh +^ pLowNeg)
- testPoint point
- | result =
- unsafeReport reportFileName
- (
- show $
- (testId, point, opInnerPAtPoint, resAtPoint)
- )
- result
- | otherwise =
- unsafePrint
- (
- "enclAtKeyPointsPointwiseUnaryDownUpConsistent 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 = enclEval resEncl point
- pAtPoint =
--- normaliseERInterval $
- enclEvalInner pEncl point
-
-
-enclAtKeyPointsConsistent ::
- (B.ERRealBase b, RealFrac b, DomainBox box varid Int, Ord box,
- DomainBoxMappable boxb boxbb varid b [ERInterval b], Show boxb, Show testId) =>
- String {-^ report file name -} ->
- testId {-^ item to identify the random input given to the test -} ->
- (boxb -> (ERInterval b))
- {-^ 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 -} ->
- (ERChebPoly box b, ERChebPoly box b) {-^ alleged enclosure of result -} ->
- Bool
-enclAtKeyPointsConsistent
- reportFileName testId
- opInner allVars resEncl@(resLowNeg, resHigh) =
- and $ map testPoint points
- where
- points = getKeyPointsForVars allVars
- testPoint point
- | result =
- unsafeReport reportFileName
- (
- show $
- (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 = enclEval resEncl point
-
-
-{------------------}
-{-------- A diverse collection of polynomials to pick from: ----------}
-{------------------}
-
-type E = (P,P)
-
-vars :: [P]
-vars = map chplVar [0..7]
-
-varsE :: [E]
-varsE = map (\p -> (chplNeg p, p)) vars
-
-x0 = vars !! 0
-x1 = vars !! 1
-x2 = vars !! 2
-x3 = vars !! 3
-x4 = vars !! 4
-
-x0E = varsE !! 0
-x1E = varsE !! 1
-x2E = varsE !! 2
-x3E = varsE !! 3
-x4E = varsE !! 4
-
-one :: P
-[mone, one, two, three, seven, thousand, million, tiny, huge] =
- map chplConst
- [-1,1,2,3,7,1000,1000000,10^^(-200),10^^200]
-
-oneE :: E
-[moneE, oneE, twoE, threeE, sevenE, thousandE, millionE, tinyE, hugeE] =
- map (\ c -> (chplConst (-c), chplConst c))
- [-1,1,2,3,7,1000,1000000,10^^(-200),10^^200]
-
-polynomials1200ish rdc =
- concat $ map (powers10 rdc) $
- concat $ map addConsts3 $
- concat $ map multConsts3 $
- polyBase13
-
-polynomials200ish rdc =
- concat $ map (powers4 rdc) $
- concat $ map addConsts3 $
- concat $ map multConsts3 $
- polyBase5
-
-polynomials40ish rdc =
- concat $ map (powers2 rdc) $
- concat $ map addConsts2 $
- concat $ map multConsts2 $
- polyBase5
-
-polynomials200ishSmall rdc =
- concat $ map (powers4Small rdc) $
- concat $ map addConsts3 $
- concat $ map multConsts3 $
- polyBase5
-
-polynomials40ishSmall rdc =
- concat $ map (powers2Small rdc) $
- concat $ map addConsts2 $
- concat $ map multConsts2 $
- polyBase5
-
-
-polyBase5 =
- [
- (two *^ x0) +^ x1
- ,
- (seven *^ x0) -^ x1
- ,
- (tiny *^ x0) +^ x1
- ,
- x0 -^ x1 *^ x2
- ,
- x0 -^ x1 +^ x2 -^ x3 +^ x4
- ]
-
-polyBase13 =
- [
- 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
- ,
- 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
-
-powers10 rdc p =
- powersForExps rdc p [1..10]
-
-powers4 rdc p =
- powersForExps rdc p [1,3,5,7]
-
-powers4Small rdc p =
- powersForExps rdc p [1,2,3,5]
-
-powers2 rdc p =
- powersForExps rdc p [1,7]
-
-powers2Small rdc p =
- powersForExps rdc p [1,3]
-
-addConsts3 p =
- [p +^ one, p +^ three, p +^ seven]
-
-multConsts3 p =
- [p *^ two, p *^ three, p *^ seven]
-
-addConsts2 p =
- [p +^ one, p +^ three]
-
-multConsts2 p =
- [p *^ two, p *^ seven]
-
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Reduce.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Reduce.hs
deleted file mode 100644
index 4d954b6..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Reduce.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.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.ChebyshevBase.Polynom.Tests.Reduce
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Reduce
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-
-import Test.QuickCheck
-
-prop_chplReduceTermCount_consistent (PSize30 (_,p), Deg20Size20 _ maxSize) =
- maxSize < chplCountTerms p ==>
- chplAtKeyPointsCanBeLeq p pUp
- &&
- chplAtKeyPointsCanBeLeq pDown p
- where
- (pDown, pUp) = chplReduceTermCount maxSize p
-
-
-prop_chplReduceDegree_consistent (PSize30 (_,p), Deg20Size20 maxDegree _) =
- maxDegree < chplGetDegree p ==>
- chplAtKeyPointsCanBeLeq p pUp
- &&
- chplAtKeyPointsCanBeLeq pDown p
- where
- (pDown, pUp) = chplReduceDegree maxDegree p
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Ring.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Ring.hs
deleted file mode 100644
index fae2a10..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Ring.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.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.ChebyshevBase.Polynom.Tests.Ring
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Ring
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Basic
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-
-prop_chplAdd_consistent (PSize30 (_,p1), PSize30 (_, p2)) =
- chplAtKeyPointsPointwiseBinaryDownUpConsistent (+) p1 p2 (sumLow, sumHigh)
- where
- (sumLow, sumHigh, _) = chplAdd p1 p2
-
-prop_chplAddConst_consistent (SmallRatio num denom, PSize30 (_, p)) =
- chplAtKeyPointsPointwiseBinaryDownUpConsistent (+) cP p (sumLow, sumHigh)
- where
- (sumLow, sumHigh, _) = chplAddConst cB p
- cP = chplConst cB
- cB = numB / denomB
- numB = fromInteger $ toInteger num
- denomB = fromInteger $ toInteger denom
-
-prop_chplMult_consistent (PSize30 (_,p1), PSize30 (_, p2)) =
- chplAtKeyPointsPointwiseBinaryDownUpConsistent (*) p1 p2 (prodLow, prodHigh)
- where
- (prodLow, prodHigh, _) = chplMultiply p1 p2
-
-prop_chplScale_consistent (SmallRatio num denom, PSize30 (_, p)) =
- chplAtKeyPointsPointwiseBinaryDownUpConsistent (*) cP p (prodLow, prodHigh)
- where
- (prodLow, prodHigh, _) = chplScale cB p
- cP = chplConst cB
- cB = numB / denomB
- numB = fromInteger $ toInteger num
- denomB = fromInteger $ toInteger denom
-
diff --git a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Run.hs b/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Run.hs
deleted file mode 100644
index edca3f6..0000000
--- a/src/Data/Number/ER/RnToRm/UnitDom/ChebyshevBase/Polynom/Tests/Run.hs
+++ /dev/null
@@ -1,159 +0,0 @@
-{-|
- Module : Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Run
- Description : (testing) running all polynomial 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 polynomial tests in a batch.
--}
-module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Run
-where
-
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Reduce
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Ring
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Bounds
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Enclosure
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Division
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Elementary
-import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Compose
---import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Integration
-
-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.Arithmetic.Elementary
-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)
-
-import Data.Number.ER.Real.DefaultRepr
-import Data.Number.ER.Misc
-
-import Test.QuickCheck
-import Test.QuickCheck.Batch
-
-import System.IO
-import System.Directory
-import qualified System.FilePath as FP
-import Data.Time.Clock
-import Data.Time.Calendar
-
-initArith = B.initialiseBaseArithmetic (0::BM)
-
-runPolynomTests =
- do
- (UTCTime (ModifiedJulianDay days) secs) <- getCurrentTime
- let folder = "tests-" ++ (show days) ++ "-" ++ (show $ floor $ toRational secs)
- createDirectory folder
--- mkRunTests "poly tests" chplTestOptions (chplTests folder)
- mkRunTests "poly tests" chplTestOptions (enclTests folder)
-
-instance Show TestResult
- where
- show result =
- case result of
- TestOk msg ntest stamps ->
- msg ++ " " ++ show ntest ++ " " -- ++ show stamps
- TestExausted msg ntest stamps ->
- msg ++ " " ++ show ntest ++ " " -- ++ show stamps
- TestAborted exception ->
- "aborted: " ++ show exception
- TestFailed args ntest ->
- "failed after " ++ show ntest ++ " tests"
- ++ "\n args = " ++ show args
-
-mkRunTests testsetName options tests =
- do
- initArith
- mapM (mkRunTest $ length tests) $ zip [1..] tests
- return ()
- where
- mkRunTest testCount (n, (testName, test)) =
- do
- putStr testDescr
- result <- test options
- putStrLn $ " result: " ++ show result
--- runTests testDescr options [test]
- hFlush stdout
- where
- testDescr =
- "(" ++ show n ++ "/" ++ show testCount ++ ") " ++ testsetName ++ ": " ++ testName ++ "\n"
-
-chplTestOptions =
- TestOptions
- {
--- no_of_tests = 10
--- no_of_tests = 50
- no_of_tests = 100
--- no_of_tests = 200
- ,
- length_of_tests = 240 * 3600 -- ie 4h time limit
- ,
- debug_tests = False
- }
-
-chplTests folder =
- [
- ("reduce term count", run prop_chplReduceTermCount_consistent),
- ("reduce degree", run prop_chplReduceDegree_consistent),
- ("add two polys", run prop_chplAdd_consistent),
- ("add const to poly", run prop_chplAddConst_consistent),
- ("mult two polys", run prop_chplMult_consistent),
- ("scale poly", run prop_chplScale_consistent),
- ("bounds of poly", run prop_chplBounds_consistent),
- ("max of two polys", run prop_chplMax_consistent),
- ("min of two polys", run prop_chplMin_consistent)
- ]
-enclTests folder =
- [
- ("add thick encls", run $ prop_enclAdd_ThickEncls_consistent $ addFolder "enclAdd_Thick"),
- ("mult paral encls", run $ prop_enclMultiply_ParalEncls_consistent $ addFolder "enclMultiply_Paral"),
- ("mult thick encls", run $ prop_enclMultiply_ThickEncls_consistent $ addFolder "enclMultiply_Thick"),
- ("scale paral encl", run $ prop_enclScale_ParalEncl_consistent $ addFolder "enclScale_Paral"),
- ("scale thick encl", run $ prop_enclScale_ThickEncl_consistent $ addFolder "enclScale_Thick"),
- ("recip paral encl", run $ prop_enclRecip_ParalEncl_consistent $ addFolder "enclRecip_Paral"),
- ("recip thick encl", run $ prop_enclRecip_ThickEncl_consistent $ addFolder "enclRecip_Thick"),
- ("compose thin encl", run $ prop_enclCompose_ThinEncl_consistent $ addFolder "enclCompose_Thin"),
- ("compose paral encl", run $ prop_enclCompose_ParalEncl_consistent $ addFolder "enclCompose_Paral"),
- ("compose thick encl", run $ prop_enclCompose_ThickEncl_consistent $ addFolder "enclCompose_Thick"),
- ("exp thin encl", run $ prop_enclExp_ThinEncl_consistent $ addFolder "enclExp_Thin"),
- ("exp paral encl", run $ prop_enclExp_ParalEncl_consistent $ addFolder "enclExp_Paral"),
- ("exp thick encl", run $ prop_enclExp_ThickEncl_consistent $ addFolder "enclExp_Thick"),
- ("sine thin encl", run $ prop_enclSine_ThinEncl_consistent $ addFolder "enclSine_Thin"),
- ("sine paral encl", run $ prop_enclSine_ParalEncl_consistent $ addFolder "enclSine_Paral"),
- ("sine thick encl", run $ prop_enclSine_ThickEncl_consistent $ addFolder "enclSine_Thick"),
- ("cosine thin encl", run $ prop_enclCosine_ThinEncl_consistent $ addFolder "enclCosine_Thin"),
- ("cosine paral encl", run $ prop_enclCosine_ParalEncl_consistent $ addFolder "enclCosine_Paral"),
- ("cosine thick encl", run $ prop_enclCosine_ThickEncl_consistent $ addFolder "enclCosine_Thick"),
- ("atan thin encl", run $ prop_enclAtan_ThinEncl_consistent $ addFolder "enclAtan_Thin"),
- ("atan paral encl", run $ prop_enclAtan_ParalEncl_consistent $ addFolder "enclAtan_Paral"),
- ("atan thick encl", run $ prop_enclAtan_ThickEncl_consistent $ addFolder "enclAtan_Thick")
- ]
- where
- addFolder name = FP.combine folder name
-
-
--- failed tests:
-
---failed1 =
--- -- identified 19 Feb 9:33
--- -- fixed 19 Feb 16:50
--- prop_enclCompose_ThickEncl_consistent "a"
--- (Deg20Size20 4 18, 0,
--- PSize30 ((0,112), polynomials200ishSize30 !! 112),
--- (PSize30 ((0,57), polynomials200ishSize30 !! 57),
--- PSize30 ((0,18), polynomials200ishSize30 !! 18)
--- )
--- )
-
-failed2 =
- -- identified 19 Feb 18:59 -- this one makes the automatic test abort with <<loop>>
- -- but runs ok when executed individually
- prop_enclMultiply_ParalEncls_consistent "a"
- (Deg20Size20 5 11,
- (SmallRatio 680377 535300, PSize30 ((1,1018), polynomials1200ishSize30 !! 1018)),
- (SmallRatio (-157647) 491208, PSize30 ((1,465), polynomials1200ishSize30 !! 465))
- )
diff --git a/tests/RunPolynomTests.hs b/tests/RunPolynomTests.hs
new file mode 100644
index 0000000..57b2095
--- /dev/null
+++ b/tests/RunPolynomTests.hs
@@ -0,0 +1,51 @@
+{-|
+ Module : Main
+ Description : laucher for polynomial arith tests
+ Copyright : (c) Michal Konecny
+ License : BSD3
+
+ Maintainer : mik@konecny.aow.cz
+ Stability : experimental
+ Portability : portable
+
+ An executable for easy automated launch of
+ polynomial arithmetic tests.
+-}
+module Main where
+
+import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB
+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Run
+import Data.Number.ER.RnToRm.DefaultRepr
+import Data.Number.ER.Real.DefaultRepr
+
+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Compose
+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common
+import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate
+import Data.Number.ER.BasicTypes.Tests.Generate
+
+main =
+ do
+ runUFBTests "cheb-poly-double" samplePBM (UFB.initialiseBaseArithmetic samplePBM)
+
+samplePBM :: P BM
+samplePBM = UFB.const 0
+
+failed1 =
+ -- identified 24 Jul 19:00
+ prop_enclCompose_ThinEncl_consistent (samplePBM,samplePBM) "a"
+ (Deg10Size10 9 8, 7,
+ FBEnclThinSize10 ((0,72),
+ makeThinEncl (polynomials1200ishSize10Small samplePBM !! 72)),
+ FBEnclThinSize10 ((0,853),
+ makeThinEncl (polynomials1200ishSize10Small samplePBM !! 853))
+ )
+
+--failed1 =
+-- -- identified 24 Jul 15:00
+-- -- fixed - error in enclMultiply 24 Jul 16:25
+-- prop_enclScale_ParalEncl_consistent (samplePBM,samplePBM) "a"
+-- (Deg10Size10 7 7, SmallRatio 220736 320174,
+-- FBEnclParalSize10 (((0,872),SmallRatio (-50723) 723338),
+-- makeParalEncl (polynomials1200ishSize10Small samplePBM !! 872) (SmallRatio (-50723) 723338))
+-- )
+