packages feed

AERN-Real 0.10.0.2 → 2011.1

raw patch · 80 files changed

+7695/−7041 lines, 80 filesdep +AERN-Basicsdep +criteriondep +test-frameworkdep −binarydep −containersdep −directorydep ~QuickCheckdep ~basesetup-changed

Dependencies added: AERN-Basics, criterion, test-framework, test-framework-quickcheck2

Dependencies removed: binary, containers, directory, filepath, hmpfr, html, regex-compat, stm, time

Dependency ranges changed: QuickCheck, base

Files

AERN-Real.cabal view
@@ -1,85 +1,80 @@ Name:           AERN-Real-Version:        0.10.0.2+Version:        2011.1 Cabal-Version:  >= 1.2 Build-Type:     Simple License:        BSD3 License-File:   LICENCE Author:         Michal Konecny (Aston University)-Copyright:      (c) 2007-2009 Michal Konecny, Amin Farjudian, Jan Duracz+Copyright:      (c) 2011 Michal Konecny, Jan Duracz Maintainer:     mikkonecny@gmail.com-Homepage:       http://www-users.aston.ac.uk/~konecnym/DISCERN-Stability:      beta+Homepage:       http://code.google.com/p/aern/+Stability:      experimental Category:       Data, Math-Synopsis:       arbitrary precision interval arithmetic for approximating exact real numbers-Tested-with:    GHC ==6.10.1+Synopsis:       arbitrary precision real interval arithmetic+Tested-with:    GHC ==6.12.3 Description:-    Datatypes and abstractions for approximating exact real numbers-    and a basic arithmetic over such approximations.-    The main datatype is interval with arbitrary precision endpoints-    supported by safely rounding field and elementary operations-    whose precision can be increased arbitrarily, so that they-    all converge to the exact operations.-    .-    The design of the library is inspired to some degree -    by Mueller's iRRAM and Lambov's RealLib-    (both are C++ libraries for exact real arithmetic).-    .-    For an architectural overview, see module "Data.Number.ER.Real".-    .-    Simple examples of usage can be found in folder @examples@.+    Type classes abstracting typical approximate real number arithmetic operations+    including rounded+    field operations and common elementary operations.+    Two kinds of rounding are supported: rounding up/down in the numerical order+    or rounding in/out in a refinement order.     .-    There is a built-in test suite and it can be evoked using-    the module in the folder @tests@.+    A concrete implementation of refinement order rounded operations+    is given for intervals in the package AERN-Real-Interval.+    Concrete implementations of up/down rounded operations is+    given in AERN-Real-Double for ordinary Double+    fixed-precision numbers.  These can serve as interval+    endpoints.  In a future release also MPFR arbitrary-precision numbers+    will be made available as interval endpoints.  Extra-Source-Files:-    examples/Demo.hs examples/Pi.hs examples/Matrix.hs-    tests/RunERIntervalTests.hs-    ChangeLog--Flag use-hmpfr-    Default: False+    CHANGES  Library-  hs-source-dirs:  src-  if flag(use-hmpfr)-      Build-Depends:-        base >= 3, base < 4, containers, binary, html >= 1.0, regex-compat >= 0.71, stm, time, QuickCheck == 1.2.0.0, filepath, directory, hmpfr == 0.2-      cpp-options: -DUSE_MPFR-  else-      Build-Depends:-        base >= 3, base < 4, containers, binary, html >= 1.0, regex-compat >= 0.71, stm, time, QuickCheck == 1.2.0.0, filepath, directory+  hs-source-dirs: src+  ghc-options:     -O2+  Build-Depends:+        base >= 4 && < 5,+        QuickCheck >= 2.1 && < 3,+        test-framework >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2 && < 0.4,+        criterion >= 0.5 && < 0.6,+        AERN-Basics == 2011.1   Exposed-modules:-        Data.Number.ER,-        Data.Number.ER.BasicTypes,-        Data.Number.ER.BasicTypes.DomainBox,-        Data.Number.ER.BasicTypes.DomainBox.IntMap,-        Data.Number.ER.BasicTypes.ExtendedInteger,-        Data.Number.ER.BasicTypes.PlusMinus,-        Data.Number.ER.BasicTypes.Tests.Generate,-        Data.Number.ER.Misc,-        Data.Number.ER.Misc.STM,-        Data.Number.ER.Misc.Tests,-        Data.Number.ER.Real,-        Data.Number.ER.Real.Approx,-        Data.Number.ER.Real.Approx.Elementary,-        Data.Number.ER.Real.Approx.Interval,-        Data.Number.ER.Real.Approx.OI,-        Data.Number.ER.Real.Approx.Sequence,-        Data.Number.ER.Real.Approx.Tests.Generate,-        Data.Number.ER.Real.Approx.Tests.Properties,-        Data.Number.ER.Real.Approx.Tests.Reporting,-        Data.Number.ER.Real.Approx.Tests.Run,-        Data.Number.ER.Real.Arithmetic.Elementary,-        Data.Number.ER.Real.Arithmetic.Integration,-        Data.Number.ER.Real.Arithmetic.LinearSolver,-        Data.Number.ER.Real.Arithmetic.Newton,-        Data.Number.ER.Real.Arithmetic.Taylor,-        Data.Number.ER.Real.Base,-        Data.Number.ER.Real.Base.CombinedMachineAP,-        Data.Number.ER.Real.Base.Float,-        Data.Number.ER.Real.Base.MachineDouble,-        Data.Number.ER.Real.Base.MPFR,-        Data.Number.ER.Real.Base.Rational,-        Data.Number.ER.Real.Base.Tests.Generate,-        Data.Number.ER.Real.DefaultRepr,-        Data.Number.ER.ShowHTML+    Numeric.AERN.RealArithmetic.ExactOps, +    Numeric.AERN.RealArithmetic.NumericOrderRounding, +    Numeric.AERN.RealArithmetic.NumericOrderRounding.OpsDefaultEffort,+    Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.OpsDefaultEffort,+    Numeric.AERN.RealArithmetic.NumericOrderRounding.OpsImplicitEffort,+    Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.OpsImplicitEffort,+    Numeric.AERN.RealArithmetic.RefinementOrderRounding,+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.ElementaryFromFieldOps.Exponentiation,+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsDefaultEffort, +    Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsDefaultEffort,+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsImplicitEffort, +    Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsImplicitEffort, +    Numeric.AERN.RealArithmetic.Measures, +    Numeric.AERN.RealArithmetic.Laws, +    Numeric.AERN.RealArithmetic.Bench, +    Numeric.AERN.Misc.IntegerArithmetic+    +  Other-modules:+    Numeric.AERN.RealArithmetic.Auxiliary+    Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion+    Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+    Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps+    Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary+    Numeric.AERN.RealArithmetic.NumericOrderRounding.SpecialConst+    Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace+    Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps+    Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.MixedFieldOps+    Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.Elementary+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.MixedFieldOps+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.Elementary+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.SpecialConst+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.FieldOps+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.MixedFieldOps+    Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.Elementary+
+ CHANGES view
@@ -0,0 +1,3 @@+2011.1: 6th May 2011+    * initial release of a completely rewritten version of AERN-Real+
− ChangeLog 
@@ -1,78 +0,0 @@-0.10.0.2: 29 July 2009: renamed "demos" folder to "examples"-0.10.0.1: 28 July 2009: fixed a few bugs in meta-data-0.10.0: 28 July 2009-    * switching to beta status-    * new QuickCheck test suite covering most functionality-    * new support for anti-consistent intervals (eg [2,0])-      (also called directed or improper; using Kaucher arithmetic)-    * new support for inner-rounded interval arithemtic-    * fixed errors in some elementary functions for extreme values-    * fixed performance bug in arctan-    * improved hierarchy of auxiliary modules--0.9.9: 23 February 2009-    * Small changes needed in other AERN packages:-        * New operation for domain boxes: get its dimension.-    * Exponentiation, sine, cosine and arctan signinificantly improved for arguments further away from 0.-    * Fixed a bug in sine Taylor series error term.-    * Some interval arithmetic operations now have also "inner" versions-      that approximate the maximal extension of the operation from inside-      (useful for testing the normal "outer" versions).--0.9.8: 1 December 2008-    * added instance of the HTML class for intervals-    * added syntactic comparison of variable-indexed domain boxes-    * some extra miscellaneous functions-    * moved miscellaneous facilities for STM from AERN-RnToRm-Plot to here so that they can be used by AERN-Net--0.9.7.2: 7 October 2008-    * hmpfr interface now uses a faster toDouble conversion--0.9.7.1: 30 September 2008-    * switched the Demo program to a more suitable (ie faster) base--0.9.7: 30 September 2008-    * made it easier to switch among various bases (double, mpfr, pure haskell floats...)-    * added MPFR backend via hmpfr (cabal install -f "use-hmpfr")-    * added two new samples (computing pi, inverting Hilbert matrix) that-      demonstrate the speedup when using MPFR--0.9.6.1: 7 August 2008-    * revamped package description to make it much shorter and linked it-      to the main module--0.9.6: 7 August 2008-    * improved domain box class interface and implementation-    * fixed broken domain box splitting function-    * improved the integer logarithm auxiliary function--0.9.5: 24 July 2008-    * new operation for testing disjoing interiors-    * real approximations not automatically instances of Ord-      because comparison is not decidable in general;-      one should use the four-valued compareReals instead of <, =<, ==-    * removed rependency on haskell98--0.9.4: 15 July 2008-    * fixed buggy formatting of floating point numbers-    * added a simple although inefficient linear solver--0.9.3.1: 12 July 2008-    * fixed email in cabal maintainer field--0.9.3: 12 July 2008-    * Fixed Data.Number.ER.Real so that it is usable as a single import-      for the library and its documentation links are more useful.-    * Added a module with some tests, which can also serve as an example.-    * Improved formatting of floating point numbers.--0.9.2: 11 July 2008-    * declared dependency on haskell98 in cabal file (thanks to Don Stewart)--0.9.1: 11 July 2008-    * fixed licence specification within modules--0.9.0: 11 July 2008-    * initial release of AERN-Real-    -
LICENCE view
@@ -1,4 +1,4 @@-Copyright (c) 2007-2008 Michal Konecny, Amin Farjudian, Jan Duracz+Copyright (c) 2010 Michal Konecny  All rights reserved.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs 
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
− examples/Demo.hs 
@@ -1,149 +0,0 @@-{-# LANGUAGE CPP #-}-{-| -    Module      :  Main-    Description :  simple examples of using AERN-Real-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Simple examples of using AERN-Real--}-module Main where--import qualified Data.Number.ER.Real as AERN-import Data.Number.ER.Real (ConvergRealSeq(..), convertFuncRA2Seq)--#ifdef USE_MPFR---type B = AERN.BAP -- use pure Haskell floats-type B = AERN.BMAP -- use combination of double and pure Haskell floats---type B = AERN.BMPFR -- use MPFR floats-#else---type B = AERN.BAP -- use pure Haskell floats-type B = AERN.BMAP -- use combination of double and pure Haskell floats-#endif-type RA = AERN.RA B-type IRA = AERN.IRA B-type R = ConvergRealSeq IRA--one :: R-one = 1--two :: R-two = 2--piSeq :: R-piSeq = ConvergRealSeq $ AERN.pi--seqExp = convertFuncRA2Seq $ AERN.exp-seqSine = convertFuncRA2Seq $ AERN.sin-seqCosine = convertFuncRA2Seq $ AERN.cos--main = -    do-    AERN.initialiseBaseArithmetic (0 :: RA)-    putStrLn "****************************"-    putStrLn "Testing interval arithmetic:"-    putStrLn "****************************"-    putStrLn "**** Fractions:"-    putStrLn $-        "(default granularity, show internals) 1/3 =\n  " ++ -        AERN.showApprox 30 True True (1/3 :: RA) -    putStrLn $-        "(granularity 50, show internals) 1/3 =\n  " ++ -        AERN.showApprox 30 True True ((AERN.setGranularityOuter 50 1/3) :: RA) -    putStrLn $-        "(granularity 100, show internals) 1/3 =\n  " ++ -        AERN.showApprox 40 True True ((AERN.setGranularityOuter 100 1/3) :: RA) -    putStrLn $-        "(granularity 100, do not show internals) 1/3 =\n  " ++ -        AERN.showApprox 40 True False ((AERN.setGranularityOuter 100 1/3) :: RA) -    putStrLn $-        "(granularity 100, default show) 1/3 =\n  " ++ -        show ((AERN.setGranularityOuter 100 1/3) :: RA) -    putStrLn "**** Exp:"-    putStrLn $ -        "(effort 5, granularity 50) exp 1 =\n  " ++ -        (show $ AERN.exp 5 (AERN.setGranularityOuter 50 (1::RA)))-    putStrLn $ -        "(effort 10, granularity 50) exp 1 =\n  " ++ -        (show $ AERN.exp 10 (AERN.setGranularityOuter 50 (1::RA)))-    putStrLn $-        "(effort 10, granularity 100) exp 1 =\n  " ++ -        (show $ AERN.exp 10 (AERN.setGranularityOuter 100 (1::RA)))-    putStrLn $ -        "(effort 20, granularity 50) exp 1 =\n  " ++ -        (show $ AERN.exp 20 (AERN.setGranularityOuter 50 (1::RA)))-    putStrLn $-        "(effort 20, granularity 100) exp 1 =\n  " ++ -        (show $ AERN.exp 20 (AERN.setGranularityOuter 100 (1::RA)))-    putStrLn "**** Pi:"-    putStrLn $ -        "(effort 10) pi =\n  " ++ -        (show $ (AERN.pi 10 :: RA))-    putStrLn $ -        "(effort 50) pi =\n  " ++ -        (AERN.showApprox 20 True False $ (AERN.pi 50 :: RA))-    putStrLn $ -        "(effort 100) pi =\n  " ++ -        (AERN.showApprox 35 True False $ (AERN.pi 100 :: RA))-    putStrLn $ -        "(effort 200) pi =\n  " ++ -        (AERN.showApprox 65 True False $ (AERN.pi 200 :: RA))-    putStrLn $ -        "(effort 400) pi =\n  " ++ -        (AERN.showApprox 125 True False $ (AERN.pi 400 :: RA))-    putStrLn "**** Sine:"-    putStrLn $-        "(effort 10, granularity 50) sin 1 =\n  " ++ -        (show $ AERN.sin 10 (AERN.setGranularityOuter 50 (1::RA)))-    putStrLn $-        "(effort 10, granularity 100) sin 1 =\n  " ++ -        (show $ AERN.sin 10 (AERN.setGranularityOuter 100 (1::RA)))-    putStrLn "**** Integration:"-    putStrLn $ -        "(effort 10, granularity 50) integrate exp 0 1 =\n  " ++ -        (show $ AERN.integrateContAdapt_R AERN.exp 10 0 (AERN.setGranularityOuter 50 (1::RA)))-    putStrLn $ -        "(effort 20, granularity 50) integrate exp 0 1 =\n  " ++ -        (show $ AERN.integrateContAdapt_R AERN.exp 20 0 (AERN.setGranularityOuter 50 (1::RA)))---    putStrLn $ ---        "(effort 30, granularity 50) integrate exp 0 1 =\n  " ++ ---        (show $ AERN.integrateContAdapt_R AERN.exp 30 0 (AERN.setGranularityOuter 50 (1::RA)))-    putStrLn "*****************************"-    putStrLn "Testing convergent sequences:"-    putStrLn "*****************************"---    putStrLn $ "1 =\n  " ++ show one---    putStrLn $ "1 + 2 =\n  " ++ (show $ one + two)-    putStrLn "**** Fractions:"-    putStrLn $ -        "(precision 20) 1/3 =\n  " ++ -        (AERN.showConvergRealSeqAuto 20 $ one / 3)-    putStrLn $ -        "(precision 20) 100000000001/300000000000 =\n  " ++ -        (AERN.showConvergRealSeqAuto 20 $ (one + 100000000000)/300000000000 )-    putStrLn $ -        "100000000001/300000000000 =? 1/3:\n  " ++ -        (show $ one/3 == 100000000001/300000000000)---    putStrLn $ "abs -1 = " ++ (show $ abs (- one))---    putStrLn $ "neg 2 = " ++ (show $ negate two)---    putStrLn $ "1 + 2 = " ++ (show $ one + 2)-    putStrLn "**** Elementary:"-    putStrLn $ -        "(precision 30) exp 1 =\n  " ++ -        (AERN.showConvergRealSeqAuto 30 $ seqExp one)-    putStrLn $ -        "(precision 500) pi =\n  " ++ -        (AERN.showConvergRealSeqAuto 500 $ piSeq)-    putStrLn $ -        "(precision 30) cosine(1) =\n  " ++ -        (AERN.showConvergRealSeqAuto 30 $ seqCosine one)    -    putStrLn $-        "(precision 30) sine(1) =\n  " ++ -        (AERN.showConvergRealSeqAuto 30 $ seqSine one)-    putStrLn "**** Integration:"-    putStrLn $ -- very slow for precision > 4-        "(precision 3) integrate exp 0 1 =\n  " ++ -        (AERN.showConvergRealSeqAuto 3 $ AERN.integrateCont AERN.exp 0 one)
− examples/Matrix.hs 
@@ -1,385 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DeriveDataTypeable #-}-module Main--where--import qualified Data.Number.ER.Real as AERN-import Data.Number.ER.BasicTypes-import Data.Number.ER.Misc--import Data.Maybe-import qualified Data.List as List-import qualified Data.Map as Map--import qualified Data.Array.IArray as IAr-import qualified Data.Array.MArray as MAr-import qualified Data.Array.ST as STAr-import qualified Data.Ix as Ix-import qualified Data.Array.Base as BAr--import Control.Monad.ST-import GHC.Arr--#ifdef USE_MPFR-type B = AERN.BAP -- use pure Haskell floats---type B = AERN.BMPFR -- use MPFR floats-#else-type B = AERN.BAP -- use pure Haskell floats-#endif-type RA = AERN.RA B-type IRA = AERN.IRA B--testMatrixN = 100-incrementGran = (+) 50---- Hilbert 100x100 matrix:-addOneDiag = False-targetPrec = 167 -- approx 50 decimal digits after the point-initialGran = 2050 -- 100x100---initialGran = 2388 -- 100x100 Norbert's---initialGran = 750 -- 50x50---initialGran = 300 -- 10x10----targetPrec = 34 -- approx 10 decimal digits after the point---initialGran = 1350---initialGran = 50 -- 50x50---- Hilbert matrix + 1:---addOneDiag = True---targetPrec = 167 -- approx 50 decimal digits after the point---initialGran = 200----targetPrec = 34 -- approx 10 decimal digits after the point---initialGran = 50--main =-    do-    AERN.initialiseBaseArithmetic (0 :: RA)-    putStrLn $ -          "Inverting the " ++ show n ++ "x" ++ show n ++ " Hilbert matrix " -          ++ "with target binary precision " ++ show targetPrec ++ "..." ---    putStrLn $ ---        "sorted matrix elements = \n" ++ (unlines $ map show elemsSortedByPrec)-    putStrLn $ -        "sum of all elements in inverted matrix = " ++ show (sum elems)---    putStrLn $ show (Matrix n n rarr)-    where-    n = testMatrixN-    elems = IAr.elems rarr-    elemsSortedByPrec =-        List.sortBy comparePrec elems-        where-        comparePrec a b =-            compare aPrecLO bPrecLO-            where-            aPrecLO = fst $ AERN.bounds $ aHI - aLO-            (aLO, aHI) = AERN.bounds a-            bPrecLO = fst $ AERN.bounds $ bHI - bLO-            (bLO, bHI) = AERN.bounds b-    rarr =-        STAr.runSTArray $-            do-            mInv@(Matrix _ _ rowsInv) <- -                invert testMatrix---            m <- testMatrix initialGran---            mUnit@(Matrix _ _ rowsUnit) <- multM m mInv-            return rowsInv---testMatrix ::-    Granularity -> -    ST s (STMatrix s IRA)-testMatrix gran =-    do-    marr <- MAr.newArray ((1,1),(n,n)) 0-    mapM (updateCell marr) assocsGran-    return $ Matrix n n marr-    where-    assocsGran = map (mapSnd $ AERN.setMinGranularityOuter gran) assocs-    assocs = ---        assocsMini-        assocsHilbert gran n-    assocsMini = -        [((1,1),1),-         ((1,2),3),-         ((2,1),2),-         ((2,2),0)-        ]-    n = testMatrixN-    updateCell marr (ix, el) =-        do-        unsafeMatrixWrite marr n ix el --assocsHilbert gran n =-    [((i,j), coeff i j)| i <- [1..n], j <- [1..n]]-    where-    coeff i j -        | addOneDiag && i == j = -            1 + oneOverIplusJ-        | otherwise =-            oneOverIplusJ-        where-        oneOverIplusJ =-            recip $ (AERN.setMinGranularityOuter gran $ iRA + jRA + 1)-        iRA = fromInteger $ toInteger i-        jRA = fromInteger $ toInteger j--    ---invert ::---    Precision ->---    () ->-invert getMatrix =-    do-    gaussElim getMatrixI-    where-    n = testMatrixN-    getMatrixI gran =-        do-        m <- getMatrix gran-        mI <- addIdentity m-        return mI--gaussElim getMatrix =-    elimWithMinGran initialGran-    where-    elimWithMinGran workingGran =-        do-        mI@(Matrix colN rowN _) <- getMatrix workingGran-        idPerm <- MAr.newListArray (1,rowN) [1..rowN]-        elimAtRow mI 1 idPerm-        where-        elimAtRow mI@(Matrix colN rowN mIarr) i perm =-            do-            success <- ensureNonZeroDiag -- make sure (i,i) is non-zero by permuting-            case success of-                False -> -- failed - all elements contain 0 -> try larger granularity-                    unsafePrint ("failed to divide at granularity " ++ show workingGran) $-                        elimWithMinGran (incrementGran workingGran)-                True ->-                    do-                    normaliseRow-                    eliminateColumn-                    case i == rowN of-                        True -> -                            do-                            mInv <- permuteRowsDropCols perm testMatrixN mI-                            mPrec <- getMatrixPrecision mInv-                            case mPrec >= targetPrec of-                                False -> -- resulting precision insufficient-                                    unsafePrint -                                    ("insufficient precision " ++ show mPrec ++  -                                     " at granularity " ++ show workingGran) $-                                        elimWithMinGran (incrementGran workingGran)-                                True -> -                                    unsafePrint -                                    ("precision " ++ show mPrec ++ -                                     " succeeded at granularity " ++ show workingGran)-                                    return mInv-                        False -> elimAtRow mI (i+1) perm-            where-            ensureNonZeroDiag =-                do-                maybeNonZeroIx <- findNonZeroRow-                case maybeNonZeroIx of-                    Nothing ->-                        return False-                    Just ii ->-                        do-                        case ii > 0 of-                            True -> swap i (i + ii) perm-                            False -> return ()-                        return True-            findNonZeroRow =-                do-                elems <- mapM getElemPerm [(i,rowIx) | rowIx <- [i..rowN]]-                return $ List.findIndex (\e -> not $ 0 `AERN.refines` e) elems-            getElemPerm (colIx,rowIx) =-                do-                rowIxPerm <- unsafePermRead perm rowIx-                unsafeMatrixRead mIarr rowN (colIx, rowIxPerm)--            normaliseRow =-                do-                rowIxPerm <- unsafePermRead perm i-                e <- unsafeMatrixRead mIarr rowN (i, rowIxPerm)-                unsafeMatrixWrite mIarr rowN (i, rowIxPerm) 1-                mapM (divideCellBy e rowIxPerm) [(i+1)..colN]-            divideCellBy e rowIxPerm colIx =-                do-                e2 <- unsafeMatrixRead mIarr rowN (colIx, rowIxPerm)-                unsafeMatrixWrite mIarr rowN (colIx, rowIxPerm) (e2/e)-                -            eliminateColumn =-                do-                iRowPerm <- unsafePermRead perm i-                mapM (eliminateColumnRow iRowPerm) $ [1..(i-1)] ++ [(i+1)..rowN]-            eliminateColumnRow iRowPerm rowIx =-                do-                rowIxPerm <- unsafePermRead perm rowIx-                c <- unsafeMatrixRead mIarr rowN (i, rowIxPerm) -- remember old element for scaling i'th row-                unsafeMatrixWrite mIarr rowN (i,rowIxPerm) 0 -- at column i we set 0-                mapM (eliminateColumnRowColumn iRowPerm rowIxPerm c) [(i+1)..colN]-            eliminateColumnRowColumn iRowPerm rowIxPerm c colIx =-                do-                ei <- unsafeMatrixRead mIarr rowN (colIx, iRowPerm) -- at i'th row-                er <- unsafeMatrixRead mIarr rowN (colIx, rowIxPerm) -- at current row-                unsafeMatrixWrite mIarr rowN (colIx, rowIxPerm) (er - c * ei) -- eliminate by i'th row-               - -swap ::-    Int ->-    Int ->-    (STAr.STUArray s Int Int) ->-    ST s ()-swap i1 i2 perm =-    do-    a1 <- unsafePermRead perm i1-    a2 <- unsafePermRead perm i2-    unsafePermWrite perm i1 a2-    unsafePermWrite perm i2 a1-            --unsafePermWrite permArr i e =-    do-    BAr.unsafeWrite permArr (i - 1) e-                -unsafePermRead permArr i =-    do-    BAr.unsafeRead permArr (i - 1)-                --addIdentity ::-    (STMatrix s IRA) ->-    ST s (STMatrix s IRA)-addIdentity (Matrix colN rowN marr) =-    do---    (_, (colN,rowN)) <- MAr.getBounds marr-    mElems <- MAr.getElems marr-    mIarr <- MAr.newListArray ((1,1),(colN+rowN,rowN)) $ mElems ++ (idElems rowN)-    return $ Matrix (colN + rowN) rowN mIarr-    where-    idElems m =-        1 : (concat $ replicate (m-1) $ (replicate m 0) ++ [1])---data Matrix marr el =-    Matrix-    {-        mxRowN :: Int,-        mxColN :: Int,-        mxRows :: marr (ColIx,RowIx) el-    }--type ColIx = Int -type RowIx = Int --type IMatrix el = -    Matrix Array el-    -type STMatrix s el =-    Matrix (STArray s) el-    -instance -    (IAr.IArray marr el,-- IAr.IArray marr (marr Int el), -     Show el) => -    Show (Matrix marr el)-    where-    show (Matrix colN rowN rows) =-        "\nMatrix:\n" ++ -        (concat $ map showCol [1..colN])-        where---        (_,(colN,rowN)) = IAr.bounds rows-        showCol colIx =-            unlines $-                map showCell [(colIx, rowIx) | rowIx <- [1..rowN]] -        showCell ix@(colIx, rowIx) =-            (show ix) ++-            (replicate colIx '.') ++  -            (show $ (IAr.!) rows ix)-    -getMatrixPrecision (Matrix _ _ marr) =-    do-    elems <- MAr.getElems marr-    return $ foldl1 min $ map AERN.getPrecision elems--unsafeMatrixWrite marr rowN (i,j) e =-    do-    BAr.unsafeWrite marr (rowN*(i-1) + j-1) e---    MAr.writeArray marr (i,j) e--unsafeMatrixRead marr rowN (i,j) =-    do-    BAr.unsafeRead marr (rowN*(i-1) + j-1)---    MAr.readArray marr (i,j)-    -permuteRowsDropCols ::-    (STAr.STUArray s Int Int) ->-    Int {-^ drop this many first columns -} ->-    (STMatrix s IRA) ->-    ST s (STMatrix s IRA)-permuteRowsDropCols perm dropN (Matrix colN rowN marr) =-    do---    (_, (colN,rowN)) <- MAr.getBounds marr-    (_, permN) <- MAr.getBounds perm    -    rarr <- MAr.newArray ((1,1),(colN - dropN, permN)) 0-    mapM (copyElem marr rarr rowN) [(colIx, rowIx) | colIx <- [1..colN - dropN], rowIx <- [1..permN]]-    return (Matrix (colN - dropN) permN rarr)-    where-    copyElem marr rarr rowN (colIx, rowIx) =-        do-        permRowIx <- unsafePermRead perm rowIx-        e <- unsafeMatrixRead marr rowN (colIx + dropN, permRowIx)-        unsafeMatrixWrite rarr rowN (colIx, rowIx) e-        -    -addM m1 m2 -    | mxColN m1 == mxColN m2 && mxRowN m1 == mxRowN m2 =-        do-        marr <- MAr.newArray ((1,1),(colN, rowN)) 0-        mapM (addCell marr) [(c,r) | c <- [1..colN], r <- [1..rowN]]-        return (Matrix colN rowN marr)   -    | otherwise =-        error "Matrix: addM mismatch"-    where-    colN = mxColN m1-    rowN = mxRowN m1-    marr1 = mxRows m1-    marr2 = mxRows m2-    addCell marr (colIx, rowIx) =-        do-        elem1 <- unsafeMatrixRead marr1 rowN (colIx, rowIx)-        elem2 <- unsafeMatrixRead marr2 rowN (colIx, rowIx)-        unsafeMatrixWrite marr rowN (colIx, rowIx) (elem1 + elem2)--multM m1 m2 -    | colN1 == rowN2 =-        do-        marr <- MAr.newArray ((1,1),(colN, rowN)) 0-        mapM (multCell marr) [(c,r) | c <- [1..colN], r <- [1..rowN]]-        return (Matrix colN rowN marr)   -    | otherwise =-        error "Matrix: multM mismatch"-    where-    colN1 = mxColN m1-    rowN1 = mxRowN m1-    colN2 = mxColN m2-    rowN2 = mxRowN m2-    colN = colN2-    rowN = rowN1-    marr1 = mxRows m1-    marr2 = mxRows m2-    multCell marr (colIx, rowIx) =-        do-        elems1 <- mapM (getCell1 rowIx) [1..colN1]-        elems2 <- mapM (getCell2 colIx) [1..rowN2]-        unsafeMatrixWrite marr rowN (colIx, rowIx) (sum $ zipWith (*) elems1 elems2)-    getCell1 rowIx colIx =-        do-        unsafeMatrixRead marr1 rowN1 (colIx, rowIx)-    getCell2 rowIx colIx =-        do-        unsafeMatrixRead marr2 rowN2 (colIx, rowIx)-
− examples/Pi.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DeriveDataTypeable #-}-module Main--where--import qualified Data.Number.ER.Real as AERN-import Data.Number.ER.Real (ConvergRealSeq(..), convertFuncRA2Seq)-import Data.Number.ER.BasicTypes-import Data.Number.ER.Misc--import Data.Maybe--#ifdef USE_MPFR---type B = AERN.BMPFR -- use MPFR floats-type B = AERN.BAP -- use pure Haskell floats-#else-type B = AERN.BAP -- use pure Haskell floats---type B = AERN.BMAP -- use combination of double and pure Haskell floats-#endif-type RA = AERN.RA B-type IRA = AERN.IRA B---decimalPrec = 1000-binaryPrec =-    fromInteger $ toInteger $-    snd $ AERN.integerBounds $-        (fromInteger decimalPrec :: RA) * (AERN.log 100 10)/(AERN.log 100 2)--main =-    do-    AERN.initialiseBaseArithmetic (0 :: RA)-    putStrLn $ -        show decimalPrec -        ++ " decimal digits of pi = \n" -        ++ (AERN.showConvergRealSeqAuto binaryPrec pi)-    where-    pi :: ConvergRealSeq RA-    pi = ConvergRealSeq AERN.pi-
− src/Data/Number/ER.hs 
@@ -1,25 +0,0 @@-{-|-    Module      :  Data.Number.ER-    Description :  top level of the exactreals framework-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  non-portable (requires fenv.h)--    This namespace is the root for the AERN family of packages.-    AERN stands for Approximated Exact Real Numbers.-    All AERN packages build on the package AERN-Real.-    -    Module "Data.Number.ER.Real" contains an overview-    of the AERN-Real package.-    --}-module Data.Number.ER -(-    module Data.Number.ER.Real-)-where--import Data.Number.ER.Real
− src/Data/Number/ER/BasicTypes.hs 
@@ -1,71 +0,0 @@-{-|-    Module      :  Data.Number.ER.BasicTypes-    Description :  auxiliary types for exact real number processing -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    auxiliary types for exact real number processing--}-module Data.Number.ER.BasicTypes -where--import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI--{-|-    Precision represents an upper bound on the measure of -    an approximation viewed as a set;-    not to be confused with the precision of -    an 'Data.Number.ER.Real.Base.Float.ERFloat' and similar.-     -    In an approximation comprising a number of-    instances of 'Data.Number.ER.Real.Base.ERRealBase',-    we will refer to the bit-precision of these base components-    as the 'Granularity' of the approximation.--}-type Precision = EI.ExtendedInteger--{-|-  The bit size of the floating point numbers (or similar)-  used internally in real number and function approximations.--}-type Granularity = Int--prec2gran :: Precision -> Granularity-prec2gran = fromInteger . toInteger--{-|-    This type synonym should be used for funciton parameter(s)-    that guide the convergence of the function's result to-    a perfect (exact) result.  -    -    The name should remind us -    that there is no universally valid relationship between-    this integer the quality (precision) of the result.    -    The only condition usually assumed is that in the limit-    when the effort index rises to infinity, the result -    should be exact.--}-type EffortIndex = Integer--effIx2gran :: EffortIndex -> Granularity-effIx2gran  = fromInteger . toInteger--effIx2prec :: EffortIndex -> Precision-effIx2prec = fromInteger . toInteger--effIx2int :: EffortIndex -> Int-effIx2int = fromInteger . toInteger--int2effIx :: Int -> EffortIndex-int2effIx = fromInteger . toInteger--prec2effIx :: Precision -> EffortIndex-prec2effIx = fromInteger . toInteger--gran2effIx :: Granularity -> EffortIndex-gran2effIx = fromInteger . toInteger-
− src/Data/Number/ER/BasicTypes/DomainBox.hs 
@@ -1,192 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE FunctionalDependencies  #-}-{-|-    Module      :  Data.Number.ER.BasicTypes.DomainBox-    Description :  portions of many-dimensional domains   -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Abstractions of the 'Box' datatype, often used to represent-    sections of multi-dimensional function domains.-    -    To be imported qualified, usually with prefix DBox.-    -    VariableID(..) and DomainBox -    are usually imported separately and not qualified.--}-module Data.Number.ER.BasicTypes.DomainBox-(-    VariableID(..),-    getNVars,-    DomainBox(..),-    DomainBoxMappable(..),-    DomainIntBox(..)-)-where--import Data.Number.ER.BasicTypes--import qualified Data.Set as Set-import qualified Data.Map as Map--import Prelude hiding (lookup)---{-| -    A class abstracting a type of variable identifiers -    for axes in function domains, polynomials etc.--}-class (Ord varid) => VariableID varid-    where-    newVarID :: Set.Set varid -> varid-    defaultVar :: varid-    defaultVar = newVarID Set.empty-    showVar :: varid -> String--getNVars :: (VariableID varid) => Int -> [varid]-getNVars n =-    aux (Set.empty) n-    where-    aux prevVars n -        | n > 0 = -            aux (Set.insert (newVarID prevVars) prevVars) (n - 1)-        | n == 0 =-            Set.toAscList $ prevVars --{-|-    A class abstracting a type of many-dimensional points, intervals-    or anything indexed by a subset of dimensions.-    -    More generally, this class abstracts most of 'Data.Map.Map'.--}-class (VariableID varid) => DomainBox box varid val-    | box -> varid val, varid val -> box-    where-    noinfo :: box-    isNoinfo :: box -> Bool-    size :: box -> Int-    {-| constructor using 'defaultVar' -}-    unary :: val -> box-    singleton :: varid -> val -> box-    toList :: box -> [(varid, val)]-    fromList :: [(varid, val)] -> box-    toAscList :: box -> [(varid, val)]-    fromAscList :: [(varid, val)] -> box---    toMap :: box -> Map.Map varid val---    fromMap :: Map.Map varid val -> box-    compare :: (val -> val -> Ordering) -> box -> box -> Ordering-    adjust :: (val -> val) -> varid -> box -> box-    insert :: varid -> val -> box -> box-    insertWith :: (val -> val -> val) -> varid -> val -> box -> box-    delete :: varid -> box -> box-    member :: varid -> box -> Bool-    notMember :: varid -> box -> Bool-    union :: box -> box -> box-    unionWith :: (val -> val -> val) -> box -> box -> box-    keys :: box -> [varid]-    elems :: box -> [val]-    filter :: (val -> Bool) -> box -> box-    fold :: (val -> a -> a) -> a -> box -> a-    foldWithKey :: (varid -> val -> a -> a) -> a -> box -> a-    {-| -        for all variables that appear in both boxes,-        apply the function and add the result to the list -     -}-    zipWith :: (val -> val -> a) -> box -> box -> [(varid, a)] -    {-| -        For all variables that appear in either of the two boxes,-        apply the function and add the result to the list.-        -        Supply the default value when the variable is missing from either box. -     -}-    zipWithDefault :: val -> (val -> val -> a) -> box -> box -> [(varid, a)] -    {-| -        For all variables that appear in the first box,-        apply the function and add the result to the list.-        -        Supply the default value when the variable is missing from the second box. -     -}-    zipWithDefaultSecond :: val -> (val -> val -> a) -> box -> box -> [(varid, a)] -    findWithDefault :: val -> varid -> box -> val-    {-|-        Pick the extents of a single variable in a domain box.-        If there is no information for this variable, assume the-        variable ranges over the whole real line.-    -}-    lookup ::     -        String {-^ identification of caller location to use in error messages -} ->-        varid ->-        box ->-        val-        -{-|-    A class linking two domain box types that share the-    index type so that boxes of the two types can be-    converted etc.--}-class (DomainBox box1 varid val1, DomainBox box2 varid val2) => -    DomainBoxMappable box1 box2 varid val1 val2-    where-    map :: (val1 -> val2) -> box1 -> box2-    mapWithKey :: (varid -> val1 -> val2) -> box1 -> box2-    intersectionWith :: (val1 -> val2 -> val1) -> box1 -> box2 -> box1-    difference :: box1 -> box2 -> box1 --{-|-    A class abstracting a type of many-dimensional intervals.--}-class (DomainBox box varid ira) => DomainIntBox box varid ira-    | box -> varid ira, varid ira -> box-    where-    {-|-        Check whether the two domains specify the same-        interval for each variable that they share.-    -}-    compatible ::-        box ->-        box ->-        Bool-    {-|-        Assuming that two domains are compatible, take the-        most information from both of the domains about the-        ranges of variables.-    -}-    unify ::-        String {-^ identification of caller location to use in error messages -} ->-        box ->-        box ->-        box-    {-|-        Find the variable with the largest interval-        and return it together with the default splitting point-        in its domain.-    -}-    bestSplit ::-        box  {-^ box considered for splitting -} ->-        (varid, (ira, ira))-        {-^ variable with widest domain, its domain and default split point -}-    split ::-        box {-^ box to split -} ->-        varid {-^ direction to split in -} ->-        Maybe ira  {-^ point to split the domain of variable @varid@ at, if absent use default -} ->-        (box, box)-    classifyPosition ::-        box {-^ domain @d1@ -} ->-        box {-^ domain @d2@ -} ->-        (Bool, Bool, Bool, Bool) -            {-^ -                Answers to these (mutually exclusive) questions:-                -                * is @d1@ outside and /not/ touching @d2@?-            -                * is @d1@ outside and touching @d2@?-            -                * is @d1@ intersecting and not inside @d2@?-            -                * is @d1@ inside @d2@?-            -}-
− src/Data/Number/ER/BasicTypes/DomainBox/IntMap.hs 
@@ -1,207 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE TypeSynonymInstances   #-}-{-|-    Module      :  Data.Number.ER.BasicTypes.DomainBox.IntMap-    Description :  implementation of DomainBox based on Data.IntMap   -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    A simple implementation of the 'VariableID' and 'DomainBox' classes.--}-module Data.Number.ER.BasicTypes.DomainBox.IntMap -(-    VarID, Box-)-where--import qualified Data.Number.ER.Real.Approx as RA-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.IntMap as IMap-import qualified Data.Set as Set--type VarID = Int-type Box ira = IMap.IntMap ira--instance VariableID VarID-    where-    newVarID prevVars -        | Set.null prevVars = 0-        | otherwise =-            1 + (Set.findMax prevVars)-    showVar v-        | v == 0 = "x"-        | otherwise = "x" ++ show v--instance (Show val) => (DomainBox (Box val) VarID val)-    where-    noinfo = IMap.empty-    isNoinfo = IMap.null-    size = IMap.size-    unary r = IMap.singleton defaultVar r-    singleton = IMap.singleton-    toList = IMap.toList-    fromList = IMap.fromList-    toAscList = IMap.toAscList-    fromAscList = IMap.fromAscList---    toMap = id---    fromMap = id-    compare compareVals b1 b2 =-        compareListsWith comparePairs (IMap.toList b1) (IMap.toList b2)-        where-        comparePairs (k1,v1) (k2,v2) =-            compareComposeMany-                [-                    compare k1 k2,-                    compareVals v1 v2-                ]-             -    adjust = IMap.adjust-    insert = IMap.insert-    insertWith = IMap.insertWith-    delete = IMap.delete-    member = IMap.member -    notMember = IMap.notMember-    union = IMap.union -    unionWith = IMap.unionWith -    elems = IMap.elems-    keys = IMap.keys-    filter = IMap.filter-    fold = IMap.fold-    foldWithKey = IMap.foldWithKey-    zipWith f b1 b2 = -        applyF (IMap.toAscList b1) (IMap.toAscList b2)-        where-        applyF [] _ = []-        applyF _ [] = []-        applyF bl1@((k1,v1):rest1) bl2@((k2,v2):rest2) -            | k1 == k2 = -                (k1, f v1 v2) : (applyF rest1 rest2)-            | k1 < k2 = applyF rest1 bl2-            | otherwise = applyF bl1 rest2 -    zipWithDefault defaultValue f b1 b2 = -        applyF (IMap.toAscList b1) (IMap.toAscList b2)-        where-        applyF [] [] = []-        applyF bl1@((k1,v1):rest1) [] =-            (k1, f v1 defaultValue) : (applyF rest1 [])-        applyF [] bl2@((k2,v2):rest2) =-            (k2, f defaultValue v2) : (applyF [] rest2)-        applyF bl1@((k1,v1):rest1) bl2@((k2,v2):rest2) -            | k1 == k2 = -                (k1, f v1 v2) : (applyF rest1 rest2)-            | k1 < k2 = -                (k1, f v1 defaultValue) : (applyF rest1 bl2)-            | otherwise =  -                (k2, f defaultValue v2) : (applyF bl1 rest2)-    zipWithDefaultSecond defaultValue f b1 b2 = -        applyF (IMap.toAscList b1) (IMap.toAscList b2)-        where-        applyF [] _ = []-        applyF bl1@((k1,v1):rest1) [] =-            (k1, f v1 defaultValue) : (applyF rest1 [])-        applyF bl1@((k1,v1):rest1) bl2@((k2,v2):rest2) -            | k1 == k2 = -                (k1, f v1 v2) : (applyF rest1 rest2)-            | k1 < k2 = -                (k1, f v1 defaultValue) : (applyF rest1 bl2)-            | otherwise =  -                applyF bl1 rest2-    findWithDefault = IMap.findWithDefault-    lookup locspec var dom =-        IMap.findWithDefault err var dom-        where-        err =-            error $-                locspec ++ "DomainBox.IntMap lookup: domain box " ++ show dom -                ++ " ignores variable " ++ show var--instance (Show val1, Show val2) => -    (DomainBoxMappable (Box val1) (Box val2) VarID val1 val2)-    where-    map = IMap.map-    mapWithKey = IMap.mapWithKey-    intersectionWith = IMap.intersectionWith-    difference = IMap.difference--instance (RA.ERIntApprox ira) => DomainIntBox (Box ira) VarID ira-    where-    compatible dom1 dom2 =-        foldl (&&) True $ map snd $-            DBox.zipWith RA.equalIntervals dom1 dom2-    unify locspec dom1 dom2-        | DBox.compatible dom1 dom2 =-            IMap.union dom1 dom2-        | otherwise =-            error $-                locspec ++ "incompatible domains " ++ show dom1 ++ " and " ++ show dom2-    bestSplit domB =-        (var, (varDom, pt))-        where-        pt = -            RA.defaultBisectPt varDom-        (_, (varDom, var)) = -            foldl findWidestVar (0, err) $ IMap.toList domB-        err =-            error $ "DomainBox: bestSplit: failed to find a split for " ++ show domB -        findWidestVar (prevWidth, prevRes) (v, d)-            | currWidth `RA.leqSingletons` prevWidth = (prevWidth, prevRes)-            | otherwise = (currWidth, (d, v))-            where-            currWidth = snd $ RA.bounds $ domHI - domLO-            (domLO, domHI) = RA.bounds d-    split domB var maybePt = -        (IMap.insert var varDomL domB, -         IMap.insert var varDomR domB)-        where-        varDomL = varDomLO RA.\/ pt-        varDomR = pt RA.\/ varDomHI-        pt = -            case maybePt of-                Nothing -> varDomMid-                Just pt | pt `RA.refines` varDom -> pt-                Just pt -> -                    error $  -                        "ER.DomainBox.IntMap: split given an invalid split point " -                        ++ show pt ++ " for the domain box " ++ show domB -                        ++ " and split variable " ++ show var -        (varDomLO, varDomMid, varDomHI, _) = RA.exactMiddle varDom-        varDom = DBox.lookup "DomainBox.IntMap: split: " var domB-    classifyPosition dom sdom =    -        (away, touch, intersect, inside)-            where-            (away, touch, inside, intersect) =-                foldl addDimension (True, True, True, False) awayTouchInsides-            addDimension -                    (prevAway, prevTouch, prevInside, prevIntersect) -                    (thisAway, thisTouch, thisInside, thisIntersect) =-                (prevAway && thisAway, -                 (prevTouch || prevAway) && (thisTouch || thisAway) && (prevTouch || thisTouch),-                 prevInside && thisInside,-                 prevIntersect || thisIntersect)-            awayTouchInsides =-                map snd $-                    DBox.zipWith classifyRA dom sdom-            classifyRA d sd =-                (outsideNoTouch, outsideTouch, inside,-                 not (outsideNoTouch || outsideTouch || inside))-                 where-                 outsideNoTouch = sdR < dL || dR < sdL-                 outsideTouch = sdR == dL || dR == sdL-                 inside = sdL =< dL && dR =< sdR-                 (==) = RA.eqSingletons-                 (<) = RA.ltSingletons-                 (=<) = RA.leqSingletons-                 (dL, dR) = RA.bounds d -                 (sdL, sdR) = RA.bounds sd -        --
− src/Data/Number/ER/BasicTypes/ExtendedInteger.hs 
@@ -1,125 +0,0 @@-{-|-    Module      :  Data.Number.ER.BasicTypes.ExtendedInteger-    Description :  integer with infinities -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    An arbitrary sized integer type with additional +infinity and -infinity.-    -    To be imported qualified, usually with prefix EI. --}-module Data.Number.ER.BasicTypes.ExtendedInteger -(-    ExtendedInteger(..),-    isInfinite, binaryLog, take-)-where--import Prelude hiding (isInfinite, take)-import qualified Prelude--data ExtendedInteger-    = MinusInfinity | Finite Integer | PlusInfinity-    deriving (Eq)--isInfinite :: ExtendedInteger -> Bool-isInfinite MinusInfinity = True-isInfinite PlusInfinity = True-isInfinite _ = False--{-|-    the smallest integer i for which 2^i <=  abs n--}-binaryLog :: ExtendedInteger -> ExtendedInteger-binaryLog PlusInfinity = PlusInfinity-binaryLog MinusInfinity = PlusInfinity-binaryLog (Finite n) -    | n < 0 = binaryLog (Finite (- n))-    | n == 0 = MinusInfinity-    | otherwise = -- (n > 0)-        -- how to do this fast?-        intBinaryLog n--intBinaryLog n -    | n > 1 = 1 + (intBinaryLog (n `div` 2))-    | n == 1 = 0--instance Show ExtendedInteger where-    show MinusInfinity = "-InfInt"-    show PlusInfinity = "+InfInt"-    show (Finite i) = show i--take :: ExtendedInteger -> [a] -> [a]-take MinusInfinity _ = error "takeEI called with MinusInfinity"-take PlusInfinity list = list-take (Finite n) list = Prelude.take (fromInteger n) list--instance Ord ExtendedInteger where-    compare MinusInfinity MinusInfinity = EQ-    compare MinusInfinity _ = LT-    compare _ MinusInfinity = GT-    compare PlusInfinity PlusInfinity = EQ-    compare PlusInfinity _ = GT-    compare _ PlusInfinity = LT-    compare (Finite i1) (Finite i2) =-        compare i1 i2--instance Num ExtendedInteger where-    fromInteger i = Finite i-    {- abs -}-    abs MinusInfinity = PlusInfinity-    abs PlusInfinity = PlusInfinity-    abs (Finite i) = Finite $ abs i-    {- signum -}-    signum ei-        | ei < 0 = -1-        | ei > 0 = 1-        | otherwise = 0-    {- negate -}-    negate (Finite i) = Finite (-i)-    negate MinusInfinity = PlusInfinity-    negate PlusInfinity = MinusInfinity-    {- addition -}-    PlusInfinity + MinusInfinity = -        error "cannot add PlusInfinity and MinusInfinity"-    MinusInfinity + PlusInfinity = -        error "cannot add PlusInfinity and MinusInfinity"-    PlusInfinity + ei = PlusInfinity-    ei + PlusInfinity = PlusInfinity-    MinusInfinity + ei = MinusInfinity-    ei + MinusInfinity = MinusInfinity-    (Finite i1) + (Finite i2) = Finite $ i1 + i2-    {- multiplication -}-    ei1 * ei2 | ei1 > ei2 = ei2 * ei1-    MinusInfinity * ei -        | ei < 0 = PlusInfinity-        | ei > 0 = MinusInfinity-        | otherwise = error "cannot multiply MinusInfinity and 0"-    ei * PlusInfinity-        | ei < 0 = MinusInfinity-        | ei > 0 = PlusInfinity-        | otherwise = error "cannot multiply PlusInfinity and 0"-    (Finite i1) * (Finite i2) = Finite $ i1 * i2--instance Enum ExtendedInteger where-    toEnum i = Finite $ toInteger i-    fromEnum (Finite i) = fromInteger i-    fromEnum _ = error "infinite integers cannot be enumerated"--instance Real ExtendedInteger where-    toRational (Finite i) = toRational i-    toRational _ = error "infinite integers cannot be converted to rational"-    -instance Integral ExtendedInteger where-    quotRem (Finite i) (Finite m) = -        (Finite a, Finite b)-        where-        (a,b) = quotRem i m-    quotRem _ _ = error "cannot make a quotient involving an infinite integer"-    toInteger (Finite i) = i-    toInteger _ = error "infinite integers cannot be converted to Integer"-
− src/Data/Number/ER/BasicTypes/PlusMinus.hs 
@@ -1,47 +0,0 @@-{-# LANGUAGE DeriveDataTypeable   #-}-{-|-    Module      :  Data.Number.ER.BasicTypes.PlusMinus-    Description :  mini sign datatype-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    A mini enumeration to represent the sign of different numbers and approximations.--}-module Data.Number.ER.BasicTypes.PlusMinus where--import Data.Typeable-import Data.Generics.Basics-import Data.Binary---import BinaryDerive--data PlusMinus = Minus | Plus-    deriving (Eq, Ord, Typeable, Data)--instance Show PlusMinus where-    show Plus = "+"-    show Minus = "-"--{- the following has been generated by BinaryDerive -}-instance Binary PlusMinus where-  put Minus = putWord8 0-  put Plus = putWord8 1-  get = do-    tag_ <- getWord8-    case tag_ of-      0 -> return Minus-      1 -> return Plus-      _ -> fail "no parse"-{- the above has been generated by BinaryDerive -}--signNeg Plus = Minus-signNeg Minus = Plus--signMult Plus s = s-signMult Minus s = signNeg s--signToNum Plus = 1-signToNum Minus = -1
− src/Data/Number/ER/BasicTypes/Tests/Generate.hs 
@@ -1,92 +0,0 @@-{-|-    Module      :  Data.Number.ER.BasicTypes.Tests.Generate-    Description :  (testing) generating values for tests-    Copyright   :  (c) 2007-2008 Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    Instances of Arbitrary so that values-    can be randomly generated for use in QuickCheck tests.--}--module Data.Number.ER.BasicTypes.Tests.Generate -where--import Data.Number.ER.BasicTypes-import Data.Number.ER.BasicTypes.ExtendedInteger-import Data.Number.ER.BasicTypes.PlusMinus--import Test.QuickCheck hiding (two, three)--data Nat10 = Nat10 Int deriving (Show)-data Nat100 = Nat100 Int deriving (Show)--data Ix10 = Ix10 EffortIndex deriving (Show)-data Ix20 = Ix20 EffortIndex deriving (Show)--data Gran100 = Gran100 Granularity deriving (Show)-data Gran1000 = Gran1000 Granularity deriving (Show)--data SmallRatio = SmallRatio Int Int deriving (Show)--instance (Arbitrary Nat10)-    where-    arbitrary =-        do-        ix <- choose (0,10)-        return $ Nat10 ix-    coarbitrary (Nat10 ix) =-        error "ER.BasicTypes.Tests.Generate: coarbitrary not implemented for Nat10"--instance (Arbitrary Nat100)-    where-    arbitrary =-        do-        ix <- choose (0,100)-        return $ Nat100 ix-    coarbitrary (Nat100 ix) =-        error "ER.BasicTypes.Tests.Generate: coarbitrary not implemented for Nat100"--instance (Arbitrary Ix20)-    where-    arbitrary =-        do-        ix <- choose (2,20)-        return $ Ix20 ix-    coarbitrary (Ix20 ix) =-        error "ER.BasicTypes.Tests.Generate: coarbitrary not implemented for Ix20"--instance (Arbitrary Ix10)-    where-    arbitrary =-        do-        ix <- choose (1,10)-        return $ Ix10 ix-    coarbitrary (Ix10 ix) =-        error "ER.BasicTypes.Tests.Generate: coarbitrary not implemented for Ix10"--instance (Arbitrary PlusMinus)-    where-    arbitrary = -        do-        isPlus <- arbitrary-        case isPlus of-            True -> return Plus-            False -> return Minus-    coarbitrary pm =-        error "ER.BasicTypes.Tests.Generate: coarbitrary not implemented for PlusMinus"-    -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"-        -
− src/Data/Number/ER/Misc.hs 
@@ -1,341 +0,0 @@-{-|-    Module      :  Data.Number.ER.Misc-    Description :  general purpose extras -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    Miscelaneous utilities (eg related to Ordering, pairs, booleans, strings)--}-module Data.Number.ER.Misc where--import Data.List-import System.IO.Unsafe-import Data.Time.Clock.POSIX--unsafePrint msg val =-    unsafePerformIO $-        do-        putStrLn $ "unsafe: " ++ msg-        return val--unsafePrintReturn msg a =-    unsafePrint (msg ++ show a) a--unsafeReport fileName msg val =-    unsafePerformIO $-        do-        stamp <- getPOSIXTime-        appendFile fileName $ showStamp stamp ++ ":"-        appendFile fileName $ msg ++ "\n"-        return val-    where-    showStamp stamp =-        padTo18 $ show stamp-    padTo18 s = s ++ (replicate (18 - (length s)) ' ')--{-|-    Compose as when defining the lexicographical ordering.--}-compareCompose :: Ordering -> Ordering -> Ordering-compareCompose EQ o = o-compareCompose o _ = o--{-|-    Compose as when defining the lexicographical ordering.--}-compareComposeMany :: [Ordering] -> Ordering-compareComposeMany [] = EQ-compareComposeMany (EQ:os) = compareComposeMany os-compareComposeMany (o:_) = o--{-|-    The lexicographical ordering.--}-compareLex :: (Ord a) => [a] -> [a] -> Ordering-compareLex [] _ = LT-compareLex _ [] = GT-compareLex (x:xs) (y:ys)-    | x == y = compareLex xs ys-    | otherwise = compare x y--compareListsWith ::-    (a -> a -> Ordering) ->-    [a] -> [a] -> Ordering-compareListsWith _ [] [] = EQ-compareListsWith _ [] _ = LT-compareListsWith _ _ [] = GT-compareListsWith compareVals (x:xs) (y:ys) =-    case compareVals x y of-        EQ -> compareListsWith compareVals xs ys-        res -> res--mapFst :: (a1 -> a2) -> (a1,b) -> (a2,b)     -mapFst f (a,b) = (f a,b)-mapSnd :: (b1 -> b2) -> (a,b1) -> (a,b2)     -mapSnd f (a,b) = (a,f b)-mapPair :: (a1 -> a2, b1 -> b2) -> (a1,b1) -> (a2,b2)     -mapPair (f1, f2) (a,b) = (f1 a, f2 b)-mapPairHomog :: (a1 -> a2) -> (a1,a1) -> (a2,a2)     -mapPairHomog f = mapPair (f,f) --unpair :: [(a,a)] -> [a]-unpair = (\(l1,l2) -> l1 ++ l2) . unzip--bool2maybe :: Bool -> Maybe ()-bool2maybe True = Just ()-bool2maybe False = Nothing--dropLast :: Int -> [a] -> [a]-dropLast n list = reverse $ drop n (reverse list)--{-|-    eg -->    concatWith "," ["a","b"] = "a,b"---}-concatWith :: -    String {-^ a connective -} -> -    [String] -> -    String-concatWith sep [] = ""-concatWith sep [str] = str-concatWith sep (str : strs) = str ++ sep ++ (concatWith sep strs)-    -{-|-    eg -->    replicateSeveral [(2,"a"),(1,"b")] = "aab"---}-replicateSeveral :: [(Int,a)] -> [a]-replicateSeveral [] = []-replicateSeveral ((n,e):rest) =-    replicate n e ++ (replicateSeveral rest)-    -{-|-    eg -->    countDuplicates "aaba" = [(2,"a"),(1,"b"),(1,"a")]---}-countDuplicates :: -    Eq a => -    [a] -> -    [(Int,a)]-countDuplicates list =-    map (\ g -> (length g, head g)) $ group list-    -{-|-    eg-    ->    allCombinations ->        [->         (1,['a']), ->         (2,['b','c']), ->         (3,['d','e','f'])->        ] =->            [->             [(1,'a'),(2,'b'),(3,'d')], ->             [(1,'a'),(2,'b'),(3,'e')],->             [(1,'a'),(2,'b'),(3,'f')],->             [(1,'a'),(2,'c'),(3,'d')], ->             [(1,'a'),(2,'c'),(3,'e')],->             [(1,'a'),(2,'c'),(3,'f')]->            ]--}-allCombinations :: -    [(k,[v])] -> [[(k,v)]]-allCombinations [] = [[]]-allCombinations ((k, vals) : rest) =-    concat $ map (\ v -> map ((k,v):) restCombinations) vals-    where-    restCombinations = -        allCombinations rest--allPairsCombinations ::-    [(k,(v,v))] -> [[(k,v)]]-allPairsCombinations [] = [[]]-allPairsCombinations ((k, (v1,v2)) : rest) =-    (map ((k, v1) :) restCombinations)-    ++-    (map ((k, v2) :) restCombinations)-    where-    restCombinations =-        allPairsCombinations rest-    -    -{-|-    eg-    ->    allPairsCombinationsEvenOdd ->        [->         (1,('a0','a1'), ->         (2,('b0','b1'), ->         (3,('c0','c1')->        ] =->           ([->             [(1,'a0'),(2,'b0'),(3,'c0')], ->             [(1,'a0'),(2,'b1'),(3,'c1')], ->             [(1,'a1'),(2,'b1'),(3,'c0')], ->             [(1,'a1'),(2,'b0'),(3,'c1')] ->            ]->           ,[->             [(1,'a0'),(2,'b0'),(3,'c1')], ->             [(1,'a0'),(2,'b1'),(3,'c0')], ->             [(1,'a1'),(2,'b0'),(3,'c0')], ->             [(1,'a1'),(2,'b1'),(3,'c1')] ->            ]->           )--}-allPairsCombinationsEvenOdd ::-    [(k,(v,v))] {-^ the first value is even, the second odd -} -> -    ([[(k,v)]], [[(k,v)]])-allPairsCombinationsEvenOdd [] = ([[]], [])-allPairsCombinationsEvenOdd ((k, (evenVal,oddVal)) : rest) =-    (-        (map ((k, evenVal) :) restCombinationsEven)-        ++-        (map ((k, oddVal) :) restCombinationsOdd)-    ,-        (map ((k, evenVal) :) restCombinationsOdd)-        ++-        (map ((k, oddVal) :) restCombinationsEven)-    )-    where-    (restCombinationsEven, restCombinationsOdd) =-        allPairsCombinationsEvenOdd rest-    -    -    -{- numeric -}    -    -intLogDown b n = fst $ intLog b n -intLogUp b n = snd $ intLog b n -    -intLog ::-    (Num n1, Num n2, Ord n1, Integral n2) => -    n1 {-^ base -} -> -    n1 {-^ x -} -> -    (n2, n2)-intLog b n-    | n == 1 = (0,0)-    | n > 1 && n < b = (0,1)-    | n >= b =-        bisect (lgDn, pwDn) (lgUp, pwUp)-    | otherwise = -        error $ "Data.Number.ER.Misc: intLog: illegal argument n = " ++ show n-    where-    ((lgDn, pwDn), (lgUp, pwUp)) = -        findBounds (1, b) -        -- lgDn <= log_b n < lgUp; pwDn = b^lgDn; pwUp = b^lgUp-    findBounds (lg, pw)-        | n < pwNext = ((lg, pw), (lgNext, pwNext))-        | otherwise = findBounds (lgNext, pwNext)-        where-        lgNext = 2 * lg-        pwNext = pw * pw-    bisect (lgDn, pwDn) (lgUp, pwUp)-        | pwDn == n = (lgDn, lgDn)-        | pwUp == n = (lgUp, lgUp)-        | lgDn == lgMid = (lgDn, lgUp)-        | lgUp == lgMid = (lgDn, lgUp)-        | n < pwMid =-            bisect (lgDn, pwDn) (lgMid, pwMid)-        | otherwise =-            bisect (lgMid, pwMid) (lgUp, pwUp)-        where-        lgMid = (lgDn + lgUp) `div` 2-        pwMid = pwDn * (b ^ (lgMid - lgDn))-            --{-|-    Directionally rounded versions of @+,*,sum,prod@.--}-plusUp, plusDown, timesUp, timesDown :: -    (Num t) =>-    t -> t -> t-divideUp, divideDown :: -    (Fractional t) =>-    t -> t -> t-sumUp, sumDown, productDown, productUp :: -    (Num t) =>-    [t] -> t-plusUp = (+)-plusDown c1 c2 = - ((- c1) - c2)-sumUp = foldl plusUp 0-sumDown = foldl plusDown 0-timesUp = (*)-timesDown c1 c2 = - ((- c1) * c2)-productUp = foldl timesUp 1-productDown = foldl timesDown 1-divideUp c1 c2 = c1 / c2-divideDown c1 c2 = - ((- c1) / c2)--{- parsing -}-readMaybe :: (Read a) => String -> Maybe a-readMaybe s =-    case reads s of-        [] -> Nothing-        (val,_) : _ -> Just val--showFirstLastLines ::-    (Show a) => -    Int {-^ how many initial lines to use -} -> -    Int {-^ how many final lines to use -} -> -    a -> -    String-showFirstLastLines lineCountInit lineCountFinal x -    | linesTotal > lineCount =-        unlines $ -            firstLines -            ++ ["...(" ++ show (linesTotal - lineCount) ++ " lines omitted)..."] ++-            lastLines-    | otherwise = unlines firstLines-    where-    lineCount = lineCountInit + lineCountFinal-    firstLines = take lineCountInit allLines-    lastLines = drop (linesTotal - lineCountFinal) allLines-    allLines = lines $ show x-    linesTotal = length allLines-    -{- sequences -}-listUpdate :: Int -> a -> [a] -> [a]-listUpdate i newx (x:xs) -    | i == 0 = newx : xs-    | i > 0 = x : (listUpdate (i - 1) newx xs) ---listHasMatch :: (a -> Bool) -> [a] -> Bool-listHasMatch f s =-    foldl (\b a -> b && (f a)) False s-    ---{-| types encoding natural numbers -}---class TypeNumber n---    where---    getTNData :: n---    getTNNumber :: n -> Int------data TN_0 = TN_0---tn_0 = TN_0---data TN_SUCC tn_prev = TN_SUCC tn_prev------type TN_ONE = TN_SUCC TN_0---tn_1 = TN_SUCC TN_0------instance (TypeNumber TN_0)---    where---    getTNData = TN_0---    getTNNumber _ = 0---    ---instance ---    (TypeNumber tn_prev) => ---    (TypeNumber (TN_SUCC tn_prev))---    where---    getTNData = TN_SUCC getTNData---    getTNNumber (TN_SUCC p) = 1 + (getTNNumber p)-
− src/Data/Number/ER/Misc/STM.hs 
@@ -1,42 +0,0 @@-{-|-    Module      :  Data.Number.ER.Misc.STM-    Description :  some STM extras -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    Miscelaneous utilities related to concurrency.--}-module Data.Number.ER.Misc.STM where--import Control.Concurrent as Concurrent-import Control.Concurrent.STM as STM--modifyTVar tv update =-    do-    value <- readTVar tv-    let newValue = update value-    writeTVar tv newValue-    return newValue--modifyTVarGetOldVal tv update =-    do-    value <- readTVar tv-    writeTVar tv $ update value-    return value--modifyTVarHasChanged tv update =-    do-    value <- readTVar tv-    let newValue = update value-    if value == newValue-        then return False-        else -            do-            writeTVar tv $ update value-            return True-    -
− src/Data/Number/ER/Misc/Tests.hs 
@@ -1,54 +0,0 @@-{-|-    Module      :  Data.Number.ER.Misc.Tests-    Description :  some QuickCheck extras -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    Miscelaneous utilities related to testing.--}-module Data.Number.ER.Misc.Tests --where--import Data.Number.ER.Misc--import Test.QuickCheck-import Test.QuickCheck.Batch--import System.IO--erRunTests testsetName options initialise tests =-    do-    mapM (mkRunTest $ length tests) $ zip [1..] tests-    return ()-    where-    mkRunTest testCount (n, (testName, test)) =-        do-        initialise-        putStr testDescr-        result <- test options-        putStrLn $ "  result: " ++ show result---        runTests testDescr options [test]-        hFlush stdout-        where-        testDescr = -            "(" ++ show n ++ "/" ++ show testCount ++ ") " ++ testsetName ++ ": " ++ testName ++ "\n" --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-
− src/Data/Number/ER/Real.hs 
@@ -1,76 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real-    Description :  overview of AERN-Real-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  non-portable (requires fenv.h)--    This module bundles some of the most important functionality-    of the AERN-Real package.  It is intended to be imported *qualified*.--    AERN-Real provides-    datatypes and abstractions for approximating exact real numbers-    and a basic arithmetic over such approximations.  The approach is-    inspired to some degree by Mueller's iRRAM and Lambov's RealLib-    (both are C++ libraries for exact real arithmetic).-    -    Abstractions are provided via 4 type classes:-     -     * 'B.ERRealBase': generalises floating point numbers-        (not exported here, used only internally)-        -     * 'ERApprox': generalises measurable subsets of real numbers-     -     * 'ERIntApprox': generalises interval neighbourhoods of real numbers--     * 'ERApproxElementary': generalises real number approximations -        that support elementary operations--    For ERRealBase we give several implementations.  The default is -    an arbitrary precision floating point type that uses Double-    for lower precisions and an Integer-based simulation for higher-    precisions.  Rational numbers can be used as one of the alternatives.-    Augustsson's Data.Number.BigFloat can be easily wrapped as an instance-    of ERRealBase except that it uses a different method to control precision.-    Optionally, one can also have MPFR floating point numbers via package-    hmpfr if compiled with USE_MPFR.-    -    ERIntApprox is implemented via outwards-rounded arbitrary precision interval arithmetic.  -    Any instance of ERRealBase can be used for the endpoints of the intervals.-    -    ERApproxElementary is implemented generically for any implementation-    of ERIntApprox.  This way some of the most common elementary operations are provided, -    notably: sqrt, exp, log, sin, cos, atan.  These operations converge -    to an arbitrary precision and also work well over larger intervals without-    excessive wrapping.-    -    There is also some support for generic Taylor series, interval Newton method-    and simple numerical integration.-    --}-module Data.Number.ER.Real -(-    module Data.Number.ER.Real.Approx,-    module Data.Number.ER.Real.Approx.Elementary,-    module Data.Number.ER.Real.DefaultRepr,-    module Data.Number.ER.Real.Approx.Sequence,-    module Data.Number.ER.Real.Arithmetic.Taylor,-    module Data.Number.ER.Real.Arithmetic.Newton,-    module Data.Number.ER.Real.Arithmetic.Integration,-    module Data.Number.ER.BasicTypes-)-where--import Data.Number.ER.Real.DefaultRepr-import Data.Number.ER.BasicTypes-import qualified Data.Number.ER.Real.Base as B-import Data.Number.ER.Real.Approx-import Data.Number.ER.Real.Approx.Elementary-import Data.Number.ER.Real.Approx.Sequence-import Data.Number.ER.Real.Arithmetic.Taylor-import Data.Number.ER.Real.Arithmetic.Newton-import Data.Number.ER.Real.Arithmetic.Integration-
− src/Data/Number/ER/Real/Approx.hs 
@@ -1,421 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Approx-    Description :  classes abstracting exact reals-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Definitions of classes that describe what is-    required from arbitrary precision approximations-    of exact real numbers.-    -    We introduce two levels of abstraction for these-    approximations:-    -        * 'ERApprox' = -            Approximating a real number by a *set* of real numbers-            that includes the approximated number.            -            Precision is measured using some fixed measure on the sets.-            Operations are "safe" wrt inclusion.-            The sets can sometimes be "anti-consistent" - being smaller than-            the empty set in the inclusion order.-                    -        * 'ERInnerOuterApprox' = -            Like 'ERApprox' with the addition of operations that are "inner rounded"-            in the sense that each element of the rounded result set can -            be obtained by the same operation performed on some elements of the arument set(s).--        * 'ERIntApprox' =-            Like ERApprox but assuming that the sets are -            *intervals* of real numbers with finitely-            representable endpoints.-    -    To be imported qualified, usually with the synonym RA.--}-module Data.Number.ER.Real.Approx-(-    ERApprox(..),-    eqSingletons,-    leqSingletons,-    ltSingletons,-    effIx2ra,-    ERInnerOuterApprox(..),-    ERIntApprox(..),-    splitIRA,-    equalIntervals,-    exactMiddle,-    maxExtensionR2R,-    maxExtensionInnerR2R,-    ERApproxApprox(..)-)-where--import Data.Number.ER.BasicTypes-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI--import Data.Typeable--{-|-    A type whose elements represent sets that can be used-    to approximate a single extended real number with arbitrary precision.--    Operations are "safe" with respect to inclusion, which means that-    for any numbers admitted by the operand approximations the result-    of the operation is admitted by the result approximation.-   -    The sets can sometimes be "anti-consistent" - being smaller than-    the empty set in the inclusion order.  -    This can be understood as indicating that not only there is no correct real number-    approximated here, but some numbers (ie those in interior of the set)-    are excluded more strongly than the others.-    Prime examples of such sets are directed "inverted" intervals such as [2,1].  -    Such sets arise naturally from "inner rounded" operations - see 'ERInnerOuterApprox'.--}-class (Fractional ra) => ERApprox ra -	where-    initialiseBaseArithmetic :: ra -> IO ()-    getPrecision :: ra -> Precision -    {-^ -            Precision is a measure of the set size.  It can be infinite.-            -            The default interpretation:-            -            * If the diameter of the set is d, then the precision-            should be near floor(- log_2 d).-    -}-    getGranularity :: ra -> Granularity-    -- ^ the lower the granularity the bigger the rounding errors-    setGranularityOuter :: Granularity -> ra -> ra-    -- ^ increase or safely decrease granularity-    setMinGranularityOuter :: Granularity -> ra -> ra-    -- ^ ensure granularity is not below the first arg-    isBottom :: ra -> Bool -    -- ^ true if this approximation holds no information, ie it admits any real number -    bottomApprox :: ra -    -- ^ the bottom approximation - it admits any real number-    isExact :: ra -> Bool -    -- ^ true if this approximation admits only one real number-    isConsistent :: ra -> Bool-    {- ^ true iff this approximation admits at least one real number -}-    isAnticonsistent :: ra -> Bool-    {- ^ true if this approximation is anti-consistent, which is a computational error -         unless we used inner rounded operations -}-    toggleConsistency :: ra -> ra-    {- ^ -        Toggle consistency - anti-consistency of the approximation. -        Top is toggled with bottom.  -        Exact approximations are the only fixed points for this operation.-    -} -    isTop :: ra -> Bool-    -- ^ true if this approximation is the most anti-consistent one-    topApprox :: ra -    -- ^ the top approximation - strongly rejects all real numbers-    isDisjoint :: ra -> ra -> Bool-    isDisjoint a b = not $ isConsistent $ a /\ b-    isInteriorDisjoint :: ra -> ra -> Bool-    isInteriorDisjoint a b = isAnticonsistent $ a /\ b-    isBounded :: ra -> Bool-    {- ^ -        True iff the approximation excludes infinity-        and, if anti-consistent, does not strongly exclude infinity.-    -}-    plusInfinity :: ra-    -- ^ an exact approximation admitting only the positive infinity-    refines :: ra -> ra -> Bool -    -- ^ first arg is a subset of the second arg-    maybeRefines :: ra -> ra -> Maybe Bool -    -- ^ like 'refines' but usable for types where 'refines' is only partially decidable-    (/\) :: ra -> ra -> ra -    -- ^ join; combining the information in two approximations of the same number-    intersectMeasureImprovement ::-        EffortIndex -> ra -> ra -> (ra, ra)-    {-^ -            First component of result is the intersection and the second component:-            -             * measures precision improvement of the intersection relative to the first argument-             -             * is a positive number: 1 means no improvement, 2 means doubled precision, etc. -    -}-    equalReals :: ra -> ra -> Maybe Bool-    -- ^ semantic semi-decidable equality test-    compareReals :: ra -> ra -> Maybe Ordering-    -- ^ semantic semi-decidable comparison-    leqReals :: ra -> ra -> Maybe Bool-    -- ^ semantic semi-decidable less-than-or-equal comparison-    equalApprox :: ra -> ra -> Bool-    -- ^ syntactic equality test-    compareApprox :: ra -> ra -> Ordering-    -- ^ syntactic linear ordering-    double2ra :: Double -> ra-    -- ^ safe approximate conversion-    showApprox :: -        Int {-^ number of relevant decimals to show -} ->-        Bool {-^ should show granularity -} ->-        Bool {-^ should show internal representation details -} ->-        ra {-^ the approximation to show -} ->-        String-    -{-|-    Assuming the arguments are singletons, equality is decidable.--}-eqSingletons :: (ERApprox ra) => ra -> ra -> Bool-eqSingletons s1 s2 =  -    case equalReals s1 s2 of -        Just b -> b-        _ -> False --{-|-    Assuming the arguments are singletons, @<=@ is decidable.--}-leqSingletons :: (ERApprox ra) => ra -> ra -> Bool-leqSingletons s1 s2 =  -    case compareReals s1 s2 of -        Just EQ -> True-        Just LT -> True-        _ -> False -        -{-|-    Assuming the arguments are singletons, @<@ is decidable.--}-ltSingletons :: (ERApprox ra) => ra -> ra -> Bool-ltSingletons s1 s2 =  -    case compareReals s1 s2 of -        Just LT -> True-        _ -> False -        -{-|    -    This function converts-    an effort index to a real number approximation.-    -    Useful when an effort index is used in a formula-    mixed with real approximations.  --}-effIx2ra :: -    (ERApprox ra) =>-    EffortIndex -> ra-effIx2ra = fromInteger . toInteger--{-|-    A type whose elements represent some kind of nominal sets of real numbers-    over which one can perform two kinds of arithmetic:-   -    * "outer rounded": arithmetic that approximates maximal extensions from outside (ie the 'ERApprox' arithmetic)-   -    * "inner rounded": arithmetic that approximates maximal extensions from inside, potentially leading to-      anti-consistent set specifications (eg intervals whose endpoints are not in the usual order)--    Another explanation of the difference:--    * `outer': the approximation contains all the number(s) of interest-    * `inner': all numbers eligible for the approximation are numbers of interest--    Ie inner rounded operations have the property that each real number admitted by the result can-    be obtained as the exact result of the same operation performed on some real numbers admitted-    by the operand approximations.-    -    While in "outer rounded" operations it is desirable to make the result set as small as-    possible in order to reduce the amount of bogus result numbers, -    in "inner rounded" operations it is desirable to make the result set as large as possible-    to lose less of the genuinely feasible result numbers.-     -    Inner rounded arithmetic is useful eg for proving/disproving inclusions "f(x) subset g(x)"-    where f and g are expressions using arithmetic extended to sets.-    For proving the inclusion, we need an inner rounded approximation of g(x)-    and for disproving the inclusion we need an inner rounded approximation of f(x).-   -    This is an abstraction of Kaucher's extended interval arithmetic    -    [Kaucher, E.: Interval Analysis in the Extended Interval Space IR, -     Computing, Suppl. 2, 1980, pp. 33-49].--}-class (ERApprox xra) => ERInnerOuterApprox xra -    where-    (+:) :: xra -> xra -> xra-    -- ^ inner rounded addition-    (-:) :: xra -> xra -> xra-    -- ^ inner rounded subtraction-    a -: b = a +: (negate b)-    (*:) :: xra -> xra -> xra-    -- ^ inner rounded multiplication-    (/:) :: xra -> xra -> xra-    -- ^ inner rounded division-    setGranularityInner :: Granularity -> xra -> xra-    -- ^ increase or safely decrease granularity-    setMinGranularityInner :: Granularity -> xra -> xra-    -- ^ ensure granularity is not below the first arg--{-|-   A type whose elements represent sets that can be used-   to approximate a recursive set of closed extended real number intervals -   with arbitrary precision.--}---class (ERApprox sra) => ERSetApprox sra where---    (\/) :: sra -> sra -> sra -- ^ union; either approximation could be correct--{-|-   A type whose elements represent real *intervals* that can be used-   to approximate a single extended real number with arbitrary precision.--   Sometimes, these types can be used to approximate -   a closed extended real number interval with arbitrary precision.-   Nevetheless, this is not guaranteed.--}-class (ERApprox ira) => ERIntApprox ira -    where-    doubleBounds :: ira -> (Double, Double) -    floatBounds :: ira -> (Float, Float)-    integerBounds :: ira -> (EI.ExtendedInteger, EI.ExtendedInteger)-    bisectDomain :: -        Maybe ira {-^ point to split at -} -> -        ira {-^ interval to split -} -> -        (ira, ira) -- ^ left and right, overlapping on a singleton-    defaultBisectPt :: ira -> ira-    -- | returns thin approximations of endpoints, in natural order -    bounds :: ira -> (ira, ira)-    -- | make an interval from thin approximations of endpoints -    fromBounds :: (ira, ira) -> ira-    {-|-         meet, usually constructing interval from approximations of its endpoints-         -         This does not need to be the meet of the real intervals -         but it has to be a maximal element in the set of all-         ira elements that are below the two parameters.-    -}-    (\/) :: ira -> ira -> ira-    -{-|-    Return true if and only if the two intervals have equal endpoints.--}-equalIntervals ::-    (ERIntApprox ira) => ira -> ira -> Bool-equalIntervals d1 d2 =-    d1L == d2L && d1U == d2U-    where-    (==) = eqSingletons-    (d1L, d1U) = bounds d1-    (d2L, d2U) = bounds d2---{-|-    Split an interval to a sequence of intervals whose union is the-    original interval using a given sequence of cut points.-    The cut points are expected to be in increasing order and contained-    in the given interval.  Violations of this rule are tolerated.--}-splitIRA ::-    (ERIntApprox ira) =>-    ira {-^ an interval to be split -} -> -    [ira] {-^ approximations of the cut points in increasing order -} -> -    [ira]-splitIRA interval splitPoints =-    doSplit [] end pointsRev-    where-    (start, end) = bounds interval-    pointsRev = reverse $ start : splitPoints-    doSplit previousSegments nextRight [] = previousSegments-    doSplit previousSegments nextRight (nextLeft : otherPoints) =-        doSplit (nextLeft \/ nextRight : previousSegments) nextLeft otherPoints--{-|-    * Return the endpoints of the interval as well as the exact midpoint.-    -    * To be able to do this, there may be a need to increase granularity.-    -    * All three singleton intervals are set to the same new granularity.--}        -exactMiddle ::-    (ERIntApprox ira) =>-    ira ->-    (ira,ira,ira,Granularity)-exactMiddle dom =-    case isExact domM of-        True ->-            (domL, domM, domR, gran)-        False ->-            (domLhg, domMhg, domRhg, higherGran)-    where-    (domL, domR) = bounds dom-    gran = max (getGranularity domL) (getGranularity domR)-    domM = (domL + domR) / 2-    higherGran = gran + 1-    domLhg = setMinGranularityOuter higherGran domL-    domRhg = setMinGranularityOuter higherGran domR-    domMhg = (domLhg + domRhg) / 2-     -        -{-| -    This produces a function that computes the maximal extension of the-    given function.  A maximal extension function has the property:-    f(I) = { f(x) | x in I }.  Here we get this property only for the-    limit function for its 'EffortIndex' tending to infinity.-    For finite effor indices the function may add *outer* rounding-    but it should be reasonably small.--}-maxExtensionR2R ::-    (ERIntApprox ira) =>-    (EffortIndex -> ira -> [ira]) -        {-^ returns an *outer* approximation of all extrema within the interval -} ->-    (EffortIndex -> ira -> ira) -        {-^ an *outer* rounding function behaving well on sequences that intersect to a point -} ->-    (EffortIndex -> ira -> ira) -        {- ^ an outer rounding function behaving well on sequences that intersect to a non-empty interval -}-maxExtensionR2R getExtremes f ix x-    | not $ isConsistent x =-        toggleConsistency $-            maxExtensionInnerR2R getExtremes f ix $ toggleConsistency x -    | getPrecision x < effIx2prec ix =-        foldl1 (\/) $ [f ix xL, f ix xR] ++ (getExtremes ix x)-    -- x is thin enough (?), don't bother evaluating by endpoints and extrema:-    | otherwise =-        f ix x-    where-    (xL, xR) = bounds x-        -{-| -    This produces a function that computes the maximal extension of the-    given function.  A maximal extension function has the property:-    f(I) = { f(x) | x in I }.  Here we get this property only for the-    limit function for its 'EffortIndex' tending to infinity.-    For finite effor indices the function may include *inner* rounding-    but it should be reasonably small.--}-maxExtensionInnerR2R ::-    (ERIntApprox ira) =>-    (EffortIndex -> ira -> [ira]) -        {-^ returns an *outer* approximation of all extrema within the interval -} ->-    (EffortIndex -> ira -> ira) -        {-^ an *outer* rounding function behaving well on sequences that intersect to a point -} ->-    (EffortIndex -> ira -> ira) -        {- ^ an inner rounding function behaving well on sequences that intersect to a non-empty interval -}-maxExtensionInnerR2R getExtremes f ix x-    | not $ isConsistent x =-        toggleConsistency $-            maxExtensionR2R getExtremes f ix $ toggleConsistency x-    | otherwise =-        foldl1 (\/) $ map toggleConsistency $ [f ix xL, f ix xR] ++ (getExtremes ix x)-    where-    (xL, xR) = bounds x-        -{-|-   A type whose elements are thought of as sets of approximations of real numbers.-   -   Eg intervals of intervals, eg [[0,3],[1,2]] containing all intervals-   whose left endpoint is between 0 and 1 and the right endpoint is between 2 and 3.-   The upper bound interval can sometimes be anti-consistent,-   eg [[0,3],[2,1]] containing all intervals (consistent as well as anti-consistent) -   with a left endpoint between [0,2] and the right endpoint between [1,3].--}-class ERApproxApprox xra -    where-    safeIncludes :: xra -> xra -> Bool-    -- ^ safe inclusion of approximations-    safeNotIncludes :: xra -> xra -> Bool-    -- ^ safe negation of inclusion of approximations-    includes :: xra -> xra -> Maybe Bool-    -- ^ like 'safeIncludes' but usable for types where 'safeIncludes' is only partially decidable-    includes aa1 aa2 -        | safeIncludes aa1 aa2 = Just True-        | safeNotIncludes aa1 aa2 = Just False-        | otherwise = Nothing
− src/Data/Number/ER/Real/Approx/Elementary.hs 
@@ -1,96 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Approx.Elementary-    Description :  abstraction of exact reals capable of elementary operations-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-        -    To be imported qualified, usually with the synonym RAEL.--}-module Data.Number.ER.Real.Approx.Elementary -(-    ERApproxElementary(..),-    ERInnerOuterApproxElementary(..)-)-where--import Prelude hiding (exp, log, sin, cos)--import qualified Data.Number.ER.Real.Approx as RA -import Data.Number.ER.Real.Approx ((+:),(-:),(*:),(/:)) -import Data.Number.ER.BasicTypes--import Data.Number.ER.Real.Arithmetic.Elementary--{-|-    A class defining various common real number operations-    in a approximation-aware fashion, ie introducing effort indices.-    -    All operations here have default implementations based on-    "Data.Number.ER.Real.Arithmetic.Elementary".--}-class (RA.ERIntApprox ra, Ord ra) => (ERApproxElementary ra) -    where-    abs :: EffortIndex -> ra -> ra-    abs ix = Prelude.abs-    min :: EffortIndex -> ra -> ra -> ra-    min ix = Prelude.min-    max :: EffortIndex -> ra -> ra -> ra-    max ix = Prelude.max-    sqrt :: EffortIndex -> ra -> ra-    sqrt = erSqrt_IR-    exp :: EffortIndex -> ra -> ra-    exp = erExp_IR-    log :: EffortIndex -> ra -> ra-    log = erLog_IR-    (**) :: EffortIndex -> ra -> ra -> ra-    (**) ix b e = exp ix $ e * (log ix b)-    pi :: EffortIndex -> ra-    pi = erPi_R-    sin :: EffortIndex -> ra -> ra-    sin = erSine_IR-    cos :: EffortIndex -> ra -> ra-    cos = erCosine_IR-    tan :: EffortIndex -> ra -> ra-    tan ix r = (sin ix r) / (cos ix r) -    atan :: EffortIndex -> ra -> ra-    atan = erATan_IR-    -{-|-    A class defining various common real number operations-    in a approximation-aware fashion, ie introducing effort indices.-    -    All operations here have default implementations based on-    "Data.Number.ER.Real.Arithmetic.Elementary".--}-class (RA.ERIntApprox ra, RA.ERInnerOuterApprox ra, Ord ra) => (ERInnerOuterApproxElementary ra) -    where-    absInner :: EffortIndex -> ra -> ra-    absInner ix = Prelude.abs-    minInner :: EffortIndex -> ra -> ra -> ra-    minInner ix = Prelude.min-    maxInner :: EffortIndex -> ra -> ra -> ra-    maxInner ix = Prelude.max-    sqrtInner :: EffortIndex -> ra -> ra-    sqrtInner = erSqrt_IR_Inner-    expInner :: EffortIndex -> ra -> ra-    expInner = erExp_IR_Inner-    logInner :: EffortIndex -> ra -> ra-    logInner = erLog_IR_Inner-    (**:) :: EffortIndex -> ra -> ra -> ra-    (**:) ix b e = expInner ix $ e *: (logInner ix b)-    sinInner :: EffortIndex -> ra -> ra-    sinInner = erSine_IR_Inner-    cosInner :: EffortIndex -> ra -> ra-    cosInner = erCosine_IR_Inner-    tanInner :: EffortIndex -> ra -> ra-    tanInner ix r = (sinInner ix r) /: (cosInner ix r) -    atanInner :: EffortIndex -> ra -> ra-    atanInner = erATan_IR_Inner-    -    -    -
− src/Data/Number/ER/Real/Approx/Interval.hs 
@@ -1,574 +0,0 @@-{-# LANGUAGE DeriveDataTypeable   #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE FlexibleInstances  #-}-{-|-    Module      :  Data.Number.ER.Real.Approx.Interval-    Description :  safe interval arithmetic-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    This module defines an arbitrary precision interval type and-    most of its interval arithmetic operations.--}-module Data.Number.ER.Real.Approx.Interval -(-    ERInterval(..),-    normaliseERIntervalOuter,-    normaliseERIntervalInner-)-where--import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.Real.Approx ((+:),(-:),(*:),(/:))-import qualified Data.Number.ER.Real.Approx.Elementary as RAEL-import qualified Data.Number.ER.Real.Base as B-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI--import Data.Number.ER.BasicTypes-import Data.Number.ER.Misc--import Data.Ratio--import qualified Text.Html as H--import Data.Typeable-import Data.Generics.Basics-import Data.Binary---import BinaryDerive--{-|-    Type for arbitrary precision interval arithmetic.--}-data ERInterval base =---    ERIntervalEmpty -- ^ usually represents computation error (top element in the interval domain)---    | ERIntervalAny  -- ^ represents no knowledge of result (bottom element in the interval domain) -    ERInterval-    {-        erintv_left :: !base,-        erintv_right :: !base-    }-    deriving (Typeable, Data)-    -{- the following has been generated by BinaryDerive -}-instance (Binary a) => Binary (ERInterval a) where-  put (ERInterval a b) = putWord8 0 >> put a >> put b-  get = do-    tag_ <- getWord8-    case tag_ of-      0 -> get >>= \a -> get >>= \b -> return (ERInterval a b)-      _ -> fail "no parse"-{- the above has been generated by BinaryDerive -}-    -    -{-|-    convert to a normal form, ie:-    -    * no NaNs as endpoints-    -    Note that inverted intervals are fully supported using Warmus-Kaucher arithmetic.-    This version interprets NaN's as bottomApprox. --}-normaliseERIntervalOuter :: -    (B.ERRealBase b) => -    ERInterval b -> ERInterval b-normaliseERIntervalOuter (ERInterval nan1 nan2) -    | B.isERNaN nan1 && B.isERNaN nan2 =-        RA.bottomApprox-normaliseERIntervalOuter (ERInterval nan r) -    | B.isERNaN nan = -        ERInterval (- B.plusInfinity) r-normaliseERIntervalOuter (ERInterval l nan) -    | B.isERNaN nan = -        ERInterval l (B.plusInfinity)-normaliseERIntervalOuter i = i--{-|-    convert to a normal form, ie:-    -    * no NaNs as endpoints-    -    Note that inverted intervals are fully supported using Warmus-Kaucher arithmetic.-    This version interprets NaN's as topApprox. --}-normaliseERIntervalInner :: -    (B.ERRealBase b) => -    ERInterval b -> ERInterval b-normaliseERIntervalInner (ERInterval nan1 nan2) -    | B.isERNaN nan1 && B.isERNaN nan2 =-        RA.topApprox-normaliseERIntervalInner (ERInterval nan r) -    | B.isERNaN nan = -        ERInterval (B.plusInfinity) r-normaliseERIntervalInner (ERInterval l nan) -    | B.isERNaN nan = -        ERInterval l (- B.plusInfinity)-normaliseERIntervalInner i = i--{-|-    erintvPrecision returns an approximation of the number of bits required-    to represent the mantissa of a normalised size of the interval:-  -  >  - log_2 ((r - l) / (1 + abs(r) + abs(l)))-    -    Notice that this is +Infty for singleton and anti-consistent intervals-    and -Infty for unbounded intervals.--}    -erintvPrecision :: -    (B.ERRealBase b) => -    ERInterval b -> EI.ExtendedInteger-erintvPrecision i@(ERInterval l r)-    | not $ RA.isConsistent i = EI.PlusInfinity-    | not $ RA.isBounded i = EI.MinusInfinity-    | otherwise = -        -1 - (B.getApproxBinaryLog $ (r - l)) -- /(1 + abs r + abs l))--erintvGranularity :: -    (B.ERRealBase b) => -    ERInterval b -> Int-erintvGranularity (ERInterval l r) =-    min (B.getGranularity l) (B.getGranularity r)--{- syntactic comparisons -}--{-|-    a syntactic equality test--}-erintvEqualApprox :: -    (B.ERRealBase b) => -    ERInterval b -> ERInterval b -> Bool-erintvEqualApprox (ERInterval l1 r1) (ERInterval l2 r2) =-    l1 == l2 && r1 == r2--{-|-    a syntactic linear order--}-erintvCompareApprox :: -    (B.ERRealBase b) => -    ERInterval b -> ERInterval b -> Ordering-erintvCompareApprox (ERInterval l1 r1) (ERInterval l2 r2) =-    case compare l1 l2 of-        EQ -> compare r1 r2-        res -> res--{- semantic comparisons -}--{-|-    Compare for equality two intervals interpreted as approximations for-    2 single real numbers.  When equality or inequality cannot-    be established, return Nothing (ie bottom).--}-erintvEqualReals ::-    (B.ERRealBase b) =>-    ERInterval b ->-    ERInterval b ->-    Maybe Bool-erintvEqualReals (ERInterval l1 r1) (ERInterval l2 r2)-    | l1 == r1 && l2 == r2 && l1 == l2 = Just True-    | r1 < l2 || l1 > r2 = Just False-    | otherwise = Nothing--{-|-    Compare in natural order two intervals interpreted as approximations for-    2 single real numbers.  When equality or inequality cannot-    be established, return Nothing (ie bottom).--}-erintvCompareReals ::-    (B.ERRealBase b) =>-    ERInterval b ->-    ERInterval b ->-    Maybe Ordering-erintvCompareReals i1@(ERInterval l1 r1) i2@(ERInterval l2 r2)-    | r1 < l2 = Just LT-    | l1 > r2 = Just GT-    | l1 == r1 && l2 == r2 && l1 == l2 = Just EQ-    | otherwise = Nothing--{-|-    Compare in natural order two intervals interpreted as approximations for-    2 single real numbers.  When relaxed equality cannot-    be established nor disproved, return Nothing (ie bottom).--}-erintvLeqReals ::-    (B.ERRealBase b) =>-    ERInterval b ->-    ERInterval b ->-    Maybe Bool-erintvLeqReals i1@(ERInterval l1 r1) i2@(ERInterval l2 r2)-    | r1 <= l2 = Just True-    | l1 > r2 = Just False-    | otherwise = Nothing---{-|-    -    Default splitting:--    > [-Infty,+Infty] |-> [-Infty,0] [0,+Infty] -    -    > [-Infty,x] |-> [-Infty,2*x-1] [2*x-1, x] (x <= 0)-    -    > [-Infty,x] |-> [-Infty,0] [0, x] (x > 0)-    -    > [x,+Infty] |-> [x,2*x+1] [2*x+1,+Infty]  (x => 0)-    -    > [x,+Infty] |-> [x,0] [0,+Infty]  (x < 0)-    -    > [x,y] |-> [x, (x+y)/2] [(x+y)/2, y]-    -    > empty |-> empty empty--}-erintvDefaultBisectPt ::-    (B.ERRealBase b) => -    Granularity -> -    (ERInterval b) ->-    (ERInterval b)-erintvDefaultBisectPt gran (ERInterval l r) = -    ERInterval m m-    where-    m = -        case (B.isMinusInfinity l, B.isPlusInfinity r, B.isPlusInfinity l, B.isMinusInfinity r) of-            (True, True, _, _) -> 0 -- [-oo,+oo] -            (True, _,_,True) -> B.minusInfinity -- [-oo,-oo]-            (_, True,True,_) -> B.plusInfinity -- [+oo,+oo]-            (True, _,_,_) | r > 0 -> 0 -            (True, _,_,_) -> 2 * (B.setMinGranularity gran r) - 1-            (_,True,_,_) | l < 0 -> 0 -            (_,True,_,_) -> 2 * (B.setMinGranularity gran l) + 1  -            (_,_,True,_) | r < 0 -> 0 -            (_,_,True,_) -> 2 * (B.setMinGranularity gran r) + 1-            (_,_,_,True) | l > 0 -> 0 -            (_,_,_,True) -> 2 * (B.setMinGranularity gran l) - 1  -            _ -> ((B.setMinGranularity gran l) + r)/2 -- no infinities-    --erintvBisect ::-    (B.ERRealBase b) => -    Granularity -> -    (Maybe (ERInterval b)) ->-    (ERInterval b) ->-    (ERInterval b, ERInterval b)-erintvBisect gran maybePt i@(ERInterval l r) =-    (ERInterval l mR, ERInterval mL r)-    where-    ERInterval mL mR = m-    m =-        case maybePt of-            Just m -> m-            Nothing -> erintvDefaultBisectPt gran i --instance (B.ERRealBase b) => Eq (ERInterval b) where-    i1 == i2 =-        case erintvEqualReals i1 i2 of-            Nothing -> -                error $-                     "ERInterval: Eq: comparing overlapping intervals:\n" ++-                    show i1 ++ "\n" ++-                    show i2-            Just b -> b--instance (B.ERRealBase b) => Ord (ERInterval b) where-    compare i1 i2 = -        case erintvCompareReals i1 i2 of-            Nothing -> -                error $ -                    "ERInterval: Ord: comparing overlapping intervals:\n" ++-                    show i1 ++ "\n" ++-                    show i2-            Just r -> r-    {- max:-       (Default implementation is wrong in this case:-        eg compare is not defined for overlapping intervals.)-    -}-    max i1@(ERInterval l1 r1) i2@(ERInterval l2 r2) =-        ERInterval (max l1 l2) (max r1 r2)-    {- min: -}-    min i1@(ERInterval l1 r1) i2@(ERInterval l2 r2) =-        ERInterval (min l1 l2) (min r1 r2)-        -instance (B.ERRealBase b) => Show (ERInterval b) -    where-    show = erintvShow 16 True False-    -erintvShow numDigits showGran showComponents interval =-    showERI interval-    where-    showERI (ERInterval l r)-        | (B.isMinusInfinity r) && (B.isPlusInfinity r) =-            "[ANY]" -        | l == r = "<" ++ showBase l ++ ">"-        | l > r =-            "[!" ++ showBase l ++ "," ++ showBase r ++ "!]"-        | otherwise = -            "[" ++ showBase l ++ "," ++ showBase r ++ "]"-    showBase = B.showDiGrCmp numDigits showGran showComponents-        -instance (B.ERRealBase b, H.HTML b) => H.HTML (ERInterval b)-    where-    toHtml (ERInterval l r) -        | l == r =-            H.toHtml $ show l-        | otherwise =-            H.simpleTable [] [] [[H.toHtml l],[H.toHtml r]]--instance (B.ERRealBase b) => Num (ERInterval b) where-    fromInteger n =-        ERInterval (B.fromIntegerDown n) (B.fromIntegerUp n)-    {- abs -}-    abs (ERInterval l r)-        | l <= 0 && r >= 0 = ERInterval 0 (max (-l) r)-        | l >= 0 && r <= 0 = ERInterval (max l (-r)) 0-        | r <= 0 = ERInterval (-r) (-l)-        | otherwise = ERInterval l r-    {- signum -}-    signum i@(ERInterval l r) =-        error "ER.Real.Approx.Interval: signum not implemented for ERInterval"---        | l < 0 && r > 0 = ERInterval (-1) 1 -- need many-valuedness via sequences of intervals---        | r < 0 = ERInterval (-1) (-1)---        | l > 0 = ERInterval 1 1---        | l == 0 && r == 0 = i---        | l == 0 = ERInterval 0 1---        | r == 0 = ERInterval (-1) 0-    {- negate -}-    negate (ERInterval l r) = (ERInterval (-r) (-l))-    {- addition -}-    i1@(ERInterval l1 r1) + i2@(ERInterval l2 r2) = -        normaliseERIntervalOuter $-            ERInterval (l1 `plusDown` l2) (r1 `plusUp` r2)-    {- multiplication -}-    i1@(ERInterval l1 r1) * i2@(ERInterval l2 r2) = -        normaliseERIntervalOuter $-             intervalTimes timesDown timesUp i1 i2--instance (B.ERRealBase b) => Fractional (ERInterval b) where-    fromRational rat =-        (fromInteger $ numerator rat)-        / (fromInteger $ denominator rat)-    {- division -}-    recip i@(ERInterval l r)-        | not $ RA.isConsistent i = -            RA.toggleConsistency $ -                1 /: (RA.toggleConsistency i)-        | 0 < l || r < 0 =-            normaliseERIntervalOuter $-                ERInterval (1 `divideDown` r) (1 `divideUp` l)-        | otherwise =-            RA.bottomApprox---instance (B.ERRealBase b) => RA.ERInnerOuterApprox (ERInterval b)-    where-    {- addition -}-    i1@(ERInterval l1 r1) +: i2@(ERInterval l2 r2) = -        normaliseERIntervalInner $-            ERInterval (l1 `plusUp` l2) (r1 `plusDown` r2)-    {- multiplication -}-    i1@(ERInterval l1 r1) *: i2@(ERInterval l2 r2) = -        normaliseERIntervalInner $-             intervalTimes timesUp timesDown i1 i2-    {- division -}-    i1@(ERInterval l1 r1) /: i2@(ERInterval l2 r2) -        | not $ RA.isConsistent i2 = -            (*:) i1 $-                RA.toggleConsistency $ -                    1 / (RA.toggleConsistency i2)-        | 0 < l2 || r2 < 0 = -            (*:) i1 $-                normaliseERIntervalInner $-                    ERInterval (1 `divideDown` r2) (1 `divideUp` l2)-        | otherwise =-            RA.bottomApprox-    {- setMinGranularityInner -}-    setMinGranularityInner gr (ERInterval l r) =-        normaliseERIntervalInner $-        (ERInterval (B.setMinGranularity gr l) (negate $ B.setMinGranularity gr (-r)))-    {- setGranularityInner -}-    setGranularityInner gr (ERInterval l r) =-        normaliseERIntervalInner $-        (ERInterval (B.setGranularity gr l) (negate $ B.setGranularity gr (- r)))--intervalTimes timesL timesR i1@(ERInterval l1 r1) i2@(ERInterval l2 r2) =-    ERInterval l r-    where-    (l,r) = -        case (compare l1 0, compare r1 0, l1 <= r1, compare l2 0, compare r2 0, l2 <= r2) of-            -- i1 negative, i2 positive-            (LT, LT, _, GT, GT, _) -> (l1 `timesL` r2, r1 `timesR` l2)-            -- i1 negative, i2 negative-            (LT, LT, _, LT, LT, _) -> (r1 `timesL` r2, l1 `timesR` l2)-            -- i1 negative, i2 consistent and containing zero-            (LT, LT, _, _, _, True) -> (l1 `timesL` r2, l1 `timesR` l2)-            -- i1 negative, i2 inconsistent and anti-containing zero-            (LT, LT, _, _, _, False) -> (r1 `timesL` r2, r1 `timesR` l2)-            -            -- i1 positive, i2 positive-            (GT, GT, _, GT, GT, _) -> (l1 `timesL` l2, r1 `timesR` r2)-            -- i1 positive, i2 negative-            (GT, GT, _, LT, LT, _) -> (r1 `timesL` l2, l1 `timesR` r2)-            -- i1 positive, i2 consistent and containing zero-            (GT, GT, _, _, _, True) -> (r1 `timesL` l2, r1 `timesR` r2)-            -- i1 positive, i2 inconsistent and anti-containing zero-            (GT, GT, _, _, _, False) -> (l1 `timesL` l2, l1 `timesR` r2)--            -- i1 consistent and containing zero, i2 positive-            (_, _, True, GT, GT, _) -> (l1 `timesL` r2, r1 `timesR` r2)-            -- i1 consistent and containing zero, i2 negative-            (_, _, True, LT, LT, _) -> (r1 `timesL` l2, l1 `timesR` l2)-            -- i1 consistent and containing zero, i2 consistent and containing zero-            (_, _, True, _, _, True) -> -                (l,r)-                where-                l | B.isERNaN l1r2 || B.isERNaN r1l2 = B.minusInfinity-                  | otherwise = min l1r2 r1l2-                  where-                  l1r2 = l1 `timesL` r2-                  r1l2 = r1 `timesL` l2-                r | B.isERNaN l1l2 || B.isERNaN r1r2 = B.plusInfinity-                  | otherwise = max l1l2 r1r2-                  where-                  l1l2 = l1 `timesR` l2-                  r1r2 = r1 `timesR` r2-            -- i1 consistent and containing zero, i2 inconsistent and anti-containing zero-            (_, _, True, _, _, False) -> (0, 0)--            -- i1 inconsistent and anti-containing zero, i2 positive -            (_, _, False, GT, GT, _) -> (l1 `timesL` l2, r1 `timesR` l2)-            -- i1 inconsistent and anti-containing zero, i2 negative -            (_, _, False, LT, LT, _) -> (r1 `timesL` r2, l1 `timesR` r2)-            -- i1 inconsistent and anti-containing zero, i2 consistent and containing zero -            (_, _, False, _, _, True) -> (0, 0) -            -- i1 inconsistent and anti-containing zero, i2 the same -            (_, _, False, _, _, False) ->-                (l,r)-                where-                l | B.isERNaN l1l2 || B.isERNaN r1r2 = B.plusInfinity-                  | otherwise = max l1l2 r1r2-                  where-                  l1l2 = l1 `timesL` l2-                  r1r2 = r1 `timesL` r2-                r | B.isERNaN l1r2 || B.isERNaN r1l2 = B.minusInfinity-                  | otherwise = min l1r2 r1l2-                  where-                  l1r2 = l1 `timesR` r2-                  r1l2 = r1 `timesR` l2---     -            -instance (B.ERRealBase b) => RA.ERApprox (ERInterval b) where-    initialiseBaseArithmetic _ =-        B.initialiseBaseArithmetic (0 :: b)-    getPrecision i = erintvPrecision i-    getGranularity i = erintvGranularity i-    {- setMinGranularity -}-    setMinGranularityOuter gr (ERInterval l r) =-        normaliseERIntervalOuter $-        (ERInterval (- (B.setMinGranularity gr (-l))) (B.setMinGranularity gr r))-    {- setGranularity -}-    setGranularityOuter gr (ERInterval l r) =-        normaliseERIntervalOuter $-        (ERInterval (- (B.setGranularity gr (-l))) (B.setGranularity gr r))-    {- isBottom -}-    isBottom (ERInterval l r) =-        B.isMinusInfinity l && B.isPlusInfinity r-    {- bottomApprox -}-    bottomApprox = -        ERInterval B.minusInfinity B.plusInfinity-    {- isExact -}-    isExact (ERInterval l r) = l == r-    {- isConsistent -}-    isConsistent (ERInterval l r) = l <= r-    {- isAnticonsistent -}-    isAnticonsistent (ERInterval l r) = l >= r-    {- toggleConsistency -}-    toggleConsistency (ERInterval l r) = (ERInterval r l)-    {- isTop -}-    isTop (ERInterval l r) =-        B.isPlusInfinity l && B.isMinusInfinity r-    {- topApprox -}-    topApprox =-        ERInterval B.plusInfinity B.minusInfinity-    {- isBounded -}-    isBounded (ERInterval l r) = -        (- B.plusInfinity) < l && l < B.plusInfinity-        &&-        (- B.plusInfinity) < r && r < B.plusInfinity-    {- plusInfinity -}-    plusInfinity = ERInterval B.plusInfinity B.plusInfinity  -    {- refines -}-    refines (ERInterval l1 r1) (ERInterval l2 r2) =-        l2 <= l1 && r1 <= r2-    {- maybeRefines -}-    maybeRefines i1 i2 = Just $ RA.refines i1 i2-             -    {- intersection -}-    (ERInterval l1 r1) /\ (ERInterval l2 r2) =-        ERInterval (max l1 l2) (min r1 r2)-    {- intersectMeasureImprovement -}-    intersectMeasureImprovement ix i1 i2 =-        (isec, impr)-        where-        isec = i1 RA./\ i2-        impr -            | 0 `RA.refines` isecWidth && 0 `RA.refines` i1Width = 1 -- 0 -> 0 is no improvement-            | otherwise = i1Width / isecWidth -        i1Width = i1H - i1L-        isecWidth = isecH - isecL-        (isecL, isecH) = RA.bounds $ RA.setMinGranularityOuter gran isec  -        (i1L, i1H) = RA.bounds $ RA.setMinGranularityOuter gran i1-        gran = effIx2gran ix-          -    {- semantic comparisons -}-    equalReals = erintvEqualReals-    compareReals = erintvCompareReals-    leqReals = erintvLeqReals-    {- non-semantic comparisons -}-    equalApprox = erintvEqualApprox-    compareApprox = erintvCompareApprox-    {- conversion from Double -}-    double2ra d = -        ERInterval b b-        where-        b = B.fromDouble d-    {- formatting -}-    showApprox = erintvShow--instance (B.ERRealBase b) => RA.ERIntApprox (ERInterval b)-    where-    doubleBounds (ERInterval l r) =-        (negate $ B.toDouble (-l), B.toDouble r) -    floatBounds (ERInterval l r) =-        (negate $ B.toFloat (-l), B.toFloat r) -    integerBounds (ERInterval l r) = -        (negate $ mkEI (- l), mkEI r)-        where-        mkEI f -            | B.isPlusInfinity f = EI.PlusInfinity-            | B.isMinusInfinity f = EI.MinusInfinity-            | otherwise = ceiling f-    defaultBisectPt dom = -        erintvDefaultBisectPt  (RA.getGranularity dom + 1) dom-    bisectDomain maybePt dom = -        erintvBisect (RA.getGranularity dom + 1) maybePt dom-    {- \/ -}-    (ERInterval l1 r1) \/ (ERInterval l2 r2) =-        ERInterval (min l1 l2) (max r1 r2)-    {- RA.bounds -}-    bounds (ERInterval l r) = -        (ERInterval l l, ERInterval r r)-    {- RA.fromBounds -}-    fromBounds (ERInterval l1 r1, ERInterval l2 r2) -        | l1 == r1 && l2 == r2 = ERInterval l1 l2-    fromBounds i1i2 =-        error $-            "ER.Real.Approx.Interval: fromBounds: bounds not exact: "-            ++ show i1i2--instance (B.ERRealBase b) => RAEL.ERApproxElementary (ERInterval b)-instance (B.ERRealBase b) => RAEL.ERInnerOuterApproxElementary (ERInterval b)--- all operations here have appropriate default implementations-    -
− src/Data/Number/ER/Real/Approx/OI.hs 
@@ -1,56 +0,0 @@-{-# OPTIONS_GHC -fno-warn-missing-methods #-}-{-|-    Module      :  Data.Number.ER.Real.Approx.OI-    Description :  outer and inner approximations of approximations  -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    This module offers a transformation of a safely rounded real approximation type into-    a type that approximates these approximations from outside as well as *inside*. --}-module Data.Number.ER.Real.Approx.OI where--import qualified Data.Number.ER.Real.Approx as RA --{-|-    A pair of approximations that form an "interval" in the lattice of-    approximations. -    -    Eg outer = [1,4] inner = [3,2] can be thought of as the set of all-    generalised intervals where the left endpoint is between 1 and 3-    and the right endpoint is between 2 and 4 (eg [1,4], [3,4],-    [3,2], [3,3]).--}-data ERApproxOI ra = -    ERApproxOI-    {-        eroiOuter :: ra,-        eroiInner :: ra-    }-    deriving (Eq, Ord)--instance (RA.ERApprox ra) => (Show (ERApproxOI ra))-    where-    show (ERApproxOI oi ii) =-        "{ outer = " ++ show oi ++ "; inner = " ++ show ii ++ "}" --instance (RA.ERApprox ra) => RA.ERApproxApprox (ERApproxOI ra)-    where-    safeIncludes (ERApproxOI oi1 ii1) (ERApproxOI oi2 ii2) =-        oi2 `RA.refines` ii1-    safeNotIncludes (ERApproxOI oi1 ii1) (ERApproxOI oi2 ii2) =-        not $ ii2 `RA.refines` oi1--{- TODO when required: -}    -instance (RA.ERApprox ra) => (Num (ERApproxOI ra))-instance (RA.ERApprox ra) => (Fractional (ERApproxOI ra))-instance (RA.ERApprox ra) => RA.ERApprox (ERApproxOI ra)-    where-    (ERApproxOI oi1 ii1) `leqReals` (ERApproxOI oi2 ii2) =-        oi1 `RA.leqReals` oi2--
− src/Data/Number/ER/Real/Approx/Sequence.hs 
@@ -1,220 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Approx.Sequence-    Description :  exact reals via convergent sequences-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Types and methods related to explicit -    convergent sequences of real number approximations.--}-module Data.Number.ER.Real.Approx.Sequence -(-    ConvergRealSeq(..),-    makeFastConvergRealSeq,-    convertFuncRA2Seq,-    convertBinFuncRA2Seq,-    convergRealSeqElem,-    showConvergRealSeq,-    showConvergRealSeqAuto-)-where--import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.BasicTypes--import Data.Maybe-import Data.Ratio--{-|-  A converging sequence of real number approximations.-  -  * Every finite subsequence has a non-empty intersection.-  -  * The limit should be a singleton.--}-data ConvergRealSeq ra =-    ConvergRealSeq (EffortIndex -> ra)--convergRealSeqElem :: (ConvergRealSeq ra) -> EffortIndex -> ra-convergRealSeqElem (ConvergRealSeq sq) ix = sq ix-        -{-| -    Using this operator, a unary funtion working over-    approximations can be converted to one that works-    over exact numbers represented through a sequence-    of approximations.--}-convertFuncRA2Seq ::-    (EffortIndex -> ra -> ra) ->-    (ConvergRealSeq ra) ->-    (ConvergRealSeq ra)-convertFuncRA2Seq f (ConvergRealSeq argSeq) = -    ConvergRealSeq resultSeq-    where-    resultSeq ix =-        f ix (argSeq ix)-        -{-|-    The same as above, where f is binary--}            -convertBinFuncRA2Seq :: -    (EffortIndex -> ra -> ra -> ra) -> -    (ConvergRealSeq ra) -> -    (ConvergRealSeq ra) -> -    (ConvergRealSeq ra)-    -convertBinFuncRA2Seq f (ConvergRealSeq arg1) (ConvergRealSeq arg2) = -    ConvergRealSeq resultSeq-    where-    resultSeq ix =-        f ix (arg1 ix) (arg2 ix)--{-|-    Turn an arbitrary convergent sequence into one with-    a guaranteed convergence rate - the precision (as defined-    by 'RA.ERApprox.RA.getPrecision') of x_ix is at least ix.--}-makeFastConvergRealSeq :: -    (RA.ERApprox ra) => -    (ConvergRealSeq ra) -> -    (ConvergRealSeq ra)-makeFastConvergRealSeq (ConvergRealSeq argSeq) = -    ConvergRealSeq fastSeq-    where-    fastSeq ix =-        head $ catMaybes $ map (precisionOK . argSeq) indexSeries-        where-        indexSeries =-    --        take 5 $ -- upper bound on iteration - for testing-            binGeomSeries (max 1 ix)-        precisionOK ra-            | RA.getPrecision ra >= (effIx2prec ix) = Just ra-            | otherwise = Nothing--{-| -    binGeomSeries n is the geometric series-    [ n, 2n, 4n, 8n, ...]--}    -binGeomSeries-    :: (Num a)-    => a-    -> [a]-binGeomSeries n =-    n : (binGeomSeries (2 * n))--instance (RA.ERApprox ra) => Show (ConvergRealSeq ra) -    where-    show = showConvergRealSeq 6 True False 10 -- cheating here, should throw an error---{-|-    Show function for ConvergRealSeq's with full arguments.--}    -showConvergRealSeq-    :: (RA.ERApprox ra)-    => Int-    -> Bool-    -> Bool-    -> Precision-    -> (ConvergRealSeq ra)-    -> String--showConvergRealSeq numDigits showGran showComponents prec r =-    RA.showApprox numDigits showGran showComponents $-         convergRealSeqElem (makeFastConvergRealSeq r) (prec2effIx prec)---{-|-    Show function for ConvergRealSeq's with all parameters fixed-    except for number of digits--}-showConvergRealSeqAuto -    :: (RA.ERApprox ra)-    => Int-    -> (ConvergRealSeq ra)-    -> String-showConvergRealSeqAuto numDigits argSeq =-    showConvergRealSeq numDigits True False prec argSeq-    where-    prec = effIx2prec $ ceiling $ (fromInteger $ toInteger numDigits) * 3.3219280948873626----instance-    (RA.ERApprox ra)-    => Eq (ConvergRealSeq ra)-    where-    r1 == r2 = -        iterateRA_A raEq 2 [r1, r2]-        where-        raEq _ ([a1,a2]) = RA.equalReals a1 a2-                -instance-    (RA.ERApprox ra)-    => Ord (ConvergRealSeq ra)-    where-    compare r1 r2 = -        iterateRA_A eraComp 2 [r1, r2]-        where-        eraComp _ ([a1,a2]) = RA.compareReals a1 a2-            -pointwiseConvergRealSeq1 f (ConvergRealSeq sq) =-    ConvergRealSeq (f . sq)-pointwiseConvergRealSeq2 f (ConvergRealSeq sq1) (ConvergRealSeq sq2) =-    ConvergRealSeq (\ix -> f (sq1 ix) (sq2 ix))-            -instance -    (RA.ERApprox ra)-    => Num (ConvergRealSeq ra)-    where-    fromInteger n = ConvergRealSeq sq-        where-        sq ix =-            RA.setMinGranularityOuter (effIx2gran ix) $ fromInteger n-    abs = pointwiseConvergRealSeq1 $ abs-    signum = pointwiseConvergRealSeq1 $ signum-    negate = pointwiseConvergRealSeq1 $ negate-    (+) = pointwiseConvergRealSeq2 $ (+)-    (*) = pointwiseConvergRealSeq2 $ (*)-    -instance-    (RA.ERApprox ra)-    => Fractional (ConvergRealSeq ra)-    where-    fromRational q = ConvergRealSeq sq-        where-        sq ix =-            (RA.setMinGranularityOuter (effIx2gran ix) num) / denom-        num = fromInteger $ numerator q-        denom = fromInteger $ denominator q-    recip = pointwiseConvergRealSeq1 $ recip--{-|-    Take a converging sequence of partial functions F_i that operate on -    real approximations and turn it into a function F that operates on converging sequences. -    F looks for some members of the real approximation sequences -    and an i so that F_i is defined for the chosen approximations-    and returns its result.  --}-iterateRA_A-    :: (EffortIndex -> [ra] -> Maybe a) -        -- ^ a sequence of partial functions based on approximations-    -> EffortIndex -- ^ a starting index to use when searching sequences-    -> ([ConvergRealSeq ra] -> a) -        -- ^ a total function based on sequences--iterateRA_A fn_RA startIx args =-    head $ catMaybes $ map ((uncurry fn_RA) . args_Prec) indexSeries-    where-    indexSeries =---        take 5 $ -- upper bound on iteration - for testing-        binGeomSeries $ max 1 startIx-        -- [(max 1 startIx)..]-    args_Prec currentIndex =-        (currentIndex, map (\ arg -> convergRealSeqElem arg currentIndex) args)-       -
− src/Data/Number/ER/Real/Approx/Tests/Generate.hs 
@@ -1,177 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Approx.Tests.Generate-    Description :  (testing) generating real approximations-    Copyright   :  (c) 2009 Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    Generic instances of 'Arbitrary' class for generating (almost) random instances. --}--module Data.Number.ER.Real.Approx.Tests.Generate where--import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.BasicTypes--import Test.QuickCheck--import qualified Data.List as List--newtype RAThin ira = RAThin ira deriving (Show)-newtype RAConsistent ira = RAConsistent ira deriving (Show)-newtype RADirected ira = RADirected ira deriving (Show)---instance (RA.ERIntApprox ira) => Arbitrary (RAThin ira)-    where-    arbitrary = -        sized arbitrarySized-        where-        arbitrarySized n -            | n < 28 =-                do-                gran <- choose (8,20)-                (f1,f2,f3) <- arbitrary-                isInfty <- choose (-inftyChance,inftyChance)-                pow <- choose (-10,10)-                return $ RAThin $ constructThinRA isInfty gran (f1,f2,f3) pow-            | n <= 68 =-                do-                gran <- choose (30,100)-                (f1,f2,f3) <- arbitrary-                isInfty <- choose (-inftyChance,inftyChance)-                pow <- choose (-100,100)-                return $ RAThin $ constructThinRA isInfty gran (f1,f2,f3) pow-            | otherwise =-                do-                gran <- choose (400,1000)-                (f1,f2,f3) <- arbitrary-                isInfty <- choose (-inftyChance,inftyChance)-                pow <- choose (-10000,10000)-                return $ RAThin $ constructThinRA isInfty gran (f1,f2,f3) pow-    coarbitrary _ =-        error "ER.Real.Approx: Tests: coarbitrary not implemented"--inftyChance = 15-                -constructThinRA ::-    (RA.ERIntApprox ra) =>-    Granularity ->-    Int ->-    (Double, Double, Double) ->-    Int ->-    ra-constructThinRA gran isInfty (f1,f2,f3) pow -    | isInfty == inftyChance =-        RA.setGranularityOuter gran $ RA.plusInfinity-    | isInfty == - inftyChance =-        RA.setGranularityOuter gran $ negate $ RA.plusInfinity-    | isInfty == 0 =-        RA.setGranularityOuter gran 0-    | otherwise =-        fst $ RA.bounds $ -- ensure thinness-            (\ (Just a) -> a) $ List.find RA.isBounded results-    where-    results = [result1, result2, result3, result4, result5, 0]-    result1 = (b1/b2) ^^ pow + b3-    result2 = b1 * b2 + b3-    result3 = b1 ^^ pow - b2-    result4 = b1 - b2-    result5 = b1-    [b1,b2,b3] = map cvt [f1,f2,f3]-    cvt f = RA.setGranularityOuter gran $ RA.double2ra f--instance (RA.ERIntApprox ira) => Arbitrary (RAConsistent ira)-    where-    arbitrary = -        sized arbitrarySized-        where-        arbitrarySized n -            | n < 28 =-                do-                gran <- choose (8,20)-                (f11,f12,f13) <- arbitrary-                isInfty1 <- choose (-inftyChance,inftyChance)-                pow1 <- choose (-10,10)-                (f21,f22,f23) <- arbitrary-                isInfty2 <- choose (-inftyChance,inftyChance)-                pow2 <- choose (-10,10)-                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1-                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2-                return $ RAConsistent $ t1 RA.\/ t2-            | n <= 68 =-                do-                gran <- choose (30,100)-                (f11,f12,f13) <- arbitrary-                isInfty1 <- choose (-inftyChance,inftyChance)-                pow1 <- choose (-100,100)-                (f21,f22,f23) <- arbitrary-                isInfty2 <- choose (-inftyChance,inftyChance)-                pow2 <- choose (-100,100)-                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1-                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2-                return $ RAConsistent $ t1 RA.\/ t2-            | otherwise =-                do-                gran <- choose (400,1000)-                (f11,f12,f13) <- arbitrary-                isInfty1 <- choose (-inftyChance,inftyChance)-                pow1 <- choose (-10000,10000)-                (f21,f22,f23) <- arbitrary-                isInfty2 <- choose (-inftyChance,inftyChance)-                pow2 <- choose (-10000,10000)-                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1-                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2-                return $ RAConsistent $ t1 RA.\/ t2-    coarbitrary _ =-        error "ER.Real.Approx: Tests: coarbitrary not implemented"--instance (RA.ERIntApprox ira) => Arbitrary (RADirected ira)-    where-    arbitrary = -        sized arbitrarySized-        where-        arbitrarySized n -            | n < 28 =-                do-                gran <- choose (8,20)-                (f11,f12,f13) <- arbitrary-                isInfty1 <- choose (-inftyChance,inftyChance)-                pow1 <- choose (-10,10)-                (f21,f22,f23) <- arbitrary-                isInfty2 <- choose (-inftyChance,inftyChance)-                pow2 <- choose (-10,10)-                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1-                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2-                return $ RADirected $ RA.fromBounds (t1, t2)-            | n <= 68 =-                do-                gran <- choose (30,100)-                (f11,f12,f13) <- arbitrary-                isInfty1 <- choose (-inftyChance,inftyChance)-                pow1 <- choose (-100,100)-                (f21,f22,f23) <- arbitrary-                isInfty2 <- choose (-inftyChance,inftyChance)-                pow2 <- choose (-100,100)-                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1-                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2-                return $ RADirected $ RA.fromBounds (t1, t2)-            | otherwise =-                do-                gran <- choose (400,1000)-                (f11,f12,f13) <- arbitrary-                isInfty1 <- choose (-inftyChance,inftyChance)-                pow1 <- choose (-10000,10000)-                (f21,f22,f23) <- arbitrary-                isInfty2 <- choose (-inftyChance,inftyChance)-                pow2 <- choose (-10000,10000)-                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1-                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2-                return $ RADirected $ RA.fromBounds (t1, t2)-    coarbitrary _ =-        error "ER.Real.Approx: Tests: coarbitrary not implemented"--
− src/Data/Number/ER/Real/Approx/Tests/Properties.hs 
@@ -1,266 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Base.Tests.Properties-    Description :  (testing) properties to check for real approximations-    Copyright   :  (c) 2009 Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    Properties of real approximations we want to check in tests. --}--module Data.Number.ER.Real.Approx.Tests.Properties -where--import Data.Number.ER.Real.Approx.Tests.Generate-import Data.Number.ER.Real.Approx.Tests.Reporting-import Data.Number.ER.BasicTypes.Tests.Generate--import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.Real.Approx ((+:),(-:),(*:),(/:))-import qualified Data.Number.ER.Real.Approx.Elementary as RAEL--import Data.Number.ER.BasicTypes--import Data.Number.ER.Misc--import Test.QuickCheck--type RAPropTupleUnary ira =-    ira ->-    String ->-    ((Ix20, RAThin ira) -> Bool, -     (Ix20, RAConsistent ira) -> Bool,-     (Ix20, RAThin ira) -> Bool, -     (Ix20, RAConsistent ira) -> Bool, -     (Ix20, RADirected ira) -> Bool)--props_ra_AMinusA_eq_oi ::-    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira-props_ra_AMinusA_eq_oi =-    props_ra_eq_oi_unary 0 (\ix a -> a - a) (\ix a -> a -: a)--props_ra_ADivA_eq_oi ::-    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira-props_ra_ADivA_eq_oi =-    props_ra_eq_oi_unary 1 (\ix a -> a / a) (\ix a -> a /: a)-    -props_ra_AddCommut_eq_oi ::-    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira-props_ra_AddCommut_eq_oi =-    props_ra_eq_oi_unary 0 commutDiff commutDiffInner-    where-    commutDiff ix a =-        (a + b) - (b + a)-        where-        b = 1 / (a + 1)-    commutDiffInner ix a =-        (a +: b) -: (b +: a)-        where-        b = 1 / (a + 1)--props_ra_MultCommut_eq_oi ::-    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira-props_ra_MultCommut_eq_oi =-    props_ra_eq_oi_unary 0 commutDiff commutDiffInner-    where-    commutDiff ix a =-        (a * b) - (b * a)-        where-        b = 1 / (a + 1)-    commutDiffInner ix a =-        (a *: b) -: (b *: a)-        where-        b = 1 / (a + 1)--props_ra_AddAssoc_eq_oi ::-    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira-props_ra_AddAssoc_eq_oi =-    props_ra_eq_oi_unary 0 assocDiff assocDiffInner-    where-    assocDiff ix a =-        ((a + b) + c) - (a + (b + c))-        where-        b = 1 / (a + 1)-        c = (a - 1)-    assocDiffInner ix a =-        ((a +: b) +: c) -: (a +: (b +: c))-        where-        b = 1 / (a + 1)-        c = (a - 1)--props_ra_MultAssoc_eq_oi ::-    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira-props_ra_MultAssoc_eq_oi =-    props_ra_eq_oi_unary 0 assocDiff assocDiffInner-    where-    assocDiff ix a =-        ((a * b) * c) - (a * (b * c))-        where-        b = 1 / (a + 1)-        c = (a - 1)-    assocDiffInner ix a =-        ((a *: b) *: c) -: (a *: (b *: c))-        where-        b = 1 / (a + 1)-        c = (a - 1)--props_ra_Distr_eq_oi ::-    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira-props_ra_Distr_eq_oi =-    props_ra_eq_oi_unary 0 distrDiff distrDiffInner-    where-    distrDiff ix a =-        (a * (b + c)) - (a * b + a * c)-        where-        b = 1 / (a + 1)-        c = (a - 1)-    distrDiffInner ix a =-        (a *: (b +: c)) -: ((a *: b) +: (a *: c))-        where-        b = 1 / (a + 1)-        c = (a - 1)--props_ra_SinCos_eq_oi ::-    (RAEL.ERInnerOuterApproxElementary ira, RAEL.ERApproxElementary ira) => RAPropTupleUnary ira-props_ra_SinCos_eq_oi =-    props_ra_eq_oi_unary 1 sincos sincosInner-    where-    sincos ix a =-        (RAEL.sin ix a)^2 + (RAEL.cos ix a)^2-    sincosInner ix a =-        (sina *: sina) +: (cosa *: cosa)-        where-        sina = RAEL.sinInner ix a -        cosa = RAEL.cosInner ix a --props_ra_TanATan_eq_oi ::-    (RAEL.ERInnerOuterApproxElementary ira, RAEL.ERApproxElementary ira) => RAPropTupleUnary ira-props_ra_TanATan_eq_oi =-    props_ra_eq_oi_unary 0 tanAtan tanAtanInner-    where-    tanAtan ixP a =---        unsafePrint ---        (---            "tanAtan: "---            ++ "\n ix = " ++ show ix ---            ++ "\n a = " ++ show a---            ++ "\n atan ix a = " ++ show tana---            ++ "\n tan ix (atan ix a) = " ++ show tanatana---        ) $-        tanatana - a-        where-        tanatana = RAEL.tan ix tana-        tana = RAEL.atan ix a-        ix = min 10 ixP-    tanAtanInner ixP a =-        (RAEL.tanInner ix $ RAEL.atanInner ix a) -: a-        where-        ix = min 10 ixP--props_ra_LogExp_eq_oi ::-    (RAEL.ERInnerOuterApproxElementary ira, RAEL.ERApproxElementary ira) => RAPropTupleUnary ira-props_ra_LogExp_eq_oi =-    props_ra_eq_oi_unary 0 logExp logExpInner-    where-    logExp ixP a =---        unsafePrint ---        (---            "logExp: "---            ++ "\n ix = " ++ show ix ---            ++ "\n a = " ++ show a---            ++ "\n exp ix a = " ++ show expa---            ++ "\n log ix (exp ix a) = " ++ show logexpa---        ) $-        logexpa - a-        where-        logexpa = RAEL.log ix expa -        expa = RAEL.exp ix a-        ix = min 10 ixP-    logExpInner ixP a =-        logexpa -: a-        where-        logexpa = RAEL.logInner ix expa-        expa = RAEL.expInner ix a-        ix = min 10 ixP---{------------------  auxiliary functions ------------------------}--props_ra_eq_oi_unary constRes opOuter opInner sampleRA reportFileName =-    (prop_Eq_Thin, prop_Eq_Consistent, -     prop_OI_Thin, prop_OI_Consistent, prop_OI_Directed)-    where-    prop_Eq_Thin (Ix20 ix, RAThin a) =-        raConsistentWithPrecise sampleRA (reportFileName  ++ "_Eq_Thin") (ix,aId) 0 constRes resOuter-        where-        resOuter = opOuter ix a-        aId = RA.showApprox 10 True True a-    prop_Eq_Consistent (Ix20 ix, RAConsistent a) =-        raConsistentWithPrecise sampleRA (reportFileName ++ "_Eq_Consistent") (ix,aId) 0 constRes resOuter-        where-        resOuter = opOuter ix a-        aId = RA.showApprox 10 True True a-    prop_OI_Thin (Ix20 ix, RAThin a) =-        raIncludedIn sampleRA (reportFileName ++ "_OI_Thin") (ix, aId) 0 resInner resOuter-        where-        resOuter = opOuter ix a-        resInner = opInner ix a-        aId = RA.showApprox 10 True True a-    prop_OI_Consistent (Ix20 ix, RAConsistent a) =-        raIncludedIn sampleRA (reportFileName ++ "_OI_Consistent") (ix,aId) 0 resInner resOuter-        where-        resOuter = opOuter ix a-        resInner = opInner ix a-        aId = RA.showApprox 10 True True a-    prop_OI_Directed (Ix20 ix, RADirected a) =-        raIncludedIn sampleRA (reportFileName ++ "_OI_Directed") (ix, aId) 0 resInner resOuter-        where-        resOuter = opOuter ix a-        resInner = opInner ix a-        aId = RA.showApprox 10 True True a-    -raConsistentWithPrecise sampleRA reportFileName caseId subId preciseVal approxVal -    | result =-        unsafeERTestReport reportFileName-            (caseId, subId, preciseVal, approxVal) $-        result-    | otherwise = -        unsafePrint-        (-            "raAntiIncludes failed"-            ++ "\n caseId = " ++ show caseId-            ++ "\n subId = " ++ show subId-            ++ "\n preciseVal = " ++ show preciseVal-            ++ "\n approxVal = " ++ show approxVal-        ) $-        result-    where-    result = -        (approxVal `RA.refines` preciseVal)-        || -        (preciseVal `RA.refines` approxVal)-    _ = [sampleRA, approxVal]--raIncludedIn sampleRA reportFileName caseId subId innerVal outerVal -    | result =-        unsafeERTestReport reportFileName-            (caseId, subId, innerVal, outerVal) $-        result-    | otherwise = -        unsafePrint-        (-            "raIncludes failed"-            ++ "\n caseId = " ++ show caseId-            ++ "\n subId = " ++ show subId-            ++ "\n innerVal = " ++ show innerVal-            ++ "\n outerVal = " ++ show outerVal-        ) $-        result-    where-    result = innerVal `RA.refines` outerVal -    _ = [sampleRA, innerVal]--
− src/Data/Number/ER/Real/Approx/Tests/Reporting.hs 
@@ -1,167 +0,0 @@--module Data.Number.ER.Real.Approx.Tests.Reporting --where--import qualified Data.Number.ER.Real.Approx as RA--import Data.Number.ER.Misc--import qualified Data.List as List-import Text.Regex-import System.IO---unsafeERTestReport ::-    (Show tId, Show sId, RA.ERIntApprox ira) =>-    String ->-    (tId, sId, ira, ira) ->-    a -> a-unsafeERTestReport reportFileName (testId, subId, almostPreciseVal, approxVal) =-    unsafeReport reportFileName $ -        stdRepLine (testId, subId) (overestimation, detail)-    where-    overestimation = fst $ getOverestimation almostPreciseVal approxVal-    detail = (almostPreciseVal, approxVal)--stdRepLine (testId, subId) (overestimation, detail) =-    "case=" ++ show testId-    ++ ";pt=" ++ show subId-    ++ ";ovest=" ++ show overestimation-    ++ ";detail=" ++ show detail--getOverestimation ::-    (RA.ERIntApprox ira) =>-    ira -> ira -> (Double, (ira, ira))-getOverestimation model res =-    ((abs $ wMod - wRes) / (1 + (max 0 (wMod))), (model, res))-    where-    wMod = hMod - lMod-    wRes = hRes - lRes-    (lMod, hMod) = RA.doubleBounds model-    (lRes, hRes) = RA.doubleBounds res-    -produceSummary :: String -> IO ()-produceSummary filepath =-    do-    casesInfo <- parseReport filepath-    writeFile summaryFilepath $ formatSummary casesInfo-    return ()-    where-    summaryFilepath = filepath ++ "-summary"-    formatSummary casesInfo =-        "all " ++ show casesCount ++ " cases:"-        ++ "\n  approx. average time per case: " ++ show timeInSeconds ++ " seconds"-        ++ "\n  approx. average per case average overestimation: " ++ show avgOverestimation-        ++ "\n  approx. average per case maximum overestimation: " ++ show maxOverestimation-        ++ "\n\n removing the worst 5% of the cases (for each measure separately):"-        ++ "\n  approx. average time per case: " ++ show timeInSeconds95 ++ " seconds"-        ++ "\n  approx. average per case average overestimation: " ++ show avgOverestimation95-        ++ "\n  approx. average per case maximum overestimation: " ++ show maxOverestimation95-        ++ "\n\n considering only the worst 50% but not the worst 5% of the cases (for each measure separately):"-        ++ "\n  approx. average time per case: " ++ show timeInSeconds45 ++ " seconds"-        ++ "\n  approx. average per case average overestimation: " ++ show avgOverestimation45-        ++ "\n  approx. average per case maximum overestimation: " ++ show maxOverestimation45-        ++ "\n\n considering only the best 50% of the cases (for each measure separately):"-        ++ "\n  approx. average time per case: " ++ show timeInSeconds50 ++ " seconds"-        ++ "\n  approx. average per case average overestimation: " ++ show avgOverestimation50-        ++ "\n  approx. average per case maximum overestimation: " ++ show maxOverestimation50-        ++ "\n\n" ++ (unlines $ map formatSummaryCase casesInfo)-        where-        (allTimes, (allAvgOvers, allMaxOvers)) =-            mapSnd unzip $ unzip $ snd $ unzip casesInfo-        timeInSeconds = (sum allTimes) / casesCountF-        avgOverestimation = (sum allAvgOvers) / casesCountF-        maxOverestimation = (sum allMaxOvers) / casesCountF-        casesCount = length casesInfo-        casesCountF :: Double-        casesCountF = fromInteger $ toInteger casesCount-        -        timeInSeconds95 = (sum allTimes95) / casesCount95F-        avgOverestimation95 = (sum allAvgOvers95) / casesCount95F-        maxOverestimation95 = (sum allMaxOvers95) / casesCount95F-        allTimes95 = drop fivePerCent $ reverse $ List.sort allTimes -        allAvgOvers95 = drop fivePerCent $ reverse $ List.sort allAvgOvers -        allMaxOvers95 = drop fivePerCent $ reverse $ List.sort allMaxOvers-        casesCount95F = fromInteger $ toInteger $ casesCount - fivePerCent-        fivePerCent = max 1 $ (5 * casesCount) `div` 100-        -        timeInSeconds50 = (sum allTimes50) / casesCount50F-        avgOverestimation50 = (sum allAvgOvers50) / casesCount50F-        maxOverestimation50 = (sum allMaxOvers50) / casesCount50F-        allTimes50 = drop fiftyPerCent $ reverse $ List.sort allTimes -        allAvgOvers50 = drop fiftyPerCent $ reverse $ List.sort allAvgOvers -        allMaxOvers50 = drop fiftyPerCent $ reverse $ List.sort allMaxOvers-        casesCount50F = fromInteger $ toInteger $ casesCount - fiftyPerCent-        fiftyPerCent = casesCount `div` 2-        -        timeInSeconds45 = (sum allTimes45) / casesCount45F-        avgOverestimation45 = (sum allAvgOvers45) / casesCount45F-        maxOverestimation45 = (sum allMaxOvers45) / casesCount45F-        allTimes45 =  drop fivePerCent $ reverse $ drop fiftyPerCent $ List.sort allTimes -        allAvgOvers45 = drop fivePerCent $ reverse $ drop fiftyPerCent $ List.sort allAvgOvers -        allMaxOvers45 = drop fivePerCent $ reverse $ drop fiftyPerCent $ List.sort allMaxOvers-        casesCount45F = fromInteger $ toInteger $ casesCount - fiftyPerCent - fivePerCent-    formatSummaryCase (caseId, (timeInSeconds, (avgOverestimation, maxOverestimation))) =-        "case " ++ caseId ++ ":"-        ++ "\n  approximate time = " ++ show timeInSeconds ++ " seconds"-        ++ "\n  average sampled overestimation = " ++ show avgOverestimation -        ++ "\n  maximal sampled overestimation = " ++ show maxOverestimation-    parseReport :: String -> IO [(String, (Double, (Double, Double)))]-    parseReport filepath =-        withFile filepath ReadMode readFirstAndOtherLines-        where-        readFirstAndOtherLines h =-            do-            startLine <- hGetLine h-            firstLine <- hGetLine h-            readCases (firstLine, (getTime firstLine) - (getTime startLine)) h-        readCases (currentLine, caseCompTime) h =-            do-            (caseOverestimations, maybeNextLineAndTime) <- readCase [] 0 currentLine-            let caseInfo = (caseId, (caseCompTime, avgAndMax caseOverestimations))-            case maybeNextLineAndTime of-                Nothing -> return [caseInfo]-                Just (nextLine, nextCaseTime) ->-                    do-                    otherCases <- readCases (nextLine, nextCaseTime) h-                    return $ caseInfo : otherCases-            where     -            avgAndMax ns =-                (sum ns / (fromInteger $ toInteger $ length ns), foldl1 max ns)-            caseId = getCaseId currentLine-            readCase overestimationsSoFar currentTimeStep currentLine-                | currentCaseId /= caseId =-                    return (overestimationsSoFar, Just (currentLine, currentTimeStep))-                | otherwise =-                    do-                    finished <- hIsEOF h-                    case finished of-                        True -> return (currentOverestimations, Nothing)-                        False ->-                            do-                            nextLine <- hGetLine h-                            let nextTimeStep = (getTime nextLine) - (getTime currentLine)-                            readCase currentOverestimations nextTimeStep nextLine-                where-                currentCaseId = getCaseId currentLine-                currentOverestimations = -                    currentOverestimation : overestimationsSoFar-                currentOverestimation = getOverestimation currentLine-        getTime :: String -> Double-        getTime line = -            case reads line of-                [(time,'s':_)] -> time-        getCaseId :: String -> String-        getCaseId line =-            case matchRegex idRegex line of-                Just [caseId] -> caseId-            where-            idRegex = mkRegex "case=([^;]*);"-        getOverestimation :: String -> Double-        getOverestimation line =-            case matchRegex ovestRegex line of-                Just [ovestS] -> read ovestS-            where-            ovestRegex = mkRegex "ovest=([^;]*);"-
− src/Data/Number/ER/Real/Approx/Tests/Run.hs 
@@ -1,100 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Approx.Tests.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.Real.Approx.Tests.Run-where--import Data.Number.ER.Real.Approx.Tests.Generate-import Data.Number.ER.Real.Approx.Tests.Properties-import Data.Number.ER.Real.Approx.Tests.Reporting--import qualified Data.Number.ER.Real.Approx as RA-import qualified Data.Number.ER.Real.Approx.Elementary as RAEL--import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)--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--runRATests :: -    (RAEL.ERApproxElementary ra, -     RAEL.ERInnerOuterApproxElementary ra,-     Ord ra) =>-    String -> ra -> IO () -> IO ()-runRATests title sampleRA initialise =-    do-    (UTCTime (ModifiedJulianDay days) secs) <- getCurrentTime-    let folder = "tests-" ++ title ++ "-" ++ (show days) ++ "-" ++ (show $ floor $ toRational secs)-    createDirectory folder-    erRunTests (title ++ " real approx tests") raTestOptions initialise (raTests sampleRA folder)--raTestOptions = -    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 -      }--raTests sampleRA folder =-    (propTuple "a-a=0" "AMinusAIsZero" props_ra_AMinusA_eq_oi)-    ++-    (propTuple "a/a=1" "ADivAIsOne" props_ra_ADivA_eq_oi)-    ++-    (propTuple "a+b=b+a" "AddCommut" props_ra_AddCommut_eq_oi)-    ++-    (propTuple "a*b=b*a" "MultCommut" props_ra_MultCommut_eq_oi)-    ++-    (propTuple "(a+b)+c=a+(b+c)" "AddAssoc" props_ra_AddAssoc_eq_oi)-    ++-    (propTuple "(a*b)*c=a*(b*c)" "MultAssoc" props_ra_MultAssoc_eq_oi)-    ++-    (propTuple "a*(b+c)=a*b+a*c" "Distr" props_ra_Distr_eq_oi)-    ++-    (propTuple "log(exp(a))=a" "LogExp" props_ra_LogExp_eq_oi)-    ++-    (propTuple "(sin a)^2+(cos a)^2=1" "SinCos" props_ra_SinCos_eq_oi)-    ++-    (propTuple "tan(atan(a))=a" "TanATan" props_ra_TanATan_eq_oi)-    where-    propTuple testName testFileName propGen =-        [-            (testName  ++ ", equality, thin intervals", runR prop_eq_Thin $ filepath ++ "_Eq_Thin"),-            (testName  ++ ", equality, consistent intervals", runR prop_eq_Consistent $ filepath ++ "_Eq_Consistent"),-            (testName  ++ ", inner in outer, thin intervals", runR prop_oi_Thin $ filepath ++ "_OI_Thin"),-            (testName  ++ ", inner in outer, consistent intervals", runR prop_oi_Consistent $ filepath ++ "_OI_Consistent"),-            (testName  ++ ", inner in outer, directed intervals", runR prop_oi_Directed $ filepath ++ "_OI_Directed")-        ]-        where-        (prop_eq_Thin, prop_eq_Consistent, prop_oi_Thin, prop_oi_Consistent, prop_oi_Directed) = -            propGen sampleRA filepath-        filepath = FP.combine folder testFileName-    runR test filepath opts =-        unsafeReport filepath "started" $-            do -            result <- run test opts-            produceSummary filepath-            return result-
− src/Data/Number/ER/Real/Arithmetic/Elementary.hs 
@@ -1,771 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Arithmetic.Elementary-    Description :  some elementary functions-    Copyright   :  (c) Michal Konecny, Amin Farjudian, Jan Duracz-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Some important elementary functions for real approximations-    and their maximal extensions for interval approximations.--}-module Data.Number.ER.Real.Arithmetic.Elementary-(   -    -- * specialised exponentiation-    erSqr_R,-    erSqr_IR,-    erPow_R,-    erPow_IR,-    erSqrt_R,-    erSqrt_IR,-    erSqrt_IR_Inner,-    erRoot_R,-    erRoot_IR,-    erRoot_IR_Inner,-    -- * exponentiation and logarithm -    erExp_R,-    erExp_IR,-    erExp_IR_Inner,-    erLog_R,-    erLog_IR,-    erLog_IR_Inner,-    -- * trigonometrics-    erSine_R,-    erSine_IR,-    erSine_IR_Inner,-    erCosine_R,-    erCosine_IR,-    erCosine_IR_Inner,-    erATan_R,-    erATan_IR,-    erATan_IR_Inner,-    erPi_R-)-where--import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.BasicTypes-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI--import Data.Number.ER.Real.Arithmetic.Taylor--- import Data.Number.ER.Real.Arithmetic.Newton--import Data.Number.ER.Misc--{--    sqr--}--erSqr_IR ::-    (RA.ERIntApprox ira, Ord ira) =>-    EffortIndex -> -    ira -> ira-erSqr_IR =-    RA.maxExtensionR2R-        sqrExtrema-        erSqr_R-    where-    sqrExtrema ix x -        | 0 `RA.refines` x = [0]-        | otherwise = [] --erSqr_R ::-    (RA.ERIntApprox ira, Ord ira) =>-    EffortIndex -> -    ira -> ira-erSqr_R ix a =-    max 0 $ a' * a'-    where-    a' = RA.setMinGranularityOuter gran a-    gran = effIx2gran ix-    -{--    integer exponentiation x ^ p--}--erPow_IR ::-    (RA.ERIntApprox ira, Ord ira) =>-    EffortIndex -> -    Integer ->-    ira -> ira-erPow_IR ix n x = -    RA.maxExtensionR2R-        powExtrema-        (\ ix x -> erPow_R ix n x)-        ix x-    where-    powExtrema ix x -        | even n && 0 `RA.refines` x = [0]-        | otherwise = [] ---erPow_R ::-    (RA.ERIntApprox ira, Ord ira) =>-    EffortIndex ->-    Integer ->-    ira -> ira-erPow_R ix p a-    | p < 0 =-        1 / erPow_R ix (-p) a-    | p == 0 = -        1-    | even p =-        erPow_R ix (div p 2) (erSqr_R ix a')-    | otherwise =-        a' * (erPow_R ix (div (p - 1) 2) (erSqr_R ix a'))-    where-    a' = RA.setMinGranularityOuter gran a-    gran = effIx2gran ix--{--    sqrt--}--erSqrt_R ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira-erSqrt_R = erSqrtNewton_R  -    -erSqrt_IR ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira-erSqrt_IR =-    RA.maxExtensionR2R -        sqrtExtrema-        (\ ix x -> erSqrt_R ix x)--erSqrt_IR_Inner ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira-erSqrt_IR_Inner =-    RA.maxExtensionInnerR2R -        sqrtExtrema-        (\ ix x -> erSqrt_R ix x)--sqrtExtrema ix x = fst $ sqrtExtremaAndDirections ix x-        -sqrtExtremaAndDirections ix x =-    case RA.compareReals 0 x of-        Just LT -> ([], (Just True, Just True))-        Just GT -> ([], (Nothing, Nothing))-        _ -> ([0], (Nothing, Just True))-        ---erSqrtContFr_R ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira-erSqrtContFr_R ix a-    | aR == 0 = 0-    | aL == RA.plusInfinity = RA.plusInfinity-    | aR `RA.ltSingletons` 0 = RA.topApprox-    | otherwise =-        contFrIter (ix + 3) $-            RA.setMinGranularityOuter gran $ 0 RA.\/ aR -- assuming aR >= 0 -    where-    gran = effIx2gran ix-    (aL, aR) = RA.bounds a-    aM1 = a - 1-    -    contFrIter i x_i-        | i == 0 =-            x_i-        | otherwise =-            1 + (aM1 / (x_iPlus1 + 1))-        where-        x_iPlus1 = contFrIter (i - 1) x_i-            -erSqrtNewton_R ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira-erSqrtNewton_R ix a-    | aR == 0 = 0-    | aL == RA.plusInfinity = RA.plusInfinity-    | aR `RA.ltSingletons` 0 = RA.topApprox-    | otherwise =-        x_i RA.\/ (a/x_i)-    where-    gran = effIx2gran ix-    (aL, aR) = RA.bounds a-    aM1 = a - 1-    -    x_i = -        newtonIter ((ix `div` 10) + 5) $-                RA.setMinGranularityOuter gran aR -- assuming aR >= 0 -    newtonIter i x_i-        | i == 0 = x_i-        | otherwise =-                snd $ RA.bounds $-                    (x_iMinus1 + a / (x_iMinus1)) / 2-        where-        x_iMinus1 = newtonIter (i - 1) x_i--{--    pth root x ^ (1/p)--}--erRoot_R ::-    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> Integer -> ira -> ira-erRoot_R = erRootNewton_R    -    -erRoot_IR ::-    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> Integer -> ira -> ira-erRoot_IR ix p =-    RA.maxExtensionR2R -        (rootExtrema p)-        (\ ix x -> erRoot_R ix p x) $-            ix--erRoot_IR_Inner ::-    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> Integer -> ira -> ira-erRoot_IR_Inner ix p =-    RA.maxExtensionInnerR2R -        (rootExtrema p)-        (\ ix x -> erRoot_R ix p x) $-            ix-rootExtrema p ix x = fst $ rootExtremaAndDirections p ix x--rootExtremaAndDirections p ix x-    | odd p = ([], (Just True, Just True))-    | otherwise =-        case RA.compareReals 0 x of-            Just LT -> ([], (Just True, Just True))-            Just GT -> ([], (Nothing, Nothing))-            _ -> ([0], (Nothing, Just True))--erRootNewton_R ::-    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> Integer -> ira -> ira-erRootNewton_R ix p a-    | aR == 0 = 0-    | aL == RA.plusInfinity = RA.plusInfinity-    | aR < 0 && even p = RA.topApprox-    | aR < 0 = - erRootNewton_R ix p (-a)-    | p > 0 =-        x_i RA.\/ (a/x_i_pow_p_minus_1)-    | otherwise =   -        1 / (erRootNewton_R ix (-p) a) -- TODO: check extremes-    where-    gran = effIx2gran ix-    (aL, aR) = RA.bounds a-    aM1 = a - 1-    pIRA = fromInteger p-    pIRA_minus_1 = pIRA - 1-    -    (x_i, x_i_pow_p_minus_1) = -        newtonIter (ix + 5) $-                RA.setMinGranularityOuter gran $ max 0 aR- -    newtonIter i x_0-        | i == 0 = -            (x_0, x_0_pow_p_minus_1)-        | otherwise =-            (x_i, x_i_pow_p_minus_1)-            -        where-        (x_iMinus1, x_iMinus1_pow_p_minus_1) = -            newtonIter (i - 1) x_0-        x_i =-                snd $ RA.bounds $-                    (pIRA_minus_1 * x_iMinus1 + a / x_iMinus1_pow_p_minus_1) / pIRA-        x_i_pow_p_minus_1 =-                erPow_R ix (p - 1) x_i-        x_0_pow_p_minus_1 =-                erPow_R ix (p - 1) x_0--{--    e^x and log--}--erExp_R :: -    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> ira -> ira-    -erExp_R ix x -    | RA.isBounded x =---        unsafePrintReturn---        (---            "erExp_R: "---            ++ "\n x = " ++ show x---            ++ "\n xNear0 = " ++ show xNear0---            ++ "\n n = " ++ show n---            ++ "\n erExp_Tay_Opt_R ix xNear0 = " ++ (show $ erExp_Tay_Opt_R ix xNear0)---            ++ "\n result = "---        ) $-        erPow_IR ix n $ -        erExp_Tay_Opt_R ix xNear0-    | x `RA.refines` (-RA.plusInfinity) = 0-    | (-RA.plusInfinity) `RA.refines` x =-        0 RA.\/ (erExp_R ix (snd $ RA.bounds x))-    | otherwise = RA.bottomApprox-    where-    (xNear0, n) = scaleNear0 (x,1)-    scaleNear0 (xPrev, nPrev) =-        case xPrev `RA.refines` ((-1) RA.\/ 1) of-            True -> (xPrev, nPrev)-            False -> scaleNear0 (xNext, nNext)-        where-        xNext = xPrev / 2-        nNext = 2 * nPrev--erExp_IR :: -    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> ira -> ira-    -erExp_IR =-    RA.maxExtensionR2R-        noExtrema-        erExp_R--erExp_IR_Inner :: -    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> ira -> ira-erExp_IR_Inner =-    RA.maxExtensionInnerR2R-        noExtrema-        erExp_R--noExtrema ix x = []--{- Log using Newton -}--erLog_R :: -    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> ira -> ira-    -erLog_R =-    logDivSeries_R ---    erLog_IR -- intervals are more efficient for log than singletons --erLog_IR ::-    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> ira -> ira-    -erLog_IR =-    RA.maxExtensionR2R-        logExtrema-        (\ ix x -> logDivSeries_R ix x)-        -erLog_IR_Inner ::-    (RA.ERIntApprox ira, Ord ira) => -    EffortIndex -> ira -> ira-    -erLog_IR_Inner =-    RA.maxExtensionInnerR2R-        logExtrema-        (\ ix x -> logDivSeries_R ix x)-        -logExtrema ix x = fst $ logExtremaAndDirections ix x-        -logExtremaAndDirections ix x =-    case RA.compareReals 0 x of-        Just LT -> ([], (Just True, Just True))-        Just GT -> ([], (Nothing, Nothing))-        _ -> ([-RA.plusInfinity], (Nothing, Just True))-        -{-| log using a fast converging series, designed to be used with singletons -}-logDivSeries_R ::-    (RA.ERIntApprox ira, Ord ira) => EffortIndex -> ira -> ira -logDivSeries_R ix x -    | posx `RA.refines` 0 = -RA.plusInfinity-    | 0 `RA.refines` posx = RA.bottomApprox-    | posx `RA.refines` (RA.plusInfinity) = RA.plusInfinity-    | otherwise =-        case RA.compareReals posx 1 of-            Just LT ->---                unsafePrint ---                (---                    "logDivSeries_R: recursion via recip" ---                ) $-                negate $-                    (logDivSeries_R ix posxRecipL) -                    RA.\/ -                    (logDivSeries_R ix posxRecipR)-            _ ->---                unsafePrint ---                (---                    "logDivSeries_R: using series"---                    ++ "\n posx = " ++ show posx ---                    ++ "\n nearLogx = " ++ show nearLogx ---                    ++ "\n remNearLogx = " ++ show remNearLogx ---                    ++ "\n t = " ++ show t ---                ) $-                nearLogx + 2 * t * (series ix (RA.setMinGranularityOuter gran 1))-    where-    gran = effIx2gran ix-    posx = (RA.setMinGranularityOuter gran x) RA./\ (0 RA.\/ (RA.plusInfinity))-    (posxRecipL, posxRecipR) = RA.bounds $ recip posx-    nearLogx =-        0.69314718055994530941 * (fromInteger $ intLogUp 2 $ xCeiling)-    remNearLogx =-        posx / (erExp_R ix nearLogx) -- should be very close to 1-    xCeiling = -        snd $ RA.integerBounds posx-    t = -        ((remNearLogx - 1) / (remNearLogx + 1)) -- the range of this expression is [-1,1] -            RA./\ ((-1) RA.\/ 1) -- correction of wrapping -    tsquare = abs $ t * t -- the range is [0,1]-    series termsCount currentDenominator -        | termsCount > 0 =-            (recip currentDenominator) + tsquare * (series (termsCount - 1) (currentDenominator + 2))-        | otherwise =-            (recip currentDenominator)-            * (1 RA.\/ (recip $ 1 - tsquare)) -- [1,1/(1-t^2)] is a valid error bound-        ---{- log using Newton -}---    ---logNewton_RA---    :: (RA.ERIntApprox ira)---    => EffortIndex---    -> ra -- must not be below 1---    -> ra---    ---logNewton_RA i x = ---    case compareReals posx 1 of---        Just LT ->---            - (logNewton_RA i (recip posx))---        _ ->    ---            erNewton_FullArgs ---                ( \ i y -> (erExp_RA i y) - posx, erExp_RA) ---                (RA.setMinGranularityOuter gran nearLogx) ---                (RA.setMinGranularityOuter gran 1) ---                (fromInteger $ toInteger i)---                i---    where---    gran = effIx2gran i---    posx = ---        RA.setMinGranularityOuter gran x /\ (ira2ra $ 0 RA.\/ (RA.plusInfinity))---    nearLogx =                    ---        0.69314718055994530941 * (fromInteger $ intLog 2 $ xCeiling)---    xCeiling ---        | RA.isEmpty posx = 1 -- choice of constant irrelevant---        | otherwise =---            snd $ RA.iraIntegerBounds $ ra2ira posx---{--    sin(x) and cos(x)--}--erSine_R ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira--erSine_R ix x =-    case (RA.isBounded x) of-        True | xNear0 `RA.refines` plusMinusPiHalf ->-            erSine_Tay_Opt_R ix xNear0-        True | (xNear0 - piHalf) `RA.refines` plusMinusPiHalf ->-            erCosine_Tay_Opt_R ix (xNear0 - piHalf)-        True | (xNear0 + piHalf) `RA.refines` plusMinusPiHalf ->-            negate $ erCosine_Tay_Opt_R ix (xNear0 + piHalf)-        True | (xNear0 - pi) `RA.refines` plusMinusPiHalf ->-            negate $ erSine_Tay_Opt_R ix (xNear0 - pi)-        _ ->-            (-1) RA.\/ 1-    where-    xNear0 = x - k * 2 * pi -- should be in [-pi,3*pi/2]-    k = fromInteger $ toInteger kEI-    (kEI,_) = RA.integerBounds $ 0.5 + (x / (2*pi))--    plusMinusPiHalf = (- piHalf) RA.\/ piHalf-    piHalf = pi / 2-    pi = erPi_R ix-    --erCosine_R :: -    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira-     -erCosine_R ix x =-    case (RA.isBounded x) of-        True | xNear0 `RA.refines` plusMinusPiHalf ->-            erCosine_Tay_Opt_R ix xNear0-        True | (xNear0 - piHalf) `RA.refines` plusMinusPiHalf ->-            negate $ erSine_Tay_Opt_R ix (xNear0 - piHalf)-        True | (xNear0 + piHalf) `RA.refines` plusMinusPiHalf ->-            erSine_Tay_Opt_R ix (xNear0 + piHalf)-        True | (xNear0 - pi) `RA.refines` plusMinusPiHalf ->-            negate $ erCosine_Tay_Opt_R ix (xNear0 - pi)-        _ ->-            (-1) RA.\/ 1-    where-    xNear0 = x - k * 2 * pi -- should be in [-pi,3*pi/2]-    k = fromInteger $ toInteger kEI-    (kEI,_) = RA.integerBounds $ 0.5 + (x / (2*pi))--    plusMinusPiHalf = (- piHalf) RA.\/ piHalf-    piHalf = pi / 2-    pi = erPi_R ix---{- Sine using generic Taylor (see Taylor for an optimised version) -}--erSine_Tay_R :: -    (RA.ERIntApprox ira) =>-    EffortIndex -> ira -> ira--erSine_Tay_R ix x-    | (RA.plusInfinity) `RA.refines` x || (-RA.plusInfinity) `RA.refines` x = -        (-1) RA.\/ 1  -    | otherwise =-        erTaylor_R ix sine_coefSeq sine_error 0 x--sine_coefSeq :: -    (RA.ERIntApprox ira) => -    Int -> ira--sine_coefSeq n-  | n `mod` 4 == 0 = 0-  | n `mod` 4 == 1 = 1-  | n `mod` 4 == 2 = 0-  | n `mod` 4 == 3 = -1-  -sine_error n = (-1) RA.\/ 1  --{- maximal extensions -}--erSine_IR ::-    (RA.ERIntApprox ira) =>-    EffortIndex -> ira -> ira -    -erSine_IR = -    RA.maxExtensionR2R sineExtremes erSine_R-    -erCosine_IR ::-    (RA.ERIntApprox ira) =>-    EffortIndex -> ira -> ira -    -erCosine_IR = -    RA.maxExtensionR2R cosineExtremes erCosine_R-        -erSine_IR_Inner ::-    (RA.ERIntApprox ira) =>-    EffortIndex -> ira -> ira -    -erSine_IR_Inner = -    RA.maxExtensionInnerR2R sineExtremes erSine_R-    -erCosine_IR_Inner ::-    (RA.ERIntApprox ira) =>-    EffortIndex -> ira -> ira -    -erCosine_IR_Inner = -    RA.maxExtensionInnerR2R cosineExtremes erCosine_R-        -sineExtremes ix x = fst $ sineExtremesAndDirections ix x-cosineExtremes ix x = fst $ cosineExtremesAndDirections ix x-        -sineExtremesAndDirections ix x -    | RA.isBounded x =-        alternatingExtremes 1 (-1) ix scaledX-    | otherwise = ([-1,1], (Nothing, Nothing))-    where-    scaledX = (x / (erPi_R ix)) - 0.5-    -cosineExtremesAndDirections ix x-    | RA.isBounded x =-        alternatingExtremes 1 (-1) ix scaledX-    | otherwise = ([-1,1], (Nothing, Nothing))-    where-    scaledX = (x / (erPi_R ix))-    -alternatingExtremes extrHigh extrLow ix scaledX-    | extremesCount == 1 && even minExtremeN = -        ([extrHigh], (Just True, Just False)) -- increasing, decreasing-    | extremesCount == 1 =-        ([extrLow], (Just False, Just True)) -- decreasing, increasing-    | extremesCount >= 2 = -        ([extrHigh,extrLow], (Just $ even minExtremeN, Just $ odd maxExtremeN))  -    | otherwise = -        ([], (Just isIncreasing, Just isIncreasing))-    where-    extremesCount = 1 + maxExtremeN - minExtremeN-    isIncreasing = even maxExtremeN-    (xFloor, xCeiling) = RA.integerBounds scaledX-    minExtremeN = -        case RA.compareReals (fromInteger $ toInteger xFloor) scaledX of-            Just LT -> (xFloor + 1)-            _ -> xFloor-    maxExtremeN =-        case RA.compareReals scaledX (fromInteger $ toInteger xCeiling) of-            Just LT -> xCeiling - 1-            _ -> xCeiling-        --{--    tan(x), atan(x) and pi--}--erATan_R :: -    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira-    -erATan_R = atanEuler_R--erATan_IR ::-    (RA.ERIntApprox ira) =>-    EffortIndex -> ira -> ira -    -erATan_IR =-    RA.maxExtensionR2R noExtrema erATan_R--erATan_IR_Inner ::-    (RA.ERIntApprox ira) =>-    EffortIndex -> ira -> ira --erATan_IR_Inner =-    RA.maxExtensionInnerR2R noExtrema erATan_R--{- atan using Euler's 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]--}--atanEuler_R ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira--atanEuler_R ix x -    | x `RA.refines` RA.plusInfinity = RA.plusInfinity  -    | x `RA.refines` (- RA.plusInfinity) = - RA.plusInfinity  -    | not $ RA.isBounded x = RA.bottomApprox -    | x `RA.refines` ((-1.5) RA.\/ 1.5) =-        (x / xSquarePlus1) * (series ix (RA.setMinGranularityOuter gran 2))-    | otherwise = -- too far from 0, needs atan(x) = 2*atan(x/(1+sqrt(1+x^2)))-        2 * (atanEuler_R ix $ x / (1 + sqrtXQuarePlus1))-    where-    gran = effIx2gran ix-    series termsCount coeffBase -        | termsCount > 0 =-            1 + xSquareOverXSquarePlus1 * coeff * (series (termsCount - 1) (coeffBase + 2))-        | otherwise =-            1 + xSquare * (0 RA.\/ 1)-        where-        coeff = coeffBase / (coeffBase + 1)-    xSquare = abs $ x * x-    xSquarePlus1 = xSquare + 1-    xSquareOverXSquarePlus1 = xSquare / xSquarePlus1-    sqrtXQuarePlus1 =-        iterateIx 10 EI.MinusInfinity-        where-        iterateIx ix prevPrec -            | prevPrec == currentPrec = result-            | otherwise =-                iterateIx (ix * 2) currentPrec-            where -            result = erSqrt_R ix xSquarePlus1-            currentPrec = RA.getPrecision result -    ---{- atan using Newton -}------atanNewton_RA :: ---    (RA.ERIntApprox ira) => ---    EffortIndex -> ra -> ra---    ---atanNewton_RA i x = ---    erNewton_FullArgs ---        ( \ i y -> (erTan_RA i y) - x, erTanDeriv_RA) ---        (RA.setMinGranularityOuter (effIx2gran i) (x))---        (RA.setMinGranularityOuter (effIx2gran i) 1) ---        (fromInteger $ toInteger i)---        i--{- tan -}--erTan_R :: -    (RA.ERIntApprox ira) => -    EffortIndex -> ira -> ira-    -erTan_R ix x =-    (erSine_R ix x) / (erCosine_R ix x)--erTanDeriv_R ix x = -    recip $ abs $ cosx * cosx-    where-    cosx = erCosine_R ix x---{- pi -}--{-|-    pi using Bellard's formula-    -    Convergence properties:-    -    * shrinking sequence-     -    * rate at least 2^(-i).-    --}-erPi_R :: -    (RA.ERIntApprox ira) => -    EffortIndex -> ira-erPi_R = piBellard_R---- | pi using atan -piAtan_R ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira-piAtan_R ix =-    (*) 4 $ atanEuler_R ix 1--{-|-    pi using Bellard's formula-    (see <http://en.wikipedia.org/wiki/Computing_π>)-    -    Convergence properties:-    -    * shrinking sequence-     -    * rate at least 2^(-i).-    --}-piBellard_R ::-    (RA.ERIntApprox ira) => -    EffortIndex -> ira-piBellard_R ix =-    r1over64 * (sum $ reverse $ bellardTerms 0 (10 + (ix `div` 10)) (1,z,z))-    {- -      sum from the smallest to the largest -      (got this trick from Martin Escardo who said he got it from Andrej Bauer)-      -      the rounding error dominates the truncation error to such-      a degree that the truncation error can be safely left out-      -      each bellard term contributes 10 binary digits that the following terms-      do not influence-    -} -    where-    gran = max 0 (effIx2gran ix) + 10-    r1over64 = (RA.setMinGranularityOuter gran 1) / 64-    r1over1024 = (RA.setMinGranularityOuter gran 1) / 1024-    z = RA.setMinGranularityOuter gran 0-    bellardTerms n nMax (mult, r4n, r10n)-        | n >= nMax = []-        | otherwise =-             termN : rest-        where-        rest = -            bellardTerms (n + 1) nMax (- mult * r1over1024, r4n + 4, r10n + 10)-        termN = -            mult * bellardSum-        bellardSum =-            -- sum from the smallest to the largest-            (recip $ r10n + 9)-            - (recip $ r4n + 3)-            - 4 * ((recip $ r10n + 7) + (recip $ r10n + 5))-            - (64 / (r10n + 3))-            - (32 / (r4n + 1))-            + (256 / (r10n + 1)) -    -
− src/Data/Number/ER/Real/Arithmetic/Integration.hs 
@@ -1,141 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Arithmetic.Integration-    Description :  simple integration methods-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Simple integration methods for Haskell functions operating -    on real number approximations.--}-module Data.Number.ER.Real.Arithmetic.Integration-(-    integrateCont,---    integrateDiff,-    integrateCont_R,-    integrateContAdapt_R-)-where--import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.BasicTypes-import Data.Number.ER.Real.Approx.Sequence-import Data.Number.ER.Real.Arithmetic.Elementary--testIntegr1 :: -    (RA.ERIntApprox ira, Ord ira) => -    (ConvergRealSeq ira)-testIntegr1 = integrateCont erExp_IR 0 1--integrateCont :: -    (RA.ERIntApprox ira) => -    (EffortIndex -> ira -> ira) ->-    (ConvergRealSeq ira) -> (ConvergRealSeq ira) -> (ConvergRealSeq ira)--integrateCont f = convertBinFuncRA2Seq $ integrateContAdapt_R f--integrateDiff :: -    (RA.ERIntApprox ira) => -    (EffortIndex -> ira -> ira, EffortIndex -> ira -> ira) ->-    (ConvergRealSeq ra) -> (ConvergRealSeq ra) -> (ConvergRealSeq ra)--integrateDiff f = convertBinFuncRA2Seq $ integrateDiffAdapt_RA f---{-|-    naive integration, using a partition of 2 * prec equally sized intervals--}-integrateCont_R ::-    (RA.ERIntApprox ira) => -    (EffortIndex -> ira -> ira) ->-    EffortIndex -> (ira) -> (ira) -> (ira)-integrateCont_R f ix a b =-    sum $ map rectArea rectangles-    where-    rectArea (width, height) = width * height-    rectangles = -        zip (repeat width) $ map (f ix) covering-    width = (b - a) / (fromInteger rectCount)-    rectCount = 2 * (fromInteger $ toInteger gran)-    gran = effIx2gran ix-    covering = getCoveringIntervals division-    getCoveringIntervals ( pt1 : pt2 : rest ) =-        ((pt1) RA.\/ (pt2)) : (getCoveringIntervals $ pt2 : rest)-    getCoveringIntervals _ = []-    division = map getEndPoint $ [0..rectCount]-    getEndPoint n =-        a + ((fromInteger n) * width)--{-|-    integration using divide and conquer adaptive partitioning--}-integrateContAdapt_R ::-    (RA.ERIntApprox ira) => -    (EffortIndex -> ira -> ira) ->-    EffortIndex -> (ira) -> (ira) -> (ira)-integrateContAdapt_R f ix a b =-    sum rectangleAreas-    where-    rectangleAreas = -        getRs 10 a b-    getRs subix l r-        | RA.getPrecision area >= prec = [area]-        | otherwise =-            (getRs nsubix l m) ++ (getRs nsubix m r)-        where-        prec = foldl1 min [effIx2prec ix, RA.getPrecision l, RA.getPrecision r]-        area = (r - l) * (f subix (l RA.\/ r))-        nsubix = subix + 1-        m = (l + r)/2-        --{-|-    integration using divide and conquer adaptive partitioning-    making use of the derivative of the integrated function--}-integrateDiffAdapt_RA ::-    (RA.ERIntApprox ira) => -    (EffortIndex -> ira -> ira, EffortIndex -> ira -> ira) ->-    EffortIndex -> (ra) -> (ra) -> (ra)-integrateDiffAdapt_RA f prec a b =-    error "TODO"-    -{--    sum rectangleAreas-    where-    rectangleAreas = -        getRs prec a b-    getRs p l r-        | getPrecision area >= prec = [area]-        | otherwise =-            (getRs np l m) ++ (getRs np m r)-        where-        np = p + 1-        m = (l + r)/2---        area = areaDiff-        area = areaRect /\ areaDiff-            -- merge the information given by the rectangle method-            -- with the information given by the derivative method-        areaRect = w * fVal -- same as in integrateContAdapt_R-        (fVal, fDeriv) = applyRdiffR f p (l \/ r)-        w = r - l-        areaDiff-            | isExact fDeriv = w * (fl + fr) / 2 -- derivative is constant and perfectly known-            | otherwise = areaLow \/ areaHigh-        fl = fst $ applyRdiffR f (2 * p) l-        fr = fst $ applyRdiffR f (2 * p) r-            -- interestingly, we have to request fl, fr with higher precision than-            -- we requested fDeriv so that the derivative would be of any use-            -- with these values - replace (2 * p) by p and it will not converge!-        -- area computed by a scary formula:-        areaLow = t + w * (fl * dHigh - fr * dLow) / dDiff-        areaHigh = - t - w * (fl * dLow - fr * dHigh) / dDiff -- swap dHigh and dLow-        t = (w^2 * dLow * dHigh + (fr - fl)^2)/(2 * dDiff)-        dDiff = dHigh - dLow-        (dLow, dHigh) = getBounds fDeriv--}        -        -
− src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs 
@@ -1,116 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.LinearSolver-    Description :  arbitrary precision piece-wise something function enclosures-    Copyright   :  (c) Jan Duracz, Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    A simple validated solver for systems of linear equations with-    interval coefficients.  It uses a naive splitting approach and is-    therefore very slow.--}-module Data.Number.ER.Real.Arithmetic.LinearSolver -(-    linearSolver-)-where--import qualified Data.Number.ER.Real.Approx as RA -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.List-import Data.Maybe---import qualified Data.Map as Map---- the following is code for unit testing -{---import Data.Number.ER.Real.DefaultRepr --eq1 :: (Box IRA, IRA)-eq1 = (mkBox [1,2,1], 2)-eq2 = (mkBox [2,4,2], 4)-eq3 = (mkBox [2,4,4], 5)-eqs = [eq1,eq2,eq3]--box = mkBox $ replicate 3 $ (-1)RA.\/1  -x1 = (-13/16)RA.\/(-3/4) :: IRA-x2 = (5/16)RA.\/(3/8) :: IRA-tol = 2^^(-20) :: IRA--mkBox :: [IRA] -> Box IRA-mkBox iras = Map.fromList $ zip [1..] iras--}--linearSolver ::-    (RA.ERIntApprox ira, -     DomainIntBox box varid ira,-     DomainBoxMappable box box varid ira ira) =>-    [(box, ira)] -        {-^ the equations; -            each equation has coefficients of linear terms -              + constant term -} ->-    box {-^ the domain of the variables -} ->-    ira {-^ an upper bound on the size of an acceptable solution box -} ->-    Maybe box -        {-^ -            A box containing at least one solution within the domain; -            Nothing if there is no solution. -        -}-linearSolver eqns domBox tolerance =-    linearSolver' eqns [domBox] tolerance-    -linearSolver' eqns [] tolerance = -    Nothing-linearSolver' eqns (b:bs) tolerance-    | not $ evalEqns b eqns = -- no solutions in the box-        linearSolver' eqns bs tolerance-    | belowTolerance = -        Just b-    | otherwise = -        linearSolver' eqns (splitBox b ++ bs) tolerance-    where-    belowTolerance =-        and $ map (\d -> width d `RA.ltSingletons` tolerance) $ DBox.elems b--evalEqns box eqns =-    and $ map (evalEqn box) eqns-            -{-|-    returns true iff there exists a solution to the equation in the box--}-evalEqn box (expr,cons) = -    cons `RA.refines` (evalExpr expr box)-    where-    evalExpr expr box = sum $ DBox.elems $ DBox.intersectionWith (*) expr box--{-|-    returns the list of (two) boxes resulting from splitting the widest edge -    of the box in half--}-splitBox box =-    [DBox.insert k (iLg RA.\/ iMg) box, -     DBox.insert k (iMg RA.\/ iRg) box]-    where-    iMg = (iLg+iRg)/2-    iLg = incrementGranularity iL-    iRg = incrementGranularity iR-    (iL,iR) = RA.bounds i-    i = DBox.lookup "ER: LinearSolver: splitBox: " k box-    k = widestVar box-    incrementGranularity x =-        RA.setMinGranularityOuter (RA.getGranularity x + 1) x--widestVar box =-    fst $ DBox.bestSplit box--width i =-    snd $ RA.bounds (iR-iL)-    where-    (iL,iR) = RA.bounds i-
− src/Data/Number/ER/Real/Arithmetic/Newton.hs 
@@ -1,201 +0,0 @@-{-| --    Module      :  Data.Number.ER.Real.Arithmetic.Taylor-    Description :  interval Newton method-    Copyright   :  (c) Amin Farjudian, Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  alpha-    Portability :  portable--    Interval Newton's method for root finding. -       -    To be used for obtaining functions out of their inverse(s) over various -    intervals.--}-module Data.Number.ER.Real.Arithmetic.Newton -(-    erNewton_FullArgs,-    erNewton_mdfd_FullArgs-)-where--import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.BasicTypes-import Data.Number.ER.Real.Arithmetic.Taylor--erNewton_FullArgs-	:: (RA.ERIntApprox ira)-	=> (EffortIndex -> ira -> ira, EffortIndex -> ira -> ira) -- ^ a function and its derivative-	-> ira -- ^ a starting point-	-> ira -- ^ a lower bound of the absolute value of the derivative over the working interval-	-> Int -- ^ number of iterations-	-> EffortIndex  -- ^ the initial index to use for argument function and its derivative-	-> ira -- ^ the result-	-erNewton_FullArgs (f ,df) startPt minDrv iterCnt i = -    erNewton_FullArgs_aux startPt startOtherPt iterCnt-	where -    erNewton_FullArgs_aux newtonPt otherPt iterCnt-        | (iterCnt <= 0 || RA.getPrecision result >= prec) =-            result -        | otherwise = -            erNewton_FullArgs_aux newNewtonPt newOtherPt (iterCnt - 1)-        where -        result = -            newtonPt RA.\/ otherPt-        prec = effIx2prec i -        newNewtonPt = -            midPoint $ RA.bounds $ -            (newtonPt - ( (f i newtonPt) / (( df i newtonPt)))) -               --  /\ (ira2ra ((ra2ira minDrv) \/ 100000000)))))-        newOtherPt = otherEndPoint newNewtonPt-    startOtherPt = otherEndPoint startPt-    otherEndPoint a =  a - ((f i a) / minDrv) --   /\ (0 \/ 10000000)--    -{-|-    This auxiliary function returns the average of two ra's--}-midPoint-    :: (RA.ERIntApprox ira)-    => (ira ,ira)-    -> ira-midPoint (x1, x2) = (x1 + x2) / 2-        --{-| Modified Newton Method-    Notes:-    -        1. It has a cubic convergence speed, as opposed to the original Newton's-            square convergence speed.-            -        2. It does not deal with multiple roots.-        -        3. Per iteration, it makes two queries on the derivative, so it best -            suits the cases where computation of the derivative is at most as-            expensive as the function itself.--}-erNewton_mdfd_FullArgs-    :: (RA.ERIntApprox ira)-    => (EffortIndex -> ira -> ira, EffortIndex -> ira -> ira) -- ^ a function and its derivative-    -> ira -- ^ a starting point-    -> ira -- ^ The minimum of absolute value of derivative over the working interval-    -> Int -- ^ number of iterations-    -> EffortIndex  -- ^ It triggers the initial index to be called by the argument function and its derivative.-    -> ira -- ^ the result-    -erNewton_mdfd_FullArgs (f ,df) startPt minDrv iterCnt i = -    erNewton_FullArgs_aux startPt startOtherPt iterCnt-    where -    erNewton_FullArgs_aux newtonPt otherPt iterCnt-        | iterCnt <= 0 = newtonPt RA.\/ otherPt-        | otherwise = erNewton_FullArgs_aux newNewtonPt newOtherPt (iterCnt - 1)-        where-        valueAtNewOtherPt = f i newOtherPt-        derivAtNewtonPt   = df i newOtherPt-        unblurredDeriv = midPoint $ RA.bounds $ derivAtNewtonPt-        intermediaryPt = midPoint $ RA.bounds $ newtonPt - valueAtNewOtherPt / (2 * derivAtNewtonPt)-        derivAtIntermediaryPt = df i intermediaryPt-        newNewtonPt = -            midPoint $ RA.bounds $ -            (newtonPt - ( valueAtNewOtherPt / derivAtIntermediaryPt))-        newOtherPt = otherEndPoint newNewtonPt-    startOtherPt = otherEndPoint startPt-    otherEndPoint a = a - ((f i a) / minDrv)--erNewton_mdfd-    :: (RA.ERIntApprox ira)-    => (EffortIndex -> ira -> ira, EffortIndex -> ira -> ira) -- ^ a function and its derivative-    -> ira -- ^ a starting point-    -> ira -- ^ The minimum of absolute value of derivative over the working interval-    -> EffortIndex  -- ^ It triggers the initial index to be called by the argument function and its derivative.-    -> ira -- ^ the result-    -erNewton_mdfd (f ,df) startPt minDrv i = -    erNewton_mdfd_FullArgs (f, df) startPt minDrv (fromInteger $ toInteger $ i) i----apNewton_mdfd---    :: (RA.ERIntApprox ira)---    => (EffortIndex -> ra -> ra, EffortIndex -> ra -> ra) -- ^ a function and its derivative---    -> ra -- ^ a starting point---    -> ra -- ^ The minimum of absolute value of derivative over the working interval---    -> EffortIndex  -- ^ It triggers the initial index to be called by the argument function and its derivative. Moreover, the number of iterations are predefined by this argument.---    -> ra -- ^ the result---    ---apNewton_mdfd (f, df) startPt minDrv i =---    erNewton_mdfd_FullArgs----			---id_RA ---	:: (RA.ERIntApprox ira)---	=> EffortIndex -> ira -> ira------id_RA i x = x------const_one_RA---	:: (RA.ERIntApprox ira)---	=> EffortIndex -> ira -> ira------const_one_RA i x = (setMinGranularity (effIx2gran i) 1)---	------test_erNewton_FullArgs_01_RA ---	:: (RA.ERIntApprox ira)---	=> EffortIndex -> ira -> ira------test_erNewton_FullArgs_01_RA i x = erNewton_FullArgs_01 ( id_RA, const_one_RA) x 10 i------test_erNewton_FullArgs_01---	:: (RA.ERIntApprox ira)---	=> (ConvergRealSeq ira) -> (ConvergRealSeq ira)---	---test_erNewton_FullArgs_01 = convertFuncRA2Seq test_erNewton_FullArgs_01_RA------exp_Ra_minus_r_RA---	:: (RA.ERIntApprox ira)---	=> EffortIndex -> ira -> ira -> ira ---	---exp_Ra_minus_r_RA i r x = (erExp_RA i x) - r------exp_Ra_minus_r ---	:: (RA.ERIntApprox ira)---	=> (ConvergRealSeq ira) -> (ConvergRealSeq ira) -> (ConvergRealSeq ira)------exp_Ra_minus_r = convertBinFuncRA2Seq exp_Ra_minus_r_RA------logNewton_RA_02---    :: (RA.ERIntApprox ira)---    => EffortIndex -> ira -> ira---    ---logNewton_RA_02 i x = ---    erNewton_FullArgs_02---        ( \ i y -> (erExp_RA i y) - x, erExp_RA) ---        (setMinGranularity (effIx2gran i) (2)) ---        (setMinGranularity (effIx2gran i) 1) ---        i   ------logNewton_02  ---    :: (RA.ERIntApprox ira)---    => (ConvergRealSeq ira) -> (ConvergRealSeq ira)---    ---logNewton_02 = convertFuncRA2Seq logNewton_RA_02-----logNewton_mdfd_RA---    :: (RA.ERIntApprox ira)---    => EffortIndex -> ira -> ira-    ---logNewton_mdfd_RA i x = ---    erNewton_mdfd_FullArgs---        ( \ i y -> (erExp_RA i y) - x, erExp_RA) ---        (setMinGranularity (effIx2gran i) (2)) ---        (setMinGranularity (effIx2gran i) 1) ---        i   ----logNewton_mdfd---    :: (RA.ERIntApprox ira)---    => (ConvergRealSeq ira) -> (ConvergRealSeq ira)---    ---logNewton_mdfd = convertFuncRA2Seq logNewton_mdfd_RA
− src/Data/Number/ER/Real/Arithmetic/Taylor.hs 
@@ -1,195 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Arithmetic.Taylor-    Description :  implementation of Taylor series-    Copyright   :  (c) Amin Farjudian, Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Taylor series related functions.--}-module Data.Number.ER.Real.Arithmetic.Taylor where--import qualified Data.Number.ER.Real.Approx as RA-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI-import Data.Number.ER.BasicTypes-import Data.Number.ER.Misc---erTaylor_R-    :: (RA.ERIntApprox ira)-    => EffortIndex-    -> (Int -> ira) -- ^ coefficients of the Taylor series-    -> (Int -> ira) -- ^ function to estimate the n'th derivative between a and x-    -> ira -- ^ centre of the Taylor Expansion-    -> ira -    -> ira-erTaylor_R ix coefSeq derivBounds a x =-    erTaylor_R_FullArgs coefSeq derivBounds n a gran x-    where-    n = fromInteger ix-    gran = fromInteger $ toInteger $ ix--erTaylor_R_FullArgs-    :: (RA.ERIntApprox ira)-    => (Int -> ira)  -- ^ coefficients of the Taylor series-    -> (Int -> ira) -- ^ function to estimate the n'th derivative between a and x-    -> Int -- ^ use this many elements of the series (+ account for error appropriately)-    -> ira -- ^ centre of the Taylor Expansion-    -> Granularity -- ^ make all constants have this granularity, thus influencing rounding errors-    -> ira -    -> ira-erTaylor_R_FullArgs coefSeq derivBounds n a gran x = -    rec_apTaylor (RA.setMinGranularityOuter gran 0) 0-    where-    rec_apTaylor i j-        | n > j = (coefSeq(j)) + -                        ((x - a)/(i+1)) * (rec_apTaylor (i+1) (j+1))-        | n == j = derivBounds n-        | otherwise = -            error "Data.Number.ER.Real.Arithmetic.Taylor.hs: erTaylor_RA_FullArgs: The index n cannot be negative"--{-|-    A Taylor series for exponentiation.    --}-erExp_Tay_Opt_R-    :: (RA.ERIntApprox ira)-    => EffortIndex-    -> ira-    -> ira-erExp_Tay_Opt_R ix x -    | x `RA.refines` (-RA.plusInfinity) = ---        unsafePrintReturn---        (---            "erExp_Tay_Opt_R (x `RA.refines` (-RA.plusInfinity)): "---            ++ "\n x = " ++ show x---            ++ "\n ix = " ++ show ix---            ++ "\n result = "---        ) $-        0 -- -infty is not handled well by the Taylor formula-    | otherwise = ---        unsafePrintReturn---        (---            "erExp_Tay_Opt_R: "---            ++ "\n x = " ++ show x---            ++ "\n ix = " ++ show ix---            ++ "\n result = "---        ) $-        1 + (te ix x (RA.setMinGranularityOuter gran 1))-    where-    gran = effIx2gran ix-    te steps x i-        | steps > 0 =-            (x/i) * (1 + (te (steps - 1) x (i + 1)))-        | steps == 0 = -            errorBound-            where-            errorBound = -                (x/i) * ithDerivBound-            ithDerivBound -                | xCeiling == EI.MinusInfinity = -- certainly -infty:-                    0-                | xCeiling < 0 = -- certainly negative:-                    pow26xFloor RA.\/ 1-                | xFloor > 0 = -- certainly positive:-                    1 RA.\/ pow28xCeiling-                | otherwise = -- could contain 0:-                    pow26xFloor RA.\/ pow28xCeiling-                where-                (xFloor, xCeiling) = RA.integerBounds x-                pow26xFloor -                    | xFloor == EI.MinusInfinity =-                        0-                    | otherwise = -                        ((RA.setMinGranularityOuter gran 26)/10) ^^ xFloor -                            -- lower estimate of e^x-                pow28xCeiling -                    | xCeiling == EI.PlusInfinity =-                        (RA.plusInfinity)-                    | otherwise = -                        ((RA.setMinGranularityOuter gran 28)/10) ^^ xCeiling -                            -- upper estimate of e^x--{-- The sine and cosine are implemented in almost exactly the same way --}--{-|-    A Taylor series for sine.    --}-erSine_Tay_Opt_R-    :: (RA.ERIntApprox ira)-    => EffortIndex-    -> ira-    -> ira-erSine_Tay_Opt_R ix x = -    taylor_seg ix x (RA.setMinGranularityOuter gran 1)-    where-    gran = effIx2gran ix-    taylor_seg i x n -- 'i' for iterator-        | i > 0  = x - (x*x)/((n+1)*(n+2)) * (taylor_seg (i-2) x (n+2))-        | otherwise = errorRegion-        where -        errorRegion = (- x) RA.\/ x-                    -		-{-|-    A Taylor series for cosine.    --}-erCosine_Tay_Opt_R -    :: (RA.ERIntApprox ira) -    => EffortIndex -    -> ira-    -> ira-erCosine_Tay_Opt_R ix x = taylor_seg ix x (RA.setMinGranularityOuter gran 1)-	where-    gran = effIx2gran ix-    taylor_seg i x n -- 'i' for iterator-        | i > 0  = 1 - ((x*x)/(n*(n+1))) * (taylor_seg (i-2) x (n+2))-        | otherwise = errorRegion-        where -        errorRegion = (-1) RA.\/ (1)--   -				-{-| Natural Logarithm: The following is a code for obtaining natural- 	logarithm using taylor series. Note that it only works for - 	x in [ 1, 2]. For other values, a scaling by factors of e^q is- 	best to do, i.e. if x is not in [1,2], then find some ratioal number				- 	q where exp(q) * x is in [1,2]. Then you have:- 	log ( exp(q) * m)  = q + log(m)--}--{-| Coefficients of the taylor series around a=1 -}---logTayCoefs---	:: (RA.ERIntApprox ira)---	=>	Int -- up to how many terms of the Taylor series is desired---	-> Int---    -> ra---	---logTayCoefs n i -----	| i < 0 = error "ERTaylor.logTayCoefs: Negative n for the n-th term of Taylor series for logarithm"---	| i == 0 = 0---	| i == n = fromInteger $ toInteger $ amFact(n-1)	---	| otherwise = fromInteger $ toInteger $ ((-1)^(i-1) * amFact(i-1))---	where---		amFact (m) = product [1..m]-		---logTay_RA---	:: (RA.ERIntApprox ira)---	=> EffortIndex---    -> ra---    -> ra---	---logTay_RA i = erTaylor_RA_FullArgs (logTayCoefs $fromInteger $ toInteger $ i) ---                (100000) (setMinGranularity (effIx2gran i) 1) (effIx2gran i)---	---	---logTay ---	:: (RA.ERIntApprox ira)	---	=> (ConvergRealSeq ra)---    -> (ConvergRealSeq ra)---logTay = convertFuncRA2Seq logTay_RA	-
− src/Data/Number/ER/Real/Base.hs 
@@ -1,68 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Base-    Description :  class abstracting floats-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Abstraction over various fixed and floating point types as well-    as rational numbers.-    -    This module should be included qualified as is often given the local-    synonym B.--}-module Data.Number.ER.Real.Base-(-    module Data.Number.ER.BasicTypes,-    ERRealBase(..)-)-where--import Data.Number.ER.BasicTypes-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI--import Data.Typeable--{-|-    This class is an abstraction of a subset of real numbers-    with *upwards rounded* operations. --}-class (RealFrac rb, Ord rb) => ERRealBase rb -    where-    typeName :: rb -> String-    initialiseBaseArithmetic :: rb -> IO ()-    initialiseBaseArithmetic x = -		do-		putStrLn $ "Base arithmetic: " ++ typeName x-    defaultGranularity :: rb -> Granularity-    getApproxBinaryLog :: rb -> EI.ExtendedInteger-    getGranularity :: rb -> Granularity-    setMinGranularity :: Granularity -> rb -> rb-    setGranularity :: Granularity -> rb -> rb-    {-|-        if @a@ is rounded to @ao@ then @|a-ao| <= getBaseMaxRounding ao@-    -}-    getMaxRounding :: rb -> rb-    isERNaN :: rb -> Bool-    erNaN :: rb-    isPlusInfinity :: rb -> Bool-    isMinusInfinity :: rb -> Bool-    isMinusInfinity = isPlusInfinity . negate-    plusInfinity :: rb-    minusInfinity :: rb-    minusInfinity = - plusInfinity-    fromIntegerUp :: Integer -> rb-    fromIntegerDown :: Integer -> rb-    fromIntegerDown i = negate $ fromIntegerUp $ - i-    fromDouble :: Double -> rb-    toDouble :: rb -> Double-    fromFloat :: Float -> rb-    toFloat :: rb -> Float-    showDiGrCmp :: -        Int {- ^ number of decimal digits to show -} ->-        Bool {-^ whether to show granularity -} ->-        Bool {-^ whether to show internal structure -} ->-        rb -> String
− src/Data/Number/ER/Real/Base/CombinedMachineAP.hs 
@@ -1,244 +0,0 @@-{-# LANGUAGE DeriveDataTypeable   #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-|-    Module      :  Data.Number.ER.Real.Base.CombinedMachineAP-    Description :  auto-switching hardware-software floats -    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  non-portable (requires fenv.h)--    Arbitrary precision floating point numbers that use-    machine double up to its precision.  When a higher-    granularity is required, it automatically switches -    to another floating point type.--}-module Data.Number.ER.Real.Base.CombinedMachineAP -(-    ERMachineAP,-    doubleDigits-)-where--import qualified Data.Number.ER.Real.Base as B-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI-import Data.Number.ER.Real.Base.MachineDouble-import Data.Number.ER.Real.Base.Float-import Data.Number.ER.BasicTypes-import Data.Number.ER.Misc--import Data.Typeable-import Data.Generics.Basics-import Data.Binary---import BinaryDerive--import Data.Ratio--data ERMachineAP b =-    ERMachineAPMachineDouble-    {-        machapfltDoubleGranularity :: Granularity-        {-^ this has to be between 1 and 'doubleDigits' -}-    ,-        machapfltDouble :: Double-    }-    |    -    ERMachineAPB-    {-        machapfltB :: b-    }-    deriving (Typeable, Data)--doubleDigits = floatDigits (0 :: Double)--{- the following has been generated by BinaryDerive -}     -instance (Binary b) => (Binary (ERMachineAP b)) where-  put (ERMachineAPMachineDouble a b) = putWord8 0 >> put a >> put b-  put (ERMachineAPB a) = putWord8 1 >> put a-  get = do-    tag_ <- getWord8-    case tag_ of-      0 -> get >>= \a -> get >>= \b -> return (ERMachineAPMachineDouble a b)-      1 -> get >>= \a -> return (ERMachineAPB a)-      _ -> fail "no parse"-{- the above has been generated by BinaryDerive -}-    -lift1ERMachineAP ::-    (Double -> Double) ->-    (b -> b) ->-    (ERMachineAP b -> ERMachineAP b)-lift1ERMachineAP fD fB (ERMachineAPMachineDouble g d) = -    ERMachineAPMachineDouble g (fD d) -lift1ERMachineAP fD fB (ERMachineAPB b) = -    ERMachineAPB (fB b) --op1ERMachineAP ::-    (Double -> a) ->-    (b -> a) ->-    (ERMachineAP b -> a)-op1ERMachineAP fD fB (ERMachineAPMachineDouble g d) = -    fD d -op1ERMachineAP fD fB (ERMachineAPB b) = -    fB b --lift2ERMachineAP ::-    (B.ERRealBase b) =>-    (Double -> Double -> Double) ->-    (b -> b -> b) ->-    (ERMachineAP b -> ERMachineAP b -> ERMachineAP b)-lift2ERMachineAP fD fB -        (ERMachineAPMachineDouble g1 d1) (ERMachineAPMachineDouble g2 d2) = -    ERMachineAPMachineDouble (max g1 g2) (fD d1 d2)-lift2ERMachineAP fD fB -        (ERMachineAPMachineDouble g1 d1) (ERMachineAPB b2) = -    ERMachineAPB $ fB (B.fromDouble d1) b2-lift2ERMachineAP fD fB -        (ERMachineAPB b1) (ERMachineAPMachineDouble g2 d2) = -    ERMachineAPB $ fB b1 (B.fromDouble d2)-lift2ERMachineAP fD fB -        (ERMachineAPB b1) (ERMachineAPB b2) = -    ERMachineAPB $ fB b1 b2-    -op2ERMachineAP ::-    (B.ERRealBase b) =>-    (Double -> Double -> a) ->-    (b -> b -> a) ->-    (ERMachineAP b -> ERMachineAP b -> a)-op2ERMachineAP fD fB -        (ERMachineAPMachineDouble g1 d1) (ERMachineAPMachineDouble g2 d2) = -    fD d1 d2-op2ERMachineAP fD fB -        (ERMachineAPMachineDouble g1 d1) (ERMachineAPB b2) = -    fB (B.fromDouble d1) b2-op2ERMachineAP fD fB -        (ERMachineAPB b1) (ERMachineAPMachineDouble g2 d2) = -    fB b1 (B.fromDouble d2)-op2ERMachineAP fD fB -        (ERMachineAPB b1) (ERMachineAPB b2) = -    fB b1 b2-    -instance (B.ERRealBase b) => Show (ERMachineAP b)-    where-    show = showERMachineAP 6 True True-    -showERMachineAP numDigits showGran showComponents =-    showEMA-    where-    maybeGran gr-        | showGran = "{g=" ++ show gr ++ "}"-        | otherwise = ""-    maybeComps-        | showComponents = "{Double}"-        | otherwise = ""-    showEMA (ERMachineAPMachineDouble gr d) = -        show d ++ (maybeGran gr) ++ maybeComps-    showEMA (ERMachineAPB b) = -        B.showDiGrCmp numDigits showGran showComponents b---instance (B.ERRealBase b) => Eq (ERMachineAP b)-    where-    (==) = op2ERMachineAP (==) (==)-    -instance (B.ERRealBase b) => Ord (ERMachineAP b)-    where-    compare = op2ERMachineAP compare compare-    --    -instance (B.ERRealBase b) => Num (ERMachineAP b)-    where-    fromInteger n -        | gran < doubleDigits = -            ERMachineAPMachineDouble gran $ fromInteger n-        | otherwise = -            ERMachineAPB b-        where-        gran = B.getGranularity b    -        b = fromInteger n-    abs = lift1ERMachineAP abs abs  -    signum = lift1ERMachineAP signum signum-    negate = lift1ERMachineAP negate negate-    (+) = lift2ERMachineAP (+) (+)-    (*) = lift2ERMachineAP (*) (*)-    -instance (B.ERRealBase b) => Fractional (ERMachineAP b)-    where-    fromRational rat =-        (fromInteger $ numerator rat) -        / (fromInteger $ denominator rat)-    recip = lift1ERMachineAP recip recip-    (/) = lift2ERMachineAP (/) (/)-        -instance (B.ERRealBase b, Real b) => Real (ERMachineAP b)-    where-    toRational = op1ERMachineAP toRational toRational-    -instance (B.ERRealBase b, RealFrac b) => RealFrac (ERMachineAP b)-    where-    properFraction (ERMachineAPMachineDouble g d) =-        (a, ERMachineAPMachineDouble g remainder)-        where-        (a,remainder) = properFraction d -    properFraction (ERMachineAPB b) =-        (a, ERMachineAPB remainder)-        where-        (a,remainder) = properFraction b -        -        -instance (B.ERRealBase b) => B.ERRealBase (ERMachineAP b)-    where-    typeName _ = "auto switching double and " ++ (B.typeName (0::b))-    initialiseBaseArithmetic x = -		do-		putStr $ "Base arithmetic:" ++ B.typeName x ++ "; "-		initMachineDouble-    defaultGranularity _ = (B.defaultGranularity (0 :: b))-    getApproxBinaryLog = -        op1ERMachineAP doubleBinaryLog B.getApproxBinaryLog-        where-        doubleBinaryLog d-            | d < 0 =-                error $ "ERMachineAP: getApproxBinaryLog: negative argument " ++ show d -            | d == 0 = EI.MinusInfinity -            | d >= 1 =-                fromInteger $ intLogUp 2 $ ceiling d-            | d < 1 =-                negate $ fromInteger $ intLogUp 2 $ ceiling $ recip d-    getGranularity (ERMachineAPB b) = B.getGranularity b-    getGranularity (ERMachineAPMachineDouble gr _) = gr-    setMinGranularity gran (ERMachineAPMachineDouble g d) -        | gran > doubleDigits =-            ERMachineAPB $ B.setMinGranularity gran $ B.fromDouble d-        | otherwise =-            ERMachineAPMachineDouble gran d-    setMinGranularity gran (ERMachineAPB b) = ERMachineAPB $ B.setMinGranularity gran b -    setGranularity gran (ERMachineAPMachineDouble g d) -        | gran > doubleDigits =-            ERMachineAPB $ B.setGranularity gran $ B.fromDouble d-        | otherwise =-            ERMachineAPMachineDouble gran d-    setGranularity gran (ERMachineAPB b)-        | gran <= doubleDigits =-            ERMachineAPMachineDouble gran $ B.toDouble b-        | otherwise = -            ERMachineAPB $ B.setGranularity gran b -    getMaxRounding _ = -        error "ERMachineAP: getMaxRounding not implemented yet"-    isERNaN = op1ERMachineAP isNaN B.isERNaN-    erNaN = B.fromDouble (0/0)-    isPlusInfinity = -        op1ERMachineAP (== 1/0) B.isPlusInfinity-    plusInfinity = B.fromDouble $ 1/0-    fromIntegerUp = fromInteger-    fromDouble d = -        ERMachineAPMachineDouble (B.defaultGranularity (0 :: b)) d-    toDouble = op1ERMachineAP id B.toDouble-    fromFloat f = -        ERMachineAPMachineDouble (B.defaultGranularity (0 :: b)) $-            fromRational $ toRational f-    toFloat = op1ERMachineAP (fromRational . toRational) B.toFloat -    showDiGrCmp = showERMachineAP-
− src/Data/Number/ER/Real/Base/Float.hs 
@@ -1,518 +0,0 @@-{-# LANGUAGE DeriveDataTypeable   #-}-{-|-    Module      :  Data.Number.ER.Real.Base-    Description :  arbitrary precision floating point numbers-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    This module defines an arbitrary precision floating point type and-    its operations.  It should be viewed more abstractly as an instance-    of 'B.ERRealBase' when used as interval endpoints.--}-module Data.Number.ER.Real.Base.Float-(-    ERFloat-)-where--import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI-import Data.Number.ER.BasicTypes.PlusMinus-import Data.Number.ER.Misc-import Data.Number.ER.BasicTypes-import qualified Data.Number.ER.Real.Base as B--import Data.Ratio--import Data.Typeable-import Data.Generics.Basics-import Data.Binary--- import BinaryDerive----debugMsg = unsafePrint-debugMsg msg = id---{-|-A floating point number with a given but arbitrary precision represented by its 'Granularity'.--    * base: 2.-    -    * granularity specifies the bit-size of both the significand and the exponent  --    * special values: NaN, signed Infinity and signed Zero-    -    * no denormalised numbers-    -    * operations unify the granularity of their operands to the maximum 'Granularity'-     -    * Rounding is always towards +Infinity.  -      For field operations, the rounded result is as close as possible to the exact result.--}-data ERFloat =-    ERFloatNaN -- any number / bottom-        { -            apfltGran :: Granularity -- >0-        }-    | ERFloatInfty -        { -            apfltGran :: Granularity, -- >0-            apfltSign :: PlusMinus -        }-    | ERFloatZero-        { -            apfltGran :: Granularity, -- >0-            apfltSign :: PlusMinus -        }-    | ERFloat-        {-            -- represents:-            -- sign * (1 + (mant/2^gran)) * (2 ^ exp)-            apfltGran :: Granularity, -- >0  granularity-            apfltSign :: PlusMinus,-            apfltMant :: Integer, -- 0 .. (2^gran - 1)-            apfltExp :: Integer -- -2^gran..2^gran-        }-    deriving (Typeable, Data)-    -zero = ERFloatZero 10 Plus-    -{- the following has been generated by BinaryDerive -}-instance Binary ERFloat where-  put (ERFloatNaN a) = putWord8 0 >> put a-  put (ERFloatInfty a b) = putWord8 1 >> put a >> put b-  put (ERFloatZero a b) = putWord8 2 >> put a >> put b-  put (ERFloat a b c d) = putWord8 3 >> put a >> put b >> put c >> put d-  get = do-    tag_ <- getWord8-    case tag_ of-      0 -> get >>= \a -> return (ERFloatNaN a)-      1 -> get >>= \a -> get >>= \b -> return (ERFloatInfty a b)-      2 -> get >>= \a -> get >>= \b -> return (ERFloatZero a b)-      3 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (ERFloat a b c d)-      _ -> fail "no parse"-{- the above has been generated by BinaryDerive -}-    -    -{-| normalisation--  * ensures that the components are within their regions-  -  * possibly turning the number into a zero or infinity--}-normaliseERFloat :: ERFloat -> ERFloat-normaliseERFloat flt@(ERFloat gr s m e) -    | m < 0 = -        normaliseERFloat $ -        ERFloat gr s (2*m + grmax) (e - 1)-    | m >= grmax =-        normaliseERFloat $ -        ERFloat gr s ((m - grmax + (rndCorr s)) `div` 2) (e + 1)-    | e > grmax =-        case s of-            Plus -> ERFloatInfty gr Plus-            Minus -> minERFloat gr -- round upwards!-    | e < -grmax = -        case s of-            Plus -> ulpERFloat gr -- round upwards!-            Minus -> ERFloatZero gr Minus-    | otherwise = flt-    where-    grmax = 2^gr-normaliseERFloat flt = flt--ulpERFloat gr =-    ERFloat gr Plus 0 (-2^gr)--minERFloat gr =-    ERFloat gr Minus (grmax - 1) grmax-    where-    grmax = 2^gr--maxERFloat gr =-    ERFloat gr Plus (grmax - 1) grmax-    where-    grmax = 2^gr--rndCorr Plus = 1-rndCorr Minus = 0--increaseERFloatExp e flt@(ERFloat gr s m eOld) =-    ERFloat gr s mNew e-    where-    mNew = -        -grmax + ((m + grmax +  (rndCorr s) * (ediff - 1)) `div` ediff)-                           --  .^^^^^^^^^^^^^^^^^^^^^^^^^ round upwards-    grmax = 2^gr-    ediff = 2^(e - eOld) -- assuming e >= eOld-increaseERFloatExp _ flt = flt--decreaseERFloatExp e flt@(ERFloat gr s m eOld) =-    ERFloat gr s mNew e-    where-    mNew = -        -grmax + ediff * (m + grmax)-    grmax = 2^gr-    ediff = 2^(eOld - e) -- assuming e <= eOld-decreaseERFloatExp _ flt = flt---apFloatExponent :: ERFloat -> EI.ExtendedInteger--apFloatExponent (ERFloatInfty _ _) = EI.PlusInfinity-apFloatExponent (ERFloatZero _ _) = EI.MinusInfinity-apFloatExponent (ERFloatNaN _) = EI.PlusInfinity -- includes infinity-apFloatExponent flt = EI.Finite $ apfltExp flt-        --setERFloatGranularity ::-    Granularity -> ERFloat -> ERFloat-setERFloatGranularity gr flt@(ERFloat oldGr s m e) -    | gr > 0 =-        normaliseERFloat $ ERFloat gr s newM e-    | otherwise =-        flt-    where-    newM = -        (m * (2^gr) -          + ((rndCorr s)*(2^oldGr - 1))) -- round upwards!-        `div` (2^oldGr)-setERFloatGranularity gr f = f { apfltGran = gr } -        -setERFloatMinGranularity ::-    Granularity -> ERFloat -> ERFloat-setERFloatMinGranularity gr flt-    | gr > oldGr = -        setERFloatGranularity gr flt-    | otherwise = flt-    where-    oldGr = apfltGran flt-        -apfltGranularity = apfltGran--{-^ see the documentation of 'ERRealBase.getBaseMaxRounding' -}-apfltGetMaxRounding ::-    ERFloat -> ERFloat-apfltGetMaxRounding f@(ERFloatNaN _) = f-apfltGetMaxRounding f@(ERFloatInfty _ _) = f-apfltGetMaxRounding (ERFloatZero gr _) =-    ERFloat gr Plus 0 (-(2^gr))-apfltGetMaxRounding (ERFloat gr s m e) =-    ERFloat gr Plus 0 (max (e - (toInteger gr)) (-(2^gr)))--instance Show ERFloat where-    show = showERFloat 6 True False-    -    -showERFloat numDigits showGran showComponents flt =-    showERF flt-    where-    maybeGran gr-        | showGran = "{g=" ++ show gr ++ "}"-        | otherwise = ""-    showPM Plus = ""-    showPM Minus = "-"-    showERF (ERFloatNaN gr) = "NaN" ++ (maybeGran gr)  -    showERF (ERFloatZero gr pm) = showPM pm ++ "0.0" ++ (maybeGran gr)-    showERF (ERFloatInfty gr pm) = showPM pm ++ "oo" ++ (maybeGran gr)-    showERF f@(ERFloat gr s m e) =-        decimal ++ (maybeGran gr) ++ maybeComps-        where-        maybeComps-            | showComponents = "{val="++ show (s,m,e) ++ "}"-            | otherwise = ""-        decimal =-            showPM s-            ++ show digit1 ++ "." ++ (concat $ map show $ take numDigits digits)-            ++ (if dexp == 0 then "" else "e" ++ show dexp)-        (dexp, digit1 : digits) -            | noLeadingZerosDexp == -1 =-                (0, 0 : noLeadingZeroDigits)-            | otherwise =-                (noLeadingZerosDexp, noLeadingZeroDigits)-        noLeadingZerosDexp = dexpBound - zerosCount-        (zerosCount, noLeadingZeroDigits) = -            stripCountZeros 0 preDigits-        stripCountZeros prevZeros ds@(d : dsRest) -            | d == 0 = stripCountZeros (prevZeros + 1) dsRest-            | otherwise = (prevZeros, ds)-        dexpBound -- upper bound of dexp: f/10^dexpBound < 1-            | e >= 0 = intLogUp 10 (2^e)-            | e < 0 = 2 - (intLogUp 10 (2^(-e)))-        preDigits =-            getDigits $ (abs $ setERFloatGranularity gran f) / (ten ^^ dexpBound)-        ten = setERFloatGranularity gran 10-        gran = 10 + (max (4 * numDigits) gr)-        getDigits ff =-            digit : digits-            where-            digit :: Integer-            digit = truncate ff-            digits =-                getDigits ((ff - (fromInteger digit)) * ten)-            --{--    Beware: cannot use List.elem with ERFloat because of-    the intensional nature of Eq (eg ERFloatNaN /= ERFloatNaN).--}-instance Eq ERFloat where-    (ERFloatNaN _) == _ = -        False-        -- error "cannot compare NaN"-    _ == (ERFloatNaN _) = -        False-        -- error "cannot compare NaN"-    (ERFloatZero _ _) == (ERFloatZero _ _) = True-    (ERFloatInfty _ pm1) == (ERFloatInfty _ pm2) = (pm1 == pm2)-    f1@(ERFloat gr1 s1 m1 e1) == f2@(ERFloat gr2 s2 m2 e2) -        | gr1 < gr2 =-            (setERFloatGranularity gr2 f1) == f2-        | gr1 > gr2 =-            f1 == (setERFloatGranularity gr1 f2)-        | otherwise =-            s1 == s2 && m1 == m2 && e1 == e2-    _ == _ = False    --isERFloatNaN (ERFloatNaN _) = True-isERFloatNaN _ = False--instance Ord ERFloat where-    {- compare NaN -}-    compare a b@(ERFloatNaN _) =-        unsafePrint ("ERFloat: comparing NaN: " ++ show a ++ " vs. " ++ show b) EQ ---        error $ "ERFloat: comparing NaN: " ++ show a ++ " vs. " ++ show b -    compare a@(ERFloatNaN _) b = -        unsafePrint ("ERFloat: comparing NaN: " ++ show a ++ " vs. " ++ show b) EQ ---        error $ "ERFloat: comparing NaN: " ++ show a ++ " vs. " ++ show b -    {- compare infty -}-    compare (ERFloatInfty gr1 pm1) (ERFloatInfty gr2 pm2) =-        compare pm1 pm2-    compare _ (ERFloatInfty _ Plus) = LT-    compare _ (ERFloatInfty _ Minus) = GT-    compare (ERFloatInfty _ Plus) _ = GT-    compare (ERFloatInfty _ Minus) _ = LT-    {- compare zero -}-    compare (ERFloatZero gr1 pm1) (ERFloatZero gr2 pm2) = EQ-    compare (ERFloatZero _ _) (ERFloat _ Plus _ _) = LT-    compare (ERFloatZero _ _) (ERFloat _ Minus _ _) = GT-    compare (ERFloat _ Minus _ _) (ERFloatZero _ _) = LT-    compare (ERFloat _ Plus _ _) (ERFloatZero _ _) = GT-    {- compare regular -}-    compare (ERFloat _ Minus _ _) (ERFloat _ Plus _ _) = LT-    compare (ERFloat _ Plus _ _) (ERFloat _ Minus _ _) = GT-    compare (ERFloat gr1 Plus m1 e1) (ERFloat gr2 _ m2 e2) -        | e1 < e2 = LT-        | e1 > e2 = GT-        | gr1 == gr2 = compare m1 m2-        | otherwise = compare ((2^gr2)*m1) ((2^gr1)*m2)-    compare f1@(ERFloat _ Minus _ _) f2@(ERFloat _ _ _ _) =-        compare (-f2) (-f1)-        -instance Num ERFloat where-    fromInteger n-        | n == 0 = ERFloatZero (B.defaultGranularity zero) Plus-        | n < 0 =-            normaliseERFloat $ ERFloat gr Minus m e-        | otherwise = -            normaliseERFloat $ ERFloat gr Plus m e-        where-        gr = fromInteger e-        e = max (toInteger (B.defaultGranularity zero)) $ (intLogUp 2 $ abs n) - 1-        m = (abs n) - 2^gr-    abs f@(ERFloatNaN _) = f-    abs f = f { apfltSign = Plus }-    signum f@(ERFloatNaN _) = f-    signum (ERFloatZero gr Plus) = setERFloatMinGranularity gr 1-    signum (ERFloatZero gr Minus) = setERFloatMinGranularity gr (-1)-    signum (ERFloatInfty gr Plus) = setERFloatMinGranularity gr 1-    signum (ERFloatInfty gr Minus) = setERFloatMinGranularity gr (-1)-    signum flt = -        case apfltSign flt of { Plus -> 1; Minus -> -1 }-    negate (ERFloat gr s m e) = ERFloat gr (signNeg s) m e-    negate (ERFloatZero gr s) = ERFloatZero gr (signNeg s)-    negate (ERFloatInfty gr s) = ERFloatInfty gr (signNeg s)-    negate f@(ERFloatNaN _) = f-    {- addition -}-    f1 + f2 -- ensure equal granularity:-        | gr1 > gr2 = f1 + (setERFloatGranularity gr1 f2)-        | gr1 < gr2 = (setERFloatGranularity gr2 f1) + f2 -        where-        gr1 = apfltGran f1-        gr2 = apfltGran f2-    f@(ERFloatNaN _) + _ = f-    _ + f@(ERFloatNaN _) = f-    (ERFloatZero _ _) + f = f-    f + (ERFloatZero _ _) = f-    (ERFloatInfty gr Plus) + (ERFloatInfty _ Minus) =-        debugMsg ("ERFloat: infty - infty -> NaN\n") $ -        ERFloatNaN gr-    (ERFloatInfty gr Minus) + (ERFloatInfty _ Plus) = -        debugMsg ("ERFloat: -infty + infty -> NaN\n") $ -        ERFloatNaN gr-    f@(ERFloatInfty gr s) + _ = f-    _ + f@(ERFloatInfty gr s) = f-    f1@(ERFloat gr s1 m1 e1) + f2@(ERFloat _ s2 m2 e2)-        -- equalise the exponents: -        | e1 < e2 = f1 + (decreaseERFloatExp e1 f2)-        | e1 > e2 = (decreaseERFloatExp e2 f1) + f2-        -- ensure positive comes before negative: -        | s1 == Minus && s2 == Plus = -            f2 + f1-        -- opposite signs:-        | s1 == Plus && s2 == Minus && m1 == m2 =-            ERFloatZero gr Plus-        | s1 == Plus && s2 == Minus && m1 > m2 =-            normaliseERFloat $-            ERFloat gr s1 (m1 - m2 - 2^gr) e1-        | s1 == Plus && s2 == Minus && m1 < m2 =-            normaliseERFloat $-            ERFloat gr s2 (m2 - m1 - 2^gr) e1-        -- equal signs:-        | otherwise =-            normaliseERFloat $-            ERFloat gr s1 (m1 + m2 + 2^gr) e1-    {- multiplication -}-    -- ensure equal granularity:-    f1 * f2-        | gr1 > gr2 = f1 * (setERFloatGranularity gr1 f2)-        | gr1 < gr2 = (setERFloatGranularity gr2 f1) * f2 -        where-        gr1 = apfltGran f1-        gr2 = apfltGran f2-    -- NaN:-    f@(ERFloatNaN _) * _ = f-    _ * f@(ERFloatNaN _) = f-    -- Infty-    (ERFloatInfty gr _) * (ERFloatZero _ _) = -        debugMsg ("ERFloat: infty * 0 -> NaN\n") $ -        ERFloatNaN gr-    (ERFloatZero gr _) * (ERFloatInfty _ _) = -        debugMsg ("ERFloat: 0 * infty -> NaN\n") $ -        ERFloatNaN gr-    f * (ERFloatInfty gr s) = ERFloatInfty gr $ signMult s (apfltSign f)-    (ERFloatInfty gr s) * f = ERFloatInfty gr $ signMult s (apfltSign f)-    -- Zero-    (ERFloatZero gr s) * f = ERFloatZero gr $ signMult s (apfltSign f)-    f * (ERFloatZero gr s) = ERFloatZero gr $ signMult s (apfltSign f)-    -- regular-    f1@(ERFloat gr s1 m1 e1) * f2@(ERFloat _ s2 m2 e2) =-        normaliseERFloat $-        ERFloat gr s mNew (e1 + e2)-        where-        s = signMult s1 s2-        mNew = -            m1 + m2 -            + ((m1 * m2 + (rndCorr s) * (2^gr - 1)) -               `div` 2^gr)-    -instance Fractional ERFloat where-    fromRational rat = ---        error "ERFloat: fromRational cannot be implemented reliably: use apfloatFromRational instead"-        (fromInteger $ numerator rat) -        / (fromInteger $ denominator rat)-    f1 / f2 -        | gr1 > gr2 = f1 / (setERFloatGranularity gr1 f2)-        | gr1 < gr2 = (setERFloatGranularity gr2 f1) / f2-        where-        gr1 = apfltGran f1-        gr2 = apfltGran f2-    f@(ERFloatNaN _) / _ = f-    f1 / f2 =-        case apfltSign f1 of-            Plus -> f1 * (recip f2)-            Minus -> (- f1) * (recip (- f2)) -- rounding upwards!-    recip f@(ERFloatNaN _) = f-    recip (ERFloatZero gr s) = ERFloatInfty gr s-    recip (ERFloatInfty gr s) = ERFloatZero gr s-    recip (ERFloat gr s m e) =-        normaliseERFloat $-        ERFloat gr s mNew (-e)-        where-        mNew = -            (- grmax * m -             + (rndCorr s) * (grmax + m -1)) -- rounding upwards!-            `div`-            (grmax + m)-        grmax = 2^gr-        -        -apfloatFromRational ::-    Granularity -> Rational -> ERFloat-apfloatFromRational gran rat = -    (setERFloatMinGranularity gran (fromInteger $ numerator rat)) -        / (fromInteger $ denominator rat)-        -     -        -instance Real ERFloat where-    toRational (ERFloat gr s m e) =-        case s of-            Plus -> r-            Minus -> -r-        where-        r = (eOn2R) * (1 + mR/(grOn2R))-        mR = toRational m-        eOn2R = toRational $ 2 ^^ e-        grOn2R = toRational $ 2 ^ gr-    toRational (ERFloatZero _ _) = 0-    toRational f = -        error $ "cannot covert " ++ show f ++ " to a rational" -    -instance RealFrac ERFloat where-    properFraction (ERFloatNaN _) = -        error "no integral part in ERFloatNaN"-    properFraction (ERFloatZero _ _) =-        (0, 0)-    properFraction (ERFloatInfty _ _) =-        error "no integral part in ERFloatInfty"-    properFraction f@(ERFloat gr s m e) -        | e < 0 = (0, f)-        | s == Plus =-            (n, frac)-        | s == Minus =-            (-n, frac)-        where-        n = fromInteger $ 2^e + (m*(2^e) `div` 2^gr)-        frac = f - (fromInteger $ toInteger n)-        -    -instance B.ERRealBase ERFloat-    where-    typeName _ = "ERFloat (pure Haskell implementation)"-    defaultGranularity _ = 10-    getApproxBinaryLog = apFloatExponent-    getGranularity = apfltGran-    setMinGranularity = setERFloatMinGranularity-    setGranularity = setERFloatGranularity-    getMaxRounding = apfltGetMaxRounding-    isERNaN (ERFloatNaN _) = True-    isERNaN _ = False-    erNaN = ERFloatNaN (B.defaultGranularity zero)-    isPlusInfinity (ERFloatInfty _ Plus) = True-    isPlusInfinity _ = False-    plusInfinity = ERFloatInfty (B.defaultGranularity zero) Plus-    fromIntegerUp i = fromInteger i    -    fromDouble d-        | isNaN d = ERFloatNaN (B.defaultGranularity zero)-        | otherwise = (fromRational . toRational) d-    toDouble (ERFloatInfty _ s) = signToNum s * (1/0)-    toDouble (ERFloatNaN _) = 0/0-    toDouble flt =-        (fromInteger $ numerator rat) / (fromInteger $ denominator rat)-        where-        rat = toRational flt-    fromFloat f-        | isNaN f = ERFloatNaN (B.defaultGranularity zero)-        | otherwise = (fromRational . toRational) f-    toFloat (ERFloatInfty _ s) = signToNum s * (1/0) -    toFloat (ERFloatNaN _) = 0/0-    toFloat flt =-        (fromInteger $ numerator rat) / (fromInteger $ denominator rat)-        where-        rat = toRational flt-    showDiGrCmp = showERFloat-
− src/Data/Number/ER/Real/Base/MPFR.hs 
@@ -1,79 +0,0 @@-{-# LANGUAGE CPP #-}--- #define USE_MPFR-{-|-    Module      :  Data.Number.ER.Real.Base.MPFR-    Description :  enabling MPFR dyadics as interval endpoints-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  non-portable (requires fenv.h)--    Make Ales Bizjak's Haskell interface to MPFR an instance of -    'B.ERRealBase'.-     -    If compiled without USE_MPFR, this module is empty.--}-module Data.Number.ER.Real.Base.MPFR-(-#ifdef USE_MPFR-    MPFR-#endif-)-where--import qualified Data.Number.ER.Real.Base as B-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI-import Data.Number.ER.Misc--import Data.Binary--#ifdef USE_MPFR-import qualified Data.Number.MPFR.Up as M--type MPFR = M.MPFR--instance Binary M.MPFR-    where-    get = error "Data.Number.Dyadic: Binary not implemented yet"-    put = error "Data.Number.Dyadic: Binary not implemented yet"---instance B.ERRealBase M.MPFR-    where-    typeName _ = "MPFR float"-    defaultGranularity _ = 30-    getApproxBinaryLog d -        | d < 0 =-            error $ "ER.Real.Base.MPFR: getApproxBinaryLog: negative argument " ++ show d -        | d == 0 = EI.MinusInfinity -        | d >= 1 =-            fromInteger $ intLogUp 2 $ ceiling d-        | d < 1 =-            negate $ fromInteger $ intLogUp 2 $ ceiling $ recip d-    getGranularity = mPrec2gran . M.getPrec-    setMinGranularity g x -        | g > xGran = B.setGranularity g x-        | otherwise = x-        where-        xGran = B.getGranularity x  -    setGranularity g = M.set M.Up (gran2mPrec g)-    getMaxRounding _ = -        error "ER.Real.Base.MPFR: getMaxRounding undefined"-    isERNaN = M.isNaN-    erNaN = 0/0-    isPlusInfinity x = M.isInfinite x && x > 0-    plusInfinity = 1/0-    fromIntegerUp = fromInteger-    fromDouble = M.fromDouble M.Up 53-    toDouble = M.toDouble M.Up-    fromFloat = B.fromDouble . fromRational . toRational  -    toFloat = fromRational . toRational . B.toDouble-    showDiGrCmp numDigits _showGran _showComponents f = -        M.toStringExp (int2word numDigits) f-#endif-    -mPrec2gran = fromInteger . toInteger-gran2mPrec = fromInteger . toInteger-int2word = fromInteger . toInteger
− src/Data/Number/ER/Real/Base/MachineDouble.hs 
@@ -1,105 +0,0 @@-{-# INCLUDE <fenv.h> #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-|-    Module      :  Data.Number.ER.Real.Base.MachineDouble-    Description :  enabling Double's as interval endpoints-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  non-portable (requires fenv.h)--    Make 'Double' an instance of 'B.ERRealBase' as much as possible.    --}-module Data.Number.ER.Real.Base.MachineDouble-(-    initMachineDouble-)-where--import qualified Data.Number.ER.Real.Base as B-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI-import Data.Number.ER.Misc--import Foreign.C--{- -    The following section is taken from Oleg Kiselyov's email-    http://www.haskell.org/pipermail/haskell/2005-October/016574.html--}--type FP_RND_T = CInt  -- fenv.h--eFE_TONEAREST = 0-eFE_DOWNWARD = 0x400-eFE_UPWARD   = 0x800-eFE_TOWARDZERO = 0xc00--foreign import ccall "fenv.h fegetround" fegetround -  :: IO FP_RND_T--foreign import ccall "fenv.h fesetround" fesetround-  :: FP_RND_T -> IO FP_RND_T-{- end of Oleg's code -}--{-|-    Set machine floating point unit to the upwards-directed rounding-    mode.  -    -    This procedure has to be executed before using 'Double' -    as a basis for interval and polynomial arithmetic defined in this package.--}-initMachineDouble :: IO ()-initMachineDouble =-    do-    currentRndMode <- fegetround-    case currentRndMode == eFE_UPWARD of-        True -> -            putStrLn "already rounding upwards" -        False ->-            do-            fesetround eFE_UPWARD-            putStrLn "switching to upwards rounding" --instance B.ERRealBase Double-    where-    typeName _ = "double"-    initialiseBaseArithmetic x = -		do-		putStr $ "Base arithmetic:" ++ B.typeName x ++ "; "-		initMachineDouble-    defaultGranularity _ = 53-    getApproxBinaryLog d -        | d < 0 =-            error $ "ER.Real.Base.MachineDouble: getApproxBinaryLog: negative argument " ++ show d -        | d == 0 = EI.MinusInfinity -        | d >= 1 =-            fromInteger $ intLogUp 2 $ ceiling d-        | d < 1 =-            negate $ fromInteger $ intLogUp 2 $ ceiling $ recip d-        | otherwise = -            error $ "ER.Real.Base.MachineDouble: getApproxBinaryLog: illegal argument " ++ show d -    getGranularity _ = 53-    setMinGranularity _ = id-    setGranularity _ = id-    getMaxRounding _ = 0-    isERNaN f = isNaN f-    erNaN = 0/0-    isPlusInfinity f = isInfinite f && f > 0-    plusInfinity = 1/0-    fromIntegerUp i-        | i <= floor nearest = nearest-        | otherwise = nearestIncreased-        where-        nearestCeil = ceiling nearest-        nearest = fromInteger i-        nearestIncreased = encodeFloat (s+1) e-        (s,e) = decodeFloat nearest-    fromDouble = fromRational . toRational-    toDouble = fromRational . toRational-    fromFloat = fromRational . toRational-    toFloat = fromRational . toRational-    showDiGrCmp _numDigits _showGran _showComponents f = show f-    -
− src/Data/Number/ER/Real/Base/Rational.hs 
@@ -1,244 +0,0 @@-{-# LANGUAGE DeriveDataTypeable   #-}-{-|-    Module      :  Data.Number.ER.Real.Base.Rational-    Description :  rational numbers with infinities-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    Unlimited size rational numbers extended with signed infinities and NaN.-    -    These can serve as endpoints of 'Data.Number.ER.Real.Approx.Interval.ERInterval'.-    -    To be imported qualified, usually with prefix ERAT. --}-module Data.Number.ER.Real.Base.Rational -(-    ExtendedRational(..)-)-where--import Prelude hiding (isNaN)--import qualified Data.Number.ER.Real.Base as B-import qualified Data.Number.ER.BasicTypes.ExtendedInteger as EI-import Data.Number.ER.BasicTypes.PlusMinus-import Data.Number.ER.Misc--import Data.Ratio-import Data.Typeable-import Data.Generics.Basics--import Data.Binary--data ExtendedRational =-    NaN-    | Infinity PlusMinus-    | Finite Rational-    deriving (Typeable, Data)--{- the following has been generated by BinaryDerive -}     -instance Binary ExtendedRational where-  put NaN = putWord8 0-  put (Infinity a) = putWord8 1 >> put a-  put (Finite a) = putWord8 2 >> put a-  get = do-    tag_ <- getWord8-    case tag_ of-      0 -> return NaN-      1 -> get >>= \a -> return (Infinity a)-      2 -> get >>= \a -> return (Finite a)-      _ -> fail "no parse"-{- the above has been generated by BinaryDerive -}--eratSign :: ExtendedRational -> PlusMinus-eratSign NaN = error "ExtendedRational: eratSign: NaN"-eratSign (Infinity s) = s-eratSign (Finite r)-    | r < 0 = Minus-    | otherwise = Plus--liftToERational1 ::-    (Rational -> Rational) ->-    (ExtendedRational -> ExtendedRational)-liftToERational1 f (Finite r) = -    Finite (f r)--liftToERational2 ::-    (Rational -> Rational -> Rational) ->-    (ExtendedRational -> ExtendedRational -> ExtendedRational)-liftToERational2 f (Finite r1) (Finite r2) = -    Finite (f r1 r2)---instance Show ExtendedRational -    where-    show = showERational 6 True False-    -showERational numDigits _showGran showComponents =-    showER-    where-    showER NaN = "NaN"-    showER (Infinity pm) =-        show pm ++ "oo"-    showER (Finite r) | r == 0 =-        "0"-    showER (Finite r) =-        decimal -        ++ (if showComponents then components else "")-        where-        components = "{" ++  show r ++ "}"-        decimal = -            show pm-            ++ show digit1 ++ "." ++ (concat $ map show $ take numDigits digits)-            ++ "E" ++ show dexp-        pm | r < 0 = Minus-           | otherwise = Plus-        dexp = dexpBound - zerosCount-        digit1 : digits =-            drop zerosCount preDigits-        dexpBound = -- upper bound of dexp: f/10^dexpBound < 1-            2 + (intLogUp 10 num) - (intLogUp 10 dnm)-        num = numerator absr-        dnm = denominator absr-        absr = abs r-        (zerosCount, preDigits) =-            getDigits 0 $ absr / (10 ^^ dexpBound)-        getDigits prevZeros rr-            | digit == 0 = (zerosCount, digit : digits)-            | otherwise = (prevZeros, digit : digits)-            where-            digit :: Integer-            digit = truncate rr-            (zerosCount, digits) =-                getDigits zerosNow ((rr - (fromInteger digit)) * 10)-            zerosNow-                | digit == 0 = prevZeros + 1-                | otherwise = 0-        -instance Eq ExtendedRational where-    NaN == _ = -        False-        -- error "cannot compare NaN"-    _ == NaN = -        False-        -- error "cannot compare NaN"-    (Infinity pm1) == (Infinity pm2) = (pm1 == pm2)-    (Finite r1) == (Finite r2) = r1 == r2-    _ == _ = False--isNaN NaN = True-isNaN _ = False-        -instance Ord ExtendedRational where-    {- compare NaN -}-    compare _ NaN = -        error "comparing NaN - aborting"-    compare NaN _ = -        error "comparing NaN - aborting"-    {- compare infty -}-    compare (Infinity pm1) (Infinity pm2) =-        compare pm1 pm2-    compare _ (Infinity Plus) = LT-    compare _ (Infinity Minus) = GT-    compare (Infinity Plus) _ = GT-    compare (Infinity Minus) _ = LT-    {- compare regular -}-    compare (Finite r1) (Finite r2) = compare r1 r2--instance Num ExtendedRational where-    fromInteger n = Finite (fromInteger n)-    abs NaN = NaN-    abs (Infinity _) = Infinity Plus-    abs r = liftToERational1 abs r-    signum NaN = NaN-    signum (Infinity Plus) = 1-    signum (Infinity Minus) = -1-    signum r = liftToERational1 signum r-    negate NaN = NaN-    negate (Infinity s) = Infinity (signNeg s)-    negate (Finite r) = Finite (negate r)-    {- addition -}-    -- NaN-    NaN + _ = NaN-    _ + NaN = NaN-    -- Infty-    (Infinity Plus) + (Infinity Minus) = NaN-    (Infinity Minus) + (Infinity Plus) = NaN-    (Infinity s) + _ = Infinity s-    _ + (Infinity s) = Infinity s-    -- regular-    r1 + r2 = liftToERational2 (+) r1 r2-    {- multiplication -}-    -- NaN-    NaN * _ = NaN-    _ * NaN = NaN-    -- Infty-    (Infinity _) * (Finite r) | r == 0 = NaN-    (Finite r) * (Infinity _) | r == 0 = NaN-    r * (Infinity s) = Infinity $ signMult s (eratSign r)-    (Infinity s) * r = Infinity $ signMult s (eratSign r)-    -- regular-    r1 * r2 = liftToERational2 (*) r1 r2--instance Fractional ExtendedRational where-    fromRational rat = Finite rat-    recip NaN = NaN-    recip (Infinity s) = 0-    recip (Finite r) -        | r == 0 = Infinity Plus-        | otherwise = (Finite $ recip r)-        -instance Real ExtendedRational where-    toRational (Finite r) = r-    toRational r = error $ "cannot convert " ++  show r ++ " to Rational"-    -instance RealFrac ExtendedRational where-    properFraction (Finite r) = -        (a, Finite b)-        where-        (a,b) = properFraction r-    properFraction r = -        error $ "ExtendedRational: RealFrac: no integral part in " ++ show r-        -instance B.ERRealBase ExtendedRational-    where-    typeName _ = "extended rationals"-    defaultGranularity _ = 10-    getApproxBinaryLog (Finite r)-        | r == 0 =-            EI.MinusInfinity-        | otherwise =-            (intLogUp 2 (abs $ numerator $ r)) -            --            (intLogUp 2 (abs $ denominator $ r))-    getApproxBinaryLog (Infinity _) = EI.PlusInfinity-    getApproxBinaryLog (NaN) = error "RationalBase: getApproxBinaryLog: NaN"-    getGranularity _ = 0-    setMinGranularity _ = id-    setGranularity _ = id-    getMaxRounding _ = 0-    isERNaN = isNaN-    erNaN = NaN-    isPlusInfinity (Infinity Plus) = True-    isPlusInfinity _ = False-    plusInfinity = Infinity Plus-    fromIntegerUp = fromInteger-    fromDouble = fromRational . toRational-    toDouble (Infinity Plus) = 1/0 -    toDouble (Infinity Minus) = -1/0 -    toDouble (NaN) = 0/0-    toDouble (Finite r) = fromRational r-    fromFloat = fromRational . toRational-    toFloat (Infinity Plus) = 1/0 -    toFloat (Infinity Minus) = -1/0 -    toFloat (NaN) = 0/0-    toFloat (Finite r) = fromRational r-    showDiGrCmp = showERational----
− src/Data/Number/ER/Real/Base/Tests/Generate.hs 
@@ -1,90 +0,0 @@-{-|-    Module      :  Data.Number.ER.Real.Base.Tests.Generate-    Description :  (testing) generating base real numbers-    Copyright   :  (c) 2009 Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -    Generic instances of 'Arbitrary' class for generating (almost) random instances-    according to different distributions. --}-module Data.Number.ER.Real.Base.Tests.Generate where--import qualified Data.Number.ER.Real.Base as B-import Data.Number.ER.BasicTypes--import Test.QuickCheck--newtype BGran20 b = BGran20 b deriving Show-newtype BGran100 b = BGran100 b deriving Show-newtype BGran1000 b = BGran1000 b deriving Show--instance (B.ERRealBase b) => Arbitrary (BGran20 b)-    where-    arbitrary =-        do-        gran <- choose (8,20)-        (f1,f2,f3) <- arbitrary-        pow <- choose (-10,10)-        return $ BGran20 $ constructB gran (f1,f2,f3) pow-    coarbitrary _ =-        error "ER.Real.Base: Tests: coarbitrary not implemented"--constructB ::-    (B.ERRealBase b) =>-    Granularity ->-    (Double, Double, Double) ->-    Int ->-    b-constructB gran (f1,f2,f3) pow =-    (b1/b2) ^^ pow + b3 -    where-    [b1,b2,b3] = map cvt [f1,f2,f3]-    cvt f = B.setGranularity gran $ B.fromDouble f--instance (B.ERRealBase b) => Arbitrary (BGran100 b)-    where-    arbitrary = -        sized arbitrarySized-        where-        arbitrarySized n -            | n <= 28 =-                do-                (BGran20 b) <- arbitrary-                return (BGran100 b)-            | otherwise =-                do-                gran <- choose (30,100)-                (f1,f2,f3) <- arbitrary-                pow <- choose (-100,100)-                return $ BGran100 $ constructB gran (f1,f2,f3) pow-    coarbitrary _ =-        error "ER.Real.Base: Tests: coarbitrary not implemented"--instance (B.ERRealBase b) => Arbitrary (BGran1000 b)-    where-    arbitrary = -        sized arbitrarySized-        where-        arbitrarySized n -            | n <= 28 =-                do-                (BGran20 b) <- arbitrary-                return (BGran1000 b)-            | n <= 68 =-                do-                (BGran100 b) <- arbitrary-                return (BGran1000 b)-            | otherwise =-                do-                gran <- choose (400,1000)-                (f1,f2,f3) <- arbitrary-                pow <- choose (-10000,10000)-                return $ BGran1000 $ constructB gran (f1,f2,f3) pow-    coarbitrary _ =-        error "ER.Real.Base: Tests: coarbitrary not implemented"-            -
− src/Data/Number/ER/Real/DefaultRepr.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE CPP #-}--- #define USE_MPFR-{-|-    Module      :  Data.Number.ER.Real.DefaultRepr-    Description :  concise names for default real representations-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  non-portable (requires fenv.h)--    This module supplies default instances for the real number classes-    defined in "Data.Number.ER.Real.Approx".-    -    These classes express loosely coupled abstraction layers.    -    To preserve the intended loose coupling, -    please use these definitions only in functions that do not import or export-    any real numbers or real functions.--}-module Data.Number.ER.Real.DefaultRepr-(-    B, BM, BAP, BMAP, BR,-#ifdef USE_MPFR-	BMPFR,-#endif     -    RA, IRA-)-where----import --import Data.Number.ER.Real.Base.Float-import Data.Number.ER.Real.Base.Rational--import Data.Number.ER.Real.Approx.Interval----import Data.Number.ER.Real.Base.BigFloatBase-import Data.Number.ER.Real.Base.MachineDouble-import Data.Number.ER.Real.Base.CombinedMachineAP--import Data.Number.ER.Real.Base.MPFR--type BAP = ERFloat--{-| -        Limited granularity, but sometimes up to 100x faster-        than ERFloat!-        -        !!! to be safe, one has to run 'initMachineDouble'--}-type BM = Double--#ifdef USE_MPFR-type BMPFR = MPFR-#endif--{-|-        Use machine 'Double' while the granularity is up to its significant bit length-        and when the granularity grows beyond that, use 'ERFloat'.-        -        !!! to be safe, one has to run 'initMachineDouble'--}-type BMAP = ERMachineAP BAP- ---type BBF = BigFloat Prec50 -- seems incomplete on 25/Jun/2008 --{-| very inefficient -}-type BR = ExtendedRational --{-| -    the default base type--}--#ifdef USE_MPFR-type B = BMPFR---type B = BMAP---type B = BAP---type B = BM---type B = BR-#else-type B = BMAP---type B = BAP---type B = BM---type B = BR-#endif--{-| -    the default instance of 'Data.Number.ER.Real.Approx.ERApprox' --}-type RA b = ERInterval b--{-| -    the default instance of 'Data.Number.ER.Real.Approx.ERIntApprox' --}-type IRA b = ERInterval b-
− src/Data/Number/ER/ShowHTML.hs 
@@ -1,51 +0,0 @@-{-|-    Module      :  Data.Number.ER.ShowHTML-    Description :  Misc facilities for HTML rendering.-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable-    -     --}-module Data.Number.ER.ShowHTML where--import qualified Text.Html as H-import Text.Regex--{-|-    Render HTML is a way that can be inlined in -    Javascript strings etc.--}-showHTML :: -    (H.HTML t) =>-    t -> String-showHTML v =-    escapeNewLines $-    renderHtmlNoHeader $ -    H.toHtml v-    where---    stripHeader s =---        (splitRegex (mkRegex "-->") s) !! 1-    escapeNewLines s =-        (subRegex (mkRegex "([^\\])$") s "\\1\\\\")  --abovesTable attrs cells =-    H.table H.! attrs H.<< (H.aboves $ map (H.td H.<<) cells)-besidesTable attrs cells =-    H.table H.! attrs H.<< (H.aboves [H.besides $ map (H.td H.<<) cells])--renderHtmlNoHeader :: H.Html -> String-renderHtmlNoHeader theHtml =-         foldr (.) id (map (H.renderHtml' 0)-                           (H.getHtmlElements theHtml)) "\n"--toHtmlDefault :: (Show a) => a -> H.Html-toHtmlDefault = H.toHtml . show--instance (H.HTML a) => H.HTML (Maybe a) where-    toHtml Nothing = H.toHtml $ "[Nothing]"-    toHtml (Just a) = H.toHtml a-
+ src/Numeric/AERN/Misc/IntegerArithmetic.hs view
@@ -0,0 +1,52 @@+{-|+    Module      :  Numeric.AERN.Misc.IntegerArithmetic+    Description :  miscellaneous integer arithmetic functions+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Miscellaneous integer arithmetic functions.+-}++module Numeric.AERN.Misc.IntegerArithmetic where++intLogDown b n = fst $ intLog b n +intLogUp b n = snd $ intLog b n +    +intLog ::+    (Num n1, Num n2, Ord n1, Integral n2) => +    n1 {-^ base -} -> +    n1 {-^ x -} -> +    (n2, n2)+intLog b n+    | n == 1 = (0,0)+    | n > 1 && n < b = (0,1)+    | n >= b =+        bisect (lgDn, pwDn) (lgUp, pwUp)+    | otherwise = +        error $ "Numeric.ER.Misc: intLog: illegal argument n = " ++ show n+    where+    ((lgDn, pwDn), (lgUp, pwUp)) = +        findBounds (1, b) +        -- lgDn <= log_b n < lgUp; pwDn = b^lgDn; pwUp = b^lgUp+    findBounds (lg, pw)+        | n < pwNext = ((lg, pw), (lgNext, pwNext))+        | otherwise = findBounds (lgNext, pwNext)+        where+        lgNext = 2 * lg+        pwNext = pw * pw+    bisect (lgDn, pwDn) (lgUp, pwUp)+        | pwDn == n = (lgDn, lgDn)+        | pwUp == n = (lgUp, lgUp)+        | lgDn == lgMid = (lgDn, lgUp)+        | lgUp == lgMid = (lgDn, lgUp)+        | n < pwMid =+            bisect (lgDn, pwDn) (lgMid, pwMid)+        | otherwise =+            bisect (lgMid, pwMid) (lgUp, pwUp)+        where+        lgMid = (lgDn + lgUp) `div` 2+        pwMid = pwDn * (b ^ (lgMid - lgDn))
+ src/Numeric/AERN/RealArithmetic/Auxiliary.hs view
@@ -0,0 +1,81 @@+{-|+    Module      :  Numeric.AERN.RealArithmetic.Auxiliary+    Description :  auxiliary generic operators and utilities  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Auxiliary generic operators and utilities.++    This is a hidden internal module.    +-}++module Numeric.AERN.RealArithmetic.Auxiliary where++import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.Basics.Exception+import Numeric.AERN.Basics.Mutable++import Control.Exception+import Control.Monad.ST+++powerFromMult :: +    (HasOne t) =>+    (t -> t -> t) {-^ associative binary operation @*@ -} ->+    t {-^ @x@ -} ->+    Int {-^ @n@ positive -} ->+    t {-^ product @x * x * ... * x@ of @n@ copies of @x@ -}+powerFromMult mult x n+    | n < 0 = throw $ AERNException "powerFromMult does not support negative exponents"+    | otherwise = p n+    where+    p n+        | n == 0 = one+        | n == 1 = x+        | otherwise =+            case even n of+                True -> +                    powHalf `mult` powHalf +                False -> +                    x `mult` (powHalf `mult` powHalf)+        where+        powHalf = p (n `div` 2)++powerFromMultInPlace :: +    (HasOne t, CanBeMutable t) =>+    (Mutable t s -> Mutable t s -> Mutable t s -> ST s ()) {-^ associative binary operation @*@ -} ->+    (Mutable t s) {-^ where to put the resulting power @x^n@  -} ->+    (Mutable t s) {-^ @x@ -} ->+    Int {-^ @n@ positive -} ->+    ST s ()+powerFromMultInPlace mult rM xM n+    -- beware rM and xM may alias!+    | n < 0 = throw $ AERNException "powerFromMultInPlace does not support negative exponents"+    | otherwise =+        do+        nrM <- cloneMutable xM -- a non-aliased variable for interim results+        p nrM n -- nrM := x^n+        assignMutable rM nrM -- rM := nr+    where+    p nrM n -- ensures nrM holds x^n+        | n == 0 = writeMutable nrM one+        | n == 1 = return () -- assuming nrM already contains x+        | otherwise =+            case even n of+                True -> +                    do+                    powHalf -- rM now holds x^(n/2)+                    mult nrM nrM nrM -- square rM+                False -> +                    do+                    powHalf -- rM now holds x^(n-1/2)+                    mult nrM nrM nrM -- square rM+                    mult nrM nrM xM -- multiply by x one more time+        where+        rM = () -- avoid accidental use of rM from parent context+        powHalf = p nrM (n `div` 2)+
+ src/Numeric/AERN/RealArithmetic/Bench.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.Bench+    Description :  benchmarking utilities  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Benchmarking utilities.+-}++module Numeric.AERN.RealArithmetic.Bench where++import Numeric.AERN.Basics.Consistency+import Numeric.AERN.Basics.NumericOrder.OpsDefaultEffort++import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as ArithUpDn++import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.Measures++import Numeric.AERN.Misc.Debug++{-| Approximate the imprecision of an operation by measuring+    the distance between its outer rounded result and inner rounded result +-}+mkCommentImprecision1 ::+    (HasDistance t,+     ArithUpDn.Convertible (Distance t) Double,+     Show (Distance t)) =>+    (ei -> t -> t) ->+    (ei -> t -> t) ->+    ei -> t -> String+mkCommentImprecision1 opOut opIn effort a =+    show $ imprecisionD+    where+    imprecisionD :: Double+    imprecisionD =+        case ArithUpDn.convertUpEff (ArithUpDn.convertDefaultEffort imprecision sampleD) imprecision of+            Just imprecisionUp -> imprecisionUp+            Nothing -> error $ "mkCommentImprecision: cannot convert up to a Double: " ++ show imprecision+    sampleD = 0 :: Double+    imprecision = distanceBetweenEff (distanceDefaultEffort resultOut) resultOut resultIn+    resultOut = opOut effort a   +    resultIn = opIn effort a   ++mkCommentAreaImprecision op effort a =+    unsafePrint+    (+        "mkCommentImprecision: " +        ++ "\n a = " ++ show a+        ++ "\n effort = " ++ show effort+        ++ "\n aE = " ++ show aE+        ++ "\n aD = " ++ show aD+        ++ "\n aExp = " ++ show aExp+        ++ "\n resultE = " ++ show resultE+        ++ "\n imprecisionE = " ++ show imprecisionE+        ++ "\n imprecisionD = " ++ show imprecisionD+        ++ "\n imprecisionExp = " ++ show imprecisionExp+        ++ "\n resultBinaryDigits = " ++ show resultBinaryDigits+    ) $+    signOfaE ++ "x" ++ show aExp ++ "rd" ++ show resultBinaryDigits+    where+    signOfaE = +        case (aE >? zero, aE <? zero) of+            (Just True, _) -> "+"+            (_, Just True) -> "-"+            _ -> ""+    aE = getThinRepresentative a+    Just aD =+        ArithUpDn.convertUpEff (ArithUpDn.convertDefaultEffort a sampleD) aE+    aExp = exponent aD+    +    resultE = op effort aE+    Just resultD =+        ArithUpDn.convertUpEff (ArithUpDn.convertDefaultEffort a sampleD) resultE+    resultExp = exponent resultD+    +    imprecisionE =+        imprecisionOfEff (imprecisionDefaultEffort a) resultE+    Just imprecisionD =+        ArithUpDn.convertUpEff (ArithUpDn.convertDefaultEffort imprecisionE sampleD) imprecisionE+    imprecisionExp = exponent imprecisionD+    +    resultBinaryDigits = resultExp - imprecisionExp+    +    imprecisionD, aD, resultD, sampleD :: Double+    sampleD = 0
+ src/Numeric/AERN/RealArithmetic/ExactOps.hs view
@@ -0,0 +1,107 @@+{-|+    Module      :  Numeric.AERN.RealArithmetic.ExactOps+    Description :  access to exact zero and one  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Access to exact zero and one.+-}+module Numeric.AERN.RealArithmetic.ExactOps where++import Prelude hiding (EQ, LT, GT)+import Numeric.AERN.Basics.PartialOrdering++import Control.Monad.ST+import Data.STRef++import qualified Numeric.AERN.Basics.NumericOrder as NumOrd++import Numeric.AERN.Basics.Mutable++import Data.Ratio++class HasZero t where+    zero :: t+    +pNonnegNonposEff effort a =+    (nonneg, nonpos)+    where+    (_, nonneg, _, nonpos) =+        pPosNonnegNegNonposEff effort a+    +pPosNonnegNegNonposEff effort a =+    case NumOrd.pCompareEff effort a zero of+       Just EQ -> (Just False, Just True, Just False, Just True) +       Just LT -> (Just False, Just False, Just True, Just True) +       Just GT -> (Just True, Just True, Just False, Just False)+       Just LEE -> (Just False, Nothing, Nothing, Just True) +       Just GEE -> (Nothing, Just True, Just False, Nothing)+       _ -> (Nothing, Nothing, Nothing, Nothing)+    +class HasOne t where+    one :: t+    +class HasInfinities t where+    plusInfinity :: t+    minusInfinity :: t+    excludesPlusInfinity :: t -> Bool+    excludesMinusInfinity :: t -> Bool+    excludesInfinity :: t -> Bool+    excludesInfinity a = +        excludesMinusInfinity a && excludesPlusInfinity a +    +class Neg t where+    neg :: t -> t+    +class (Neg t, CanBeMutable t) => NegInPlace t where+    negInPlace :: OpMutable1 t s +    negInPlace =+        pureToMutable1 neg+--        +--        -- default such as this one is very inefficient+--        -- but facilitates an API that works even for+--        -- types that do not have native in-place updates+--        do+--        a <- readMutable aM+--        let _ = [a,sample]+--        writeMutable rM (neg a)++propNegFlip ::+    (Eq t, Neg t) =>+    t -> t -> Bool+propNegFlip _ e =+    neg (neg e) == e ++-- instances for some common types:++instance HasZero Int where zero = 0+instance HasOne Int where one = 1+instance Neg Int where neg = negate++instance HasZero Integer where zero = 0+instance HasOne Integer where one = 1+instance Neg Integer where neg = negate++instance (HasZero t, HasOne t, Integral t) => +    HasZero (Ratio t) +    where zero = zero % one+instance (HasOne t, Integral t) => +    HasOne (Ratio t) +    where one = one % one+instance (Integral t) => Neg (Ratio t) where neg = negate++instance HasZero Double where zero = 0+instance HasOne Double where one = 1+instance Neg Double where neg = negate++instance HasInfinities Double where+    plusInfinity = 1/0+    minusInfinity = -1/0+    excludesPlusInfinity a = (a /= plusInfinity)+    excludesMinusInfinity a = (a /= minusInfinity)+    +
+ src/Numeric/AERN/RealArithmetic/Laws.hs view
@@ -0,0 +1,585 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams, RankNTypes #-}+{-|+    Module      :  Numeric.AERN.Basics.Laws.Relation+    Description :  common properties of arithmetic operations arbitrarily-little rounded  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Common properties of arithmetic operations when these operations+    are rounded but the rounding can be diminished arbitrarily +    by increasing an effort indicator.+-}++module Numeric.AERN.RealArithmetic.Laws where++import Numeric.AERN.RealArithmetic.Measures++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Consistency+import Numeric.AERN.Basics.Laws.Utilities+import Numeric.AERN.Basics.Mutable++import Numeric.AERN.Misc.Bool+import Numeric.AERN.Misc.Debug+import Numeric.AERN.Misc.List+import Numeric.AERN.Misc.Maybe+import Data.Maybe++import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd++import Numeric.AERN.Basics.Exception+import Control.Exception++roundedRefinementMonotone1 ::+    (RefOrd.PartialComparison t, +     RefOrd.ArbitraryOrderedTuple t, +     Show t, HasLegalValues t) =>+    String ->+    (Expr1Eff ei t) ->+    (Expr1Eff ei t) ->+    ei -> (RefOrd.LEPair t) -> +    (RefOrd.PartialCompareEffortIndicator t) ->+    Bool+roundedRefinementMonotone1 contextDescription exprUp exprDn effort (RefOrd.LEPair (e1L, e1H)) effortComp =+    case RefOrd.pLeqEff effortComp resDn resUp of+        Just b -> b+        _ -> True+    where+    resUp = check $ exprUp effort e1H+    resDn = check $ exprDn effort e1L+    check = detectIllegalValues $ contextDescription ++ " monotone"++roundedRefinementMonotone2 ::+    (RefOrd.PartialComparison t, +     RefOrd.ArbitraryOrderedTuple t, +     Show t, HasLegalValues t) =>+    String ->+    (Expr2Eff ei t) ->+    (Expr2Eff ei t) ->+    ei -> (RefOrd.LEPair t) -> (RefOrd.LEPair t) -> +    (RefOrd.PartialCompareEffortIndicator t) ->+    Bool+roundedRefinementMonotone2 +        contextDescription exprUp exprDn effort +        (RefOrd.LEPair (e1L, e1H)) (RefOrd.LEPair (e2L, e2H)) effortComp =+--    unsafePrint ("\nroundedRefinementMonotone2: " +--      ++ "\n Up: op(" ++ show e1H ++ ", " ++ show e2H ++ ") = " ++ show resUp +--      ++ "\n Dn: op(" ++ show e1L ++ ", " ++ show e2L ++ ") = " ++ show resDn+--      ++ "\n" +--    ) $+    case RefOrd.pLeqEff effortComp resDn resUp of+        Just b -> b+        _ -> True+    where+    resUp = check $ exprUp effort e1H e2H+    resDn = check $ exprDn effort e1L e2L+    check = detectIllegalValues $ contextDescription ++ " monotone"++roundedUnit ::+    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    t -> +    (PRelEff eiRel t) -> +    (OpEff eiOp t) -> (OpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> Bool+roundedUnit unit =+    equalRoundingUpDnBin1Var1 "roundedUnit" (\_ _ e -> e) expr2+    where+    expr2 opEff effort e = +        unit * e+        where+        (*) = opEff effort++roundedReflexiveCollapse ::+    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    t -> +    (PRelEff eiRel t) -> +    (OpEff eiOp t) -> (OpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> Bool+roundedReflexiveCollapse unit =+    equalRoundingUpDnBin1Var1 "roundedReflexiveCollapse" (\_ _ e -> unit) expr2+    where+    expr2 opEff effort e = +        e * e+        where+        (*) = opEff effort++roundedCommutative ::+    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    (PRelEff eiRel t) -> +    (OpEff eiOp t) -> (OpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> t -> Bool+roundedCommutative =+    equalRoundingUpDnBin1Var2 "roundedCommutative" expr1 expr2+    where+    expr1 opEff effort e1 e2 = +        e1 * e2+        where+        (*) = opEff effort+    expr2 opEff effort e1 e2 = +        e2 * e1+        where+        (*) = opEff effort++roundedAssociative ::+    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    (PRelEff eiRel t) -> +    (OpEff eiOp t) -> (OpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> t -> t -> Bool+roundedAssociative =+    equalRoundingUpDnBin1Var3 "roundedAssociative" expr1 expr2+    where+    expr1 opEff effort e1 e2 e3 = +        (e1 * e2) * e3+        where+        (*) = opEff effort+    expr2 opEff effort e1 e2 e3 = +        e1 * (e2 * e3)+        where+        (*) = opEff effort++roundedDistributive ::+    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp1, Show eiOp1, +     EffortIndicator eiOp2, Show eiOp2,+     HasAntiConsistency t, Show t, HasLegalValues t) =>+    (PRelEff eiRel t) -> +    (OpEff eiOp1 t) -> (OpEff eiOp2 t) -> +    (OpEff eiOp1 t) -> (OpEff eiOp2 t) -> +    (ConsistencyEffortIndicator t) ->+    (eiRel, (eiOp1, eiOp2)) -> +    t -> t -> t -> Bool+roundedDistributive +        pCompareEff+        op1UpEff op2UpEff +        op1DnEff op2DnEff +        effortConsistency+        initEffort +        e1 e2 e3 =+--    unsafePrint+--    (+--        "property roundedDistributive: "+--        ++ "\n e1 = " ++ show e1+--        ++ "\n e2 = " ++ show e2+--        ++ "\n e3 = " ++ show e3+--    ) $        +    thinEqualConsLeqRoundingUpDnImprovement "roundedDistributive"+        -- cannot get equality when e1 is not thin +        -- because e1 appears twice in expr1 (dependency error)+        [e1] expr1Up expr1Dn expr2Up expr2Dn +        pCompareEff+        effortConsistency +        initEffort+    where+    expr1Up eff = expr1 op1UpEff op2UpEff eff e1 e2 e3+    expr1Dn eff = expr1 op1DnEff op2DnEff eff e1 e2 e3+    expr2Up eff = expr2 op1UpEff op2UpEff eff e1 e2 e3+    expr2Dn eff = expr2 op1DnEff op2DnEff eff e1 e2 e3+    expr1 op1Eff op2Eff (effort1, effort2) e1 e2 e3 = +        (e1 * e2) + (e1 * e3)+        where+        (*) = op1Eff effort1+        (+) = op2Eff effort2+    expr2 op1Eff op2Eff (effort1, effort2) e1 e2 e3 = +        e1 * (e2 + e3)+        where+        (*) = op1Eff effort1+        (+) = op2Eff effort2+++roundedNegSymmetric ::+    (Neg t,+     EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    (PRelEff eiRel t) -> +    (UnaryOpEff eiOp t) -> (UnaryOpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> Bool+roundedNegSymmetric =+    equalRoundingUpDnUnary1Var1 "roundedNegSymmetric" expr1 expr2+    where+    expr1 opEff effort e = +         opEff effort e+    expr2 opEff effort e = +         opEff effort (neg e) ++roundedIdempotent ::+    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    (PRelEff eiRel t) -> +    (UnaryOpEff eiOp t) -> (UnaryOpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> Bool+roundedIdempotent =+    equalRoundingUpDnUnary1Var1 "roundedIdempotent" expr1 expr2+    where+    expr1 opEff effort e = +         opEff effort e+    expr2 opEff effort e = +         opEff effort (opEff effort e)+++equalRoundingUpDnUnary1Var1 :: +    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    String ->+    (Expr1UnaryOp1Eff eiOp t) -> +    (Expr1UnaryOp1Eff eiOp t) -> +    (PRelEff eiRel t) -> +    (UnaryOpEff eiOp t) -> (UnaryOpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> Bool+equalRoundingUpDnUnary1Var1 contextDescription expr1 expr2 pCompareEff opUpEff opDnEff +        initEffort e =+    equalRoundingUpDn contextDescription expr1Up expr1Dn expr2Up expr2Dn pCompareEff initEffort+    where+    expr1Up eff = expr1 opUpEff eff e+    expr1Dn eff = expr1 opDnEff eff e+    expr2Up eff = expr2 opUpEff eff e+    expr2Dn eff = expr2 opDnEff eff e++equalRoundingUpDnBin1Var1 :: +    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    String ->+    (Expr1Op1Eff eiOp t) -> +    (Expr1Op1Eff eiOp t) -> +    (PRelEff eiRel t) -> +    (OpEff eiOp t) -> (OpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> Bool+equalRoundingUpDnBin1Var1 +        contextDescription expr1 expr2 pCompareEff +        opUpEff opDnEff initEffort e =+    equalRoundingUpDn +        contextDescription expr1Up expr1Dn expr2Up expr2Dn pCompareEff initEffort+    where+    expr1Up eff = expr1 opUpEff eff e+    expr1Dn eff = expr1 opDnEff eff e+    expr2Up eff = expr2 opUpEff eff e+    expr2Dn eff = expr2 opDnEff eff e++equalRoundingUpDnBin1Var2 :: +    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    String ->+    (Expr1Op2Eff eiOp t) -> +    (Expr1Op2Eff eiOp t) -> +    (PRelEff eiRel t) -> +    (OpEff eiOp t) -> (OpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> t -> Bool+equalRoundingUpDnBin1Var2 contextDescription expr1 expr2 pCompareEff opUpEff opDnEff +        initEffort e1 e2 =+    equalRoundingUpDn contextDescription expr1Up expr1Dn expr2Up expr2Dn pCompareEff initEffort+    where+    expr1Up eff = expr1 opUpEff eff e1 e2+    expr1Dn eff = expr1 opDnEff eff e1 e2+    expr2Up eff = expr2 opUpEff eff e1 e2+    expr2Dn eff = expr2 opDnEff eff e1 e2++equalRoundingUpDnBin1Var3 :: +    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp, Show eiOp, +     Show t, HasLegalValues t) =>+    String ->+    (Expr1Op3Eff eiOp t) -> +    (Expr1Op3Eff eiOp t) -> +    (PRelEff eiRel t) -> +    (OpEff eiOp t) -> (OpEff eiOp t) -> +    (eiRel, eiOp) -> +    t -> t -> t -> Bool+equalRoundingUpDnBin1Var3 contextDescription expr1 expr2 pCompareEff opUpEff opDnEff +        initEffort e1 e2 e3 =+    equalRoundingUpDn contextDescription expr1Up expr1Dn expr2Up expr2Dn pCompareEff initEffort+    where+    expr1Up eff = expr1 opUpEff eff e1 e2 e3+    expr1Dn eff = expr1 opDnEff eff e1 e2 e3+    expr2Up eff = expr2 opUpEff eff e1 e2 e3+    expr2Dn eff = expr2 opDnEff eff e1 e2 e3++equalRoundingUpDnBin2Var3 :: +    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp1, Show eiOp1, +     EffortIndicator eiOp2, Show eiOp2,+     Show t, HasLegalValues t) =>+    String ->+    (Expr2Op3Eff eiOp1 eiOp2 t) -> +    (Expr2Op3Eff eiOp1 eiOp2 t) -> +    (PRelEff eiRel t) -> +    (OpEff eiOp1 t) -> (OpEff eiOp2 t) -> +    (OpEff eiOp1 t) -> (OpEff eiOp2 t) -> +    (eiRel, (eiOp1, eiOp2)) -> +    t -> t -> t -> Bool+equalRoundingUpDnBin2Var3 contextDescription expr1 expr2 pCompareEff +        op1UpEff op2UpEff +        op1DnEff op2DnEff +        initEffort e1 e2 e3 =+    equalRoundingUpDn contextDescription expr1Up expr1Dn expr2Up expr2Dn pCompareEff initEffort+    where+    expr1Up eff = expr1 op1UpEff op2UpEff eff e1 e2 e3+    expr1Dn eff = expr1 op1DnEff op2DnEff eff e1 e2 e3+    expr2Up eff = expr2 op1UpEff op2UpEff eff e1 e2 e3+    expr2Dn eff = expr2 op1DnEff op2DnEff eff e1 e2 e3++thinEqualConsLeqRoundingUpDnImprovementBin2Var3 :: +    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp1, Show eiOp1, +     EffortIndicator eiOp2, Show eiOp2,+     HasAntiConsistency t, Show t, HasLegalValues t) =>+    String ->+    (Expr2Op3Eff eiOp1 eiOp2 t) -> +    (Expr2Op3Eff eiOp1 eiOp2 t) -> +    (PRelEff eiRel t) -> +    (OpEff eiOp1 t) -> (OpEff eiOp2 t) -> +    (OpEff eiOp1 t) -> (OpEff eiOp2 t) ->+    (ConsistencyEffortIndicator t) -> +    (eiRel, (eiOp1, eiOp2)) -> +    t -> t -> t -> Bool+thinEqualConsLeqRoundingUpDnImprovementBin2Var3+        contextDescription+        expr1 expr2 pCompareEff +        op1UpEff op2UpEff +        op1DnEff op2DnEff +        effortConsistency+        initEffort +        e1 e2 e3 =+    thinEqualConsLeqRoundingUpDnImprovement+        contextDescription+        [e1,e2,e3] expr1Up expr1Dn expr2Up expr2Dn +        pCompareEff+        effortConsistency +        initEffort+    where+    expr1Up eff = expr1 op1UpEff op2UpEff eff e1 e2 e3+    expr1Dn eff = expr1 op1DnEff op2DnEff eff e1 e2 e3+    expr2Up eff = expr2 op1UpEff op2UpEff eff e1 e2 e3+    expr2Dn eff = expr2 op1DnEff op2DnEff eff e1 e2 e3++++equalRoundingUpDnBin2Var2 :: +    (EffortIndicator eiRel, Show eiRel, +     EffortIndicator eiOp1, Show eiOp1, +     EffortIndicator eiOp2, Show eiOp2,+     Show t, HasLegalValues t) =>+    String ->+    (Expr2Op2Eff eiOp1 eiOp2 t) -> +    (Expr2Op2Eff eiOp1 eiOp2 t) -> +    (PRelEff eiRel t) -> +    (OpEff eiOp1 t) -> (OpEff eiOp2 t) -> +    (OpEff eiOp1 t) -> (OpEff eiOp2 t) -> +    (eiRel, (eiOp1, eiOp2)) -> +    t -> t -> Bool+equalRoundingUpDnBin2Var2 contextDescription expr1 expr2 pCompareEff +        op1UpEff op2UpEff +        op1DnEff op2DnEff +        initEffort e1 e2 =+    equalRoundingUpDn contextDescription expr1Up expr1Dn expr2Up expr2Dn pCompareEff initEffort+    where+    expr1Up eff = expr1 op1UpEff op2UpEff eff e1 e2+    expr1Dn eff = expr1 op1DnEff op2DnEff eff e1 e2+    expr2Up eff = expr2 op1UpEff op2UpEff eff e1 e2+    expr2Dn eff = expr2 op1DnEff op2DnEff eff e1 e2++thinEqualConsLeqRoundingUpDnImprovement :: +    (EffortIndicator eiRel, EffortIndicator eiOp,+     Show eiOp, Show eiRel,+     HasAntiConsistency t, Show t, HasLegalValues t) =>+    String ->+    [t] -> +    (eiOp -> t) {-^ left hand side expression UP -} -> +    (eiOp -> t) {-^ left hand side expression DN -} -> +    (eiOp -> t) {-^ right hand side expression UP -} -> +    (eiOp -> t) {-^ right hand side expression DN -} ->+    (PRelEff eiRel t) -> +    (ConsistencyEffortIndicator t) -> +    (eiRel, eiOp) -> Bool+thinEqualConsLeqRoundingUpDnImprovement+        contextDescription+        parameters+        expr1Up expr1Dn expr2Up expr2Dn+        pCompareEff+        consistencyEffort +        initEffort@(effComp, effOp)+    | allConsistent && allAntiConsistent =+        okIfThin+    | allConsistent =+        okIfConsistent+    | allAntiConsistent =+        okIfAntiConsistent+    where+    allConsistent =+        and $ map isConsistent parameters+    allAntiConsistent =+        and $ map isAntiConsistent parameters+    okIfThin =+            (equalRoundingUpDn contextDescription+                expr1Up expr1Dn expr2Up expr2Dn +                pCompareEff initEffort)+    okIfConsistent =+            leqRoundingUpDn expr1Dn expr2Up+    okIfAntiConsistent = +            leqRoundingUpDn expr2Dn expr1Up+    isConsistent a = +        justButNot False $ isConsistentEff consistencyEffort a+    isAntiConsistent a = +        justButNot False $ isAntiConsistentEff consistencyEffort a+    leqRoundingUpDn expr1Dn expr2Up =+        case pCompareEff effComp (expr1Dn effOp) (expr2Up effOp) of+            Just res -> res+            Nothing -> True+++equalRoundingUpDn :: +    (EffortIndicator eiRel, EffortIndicator eiOp,+     Show eiOp, Show eiRel,+     Show t, HasLegalValues t) =>+    String ->+    (eiOp -> t) {-^ left hand side expression UP -} -> +    (eiOp -> t) {-^ left hand side expression DN -} -> +    (eiOp -> t) {-^ right hand side expression UP -} -> +    (eiOp -> t) {-^ right hand side expression DN -} -> +    (PRelEff eiRel t) -> +    (eiRel, eiOp) -> Bool+equalRoundingUpDn +        contextDescription+        expr1Up expr1Dn expr2Up expr2Dn +        pCompareEff initEffort =+--    unsafePrint +--    (+--        "equalRoundingUpDn:"+--        ++ "\n  efforts executed = \n" ++ unlines (map show $ take (comparisonCount + 1) efforts)+--        ++ "\n  5 successes = \n" ++ unlines (map show relevantSuccesses)+--    ) +--    $+    case evalCatchDomViolationExceptions "checking a property" result of+            Left e -> True+                -- ignore tests during which a domain violation exception arises +            Right res -> res+                -- throw an exception if the result is an illegal values (eg NaN) +    where+    result = +        (andUnsafeReportFirstFalse relevantSuccesses)  +    relevantSuccesses = take 5 successes+    successes = map check efforts+    efforts =+        (initEffort : ) $ take 15 $ effortIncrementSequence initEffort+    check (effortRel, effortOp) =+        successWithMsg +        where+        successWithMsg =+            (success,+              "failure for effortRel = " ++ show effortRel +                ++ " effortOp = " ++ show effortOp+              ++ "\n val1Dn <=? val2Up is " +                ++ show val1Dn ++ " <=? " ++ show val2Up ++ " = "+                ++ show (val1Dn <=? val2Up)+              ++ "\n val2Dn <=? val1Up is " +                ++ show val2Dn ++ " <=? " ++ show val1Up ++ " = "+                ++ show (val2Dn <=? val1Up)+            )+        success =+            (defined (val1Dn <=? val2Up) ===> (val1Dn <= val2Up))+            &&+            (defined (val2Dn <=? val1Up) ===> (val2Dn <= val1Up))+        val1Dn = check $ expr1Dn effortOp+        val1Up = check $ expr1Up effortOp+        val2Dn = check $ expr2Dn effortOp+        val2Up = check $ expr2Up effortOp+        check = detectIllegalValues contextDescription+        (<=) = assumeTotal2 (<=?)+        (<=?) = pCompareEff effortRel++roundedInPlace1ConsistentWithPure ::+    (EffortIndicator eiRel, EffortIndicator eiOp,+     Show eiOp, Show eiRel,+     CanBeMutable t, Show t, HasLegalValues t) =>+    String ->+    (forall s. eiOp -> OpMutable1 t s) {-^ left hand side expression UP -} -> +    (forall s. eiOp -> OpMutable1 t s) {-^ left hand side expression DN -} -> +    (eiOp -> UnaryOp t) {-^ right hand side expression UP -} -> +    (eiOp -> UnaryOp t) {-^ right hand side expression DN -} -> +    (PRelEff eiRel t) -> +    (eiRel, eiOp) -> +    t ->+    Bool+roundedInPlace1ConsistentWithPure+        contextDescription+        opUpInPlaceEff opDnInPlaceEff opUpEff opDnEff +        pLeqEff initEffort+        e+        =+    equalRoundingUpDn+        ("in-place" ++ contextDescription ++ " consistent with pure")+        expr1Up expr1Dn expr2Up expr2Dn +        pLeqEff initEffort+    where+    opUpEffViaInPlace = mutable1EffToPure (opUpInPlaceEff)+    opDnEffViaInPlace = mutable1EffToPure (opDnInPlaceEff)+    expr1Up eff = opUpEff eff e+    expr1Dn eff = opDnEff eff e+    expr2Up eff = opUpEffViaInPlace eff e+    expr2Dn eff = opDnEffViaInPlace eff e++roundedInPlace2ConsistentWithPure ::+    (EffortIndicator eiRel, EffortIndicator eiOp,+     Show eiOp, Show eiRel,+     CanBeMutable t, Show t, HasLegalValues t) =>+    String ->+    (forall s. eiOp -> OpMutable2 t s) {-^ left hand side expression UP -} -> +    (forall s. eiOp -> OpMutable2 t s) {-^ left hand side expression DN -} -> +    (eiOp -> Op t) {-^ right hand side expression UP -} -> +    (eiOp -> Op t) {-^ right hand side expression DN -} -> +    (PRelEff eiRel t) -> +    (eiRel, eiOp) -> +    t -> t ->+    Bool+roundedInPlace2ConsistentWithPure+        contextDescription+        opUpInPlaceEff opDnInPlaceEff opUpEff opDnEff +        pLeqEff initEffort+        e1 e2+        =+    equalRoundingUpDn+        ("in-place" ++ contextDescription ++ " consistent with pure")+        expr1Up expr1Dn expr2Up expr2Dn +        pLeqEff initEffort+    where+    opUpEffViaInPlace = mutable2EffToPure (opUpInPlaceEff)+    opDnEffViaInPlace = mutable2EffToPure (opDnInPlaceEff)+    expr1Up eff =+        let (*^) = opUpEff eff in e1 *^ e2+    expr1Dn eff =+        let (*.) = opDnEff eff in e1 *. e2+    expr2Up eff =+        let (*^) = opUpEffViaInPlace eff in e1 *^ e2+    expr2Dn eff =+        let (*.) = opDnEffViaInPlace eff in e1 *. e2+
+ src/Numeric/AERN/RealArithmetic/Measures.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.Measures+    Description :  measures of quality for approximations+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Measures of quality for approximations.+-}+module Numeric.AERN.RealArithmetic.Measures where++import {-# Source #-} Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps++import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++{-|+   Ability to measure a distance.  Distance+   should be a numeric type approximating the+   positive real numbers with Partial comparison.+-}+class HasDistance t where+    type Distance t+    type DistanceEffortIndicator t+    distanceDefaultEffort :: t -> (DistanceEffortIndicator t)+    {-| distance measure -}+    distanceBetweenEff :: +        DistanceEffortIndicator t -> t -> t -> Distance t++propDistanceTriangular :: +    (HasDistance t, +     NumOrd.PartialComparison (Distance t),+     RoundedAdd (Distance t)+    ) =>+    t ->+    (DistanceEffortIndicator t) ->     +    (NumOrd.PartialCompareEffortIndicator (Distance t)) -> +    (AddEffortIndicator (Distance t)) ->     +    t -> t -> t -> Bool+propDistanceTriangular _ effortDist effortComp effortAdd e1 e2 e3 =+    let ?pCompareEffort = effortComp in +    let (<+>) = addOutEff effortAdd in +        let+        d12 = distanceBetweenEff effortDist e1 e2+        d23 = distanceBetweenEff effortDist e2 e3+        d13 = distanceBetweenEff effortDist e1 e3+        in+        case (d12 <+> d23) >=? d13 of+            Nothing -> True+            Just b -> b++testsDistance ::+    (HasDistance t, +     NumOrd.PartialComparison (Distance t),+     RoundedAdd (Distance t),+     Arbitrary (NumOrd.PartialCompareEffortIndicator (Distance t)), +     Show (NumOrd.PartialCompareEffortIndicator (Distance t)),+     Arbitrary (AddEffortIndicator (Distance t)), +     Show (AddEffortIndicator (Distance t)),+     Arbitrary (DistanceEffortIndicator t), +     Show (DistanceEffortIndicator t), +     Arbitrary t, Show t) =>+    (String, t) -> Test+testsDistance (name, sample) =+    testGroup (name ++ " distance measure") $ +        [+         testProperty "triangle inequality" (propDistanceTriangular sample)+        ]++{-|+   A numeric measure of imprecision of approximations.+   A zero imprecision means the approximation is exact.+   The imprecision type should support Partial comparison.+-}+class HasImprecision t where+    type Imprecision t+    type ImprecisionEffortIndicator t+    imprecisionDefaultEffort :: t -> ImprecisionEffortIndicator t+    imprecisionOfEff :: ImprecisionEffortIndicator t -> t -> Imprecision t++propImprecisionDecreasesWithRefinement ::+    (HasImprecision t, NumOrd.PartialComparison (Imprecision t)) =>+    t -> +    (ImprecisionEffortIndicator t) -> +    (NumOrd.PartialCompareEffortIndicator (Imprecision t)) -> +    RefOrd.LEPair t -> Bool+propImprecisionDecreasesWithRefinement _ effortImpr effortComp (RefOrd.LEPair (e1,e2)) =+    let +    ?pCompareEffort = effortComp +    in+    case (imprecisionOfEff effortImpr e1) >=? (imprecisionOfEff effortImpr e2) of+        Nothing -> True+        Just b -> b++testsImprecision (name, sample) =+    testGroup (name ++ " imprecision measure") $ +        [+         testProperty "decreases with refinement" (propImprecisionDecreasesWithRefinement sample)+        ]++
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding+    Description :  common arithmetical operations rounded up/down  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Common arithmetical operations rounded up/down.+    +    This module is meant to be imported qualified.+    It is recommended to use the prefix ArithUpDn.+-}+module Numeric.AERN.RealArithmetic.NumericOrderRounding +(+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion,+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps,+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps,+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.SpecialConst,+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary,+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace,+    RoundedReal(..), RoundedRealInPlace+)+where++import Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion+import Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.SpecialConst+import Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary+import Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace++import Numeric.AERN.RealArithmetic.ExactOps+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd++{-|+   An aggregate class collecting together all functionality+   normally expected from up/down rounded approximations to+   real numbers such as the floating point numbers.+   +   It also provides a single aggregate effort indicator type+   from which effort indicators for all the rounded operations can+   be extracted.+-}+class +    (HasZero t, HasOne t, HasInfinities t, Neg t,+     NumOrd.PartialComparison t, NumOrd.RoundedLattice t,+     Convertible Int t, Convertible t Int,  +     Convertible Integer t, Convertible t Integer,  +     Convertible Double t, Convertible t Double,  +     Convertible Rational t, Convertible t Rational,  +     RoundedAbs t, +     RoundedField t,+     RoundedMixedField t Int, +     RoundedMixedField t Integer, +     RoundedMixedField t Double, +     RoundedMixedField t Rational) => +    RoundedReal t+    where+    type RoundedRealEffortIndicator t+    roundedRealDefaultEffort :: t -> RoundedRealEffortIndicator t+    rrEffortComp :: t -> (RoundedRealEffortIndicator t) -> (NumOrd.PartialCompareEffortIndicator t)+    rrEffortMinmax :: t -> (RoundedRealEffortIndicator t) -> (NumOrd.MinmaxEffortIndicator t)+    rrEffortToInt :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator t Int)+    rrEffortFromInt :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator Int t)+    rrEffortToInteger :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator t Integer)+    rrEffortFromInteger :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator Integer t)+    rrEffortToDouble :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator t Double)+    rrEffortFromDouble :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator Double t)+    rrEffortToRational :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator t Rational)+    rrEffortFromRational :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator Rational t)+    rrEffortAbs :: t -> (RoundedRealEffortIndicator t) -> (AbsEffortIndicator t)+    rrEffortField :: t -> (RoundedRealEffortIndicator t) -> (FieldOpsEffortIndicator t)+    rrEffortIntMixedField :: t -> (RoundedRealEffortIndicator t) -> (MixedFieldOpsEffortIndicator t Int)+    rrEffortIntegerMixedField :: t -> (RoundedRealEffortIndicator t) -> (MixedFieldOpsEffortIndicator t Integer)+    rrEffortDoubleMixedField :: t -> (RoundedRealEffortIndicator t) -> (MixedFieldOpsEffortIndicator t Double)+    rrEffortRationalMixedField :: t -> (RoundedRealEffortIndicator t) -> (MixedFieldOpsEffortIndicator t Rational)+     +{-|+   A mutable version of 'RoundedReal' with additional support for mutable ops.+-}+class+    (RoundedReal t,+     NegInPlace t,+     RoundedAbsInPlace t, +     RoundedFieldInPlace t,+     RoundedMixedFieldInPlace t Int, +     RoundedMixedFieldInPlace t Integer, +     RoundedMixedFieldInPlace t Double, +     RoundedMixedFieldInPlace t Rational) => +    RoundedRealInPlace t+ +
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/Conversion.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion+    Description :  conversion between approximations and other types  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Conversion between approximations and other types.+    +    This module is hidden and reexported via its parent NumericOrderRounding. +-}+module Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion where++import Prelude hiding (EQ, LT, GT)++import Numeric.AERN.RealArithmetic.ExactOps++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.PartialOrdering+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import Numeric.AERN.Misc.Bool+import Numeric.AERN.Misc.Maybe++import Data.Ratio+import Data.Maybe++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class Convertible t1 t2 where+    type ConvertEffortIndicator t1 t2+    convertDefaultEffort :: t1 -> t2 -> ConvertEffortIndicator t1 t2 +    convertUpEff :: ConvertEffortIndicator t1 t2 -> t1 -> Maybe t2+    convertDnEff :: ConvertEffortIndicator t1 t2 -> t1 -> Maybe t2++propConvertMonotone ::+    (Convertible t1 t2, +     NumOrd.ArbitraryOrderedTuple t1, +     NumOrd.PartialComparison t2) =>+    t1 -> t2 ->+    (ConvertEffortIndicator t1 t2,+     NumOrd.PartialCompareEffortIndicator t2) ->  +    NumOrd.LEPair t1 -> Bool+propConvertMonotone sample1 sample2 (effortConvert, effortComp2) (NumOrd.LEPair (a1, a2)) =+    (defined ma1Dn && defined ma2Up) ===>+    (trueOrNothing $ +        let ?pCompareEffort = effortComp2 in+        a1Dn <=? a2Up)+    where+    ma1Dn = convertDnEff effortConvert a1 +    ma2Up = convertUpEff effortConvert a2+    a1Dn = fromJust ma1Dn+    a2Up = fromJust ma2Up+    _ = [sample2, a1Dn, a2Up]+    +propConvertRoundTrip ::+    (Convertible t1 t2, Convertible t2 t1, NumOrd.PartialComparison t1) =>+    t1 -> t2 -> +    (NumOrd.PartialCompareEffortIndicator t1, +     ConvertEffortIndicator t2 t1, +     ConvertEffortIndicator t1 t2) ->+    t1 -> Bool+propConvertRoundTrip _ sample2 (effortComp, effortFrom2, effortTo2) a =+    (defined maDn2 && defined maDn && defined maUp2 && defined maUp) ===>+    let ?pCompareEffort = effortComp in+    case (aDn <=? a, a <=? aUp) of+       (Just False, _) -> False+       (_, Just False) -> False+       _ -> True+    where+    maDn = convertDnEff effortFrom2 aDn2+    aDn = fromJust maDn +    maDn2 = convertDnEff effortTo2 a+    aDn2 = fromJust maDn2 +    maUp = convertUpEff effortFrom2 aUp2+    aUp = fromJust maUp +    maUp2 = convertUpEff effortTo2 a+    aUp2 = fromJust maUp2+    _ = [sample2, aUp2, aDn2] +    +testsConvert (name1, sample1, name2, sample2) =+    testGroup (name1 ++ " -> " ++ name2 ++  " conversions") $+        [+            testProperty "monotone" (propConvertMonotone sample1 sample2)+        ,+            testProperty "round trip" (propConvertRoundTrip sample1 sample2)+        ]+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/Elementary.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary+    Description :  support for various common elementary functions+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Support for various common elementary functions.+    +    This module is hidden and reexported via its parent NumericOrderRounding. +-}++module Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary where++import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception+import Numeric.AERN.Basics.ShowInternals+import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import Numeric.AERN.Misc.Debug++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class RoundedExponentiationEffort t where+    type ExpEffortIndicator t+    expDefaultEffort :: t -> ExpEffortIndicator t++class (RoundedExponentiationEffort t) => RoundedExponentiation t where+    expUpEff :: (ExpEffortIndicator t) -> t -> t+    expDnEff :: (ExpEffortIndicator t) -> t -> t++-- | @e^a*e^(-a) = 1@+propExpOfNegRecip ::+    (NumOrd.PartialComparison t, NumOrd.RoundedLattice t,+     RoundedExponentiation t, RoundedMultiply t, Neg t, HasOne t,+     Show t, HasLegalValues t,+     ShowInternals t,+     Show (ExpEffortIndicator t),+     EffortIndicator (ExpEffortIndicator t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     (ExpEffortIndicator t, MultEffortIndicator t)) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propExpOfNegRecip _ initEffort (NumOrd.UniformlyOrderedSingleton e1) =+    equalRoundingUpDn "e^a * e^(-a) = 1"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effExp, effMult) = one+    expr1Dn (effExp, effMult) = one+    expr2Up (effExp, effMult) =+        let (*^) = multUpEff effMult in+        let expE1 = expUpEff effExp e1 in+        let expNegE1 = expUpEff effExp (neg e1) in+        let prod = expE1 *^ expNegE1 in+--        unsafePrintReturn+--        (+--          "propExpOfNegRecip: expr2Up: e1 = " ++ show e1 +--          ++ "; expE1 = " ++ show expE1 +--          ++ "; expNegE1 = " ++ show expNegE1 +--          ++ "; prod = " ++ showUsingShowInternals prod+--          ++ "; result = " +--        )$+        prod+    expr2Dn (effExp, effMult) =+        let (*.) = multDnEff effMult in+        let expE1 = expDnEff effExp e1 in+        let negE1 = (neg e1) in+        let expNegE1 = expDnEff effExp negE1 in+        let prod = expE1 *. expNegE1 in+--        unsafePrintReturn+--        (+--          "propExpOfNegRecip: expr2Dn: e1 = " ++ show e1 +--          ++ "; expE1 = " ++ show expE1 +--          ++ "; negE1 = " ++ show negE1 +--          ++ "; expNegE1 = " ++ show expNegE1 +--          ++ "; prod = " ++ showUsingShowInternals prod+--          ++ "; result = " +--        )$+        prod++-- | @e^(b+c) = e^b * e^c@+propExpOfAddToMult ::+    (NumOrd.PartialComparison t,+     RoundedExponentiation t, RoundedMultiply t,  RoundedAdd t,+     Show t, HasLegalValues t,+     Show (ExpEffortIndicator t),+     EffortIndicator (ExpEffortIndicator t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     (ExpEffortIndicator t, MultEffortIndicator t, AddEffortIndicator t)) -> +    (NumOrd.UniformlyOrderedPair t) -> +    Bool+propExpOfAddToMult _ initEffort (NumOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "e^(a + b) = e^a * e^b"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effExp, effMult, effAdd) =+        let (+^) = addUpEff effAdd in+        (expUpEff effExp (e1 +^ e2))+    expr1Dn (effExp, effMult, effAdd) =+        let (+.) = addDnEff effAdd in+        (expDnEff effExp (e1 +. e2))+    expr2Up (effExp, effMult, effAdd) =+        let (*^) = multUpEff effMult in+        (expUpEff effExp e1) *^ (expUpEff effExp e2)+    expr2Dn (effExp, effMult, effAdd) =+        let (*.) = multDnEff effMult in+        (expDnEff effExp e1) *. (expDnEff effExp e2)+    +testsUpDnExp (name, sample) =+    testGroup (name ++ " exp up/dn") $+        [+            testProperty "e^a * e^(-a) = 1" (propExpOfNegRecip sample)+        ,+            testProperty "e^(a + b) = e^a * e^b" (propExpOfAddToMult sample)+        ]+    +class RoundedSquareRootEffort t where+    type SqrtEffortIndicator t+    sqrtDefaultEffort :: t -> SqrtEffortIndicator t++class (RoundedSquareRootEffort t) => RoundedSquareRoot t where+    sqrtUpEff :: (SqrtEffortIndicator t) -> t -> t+    sqrtDnEff :: (SqrtEffortIndicator t) -> t -> t++propSqrtSquare ::+    (NumOrd.PartialComparison t, +     RoundedSquareRoot t, RoundedMultiply t, HasZero t,+     Show t, HasLegalValues t,+     ShowInternals t,+     Show (SqrtEffortIndicator t),+     EffortIndicator (SqrtEffortIndicator t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     (SqrtEffortIndicator t, MultEffortIndicator t, NumOrd.PartialCompareEffortIndicator t)) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propSqrtSquare _ initEffort (NumOrd.UniformlyOrderedSingleton e1) =+    case evalCatchDomViolationExceptions "checking sqrt(x)^2 = x"+            (equalRoundingUpDn "sqrt(x)^2 = x"+                expr1Up expr1Dn expr2Up expr2Dn +                NumOrd.pLeqEff initEffort) of+        Left e -> True -- was unlucky with the params+        Right r -> r+    where+    expr1Up (effSqrt, effMult, effCompare) =+        sqrtE1 *^ sqrtE1+        where+        (*^) = multUpEff effMult+        sqrtE1 = sqrtUpEff effSqrt e1+    expr1Dn (effSqrt, effMult, effCompare)+        | sqrtE1DefinitelyPositive = sqrtE1 *. sqrtE1+        | otherwise = zero+        where+        sqrtE1DefinitelyPositive =+            let ?pCompareEffort = effCompare in+            case sqrtE1 >=? zero of (Just r) -> r; _ -> False+        (*.) = multDnEff effMult+        sqrtE1 = sqrtDnEff effSqrt e1+    expr2Up _ = e1+    expr2Dn _ = e1++testsUpDnSqrt (name, sample) =+    testGroup (name ++ " sqrt up/dn") $+        [+            testProperty "sqrt(e)^2 = e" (propSqrtSquare sample)+        ]+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/FieldOps.hs view
@@ -0,0 +1,719 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+    Description :  rounded basic arithmetic operations  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Rounded basic arithmetical operations.+    +    This module is hidden and reexported via its parent NumericOrderRounding. +-}+module Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps +(+    RoundedAdd(..),RoundedAddEffort(..), RoundedSubtr(..), +    testsUpDnAdd, testsUpDnSubtr,+    RoundedAbs(..), RoundedAbsEffort(..), +    testsUpDnAbs, absUpUsingCompMax, absDnUsingCompMax,+    RoundedMultiply(..), RoundedMultiplyEffort(..), testsUpDnMult,+    RoundedPowerNonnegToNonnegInt(..), RoundedPowerNonnegToNonnegIntEffort(..),+    PowerNonnegToNonnegIntEffortIndicatorFromMult, +    powerNonnegToNonnegIntDefaultEffortFromMult,+    powerNonnegToNonnegIntUpEffFromMult,+    powerNonnegToNonnegIntDnEffFromMult,+    RoundedPowerToNonnegInt(..), RoundedPowerToNonnegIntEffort(..), testsUpDnIntPower, +    PowerToNonnegIntEffortIndicatorFromMult, +    powerToNonnegIntDefaultEffortFromMult,+    powerToNonnegIntUpEffFromMult,+    powerToNonnegIntDnEffFromMult,+    RoundedDivide(..), RoundedDivideEffort(..), testsUpDnDiv,+    RoundedRingEffort(..), RoundedFieldEffort(..),+    RoundedRing(..), RoundedField(..)+)+where++import Prelude hiding (EQ, LT, GT)+import Numeric.AERN.Basics.PartialOrdering++import Numeric.AERN.RealArithmetic.Auxiliary+import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception (HasLegalValues)+import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Maybe++class RoundedAddEffort t where+    type AddEffortIndicator t+    addDefaultEffort :: t -> AddEffortIndicator t++class (RoundedAddEffort t) => RoundedAdd t where+    addUpEff :: AddEffortIndicator t -> t -> t -> t+    addDnEff :: AddEffortIndicator t -> t -> t -> t++propUpDnAddZero ::+    (NumOrd.PartialComparison t, RoundedAdd t, HasZero t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnAddZero _ effort (NumOrd.UniformlyOrderedSingleton e) =+    roundedUnit zero NumOrd.pLeqEff addUpEff addDnEff effort e++propUpDnAddCommutative ::+    (NumOrd.PartialComparison t, RoundedAdd t, HasZero t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (NumOrd.UniformlyOrderedPair t) -> +    Bool+propUpDnAddCommutative _ effort (NumOrd.UniformlyOrderedPair (e1,e2)) =+    roundedCommutative NumOrd.pLeqEff addUpEff addDnEff effort e1 e2+       +propUpDnAddAssociative ::+    (NumOrd.PartialComparison t, RoundedAdd t, HasZero t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (NumOrd.UniformlyOrderedTriple t) -> +    Bool+propUpDnAddAssociative _ effort (NumOrd.UniformlyOrderedTriple (e1,e2,e3)) =+    roundedAssociative NumOrd.pLeqEff addUpEff addDnEff effort e1 e2 e3++testsUpDnAdd (name, sample) =+    testGroup (name ++ " +. +^") $+        [+            testProperty "0 absorbs" (propUpDnAddZero sample)+        ,+            testProperty "commutative" (propUpDnAddCommutative sample)+        ,+            testProperty "associative" (propUpDnAddAssociative sample)+        ]+        +class (RoundedAdd t, Neg t) => RoundedSubtr t where+    subtrUpEff :: (AddEffortIndicator t) -> t -> t -> t+    subtrDnEff :: (AddEffortIndicator t) -> t -> t -> t+    subtrUpEff effort a b = addUpEff effort a (neg b)+    subtrDnEff effort a b = addDnEff effort a (neg b)++propUpDnSubtrElim ::+    (NumOrd.PartialComparison t, RoundedSubtr t, HasZero t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnSubtrElim _ effort (NumOrd.UniformlyOrderedSingleton e) =+    roundedReflexiveCollapse zero NumOrd.pLeqEff subtrUpEff subtrDnEff effort e++propUpDnSubtrNegAdd ::+    (NumOrd.PartialComparison t, RoundedSubtr t, Neg t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (NumOrd.UniformlyOrderedPair t) -> +    Bool+propUpDnSubtrNegAdd _ initEffort (NumOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "a+b=a-(-b)"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up eff =+        let (-^) = subtrUpEff eff in e1 -^ (neg e2)+    expr1Dn eff =+        let (-.) = subtrDnEff eff in e1 -. (neg e2)+    expr2Up eff =+        let (+^) = addUpEff eff in e1 +^ e2+    expr2Dn eff =+        let (+.) = addDnEff eff in e1 +. e2+++testsUpDnSubtr (name, sample) =+    testGroup (name ++ " -. -^") $+        [+            testProperty "a-a=0" (propUpDnSubtrElim sample)+            ,+            testProperty "a+b=a-(-b)" (propUpDnSubtrNegAdd sample)+        ]++class RoundedAbsEffort t where+    type AbsEffortIndicator t+    absDefaultEffort :: t -> AbsEffortIndicator t++class (RoundedAbsEffort t) => RoundedAbs t where+    absUpEff :: (AbsEffortIndicator t) -> t -> t+    absDnEff :: (AbsEffortIndicator t) -> t -> t++absUpUsingCompMax ::+    (HasZero t, Neg t, +     NumOrd.PartialComparison t, NumOrd.RoundedLattice t) =>+    (NumOrd.PartialCompareEffortIndicator t,+     NumOrd.MinmaxEffortIndicator t) ->+    t -> t +absUpUsingCompMax (effortComp, effortMinmax) a =+    case NumOrd.pCompareEff effortComp zero a of+        Just EQ -> a+        Just LT -> a+        Just LEE -> a+        Just GT -> neg a+        Just GEE -> neg a+        _ -> zero `max` (a `max` (neg a))+    where+    max = NumOrd.maxUpEff effortMinmax++absDnUsingCompMax ::+    (HasZero t, Neg t, +     NumOrd.PartialComparison t, NumOrd.RoundedLattice t) =>+    (NumOrd.PartialCompareEffortIndicator t,+     NumOrd.MinmaxEffortIndicator t) ->+    t -> t +absDnUsingCompMax (effortComp, effortMinmax) a =+    case NumOrd.pCompareEff effortComp zero a of+        Just EQ -> a+        Just LT -> a+        Just LEE -> a+        Just GT -> neg a+        Just GEE -> neg a+        _ -> zero `max` (a `max` (neg a))+    where+    max = NumOrd.maxDnEff effortMinmax++propUpDnAbsNegSymmetric ::+    (NumOrd.PartialComparison t, RoundedAbs t, HasZero t,+     Show t, Neg t, HasLegalValues t,+     Show (AbsEffortIndicator t),+     EffortIndicator (AbsEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AbsEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnAbsNegSymmetric _ effort (NumOrd.UniformlyOrderedSingleton e) =+    roundedNegSymmetric NumOrd.pLeqEff absUpEff absDnEff effort e++propUpDnAbsIdempotent ::+    (NumOrd.PartialComparison t, RoundedAbs t, HasZero t,+     Show t, HasLegalValues t,+     Show (AbsEffortIndicator t),+     EffortIndicator (AbsEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AbsEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnAbsIdempotent _ effort (NumOrd.UniformlyOrderedSingleton e) =+    roundedIdempotent NumOrd.pLeqEff absUpEff absDnEff effort e++testsUpDnAbs (name, sample) =+    testGroup (name ++ " up/dn rounded abs") $+        [+            testProperty "neg -> no change" (propUpDnAbsNegSymmetric sample)+        ,+            testProperty "idempotent" (propUpDnAbsIdempotent sample)+        ]+++class RoundedMultiplyEffort t where+    type MultEffortIndicator t+    multDefaultEffort :: t -> MultEffortIndicator t++class (RoundedMultiplyEffort t) => RoundedMultiply t where+    multUpEff :: MultEffortIndicator t -> t -> t -> t+    multDnEff :: MultEffortIndicator t -> t -> t -> t++propUpDnMultOne ::+    (NumOrd.PartialComparison t, RoundedMultiply t, HasOne t,+     Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     MultEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnMultOne _ effort (NumOrd.UniformlyOrderedSingleton e) =+    roundedUnit one NumOrd.pLeqEff multUpEff multDnEff effort e++propUpDnMultCommutative ::+    (NumOrd.PartialComparison t, RoundedMultiply t, HasZero t,+     Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     MultEffortIndicator t) -> +    (NumOrd.UniformlyOrderedPair t) -> +    Bool+propUpDnMultCommutative _ effort (NumOrd.UniformlyOrderedPair (e1,e2)) =+    roundedCommutative NumOrd.pLeqEff multUpEff multDnEff effort e1 e2+       +propUpDnMultAssociative ::+    (NumOrd.PartialComparison t, NumOrd.RoundedLattice t, +     Show t, HasLegalValues t,+     RoundedMultiply t, HasZero t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.MinmaxEffortIndicator t),+     EffortIndicator (NumOrd.MinmaxEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     (MultEffortIndicator t, NumOrd.MinmaxEffortIndicator t)) -> +    (NumOrd.UniformlyOrderedTriple t) -> +    Bool+propUpDnMultAssociative _ initEffort (NumOrd.UniformlyOrderedTriple (e1, e2, e3)) =+    equalRoundingUpDn "associativity"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMult, effMinmax) =+        let (*^) = multUpEff effMult; (*.) = multDnEff effMult in+        let r1 = e1 *^ (e2 *^ e3) in+        let r2 = e1 *^ (e2 *. e3) in+        NumOrd.maxUpEff effMinmax r1 r2+    expr1Dn (effMult, effMinmax) =+        let (*^) = multUpEff effMult; (*.) = multDnEff effMult in+        let r1 = e1 *. (e2 *^ e3) in+        let r2 = e1 *. (e2 *. e3) in+        NumOrd.minDnEff effMinmax r1 r2+    expr2Up (effMult, effMinmax) =+        let (*^) = multUpEff effMult; (*.) = multDnEff effMult in+        let r1 = (e1 *^ e2) *^ e3 in+        let r2 = (e1 *. e2) *^ e3 in+        NumOrd.maxUpEff effMinmax r1 r2+    expr2Dn (effMult, effMinmax) =+        let (*^) = multUpEff effMult; (*.) = multDnEff effMult in+        let r1 = (e1 *^ e2) *. e3 in+        let r2 = (e1 *. e2) *. e3 in+        NumOrd.minDnEff effMinmax r1 r2++propUpDnMultDistributesOverAdd ::+    (NumOrd.PartialComparison t, NumOrd.RoundedLattice t,+     Show t, HasLegalValues t,+     RoundedMultiply t,  RoundedAdd t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.MinmaxEffortIndicator t),+     EffortIndicator (NumOrd.MinmaxEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     (MultEffortIndicator t, AddEffortIndicator t, NumOrd.MinmaxEffortIndicator t)) -> +    (NumOrd.UniformlyOrderedTriple t) -> +    Bool+propUpDnMultDistributesOverAdd _ initEffort (NumOrd.UniformlyOrderedTriple (e1, e2, e3)) =+    equalRoundingUpDn "distributivity"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMult, effAdd, effMinmax) =+        let (*^) = multUpEff effMult in+        let (+^) = addUpEff effAdd; (+.) = addDnEff effAdd in+        let r1 = e1 *^ (e2 +^ e3) in+        let r2 = e1 *^ (e2 +. e3) in+        NumOrd.maxUpEff effMinmax r1 r2+    expr1Dn (effMult, effAdd, effMinmax) =+        let (*.) = multDnEff effMult in+        let (+^) = addUpEff effAdd; (+.) = addDnEff effAdd in+        let r1 = e1 *. (e2 +^ e3) in+        let r2 = e1 *. (e2 +. e3) in+        NumOrd.minDnEff effMinmax r1 r2+    expr2Up (effMult, effAdd, _) =+        let (*^) = multUpEff effMult in+        let (+^) = addUpEff effAdd in+        (e1 *^ e2) +^ (e1 *^ e3)+    expr2Dn (effMult, effAdd, _) =+        let (*.) = multDnEff effMult in+        let (+.) = addDnEff effAdd in+        (e1 *. e2) +. (e1 *. e3)+       +    +testsUpDnMult (name, sample) =+    testGroup (name ++ " *. *^") $+        [+            testProperty "1 absorbs" (propUpDnMultOne sample)+        ,+            testProperty "commutative" (propUpDnMultCommutative sample)+        ,+            testProperty "associative" (propUpDnMultAssociative sample)+        ,+            testProperty "distributes over +" (propUpDnMultDistributesOverAdd sample)+        ]++-- simpler versions assuming the argument is non-negative:+class RoundedPowerNonnegToNonnegIntEffort t where+    type PowerNonnegToNonnegIntEffortIndicator t+    powerNonnegToNonnegIntDefaultEffort :: +        t -> PowerNonnegToNonnegIntEffortIndicator t ++class (RoundedPowerNonnegToNonnegIntEffort t) =>+        RoundedPowerNonnegToNonnegInt t where+    powerNonnegToNonnegIntUpEff :: +        (PowerNonnegToNonnegIntEffortIndicator t) -> +        t {-^ @x@ (assumed >=0) -} -> +        Int {-^ @n@ (assumed >=0)-} -> +        t {-^ @x^n@ rounded up -}+    powerNonnegToNonnegIntDnEff ::+        (PowerNonnegToNonnegIntEffortIndicator t) -> +        t {-^ @x@ (assumed >=0) -} -> +        Int {-^ @n@ (assumed >=0)-} -> +        t {-^ @x^n@ rounded down -}+        +-- functions providing an implementation derived from rounded multiplication: +        +type PowerNonnegToNonnegIntEffortIndicatorFromMult t =+    MultEffortIndicator t+    +powerNonnegToNonnegIntDefaultEffortFromMult a =+    multDefaultEffort a++powerNonnegToNonnegIntUpEffFromMult ::+    (RoundedMultiply t, HasOne t) => +    PowerNonnegToNonnegIntEffortIndicatorFromMult t -> +    t -> Int -> t+powerNonnegToNonnegIntUpEffFromMult effMult e n =+    powerFromMult (multUpEff effMult) e n++powerNonnegToNonnegIntDnEffFromMult ::+    (RoundedMultiply t, HasOne t) => +    PowerNonnegToNonnegIntEffortIndicatorFromMult t -> +    t -> Int -> t+powerNonnegToNonnegIntDnEffFromMult effMult e n =+    powerFromMult (multDnEff effMult) e n++-- now not assuming the argument is non-negative:+class RoundedPowerToNonnegIntEffort t where+    type PowerToNonnegIntEffortIndicator t+    powerToNonnegIntDefaultEffort :: +        t -> PowerToNonnegIntEffortIndicator t ++class (RoundedPowerToNonnegIntEffort t) => RoundedPowerToNonnegInt t where+    powerToNonnegIntUpEff ::+        (PowerToNonnegIntEffortIndicator t) -> +        t {-^ @x@ -} -> +        Int {-^ @n@ (assumed >=0)-} -> +        t {-^ @x^n@ rounded up -}+    powerToNonnegIntDnEff ::+        (PowerToNonnegIntEffortIndicator t) -> +        t {-^ @x@ -} -> +        Int {-^ @n@ (assumed >=0)-} -> +        t {-^ @x^n@ rounded down -}++-- functions providing an implementation derived from rounded multiplication: ++type PowerToNonnegIntEffortIndicatorFromMult t =+    (MultEffortIndicator t, +     NumOrd.PartialCompareEffortIndicator t, +     NumOrd.MinmaxEffortIndicator t)+     +powerToNonnegIntDefaultEffortFromMult a =+    (multDefaultEffort a,+     NumOrd.pCompareDefaultEffort a,+     NumOrd.minmaxDefaultEffort a)++powerToNonnegIntUpEffFromMult :: +    (RoundedMultiply t, HasOne t, +     NumOrd.PartialComparison t, HasZero t, +     Neg t, NumOrd.RoundedLattice t) => +    PowerToNonnegIntEffortIndicatorFromMult t ->+    t -> Int -> t+powerToNonnegIntUpEffFromMult (effMult, effComp, effMinmax) e n =+    powerToNonnegIntDir+        (multUpEff effMult) (multDnEff effMult)+        (NumOrd.maxUpEff effMinmax)+        effComp e n++powerToNonnegIntDnEffFromMult :: +    (RoundedMultiply t, HasOne t, +     NumOrd.PartialComparison t, HasZero t, +     Neg t, NumOrd.RoundedLattice t) => +    PowerToNonnegIntEffortIndicatorFromMult t ->+    t -> Int -> t+powerToNonnegIntDnEffFromMult (effMult, effComp, effMinmax) e n =+    powerToNonnegIntDir +        (multDnEff effMult) (multUpEff effMult) +        (NumOrd.minDnEff effMinmax)+        effComp e n++powerToNonnegIntDir :: +    (HasOne t, +     NumOrd.PartialComparison t, HasZero t, +     Neg t) => +    (t -> t -> t) {-^ multiplication rounded in the desired direction -} ->+    (t -> t -> t) {-^ multiplication rounded in the opposite direction -} ->+    (t -> t -> t) {-^ safe combination of alternative results -} ->+    (NumOrd.PartialCompareEffortIndicator t) -> +    t -> Int -> t+powerToNonnegIntDir mult1 mult2 combine effComp x n+    | n == 0 = one+    | n == 1 = x+    | otherwise =+        case (pNonnegNonposEff effComp x) of+            (Just True, _) -> resNonneg+            (_, Just True) -> resNonpos+            _ -> resNonneg `combine` resNonpos+    where+    resNonneg = powerFromMult mult1 x n+    resNonpos +        | even n = +            powerFromMult mult1 (neg x) n+        | otherwise = +            neg $ powerFromMult mult2 (neg x) n +            -- switching rounding direction++propUpDnPowerSumExponents ::+    (NumOrd.PartialComparison t, NumOrd.RoundedLattice t,+     RoundedPowerToNonnegInt t, RoundedMultiply t, +     HasOne t, HasZero t, Neg t,+     Show t, HasLegalValues t,+     Show (PowerToNonnegIntEffortIndicator t),+     EffortIndicator (PowerToNonnegIntEffortIndicator t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.MinmaxEffortIndicator t),+     EffortIndicator (NumOrd.MinmaxEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t,+     (PowerToNonnegIntEffortIndicator t,+      (NumOrd.PartialCompareEffortIndicator t,+       MultEffortIndicator t,+       NumOrd.MinmaxEffortIndicator t))) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Int -> Int -> Bool+propUpDnPowerSumExponents _ initEffort (NumOrd.UniformlyOrderedSingleton a) nR mR =+    equalRoundingUpDn "a^(n+m) = a^n * a^m"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    n = nR `mod` 10+    m = mR `mod` 10+    minusA = neg a+    expr1Up (effPower, (effComp, effMult, effMinmax)) =+        let (^^) = powerToNonnegIntUpEff effPower in+        a ^^ (n + m)+    expr1Dn (effPower, (effComp, effMult, effMinmax)) =+        let (^.) = powerToNonnegIntDnEff effPower in+        a ^. (n + m)+    expr2Up (effPower, (effComp, effMult, effMinmax)) =+        case pNonnegNonposEff effComp a of+            (Just True, _) -> rNonneg+            (_, Just True) -> rNonpos+            _ -> rNonneg `max` rNonpos+        where+        max = NumOrd.maxUpEff effMinmax+        (^^) = powerToNonnegIntUpEff effPower+        (^.) = powerToNonnegIntDnEff effPower+        (*^) = multUpEff effMult+        (*.) = multDnEff effMult+        rNonneg = (a ^^ n) *^ (a ^^ m)+        rNonpos =+            case (even (n + m)) of+                True -> (minusA ^^ n) *^ (minusA ^^ m)+                False -> neg $ (minusA ^. n) *. (minusA ^. m)+    expr2Dn (effPower, (effComp, effMult, effMinmax)) =+        case pNonnegNonposEff effComp a of+            (Just True, _) -> rNonneg+            (_, Just True) -> rNonpos+            _ -> rNonneg `min` rNonpos+        where+        min = NumOrd.minDnEff effMinmax+        (^^) = powerToNonnegIntUpEff effPower+        (^.) = powerToNonnegIntDnEff effPower+        (*^) = multUpEff effMult+        (*.) = multDnEff effMult+        rNonneg = (a ^. n) *. (a ^. m)+        rNonpos =+            case (even (n + m)) of+                True -> (minusA ^. n) *. (minusA ^. m)+                False -> neg $ (minusA ^^ n) *^ (minusA ^^ m)++testsUpDnIntPower (name, sample) =+    testGroup (name ++ " non-negative integer power") $+        [+            testProperty "a^(n+m) = a^n * a^m" (propUpDnPowerSumExponents sample)+--            ,+--            testProperty "a/b=a*(1/b)" (propUpDnDivRecipMult sample)+        ]+++class RoundedDivideEffort t where+    type DivEffortIndicator t+    divDefaultEffort :: t -> DivEffortIndicator t++class (HasOne t, RoundedDivideEffort t) => RoundedDivide t where+    divUpEff :: DivEffortIndicator t -> t -> t -> t+    divDnEff :: DivEffortIndicator t -> t -> t -> t+    recipUpEff :: DivEffortIndicator t -> t -> t+    recipDnEff :: DivEffortIndicator t -> t -> t+    recipUpEff eff = divUpEff eff one+    recipDnEff eff = divDnEff eff one++propUpDnDivElim ::+    (NumOrd.PartialComparison t, RoundedDivide t, HasOne t, HasZero t,+     Show t, HasLegalValues t,+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     DivEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnDivElim _ efforts2@(effComp, _) (NumOrd.UniformlyOrderedSingleton a) =+    roundedReflexiveCollapse +        one +        NumOrd.pLeqEff +        divUpEff divDnEff +        efforts2 +        a+        +propUpDnDivRecipMult ::+    (NumOrd.PartialComparison t, NumOrd.RoundedLattice t,+     Show t, HasLegalValues t,+     RoundedMultiply t, RoundedDivide t, HasOne t, HasZero t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (NumOrd.MinmaxEffortIndicator t),+     EffortIndicator (NumOrd.MinmaxEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t,+     (MultEffortIndicator t, DivEffortIndicator t, NumOrd.MinmaxEffortIndicator t)) -> +    (NumOrd.UniformlyOrderedPair t) -> +    Bool+propUpDnDivRecipMult _ initEffort@(effComp,_) (NumOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "a/b=a*(1/b)"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMult, effDiv, effMinmax) =+        let (*^) = multUpEff effMult in+        let (/^) = divUpEff effDiv; (/.) = divDnEff effDiv in+        let r1 = e1 *^ (one /^ e2) in+        let r2 = e1 *^ (one /. e2) in+        NumOrd.maxUpEff effMinmax r1 r2+    expr1Dn (effMult, effDiv, effMinmax) =+        let (*.) = multDnEff effMult in+        let (/^) = divUpEff effDiv; (/.) = divDnEff effDiv in+        let r1 = e1 *. (one /^ e2) in+        let r2 = e1 *. (one /. e2) in+        NumOrd.minDnEff effMinmax r1 r2+    expr2Up (effMult, effDiv, _) =+        let (/^) = divUpEff effDiv in+        e1 /^ e2+    expr2Dn (effMult, effDiv, _) =+        let (/.) = divDnEff effDiv in+        e1 /. e2++testsUpDnDiv (name, sample) =+    testGroup (name ++ " /. /^") $+        [+            testProperty "a/a=1" (propUpDnDivElim sample)+            ,+            testProperty "a/b=a*(1/b)" (propUpDnDivRecipMult sample)+        ]++class (RoundedAddEffort t, +       RoundedMultiplyEffort t, +       RoundedPowerNonnegToNonnegIntEffort t, +       RoundedPowerToNonnegIntEffort t) => +    RoundedRingEffort t+    where+    type RingOpsEffortIndicator t+    ringOpsDefaultEffort :: t -> RingOpsEffortIndicator t+    ringEffortAdd :: t -> (RingOpsEffortIndicator t) -> (AddEffortIndicator t)+    ringEffortMult :: t ->  (RingOpsEffortIndicator t) -> (MultEffortIndicator t)+    ringEffortPow :: t -> (RingOpsEffortIndicator t) -> (PowerNonnegToNonnegIntEffortIndicator t)++class (RoundedAdd t, RoundedSubtr t, +       RoundedMultiply t, +       RoundedPowerNonnegToNonnegInt t, +       RoundedPowerToNonnegInt t,+       RoundedRingEffort t) => +    RoundedRing t++class (RoundedRingEffort t, RoundedDivideEffort t) => RoundedFieldEffort t+    where+    type FieldOpsEffortIndicator t+    fieldOpsDefaultEffort :: t -> FieldOpsEffortIndicator t+    fldEffortAdd :: t -> (FieldOpsEffortIndicator t) -> (AddEffortIndicator t)+    fldEffortMult :: t ->  (FieldOpsEffortIndicator t) -> (MultEffortIndicator t)+    fldEffortPow :: t -> (FieldOpsEffortIndicator t) -> (PowerNonnegToNonnegIntEffortIndicator t)+    fldEffortDiv :: t -> (FieldOpsEffortIndicator t) -> (DivEffortIndicator t)++class (RoundedRing t, RoundedDivide t, RoundedFieldEffort t) => RoundedField t++
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/InPlace.hs view
@@ -0,0 +1,26 @@+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace+    Description :  common arithmetical operations rounded up/down  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    In-place versions of common arithmetical operations rounded up/down.+    +    This module is hidden and reexported via its parent NumericOrderRounding. +-}+module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace+(+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps,+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.MixedFieldOps,+    module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.Elementary+)+where++import Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.MixedFieldOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.Elementary+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/InPlace/Elementary.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.Elementary+    Description :  support for various common elementary functions+    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Support for various common elementary functions.+    +    This module is hidden and reexported via its parent NumericOrderRounding.InPlace. +-}++module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.Elementary where++import Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary++import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception (HasLegalValues)+import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class (RoundedExponentiation t, CanBeMutable t) => RoundedExponentiationInPlace t where+    expUpInPlaceEff :: OpMutable1Eff (ExpEffortIndicator t) t s+    expDnInPlaceEff :: OpMutable1Eff (ExpEffortIndicator t) t s++expUpInPlaceEffFromPure,+ expDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedExponentiation t) =>+    OpMutable1Eff (ExpEffortIndicator t) t s+expUpInPlaceEffFromPure =+    pureToMutable1Eff expUpEff+expDnInPlaceEffFromPure =+    pureToMutable1Eff expDnEff++expUpInPlaceEffFromInPlace,+ expDnInPlaceEffFromInPlace ::+    (RoundedExponentiationInPlace t) =>+    (ExpEffortIndicator t) -> t -> t+expUpInPlaceEffFromInPlace = +    mutable1EffToPure expUpInPlaceEff +expDnInPlaceEffFromInPlace = +    mutable1EffToPure expDnInPlaceEff ++propUpDnExpInPlace ::+    (NumOrd.PartialComparison t, +     RoundedExponentiationInPlace t, +     RoundedExponentiation t, +     Neg t,+     Show t, HasLegalValues t,+     Show (ExpEffortIndicator t),+     EffortIndicator (ExpEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     ExpEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnExpInPlace sample initEffort (NumOrd.UniformlyOrderedSingleton e1) =+    equalRoundingUpDn "in-place rounded exp"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expUpEffViaInPlace = mutable1EffToPure expUpInPlaceEff+    expDnEffViaInPlace = mutable1EffToPure expDnInPlaceEff+    expr1Up eff = expUpEff eff e1+    expr1Dn eff = expDnEff eff e1+    expr2Up eff = expUpEffViaInPlace eff e1+    expr2Dn eff = expDnEffViaInPlace eff e1++testsUpDnExpInPlace (name, sample) =+    testGroup (name ++ " in place exp") $+        [+            testProperty "matches pure" (propUpDnExpInPlace sample)+        ]++        +class (RoundedSquareRoot t, CanBeMutable t) => RoundedSquareRootInPlace t where+    sqrtUpInPlaceEff :: OpMutable1Eff (SqrtEffortIndicator t) t s+    sqrtDnInPlaceEff :: OpMutable1Eff (SqrtEffortIndicator t) t s++sqrtUpInPlaceEffFromPure,+ sqrtDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedSquareRoot t) =>+    OpMutable1Eff (SqrtEffortIndicator t) t s+sqrtUpInPlaceEffFromPure =+    pureToMutable1Eff sqrtUpEff+sqrtDnInPlaceEffFromPure =+    pureToMutable1Eff sqrtDnEff++sqrtUpInPlaceEffFromInPlace,+ sqrtDnInPlaceEffFromInPlace ::+    (RoundedSquareRootInPlace t) =>+    (SqrtEffortIndicator t) -> t -> t +sqrtUpInPlaceEffFromInPlace = +    mutable1EffToPure sqrtUpInPlaceEff +sqrtDnInPlaceEffFromInPlace = +    mutable1EffToPure sqrtDnInPlaceEff ++propUpDnSqrtInPlace ::+    (NumOrd.PartialComparison t, +     RoundedSquareRootInPlace t, +     RoundedSquareRoot t, +     Neg t,+     Show t, HasLegalValues t,+     Show (SqrtEffortIndicator t),+     EffortIndicator (SqrtEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     SqrtEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnSqrtInPlace sample initEffort (NumOrd.UniformlyOrderedSingleton e1) =+    equalRoundingUpDn "in-place rounded sqrt"+        sqrtr1Up sqrtr1Dn sqrtr2Up sqrtr2Dn +        NumOrd.pLeqEff initEffort+    where+    sqrtUpEffViaInPlace = mutable1EffToPure sqrtUpInPlaceEff+    sqrtDnEffViaInPlace = mutable1EffToPure sqrtDnInPlaceEff+    sqrtr1Up eff = sqrtUpEff eff e1+    sqrtr1Dn eff = sqrtDnEff eff e1+    sqrtr2Up eff = sqrtUpEffViaInPlace eff e1+    sqrtr2Dn eff = sqrtDnEffViaInPlace eff e1++testsUpDnSqrtInPlace (name, sample) =+    testGroup (name ++ " in place sqrt") $+        [+            testProperty "matches pure" (propUpDnSqrtInPlace sample)+        ]+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/InPlace/FieldOps.hs view
@@ -0,0 +1,453 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE RankNTypes #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps+    Description :  rounded basic arithmetic operations  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    In-place versions of rounded basic arithmetic operations.+    +    Each operations takes mutable parameters instead of pure parameters+    and has one extra mutable parameter before the other parameters, +    in which it stores the result.+    The mutable parameters can alias arbitrarily, making it possible+    to eg add to a number overwriting the original number.+    +    The operations have as their first paramter a non-mutable sample value+    to aid type-checking, ie to help work out which type the mutable parameters+    contain.+    +    This module is hidden and reexported via its parent NumericOrderRounding.InPlace. +-}+module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps +where++import Prelude hiding (EQ, LT, GT)+import Numeric.AERN.Basics.PartialOrdering++import Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps++import Numeric.AERN.RealArithmetic.Auxiliary+import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception (HasLegalValues)+import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Control.Monad.ST+import Data.Maybe++class (RoundedAddEffort t, CanBeMutable t) => RoundedAddInPlace t where+    addUpInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s+    addDnInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s++addUpInPlaceEffFromPure,+ addDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedAdd t) =>+    OpMutable2Eff (AddEffortIndicator t) t s +addUpInPlaceEffFromPure = pureToMutable2Eff addUpEff +addDnInPlaceEffFromPure = pureToMutable2Eff addDnEff++addUpInPlaceEffFromInPlace,+ addDnInPlaceEffFromInPlace :: +    (RoundedAddInPlace t) =>+    (AddEffortIndicator t) -> t -> t -> t +addUpInPlaceEffFromInPlace = mutable2EffToPure addUpInPlaceEff +addDnInPlaceEffFromInPlace = mutable2EffToPure addDnInPlaceEff ++propUpDnAddInPlace ::+    (NumOrd.PartialComparison t, Neg t, +     RoundedAddInPlace t, RoundedAdd t, +     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (NumOrd.UniformlyOrderedPair t) -> +    Bool+propUpDnAddInPlace sample initEffort (NumOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "in-place rounded addition"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    addUpEffViaInPlace = mutable2EffToPure addUpInPlaceEff+    addDnEffViaInPlace = mutable2EffToPure addDnInPlaceEff+    expr1Up eff =+        let (+^) = addUpEff eff in e1 +^ e2+    expr1Dn eff =+        let (+.) = addDnEff eff in e1 +. e2+    expr2Up eff =+        let (+^) = addUpEffViaInPlace eff in e1 +^ e2+    expr2Dn eff =+        let (+.) = addDnEffViaInPlace eff in e1 +. e2++class (RoundedAddInPlace t,  NegInPlace t) => RoundedSubtrInPlace t where+    subtrUpInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s+    subtrDnInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s+    subtrUpInPlaceEff effort rM aM bM =+        do+        bbM <- cloneMutable bM+        negInPlace bbM bM+        addUpInPlaceEff effort rM aM bbM+    subtrDnInPlaceEff effort rM aM bM = +        do+        bbM <- cloneMutable bM+        negInPlace bbM bM+        addDnInPlaceEff effort rM aM bbM++propUpDnSubtrInPlace ::+    (NumOrd.PartialComparison t, +     RoundedSubtrInPlace t, RoundedSubtr t, +     Neg t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (NumOrd.UniformlyOrderedPair t) ->+    Bool+propUpDnSubtrInPlace sample initEffort (NumOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "in-place rounded subtraction"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    subtrUpEffViaInPlace = mutable2EffToPure subtrUpInPlaceEff+    subtrDnEffViaInPlace = mutable2EffToPure subtrDnInPlaceEff+    expr1Up eff =+        let (-^) = subtrUpEff eff in e1 -^ e2+    expr1Dn eff =+        let (-.) = subtrDnEff eff in e1 -. e2+    expr2Up eff =+        let (-^) = subtrUpEffViaInPlace eff in e1 -^ e2+    expr2Dn eff =+        let (-.) = subtrDnEffViaInPlace eff in e1 -. e2+++class (RoundedAbsEffort t, CanBeMutable t) => RoundedAbsInPlace t where+    absUpInPlaceEff :: OpMutable1Eff (AbsEffortIndicator t) t s+    absDnInPlaceEff :: OpMutable1Eff (AbsEffortIndicator t) t s++absUpInPlaceEffFromPure,+ absDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedAbs t) =>+    OpMutable1Eff (AbsEffortIndicator t) t s+absUpInPlaceEffFromPure = pureToMutable1Eff absUpEff +absDnInPlaceEffFromPure = pureToMutable1Eff absDnEff ++absUpInPlaceEffFromInPlace,+ absDnInPlaceEffFromInPlace ::+    (RoundedAbsInPlace t) =>+    (AbsEffortIndicator t) -> t -> t+absUpInPlaceEffFromInPlace = mutable1EffToPure absUpInPlaceEff +absDnInPlaceEffFromInPlace = mutable1EffToPure absDnInPlaceEff ++propUpDnAbsInPlace ::+    (NumOrd.PartialComparison t, +     RoundedAbsInPlace t, RoundedAbs t,+     Neg t,+     Show t, HasLegalValues t,+     Show (AbsEffortIndicator t),+     EffortIndicator (AbsEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     AbsEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Bool+propUpDnAbsInPlace sample initEffort (NumOrd.UniformlyOrderedSingleton e1) =+    equalRoundingUpDn "in-place rounded abs"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    absUpEffViaInPlace = mutable1EffToPure absUpInPlaceEff+    absDnEffViaInPlace = mutable1EffToPure absDnInPlaceEff+    expr1Up eff = absUpEff eff e1+    expr1Dn eff = absDnEff eff e1+    expr2Up eff = absUpEffViaInPlace eff e1+    expr2Dn eff = absDnEffViaInPlace eff e1++class (RoundedMultiplyEffort t, CanBeMutable t) => RoundedMultiplyInPlace t where+    multUpInPlaceEff :: OpMutable2Eff (MultEffortIndicator t) t s+    multDnInPlaceEff :: OpMutable2Eff (MultEffortIndicator t) t s++multUpInPlaceEffFromPure,+ multDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedMultiply t) =>+    OpMutable2Eff (MultEffortIndicator t) t s+multUpInPlaceEffFromPure = pureToMutable2Eff multUpEff +multDnInPlaceEffFromPure = pureToMutable2Eff multDnEff ++multUpInPlaceEffFromInPlace,+ multDnInPlaceEffFromInPlace ::+    (RoundedMultiplyInPlace t) =>+    (MultEffortIndicator t) -> t -> t -> t+multUpInPlaceEffFromInPlace = mutable2EffToPure multUpInPlaceEff +multDnInPlaceEffFromInPlace = mutable2EffToPure multDnInPlaceEff ++propUpDnMultInPlace ::+    (NumOrd.PartialComparison t, +     RoundedMultiplyInPlace t, RoundedMultiply t,+     Neg t,+     Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     MultEffortIndicator t) -> +    (NumOrd.UniformlyOrderedPair t) ->+    Bool+propUpDnMultInPlace sample initEffort (NumOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "in-place rounded multiplication"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    multUpEffViaInPlace = mutable2EffToPure multUpInPlaceEff+    multDnEffViaInPlace = mutable2EffToPure multDnInPlaceEff+    expr1Up eff =+        let (*^) = multUpEff eff in e1 *^ e2+    expr1Dn eff =+        let (*.) = multDnEff eff in e1 *. e2+    expr2Up eff =+        let (*^) = multUpEffViaInPlace eff in e1 *^ e2+    expr2Dn eff =+        let (*.) = multDnEffViaInPlace eff in e1 *. e2++class (RoundedPowerNonnegToNonnegIntEffort t, CanBeMutable t) => +        RoundedPowerNonnegToNonnegIntInPlace t+    where+    powerNonnegToNonnegIntUpInPlaceEff ::+        OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicator t) t Int s+    powerNonnegToNonnegIntDnInPlaceEff ::+        OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicator t) t Int s+    -- default implementations, do not use these if the RoundedPowerNonnegToNonnegInt+    -- instance uses the ...fromMult implementation; +    -- in such cases override this implementation with the ...fromMult implementation below+    -- for improved efficiency++powerNonnegToNonnegIntUpInPlaceEffFromPure,+ powerNonnegToNonnegIntDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedPowerNonnegToNonnegInt t) =>+    OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicator t) t Int s+powerNonnegToNonnegIntUpInPlaceEffFromPure =+    pureToMutableNonmutEff powerNonnegToNonnegIntUpEff +powerNonnegToNonnegIntDnInPlaceEffFromPure =+    pureToMutableNonmutEff powerNonnegToNonnegIntDnEff ++powerNonnegToNonnegIntUpInPlaceEffFromInPlace,+ powerNonnegToNonnegIntDnInPlaceEffFromInPlace ::+    (RoundedPowerNonnegToNonnegIntInPlace t) =>+    (PowerNonnegToNonnegIntEffortIndicator t) -> t -> Int -> t+powerNonnegToNonnegIntUpInPlaceEffFromInPlace = +    mutableNonmutEffToPure powerNonnegToNonnegIntUpInPlaceEff +powerNonnegToNonnegIntDnInPlaceEffFromInPlace = +    mutableNonmutEffToPure powerNonnegToNonnegIntDnInPlaceEff++powerNonnegToNonnegIntUpInPlaceEffFromMult ::+    (RoundedMultiplyInPlace t, HasOne t) =>+    OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicatorFromMult t) t Int s +powerNonnegToNonnegIntUpInPlaceEffFromMult effMult rM eM n =+    powerFromMultInPlace (multUpInPlaceEff effMult) rM eM n++powerNonnegToNonnegIntDnInPlaceEffFromMult ::+    (RoundedMultiplyInPlace t, HasOne t) =>+    OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicatorFromMult t) t Int s +powerNonnegToNonnegIntDnInPlaceEffFromMult effMult rM eM n =+    powerFromMultInPlace (multDnInPlaceEff effMult) rM eM n+++class (RoundedPowerToNonnegIntEffort t, CanBeMutable t) => +    RoundedPowerToNonnegIntInPlace t +    where+    powerToNonnegIntUpInPlaceEff ::+        OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s+    powerToNonnegIntDnInPlaceEff ::+        OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s++powerToNonnegIntUpInPlaceEffFromPure,+ powerToNonnegIntDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedPowerToNonnegInt t) =>+    OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s+powerToNonnegIntUpInPlaceEffFromPure =+    pureToMutableNonmutEff powerToNonnegIntUpEff +powerToNonnegIntDnInPlaceEffFromPure =+    pureToMutableNonmutEff powerToNonnegIntDnEff ++powerToNonnegIntUpInPlaceEffFromInPlace,+ powerToNonnegIntDnInPlaceEffFromInPlace ::+    (RoundedPowerToNonnegIntInPlace t) =>+    (PowerToNonnegIntEffortIndicator t) -> t -> Int -> t+powerToNonnegIntUpInPlaceEffFromInPlace = +    mutableNonmutEffToPure powerToNonnegIntUpInPlaceEff +powerToNonnegIntDnInPlaceEffFromInPlace = +    mutableNonmutEffToPure powerToNonnegIntDnInPlaceEff++propUpDnPowerToNonnegInPlace ::+    (NumOrd.PartialComparison t, +     RoundedPowerToNonnegIntInPlace t, +     RoundedPowerToNonnegInt t, +     Neg t,+     Show t, HasLegalValues t,+     Show (PowerToNonnegIntEffortIndicator t),+     EffortIndicator (PowerToNonnegIntEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     PowerToNonnegIntEffortIndicator t) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    Int -> Bool+propUpDnPowerToNonnegInPlace sample initEffort +        (NumOrd.UniformlyOrderedSingleton e1) n =+    equalRoundingUpDn "in-place rounded non-neg integer power"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    powerToNonnegIntUpEffViaInPlace = +        mutableNonmutEffToPure powerToNonnegIntUpInPlaceEff+    powerToNonnegIntDnEffViaInPlace = +        mutableNonmutEffToPure powerToNonnegIntDnInPlaceEff+    expr1Up eff =+        let (^^) = powerToNonnegIntUpEff eff in e1 ^^ n+    expr1Dn eff =+        let (^.) = powerToNonnegIntDnEff eff in e1 ^. n+    expr2Up eff =+        let (^^) = powerToNonnegIntUpEffViaInPlace eff in e1 ^^ n+    expr2Dn eff =+        let (^.) = powerToNonnegIntDnEffViaInPlace eff in e1 ^. n++class (HasOne t, RoundedDivideEffort t, CanBeMutable t) => +    RoundedDivideInPlace t+    where+    divUpInPlaceEff :: OpMutable2Eff (DivEffortIndicator t) t s+    divDnInPlaceEff :: OpMutable2Eff (DivEffortIndicator t) t s+    recipUpInPlaceEff :: OpMutable1Eff (DivEffortIndicator t) t s+    recipDnInPlaceEff :: OpMutable1Eff (DivEffortIndicator t) t s++    recipUpInPlaceEff effort resM aM =+        do+        oneM <- unsafeMakeMutable one+        divUpInPlaceEff effort resM oneM aM+    recipDnInPlaceEff effort resM aM =+        do+        oneM <- unsafeMakeMutable one+        divDnInPlaceEff effort resM oneM aM++divUpInPlaceEffFromPure,+ divDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedDivide t) =>+    OpMutable2Eff (DivEffortIndicator t) t s+divUpInPlaceEffFromPure = pureToMutable2Eff divUpEff +divDnInPlaceEffFromPure = pureToMutable2Eff divDnEff ++divUpInPlaceEffFromInPlace,+ divDnInPlaceEffFromInPlace ::+    (RoundedDivideInPlace t) =>+    (DivEffortIndicator t) -> t -> t -> t+divUpInPlaceEffFromInPlace = mutable2EffToPure divUpInPlaceEff +divDnInPlaceEffFromInPlace = mutable2EffToPure divDnInPlaceEff ++recipUpInPlaceEffFromPure,+ recipDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedDivide t) =>+    OpMutable1Eff (DivEffortIndicator t) t s+recipUpInPlaceEffFromPure = pureToMutable1Eff recipUpEff +recipDnInPlaceEffFromPure = pureToMutable1Eff recipDnEff ++recipUpInPlaceEffFromInPlace,+ recipDnInPlaceEffFromInPlace ::+    (RoundedDivideInPlace t) =>+    (DivEffortIndicator t) -> t -> t+recipUpInPlaceEffFromInPlace = mutable1EffToPure recipUpInPlaceEff +recipDnInPlaceEffFromInPlace = mutable1EffToPure recipDnInPlaceEff ++propUpDnDivInPlace ::+    (NumOrd.PartialComparison t, +     RoundedDivideInPlace t, RoundedDivide t,+     Neg t,+     Show t, HasZero t, HasLegalValues t,+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (NumOrd.PartialCompareEffortIndicator t, +     DivEffortIndicator t) -> +    (NumOrd.UniformlyOrderedPair t) ->+    Bool+propUpDnDivInPlace sample initEffort@(effComp, _) (NumOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "in-place rounded division"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    divUpEffViaInPlace = mutable2EffToPure divUpInPlaceEff+    divDnEffViaInPlace = mutable2EffToPure divDnInPlaceEff+    expr1Up eff =+        let (/^) = divUpEff eff in e1 /^ e2+    expr1Dn eff =+        let (/.) = divDnEff eff in e1 /. e2+    expr2Up eff =+        let (/^) = divUpEffViaInPlace eff in e1 /^ e2+    expr2Dn eff =+        let (/.) = divDnEffViaInPlace eff in e1 /. e2++testsUpDnFieldOpsInPlace (name, sample) =+    testGroup (name ++ " in-place up/down rounded ops match pure ops") $+        [+            testProperty "addition" (propUpDnAddInPlace sample)+        ,+            testProperty "subtraction" (propUpDnSubtrInPlace sample)+        ,+            testProperty "absolute value" (propUpDnAbsInPlace sample)+        ,+            testProperty "multiplication" (propUpDnMultInPlace sample)+        ,+            testProperty "integer power" (propUpDnMultInPlace sample)+        ,+            testProperty "division" (propUpDnDivInPlace sample)+        ]+        ++class +        (RoundedSubtrInPlace t, +         RoundedMultiplyInPlace t,+         RoundedRingEffort t) => +    RoundedRingInPlace t+    +class+        (RoundedRingInPlace t, +         RoundedDivideInPlace t,+         RoundedFieldEffort t) => +     RoundedFieldInPlace t++
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/InPlace/MixedFieldOps.hs view
@@ -0,0 +1,340 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.MixedFieldOps+    Description :  rounded basic arithmetic operations mixing 2 types+    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    In-place versions of rounded basic arithmetical operations mixing 2 types.+    +    This module is hidden and reexported via its parent "NumericOrderRounding.InPlace". +-}+module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.MixedFieldOps where++import Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps++import Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion+import Numeric.AERN.RealArithmetic.ExactOps++import Numeric.AERN.Basics.Exception+import Numeric.AERN.Basics.Mutable+import Numeric.AERN.Basics.Effort+import Numeric.AERN.RealArithmetic.Laws +import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import Control.Monad.ST+import Control.Exception+import Data.Maybe++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class (RoundedMixedAddEffort t tn, CanBeMutable t) => RoundedMixedAddInPlace t tn where+    mixedAddUpInPlaceEff :: +        OpMutableNonmutEff (MixedAddEffortIndicator t tn) t tn s+    mixedAddDnInPlaceEff :: +        OpMutableNonmutEff (MixedAddEffortIndicator t tn) t tn s++mixedAddUpInPlaceEffFromPure,+ mixedAddDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedMixedAdd t tn) =>+    OpMutableNonmutEff (MixedAddEffortIndicator t tn) t tn s+mixedAddUpInPlaceEffFromPure =+    pureToMutableNonmutEff mixedAddUpEff+mixedAddDnInPlaceEffFromPure =+    pureToMutableNonmutEff mixedAddDnEff+    +mixedAddUpInPlaceEffFromInPlace,+ mixedAddDnInPlaceEffFromInPlace ::+    (RoundedMixedAddInPlace t tn) =>+    (MixedAddEffortIndicator t tn) -> t -> tn -> t+mixedAddUpInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedAddUpInPlaceEff +mixedAddDnInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedAddDnInPlaceEff ++-- an alternative default implementation using conversion +-- - this could be more efficient++mixedAddUpInPlaceEffByConversion ::+    (Convertible tn t, RoundedAddInPlace t, Show tn) =>+    OpMutableNonmutEff (AddEffortIndicator t, ConvertEffortIndicator tn t) t tn s +mixedAddUpInPlaceEffByConversion (effAdd, effConv) rM dM n =+    do+    nUpM <- makeMutable nUp+    addUpInPlaceEff effAdd rM dM nUpM+    where+    nUp = +        case convertUpEff effConv n of+            (Just nUp) -> nUp+            _ -> throw $ AERNException $ +                        "conversion failed during mixed addition: n = " ++ show n++mixedAddDnInPlaceEffByConversion ::+    (Convertible tn t, RoundedAddInPlace t, Show tn) =>+    OpMutableNonmutEff (AddEffortIndicator t, ConvertEffortIndicator tn t) t tn s +mixedAddDnInPlaceEffByConversion (effAdd, effConv) rM dM n =+    do+    nDnM <- makeMutable nDn+    addDnInPlaceEff effAdd rM dM nDnM+    where+    nDn = +        case convertDnEff effConv n of+            (Just nDn) -> nDn+            _ -> throw $ AERNException $ +                        "conversion failed during mixed addition: n = " ++ show n+++{- properties of mixed addition -}++propMixedAddInPlaceEqualsConvert ::+    (NumOrd.PartialComparison t, Convertible tn t,+     RoundedMixedAddInPlace t tn, +     RoundedMixedAdd t tn, +     RoundedAdd t,+     Show t, HasLegalValues t,+     Show (MixedAddEffortIndicator t tn),+     EffortIndicator (MixedAddEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (NumOrd.PartialCompareEffortIndicator t,+     (MixedAddEffortIndicator t tn,      +      AddEffortIndicator t,+      ConvertEffortIndicator tn t)) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedAddInPlaceEqualsConvert sample1 sample2 initEffort +        (NumOrd.UniformlyOrderedSingleton d) n =+    equalRoundingUpDn "in-place rounded mixed addition"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMAdd,_,_) =+        let (+^|=) dR = mixedAddUpInPlaceEff effMAdd dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR +^|= n+            unsafeReadMutable dR+    expr1Dn (effMAdd,_,_) =+        let (+.|=) dR = mixedAddDnInPlaceEff effMAdd dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR +.|= n+            unsafeReadMutable dR+    expr2Up (_,effAdd,effConv) =+        let (+^) = addUpEff effAdd in (fromJust $ convertUpEff effConv n) +^ d+    expr2Dn (_,effAdd,effConv) =+        let (+.) = addDnEff effAdd in (fromJust $ convertDnEff effConv n) +. d++++class (RoundedMixedMultiplyEffort t tn, CanBeMutable t) => RoundedMixedMultiplyInPlace t tn where+    mixedMultUpInPlaceEff :: +        OpMutableNonmutEff (MixedMultEffortIndicator t tn) t tn s+    mixedMultDnInPlaceEff :: +        OpMutableNonmutEff (MixedMultEffortIndicator t tn) t tn s++mixedMultUpInPlaceEffFromPure,+ mixedMultDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedMixedMultiply t tn) =>+    OpMutableNonmutEff (MixedMultEffortIndicator t tn) t tn s+mixedMultUpInPlaceEffFromPure =+    pureToMutableNonmutEff mixedMultUpEff+mixedMultDnInPlaceEffFromPure =+    pureToMutableNonmutEff mixedMultDnEff++mixedMultUpInPlaceEffFromInPlace,+ mixedMultDnInPlaceEffFromInPlace ::+    (RoundedMixedMultiplyInPlace t tn) =>+    (MixedMultEffortIndicator t tn) -> t -> tn -> t+mixedMultUpInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedMultUpInPlaceEff +mixedMultDnInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedMultDnInPlaceEff++{- properties of mixed multiplication -}++propMixedMultInPlaceEqualsConvert ::+    (NumOrd.PartialComparison t,  NumOrd.RoundedLattice t,+     Convertible tn t,+     RoundedMixedMultiplyInPlace t tn, +     RoundedMixedMultiply t tn, +     RoundedMultiply t,+     Show t, HasLegalValues t,+     Show (MixedMultEffortIndicator t tn),+     EffortIndicator (MixedMultEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.MinmaxEffortIndicator t),+     EffortIndicator (NumOrd.MinmaxEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (NumOrd.PartialCompareEffortIndicator t,+     (MixedMultEffortIndicator t tn,      +      (MultEffortIndicator t,+       ConvertEffortIndicator tn t,+       NumOrd.MinmaxEffortIndicator t))) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedMultInPlaceEqualsConvert sample1 sample2 initEffort +        (NumOrd.UniformlyOrderedSingleton d) n =+    equalRoundingUpDn "in-place rounded mixed multiplication"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMMult,_) =+        let (*^|=) dR = mixedMultUpInPlaceEff effMMult dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR *^|= n+            unsafeReadMutable dR+    expr1Dn (effMMult,_) =+        let (*.|=) dR = mixedMultDnInPlaceEff effMMult dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR *.|= n+            unsafeReadMutable dR+    expr2Up (_,(effMult,effConv,effMinmax)) =+        let (*^) = multUpEff effMult in+        NumOrd.maxUpEff effMinmax  +            (d *^ (fromJust $ convertUpEff effConv n))+            (d *^ (fromJust $ convertDnEff effConv n))+    expr2Dn (_,(effMult,effConv,effMinmax)) =+        let (*.) = multDnEff effMult in+        NumOrd.minDnEff effMinmax  +            (d *. (fromJust $ convertUpEff effConv n))+            (d *. (fromJust $ convertDnEff effConv n))++class (RoundedMixedDivide t tn, CanBeMutable t) => RoundedMixedDivideInPlace t tn where+    mixedDivUpInPlaceEff :: +        OpMutableNonmutEff (MixedDivEffortIndicator t tn) t tn s+    mixedDivDnInPlaceEff :: +        OpMutableNonmutEff (MixedDivEffortIndicator t tn) t tn s++mixedDivUpInPlaceEffFromPure,+ mixedDivDnInPlaceEffFromPure ::+    (CanBeMutable t, RoundedMixedDivide t tn) =>+    OpMutableNonmutEff (MixedDivEffortIndicator t tn) t tn s+mixedDivUpInPlaceEffFromPure =+    pureToMutableNonmutEff mixedDivUpEff+mixedDivDnInPlaceEffFromPure =+    pureToMutableNonmutEff mixedDivDnEff++mixedDivUpInPlaceEffFromInPlace,+ mixedDivDnInPlaceEffFromInPlace ::+    (RoundedMixedDivideInPlace t tn) =>+    (MixedDivEffortIndicator t tn) -> t -> tn -> t+mixedDivUpInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedDivUpInPlaceEff +mixedDivDnInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedDivDnInPlaceEff++{- properties of mixed division -}++propMixedDivInPlaceEqualsConvert ::+    (NumOrd.PartialComparison t,  NumOrd.RoundedLattice t,+     Convertible tn t,+     RoundedMixedDivideInPlace t tn, +     RoundedMixedDivide t tn, +     RoundedDivide t,+     Show t, HasZero t, HasLegalValues t,+     Show (MixedDivEffortIndicator t tn),+     EffortIndicator (MixedDivEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (NumOrd.MinmaxEffortIndicator t),+     EffortIndicator (NumOrd.MinmaxEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (NumOrd.PartialCompareEffortIndicator t,+     (MixedDivEffortIndicator t tn,      +      (DivEffortIndicator t,+       ConvertEffortIndicator tn t,+       NumOrd.MinmaxEffortIndicator t))) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedDivInPlaceEqualsConvert sample1 sample2 +        initEffort@(effComp,(_,(_,effConv,_))) +        (NumOrd.UniformlyOrderedSingleton d) n+    =+    equalRoundingUpDn "in-place rounded mixed division"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMDiv,_) =+        let (/^|=) dR = mixedDivUpInPlaceEff effMDiv dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR /^|= n+            unsafeReadMutable dR+    expr1Dn (effMDiv,_) =+        let (/.|=) dR = mixedDivDnInPlaceEff effMDiv dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR /.|= n+            unsafeReadMutable dR+    expr2Up (_,(effDiv,effConv,effMinmax)) =+        let (/^) = divUpEff effDiv in+        NumOrd.maxUpEff effMinmax  +            (d /^ (fromJust $ convertUpEff effConv n))+            (d /^ (fromJust $ convertDnEff effConv n))+    expr2Dn (_,(effDiv,effConv,effMinmax)) =+        let (/.) = divDnEff effDiv in+        NumOrd.minDnEff effMinmax  +            (d /. (fromJust $ convertUpEff effConv n))+            (d /. (fromJust $ convertDnEff effConv n))+    +testsUpDnMixedFieldOpsInPlace (name, sample) (nameN, sampleN) =+    testGroup (name ++ " with " ++ nameN ++ ": in-place mixed up/dn rounded ops") $+        [+            testProperty "addition" (propMixedAddInPlaceEqualsConvert sample sampleN)+        ,+            testProperty "multiplication" (propMixedMultInPlaceEqualsConvert sample sampleN)+        ,+            testProperty "division" (propMixedDivInPlaceEqualsConvert sample sampleN)+        ]++class +        (RoundedMixedAddInPlace t tn, +         RoundedMixedMultiplyInPlace t tn, +         RoundedMixedRingEffort t tn) => +    RoundedMixedRingInPlace t tn++class +        (RoundedMixedRingInPlace t tn, +         RoundedMixedDivideInPlace t tn,+         RoundedMixedFieldEffort t tn) => +    RoundedMixedFieldInPlace t tn+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/InPlace/OpsDefaultEffort.hs view
@@ -0,0 +1,191 @@+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.OpsDefaultEffort+    Description :  convenience in-place operators and functions with default effort  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Convenience in-place operators and functions with default effort.+-}++module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.OpsDefaultEffort where++import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.NumericOrderRounding++-- | Upward rounded in-place addition+addUpInPlace :: (RoundedAddInPlace t) => OpMutable2 t s+addUpInPlace = mutable2EffToMutable2 addUpInPlaceEff addDefaultEffort++-- | Upward rounded addition assignment+(+^=) :: (RoundedAddInPlace t) => OpMutable1 t s+(+^=) = mutable2ToMutable1 addUpInPlace++-- | Downward rounded in-place addition+addDnInPlace :: (RoundedAddInPlace t) => OpMutable2 t s+addDnInPlace = mutable2EffToMutable2 addDnInPlaceEff addDefaultEffort ++-- | Downward rounded addition assignment+(+.=) :: (RoundedAddInPlace t) => OpMutable1 t s+(+.=) = mutable2ToMutable1 addDnInPlace++-- | Upward rounded in-place subtraction+subtrUpInPlace :: (RoundedSubtrInPlace t) => OpMutable2 t s+subtrUpInPlace = mutable2EffToMutable2 subtrUpInPlaceEff addDefaultEffort++-- | Upward rounded subtraction assignment+(-^=) :: (RoundedSubtrInPlace t) => OpMutable1 t s+(-^=) = mutable2ToMutable1 subtrUpInPlace++-- | Downward rounded in-place subtraction+subtrDnInPlace :: (RoundedSubtrInPlace t) => OpMutable2 t s+subtrDnInPlace = mutable2EffToMutable2 subtrDnInPlaceEff addDefaultEffort++-- | Downward rounded subtraction assignment+(-.=) :: (RoundedSubtrInPlace t) => OpMutable1 t s+(-.=) = mutable2ToMutable1 subtrDnInPlace++-- | Upward rounded in-place absolute value+absUpInPlace :: (RoundedAbsInPlace t) => OpMutable1 t s+absUpInPlace = mutable1EffToMutable1 absUpInPlaceEff absDefaultEffort ++-- | Downward rounded in-place absolute value+absDnInPlace :: (RoundedAbsInPlace t) => OpMutable1 t s+absDnInPlace = mutable1EffToMutable1 absDnInPlaceEff absDefaultEffort ++-- | Upward rounded in-place multiplication+multUpInPlace :: (RoundedMultiplyInPlace t) => OpMutable2 t s+multUpInPlace = mutable2EffToMutable2 multUpInPlaceEff multDefaultEffort++-- | Upward rounded multiplication assignment+(*^=) :: (RoundedMultiplyInPlace t) => OpMutable1 t s+(*^=) = mutable2ToMutable1 multUpInPlace++-- | Downward rounded in-place multiplication+multDnInPlace :: (RoundedMultiplyInPlace t) => OpMutable2 t s+multDnInPlace = mutable2EffToMutable2 multDnInPlaceEff multDefaultEffort++-- | Downward rounded multiplication assignment+(*.=) :: (RoundedMultiplyInPlace t) => OpMutable1 t s+(*.=) = mutable2ToMutable1 multDnInPlace++-- | Upward rounded in-place power+powerToNonnegIntUpInPlace :: (RoundedPowerToNonnegIntInPlace t) => +    OpMutableNonmut t Int s+powerToNonnegIntUpInPlace = +    mutableNonmutEffToMutableNonmut powerToNonnegIntUpInPlaceEff powerToNonnegIntDefaultEffort++-- | Upward rounded in-place power assignment+(^^=) :: (RoundedPowerToNonnegIntInPlace t) => OpNonmut t Int s+(^^=) = mutableNonmutToNonmut powerToNonnegIntUpInPlace++-- | Downward rounded in-place power+powerToNonnegIntDnInPlace :: (RoundedPowerToNonnegIntInPlace t) => +    OpMutableNonmut t Int s+powerToNonnegIntDnInPlace = +    mutableNonmutEffToMutableNonmut powerToNonnegIntDnInPlaceEff powerToNonnegIntDefaultEffort++-- | Upward rounded in-place power assignment+(^.=) :: (RoundedPowerToNonnegIntInPlace t) => OpNonmut t Int s+(^.=) = mutableNonmutToNonmut powerToNonnegIntDnInPlace++-- | Upward rounded in-place division+divUpInPlace :: (RoundedDivideInPlace t) => OpMutable2 t s+divUpInPlace = mutable2EffToMutable2 divUpInPlaceEff divDefaultEffort++-- | Upward rounded division assignment+(/^=) :: (RoundedDivideInPlace t) => OpMutable1 t s+(/^=) = mutable2ToMutable1 divUpInPlace++-- | Downward rounded in-place division+divDnInPlace :: (RoundedDivideInPlace t) => OpMutable2 t s+divDnInPlace = mutable2EffToMutable2 divDnInPlaceEff divDefaultEffort++-- | Downward rounded division assignment+(/.=) :: (RoundedDivideInPlace t) => OpMutable1 t s+(/.=) = mutable2ToMutable1 divDnInPlace++-- | Upward rounded in-place mixed addition+mixedAddUpInPlace :: (RoundedMixedAddInPlace t tn) => +    OpMutableNonmut t tn s+mixedAddUpInPlace =+    mixedEffToMutableNonmut mixedAddUpInPlaceEff mixedAddDefaultEffort++-- | Upward rounded additive scalar action assignment+(+^|=) :: (RoundedMixedAddInPlace t tn) => OpNonmut t tn s+(+^|=) = mutableNonmutToNonmut mixedAddUpInPlace++-- | Downward rounded in-place mixed addition+mixedAddDnInPlace :: (RoundedMixedAddInPlace t tn) =>+    OpMutableNonmut t tn s+mixedAddDnInPlace =+    mixedEffToMutableNonmut mixedAddDnInPlaceEff mixedAddDefaultEffort++-- | Downward rounded additive scalar action assignment+(+.|=) :: (RoundedMixedAddInPlace t tn) => OpNonmut t tn s+(+.|=) = mutableNonmutToNonmut mixedAddDnInPlace++-- | Upward rounded in-place mixed multiplication+mixedMultUpInPlace :: (RoundedMixedMultiplyInPlace t tn) => +    OpMutableNonmut t tn s+mixedMultUpInPlace =+    mixedEffToMutableNonmut mixedMultUpInPlaceEff mixedMultDefaultEffort++-- | Upward rounded multiplicative scalar action assignment+(*^|=) :: (RoundedMixedMultiplyInPlace t tn) => OpNonmut t tn s+(*^|=) = mutableNonmutToNonmut mixedMultUpInPlace++-- | Downward rounded in-place mixed multiplication+mixedMultDnInPlace :: (RoundedMixedMultiplyInPlace t tn) => +    OpMutableNonmut t tn s+mixedMultDnInPlace =+    mixedEffToMutableNonmut mixedMultDnInPlaceEff mixedMultDefaultEffort++-- | Downward rounded multiplicative scalar action assignment+(*.|=) :: (RoundedMixedMultiplyInPlace t tn) => OpNonmut t tn s+(*.|=) = mutableNonmutToNonmut mixedMultDnInPlace++-- | Upward rounded in-place mixed reciprocal action+mixedDivUpInPlace :: (RoundedMixedDivideInPlace t tn) => +    OpMutableNonmut t tn s+mixedDivUpInPlace =+    mixedEffToMutableNonmut mixedDivUpInPlaceEff mixedDivDefaultEffort++-- | Upward rounded multiplicative scalar reciprocal action assignment+(/^|=) :: (RoundedMixedDivideInPlace t tn) => OpNonmut t tn s+(/^|=) = mutableNonmutToNonmut mixedDivUpInPlace++-- | Downward rounded in-place mixed reciprocal action+mixedDivDnInPlace :: (RoundedMixedDivideInPlace t tn) => +    OpMutableNonmut t tn s+mixedDivDnInPlace =+    mixedEffToMutableNonmut mixedDivDnInPlaceEff mixedDivDefaultEffort++-- | Downward rounded multiplicative scalar reciprocal action assignment+(/.|=) :: (RoundedMixedDivideInPlace t tn) => OpNonmut t tn s+(/.|=) = mutableNonmutToNonmut mixedDivDnInPlace++-- | Upward rounded in-place exponential+expUpInPlace :: (RoundedExponentiationInPlace t) => OpMutable1 t s+expUpInPlace = mutable1EffToMutable1 expUpInPlaceEff expDefaultEffort ++-- | Downward rounded in-place exponential+expDnInPlace :: (RoundedExponentiationInPlace t) => OpMutable1 t s+expDnInPlace = mutable1EffToMutable1 expDnInPlaceEff expDefaultEffort ++-- | Upward rounded in-place square root+sqrtUpInPlace :: (RoundedSquareRootInPlace t) => OpMutable1 t s+sqrtUpInPlace = mutable1EffToMutable1 sqrtUpInPlaceEff sqrtDefaultEffort ++-- | Downward rounded in-place square root+sqrtDnInPlace :: (RoundedSquareRootInPlace t) => OpMutable1 t s+sqrtDnInPlace = mutable1EffToMutable1 sqrtDnInPlaceEff sqrtDefaultEffort ++++++
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/InPlace/OpsImplicitEffort.hs view
@@ -0,0 +1,280 @@+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.OpsImplicitEffort+    Description :  convenience directed-rounded in-place operators and functions with implicit effort parameters  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Convenience directed-rounded in-place operators and functions with implicit effort parameters.+-}++module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.OpsImplicitEffort where++import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.NumericOrderRounding++-- | Upward rounded in-place addition+addUpInPlace :: +    (RoundedAddInPlace t, ?addUpDnEffort :: AddEffortIndicator t) => +    OpMutable2 t s+addUpInPlace = addUpInPlaceEff ?addUpDnEffort++-- | Upward rounded addition assignment+(+^=) :: +    (RoundedAddInPlace t, ?addUpDnEffort :: AddEffortIndicator t) => +    OpMutable1 t s+(+^=) = mutable2ToMutable1 addUpInPlace++-- | Downward rounded in-place addition+addDnInPlace :: +    (RoundedAddInPlace t, ?addUpDnEffort :: AddEffortIndicator t) => +    OpMutable2 t s+addDnInPlace = addDnInPlaceEff ?addUpDnEffort++-- | Downward rounded addition assignment+(+.=) :: +    (RoundedAddInPlace t, ?addUpDnEffort :: AddEffortIndicator t) => +    OpMutable1 t s+(+.=) = mutable2ToMutable1 addDnInPlace++-- | Upward rounded in-place subtraction+subtrUpInPlace :: +    (RoundedSubtrInPlace t, ?addUpDnEffort :: AddEffortIndicator t) => +    OpMutable2 t s+subtrUpInPlace = subtrUpInPlaceEff ?addUpDnEffort++-- | Upward rounded subtraction assignment+(-^=) :: +    (RoundedSubtrInPlace t, ?addUpDnEffort :: AddEffortIndicator t) => +    OpMutable1 t s+(-^=) = mutable2ToMutable1 subtrUpInPlace++-- | Downward rounded in-place subtraction+subtrDnInPlace :: +    (RoundedSubtrInPlace t, ?addUpDnEffort :: AddEffortIndicator t) => +    OpMutable2 t s+subtrDnInPlace = subtrDnInPlaceEff ?addUpDnEffort++-- | Downward rounded subtraction assignment+(-.=) :: +    (RoundedSubtrInPlace t, ?addUpDnEffort :: AddEffortIndicator t) => +    OpMutable1 t s+(-.=) = mutable2ToMutable1 subtrDnInPlace++-- | Upward rounded in-place absolute value+absUpInPlace ::+    (RoundedAbsInPlace t, ?absUpDnEffort :: AbsEffortIndicator t) => +    OpMutable1 t s+absUpInPlace = absUpInPlaceEff ?absUpDnEffort++-- | Downward rounded in-place absolute value+absDnInPlace ::+    (RoundedAbsInPlace t, ?absUpDnEffort :: AbsEffortIndicator t) => +    OpMutable1 t s+absDnInPlace = absDnInPlaceEff ?absUpDnEffort++-- | Upward rounded in-place multiplication+multUpInPlace :: +    (RoundedMultiplyInPlace t, ?multUpDnEffort :: MultEffortIndicator t) => +    OpMutable2 t s+multUpInPlace = multUpInPlaceEff ?multUpDnEffort++-- | Upward rounded multiplication assignment+(*^=) :: +    (RoundedMultiplyInPlace t, ?multUpDnEffort :: MultEffortIndicator t) => +    OpMutable1 t s+(*^=) = mutable2ToMutable1 multUpInPlace++-- | Downward rounded in-place multiplication+multDnInPlace :: +    (RoundedMultiplyInPlace t, ?multUpDnEffort :: MultEffortIndicator t) => +    OpMutable2 t s+multDnInPlace = multDnInPlaceEff ?multUpDnEffort++-- | Downward rounded multiplication assignment+(*.=) :: +    (RoundedMultiplyInPlace t, ?multUpDnEffort :: MultEffortIndicator t) => +    OpMutable1 t s+(*.=) = mutable2ToMutable1 multDnInPlace++-- | Upward rounded in-place power+powerToNonnegIntUpInPlace :: +    (RoundedPowerToNonnegIntInPlace t, +     ?intPowerUpDnEffort :: PowerToNonnegIntEffortIndicator t) => +    OpMutableNonmut t Int s+powerToNonnegIntUpInPlace = powerToNonnegIntUpInPlaceEff ?intPowerUpDnEffort++-- | Upward rounded in-place power assignment+(^^=)  :: +    (RoundedPowerToNonnegIntInPlace t, +     ?intPowerUpDnEffort :: PowerToNonnegIntEffortIndicator t) => +    OpNonmut t Int s+(^^=) = mutableNonmutToNonmut powerToNonnegIntUpInPlace++-- | Downward rounded in-place power+powerToNonnegIntDnInPlace :: +    (RoundedPowerToNonnegIntInPlace t, +     ?intPowerUpDnEffort :: PowerToNonnegIntEffortIndicator t) => +    OpMutableNonmut t Int s+powerToNonnegIntDnInPlace = powerToNonnegIntDnInPlaceEff ?intPowerUpDnEffort++-- | Upward rounded in-place power assignment+(^.=)  :: +    (RoundedPowerToNonnegIntInPlace t, +     ?intPowerUpDnEffort :: PowerToNonnegIntEffortIndicator t) => +    OpNonmut t Int s+(^.=) = mutableNonmutToNonmut powerToNonnegIntDnInPlace++-- | Upward rounded in-place division+divUpInPlace :: +    (RoundedDivideInPlace t, ?divUpDnEffort :: DivEffortIndicator t) => +    OpMutable2 t s+divUpInPlace = divUpInPlaceEff ?divUpDnEffort++-- | Upward rounded division assignment+(/^=) :: +    (RoundedDivideInPlace t, ?divUpDnEffort :: DivEffortIndicator t) => +    OpMutable1 t s+(/^=) = mutable2ToMutable1 divUpInPlace++-- | Downward rounded in-place division+divDnInPlace :: +    (RoundedDivideInPlace t, ?divUpDnEffort :: DivEffortIndicator t) => +    OpMutable2 t s+divDnInPlace = divDnInPlaceEff ?divUpDnEffort++-- | Downward rounded division assignment+(/.=) :: +    (RoundedDivideInPlace t, ?divUpDnEffort :: DivEffortIndicator t) => +    OpMutable1 t s+(/.=) = mutable2ToMutable1 divDnInPlace++-- the following does not work, but is kept here as a template for+-- cut and pasting the "let"s+withFieldOpsEffortIndicator effortField expression =+    let ?addUpDnEffort = fldEffortAdd effortField in+    let ?multUpDnEffort = fldEffortMult effortField in+    let ?intPowerUpDnEffort = fldEffortPow effortField in+    let ?divUpDnEffort = fldEffortDiv effortField in+    expression++-- | Upward rounded in-place mixed addition+mixedAddUpInPlace :: +    (RoundedMixedAddInPlace t tn, +     ?mixedAddUpDnEffort :: MixedAddEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedAddUpInPlace = mixedAddUpInPlaceEff ?mixedAddUpDnEffort++-- | Upward rounded additive scalar action assignment+(+^|=) :: +    (RoundedMixedAddInPlace t tn, +     ?mixedAddUpDnEffort :: MixedAddEffortIndicator t tn) => +    OpNonmut t tn s+(+^|=) = mutableNonmutToNonmut mixedAddUpInPlace++-- | Downward rounded in-place mixed addition+mixedAddDnInPlace :: +    (RoundedMixedAddInPlace t tn, +     ?mixedAddUpDnEffort :: MixedAddEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedAddDnInPlace = mixedAddDnInPlaceEff ?mixedAddUpDnEffort++-- | Downward rounded additive scalar action assignment+(+.|=) :: +    (RoundedMixedAddInPlace t tn, +     ?mixedAddUpDnEffort :: MixedAddEffortIndicator t tn) => +    OpNonmut t tn s+(+.|=) = mutableNonmutToNonmut mixedAddDnInPlace++-- | Upward rounded in-place mixed multiplication+mixedMultUpInPlace :: +    (RoundedMixedMultiplyInPlace t tn, +     ?mixedMultUpDnEffort :: MixedMultEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedMultUpInPlace = mixedMultUpInPlaceEff ?mixedMultUpDnEffort++-- | Upward rounded multiplicative scalar action assignment+(*^|=) :: +    (RoundedMixedMultiplyInPlace t tn, +     ?mixedMultUpDnEffort :: MixedMultEffortIndicator t tn) => +    OpNonmut t tn s+(*^|=) = mutableNonmutToNonmut mixedMultUpInPlace++-- | Downward rounded in-place mixed multiplication+mixedMultDnInPlace :: +    (RoundedMixedMultiplyInPlace t tn, +     ?mixedMultUpDnEffort :: MixedMultEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedMultDnInPlace = mixedMultDnInPlaceEff ?mixedMultUpDnEffort++-- | Downward rounded multiplicative scalar action assignment+(*.|=) :: +    (RoundedMixedMultiplyInPlace t tn, +     ?mixedMultUpDnEffort :: MixedMultEffortIndicator t tn) => +    OpNonmut t tn s+(*.|=) = mutableNonmutToNonmut mixedMultDnInPlace++-- | Upward rounded in-place mixed reciprocal action+mixedDivUpInPlace :: +    (RoundedMixedDivideInPlace t tn, +     ?mixedDivUpDnEffort :: MixedDivEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedDivUpInPlace = mixedDivUpInPlaceEff ?mixedDivUpDnEffort++-- | Upward rounded multiplicative scalar reciprocal action assignment+(/^|=) :: +    (RoundedMixedDivideInPlace t tn, +     ?mixedDivUpDnEffort :: MixedDivEffortIndicator t tn) => +    OpNonmut t tn s+(/^|=) = mutableNonmutToNonmut mixedDivUpInPlace++-- | Downward rounded in-place mixed reciprocal action+mixedDivDnInPlace :: +    (RoundedMixedDivideInPlace t tn, +     ?mixedDivUpDnEffort :: MixedDivEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedDivDnInPlace = mixedDivDnInPlaceEff ?mixedDivUpDnEffort++-- | Downward rounded multiplicative scalar reciprocal action assignment+(/.|=) :: +    (RoundedMixedDivideInPlace t tn, +     ?mixedDivUpDnEffort :: MixedDivEffortIndicator t tn) => +    OpNonmut t tn s+(/.|=) = mutableNonmutToNonmut mixedDivDnInPlace++-- the following does not work, but is kept here as a template for+-- cut and pasting the "let"s+withMixedFieldOpsEffortIndicator effortMixedField expression =+    let ?mixedAddUpDnEffort = mxfldEffortAdd effortMixedField in+    let ?mixedMultUpDnEffort = mxfldEffortMult effortMixedField in+    let ?mixedDivUpDnEffort = mxfldEffortDiv effortMixedField in+    expression++-- | Upward rounded in-place exponential+expUpInPlace ::+    (RoundedExponentiationInPlace t, ?expUpDnEffort :: ExpEffortIndicator t) => +    OpMutable1 t s+expUpInPlace = expUpInPlaceEff ?expUpDnEffort++-- | Downward rounded in-place exponential+expDnInPlace ::+    (RoundedExponentiationInPlace t, ?expUpDnEffort :: ExpEffortIndicator t) => +    OpMutable1 t s+expDnInPlace = expDnInPlaceEff ?expUpDnEffort++-- | Upward rounded in-place square root+sqrtUpInPlace ::+    (RoundedSquareRootInPlace t, ?sqrtUpDnEffort :: SqrtEffortIndicator t) => +    OpMutable1 t s+sqrtUpInPlace = sqrtUpInPlaceEff ?sqrtUpDnEffort++-- | Downward rounded in-place square root+sqrtDnInPlace ::+    (RoundedSquareRootInPlace t, ?sqrtUpDnEffort :: SqrtEffortIndicator t) => +    OpMutable1 t s+sqrtDnInPlace = sqrtDnInPlaceEff ?sqrtUpDnEffort+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/MixedFieldOps.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps+    Description :  rounded basic arithmetic operations mixing 2 types+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Rounded basic arithmetical operations mixing 2 types.+    +    This module is hidden and reexported via its parent NumericOrderRounding. +-}+module Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps where++import Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+import Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion+import Numeric.AERN.RealArithmetic.ExactOps++import Numeric.AERN.Basics.Exception+import Numeric.AERN.Basics.Effort+import Numeric.AERN.RealArithmetic.Laws +import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import Control.Exception+import Data.Maybe++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class RoundedMixedAddEffort t tn where+    type MixedAddEffortIndicator t tn+    mixedAddDefaultEffort :: t -> tn -> MixedAddEffortIndicator t tn++class (RoundedMixedAddEffort t tn) => RoundedMixedAdd t tn where+    mixedAddUpEff :: MixedAddEffortIndicator t tn -> t -> tn -> t+    mixedAddDnEff :: MixedAddEffortIndicator t tn -> t -> tn -> t++{- tools to easily make a RoundedMixedAdd instance +   via the composition of conversion and homogeneous addition -}++type MixedAddEffortIndicatorByConversion t tn =+        (AddEffortIndicator t, ConvertEffortIndicator tn t)++mixedAddDefaultEffortByConversion d n = +        (addDefaultEffort d, convertDefaultEffort n d)++mixedAddUpEffByConversion ::+    (Convertible tn t, RoundedAdd t, Show tn) =>+    (AddEffortIndicator t, ConvertEffortIndicator tn t) ->+    t -> tn -> t+mixedAddUpEffByConversion (effAdd, effConv) d n = +    addUpEff effAdd nUp d+    where+    nUp = +        case convertUpEff effConv n of+            (Just nUp) -> nUp+            _ -> throw $ AERNException $ +                        "conversion failed during mixed addition: n = " ++ show n++mixedAddDnEffByConversion ::+    (Convertible tn t, RoundedAdd t, Show tn) =>+    (AddEffortIndicator t, ConvertEffortIndicator tn t) ->+    t -> tn -> t+mixedAddDnEffByConversion (effAdd, effConv) d n = +    addDnEff effAdd nDn d+    where+    nDn = +        case convertDnEff effConv n of+            (Just nDn) -> nDn+            _ -> throw $ AERNException $ +                        "conversion failed during mixed addition: n = " ++ show n++{- properties of mixed addition -}++propMixedAddEqualsConvert ::+    (NumOrd.PartialComparison t, Convertible tn t,+     RoundedMixedAdd t tn, RoundedAdd t,+     Show t, HasLegalValues t,+     Show (MixedAddEffortIndicator t tn),+     EffortIndicator (MixedAddEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (NumOrd.PartialCompareEffortIndicator t,+     (MixedAddEffortIndicator t tn,      +      AddEffortIndicator t,+      ConvertEffortIndicator tn t)) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    tn -> +    Bool+propMixedAddEqualsConvert sampleN sample initEffort +        (NumOrd.UniformlyOrderedSingleton d) n =+    equalRoundingUpDn "mixed addition by conversion"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMAdd,_,_) =+        let (+^|) = mixedAddUpEff effMAdd in d +^| n+    expr1Dn (effMAdd,_,_) =+        let (+.|) = mixedAddDnEff effMAdd in d +.| n+    expr2Up (_,effAdd,effConv) =+        let (+^) = addUpEff effAdd in d +^ (fromJust $ convertUpEff effConv n)+    expr2Dn (_,effAdd,effConv) =+        let (+.) = addDnEff effAdd in d +. (fromJust $ convertDnEff effConv n)++class RoundedMixedMultiplyEffort t tn where+    type MixedMultEffortIndicator t tn+    mixedMultDefaultEffort :: t -> tn -> MixedMultEffortIndicator t tn++class (RoundedMixedMultiplyEffort t tn) => RoundedMixedMultiply t tn where+    mixedMultUpEff :: MixedMultEffortIndicator t tn -> t -> tn -> t+    mixedMultDnEff :: MixedMultEffortIndicator t tn -> t -> tn -> t++{- tools to easily make a RoundedMixedMultiply instance +   via the composition of conversion and homogeneous addition -}++type MixedMultEffortIndicatorByConversion t tn =+        (MultEffortIndicator t, +         ConvertEffortIndicator tn t,+         NumOrd.MinmaxEffortIndicator t)++mixedMultDefaultEffortByConversion d n = +        (addDefaultEffort d, +         convertDefaultEffort n d,+         NumOrd.minmaxDefaultEffort d)++mixedMultUpEffByConversion ::+    (Convertible tn t, RoundedMultiply t, NumOrd.RoundedLattice t, Show tn) =>+    (MultEffortIndicator t, +     ConvertEffortIndicator tn t,+     NumOrd.MinmaxEffortIndicator t) ->+    t -> tn -> t+mixedMultUpEffByConversion (effMult, effConv, effMinmax) d n =+    NumOrd.maxUpEff effMinmax+    (multUpEff effMult d nDn)+    (multUpEff effMult d nUp)+    where+    (nUp, nDn) = +        case (convertUpEff effConv n, convertDnEff effConv n) of+            (Just nUp, Just nDn) -> (nUp, nDn)+            _ -> throw $ AERNException $ +                        "conversion failed during mixed multiplication: n = " ++ show n++mixedMultDnEffByConversion ::+    (Convertible tn t, RoundedMultiply t, NumOrd.RoundedLattice t, Show tn) =>+    (MultEffortIndicator t, +     ConvertEffortIndicator tn t,+     NumOrd.MinmaxEffortIndicator t) ->+    t -> tn -> t+mixedMultDnEffByConversion (effMult, effConv, effMinmax) d n =+    NumOrd.minDnEff effMinmax+    (multDnEff effMult d nDn)+    (multDnEff effMult d nUp)+    where+    (nUp, nDn) = +        case (convertUpEff effConv n, convertDnEff effConv n) of+            (Just nUp, Just nDn) -> (nUp, nDn)+            _ -> throw $ AERNException $ +                        "conversion failed during mixed multiplication: n = " ++ show n+++{- properties of mixed multiplication -}++propMixedMultEqualsConvert ::+    (NumOrd.PartialComparison t, NumOrd.RoundedLattice t, +     Convertible tn t,+     RoundedMixedMultiply t tn, RoundedMultiply t,+     Show t, HasLegalValues t,+     Show (MixedMultEffortIndicator t tn),+     EffortIndicator (MixedMultEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (NumOrd.MinmaxEffortIndicator t),+     EffortIndicator (NumOrd.MinmaxEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (NumOrd.PartialCompareEffortIndicator t,+     (MixedMultEffortIndicator t tn,      +      (MultEffortIndicator t,+       ConvertEffortIndicator tn t,+       NumOrd.MinmaxEffortIndicator t))) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedMultEqualsConvert sample sampleN initEffort +        (NumOrd.UniformlyOrderedSingleton d) n =+    equalRoundingUpDn "mixed multiplication by conversion"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMMult,_) =+        let (*^|) = mixedMultUpEff effMMult in d *^| n+    expr1Dn (effMMult,_) =+        let (*.|) = mixedMultDnEff effMMult in d *.| n+    expr2Up (_,(effMult,effConv,effMinmax)) =+        let (*^) = multUpEff effMult in+        NumOrd.maxUpEff effMinmax  +            (d *^ (fromJust $ convertUpEff effConv n))+            (d *^ (fromJust $ convertDnEff effConv n))+    expr2Dn (_,(effMult,effConv,effMinmax)) =+        let (*.) = multDnEff effMult in+        NumOrd.minDnEff effMinmax  +            (d *. (fromJust $ convertUpEff effConv n))+            (d *. (fromJust $ convertDnEff effConv n))++class RoundedMixedDivideEffort t tn where+    type MixedDivEffortIndicator t tn+    mixedDivDefaultEffort :: t -> tn -> MixedDivEffortIndicator t tn++class (RoundedMixedDivideEffort t tn) => RoundedMixedDivide t tn where+    mixedDivUpEff :: MixedDivEffortIndicator t tn -> t -> tn -> t+    mixedDivDnEff :: MixedDivEffortIndicator t tn -> t -> tn -> t++{- tools to easily make a RoundedMixedDivide instance +   via the composition of conversion and homogeneous addition -}++type MixedDivEffortIndicatorByConversion t tn =+        (DivEffortIndicator t, +         ConvertEffortIndicator tn t,+         (NumOrd.MinmaxEffortIndicator t,+          NumOrd.PartialCompareEffortIndicator t))++mixedDivDefaultEffortByConversion d n = +        (addDefaultEffort d, +         convertDefaultEffort n d,+         (NumOrd.minmaxDefaultEffort d,+          NumOrd.pCompareDefaultEffort d))++mixedDivUpEffByConversion ::+    (Convertible tn t, +     RoundedDivide t, +     HasZero t,  HasInfinities t,+     NumOrd.PartialComparison t,+     NumOrd.RoundedLattice t,+     Show tn) =>+    (DivEffortIndicator t, +     ConvertEffortIndicator tn t,+     (NumOrd.MinmaxEffortIndicator t, +      NumOrd.PartialCompareEffortIndicator t)) ->+    t -> tn -> t+mixedDivUpEffByConversion (effDiv, effConv, (effMinmax, effComp)) d n =+    let ?pCompareEffort = effComp in+    case (nDn >=? zero, nUp <=? zero) of+        (Just True, _) -> normalResult +        (_, Just True) -> normalResult+        _ -> plusInfinity -- b is too close to zero+    where+    normalResult =+        NumOrd.maxDnEff effMinmax  -- we do not know the sign of a+            (divUpEff effDiv d nDn)+            (divUpEff effDiv d nUp)+    (nUp, nDn) = +        case (convertUpEff effConv n, convertDnEff effConv n) of+            (Just nUp, Just nDn) -> (nUp, nDn)+            _ -> throw $ AERNException $ +                        "conversion failed during mixed division: n = " ++ show n++mixedDivDnEffByConversion ::+    (Convertible tn t, +     RoundedDivide t, +     HasZero t,  HasInfinities t,+     NumOrd.PartialComparison t,+     NumOrd.RoundedLattice t,+     Show tn) =>+    (DivEffortIndicator t, +     ConvertEffortIndicator tn t,+     (NumOrd.MinmaxEffortIndicator t, +      NumOrd.PartialCompareEffortIndicator t)) ->+    t -> tn -> t+mixedDivDnEffByConversion (effDiv, effConv, (effMinmax, effComp)) d n = +    let ?pCompareEffort = effComp in+    case (nDn >=? zero, nUp <=? zero) of+        (Just True, _) -> normalResult +        (_, Just True) -> normalResult+        _ -> minusInfinity -- b is too close to zero+    where+    normalResult =+        NumOrd.minDnEff effMinmax  -- we do not know the sign of a+            (divDnEff effDiv d nDn)+            (divDnEff effDiv d nUp)+    (nUp, nDn) = +        case (convertUpEff effConv n, convertDnEff effConv n) of+            (Just nUp, Just nDn) -> (nUp, nDn)+            _ -> throw $ AERNException $ +                        "conversion failed during mixed division: n = " ++ show n++{- properties of mixed multiplication -}++propMixedDivEqualsConvert ::+    (NumOrd.PartialComparison t, NumOrd.RoundedLattice t, +     Convertible tn t,+     RoundedMixedDivide t tn, RoundedDivide t,+     Show t, HasLegalValues t,+     HasZero t,+     Show (MixedDivEffortIndicator t tn),+     EffortIndicator (MixedDivEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (NumOrd.MinmaxEffortIndicator t),+     EffortIndicator (NumOrd.MinmaxEffortIndicator t),+     Show (NumOrd.PartialCompareEffortIndicator t),+     EffortIndicator (NumOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (NumOrd.PartialCompareEffortIndicator t,+     (MixedDivEffortIndicator t tn,      +      (DivEffortIndicator t,+       ConvertEffortIndicator tn t,+       NumOrd.MinmaxEffortIndicator t))) -> +    (NumOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedDivEqualsConvert sample sampleN initEffort@(effComp,(_,(_,effConv,_))) +        (NumOrd.UniformlyOrderedSingleton d) n+    =+    equalRoundingUpDn "mixed division by conversion"+        expr1Up expr1Dn expr2Up expr2Dn +        NumOrd.pLeqEff initEffort+    where+    expr1Up (effMDiv,_) =+        let (/^|) = mixedDivUpEff effMDiv in d /^| n+    expr1Dn (effMDiv,_) =+        let (/.|) = mixedDivDnEff effMDiv in d /.| n+    expr2Up (_,(effDiv,effConv,effMinmax)) =+        let (/^) = divUpEff effDiv in+        NumOrd.maxUpEff effMinmax  +            (d /^ (fromJust $ convertUpEff effConv n))+            (d /^ (fromJust $ convertDnEff effConv n))+    expr2Dn (_,(effDiv,effConv,effMinmax)) =+        let (/.) = divDnEff effDiv in+        NumOrd.minDnEff effMinmax  +            (d /. (fromJust $ convertUpEff effConv n))+            (d /. (fromJust $ convertDnEff effConv n))+    +testsUpDnMixedFieldOps (name, sample) (nameN, sampleN) =+    testGroup (name ++ " with " ++ nameN ++ ": mixed up/dn rounded ops") $+        [+            testProperty "addition" (propMixedAddEqualsConvert sample sampleN)+        ,+            testProperty "multiplication" (propMixedMultEqualsConvert sample sampleN)+        ,+            testProperty "division" (propMixedDivEqualsConvert sample sampleN)+        ]++class (RoundedMixedAddEffort t tn, RoundedMixedMultiplyEffort t tn) => +    RoundedMixedRingEffort t tn+    where+    type MixedRingOpsEffortIndicator t tn+    mixedRingOpsDefaultEffort :: t -> tn -> MixedRingOpsEffortIndicator t tn+    mxringEffortAdd :: t -> tn -> MixedRingOpsEffortIndicator t tn -> MixedAddEffortIndicator t tn+    mxringEffortMult :: t -> tn -> MixedRingOpsEffortIndicator t tn -> MixedMultEffortIndicator t tn++class (RoundedMixedAdd t tn, RoundedMixedMultiply t tn, RoundedMixedRingEffort t tn) => +    RoundedMixedRing t tn++class (RoundedMixedRingEffort t tn, RoundedMixedDivideEffort t tn) => +    RoundedMixedFieldEffort t tn+    where+    type MixedFieldOpsEffortIndicator t tn+    mixedFieldOpsDefaultEffort :: t -> tn -> MixedFieldOpsEffortIndicator t tn+    mxfldEffortAdd :: t -> tn -> MixedFieldOpsEffortIndicator t tn -> MixedAddEffortIndicator t tn+    mxfldEffortMult :: t -> tn -> MixedFieldOpsEffortIndicator t tn -> MixedMultEffortIndicator t tn+    mxfldEffortDiv :: t -> tn -> MixedFieldOpsEffortIndicator t tn -> MixedDivEffortIndicator t tn++class (RoundedMixedRing t tn, RoundedMixedDivide t tn, RoundedMixedFieldEffort t tn) => +    RoundedMixedField t tn+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/OpsDefaultEffort.hs view
@@ -0,0 +1,131 @@+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.OpsImplicitEffort+    Description :  convenience binary infix operators with default effort  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Convenience binary infix operators with default effort.+-}++module Numeric.AERN.RealArithmetic.NumericOrderRounding.OpsDefaultEffort where++import Numeric.AERN.RealArithmetic.NumericOrderRounding+import Numeric.AERN.RealArithmetic.ExactOps++infixl 6 +., +^, -., -^+infixl 7 *., *^+infixl 8 ^., ^^+infixl 7 /., /^++infixr 6 |+., |+^+infixl 6 +.|, +^|+infixr 7 |*., |*^+infixl 7 *.|, *^|+infixl 7 /.|, /^|++(+^), (+.) :: +    (RoundedAdd t) => +    t -> t -> t+(+^) d = addUpEff (addDefaultEffort d) d+(+.) d = addDnEff (addDefaultEffort d) d++(-^), (-.) :: +    (RoundedSubtr t) => +    t -> t -> t+(-^) d = subtrUpEff (addDefaultEffort d) d+(-.) d = subtrDnEff (addDefaultEffort d) d++absUp, absDn ::+    (RoundedAbs t) => +    t -> t+absUp d = absUpEff (absDefaultEffort d) d+absDn d = absDnEff (absDefaultEffort d) d++(*^), (*.) :: +    (RoundedMultiply t) => +    t -> t -> t+(*^) d = multUpEff (multDefaultEffort d) d+(*.) d = multDnEff (multDefaultEffort d) d++(^^), (^.) :: +    (RoundedPowerToNonnegInt t) => +    t -> Int -> t+(^^) d = powerToNonnegIntUpEff (powerToNonnegIntDefaultEffort d) d+(^.) d = powerToNonnegIntDnEff (powerToNonnegIntDefaultEffort d) d++(/^), (/.) :: +    (RoundedDivide t) => +    t -> t -> t+(/^) d = divUpEff (divDefaultEffort d) d+(/.) d = divDnEff (divDefaultEffort d) d++(|+^), (|+.) :: +    (RoundedMixedAdd t tn) => +    tn -> t -> t+(|+^) n d = mixedAddUpEff (mixedAddDefaultEffort d n) d n+(|+.) n d = mixedAddDnEff (mixedAddDefaultEffort d n) d n++(+^|), (+.|) :: +    (RoundedMixedAdd t tn) => +    t -> tn -> t+(+^|) d n = mixedAddUpEff (mixedAddDefaultEffort d n) d n+(+.|) d n = mixedAddDnEff (mixedAddDefaultEffort d n) d n++(|*^), (|*.) :: +    (RoundedMixedMultiply t tn) => +    tn -> t -> t+(|*^) n d = mixedMultUpEff (mixedMultDefaultEffort d n) d n+(|*.) n d = mixedMultDnEff (mixedMultDefaultEffort d n) d n++(*^|), (*.|) :: +    (RoundedMixedMultiply t tn) => +    t -> tn -> t+(*^|) d n = mixedMultUpEff (mixedMultDefaultEffort d n) d n+(*.|) d n = mixedMultDnEff (mixedMultDefaultEffort d n) d n++(/^|), (/.|) :: +    (RoundedMixedDivide t tn) => +    t -> tn -> t+(/^|) d n = mixedDivUpEff (mixedDivDefaultEffort d n) d n+(/.|) d n = mixedDivDnEff (mixedDivDefaultEffort d n) d n++piUp, piDn ::+    (RoundedSpecialConst t) => +    t+piUp = result+    where+    result =  +        piUpEff (specialConstDefaultEffort result)+piDn = result+    where+    result =  +        piDnEff (specialConstDefaultEffort result)++eUp, eDn ::+    (RoundedSpecialConst t) => +    t+eUp = result+    where+    result =  +        eUpEff (specialConstDefaultEffort result)+eDn = result+    where+    result =  +        eDnEff (specialConstDefaultEffort result)++expUp, expDn ::+    (RoundedExponentiation t) => +    t -> t+expUp d = expUpEff (expDefaultEffort d) d+expDn d = expDnEff (expDefaultEffort d) d++sqrtUp, sqrtDn ::+    (RoundedSquareRoot t) => +    t -> t+sqrtUp d = sqrtUpEff (sqrtDefaultEffort d) d+sqrtDn d = sqrtDnEff (sqrtDefaultEffort d) d+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/OpsImplicitEffort.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.OpsImplicitEffort+    Description :  convenience binary infix operators with implicit effort parameters  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Convenience binary infix operators with implicit effort parameters.+-}++module Numeric.AERN.RealArithmetic.NumericOrderRounding.OpsImplicitEffort where++import Numeric.AERN.RealArithmetic.NumericOrderRounding++infixl 6 +., +^, -., -^+infixl 7 *., *^+infixl 8 ^., ^^+infixl 7 /., /^++infixr 6 |+., |+^+infixl 6 +.|, +^|+infixr 7 |*., |*^+infixl 7 *.|, *^|+infixl 7 /.|, /^|++(+^), (+.) :: +    (RoundedAdd t, ?addUpDnEffort :: AddEffortIndicator t) => +    t -> t -> t+(+^) = addUpEff ?addUpDnEffort+(+.) = addDnEff ?addUpDnEffort++(-^), (-.) :: +    (RoundedSubtr t, ?addUpDnEffort :: AddEffortIndicator t) => +    t -> t -> t+(-^) = subtrUpEff ?addUpDnEffort+(-.) = subtrDnEff ?addUpDnEffort++absUp, absDn ::+    (RoundedAbs t, ?absUpDnEffort :: AbsEffortIndicator t) => +    t -> t+absUp = absUpEff ?absUpDnEffort+absDn = absDnEff ?absUpDnEffort++(*^), (*.) :: +    (RoundedMultiply t, ?multUpDnEffort :: MultEffortIndicator t) => +    t -> t -> t+(*^) = multUpEff ?multUpDnEffort+(*.) = multDnEff ?multUpDnEffort++(^^), (^.) :: +    (RoundedPowerToNonnegInt t, ?intPowerUpDnEffort :: PowerToNonnegIntEffortIndicator t) => +    t -> Int -> t+(^^) = powerToNonnegIntUpEff ?intPowerUpDnEffort+(^.) = powerToNonnegIntDnEff ?intPowerUpDnEffort++(/^), (/.) :: +    (RoundedDivide t, ?divUpDnEffort :: DivEffortIndicator t) => +    t -> t -> t+(/^) = divUpEff ?divUpDnEffort+(/.) = divDnEff ?divUpDnEffort++(+^|), (+.|) ::+    (RoundedMixedAdd t tn, +     ?mixedAddUpDnEffort :: MixedAddEffortIndicator t tn) => +    t -> tn -> t+(+^|) = mixedAddUpEff ?mixedAddUpDnEffort+(+.|) = mixedAddDnEff ?mixedAddUpDnEffort++(|+^), (|+.) ::+    (RoundedMixedAdd t tn, +     ?mixedAddUpDnEffort :: MixedAddEffortIndicator t tn) => +    tn -> t -> t+(|+^) n d = mixedAddUpEff ?mixedAddUpDnEffort d n+(|+.) n d = mixedAddDnEff ?mixedAddUpDnEffort d n++(*^|), (*.|) ::+    (RoundedMixedMultiply t tn, +     ?mixedMultUpDnEffort :: MixedMultEffortIndicator t tn) => +    t -> tn -> t+(*^|) = mixedMultUpEff ?mixedMultUpDnEffort+(*.|) = mixedMultDnEff ?mixedMultUpDnEffort++(|*^), (|*.) ::+    (RoundedMixedMultiply t tn, +     ?mixedMultUpDnEffort :: MixedMultEffortIndicator t tn) => +    tn -> t -> t+(|*^) n d = mixedMultUpEff ?mixedMultUpDnEffort d n+(|*.) n d = mixedMultDnEff ?mixedMultUpDnEffort d n++(/^|), (/.|) ::+    (RoundedMixedDivide t tn, +     ?mixedDivUpDnEffort :: MixedDivEffortIndicator t tn) => +    t -> tn -> t+(/^|) = mixedDivUpEff ?mixedDivUpDnEffort+(/.|) = mixedDivDnEff ?mixedDivUpDnEffort++piUp, piDn ::+    (RoundedSpecialConst t, ?specialConstUpDnEffort :: SpecialConstEffortIndicator t) => +    t+piUp = piUpEff ?specialConstUpDnEffort+piDn = piDnEff ?specialConstUpDnEffort++eUp, eDn ::+    (RoundedSpecialConst t, ?specialConstUpDnEffort :: SpecialConstEffortIndicator t) => +    t+eUp = eUpEff ?specialConstUpDnEffort+eDn = eDnEff ?specialConstUpDnEffort++expUp, expDn ::+    (RoundedExponentiation t, ?expUpDnEffort :: ExpEffortIndicator t) => +    t -> t+expUp = expUpEff ?expUpDnEffort+expDn = expDnEff ?expUpDnEffort++sqrtUp, sqrtDn ::+    (RoundedSquareRoot t, ?sqrtUpDnEffort :: SqrtEffortIndicator t) => +    t -> t+sqrtUp = sqrtUpEff ?sqrtUpDnEffort+sqrtDn = sqrtDnEff ?sqrtUpDnEffort+
+ src/Numeric/AERN/RealArithmetic/NumericOrderRounding/SpecialConst.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.NumericOrderRounding.SpecialConst+    Description :  support for common constants such as pi+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Support for common constants such as pi.+    +    This module is hidden and reexported via its parent NumericOrderRounding. +-}++module Numeric.AERN.RealArithmetic.NumericOrderRounding.SpecialConst where++--import Numeric.AERN.Basics.Effort+--import Numeric.AERN.Basics.Exception+--import Numeric.AERN.Basics.ShowInternals+--import Numeric.AERN.RealArithmetic.Laws+--import Numeric.AERN.RealArithmetic.Measures+--import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+--import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort+--+--import Numeric.AERN.Misc.Debug+--+--import Test.QuickCheck+--import Test.Framework (testGroup, Test)+--import Test.Framework.Providers.QuickCheck2 (testProperty)++class RoundedSpecialConstEffort t where+    type SpecialConstEffortIndicator t+    specialConstDefaultEffort :: t -> SpecialConstEffortIndicator t++class (RoundedSpecialConstEffort t) => RoundedSpecialConst t where+    piUpEff :: (SpecialConstEffortIndicator t) -> t+    piDnEff :: (SpecialConstEffortIndicator t) -> t+    eUpEff :: (SpecialConstEffortIndicator t) -> t+    eDnEff :: (SpecialConstEffortIndicator t) -> t+
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Numeric.AERN.RefinementOrderRounding+    Description :  common arithmetical operations rounded in/out  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Common arithmetical operations rounded in/out.+    +    This module is meant to be imported qualified.+    It is recommended to use the prefix ArithInOut.+-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding+(+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion,+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps,+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.MixedFieldOps,+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.SpecialConst,+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.Elementary,+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace,+    RoundedReal(..), RoundedRealInPlace+)+where++import Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.MixedFieldOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.SpecialConst+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.Elementary+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace++import Numeric.AERN.RealArithmetic.ExactOps++import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as ArithUpDn++import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd++{-|+   An aggregate class collecting together all functionality+   normally expected from up/down rounded approximations to+   real numbers such as the floating point numbers.+   +   It also provides a single aggregate effort indicator type+   from which effort indicators for all the rounded operations can+   be extracted.+-}+class +    (HasZero t, HasOne t, HasInfinities t, Neg t,+     NumOrd.PartialComparison t, NumOrd.RefinementRoundedLattice t,+     RefOrd.PartialComparison t, RefOrd.RoundedLattice t, +     Convertible Int t, ArithUpDn.Convertible t Int,+     Convertible Integer t, ArithUpDn.Convertible t Integer,  +     Convertible Double t, ArithUpDn.Convertible t Double,  +     Convertible Rational t, ArithUpDn.Convertible t Rational,  +     RoundedAbs t, +     RoundedField t,+     RoundedMixedField t Int, +     RoundedMixedField t Integer, +     RoundedMixedField t Double, +     RoundedMixedField t Rational) => +    RoundedReal t+    where+    type RoundedRealEffortIndicator t+    roundedRealDefaultEffort :: t -> RoundedRealEffortIndicator t+    rrEffortNumComp :: t -> (RoundedRealEffortIndicator t) -> (NumOrd.PartialCompareEffortIndicator t)+    rrEffortMinmax :: t -> (RoundedRealEffortIndicator t) -> (NumOrd.MinmaxEffortIndicator t)+    rrEffortComp :: t -> (RoundedRealEffortIndicator t) -> (NumOrd.PartialCompareEffortIndicator t)+    rrEffortJoinMeetOut :: t -> (RoundedRealEffortIndicator t) -> (RefOrd.JoinMeetOutEffortIndicator t)+    rrEffortJoinMeetIn :: t -> (RoundedRealEffortIndicator t) -> (RefOrd.JoinMeetInEffortIndicator t)+    rrEffortToInt :: t -> (RoundedRealEffortIndicator t) -> (ArithUpDn.ConvertEffortIndicator t Int)+    rrEffortFromInt :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator Int t)+    rrEffortToInteger :: t -> (RoundedRealEffortIndicator t) -> (ArithUpDn.ConvertEffortIndicator t Integer)+    rrEffortFromInteger :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator Integer t)+    rrEffortToDouble :: t -> (RoundedRealEffortIndicator t) -> (ArithUpDn.ConvertEffortIndicator t Double)+    rrEffortFromDouble :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator Double t)+    rrEffortToRational :: t -> (RoundedRealEffortIndicator t) -> (ArithUpDn.ConvertEffortIndicator t Rational)+    rrEffortFromRational :: t -> (RoundedRealEffortIndicator t) -> (ConvertEffortIndicator Rational t)+    rrEffortAbs :: t -> (RoundedRealEffortIndicator t) -> (AbsEffortIndicator t)+    rrEffortField :: t -> (RoundedRealEffortIndicator t) -> (FieldOpsEffortIndicator t)+    rrEffortIntMixedField :: t -> (RoundedRealEffortIndicator t) -> (MixedFieldOpsEffortIndicator t Int)+    rrEffortIntegerMixedField :: t -> (RoundedRealEffortIndicator t) -> (MixedFieldOpsEffortIndicator t Integer)+    rrEffortDoubleMixedField :: t -> (RoundedRealEffortIndicator t) -> (MixedFieldOpsEffortIndicator t Double)+    rrEffortRationalMixedField :: t -> (RoundedRealEffortIndicator t) -> (MixedFieldOpsEffortIndicator t Rational)++{-|+   A mutable version of 'RoundedReal' with additional support for mutable ops.+-}+class+    (RoundedReal t,+     NegInPlace t,+     RoundedAbsInPlace t, +     RoundedFieldInPlace t,+     RoundedMixedFieldInPlace t Int, +     RoundedMixedFieldInPlace t Integer, +     RoundedMixedFieldInPlace t Double, +     RoundedMixedFieldInPlace t Rational) => +    RoundedRealInPlace t+
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/Conversion.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion+    Description :  conversion between approximations and other types  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Conversion between approximations and other types.+    +    This module is hidden and reexported via its parent RefinementOrderRounding. +-}+module Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion where++import Prelude hiding (EQ, LT, GT)++import Numeric.AERN.RealArithmetic.ExactOps++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.PartialOrdering+import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort++import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion as UpDnConversion++import Numeric.AERN.Misc.Bool+import Numeric.AERN.Misc.Maybe++import Data.Ratio+import Data.Maybe++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class Convertible t1 t2 where+    type ConvertEffortIndicator t1 t2+    convertDefaultEffort :: t1 -> t2 -> ConvertEffortIndicator t1 t2 +    convertInEff :: ConvertEffortIndicator t1 t2 -> t1 -> t2+    convertOutEff :: ConvertEffortIndicator t1 t2 -> t1 -> t2++propConvertMonotoneFromNumOrd ::+    (Convertible t1 t2, NumOrd.ArbitraryOrderedTuple t1, NumOrd.PartialComparison t2) =>+    t1 -> t2 ->+    (ConvertEffortIndicator t1 t2, NumOrd.PartialCompareEffortIndicator t2) ->  +    NumOrd.LEPair t1 -> Bool+propConvertMonotoneFromNumOrd sample1 sample2 (effortFrom, effortComp) (NumOrd.LEPair (a, b)) = +    (trueOrNothing $ let ?pCompareEffort = effortComp in aOut <=? bOut)+    &&+    (trueOrNothing $ let ?pCompareEffort = effortComp in aIn <=? bIn)+    where+    aOut = convertOutEff effortFrom a +    aIn = convertInEff effortFrom a +    bOut = convertOutEff effortFrom b +    bIn = convertInEff effortFrom b+    _ = [sample2, aOut, aIn]++propConvertRoundTripNumOrd ::+    (UpDnConversion.Convertible t1 t2, Convertible t2 t1, +     NumOrd.PartialComparison t1, Show t1, Show t2) =>+    t1 -> t2 -> +    (NumOrd.PartialCompareEffortIndicator t1, +     ConvertEffortIndicator t2 t1, +     UpDnConversion.ConvertEffortIndicator t1 t2) ->+    t1 -> Bool+propConvertRoundTripNumOrd sample1 sample2 (effortComp, effortFrom, effortTo) a =+    (defined maDn && defined maUp) ===>+    let ?pCompareEffort = effortComp in+    case (aDnOut <=? a, a <=? aUpOut) of+       (Just False, _) -> printErrorDetail+       (_, Just False) -> printErrorDetail+       _ -> True+    where+    aDnOut = convertOutEff effortFrom aDn +    maDn = UpDnConversion.convertDnEff effortTo a+    aDn = fromJust maDn +    aUpOut = convertOutEff effortFrom aUp+    maUp = UpDnConversion.convertUpEff effortTo a+    aUp = fromJust maUp +    _ = [sample2, aDn, aUp]+    printErrorDetail =+        error $+           "propToFromInteger failed:"+           ++ "\n  a = " ++ show a+           ++ "\n  aDnOut = " ++ show aDnOut+           ++ "\n  aUpOut = " ++ show aUpOut+++testsConvertNumOrd (name1, sample1, name2, sample2) =+    testGroup (name1 ++ " -> " ++ name2 ++  " conversions") $+        [+            testProperty "monotone" (propConvertMonotoneFromNumOrd sample1 sample2)+        ,+            testProperty "round trip" (propConvertRoundTripNumOrd sample2 sample1)+        ]+
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/Elementary.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.Elementary+    Description :  support for various common elementary functions+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Support for various common elementary functions.+    +    This module is hidden and reexported via its parent RefinementOrderRounding. +-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.Elementary where++import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.MixedFieldOps++import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion as UpDnConversion++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception+import Numeric.AERN.Basics.ShowInternals+import Numeric.AERN.Basics.Bench+import Numeric.AERN.Basics.Consistency+import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Bench+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd++import Numeric.AERN.Misc.Debug++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Criterion++class RoundedExponentiationEffort t where+    type ExpEffortIndicator t+    expDefaultEffort :: t -> ExpEffortIndicator t++class (RoundedExponentiationEffort t) => RoundedExponentiation t where+    expInEff :: (ExpEffortIndicator t) -> t -> t+    expOutEff :: (ExpEffortIndicator t) -> t -> t++-- | @e^a*e^(-a) = 1@+propExpOfNegRecip ::+    (RefOrd.PartialComparison t,+     RoundedExponentiation t, RoundedMultiply t, Neg t, HasOne t,+     Show t, HasAntiConsistency t, HasLegalValues t,+     Show (ExpEffortIndicator t),+     EffortIndicator (ExpEffortIndicator t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (ConsistencyEffortIndicator t) -> +    (RefOrd.PartialCompareEffortIndicator t, +     (ExpEffortIndicator t, MultEffortIndicator t)) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    Bool+propExpOfNegRecip _ effortConsistency initEffort +        (RefOrd.UniformlyOrderedSingleton e1) =+    thinEqualConsLeqRoundingUpDnImprovement "e^a * e^(-a) ⊑/⊒ 1" [e1]+        expr1In expr1Out expr2In expr2Out +        RefOrd.pLeqEff+        effortConsistency +        initEffort+    where+    expr1In (effExp, effMult) =+--        unsafePrintReturn (+--                "propExpOfNegRecip: expr2In: " +--                ++ "\n e1 = " ++ (show e1)+--                ++ "\n expInEff effExp e1 = " ++ (show $ expInEff effExp e1)+--                ++ "\n expInEff effExp (neg e1) = " ++ (show $ expInEff effExp (neg e1))+--                ++ "\n product of the above = "+--        ) $+        let (>*<) = multInEff effMult in+        (expInEff effExp e1) >*< (expInEff effExp (neg e1))+    expr1Out (effExp, effMult) =+        let (<*>) = multOutEff effMult in+        (expOutEff effExp e1) <*> (expOutEff effExp (neg e1))+    expr2In (effExp, effMult) = one+    expr2Out (effExp, effMult) = one++-- | @e^(b+c) = e^b * e^c@+propExpOfAddToMult ::+    (RefOrd.PartialComparison t,+     RoundedExponentiation t, RoundedMultiply t,  RoundedAdd t,+     Show t, HasLegalValues t,+     Show (ExpEffortIndicator t),+     EffortIndicator (ExpEffortIndicator t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     (ExpEffortIndicator t, MultEffortIndicator t, AddEffortIndicator t)) -> +    (RefOrd.UniformlyOrderedPair t) -> +    Bool+propExpOfAddToMult _ initEffort (RefOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "e^(a + b) = e^a * e^b"+        expr1In expr1Out expr2In expr2Out +        RefOrd.pLeqEff initEffort+    where+    expr1In (effExp, effMult, effAdd) =+        let (+^) = addInEff effAdd in+        (expInEff effExp (e1 +^ e2))+    expr1Out (effExp, effMult, effAdd) =+        let (+.) = addOutEff effAdd in+        (expOutEff effExp (e1 +. e2))+    expr2In (effExp, effMult, effAdd) =+        let (*^) = multInEff effMult in+        (expInEff effExp e1) *^ (expInEff effExp e2)+    expr2Out (effExp, effMult, effAdd) =+        let (*.) = multOutEff effMult in+        (expOutEff effExp e1) *. (expOutEff effExp e2)+    +testsInOutExp (name, sample) =+    testGroup (name ++ " exp in/out") $+        [+            testProperty "e^a * e^(-a) ⊑/⊒ 1" (propExpOfNegRecip sample)+        ,+            testProperty "e^(a + b) = e^a * e^b" (propExpOfAddToMult sample)+        ]+            +benchInOutExp (name, sample) areas =+    bgroup (name ++ " exp") $+        mkBenchAreasSequences1 (mkCommentImprecision1 expOutEff expInEff) +            expOutEff areas 10 (expDefaultEffort sample) sample ++benchExpAreasReal =+    [+        ("near 0", NumOrd.AreaLinear (Just $ -1/2) True (Just $ 1/2) True [])+    ,+        ("near -10", NumOrd.AreaLinear (Just $ -10.5) True (Just $ -9.5) True [])+    ,+        ("near 10", NumOrd.AreaLinear (Just $ 9.5) True (Just $ 10.5) True [])+    ,+        ("near 20", NumOrd.AreaLinear (Just $ 19.5) True (Just $ 20.5) True [])+    ]++class RoundedSquareRootEffort t where+    type SqrtEffortIndicator t+    sqrtDefaultEffort :: t -> SqrtEffortIndicator t++class (RoundedSquareRootEffort t) => RoundedSquareRoot t where+    sqrtInEff :: (SqrtEffortIndicator t) -> t -> t+    sqrtOutEff :: (SqrtEffortIndicator t) -> t -> t++propSqrtSquare ::+    (RefOrd.PartialComparison t, +     RoundedSquareRoot t, RoundedMultiply t, HasZero t,+     UpDnConversion.Convertible t Double,+     RoundedMixedAdd t Double,+     Show t, HasLegalValues t,+--     ShowInternals t,+     Show (UpDnConversion.ConvertEffortIndicator t Double),+     EffortIndicator (UpDnConversion.ConvertEffortIndicator t Double),+     Show (MixedAddEffortIndicator t Double),+     EffortIndicator (MixedAddEffortIndicator t Double),+     Show (SqrtEffortIndicator t),+     EffortIndicator (SqrtEffortIndicator t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (tInArea -> t) ->+    (UpDnConversion.ConvertEffortIndicator t Double, +     MixedAddEffortIndicator t Double) ->+    (RefOrd.PartialCompareEffortIndicator t, +     (SqrtEffortIndicator t, +      MultEffortIndicator t, +      RefOrd.PartialCompareEffortIndicator t)) -> +    tInArea -> Bool+propSqrtSquare _ fromArea (effortToDbl, effortAddDbl) initEffort e1InArea =+    equalRoundingUpDn "sqrt(e)^2 = e"+        expr1In expr1Out expr2In expr2Out +        RefOrd.pLeqEff initEffort+    where+    e1Pos = fromArea e1InArea+--        case maybeE1LowerBoundD of+--            Just e1LowerBoundD+--                | e1LowerBoundD <= (0 :: Double) -> +--                    mixedAddOutEff effortAddDbl e1 (0.5 - e1LowerBoundD)+--                | otherwise -> e1+--            _ -> e1+--        where+--        maybeE1LowerBoundD = UpDnConversion.convertDnEff effortToDbl e1  +    expr1In (effSqrt, effMult, effCompare) =+        sqrtE1 >*< sqrtE1+        where+        (>*<) = multInEff effMult+        sqrtE1 = sqrtInEff effSqrt e1Pos+    expr1Out (effSqrt, effMult, effCompare) =+        sqrtE1 <*> sqrtE1+        where+        (<*>) = multOutEff effMult+        sqrtE1 = sqrtOutEff effSqrt e1Pos+    expr2In _ = e1Pos+    expr2Out _ = e1Pos++testsInOutSqrt (name, sample) fromArea =+    testGroup (name ++ " sqrt in/out") $+        [+            testProperty "sqrt(e)^2 = e" (propSqrtSquare sample fromArea)+        ]+
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/ElementaryFromFieldOps/Exponentiation.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.ElementaryFromFieldOps.Exponentiation+    Description :  implementation of in/out rounded exponentiation+    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Implementation of in/out rounded exponentiation.+-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.ElementaryFromFieldOps.Exponentiation where++import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as ArithInOut+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsImplicitEffort+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsImplicitEffort++import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as ArithUpDn+import Numeric.AERN.RealArithmetic.NumericOrderRounding.OpsImplicitEffort++import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd+import Numeric.AERN.Basics.RefinementOrder.OpsImplicitEffort+import Numeric.AERN.Basics.RefinementOrder.InPlace.OpsImplicitEffort++import qualified Numeric.AERN.Basics.NumericOrder as NumOrd++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.ExactOps++import Control.Monad.ST (ST)++expOutThinArg ::+    (HasZero t, HasOne t, HasInfinities t,+     RefOrd.PartialComparison t,+     NumOrd.PartialComparison t,+     RefOrd.OuterRoundedLattice t,+     ArithUpDn.Convertible t Int,+     ArithInOut.Convertible Double t,+     ArithInOut.RoundedMixedField t Int,+     ArithInOut.RoundedField t) =>+    ArithInOut.FieldOpsEffortIndicator t ->+    ArithInOut.MixedFieldOpsEffortIndicator t Int ->+    RefOrd.JoinMeetOutEffortIndicator t ->+    RefOrd.PartialCompareEffortIndicator t ->+    NumOrd.PartialCompareEffortIndicator t ->+    (ArithUpDn.ConvertEffortIndicator t Int, +     ArithInOut.ConvertEffortIndicator Double t) ->+    Int {-^ the highest degree to consider in the Taylor expansion -} ->+    t {-^ @x@ assumed to be a thin approximation -} -> +    t {-^ @exp(x)@ -}+expOutThinArg+        effortField+        effortMixedField+        effortMeet+        effortRefinement effortCompare+        (effortToInt, effortFromDouble)+        degr x =+    let ?pCompareEffort = effortRefinement in+    let ?joinmeetOutEffort = effortMeet in+    let ?divInOutEffort = ArithInOut.fldEffortDiv x effortField in+    -- infinities not handled well by the Taylor formula,+    -- treat them as special cases, adding also 0 for efficiency:+    case (xTooBig, xTooLow, x |>=? zero) of+        (True, _, _) -> x </\> plusInfinity -- x almost oo+        (_, True, _) -> zero </\> (one </> (neg x)) -- x almost -oo+        (_, _, Just True) -> one -- x = 0+        _ | excludesPlusInfinity x && excludesMinusInfinity x ->+            expOutViaTaylorForXScaledNearZero+        _ -> -- not equal to infinity but not excluding infinity:+            zero </\> plusInfinity+             -- this is always a valid outer approx+    where+    (xUp, xTooBig) =+        case ArithUpDn.convertUpEff effortToInt x of+            Just xUp -> (xUp :: Int, False)+            _ -> (error "internal error in expOutThinArg", True)+    (xDn, xTooLow) =+        case ArithUpDn.convertDnEff effortToInt x of+            Just xDn -> (xDn :: Int, False)+            _ -> (error "internal error in expOutThinArg", True)+    expOutViaTaylorForXScaledNearZero =+        let ?joinmeetOutEffort = effortMeet in+        let ?addInOutEffort = ArithInOut.fldEffortAdd x effortField in+        let ?multInOutEffort = ArithInOut.fldEffortMult x effortField in+        let ?intPowerInOutEffort = ArithInOut.fldEffortPow x effortField in+        let ?divInOutEffort = ArithInOut.fldEffortDiv x effortField in+        let ?mixedAddInOutEffort = ArithInOut.mxfldEffortAdd x xUp effortMixedField in+        let ?mixedMultInOutEffort = ArithInOut.mxfldEffortMult x xUp effortMixedField in+        let ?mixedDivInOutEffort = ArithInOut.mxfldEffortDiv x xUp effortMixedField in+        (expOutViaTaylor degr (x </>| n)) <^> n+        where+        n = -- x / n must fall inside [-1,1] +            (abs xUp) `max` (abs xDn)+    expOutViaTaylor degr x = -- assuming x inside [-1,1]+        oneI |<+> (te degr oneI)+        where+        oneI :: Int+        oneI = 1+        te steps i+            | steps > 0 =+                (x </>| i) <*> (oneI |<+> (te (steps - 1) (i + 1)))+            | steps == 0 = +                errorBound+                where+                errorBound = +                    (x </>| i) <*> ithDerivBound+                ithDerivBound =+                    case (pNonnegNonposEff effortCompare x) of+                        (Just True, _) -> -- x >= 0:+                            one </\> eUp+                        (_, Just True) -> -- x <= 0:+                            recipEDn </\> one+                        _ -> -- near or crossing zero:+                            recipEDn </\> eUp+                eUp =+                    ArithInOut.convertOutEff effortFromDouble (2.718281829 :: Double)+                recipEDn =+                    ArithInOut.convertOutEff effortFromDouble (0.367879440 :: Double)++expOutThinArgInPlace ::+    (CanBeMutable t, +     HasZero t, HasOne t, HasInfinities t,+     RefOrd.PartialComparison t,+     NumOrd.PartialComparison t,+     RefOrd.OuterRoundedLattice t,+     ArithUpDn.Convertible t Int,+     ArithInOut.Convertible Double t,+     ArithInOut.RoundedField t,+     ArithInOut.RoundedFieldInPlace t,+     ArithInOut.RoundedMixedField t Int,+     ArithInOut.RoundedMixedFieldInPlace t Int, -- this constraint should be redundant..+     ArithInOut.RoundedPowerToNonnegIntInPlace t) => +    ArithInOut.FieldOpsEffortIndicator t ->+    ArithInOut.MixedFieldOpsEffortIndicator t Int ->+    RefOrd.JoinMeetOutEffortIndicator t ->+    RefOrd.PartialCompareEffortIndicator t ->+    NumOrd.PartialCompareEffortIndicator t ->+    (ArithUpDn.ConvertEffortIndicator t Int, +     ArithInOut.ConvertEffortIndicator Double t) ->+    Mutable t s -> {-^ out parameter -}+    Int {-^ the highest degree to consider in the Taylor expansion -} ->+    Mutable t s {-^ @xM@ assumed to be a thin approximation -} -> +    ST s ()+expOutThinArgInPlace+        effortField+        effortMixedField+        effortMeet+        effortRefinement effortCompare+        (effortToInt, effortFromDouble)+        resM degr xM =+    do+    -- clone xM to ensure no aliasing with resM:+    xMNA <- cloneMutable xM+    +    -- we need x - a pure version of xM for branching conditions:+    x <- unsafeReadMutable xMNA+    -- unsafe is OK because we do not write into xMNA while x is in scope++    -- set various effort indicators for the following block using implicit parameters: +    let ?pCompareEffort = effortRefinement+    let ?joinmeetOutEffort = effortMeet+    let ?divInOutEffort = ArithInOut.fldEffortDiv x effortField+    let ?multInOutEffort = ArithInOut.fldEffortMult x effortField+    let ?intPowerInOutEffort = ArithInOut.fldEffortPow x effortField+    let ?mixedAddInOutEffort = ArithInOut.mxfldEffortAdd x degr effortMixedField+    let ?mixedDivInOutEffort = ArithInOut.mxfldEffortDiv x degr effortMixedField++    -- compute integer bounds on x if possible: +    let (xUp, xTooBig) =+          case ArithUpDn.convertUpEff effortToInt x of+            Just xUp -> (xUp :: Int, False)+            _ -> (error "internal error in expOutThinArg", True)+    let (xDn, xTooLow) =+          case ArithUpDn.convertDnEff effortToInt x of+            Just xDn -> (xDn :: Int, False)+            _ -> (error "internal error in expOutThinArg", True)++    -- infinities not handled well by the Taylor formula,+    -- treat them as special cases, adding also 0 for efficiency:+    case (xTooBig, xTooLow, x |>=? zero) of+        (True, _, _) -> unsafeWriteMutable resM (x </\> plusInfinity) -- x almost oo+        (_, True, _) -> unsafeWriteMutable resM (zero </\> (one </> (neg x))) -- x almost -oo+        (_, _, Just True) -> unsafeWriteMutable resM one -- x = 0+        _ | excludesPlusInfinity x && excludesMinusInfinity x ->+            -- the main case where Taylor is used:+            expOutViaTaylorForXScaledNearZero resM xUp xDn xMNA+        _ -> -- not equal to infinity but not excluding infinity:+            unsafeWriteMutable resM (zero </\> plusInfinity)+             -- this is always a valid outer approx+    where+    expOutViaTaylorForXScaledNearZero resM xUp xDn xM =+        -- assuming no aliasing between xM and resM+    +        -- set various effort indicators for the following block using implicit parameters: +        do+        xM </>|= n -- x := x/n+        expOutViaTaylor resM degr xM -- res := exp x+        resM <^>= n -- res := res^n+        where+        n = -- x / n must fall inside [-1,1] +            (abs xUp) `max` (abs xDn)+    expOutViaTaylor resM degr xM = -- assuming x inside [-1,1]+        -- assuming no aliasing between xM and resM+    +        do+        -- we need a pure version of xM for constructing the error bound:+        x <- unsafeReadMutable xM+        -- unsafe is OK because we do not write into xM and it does not alias with resM+        +        let ?addInOutEffort = ArithInOut.fldEffortAdd x effortField+        let ?mixedMultInOutEffort = ArithInOut.mxfldEffortMult x oneI effortMixedField+        te resM degr oneI x xM -- res := x + x^2/2 + ...+        resM <+>|= oneI -- res := res + 1+        where+        oneI :: Int+        oneI = 1+        te resM steps i x xM+            | steps > 0 =+                do+                -- (x </>| i) <*> (oneI |<+> (te (steps - 1) (i + 1)))+                te resM (steps - 1) (i + 1) x xM+                resM <+>|= oneI+                resM </>|= i+                resM <*>= xM               +            | steps == 0 = +                do+                -- (x </>| i) <*> ithDerivBound+                unsafeWriteMutable resM ithDerivBound+                resM </>|= i+                resM <*>= xM+                where+                ithDerivBound =+                    case (pNonnegNonposEff effortCompare x) of+                        (Just True, _) -> -- x >= 0:+                            one </\> eUp+                        (_, Just True) -> -- x <= 0:+                            recipEDn </\> one+                        _ -> -- near or crossing zero:+                            recipEDn </\> eUp+                eUp =+                    ArithInOut.convertOutEff effortFromDouble (2.718281829 :: Double)+                recipEDn =+                    ArithInOut.convertOutEff effortFromDouble (0.367879440 :: Double)
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/FieldOps.hs view
@@ -0,0 +1,680 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE UndecidableInstances #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps+    Description :  rounded addition and multiplication  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Rounded addition and multiplication.+    +    This module is hidden and reexported via its parent RefinementOrderRounding. +-}+module Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps +(+    RoundedAdd(..), RoundedAddEffort(..), RoundedSubtr(..), +    testsInOutAdd, testsInOutSubtr,+    RoundedAbs(..), RoundedAbsEffort(..), +    testsInOutAbs,  absInUsingCompMax, absOutUsingCompMax,+    RoundedMultiply(..), RoundedMultiplyEffort(..), testsInOutMult,+    RoundedPowerToNonnegInt(..), RoundedPowerToNonnegIntEffort(..), +    testsInOutIntPower,+    PowerToNonnegIntEffortIndicatorFromMult, powerToNonnegIntDefaultEffortFromMult,+    powerToNonnegIntInEffFromMult, powerToNonnegIntOutEffFromMult,+    RoundedDivide(..), RoundedDivideEffort(..), testsInOutDiv,+    RoundedRingEffort(..), RoundedFieldEffort(..),+    RoundedRing(..), RoundedField(..)+--    ,+--    FieldOpsEffortIndicator(..), fieldOpsDefaultEffort+)+where++import Prelude hiding (EQ, LT, GT)+import Numeric.AERN.Basics.PartialOrdering++import Numeric.AERN.RealArithmetic.Auxiliary+import Numeric.AERN.RealArithmetic.ExactOps+import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as ArithUpDn+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception (HasLegalValues)+import Numeric.AERN.Basics.Consistency++import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd+import Numeric.AERN.Basics.RefinementOrder.OpsImplicitEffort+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Maybe++class RoundedAddEffort t where+    type AddEffortIndicator t+    addDefaultEffort :: t -> AddEffortIndicator t++class (RoundedAddEffort t) => RoundedAdd t where+    addInEff :: AddEffortIndicator t -> t -> t -> t+    addOutEff :: AddEffortIndicator t -> t -> t -> t++--propAddMonotone _ effortDist++propInOutAddZero ::+    (RefOrd.PartialComparison t, RoundedAdd t, HasZero t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    Bool+propInOutAddZero _ effort (RefOrd.UniformlyOrderedSingleton e) =+    roundedUnit zero RefOrd.pLeqEff addInEff addOutEff effort e++propInOutAddCommutative ::+    (RefOrd.PartialComparison t, RoundedAdd t, HasZero t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (RefOrd.UniformlyOrderedPair t) -> +    Bool+propInOutAddCommutative _ effort (RefOrd.UniformlyOrderedPair (e1,e2)) =+    roundedCommutative RefOrd.pLeqEff addInEff addOutEff effort e1 e2++propInOutAddAssociative ::+    (RefOrd.PartialComparison t, RoundedAdd t, HasZero t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (RefOrd.UniformlyOrderedTriple t) -> +    Bool+propInOutAddAssociative _ effort (RefOrd.UniformlyOrderedTriple (e1,e2,e3)) =+    roundedAssociative RefOrd.pLeqEff addInEff addOutEff effort e1 e2 e3++propInOutAddMonotone ::+    (RefOrd.PartialComparison t, RoundedAdd t, +     Show t, HasLegalValues t,+     RefOrd.ArbitraryOrderedTuple t,  +     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (AddEffortIndicator t) -> +    (RefOrd.LEPair t) -> (RefOrd.LEPair t) -> +    (RefOrd.PartialCompareEffortIndicator t) ->+    Bool+propInOutAddMonotone _ =+    roundedRefinementMonotone2 "addition" addInEff addOutEff++testsInOutAdd (name, sample) =+    testGroup (name ++ " >+< <+>") $+        [+            testProperty "0 absorbs" (propInOutAddZero sample)+        ,+            testProperty "commutative" (propInOutAddCommutative sample)+        ,+            testProperty "associative" (propInOutAddAssociative sample)+        ,+            testProperty "refinement monotone" (propInOutAddMonotone sample)+        ]+++class (RoundedAdd t, Neg t) => RoundedSubtr t where+    subtrInEff :: (AddEffortIndicator t) -> t -> t -> t+    subtrOutEff :: (AddEffortIndicator t) -> t -> t -> t+    subtrInEff effort a b = addInEff effort a (neg b)+    subtrOutEff effort a b = addOutEff effort a (neg b)++propInOutSubtrElim ::+    (RefOrd.PartialComparison t, RoundedSubtr t, HasZero t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    Bool+propInOutSubtrElim _ effort (RefOrd.UniformlyOrderedSingleton e) =+    roundedReflexiveCollapse zero RefOrd.pLeqEff subtrInEff subtrOutEff effort e++propInOutSubtrNegAdd ::+    (RefOrd.PartialComparison t, RoundedSubtr t, Neg t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (RefOrd.UniformlyOrderedPair t) -> +    Bool+propInOutSubtrNegAdd _ initEffort (RefOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDn "a+b=a-(-b)"+        expr1Up expr1Dn expr2Up expr2Dn +        RefOrd.pLeqEff initEffort+    where+    expr1Up eff =+        let (>-<) = subtrInEff eff in e1 >-< (neg e2)+    expr1Dn eff =+        let (<->) = subtrOutEff eff in e1 <-> (neg e2)+    expr2Up eff =+        let (>+<) = addInEff eff in e1 >+< e2+    expr2Dn eff =+        let (<+>) = addOutEff eff in e1 <+> e2++propInOutSubtrMonotone ::+    (RefOrd.PartialComparison t, RoundedSubtr t, +     Show t, HasLegalValues t,+     RefOrd.ArbitraryOrderedTuple t,  +     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (AddEffortIndicator t) -> +    (RefOrd.LEPair t) -> (RefOrd.LEPair t) -> +    (RefOrd.PartialCompareEffortIndicator t) ->+    Bool+propInOutSubtrMonotone _ =+    roundedRefinementMonotone2 "subtraction" subtrInEff subtrOutEff++testsInOutSubtr (name, sample) =+    testGroup (name ++ " >-< <->") $+        [+--            testProperty "a-a=0" (propInOutSubtrElim sample)+--            ,+            testProperty "a+b=a-(-b)" (propInOutSubtrNegAdd sample)+            ,+            testProperty "refinement monotone" (propInOutSubtrMonotone sample)+        ]+++class RoundedAbsEffort t where+    type AbsEffortIndicator t+    absDefaultEffort :: t -> AbsEffortIndicator t++class (RoundedAbsEffort t) => RoundedAbs t where+    absInEff :: (AbsEffortIndicator t) -> t -> t+    absOutEff :: (AbsEffortIndicator t) -> t -> t++absOutUsingCompMax ::+    (HasZero t, Neg t, +     NumOrd.PartialComparison t, NumOrd.OuterRoundedLattice t) =>+    (NumOrd.PartialCompareEffortIndicator t,+     NumOrd.MinmaxOuterEffortIndicator t) ->+    t -> t +absOutUsingCompMax (effortComp, effortMinmax) a =+    case NumOrd.pCompareEff effortComp zero a of+        Just EQ -> a+        Just LT -> a+        Just LEE -> a+        Just GT -> neg a+        Just GEE -> neg a+        _ -> zero `max` (a `max` (neg a))+    where+    max = NumOrd.maxOutEff effortMinmax++absInUsingCompMax ::+    (HasZero t, Neg t, +     NumOrd.PartialComparison t, NumOrd.InnerRoundedLattice t) =>+    (NumOrd.PartialCompareEffortIndicator t,+     NumOrd.MinmaxInnerEffortIndicator t) ->+    t -> t +absInUsingCompMax (effortComp, effortMinmax) a =+    case NumOrd.pCompareEff effortComp zero a of+        Just EQ -> a+        Just LT -> a+        Just LEE -> a+        Just GT -> neg a+        Just GEE -> neg a+        _ -> zero `max` (a `max` (neg a))+    where+    max = NumOrd.maxInEff effortMinmax++propInOutAbsNegSymmetric ::+    (RefOrd.PartialComparison t, RoundedAbs t, HasZero t, Neg t,+     Show t, HasLegalValues t,+     Show (AbsEffortIndicator t),+     EffortIndicator (AbsEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AbsEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    Bool+propInOutAbsNegSymmetric _ effort (RefOrd.UniformlyOrderedSingleton e) =+    roundedNegSymmetric RefOrd.pLeqEff absInEff absOutEff effort e++propInOutAbsIdempotent ::+    (RefOrd.PartialComparison t, RoundedAbs t, HasZero t,+     Show t, HasLegalValues t,+     Show (AbsEffortIndicator t),+     EffortIndicator (AbsEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AbsEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    Bool+propInOutAbsIdempotent _ effort (RefOrd.UniformlyOrderedSingleton e) =+    roundedIdempotent RefOrd.pLeqEff absInEff absOutEff effort e++propInOutAbsMonotone ::+    (RefOrd.PartialComparison t, RoundedAbs t,+     RefOrd.ArbitraryOrderedTuple t,  +     Show t, HasLegalValues t,+     Show (AbsEffortIndicator t),+     EffortIndicator (AbsEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (AbsEffortIndicator t) -> +    (RefOrd.LEPair t) -> +    (RefOrd.PartialCompareEffortIndicator t) ->+    Bool+propInOutAbsMonotone _ =+    roundedRefinementMonotone1 "abs" absInEff absOutEff++testsInOutAbs (name, sample) =+    testGroup (name ++ " in/out rounded abs") $+        [+            testProperty "neg -> no change" (propInOutAbsNegSymmetric sample)+        ,+            testProperty "idempotent" (propInOutAbsIdempotent sample)+        ,+            testProperty "refinement monotone" (propInOutAbsMonotone sample)+        ]+++class RoundedMultiplyEffort t where+    type MultEffortIndicator t+    multDefaultEffort :: t -> MultEffortIndicator t++class (RoundedMultiplyEffort t) => RoundedMultiply t where+    multInEff :: MultEffortIndicator t -> t -> t -> t+    multOutEff :: MultEffortIndicator t -> t -> t -> t++propInOutMultMonotone ::+    (RefOrd.PartialComparison t, RoundedMultiply t, +     Show t, HasLegalValues t,+     RefOrd.ArbitraryOrderedTuple t,  +     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (MultEffortIndicator t) -> +    (RefOrd.LEPair t) -> (RefOrd.LEPair t) -> +    (RefOrd.PartialCompareEffortIndicator t) ->+    Bool+propInOutMultMonotone _ =+    roundedRefinementMonotone2 "multiplication" multInEff multOutEff++propInOutMultOne ::+    (RefOrd.PartialComparison t, RoundedMultiply t, HasOne t,+     Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     MultEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    Bool+propInOutMultOne _ effort (RefOrd.UniformlyOrderedSingleton e) =+    roundedUnit one RefOrd.pLeqEff multInEff multOutEff effort e++propInOutMultCommutative ::+    (RefOrd.PartialComparison t, RoundedMultiply t, HasZero t,+     Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     MultEffortIndicator t) -> +    (RefOrd.UniformlyOrderedPair t) -> +    Bool+propInOutMultCommutative _ effort (RefOrd.UniformlyOrderedPair (e1,e2)) =+    roundedCommutative RefOrd.pLeqEff multInEff multOutEff effort e1 e2+       +propInOutMultAssociative ::+    (RefOrd.PartialComparison t, +     RoundedMultiply t, HasZero t,+     Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     MultEffortIndicator t) -> +    (RefOrd.UniformlyOrderedTriple t) -> +    Bool+propInOutMultAssociative _ effort (RefOrd.UniformlyOrderedTriple (e1,e2,e3)) =+    roundedAssociative RefOrd.pLeqEff multInEff multOutEff effort e1 e2 e3++propInOutMultDistributesOverAdd ::+    (RefOrd.PartialComparison t,+     RoundedMultiply t,  RoundedAdd t,+     HasAntiConsistency t, Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (ConsistencyEffortIndicator t) ->+    (RefOrd.PartialCompareEffortIndicator t, +     (MultEffortIndicator t, AddEffortIndicator t)) -> +    (RefOrd.UniformlyOrderedTriple t) -> +    Bool+propInOutMultDistributesOverAdd _ effortConst effort (RefOrd.UniformlyOrderedTriple (e1,e2,e3)) =+    roundedDistributive +        RefOrd.pLeqEff +        multInEff addInEff multOutEff addOutEff+        effortConst effort e1 e2 e3+       +    +testsInOutMult (name, sample) =+    testGroup (name ++ " >*< <*>") $+        [+            testProperty "1 absorbs" (propInOutMultOne sample)+        ,+            testProperty "commutative" (propInOutMultCommutative sample)+        ,+            testProperty "associative" (propInOutMultAssociative sample)+        ,+            testProperty "weakly distributes over +" (propInOutMultDistributesOverAdd sample)+        ,+            testProperty "refinement monotone" (propInOutMultMonotone sample)+        ]++class RoundedPowerToNonnegIntEffort t where+    type PowerToNonnegIntEffortIndicator t+    powerToNonnegIntDefaultEffort :: +        t -> PowerToNonnegIntEffortIndicator t ++class (RoundedPowerToNonnegIntEffort t) => RoundedPowerToNonnegInt t where+    powerToNonnegIntInEff ::+        (PowerToNonnegIntEffortIndicator t) -> +        t {-^ @x@ -} -> +        Int {-^ @n@ (assumed >=0)-} -> +        t {-^ @x^n@ rounded inwards -}+    powerToNonnegIntOutEff ::+        (PowerToNonnegIntEffortIndicator t) -> +        t {-^ @x@ -} -> +        Int {-^ @n@ (assumed >=0)-} -> +        t {-^ @x^n@ rounded outwards -}++-- functions providing an implementation derived from rounded multiplication: +        +type PowerToNonnegIntEffortIndicatorFromMult t =+    MultEffortIndicator t+    +powerToNonnegIntDefaultEffortFromMult a =+    multDefaultEffort a++powerToNonnegIntInEffFromMult ::+    (RoundedMultiply t, HasOne t) => +    PowerToNonnegIntEffortIndicatorFromMult t -> +    t -> Int -> t+powerToNonnegIntInEffFromMult effMult e n =+    powerFromMult (multInEff effMult) e n++powerToNonnegIntOutEffFromMult ::+    (RoundedMultiply t, HasOne t) => +    PowerToNonnegIntEffortIndicatorFromMult t -> +    t -> Int -> t+powerToNonnegIntOutEffFromMult effMult e n =+    powerFromMult (multOutEff effMult) e n++propInOutPowerMonotone ::+    (RefOrd.PartialComparison t, RoundedPowerToNonnegInt t,+     RefOrd.ArbitraryOrderedTuple t,  +     Show t, HasLegalValues t,+     Show (PowerToNonnegIntEffortIndicator t),+     EffortIndicator (PowerToNonnegIntEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    Int ->+    (PowerToNonnegIntEffortIndicator t) -> +    (RefOrd.LEPair t) -> +    (RefOrd.PartialCompareEffortIndicator t) ->+    Bool+propInOutPowerMonotone _ nR =+    roundedRefinementMonotone1 "non-neg integer power" powerNInEff powerNOutEff+    where+    n = nR `mod` 10+    powerNInEff eff x = powerToNonnegIntInEff eff x n+    powerNOutEff eff x = powerToNonnegIntOutEff eff x n+++propInOutPowerSumExponents ::+    (RefOrd.PartialComparison t,+     RoundedPowerToNonnegInt t, RoundedMultiply t, +     HasOne t, HasAntiConsistency t, Show t, HasLegalValues t,+     Show (PowerToNonnegIntEffortIndicator t),+     EffortIndicator (PowerToNonnegIntEffortIndicator t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (ConsistencyEffortIndicator t),+     EffortIndicator (ConsistencyEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (ConsistencyEffortIndicator t) -> +    (RefOrd.PartialCompareEffortIndicator t,+     (PowerToNonnegIntEffortIndicator t,+      MultEffortIndicator t)) ->+    (RefOrd.UniformlyOrderedSingleton t) -> +    Int -> Int -> Bool+propInOutPowerSumExponents _ effortConsistency initEffort +        (RefOrd.UniformlyOrderedSingleton a) nR mR =+    thinEqualConsLeqRoundingUpDnImprovement "a^n * a^m ⊑/⊒ a^(n+m)" [a]+        expr1Up expr1Dn expr2Up expr2Dn +        RefOrd.pLeqEff+        effortConsistency +        initEffort+    where+    n = nR `mod` 10+    m = mR `mod` 10+    expr1Up (effPower, effMult) =+        let (>^<) = powerToNonnegIntInEff effPower in+        let (>*<) = multInEff effMult in+        (a >^< n) >*< (a >^< m)+    expr1Dn (effPower, effMult) =+        let (<^>) = powerToNonnegIntOutEff effPower in+        let (<*>) = multOutEff effMult in+        (a <^> n) <*> (a <^> m)+    expr2Up (effPower, effMult) =+        let (>^<) = powerToNonnegIntInEff effPower in+        a >^< (n + m)+    expr2Dn (effPower, effMult) =+        let (<^>) = powerToNonnegIntOutEff effPower in+        a <^> (n + m)++testsInOutIntPower (name, sample) =+    testGroup (name ++ " non-negative integer power") $+        [+            testProperty "a^n * a^m ⊑/⊒ a^(n+m)" (propInOutPowerSumExponents sample)+            ,+            testProperty "refinement monotone" (propInOutPowerMonotone sample)+--            ,+--            testProperty "a/b=a*(1/b)" (propUpDnDivRecipMult sample)+        ]++class RoundedDivideEffort t where+    type DivEffortIndicator t+    divDefaultEffort :: t -> DivEffortIndicator t++class (HasOne t, RoundedDivideEffort t) => RoundedDivide t where+    divInEff :: DivEffortIndicator t -> t -> t -> t+    divOutEff :: DivEffortIndicator t -> t -> t -> t+    recipInEff :: DivEffortIndicator t -> t -> t+    recipOutEff :: DivEffortIndicator t -> t -> t+    recipInEff eff = divInEff eff one+    recipOutEff eff = divOutEff eff one+++propInOutDivMonotone ::+    (RefOrd.PartialComparison t, RoundedDivide t, +     Show t, HasLegalValues t,+     RefOrd.ArbitraryOrderedTuple t,  +     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (DivEffortIndicator t) -> +    (RefOrd.LEPair t) -> (RefOrd.LEPair t) -> +    (RefOrd.PartialCompareEffortIndicator t) ->+    Bool+propInOutDivMonotone _ =+    roundedRefinementMonotone2 "division" divInEff divOutEff++propInOutDivElim ::+    (RefOrd.PartialComparison t, RoundedDivide t, HasOne t, HasZero t,+     Show t, HasLegalValues t,+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     DivEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    Bool+propInOutDivElim _ efforts2@(effComp, _) (RefOrd.UniformlyOrderedSingleton a) =+    roundedReflexiveCollapse +        one +        RefOrd.pLeqEff +        divInEff divOutEff +        efforts2 +        a++propInOutDivRecipMult ::+    (RefOrd.PartialComparison t,+     RoundedMultiply t, RoundedDivide t, HasOne t, HasZero t,+     Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     (MultEffortIndicator t, DivEffortIndicator t)) -> +    (RefOrd.UniformlyOrderedPair t) -> +    Bool+propInOutDivRecipMult _ initEffort@(effComp,_) (RefOrd.UniformlyOrderedPair (e1, e2)) =+    equalRoundingUpDnBin2Var2 "a/b=a*(1/b)"+        expr1 expr2 RefOrd.pLeqEff+        multInEff divInEff+        multOutEff divOutEff+        initEffort e1 e2+    where+    expr1 op1Eff op2Eff (effort1, effort2) e1 e2 = +        e1 * (one / e2)+        where+        (*) = op1Eff effort1+        (/) = op2Eff effort2+    expr2 op1Eff op2Eff (effort1, effort2) e1 e2 = +        e1 / e2+        where+        (/) = op2Eff effort2++testsInOutDiv (name, sample) =+    testGroup (name ++ " </> >/<") $+        [+--            testProperty "a/a=1" (propInOutDivElim sample)+--            ,+            testProperty "a/b=a*(1/b)" (propInOutDivRecipMult sample)+        ,+            testProperty "refinement monotone" (propInOutDivMonotone sample)+        ]++class +        (RoundedAddEffort t, +         RoundedMultiplyEffort t, +         RoundedPowerToNonnegIntEffort t) => +    RoundedRingEffort t+    where+    type RingOpsEffortIndicator t+    ringOpsDefaultEffort :: t -> RingOpsEffortIndicator t+    ringEffortAdd :: t -> (RingOpsEffortIndicator t) -> (AddEffortIndicator t)+    ringEffortMult :: t ->  (RingOpsEffortIndicator t) -> (MultEffortIndicator t)+    ringEffortPow :: t -> (RingOpsEffortIndicator t) -> (PowerToNonnegIntEffortIndicator t)++class +        (RoundedAdd t, +         RoundedSubtr t, +         RoundedMultiply t, +         RoundedPowerToNonnegInt t,+         RoundedRingEffort t) => +    RoundedRing t+    +class (RoundedRingEffort t, RoundedDivideEffort t) => RoundedFieldEffort t where+    type FieldOpsEffortIndicator t+    fieldOpsDefaultEffort :: t -> FieldOpsEffortIndicator t+    fldEffortAdd :: t -> (FieldOpsEffortIndicator t) -> (AddEffortIndicator t)+    fldEffortMult :: t ->  (FieldOpsEffortIndicator t) -> (MultEffortIndicator t)+    fldEffortPow :: t -> (FieldOpsEffortIndicator t) -> (PowerToNonnegIntEffortIndicator t)+    fldEffortDiv :: t -> (FieldOpsEffortIndicator t) -> (DivEffortIndicator t)++class (RoundedRing t, RoundedDivide t, RoundedFieldEffort t) => RoundedField t
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/FieldOps.hs-boot view
@@ -0,0 +1,73 @@+{-+  this file is needed to break the following dependency cycles:++  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.Elementary+    imports: Numeric.AERN.RealArithmetic.Measures+             Numeric.AERN.RealArithmetic.Laws+             Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+             Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary+  Numeric.AERN.RealArithmetic.Measures+    imports: Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps+  Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps+    imports: Numeric.AERN.RealArithmetic.Measures+             Numeric.AERN.RealArithmetic.Laws+             Numeric.AERN.RealArithmetic.NumericOrderRounding+  Numeric.AERN.RealArithmetic.Laws+    imports: Numeric.AERN.RealArithmetic.Measures+  Numeric.AERN.RealArithmetic.NumericOrderRounding+    imports: Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace+             Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary+             Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps+             Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace+    imports: Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.Elementary+             Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.MixedFieldOps+             Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps+  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.MixedFieldOps+    imports: Numeric.AERN.RealArithmetic.Measures+             Numeric.AERN.RealArithmetic.Laws+             Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+             Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps+             Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps+  Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+    imports: Numeric.AERN.RealArithmetic.Measures+             Numeric.AERN.RealArithmetic.Laws+  Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps+    imports: Numeric.AERN.RealArithmetic.Measures+             Numeric.AERN.RealArithmetic.Laws+             Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+  Numeric.AERN.RealArithmetic.NumericOrderRounding.MixedFieldOps+    imports: Numeric.AERN.RealArithmetic.Measures+             Numeric.AERN.RealArithmetic.Laws+             Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+  Numeric.AERN.RealArithmetic.NumericOrderRounding.Elementary+    imports: Numeric.AERN.RealArithmetic.Measures+             Numeric.AERN.RealArithmetic.Laws+             Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps+  +-} ++{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ImplicitParams #-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps where++import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion++import Numeric.AERN.Basics.Effort+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd++class RoundedAddEffort t where+    type AddEffortIndicator t+    addDefaultEffort :: t -> AddEffortIndicator t++class (RoundedAddEffort t) => RoundedAdd t where+    addInEff :: AddEffortIndicator t -> t -> t -> t+    addOutEff :: AddEffortIndicator t -> t -> t -> t++class (RoundedAdd t, Neg t) => RoundedSubtr t where+    subtrInEff :: (AddEffortIndicator t) -> t -> t -> t+    subtrOutEff :: (AddEffortIndicator t) -> t -> t -> t+    subtrInEff effort a b = addInEff effort a (neg b)+    subtrOutEff effort a b = addOutEff effort a (neg b)
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/InPlace.hs view
@@ -0,0 +1,25 @@+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace+    Description :  common arithmetical operations rounded up/down  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    In-place versions of common arithmetical operations rounded in/out.+    +    This module is hidden and reexported via its parent RefinementOrderRounding. +-}+module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace+(+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.FieldOps,+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.MixedFieldOps,+    module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.Elementary,+)+where++import Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.FieldOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.MixedFieldOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.Elementary
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/InPlace/Elementary.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.Elementary+    Description :  support for various common elementary functions+    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Support for various common elementary functions.+    +    This module is hidden and reexported via its parent RefinementOrderRounding.InPlace. +-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.Elementary where++import Numeric.AERN.RealArithmetic.RefinementOrderRounding.Elementary++import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception (HasLegalValues)+import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class (RoundedExponentiationEffort t, CanBeMutable t) => +    RoundedExponentiationInPlace t +    where+    expInInPlaceEff :: OpMutable1Eff (ExpEffortIndicator t) t s+    expOutInPlaceEff :: OpMutable1Eff (ExpEffortIndicator t) t s++expInInPlaceEffFromPure,+ expOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedExponentiation t) =>+    OpMutable1Eff (ExpEffortIndicator t) t s+expInInPlaceEffFromPure =+    pureToMutable1Eff expInEff+expOutInPlaceEffFromPure =+    pureToMutable1Eff expOutEff++expInInPlaceEffFromInPlace,+ expOutInPlaceEffFromInPlace ::+    (RoundedExponentiationInPlace t) =>+    (ExpEffortIndicator t) -> t -> t+expInInPlaceEffFromInPlace = +    mutable1EffToPure expInInPlaceEff +expOutInPlaceEffFromInPlace = +    mutable1EffToPure expOutInPlaceEff ++propInOutExpInPlace ::+    (RefOrd.PartialComparison t, +     RoundedExponentiationInPlace t, +     RoundedExponentiation t, +     Neg t,+     Show t, HasLegalValues t,+     Show (ExpEffortIndicator t),+     EffortIndicator (ExpEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     ExpEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    Bool+propInOutExpInPlace sample initEffort (RefOrd.UniformlyOrderedSingleton e1) =+    equalRoundingUpDn "in-place exp"+        expr1In expr1Out expr2In expr2Out +        RefOrd.pLeqEff initEffort+    where+    expInEffViaInPlace = mutable1EffToPure expInInPlaceEff+    expOutEffViaInPlace = mutable1EffToPure expOutInPlaceEff+    expr1In eff = expInEff eff e1+    expr1Out eff = expOutEff eff e1+    expr2In eff = expInEffViaInPlace eff e1+    expr2Out eff = expOutEffViaInPlace eff e1++testsInOutExpInPlace (name, sample) =+    testGroup (name ++ " in-place exp") $+        [+            testProperty "matches pure" (propInOutExpInPlace sample)+        ]++class (RoundedSquareRootEffort t, CanBeMutable t) => +    RoundedSquareRootInPlace t +    where+    sqrtInInPlaceEff :: OpMutable1Eff (SqrtEffortIndicator t) t s+    sqrtOutInPlaceEff :: OpMutable1Eff (SqrtEffortIndicator t) t s++sqrtInInPlaceEffFromPure,+ sqrtOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedSquareRoot t) =>+    OpMutable1Eff (SqrtEffortIndicator t) t s+sqrtInInPlaceEffFromPure =+    pureToMutable1Eff sqrtInEff+sqrtOutInPlaceEffFromPure =+    pureToMutable1Eff sqrtOutEff++sqrtInInPlaceEffFromInPlace,+ sqrtOutInPlaceEffFromInPlace ::+    (RoundedSquareRootInPlace t) =>+    (SqrtEffortIndicator t) -> t -> t +sqrtInInPlaceEffFromInPlace = +    mutable1EffToPure sqrtInInPlaceEff +sqrtOutInPlaceEffFromInPlace = +    mutable1EffToPure sqrtOutInPlaceEff ++propInOutSqrtInPlace ::+    (RefOrd.PartialComparison t, +     RoundedSquareRootInPlace t, +     RoundedSquareRoot t, +     Neg t,+     Show t, HasLegalValues t,+     Show (SqrtEffortIndicator t),+     EffortIndicator (SqrtEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (tInArea -> t) ->+    (RefOrd.PartialCompareEffortIndicator t, +     SqrtEffortIndicator t) -> +    tInArea -> +    Bool+propInOutSqrtInPlace sample fromArea initEffort e1InArea =+    equalRoundingUpDn "in-place sqrt"+        sqrtr1In sqrtr1Out sqrtr2In sqrtr2Out +        RefOrd.pLeqEff initEffort+    where+    e1Pos = fromArea e1InArea+    sqrtInEffViaInPlace = mutable1EffToPure sqrtInInPlaceEff+    sqrtOutEffViaInPlace = mutable1EffToPure sqrtOutInPlaceEff+    sqrtr1In eff = sqrtInEff eff e1Pos+    sqrtr1Out eff = sqrtOutEff eff e1Pos+    sqrtr2In eff = sqrtInEffViaInPlace eff e1Pos+    sqrtr2Out eff = sqrtOutEffViaInPlace eff e1Pos++testsInOutSqrtInPlace (name, sample) fromArea =+    testGroup (name ++ " in-place sqrt") $+        [+            testProperty "matches pure" (propInOutSqrtInPlace sample fromArea)+        ]+
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/InPlace/FieldOps.hs view
@@ -0,0 +1,352 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE RankNTypes #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.FieldOps+    Description :  rounded basic arithmetic operations  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    In-place versions of rounded basic arithmetic operations.+    +    Each operations takes mutable parameters instead of pure parameters+    and has one extra mutable parameter before the other parameters, +    in which it stores the result.+    The mutable parameters can alias arbitrarily, making it possible+    to eg add to a number overwriting the original number.+    +    The operations have as their first paramter a non-mutable sample value+    to aid type-checking, ie to help work out which type the mutable parameters+    contain.+    +    This module is hidden and reexported via its parent RefinementOrderRounding.InPlace. +-}+module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.FieldOps +where++import Prelude hiding (EQ, LT, GT)+import Numeric.AERN.Basics.PartialOrdering++import Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps++import Numeric.AERN.RealArithmetic.Auxiliary+import Numeric.AERN.RealArithmetic.ExactOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception (HasLegalValues)+import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd+import Numeric.AERN.Basics.RefinementOrder.OpsImplicitEffort++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Control.Monad.ST+import Data.Maybe++class (RoundedAddEffort t, CanBeMutable t) => RoundedAddInPlace t where+    addInInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s+    addOutInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s++addInInPlaceEffFromPure,+ addOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedAdd t) =>+    OpMutable2Eff (AddEffortIndicator t) t s+addInInPlaceEffFromPure = pureToMutable2Eff addInEff +addOutInPlaceEffFromPure = pureToMutable2Eff addOutEff ++addInInPlaceEffFromInPlace,+ addOutInPlaceEffFromInPlace :: +    (RoundedAddInPlace t) =>+    (AddEffortIndicator t) -> t -> t -> t+addInInPlaceEffFromInPlace = mutable2EffToPure addInInPlaceEff +addOutInPlaceEffFromInPlace = mutable2EffToPure addOutInPlaceEff ++propInOutAddInPlace ::+    (RefOrd.PartialComparison t, +     RoundedAddInPlace t, +     RoundedAdd t, +     Neg t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (RefOrd.UniformlyOrderedPair t) -> Bool+propInOutAddInPlace sample initEffort (RefOrd.UniformlyOrderedPair (e1, e2)) =+    roundedInPlace2ConsistentWithPure "addition"+        addInInPlaceEff addOutInPlaceEff addInEff addOutEff+        RefOrd.pLeqEff initEffort+        e1 e2++class (RoundedAddInPlace t, NegInPlace t) => RoundedSubtrInPlace t where+    subtrInInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s+    subtrOutInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s+    subtrInInPlaceEff effort rM aM bM =+        do+        bbM <- cloneMutable bM+        negInPlace bbM bM+        addInInPlaceEff effort rM aM bbM+    subtrOutInPlaceEff effort rM aM bM = +        do+        bbM <- cloneMutable bM+        negInPlace bbM bM+        addOutInPlaceEff effort rM aM bbM++propInOutSubtrInPlace ::+    (RefOrd.PartialComparison t, +     RoundedSubtrInPlace t, +     RoundedSubtr t, +     Neg t,+     Show t, HasLegalValues t,+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AddEffortIndicator t) -> +    (RefOrd.UniformlyOrderedPair t) -> Bool+propInOutSubtrInPlace sample initEffort (RefOrd.UniformlyOrderedPair (e1, e2)) =+    roundedInPlace2ConsistentWithPure "subtraction"+        subtrInInPlaceEff subtrOutInPlaceEff subtrInEff subtrOutEff+        RefOrd.pLeqEff initEffort+        e1 e2++class (RoundedAbs t, CanBeMutable t) => RoundedAbsInPlace t where+    absInInPlaceEff :: OpMutable1Eff (AbsEffortIndicator t) t s+    absOutInPlaceEff :: OpMutable1Eff (AbsEffortIndicator t) t s+    absInInPlaceEff = pureToMutable1Eff absInEff +    absOutInPlaceEff = pureToMutable1Eff absOutEff ++propInOutAbsInPlace ::+    (RefOrd.PartialComparison t, RoundedAbsInPlace t, Neg t,+     Show t, HasLegalValues t,+     Show (AbsEffortIndicator t),+     EffortIndicator (AbsEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     AbsEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> Bool+propInOutAbsInPlace sample initEffort (RefOrd.UniformlyOrderedSingleton e) =+    roundedInPlace1ConsistentWithPure "abs"+        absInInPlaceEff absOutInPlaceEff absInEff absOutEff+        RefOrd.pLeqEff initEffort+        e+++class (RoundedMultiplyEffort t, CanBeMutable t) => RoundedMultiplyInPlace t where+    multInInPlaceEff :: OpMutable2Eff (MultEffortIndicator t) t s+    multOutInPlaceEff :: OpMutable2Eff (MultEffortIndicator t) t s++multInInPlaceEffFromPure,+ multOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedMultiply t) =>+    OpMutable2Eff (MultEffortIndicator t) t s+multInInPlaceEffFromPure = pureToMutable2Eff multInEff +multOutInPlaceEffFromPure = pureToMutable2Eff multOutEff ++multInInPlaceEffFromInPlace,+ multOutInPlaceEffFromInPlace ::+    (RoundedMultiplyInPlace t) =>+    (MultEffortIndicator t) -> t -> t -> t+multInInPlaceEffFromInPlace = mutable2EffToPure multInInPlaceEff +multOutInPlaceEffFromInPlace = mutable2EffToPure multOutInPlaceEff ++propInOutMultInPlace ::+    (RefOrd.PartialComparison t, +     RoundedMultiplyInPlace t, +     RoundedMultiply t, +     Neg t,+     Show t, HasLegalValues t,+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     MultEffortIndicator t) -> +    (RefOrd.UniformlyOrderedPair t) -> Bool+propInOutMultInPlace sample initEffort (RefOrd.UniformlyOrderedPair (e1, e2)) =+    roundedInPlace2ConsistentWithPure "multiplication"+        multInInPlaceEff multOutInPlaceEff multInEff multOutEff+        RefOrd.pLeqEff initEffort+        e1 e2++powerToNonnegIntInInPlaceEffFromMult ::+    (RoundedMultiplyInPlace t, HasOne t) =>+    OpMutableNonmutEff (PowerToNonnegIntEffortIndicatorFromMult t) t Int s +powerToNonnegIntInInPlaceEffFromMult effMult rM eM n =+    powerFromMultInPlace (multInInPlaceEff effMult) rM eM n++powerToNonnegIntOutInPlaceEffFromMult ::+    (RoundedMultiplyInPlace t, HasOne t) =>+    OpMutableNonmutEff (PowerToNonnegIntEffortIndicatorFromMult t) t Int s +powerToNonnegIntOutInPlaceEffFromMult effMult rM eM n =+    powerFromMultInPlace (multOutInPlaceEff effMult) rM eM n+++class (RoundedPowerToNonnegIntEffort t, CanBeMutable t) => +    RoundedPowerToNonnegIntInPlace t +    where+    powerToNonnegIntInInPlaceEff ::+        OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s+    powerToNonnegIntOutInPlaceEff ::+        OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s++powerToNonnegIntInInPlaceEffFromPure,+ powerToNonnegIntOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedPowerToNonnegInt t) =>+    OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s+powerToNonnegIntInInPlaceEffFromPure =+    pureToMutableNonmutEff powerToNonnegIntInEff +powerToNonnegIntOutInPlaceEffFromPure =+    pureToMutableNonmutEff powerToNonnegIntOutEff ++powerToNonnegIntInInPlaceEffFromInPlace,+ powerToNonnegIntOutInPlaceEffFromInPlace ::+    (RoundedPowerToNonnegIntInPlace t) =>+    (PowerToNonnegIntEffortIndicator t) -> t -> Int -> t+powerToNonnegIntInInPlaceEffFromInPlace = +    mutableNonmutEffToPure powerToNonnegIntInInPlaceEff +powerToNonnegIntOutInPlaceEffFromInPlace = +    mutableNonmutEffToPure powerToNonnegIntOutInPlaceEff++propInOutPowerToNonnegInPlace ::+    (RefOrd.PartialComparison t, +     RoundedPowerToNonnegIntInPlace t, +     RoundedPowerToNonnegInt t, +     Neg t,+     Show t, HasLegalValues t,+     Show (PowerToNonnegIntEffortIndicator t),+     EffortIndicator (PowerToNonnegIntEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     PowerToNonnegIntEffortIndicator t) -> +    (RefOrd.UniformlyOrderedSingleton t) -> Int -> Bool+propInOutPowerToNonnegInPlace sample initEffort (RefOrd.UniformlyOrderedSingleton e) n =+    roundedInPlace1ConsistentWithPure "non-neg integer power"+        (\eff r e -> powerToNonnegIntInInPlaceEff eff r e n) +        (\eff r e -> powerToNonnegIntOutInPlaceEff eff r e n) +        (\eff e -> powerToNonnegIntInEff eff e n) +        (\eff e -> powerToNonnegIntOutEff eff e n)+        RefOrd.pLeqEff initEffort+        e++class (HasOne t, RoundedDivideEffort t, CanBeMutable t) => RoundedDivideInPlace t where+    divInInPlaceEff :: OpMutable2Eff (DivEffortIndicator t) t s+    divOutInPlaceEff :: OpMutable2Eff (DivEffortIndicator t) t s+    recipInInPlaceEff :: OpMutable1Eff (DivEffortIndicator t) t s+    recipOutInPlaceEff :: OpMutable1Eff (DivEffortIndicator t) t s+    +    recipInInPlaceEff effort resM aM =+        do+        oneM <- unsafeMakeMutable one+        divInInPlaceEff effort resM oneM aM+    recipOutInPlaceEff effort resM aM =+        do+        oneM <- unsafeMakeMutable one+        divOutInPlaceEff effort resM oneM aM++divInInPlaceEffFromPure,+ divOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedDivide t) =>+    OpMutable2Eff (DivEffortIndicator t) t s+divInInPlaceEffFromPure = pureToMutable2Eff divInEff +divOutInPlaceEffFromPure = pureToMutable2Eff divOutEff ++divInInPlaceEffFromInPlace,+ divOutInPlaceEffFromInPlace :: +    (RoundedDivideInPlace t) =>+    (DivEffortIndicator t) -> t -> t -> t +divInInPlaceEffFromInPlace = mutable2EffToPure divInInPlaceEff +divOutInPlaceEffFromInPlace = mutable2EffToPure divOutInPlaceEff ++recipInInPlaceEffFromPure,+ recipOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedDivide t) =>+    OpMutable1Eff (DivEffortIndicator t) t s+recipInInPlaceEffFromPure = pureToMutable1Eff recipInEff +recipOutInPlaceEffFromPure = pureToMutable1Eff recipOutEff ++recipInInPlaceEffFromInPlace,+ recipOutInPlaceEffFromInPlace ::+    (RoundedDivideInPlace t) =>+    (DivEffortIndicator t) -> t -> t+recipInInPlaceEffFromInPlace = mutable1EffToPure recipInInPlaceEff +recipOutInPlaceEffFromInPlace = mutable1EffToPure recipOutInPlaceEff ++propInOutDivInPlace ::+    (RefOrd.PartialComparison t, +     RoundedDivideInPlace t, +     RoundedDivide t, +     Neg t,+     Show t, HasZero t, HasLegalValues t,+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t ->+    (RefOrd.PartialCompareEffortIndicator t, +     DivEffortIndicator t) -> +    (RefOrd.UniformlyOrderedPair t) -> Bool+propInOutDivInPlace sample initEffort@(effComp, _) (RefOrd.UniformlyOrderedPair (e1, e2)) +    =+    roundedInPlace2ConsistentWithPure "division"+        divInInPlaceEff divOutInPlaceEff divInEff divOutEff+        RefOrd.pLeqEff initEffort+        e1 e2++testsInOutFieldOpsInPlace (name, sample) =+    testGroup (name ++ " in-place up/down rounded ops match pure ops") $+        [+            testProperty "addition" (propInOutAddInPlace sample)+        ,+            testProperty "subtraction" (propInOutSubtrInPlace sample)+        ,+            testProperty "absolute value" (propInOutAbsInPlace sample)+        ,+            testProperty "multiplication" (propInOutMultInPlace sample)+        ,+            testProperty "integer power" (propInOutMultInPlace sample)+        ,+            testProperty "division" (propInOutDivInPlace sample)+        ]+++class +        (RoundedSubtrInPlace t, +         RoundedMultiplyInPlace t, +         RoundedRingEffort t) => +    RoundedRingInPlace t++class+        (RoundedRingInPlace t,+         RoundedDivideInPlace t,+         RoundedFieldEffort t) => +    RoundedFieldInPlace t++
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/InPlace/MixedFieldOps.hs view
@@ -0,0 +1,315 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.MixedFieldOps+    Description :  rounded basic arithmetic operations mixing 2 types+    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    In-place versions of rounded basic arithmetical operations mixing 2 types.+    +    This module is hidden and reexported via its parent "RefinementOrderRounding.InPlace". +-}+module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.MixedFieldOps where++import Numeric.AERN.RealArithmetic.RefinementOrderRounding.MixedFieldOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.FieldOps++import Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion+import Numeric.AERN.RealArithmetic.ExactOps++import Numeric.AERN.Basics.Exception+import Numeric.AERN.Basics.Mutable+import Numeric.AERN.Basics.Effort+import Numeric.AERN.RealArithmetic.Laws +import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd+import Numeric.AERN.Basics.RefinementOrder.OpsImplicitEffort++import Control.Monad.ST+import Control.Exception+import Data.Maybe++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class (RoundedMixedAddEffort t tn, CanBeMutable t) => +    RoundedMixedAddInPlace t tn +    where+    mixedAddInInPlaceEff :: +        OpMutableNonmutEff (MixedAddEffortIndicator t tn) t tn s+    mixedAddOutInPlaceEff :: +        OpMutableNonmutEff (MixedAddEffortIndicator t tn) t tn s++mixedAddInInPlaceEffFromPure,+ mixedAddOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedMixedAdd t tn) =>+    OpMutableNonmutEff (MixedAddEffortIndicator t tn) t tn s+mixedAddInInPlaceEffFromPure =+    pureToMutableNonmutEff mixedAddInEff+mixedAddOutInPlaceEffFromPure =+    pureToMutableNonmutEff mixedAddOutEff++mixedAddInInPlaceEffFromInPlace+ ,mixedAddOutInPlaceEffFromInPlace ::+    (RoundedMixedAddInPlace t tn) =>+    (MixedAddEffortIndicator t tn) -> t -> tn -> t +mixedAddInInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedAddInInPlaceEff+mixedAddOutInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedAddOutInPlaceEff ++{- properties of mixed addition -}++propMixedAddInPlaceEqualsConvert ::+    (RefOrd.PartialComparison t, Convertible tn t,+     RoundedMixedAddInPlace t tn, +     RoundedMixedAdd t tn, +     RoundedAdd t,+     Show t, HasLegalValues t,+     Show (MixedAddEffortIndicator t tn),+     EffortIndicator (MixedAddEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (RefOrd.PartialCompareEffortIndicator t,+     (MixedAddEffortIndicator t tn,      +      AddEffortIndicator t,+      ConvertEffortIndicator tn t)) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedAddInPlaceEqualsConvert sample1 sample2 initEffort +        (RefOrd.UniformlyOrderedSingleton d) n =+    equalRoundingUpDn "mixed in-place addition"+        expr1In expr1Out expr2In expr2Out +        RefOrd.pLeqEff initEffort+    where+    expr1In (effMAdd,_,_) =+        let (>+<|=) dR = mixedAddInInPlaceEff effMAdd dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR >+<|= n+            unsafeReadMutable dR+    expr1Out (effMAdd,_,_) =+        let (<+>|=) dR = mixedAddOutInPlaceEff effMAdd dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR <+>|= n+            unsafeReadMutable dR+    expr2In (_,effAdd,effConv) =+        let (>+<) = addInEff effAdd in (convertInEff effConv n) >+< d+    expr2Out (_,effAdd,effConv) =+        let (<+>) = addOutEff effAdd in (convertOutEff effConv n) <+> d++++class (RoundedMixedMultiplyEffort t tn, CanBeMutable t) => +    RoundedMixedMultiplyInPlace t tn +    where+    mixedMultInInPlaceEff :: +        OpMutableNonmutEff (MixedMultEffortIndicator t tn) t tn s+    mixedMultOutInPlaceEff :: +        OpMutableNonmutEff (MixedMultEffortIndicator t tn) t tn s++mixedMultInInPlaceEffFromPure,+ mixedMultOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedMixedMultiply t tn) =>+    OpMutableNonmutEff (MixedMultEffortIndicator t tn) t tn s+mixedMultInInPlaceEffFromPure =+    pureToMutableNonmutEff mixedMultInEff+mixedMultOutInPlaceEffFromPure =+    pureToMutableNonmutEff mixedMultOutEff++mixedMultInInPlaceEffFromInPlace,+ mixedMultOutInPlaceEffFromInPlace ::+    (RoundedMixedMultiplyInPlace t tn) =>+    (MixedMultEffortIndicator t tn) -> t -> tn -> t+mixedMultInInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedMultInInPlaceEff +mixedMultOutInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedMultOutInPlaceEff++{- properties of mixed multiplication -}++propMixedMultInPlaceEqualsConvert ::+    (RefOrd.PartialComparison t, Convertible tn t,+     RoundedMixedMultiplyInPlace t tn, +     RoundedMixedMultiply t tn, +     RoundedMultiply t,+     Show t, HasLegalValues t,+     Show (MixedMultEffortIndicator t tn),+     EffortIndicator (MixedMultEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (RefOrd.PartialCompareEffortIndicator t,+     (MixedMultEffortIndicator t tn,      +      MultEffortIndicator t,+      ConvertEffortIndicator tn t)) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedMultInPlaceEqualsConvert sample1 sample2 initEffort +        (RefOrd.UniformlyOrderedSingleton d) n =+    equalRoundingUpDn "in-place mixed multiplication"+        expr1In expr1Out expr2In expr2Out +        RefOrd.pLeqEff initEffort+    where+    expr1In (effMMult,_,_) =+        let (>*<|=) dR = mixedMultInInPlaceEff effMMult dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR >*<|= n+            unsafeReadMutable dR+    expr1Out (effMMult,_,_) =+        let (<*>|=) dR = mixedMultOutInPlaceEff effMMult dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR <*>|= n+            unsafeReadMutable dR+    expr2In (_,effMult,effConv) =+        let (>*<) = multInEff effMult in (convertInEff effConv n) >*< d+    expr2Out (_,effMult,effConv) =+        let (<*>) = multOutEff effMult in (convertOutEff effConv n) <*> d++class (RoundedMixedDivideEffort t tn, CanBeMutable t) => +    RoundedMixedDivideInPlace t tn +    where+    mixedDivInInPlaceEff :: +        OpMutableNonmutEff (MixedDivEffortIndicator t tn) t tn s+    mixedDivOutInPlaceEff :: +        OpMutableNonmutEff (MixedDivEffortIndicator t tn) t tn s++mixedDivInInPlaceEffFromPure,+ mixedDivOutInPlaceEffFromPure ::+    (CanBeMutable t, RoundedMixedDivide t tn) =>+    OpMutableNonmutEff (MixedDivEffortIndicator t tn) t tn s+mixedDivInInPlaceEffFromPure =+    pureToMutableNonmutEff mixedDivInEff+mixedDivOutInPlaceEffFromPure =+    pureToMutableNonmutEff mixedDivOutEff++mixedDivInInPlaceEffFromInPlace,+ mixedDivOutInPlaceEffFromInPlace ::+    (RoundedMixedDivideInPlace t tn) =>+    (MixedDivEffortIndicator t tn) -> t -> tn -> t +mixedDivInInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedDivInInPlaceEff +mixedDivOutInPlaceEffFromInPlace = +    mutableNonmutEffToPure mixedDivOutInPlaceEff++mixedDivInInPlaceEffByConversion ::+    (Convertible tn t, RoundedDivideInPlace t) =>+    (DivEffortIndicator t, ConvertEffortIndicator tn t) ->+    OpMutableNonmut t tn s+mixedDivInInPlaceEffByConversion (effDiv, effConv) rM dM n =+    do+    let nConverted = convertInEff effConv n+    nM <- unsafeMakeMutable nConverted+    divInInPlaceEff effDiv rM dM nM++mixedDivOutInPlaceEffByConversion ::+    (Convertible tn t, RoundedDivideInPlace t) =>+    (DivEffortIndicator t, ConvertEffortIndicator tn t) ->+    OpMutableNonmut t tn s+mixedDivOutInPlaceEffByConversion (effDiv, effConv) rM dM n =+    do+    let nConverted = convertOutEff effConv n+    nM <- unsafeMakeMutable nConverted+    divOutInPlaceEff effDiv rM dM nM++{- properties of mixed division -}++propMixedDivInPlaceEqualsConvert ::+    (RefOrd.PartialComparison t, Convertible tn t,+     RoundedMixedDivideInPlace t tn, +     RoundedMixedDivide t tn, +     RoundedDivide t,+     Show t, HasZero t, HasLegalValues t,+     Show (MixedDivEffortIndicator t tn),+     EffortIndicator (MixedDivEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (RefOrd.PartialCompareEffortIndicator t,+     (MixedDivEffortIndicator t tn,      +      DivEffortIndicator t,+      ConvertEffortIndicator tn t)) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedDivInPlaceEqualsConvert sample1 sample2+        initEffort@(effComp,(_,effConv,_)) +        (RefOrd.UniformlyOrderedSingleton d) n+    =+    equalRoundingUpDn "in-place mixed division"+        expr1In expr1Out expr2In expr2Out +        RefOrd.pLeqEff initEffort+    where+    expr1In (effMDiv,_,_) =+        let (>/<|=) dR = mixedDivInInPlaceEff effMDiv dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR >/<|= n+            unsafeReadMutable dR+    expr1Out (effMDiv,_,_) =+        let (</>|=) dR = mixedDivOutInPlaceEff effMDiv dR dR in+        runST $ +            do+            dR <- makeMutable d+            dR </>|= n+            unsafeReadMutable dR+    expr2In (_,effDiv,effConv) =+        let (>/<) = divInEff effDiv in d >/< (convertInEff effConv n)+    expr2Out (_,effDiv,effConv) =+        let (</>) = divOutEff effDiv in d </> (convertOutEff effConv n)+    +testsInOutMixedFieldOpsInPlace (name, sample) (nameN, sampleN) =+    testGroup (name ++ " with " ++ nameN ++ ": in-place mixed up/dn rounded ops") $+        [+            testProperty "addition" (propMixedAddInPlaceEqualsConvert sample sampleN)+        ,+            testProperty "multiplication" (propMixedMultInPlaceEqualsConvert sample sampleN)+        ,+            testProperty "division" (propMixedDivInPlaceEqualsConvert sample sampleN)+        ]++class +        (RoundedMixedAddInPlace t tn, +         RoundedMixedMultiplyInPlace t tn,+         RoundedMixedRingEffort t tn) => +    RoundedMixedRingInPlace t tn++class +        (RoundedMixedRingInPlace t tn, +         RoundedMixedDivideInPlace t tn, +         RoundedMixedFieldEffort t tn) => +    RoundedMixedFieldInPlace t tn+
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/InPlace/OpsDefaultEffort.hs view
@@ -0,0 +1,200 @@+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsDefaultEffort+    Description :  convenience in-place operators and functions with default effort  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Convenience in-place operators and functions with default effort.+-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsDefaultEffort where++import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.RefinementOrderRounding++infixl 6 <+>=, >+<=, <->=, >-<=+infixl 7 <*>=, >*<=+infixl 8 <^>=, >^<=+infixl 7 </>=, >/<=++infixl 6 <+>|=, >+<|=+infixl 7 <*>|=, >*<|=+infixl 7 </>|=, >/<|=++-- | Inward rounded in-place addition+addInInPlace :: (RoundedAddInPlace t) => OpMutable2 t s+addInInPlace = mutable2EffToMutable2 addInInPlaceEff addDefaultEffort++-- | Inward rounded addition assignment+(>+<=) :: (RoundedAddInPlace t) => OpMutable1 t s+(>+<=) = mutable2ToMutable1 addInInPlace++-- | Outward rounded in-place addition+addOutInPlace :: (RoundedAddInPlace t) => OpMutable2 t s+addOutInPlace = mutable2EffToMutable2 addOutInPlaceEff addDefaultEffort ++-- | Outward rounded addition assignment+(<+>=) :: (RoundedAddInPlace t) => OpMutable1 t s+(<+>=) = mutable2ToMutable1 addOutInPlace++-- | Inward rounded in-place subtraction+subtrInInPlace :: (RoundedSubtrInPlace t) => OpMutable2 t s+subtrInInPlace = mutable2EffToMutable2 subtrInInPlaceEff addDefaultEffort++-- | Inward rounded subtraction assignment+(>-<=) :: (RoundedSubtrInPlace t) => OpMutable1 t s+(>-<=) = mutable2ToMutable1 subtrInInPlace++-- | Outward rounded in-place subtraction+subtrOutInPlace :: (RoundedSubtrInPlace t) => OpMutable2 t s+subtrOutInPlace = mutable2EffToMutable2 subtrOutInPlaceEff addDefaultEffort++-- | Outward rounded subtraction assignment+(<->=) :: (RoundedSubtrInPlace t) => OpMutable1 t s+(<->=) = mutable2ToMutable1 subtrOutInPlace++-- | Inward rounded in-place absolute value+absInInPlace :: (RoundedAbsInPlace t) => OpMutable1 t s+absInInPlace = mutable1EffToMutable1 absInInPlaceEff absDefaultEffort ++-- | Outward rounded in-place absolute value+absOutInPlace :: (RoundedAbsInPlace t) => OpMutable1 t s+absOutInPlace = mutable1EffToMutable1 absOutInPlaceEff absDefaultEffort ++-- | Inward rounded in-place multiplication+multInInPlace :: (RoundedMultiplyInPlace t) => OpMutable2 t s+multInInPlace = mutable2EffToMutable2 multInInPlaceEff multDefaultEffort++-- | Inward rounded multiplication assignment+(>*<=) :: (RoundedMultiplyInPlace t) => OpMutable1 t s+(>*<=) = mutable2ToMutable1 multInInPlace++-- | Outward rounded in-place multiplication+multOutInPlace :: (RoundedMultiplyInPlace t) => OpMutable2 t s+multOutInPlace = mutable2EffToMutable2 multOutInPlaceEff multDefaultEffort++-- | Outward rounded multiplication assignment+(<*>=) :: (RoundedMultiplyInPlace t) => OpMutable1 t s+(<*>=) = mutable2ToMutable1 multOutInPlace++-- | Inward rounded in-place power+powerToNonnegIntInInPlace :: (RoundedPowerToNonnegIntInPlace t) => +    OpMutableNonmut t Int s+powerToNonnegIntInInPlace = +    mutableNonmutEffToMutableNonmut powerToNonnegIntInInPlaceEff powerToNonnegIntDefaultEffort++-- | Inward rounded in-place power assignment+(>^<=) :: (RoundedPowerToNonnegIntInPlace t) => OpNonmut t Int s+(>^<=) = mutableNonmutToNonmut powerToNonnegIntInInPlace++-- | Outward rounded in-place power+powerToNonnegIntOutInPlace :: (RoundedPowerToNonnegIntInPlace t) => +    OpMutableNonmut t Int s+powerToNonnegIntOutInPlace = +    mutableNonmutEffToMutableNonmut powerToNonnegIntOutInPlaceEff powerToNonnegIntDefaultEffort++-- | Inward rounded in-place power assignment+(<^>=) :: (RoundedPowerToNonnegIntInPlace t) => OpNonmut t Int s+(<^>=) = mutableNonmutToNonmut powerToNonnegIntOutInPlace++-- | Inward rounded in-place division+divInInPlace :: (RoundedDivideInPlace t) => OpMutable2 t s+divInInPlace = mutable2EffToMutable2 divInInPlaceEff divDefaultEffort++-- | Inward rounded division assignment+(>/<=) :: (RoundedDivideInPlace t) => OpMutable1 t s+(>/<=) = mutable2ToMutable1 divInInPlace++-- | Outward rounded in-place division+divOutInPlace :: (RoundedDivideInPlace t) => OpMutable2 t s+divOutInPlace = mutable2EffToMutable2 divOutInPlaceEff divDefaultEffort++-- | Outward rounded division assignment+(</>=) :: (RoundedDivideInPlace t) => OpMutable1 t s+(</>=) = mutable2ToMutable1 divOutInPlace++-- | Inward rounded in-place mixed addition+mixedAddInInPlace :: (RoundedMixedAddInPlace t tn) => +    OpMutableNonmut t tn s+mixedAddInInPlace =+    mixedEffToMutableNonmut mixedAddInInPlaceEff mixedAddDefaultEffort++-- | Inward rounded additive scalar action assignment+(>+<|=) :: (RoundedMixedAddInPlace t tn) => OpNonmut t tn s+(>+<|=) = mutableNonmutToNonmut mixedAddInInPlace++-- | Outward rounded in-place mixed addition+mixedAddOutInPlace :: (RoundedMixedAddInPlace t tn) =>+    OpMutableNonmut t tn s+mixedAddOutInPlace =+    mixedEffToMutableNonmut mixedAddOutInPlaceEff mixedAddDefaultEffort++-- | Outward rounded additive scalar action assignment+(<+>|=) :: (RoundedMixedAddInPlace t tn) => OpNonmut t tn s+(<+>|=) = mutableNonmutToNonmut mixedAddOutInPlace++-- | Inward rounded in-place mixed multiplication+mixedMultInInPlace :: (RoundedMixedMultiplyInPlace t tn) => +    OpMutableNonmut t tn s+mixedMultInInPlace =+    mixedEffToMutableNonmut mixedMultInInPlaceEff mixedMultDefaultEffort++-- | Inward rounded multiplicative scalar action assignment+(>*<|=) :: (RoundedMixedMultiplyInPlace t tn) => OpNonmut t tn s+(>*<|=) = mutableNonmutToNonmut mixedMultInInPlace++-- | Outward rounded in-place mixed multiplication+mixedMultOutInPlace :: (RoundedMixedMultiplyInPlace t tn) => +    OpMutableNonmut t tn s+mixedMultOutInPlace =+    mixedEffToMutableNonmut mixedMultOutInPlaceEff mixedMultDefaultEffort++-- | Outward rounded multiplicative scalar action assignment+(<*>|=) :: (RoundedMixedMultiplyInPlace t tn) => OpNonmut t tn s+(<*>|=) = mutableNonmutToNonmut mixedMultOutInPlace++-- | Inward rounded in-place mixed reciprocal action+mixedDivInInPlace :: (RoundedMixedDivideInPlace t tn) => +    OpMutableNonmut t tn s+mixedDivInInPlace =+    mixedEffToMutableNonmut mixedDivInInPlaceEff mixedDivDefaultEffort++-- | Inward rounded multiplicative scalar reciprocal action assignment+(>/<|=) :: (RoundedMixedDivideInPlace t tn) => OpNonmut t tn s+(>/<|=) = mutableNonmutToNonmut mixedDivOutInPlace++-- | Outward rounded in-place mixed reciprocal action+mixedDivOutInPlace :: (RoundedMixedDivideInPlace t tn) => +    OpMutableNonmut t tn s+mixedDivOutInPlace =+    mixedEffToMutableNonmut mixedDivOutInPlaceEff mixedDivDefaultEffort++-- | Outward rounded multiplicative scalar reciprocal action assignment+(</>|=) :: (RoundedMixedDivideInPlace t tn) => OpNonmut t tn s+(</>|=) = mutableNonmutToNonmut mixedDivOutInPlace++-- | Inward rounded in-place exponential+expInInPlace :: (RoundedExponentiationInPlace t) => OpMutable1 t s+expInInPlace = mutable1EffToMutable1 expInInPlaceEff expDefaultEffort ++-- | Outward rounded in-place exponential+expOutInPlace :: (RoundedExponentiationInPlace t) => OpMutable1 t s+expOutInPlace = mutable1EffToMutable1 expOutInPlaceEff expDefaultEffort ++-- | Inward rounded in-place square root+sqrtInInPlace :: (RoundedSquareRootInPlace t) => OpMutable1 t s+sqrtInInPlace = mutable1EffToMutable1 sqrtInInPlaceEff sqrtDefaultEffort ++-- | Outward rounded in-place square root+sqrtOutInPlace :: (RoundedSquareRootInPlace t) => OpMutable1 t s+sqrtOutInPlace = mutable1EffToMutable1 sqrtOutInPlaceEff sqrtDefaultEffort ++++++
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/InPlace/OpsImplicitEffort.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsImplicitEffort+    Description :  onvenience directed-rounded in-place operators and functions with implicit effort parameters  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Convenience directed-rounded in-place operators and functions with implicit effort parameters.+-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsImplicitEffort where++import Numeric.AERN.Basics.Mutable+import Numeric.AERN.RealArithmetic.RefinementOrderRounding++-- | Inward rounded in-place addition+addInInPlace :: +    (RoundedAddInPlace t, ?addInOutEffort :: AddEffortIndicator t) => +    OpMutable2 t s+addInInPlace = addInInPlaceEff ?addInOutEffort++-- | Inward rounded addition assignment+(>+<=) :: +    (RoundedAddInPlace t, ?addInOutEffort :: AddEffortIndicator t) => +    OpMutable1 t s+(>+<=) = mutable2ToMutable1 addInInPlace++-- | Outward rounded in-place addition+addOutInPlace :: +    (RoundedAddInPlace t, ?addInOutEffort :: AddEffortIndicator t) => +    OpMutable2 t s+addOutInPlace = addOutInPlaceEff ?addInOutEffort++-- | Outward rounded addition assignment+(<+>=) :: +    (RoundedAddInPlace t, ?addInOutEffort :: AddEffortIndicator t) => +    OpMutable1 t s+(<+>=) = mutable2ToMutable1 addOutInPlace++-- | Inward rounded in-place subtraction+subtrInInPlace :: +    (RoundedSubtrInPlace t, ?addInOutEffort :: AddEffortIndicator t) => +    OpMutable2 t s+subtrInInPlace = subtrInInPlaceEff ?addInOutEffort++-- | Inward rounded subtraction assignment+(>-<=) :: +    (RoundedSubtrInPlace t, ?addInOutEffort :: AddEffortIndicator t) => +    OpMutable1 t s+(>-<=) = mutable2ToMutable1 subtrInInPlace++-- | Outward rounded in-place subtraction+subtrOutInPlace :: +    (RoundedSubtrInPlace t, ?addInOutEffort :: AddEffortIndicator t) => +    OpMutable2 t s+subtrOutInPlace = subtrOutInPlaceEff ?addInOutEffort++-- | Outward rounded subtraction assignment+(<->=) :: +    (RoundedSubtrInPlace t, ?addInOutEffort :: AddEffortIndicator t) => +    OpMutable1 t s+(<->=) = mutable2ToMutable1 subtrOutInPlace++-- | Inward rounded in-place absolute value+absInInPlace ::+    (RoundedAbsInPlace t, ?absInOutEffort :: AbsEffortIndicator t) => +    OpMutable1 t s+absInInPlace = absInInPlaceEff ?absInOutEffort++-- | Outward rounded in-place absolute value+absOutInPlace ::+    (RoundedAbsInPlace t, ?absInOutEffort :: AbsEffortIndicator t) => +    OpMutable1 t s+absOutInPlace = absOutInPlaceEff ?absInOutEffort++-- | Inward rounded in-place multiplication+multInInPlace :: +    (RoundedMultiplyInPlace t, ?multInOutEffort :: MultEffortIndicator t) => +    OpMutable2 t s+multInInPlace = multInInPlaceEff ?multInOutEffort++-- | Inward rounded multiplication assignment+(>*<=) :: +    (RoundedMultiplyInPlace t, ?multInOutEffort :: MultEffortIndicator t) => +    OpMutable1 t s+(>*<=) = mutable2ToMutable1 multInInPlace++-- | Outward rounded in-place multiplication+multOutInPlace :: +    (RoundedMultiplyInPlace t, ?multInOutEffort :: MultEffortIndicator t) => +    OpMutable2 t s+multOutInPlace = multOutInPlaceEff ?multInOutEffort++-- | Outward rounded multiplication assignment+(<*>=) :: +    (RoundedMultiplyInPlace t, ?multInOutEffort :: MultEffortIndicator t) => +    OpMutable1 t s+(<*>=) = mutable2ToMutable1 multOutInPlace++-- | Inward rounded in-place power+powerToNonnegIntInInPlace :: +    (RoundedPowerToNonnegIntInPlace t, +     ?intPowerInOutEffort :: PowerToNonnegIntEffortIndicator t) => +    OpMutableNonmut t Int s+powerToNonnegIntInInPlace = powerToNonnegIntInInPlaceEff ?intPowerInOutEffort++-- | Inward rounded in-place power assignment+(>^<=)  :: +    (RoundedPowerToNonnegIntInPlace t, +     ?intPowerInOutEffort :: PowerToNonnegIntEffortIndicator t) => +    OpNonmut t Int s+(>^<=) = mutableNonmutToNonmut powerToNonnegIntInInPlace++-- | Outward rounded in-place power+powerToNonnegIntOutInPlace :: +    (RoundedPowerToNonnegIntInPlace t, +     ?intPowerInOutEffort :: PowerToNonnegIntEffortIndicator t) => +    OpMutableNonmut t Int s+powerToNonnegIntOutInPlace = powerToNonnegIntOutInPlaceEff ?intPowerInOutEffort++-- | Inward rounded in-place power assignment+(<^>=)  :: +    (RoundedPowerToNonnegIntInPlace t, +     ?intPowerInOutEffort :: PowerToNonnegIntEffortIndicator t) => +    OpNonmut t Int s+(<^>=) = mutableNonmutToNonmut powerToNonnegIntOutInPlace++-- | Inward rounded in-place division+divInInPlace :: +    (RoundedDivideInPlace t, ?divInOutEffort :: DivEffortIndicator t) => +    OpMutable2 t s+divInInPlace = divInInPlaceEff ?divInOutEffort++-- | Inward rounded division assignment+(>/<=) :: +    (RoundedDivideInPlace t, ?divInOutEffort :: DivEffortIndicator t) => +    OpMutable1 t s+(>/<=) = mutable2ToMutable1 divInInPlace++-- | Outward rounded in-place division+divOutInPlace :: +    (RoundedDivideInPlace t, ?divInOutEffort :: DivEffortIndicator t) => +    OpMutable2 t s+divOutInPlace = divOutInPlaceEff ?divInOutEffort++-- | Outward rounded division assignment+(</>=) :: +    (RoundedDivideInPlace t, ?divInOutEffort :: DivEffortIndicator t) => +    OpMutable1 t s+(</>=) = mutable2ToMutable1 divOutInPlace++-- the following does not work, but is kept here as a template for+-- cut and pasting the "let"s+withFieldOpsEffortIndicator effortField expression =+    let ?addInOutEffort = fldEffortAdd effortField in+    let ?multInOutEffort = fldEffortMult effortField in+    let ?intPowerInOutEffort = fldEffortPow effortField in+    let ?divInOutEffort = fldEffortDiv effortField in+    expression++-- | Inward rounded in-place mixed addition+mixedAddInInPlace :: +    (RoundedMixedAddInPlace t tn, +     ?mixedAddInOutEffort :: MixedAddEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedAddInInPlace = mixedAddInInPlaceEff ?mixedAddInOutEffort++-- | Inward rounded additive scalar action assignment+(>+<|=) :: +    (RoundedMixedAddInPlace t tn, +     ?mixedAddInOutEffort :: MixedAddEffortIndicator t tn) => +    OpNonmut t tn s+(>+<|=) = mutableNonmutToNonmut mixedAddInInPlace++-- | Outward rounded in-place mixed addition+mixedAddOutInPlace :: +    (RoundedMixedAddInPlace t tn, +     ?mixedAddInOutEffort :: MixedAddEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedAddOutInPlace = mixedAddOutInPlaceEff ?mixedAddInOutEffort++-- | Outward rounded additive scalar action assignment+(<+>|=) :: +    (RoundedMixedAddInPlace t tn, +     ?mixedAddInOutEffort :: MixedAddEffortIndicator t tn) => +    OpNonmut t tn s+(<+>|=) = mutableNonmutToNonmut mixedAddOutInPlace++-- | Inward rounded in-place mixed multiplication+mixedMultInInPlace :: +    (RoundedMixedMultiplyInPlace t tn, +     ?mixedMultInOutEffort :: MixedMultEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedMultInInPlace = mixedMultInInPlaceEff ?mixedMultInOutEffort++-- | Inward rounded multiplicative scalar action assignment+(>*<|=) :: +    (RoundedMixedMultiplyInPlace t tn, +     ?mixedMultInOutEffort :: MixedMultEffortIndicator t tn) => +    OpNonmut t tn s+(>*<|=) = mutableNonmutToNonmut mixedMultInInPlace++-- | Outward rounded in-place mixed multiplication+mixedMultOutInPlace :: +    (RoundedMixedMultiplyInPlace t tn, +     ?mixedMultInOutEffort :: MixedMultEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedMultOutInPlace = mixedMultOutInPlaceEff ?mixedMultInOutEffort++-- | Outward rounded multiplicative scalar action assignment+(<*>|=) :: +    (RoundedMixedMultiplyInPlace t tn, +     ?mixedMultInOutEffort :: MixedMultEffortIndicator t tn) => +    OpNonmut t tn s+(<*>|=) = mutableNonmutToNonmut mixedMultOutInPlace++-- | Inward rounded in-place mixed reciprocal action+mixedDivInInPlace :: +    (RoundedMixedDivideInPlace t tn, +     ?mixedDivInOutEffort :: MixedDivEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedDivInInPlace = mixedDivInInPlaceEff ?mixedDivInOutEffort++-- | Inward rounded multiplicative scalar reciprocal action assignment+(>/<|=) :: +    (RoundedMixedDivideInPlace t tn, +     ?mixedDivInOutEffort :: MixedDivEffortIndicator t tn) => +    OpNonmut t tn s+(>/<|=) = mutableNonmutToNonmut mixedDivInInPlace++-- | Outward rounded in-place mixed reciprocal action+mixedDivOutInPlace :: +    (RoundedMixedDivideInPlace t tn, +     ?mixedDivInOutEffort :: MixedDivEffortIndicator t tn) => +    OpMutableNonmut t tn s+mixedDivOutInPlace = mixedDivOutInPlaceEff ?mixedDivInOutEffort++-- | Outward rounded multiplicative scalar reciprocal action assignment+(</>|=) :: +    (RoundedMixedDivideInPlace t tn, +     ?mixedDivInOutEffort :: MixedDivEffortIndicator t tn) => +    OpNonmut t tn s+(</>|=) = mutableNonmutToNonmut mixedDivOutInPlace++-- the following does not work, but is kept here as a template for+-- cut and pasting the "let"s+withMixedFieldOpsEffortIndicator effortMixedField expression =+    let ?mixedAddInOutEffort = mxfldEffortAdd effortMixedField in+    let ?mixedMultInOutEffort = mxfldEffortMult effortMixedField in+    let ?mixedDivInOutEffort = mxfldEffortDiv effortMixedField in+    expression++-- | Inward rounded in-place exponential+expInInPlace ::+    (RoundedExponentiationInPlace t, ?expInOutEffort :: ExpEffortIndicator t) => +    OpMutable1 t s+expInInPlace = expInInPlaceEff ?expInOutEffort++-- | Outward rounded in-place exponential+expOutInPlace ::+    (RoundedExponentiationInPlace t, ?expInOutEffort :: ExpEffortIndicator t) => +    OpMutable1 t s+expOutInPlace = expOutInPlaceEff ?expInOutEffort++-- | Inward rounded in-place square root+sqrtInInPlace ::+    (RoundedSquareRootInPlace t, ?sqrtInOutEffort :: SqrtEffortIndicator t) => +    OpMutable1 t s+sqrtInInPlace = sqrtInInPlaceEff ?sqrtInOutEffort++-- | Outward rounded in-place square root+sqrtOutInPlace ::+    (RoundedSquareRootInPlace t, ?sqrtInOutEffort :: SqrtEffortIndicator t) => +    OpMutable1 t s+sqrtOutInPlace = sqrtOutInPlaceEff ?sqrtInOutEffort
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/MixedFieldOps.hs view
@@ -0,0 +1,255 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RefinementOrderRounding.MixedFieldOps+    Description :  rounded basic arithmetic operations mixing 2 types+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Rounded basic arithmetical operations mixing 2 types.+    +    This module is hidden and reexported via its parent RefinementOrderRounding. +-}+module Numeric.AERN.RealArithmetic.RefinementOrderRounding.MixedFieldOps where++import Numeric.AERN.RealArithmetic.RefinementOrderRounding.FieldOps+import Numeric.AERN.RealArithmetic.RefinementOrderRounding.Conversion+import Numeric.AERN.RealArithmetic.ExactOps++import Numeric.AERN.Basics.Effort+import Numeric.AERN.Basics.Exception (HasLegalValues)+import Numeric.AERN.RealArithmetic.Laws+import Numeric.AERN.RealArithmetic.Measures+import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd+import Numeric.AERN.Basics.RefinementOrder.OpsImplicitEffort++import Test.QuickCheck+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++class RoundedMixedAddEffort t tn where+    type MixedAddEffortIndicator t tn+    mixedAddDefaultEffort :: t -> tn -> MixedAddEffortIndicator t tn++class (RoundedMixedAddEffort t tn) => RoundedMixedAdd t tn where+    mixedAddInEff :: MixedAddEffortIndicator t tn -> t -> tn -> t+    mixedAddOutEff :: MixedAddEffortIndicator t tn -> t -> tn -> t++mixedAddDefaultEffortByConversion d n = +        (addDefaultEffort d, convertDefaultEffort n d)++mixedAddInEffByConversion ::+    (Convertible tn t, RoundedAdd t) =>+    (AddEffortIndicator t, ConvertEffortIndicator tn t) ->+    t -> tn -> t+mixedAddInEffByConversion (effAdd, effConv) d n = +    addInEff effAdd d (convertInEff effConv n)++mixedAddOutEffByConversion ::+    (Convertible tn t, RoundedAdd t) =>+    (AddEffortIndicator t, ConvertEffortIndicator tn t) ->+    t -> tn -> t+mixedAddOutEffByConversion (effAdd, effConv) d n = +    addOutEff effAdd d (convertOutEff effConv n)+++propMixedAddEqualsConvert ::+    (RefOrd.PartialComparison t, Convertible tn t,+     RoundedMixedAdd t tn, RoundedAdd t,+     Show t, HasLegalValues t,+     Show (MixedAddEffortIndicator t tn),+     EffortIndicator (MixedAddEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (AddEffortIndicator t),+     EffortIndicator (AddEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (RefOrd.PartialCompareEffortIndicator t,+     (MixedAddEffortIndicator t tn,      +      AddEffortIndicator t,+      ConvertEffortIndicator tn t)) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedAddEqualsConvert sample sampleN initEffort +        (RefOrd.UniformlyOrderedSingleton d) n =+    equalRoundingUpDn "mixed addition by conversion"+        expr1In expr1Out expr2In expr2Out+        RefOrd.pLeqEff initEffort+    where+    expr1In (effMAdd,_,_) =+        let (>+<|) = mixedAddInEff effMAdd in d >+<| n+    expr1Out (effMAdd,_,_) =+        let (<+>|) = mixedAddOutEff effMAdd in d <+>| n+    expr2In (_,effAdd,effConv) =+        let (>+<) = addInEff effAdd in  d >+< (convertInEff effConv n)+    expr2Out (_,effAdd,effConv) =+        let (<+>) = addOutEff effAdd in  d <+> (convertOutEff effConv n)+++class RoundedMixedMultiplyEffort t tn where+    type MixedMultEffortIndicator t tn+    mixedMultDefaultEffort :: t -> tn -> MixedMultEffortIndicator t tn++class (RoundedMixedMultiplyEffort t tn) =>  RoundedMixedMultiply t tn where+    mixedMultInEff :: MixedMultEffortIndicator t tn -> t -> tn -> t+    mixedMultOutEff :: MixedMultEffortIndicator t tn -> t -> tn -> t++mixedMultDefaultEffortByConversion d n = +        (multDefaultEffort d, convertDefaultEffort n d)++mixedMultInEffByConversion ::+    (Convertible tn t, RoundedMultiply t) =>+    (MultEffortIndicator t, ConvertEffortIndicator tn t) ->+    t -> tn -> t+mixedMultInEffByConversion (effMult, effConv) d n = +    multInEff effMult d (convertInEff effConv n)++mixedMultOutEffByConversion ::+    (Convertible tn t, RoundedMultiply t) =>+    (MultEffortIndicator t, ConvertEffortIndicator tn t) ->+    t -> tn -> t+mixedMultOutEffByConversion (effMult, effConv) d n = +    multOutEff effMult d (convertOutEff effConv n)+++propMixedMultEqualsConvert ::+    (RefOrd.PartialComparison t, Convertible tn t,+     RoundedMixedMultiply t tn, RoundedMultiply t,+     Show t, HasLegalValues t,+     Show (MixedMultEffortIndicator t tn),+     EffortIndicator (MixedMultEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (MultEffortIndicator t),+     EffortIndicator (MultEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (RefOrd.PartialCompareEffortIndicator t,+      (MixedMultEffortIndicator t tn,      +       MultEffortIndicator t,+       ConvertEffortIndicator tn t)) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedMultEqualsConvert sample sampleN initEffort +        (RefOrd.UniformlyOrderedSingleton d) n =+    equalRoundingUpDn "mixed multiplication by conversion"+        expr1In expr1Out expr2In expr2Out+        RefOrd.pLeqEff initEffort+    where+    expr1In (effMMult,_,_) =+        let (>*<|) = mixedMultInEff effMMult in d >*<| n+    expr1Out (effMMult,_,_) =+        let (<*>|) = mixedMultOutEff effMMult in d <*>| n+    expr2In (_,effMult,effConv) =+        let (>*<) = multInEff effMult in d >*< (convertInEff effConv n)+    expr2Out (_,effMult,effConv) =+        let (<*>) = multOutEff effMult in d <*> (convertOutEff effConv n)++class RoundedMixedDivideEffort t tn where+    type MixedDivEffortIndicator t tn+    mixedDivDefaultEffort :: t -> tn -> MixedDivEffortIndicator t tn++class (RoundedMixedDivideEffort t tn) => RoundedMixedDivide t tn where+    mixedDivInEff :: MixedDivEffortIndicator t tn -> t -> tn -> t+    mixedDivOutEff :: MixedDivEffortIndicator t tn -> t -> tn -> t++mixedDivDefaultEffortByConversion d n = +        (divDefaultEffort d, convertDefaultEffort n d)++mixedDivInEffByConversion ::+    (Convertible tn t, RoundedDivide t) =>+    (DivEffortIndicator t, ConvertEffortIndicator tn t) ->+    t -> tn -> t+mixedDivInEffByConversion (effDiv, effConv) d n = +    divInEff effDiv d (convertInEff effConv n)++mixedDivOutEffByConversion ::+    (Convertible tn t, RoundedDivide t) =>+    (DivEffortIndicator t, ConvertEffortIndicator tn t) ->+    t -> tn -> t+mixedDivOutEffByConversion (effDiv, effConv) d n = +    divOutEff effDiv d (convertOutEff effConv n)+++propMixedDivEqualsConvert ::+    (RefOrd.PartialComparison t, Convertible tn t,+     RoundedMixedDivide t tn, RoundedDivide t,+     Show t, HasZero t, HasLegalValues t,+     Show (MixedDivEffortIndicator t tn),+     EffortIndicator (MixedDivEffortIndicator t tn),+     Show (ConvertEffortIndicator tn t),+     EffortIndicator (ConvertEffortIndicator tn t),+     Show (DivEffortIndicator t),+     EffortIndicator (DivEffortIndicator t),+     Show (RefOrd.PartialCompareEffortIndicator t),+     EffortIndicator (RefOrd.PartialCompareEffortIndicator t)+     ) =>+    t -> tn ->+    (RefOrd.PartialCompareEffortIndicator t,+     (MixedDivEffortIndicator t tn,      +      DivEffortIndicator t,+      ConvertEffortIndicator tn t)) -> +    (RefOrd.UniformlyOrderedSingleton t) -> +    tn -> Bool+propMixedDivEqualsConvert sample sampleN initEffort@(effComp,(_,_,effConv)) +        (RefOrd.UniformlyOrderedSingleton d) n+    =+    equalRoundingUpDn "mixed division by conversion"+        expr1In expr1Out expr2In expr2Out+        RefOrd.pLeqEff initEffort+    where+    expr1In (effMDiv,_,_) =+        let (>/<|) = mixedDivInEff effMDiv in d >/<| n+    expr1Out (effMDiv,_,_) =+        let (</>|) = mixedDivOutEff effMDiv in d </>| n+    expr2In (_,effDiv,effConv) =+        let (>/<) = divInEff effDiv in d >/< (convertInEff effConv n)+    expr2Out (_,effDiv,effConv) =+        let (</>) = divOutEff effDiv in d </> (convertOutEff effConv n)++    +testsInOutMixedFieldOps (name, sample) (nameN, sampleN) =+    testGroup (name ++ " with " ++ nameN ++ ": mixed in/out rounded ops") $+        [+            testProperty "addition" (propMixedAddEqualsConvert sample sampleN)+        ,+            testProperty "multiplication" (propMixedMultEqualsConvert sample sampleN)+        ,+            testProperty "division" (propMixedDivEqualsConvert sample sampleN)+        ]++class (RoundedMixedAddEffort t tn, RoundedMixedMultiplyEffort t tn) => +    RoundedMixedRingEffort t tn+    where+    type MixedRingOpsEffortIndicator t tn+    mixedRingOpsDefaultEffort :: t -> tn -> MixedRingOpsEffortIndicator t tn+    mxringEffortAdd :: t -> tn -> MixedRingOpsEffortIndicator t tn -> MixedAddEffortIndicator t tn+    mxringEffortMult :: t -> tn -> MixedRingOpsEffortIndicator t tn -> MixedMultEffortIndicator t tn++class (RoundedMixedAdd t tn, RoundedMixedMultiply t tn) => +    RoundedMixedRing t tn++class (RoundedMixedRingEffort t tn, RoundedMixedDivideEffort t tn) => +    RoundedMixedFieldEffort t tn+    where+    type MixedFieldOpsEffortIndicator t tn+    mixedFieldOpsDefaultEffort :: t -> tn -> MixedFieldOpsEffortIndicator t tn+    mxfldEffortAdd :: t -> tn -> MixedFieldOpsEffortIndicator t tn -> MixedAddEffortIndicator t tn+    mxfldEffortMult :: t -> tn -> MixedFieldOpsEffortIndicator t tn -> MixedMultEffortIndicator t tn+    mxfldEffortDiv :: t -> tn -> MixedFieldOpsEffortIndicator t tn -> MixedDivEffortIndicator t tn+        +class (RoundedMixedRing t tn, RoundedMixedDivide t tn, RoundedMixedFieldEffort t tn) => +    RoundedMixedField t tn+
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/OpsDefaultEffort.hs view
@@ -0,0 +1,159 @@+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsDefaultEffort+    Description :  convenience operators and functions with default effort  +    Copyright   :  (c) Michal Konecny, Jan Duracz+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Convenience operators and functions with default effort.+-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsDefaultEffort where++import Numeric.AERN.RealArithmetic.RefinementOrderRounding++infixl 6 <+>, >+<, <->, >-<+infixl 7 <*>, >*<+infixl 8 <^>, >^<+infixl 7 </>, >/<++infixr 6 |<+>, |>+<+infixl 6 <+>|, >+<|+infixr 7 |<*>, |>*<+infixl 7 <*>|, >*<|+infixl 7 </>|, >/<|++-- | Inward rounded addition+(>+<) :: (RoundedAdd t) => t -> t -> t+(>+<) d = addInEff (addDefaultEffort d) d++-- | Outward rounded addition+(<+>) :: (RoundedAdd t) => t -> t -> t+(<+>) d = addOutEff (addDefaultEffort d) d++-- | Inward rounded subtraction+(>-<) :: (RoundedSubtr t) => t -> t -> t+(>-<) d = subtrInEff (addDefaultEffort d) d++-- | Outward rounded subtraction+(<->) :: (RoundedSubtr t) => t -> t -> t+(<->) d = subtrOutEff (addDefaultEffort d) d++-- | Inward rounded absolute value+absIn :: (RoundedAbs t) => t -> t+absIn d = absInEff (absDefaultEffort d) d++-- | Outward rounded absolute value+absOut :: (RoundedAbs t) => t -> t+absOut d = absOutEff (absDefaultEffort d) d++-- | Inward rounded multiplication+(>*<) :: (RoundedMultiply t) => t -> t -> t+(>*<) d = multInEff (multDefaultEffort d) d++-- | Outward rounded multiplication+(<*>) :: (RoundedMultiply t) => t -> t -> t+(<*>) d = multOutEff (multDefaultEffort d) d++-- | Inward rounded power+(>^<) :: (RoundedPowerToNonnegInt t) => t -> Int -> t +(>^<) d = powerToNonnegIntInEff (powerToNonnegIntDefaultEffort d) d++-- | Outward rounded power+(<^>) :: (RoundedPowerToNonnegInt t) => t -> Int -> t+(<^>) d = powerToNonnegIntOutEff (powerToNonnegIntDefaultEffort d) d++-- | Inward rounded division+(>/<) :: (RoundedDivide t) => t -> t -> t+(>/<) d = divInEff (divDefaultEffort d) d+  +-- | Outward rounded division+(</>) :: (RoundedDivide t) => t -> t -> t+(</>) d = divOutEff (divDefaultEffort d) d++-- | Inward rounded additive scalar left action+(|>+<) :: (RoundedMixedAdd t tn) => tn -> t -> t+(|>+<) n d = mixedAddInEff (mixedAddDefaultEffort d n) d n++-- | Outward rounded additive scalar left action+(|<+>) :: (RoundedMixedAdd t tn) => tn -> t -> t+(|<+>) n d = mixedAddOutEff (mixedAddDefaultEffort d n) d n++-- | Inward rounded additive scalar right action+(>+<|) :: (RoundedMixedAdd t tn) => t -> tn -> t+(>+<|) d n = mixedAddInEff (mixedAddDefaultEffort d n) d n++-- | Outward rounded additive scalar right action+(<+>|) :: (RoundedMixedAdd t tn) => t -> tn -> t+(<+>|) d n = mixedAddOutEff (mixedAddDefaultEffort d n) d n++-- | Inward rounded multiplicative scalar left action+(|>*<) :: (RoundedMixedMultiply t tn) => tn -> t -> t+(|>*<) n d = mixedMultInEff (mixedMultDefaultEffort d n) d n++-- | Outward rounded multiplicative scalar left action+(|<*>) :: (RoundedMixedMultiply t tn) => tn -> t -> t+(|<*>) n d = mixedMultOutEff (mixedMultDefaultEffort d n) d n++-- | Inward rounded multiplicative scalar right action+(>*<|) :: (RoundedMixedMultiply t tn) => t -> tn -> t+(>*<|) d n = mixedMultInEff (mixedMultDefaultEffort d n) d n++-- | Outward rounded multiplicative scalar right action+(<*>|) :: (RoundedMixedMultiply t tn) => t -> tn -> t+(<*>|) d n = mixedMultOutEff (mixedMultDefaultEffort d n) d n++-- | Inward rounded multiplicative scalar reciprocal right action+(>/<|) :: (RoundedMixedDivide t tn) => t -> tn -> t+(>/<|) d n = mixedDivInEff (mixedDivDefaultEffort d n) d n++-- | Outward rounded multiplicative scalar reciprocal right action+(</>|) :: (RoundedMixedDivide t tn) => t -> tn -> t+(</>|) d n = mixedDivOutEff (mixedDivDefaultEffort d n) d n++-- | Inward rounded pi+piIn :: (RoundedSpecialConst t) => t+piIn = result+    where+    result =  +        piInEff (specialConstDefaultEffort result)++-- | Outward rounded pi+piOut :: (RoundedSpecialConst t) => t+piOut = result+    where+    result =  +        piOutEff (specialConstDefaultEffort result)++-- | Inward rounded e+eIn :: (RoundedSpecialConst t) => t+eIn = result+    where+    result =  +        eInEff (specialConstDefaultEffort result)++-- | Outward rounded e+eOut :: (RoundedSpecialConst t) => t+eOut = result+    where+    result =  +        eOutEff (specialConstDefaultEffort result)++-- | Inward rounded exponential+expIn :: (RoundedExponentiation t) => t -> t+expIn d = expInEff (expDefaultEffort d) d++-- | Outward rounded exponential+expOut :: (RoundedExponentiation t) => t -> t+expOut d = expOutEff (expDefaultEffort d) d++-- | Inward rounded square root+sqrtIn :: (RoundedSquareRoot t) => t -> t+sqrtIn d = sqrtInEff (sqrtDefaultEffort d) d++-- | Outward rounded square root+sqrtOut :: (RoundedSquareRoot t) => t -> t+sqrtOut d = sqrtOutEff (sqrtDefaultEffort d) d
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/OpsImplicitEffort.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsImplicitEffort+    Description :  convenience binary infix operators with implicit effort parameters  +    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Convenience binary infix operators with implicit effort parameters.+-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsImplicitEffort where++import Numeric.AERN.RealArithmetic.RefinementOrderRounding++infixl 6 <+>, >+<, <->, >-<+infixl 7 <*>, >*<+infixl 8 <^>, >^<+infixl 7 </>, >/<++infixr 6 |<+>, |>+<+infixl 6 <+>|, >+<|+infixr 7 |<*>, |>*<+infixl 7 <*>|, >*<|+infixl 7 </>|, >/<|+++(>+<), (<+>) :: +    (RoundedAdd t, ?addInOutEffort :: AddEffortIndicator t) => +    t -> t -> t+(>+<) = addInEff ?addInOutEffort+(<+>) = addOutEff ?addInOutEffort++(>-<), (<->) :: +    (RoundedSubtr t, ?addInOutEffort :: AddEffortIndicator t) => +    t -> t -> t+(>-<) = subtrInEff ?addInOutEffort+(<->) = subtrOutEff ?addInOutEffort++absIn, absOut ::+    (RoundedAbs t, ?absInOutEffort :: AbsEffortIndicator t) => +    t -> t+absIn = absInEff ?absInOutEffort+absOut = absOutEff ?absInOutEffort++(>*<), (<*>) :: +    (RoundedMultiply t, ?multInOutEffort :: MultEffortIndicator t) => +    t -> t -> t+(>*<) = multInEff ?multInOutEffort+(<*>) = multOutEff ?multInOutEffort++(>^<), (<^>) :: +    (RoundedPowerToNonnegInt t, ?intPowerInOutEffort :: PowerToNonnegIntEffortIndicator t) => +    t -> Int -> t+(>^<) = powerToNonnegIntInEff ?intPowerInOutEffort+(<^>) = powerToNonnegIntOutEff ?intPowerInOutEffort++(>/<), (</>) :: +    (RoundedDivide t, ?divInOutEffort :: DivEffortIndicator t) => +    t -> t -> t+(>/<) = divInEff ?divInOutEffort+(</>) = divOutEff ?divInOutEffort++-- the following does not work, but is kept here as a template for+-- cut and pasting the "let"s+withFieldOpsEffortIndicator effortField expression =+    let ?addInOutEffort = fldEffortAdd effortField in+    let ?multInOutEffort = fldEffortMult effortField in+    let ?intPowerInOutEffort = fldEffortPow effortField in+    let ?divInOutEffort = fldEffortDiv effortField in+    expression++(|>+<), (|<+>) :: +    (RoundedMixedAdd t tn, +     ?mixedAddInOutEffort :: MixedAddEffortIndicator t tn) => +    tn -> t -> t+(|>+<) n d = mixedAddInEff ?mixedAddInOutEffort d n+(|<+>) n d = mixedAddOutEff ?mixedAddInOutEffort d n++(>+<|), (<+>|) :: +    (RoundedMixedAdd t tn, +     ?mixedAddInOutEffort :: MixedAddEffortIndicator t tn) => +    t -> tn -> t+(>+<|) = mixedAddInEff ?mixedAddInOutEffort+(<+>|) = mixedAddOutEff ?mixedAddInOutEffort++(|>*<), (|<*>) :: +    (RoundedMixedMultiply t tn, +     ?mixedMultInOutEffort :: MixedMultEffortIndicator t tn) => +    tn -> t -> t+(|>*<) n d = mixedMultInEff ?mixedMultInOutEffort d n+(|<*>) n d = mixedMultOutEff ?mixedMultInOutEffort d n++(>*<|), (<*>|) :: +    (RoundedMixedMultiply t tn, +     ?mixedMultInOutEffort :: MixedMultEffortIndicator t tn) => +    t -> tn -> t+(>*<|) = mixedMultInEff ?mixedMultInOutEffort+(<*>|) = mixedMultOutEff ?mixedMultInOutEffort++(>/<|), (</>|) :: +    (RoundedMixedDivide t tn, +     ?mixedDivInOutEffort :: MixedDivEffortIndicator t tn) => +    t -> tn -> t+(>/<|) = mixedDivInEff ?mixedDivInOutEffort+(</>|) = mixedDivOutEff ?mixedDivInOutEffort++-- the following does not work, but is kept here as a template for+-- cut and pasting the "let"s+withMixedFieldOpsEffortIndicator effortMixedField expression =+    let ?mixedAddInOutEffort = mxfldEffortAdd effortMixedField in+    let ?mixedMultInOutEffort = mxfldEffortMult effortMixedField in+    let ?mixedDivInOutEffort = mxfldEffortDiv effortMixedField in+    expression+++piIn, piOut ::+    (RoundedSpecialConst t, ?specialConstInOutEffort :: SpecialConstEffortIndicator t) => +    t+piIn = piInEff ?specialConstInOutEffort+piOut = piOutEff ?specialConstInOutEffort++eIn, eOut ::+    (RoundedSpecialConst t, ?specialConstInOutEffort :: SpecialConstEffortIndicator t) => +    t+eIn = eInEff ?specialConstInOutEffort+eOut = eOutEff ?specialConstInOutEffort++expIn, expOut ::+    (RoundedExponentiation t, ?expInOutEffort :: ExpEffortIndicator t) => +    t -> t+expIn = expInEff ?expInOutEffort+expOut = expOutEff ?expInOutEffort++sqrtIn, sqrtOut ::+    (RoundedSquareRoot t, ?sqrtInOutEffort :: SqrtEffortIndicator t) => +    t -> t+sqrtIn = sqrtInEff ?sqrtInOutEffort+sqrtOut = sqrtOutEff ?sqrtInOutEffort+
+ src/Numeric/AERN/RealArithmetic/RefinementOrderRounding/SpecialConst.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImplicitParams #-}+{-|+    Module      :  Numeric.AERN.RealArithmetic.RefinementOrderRounding.SpecialConst+    Description :  support for common constants such as pi+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable+    +    Support for common constants such as pi.+    +    This module is hidden and reexported via its parent RefinementOrderRounding. +-}++module Numeric.AERN.RealArithmetic.RefinementOrderRounding.SpecialConst where++--import Numeric.AERN.Basics.Effort+--import Numeric.AERN.Basics.Exception+--import Numeric.AERN.Basics.ShowInternals+--import Numeric.AERN.RealArithmetic.Laws+--import Numeric.AERN.RealArithmetic.Measures+--import qualified Numeric.AERN.Basics.NumericOrder as NumOrd+--import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort+--+--import Numeric.AERN.Misc.Debug+--+--import Test.QuickCheck+--import Test.Framework (testGroup, Test)+--import Test.Framework.Providers.QuickCheck2 (testProperty)++class RoundedSpecialConstEffort t where+    type SpecialConstEffortIndicator t+    specialConstDefaultEffort :: t -> SpecialConstEffortIndicator t++class (RoundedSpecialConstEffort t) => RoundedSpecialConst t where+    piInEff :: (SpecialConstEffortIndicator t) -> t+    piOutEff :: (SpecialConstEffortIndicator t) -> t+    eInEff :: (SpecialConstEffortIndicator t) -> t+    eOutEff :: (SpecialConstEffortIndicator t) -> t++
− tests/RunERIntervalTests.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE CPP #-}-{-| -    Module      :  Main-    Description :  laucher for approximated exact real arithmetic tests-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mik@konecny.aow.cz-    Stability   :  experimental-    Portability :  portable--    An executable for easy automated launch of tests -    of approximated exact real arithmetic.--}-module Main where--import qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.Real.Approx.Tests.Run -import Data.Number.ER.Real.DefaultRepr----import Data.Number.ER.Real.Approx.Tests.Properties---import Data.Number.ER.Real.Approx.Tests.Generate--main =-    do-    runRATests "interval-double" sampleRABM (RA.initialiseBaseArithmetic sampleRABM)-    runRATests "interval-haskell" sampleRABM (RA.initialiseBaseArithmetic sampleRABAP)-    runRATests "interval-haskell-double" sampleRABM (RA.initialiseBaseArithmetic sampleRABMAP)-#ifdef USE_MPFR-    runRATests "interval-mpfr" sampleRABM (RA.initialiseBaseArithmetic sampleRABMPFR)-#endif--sampleRABM :: RA BM-sampleRABAP :: RA BAP-sampleRABMAP :: RA BMAP-sampleRABM = 0-sampleRABAP = 0-sampleRABMAP = 0--#ifdef USE_MPFR-sampleRABMPFR :: RA BMPFR-sampleRABMPFR = 0-#endif