diff --git a/AERN-Real-Double.cabal b/AERN-Real-Double.cabal new file mode 100644 --- /dev/null +++ b/AERN-Real-Double.cabal @@ -0,0 +1,124 @@ +Name: AERN-Real-Double +Version: 2011.1 +Cabal-Version: >= 1.2 +Build-Type: Simple +License: BSD3 +License-File: LICENCE +Author: Michal Konecny (Aston University) +Copyright: (c) 2011 Michal Konecny, Jan Duracz +Maintainer: mikkonecny@gmail.com +Homepage: http://code.google.com/p/aern/ +Stability: experimental +Category: Data, Math +Synopsis: arbitrary precision real interval arithmetic +Tested-with: GHC ==6.12.3 +Description: + This package provides bindings and tests for using machine Double + values as endpoints for the interval arithmetic defined in packages AERN-Basics and + AERN-Real. + . + Most users of this package will only need to import one end-user API module. + There is a choice of three such modules, each providing a different + level of abstraction for the type of intervals with Double endpoints: + . + * "Numeric.AERN.DoubleBasis.RealApprox" gives RealApprox - an abstract data type + limited to operations that interpret each interval strictly as an + approximation to a single real number. As an instance of Fractional, + the numerical operations safely overapproximate + the exact real operations by rounding the intervals outwards. + . + * "Numeric.AERN.DoubleBasis.RealIntervalApprox" gives RealIntervalApprox - an abstract + data type limited to operations that interpret each interval strictly as an + approximation to a /set/ of real numbers. All RealApprox operations are + available also for RealIntervalApprox. Additionally, one can create approximations that + certainly cover two given approximations and one can perform all + operations rounding /inwards/ to allow safe semi-deciding of set inclusions. + As a consequence of inner rounding, anti-consistent intervals such as [1,0] may arise + and are treated using Kaucher arithmetic. + . + * "Numeric.AERN.DoubleBasis.Interval" gives full access to the interval type, + including the Double endpoints. + . + The accompanying modules "Numeric.AERN.DoubleBasis.MRealApprox", "Numeric.AERN.DoubleBasis.MRealIntervalApprox" + and "Numeric.AERN.DoubleBasis.MInterval" add in-place versions of most of the pure operations + provided by the respective above module. + . + For further information, please refer to the documentation of these six modules + and the sample programs in the demo folder. + +Extra-Source-Files: + CHANGES + +Library + hs-source-dirs: src + ghc-options: -O2 + Build-Depends: + base >= 4 && < 5, + ieee-utils >= 0.4 && < 0.5, + QuickCheck >= 2.1 && < 3, + test-framework >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2 && < 0.4, + AERN-Basics == 2011.1, AERN-Real-Interval == 2011.1, AERN-Real == 2011.1 + Exposed-modules: + Numeric.AERN.DoubleBasis.Interval, + Numeric.AERN.DoubleBasis.MInterval, + Numeric.AERN.DoubleBasis.RealApprox, + Numeric.AERN.DoubleBasis.MRealApprox, + Numeric.AERN.DoubleBasis.RealIntervalApprox, + Numeric.AERN.DoubleBasis.MRealIntervalApprox, + Numeric.AERN.RealArithmetic.Basis.Double, + Numeric.AERN.RealArithmetic.Interval.Double + + Other-modules: + Numeric.AERN.RealArithmetic.Basis.Double.Conversion + Numeric.AERN.RealArithmetic.Basis.Double.NumericOrder + Numeric.AERN.RealArithmetic.Basis.Double.FieldOps + Numeric.AERN.RealArithmetic.Basis.Double.MixedFieldOps + Numeric.AERN.RealArithmetic.Basis.Double.Mutable + Numeric.AERN.RealArithmetic.Basis.Double.Measures + Numeric.AERN.RealArithmetic.Basis.Double.ShowInternals + Numeric.AERN.RealArithmetic.Basis.Double.SpecialConst + +Executable testAERN-Real-Double + hs-source-dirs: src, tests + ghc-options: -O2 + main-is: Main.hs + Build-Depends: + base >= 4 && < 5, + test-framework >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2 && < 0.4, + AERN-Basics == 2011.1, AERN-Real-Interval == 2011.1, AERN-Real == 2011.1 + +Executable benchAERN-Real-Double + hs-source-dirs: src, bench + ghc-options: -O2 + main-is: Main.hs + Build-Depends: + base >= 4 && < 5, + criterion >= 0.5 && < 0.6, + AERN-Basics == 2011.1, AERN-Real-Interval == 2011.1, AERN-Real == 2011.1 + +Executable demoAERN-Real-Double-Quadratic + hs-source-dirs: src, demos + ghc-options: -O2 + main-is: Quadratic.hs + Build-Depends: + base >= 4 && < 5, + AERN-Basics == 2011.1, AERN-Real == 2011.1 + +Executable demoAERN-Real-Double-Riemann + hs-source-dirs: src, demos + ghc-options: -O2 + main-is: Riemann.hs + Build-Depends: + base >= 4 && < 5, + AERN-Basics == 2011.1, AERN-Real == 2011.1 + +Executable demoAERN-Real-Double-Zero + hs-source-dirs: src, demos + ghc-options: -O2 + main-is: Zero.hs + Build-Depends: + base >= 4 && < 5, + AERN-Basics == 2011.1, AERN-Real == 2011.1 + + + diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,3 @@ +2011.1: 6th May 2011 + * initial release of AERN-Real-Double + diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -0,0 +1,30 @@ +Copyright (c) 2010 Michal Konecny + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,36 @@ +{-| + Module : Main + Description : run all benchmarks defined in the AERN-Real package + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable +-} +module Main where + +import Numeric.AERN.RealArithmetic.Basis.Double +import Numeric.AERN.RealArithmetic.Interval.Double +import Numeric.AERN.RealArithmetic.Interval +import Numeric.AERN.RealArithmetic.Interval.ElementaryFromFieldOps +import Numeric.AERN.Basics.Interval + +import Numeric.AERN.Basics.Consistency +import qualified Numeric.AERN.Basics.NumericOrder as NumOrd +import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd + +import Numeric.AERN.RealArithmetic.Measures +import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as ArithUpDn +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as ArithInOut + +import Numeric.AERN.Basics.Bench +import Criterion.Main +import Criterion + +main = + defaultMainWith (criterionConfig "bench-Double" 20) (return ()) $ + [ + ArithInOut.benchInOutExp ("DI", sampleDI) ArithInOut.benchExpAreasReal + ] + diff --git a/demos/Quadratic.hs b/demos/Quadratic.hs new file mode 100644 --- /dev/null +++ b/demos/Quadratic.hs @@ -0,0 +1,100 @@ + +module Main where + +import Numeric.AERN.DoubleBasis.RealApprox +import Numeric.AERN.DoubleBasis.MRealApprox + +import Control.Monad.ST (runST) + +type R = RealApprox + +main = do + putStrLn $ "quadratic 1 1 1 = " ++ show (quadratic 1 1 1) + putStrLn $ "quadratic 1 2 1 = " ++ show (quadratic 1 2 1) + putStrLn $ "quadratic 1 5 6 = " ++ show (quadratic 1 5 6) + putStrLn $ "quadraticInPlace 1 1 1 = " ++ show (quadraticInPlace 1 1 1) + putStrLn $ "quadraticInPlace 1 2 1 = " ++ show (quadraticInPlace 1 2 1) + putStrLn $ "quadraticInPlace 1 5 6 = " ++ show (quadraticInPlace 1 5 6) + +-- | +-- Returns list such that the union of its members contains all +-- real roots of each real polynomial u*x^2+v*x+w obtained by +-- choosing coefficients u in a, v in b and w in c. +quadratic :: R -> R -> R -> [R] +quadratic a b c + | certainlyZero discriminant = + [doubleRoot] + | certainlyNonnegative discriminant = + [leftRoot,rightRoot] + | certainlyNegative discriminant = + [] + | otherwise = + [bottom] + where + discriminant = b^2-4*a*c + doubleRoot = -b/(2*a) + leftRoot = doubleRoot-sqrtDiscriminant/(2*a) -- (-b-sqrt(b^2-4*a*c))/(2*a) + rightRoot = doubleRoot+sqrtDiscriminant/(2*a) -- (-b+sqrt(b^2-4*a*c))/(2*a) + sqrtDiscriminant = sqrt discriminant + +-- | +-- In-place quadratic. +quadraticInPlace :: R -> R -> R -> [R] +quadraticInPlace a b c + | certainlyZero discriminant = + [doubleRoot] + | certainlyNonnegative discriminant = + [leftRoot,rightRoot] + | certainlyNegative discriminant = + [] + | otherwise = + [bottom] + where + discriminant = + runST $ + do + [aM,bM,cM] <- mapM makeMutable [a,b,c] + bM <^>= 2 -- b^2 + aM <*>|= (4 :: Double) -- 4*a + aM <*>= cM -- 4*a*c + bM <->= aM -- b^2-4*a*c + result <- unsafeReadMutable bM + -- using unsafeReadMutable is safe becasue bM is no longer reachable + return result + doubleRoot = + runST $ + do + [aM,bM] <- mapM makeMutable [a,b] + bM |= (-2 :: Double) -- -b/2 + bM = aM -- -b/(2*a) + result <- unsafeReadMutable bM + -- using unsafeReadMutable is safe becasue bM is no longer reachable + return result + [leftRoot,rightRoot] = + runST $ + do + [aM,drM,diM] <- mapM makeMutable [a,doubleRoot,discriminant] + sqrtOutInPlace diM diM -- sqrt(b^2-4*a*c) + diM |= (2 :: Double) -- (sqrt(b^2-4*a*c))/2 + diM = aM -- (sqrt(b^2-4*a*c))/(2*a) + assignMutable aM drM + aM <->= diM -- (-b-sqrt(b^2-4*a*c))/(2*a) + drM <+>= diM -- (-b+sqrt(b^2-4*a*c))/(2*a) + result <- mapM unsafeReadMutable [aM,drM] + -- using unsafeReadMutable is safe becasue aM and drM are no longer reachable + return result + +certainlyZero x = + case x ==? 0 of + Just True -> True + _ -> False + +certainlyNonnegative x = + case x >=? 0 of + Just True -> True + _ -> False + +certainlyNegative x = + case x True + _ -> False diff --git a/demos/Riemann.hs b/demos/Riemann.hs new file mode 100644 --- /dev/null +++ b/demos/Riemann.hs @@ -0,0 +1,88 @@ + +module Main where + +import Numeric.AERN.DoubleBasis.RealIntervalApprox +import Numeric.AERN.DoubleBasis.MRealIntervalApprox + +import Control.Monad.ST (ST, runST) + +type R = RealIntervalApprox +type RI = RealIntervalApprox + +main = + do + putStrLn $ "riemann 0.1 (\\x -> x^2) (Interval 0 1) = " ++ + show (riemann 0.1 (\x -> x^2) (0 1)) + putStrLn "erf e x = 2/(sqrt pi) * riemann e (\\t -> exp (-t^2)) (0 x)" + putStrLn $ "erf 0.001 1 = " ++ show (erf 0.001 1) + putStrLn $ "riemannInPlace 0.1 (\\x -> x^2) (Interval 0 1) = " ++ + show (riemannInPlace 0.1 (\x -> x^2) (0 1)) + putStrLn "erfInPlace e x = 2/(sqrt pi) * riemannInPlace e (\\t -> exp (-t^2)) (0 x)" + putStrLn $ "erfInPlace 0.001 1 = " ++ show (erfInPlace 0.001 1) + putStrLn $ "riemannInPlace 0.1 (\\x -> x^2) (Interval 0 1) = " ++ + show (riemannInPlace 0.1 (\x -> x^2) (0 1)) + putStrLn "erfInPlace e x = 2/(sqrt pi) * riemannInPlace e (\\t -> exp (-t^2)) (0 x)" + putStrLn $ "erfInPlace 0.001 1 = " ++ show (erf 0.001 1) + +-- compute the error function to within e accuracy +erf :: R -> R -> R +erf e x = + 2/(sqrt pi) * riemann e (\t -> exp (-t^2)) (0 x) + +-- compute the integral of f over d to within e accuracy +riemann :: R -> (R -> R) -> RI -> R +riemann e f d = + riemann' e f (width d) [d] 0 + +riemann' _ _ _ [] result = result +riemann' e f initWidth (d:ds) result + | reachedSufficientAccuracy = + riemann' e f initWidth ds (dArea + result) + | otherwise = + riemann' e f initWidth (dl:dr:ds) result + where + reachedSufficientAccuracy = + case dError True + _ -> False + dError = dWidth * (width fd) + dArea = dWidth * fd + fd = f d + dWidth = width d + (dl, dr) = bisect Nothing d + +-- erf using riemannInPlace +erfInPlace :: R -> R -> R +erfInPlace e x = + 2/(sqrt pi) * riemannInPlace e (\t -> exp (-t^2)) (0 x) + +-- riemann using in-place accumulator +riemannInPlace :: R -> (R -> R) -> RI -> R +riemannInPlace e f d = + runST $ + do + resM <- makeMutable 0 + riemannInPlace' resM e f (width d) [d] + result <- unsafeReadMutable resM + return result + +riemannInPlace' resM _ _ _ [] = + return () +riemannInPlace' resM e f initWidth (d:ds) + | reachedSufficientAccuracy = + do + dAreaM <- unsafeMakeMutable dArea + resM <+>= dAreaM + riemannInPlace' resM e f initWidth ds + | otherwise = + riemannInPlace' resM e f initWidth (dl:dr:ds) + where + reachedSufficientAccuracy = + case dError True + _ -> False + dError = dWidth * (width fd) + dArea = dWidth * fd + fd = f d + dWidth = width d + (dl, dr) = bisect Nothing d diff --git a/demos/Zero.hs b/demos/Zero.hs new file mode 100644 --- /dev/null +++ b/demos/Zero.hs @@ -0,0 +1,48 @@ + +module Main where + +import Numeric.AERN.DoubleBasis.RealIntervalApprox +import Numeric.AERN.DoubleBasis.MRealIntervalApprox + +import Control.Monad.ST (ST, runST) + +type RI = RealIntervalApprox + +main = + do + putStrLn $ "zero 0.1 (\\x -> x^2-0.5) (1 2) = " ++ + show (zero 0.1 (\x -> x^2-0.5) (1 2)) + putStrLn $ "zero 0.1 (\\x -> x^2-0.5) (0 1) = " ++ + show (zero 0.1 (\x -> x^2-0.5) (0 1)) + putStrLn $ "zero 0.01 (\\x -> x^2-0.5) (0 1) = " ++ + show (zero 0.01 (\x -> x^2-0.5) (0 1)) + putStrLn $ "zero 0.001 (\\x -> x^2-0.5) (0 1) = " ++ + show (zero 0.001 (\x -> x^2-0.5) (0 1)) + +-- find leftmost zero of f in d to within e accuracy +zero :: RI -> (RI -> RI) -> RI -> Maybe RI +zero e f d = + zero' e f [d] +zero' :: RI -> (RI -> RI) -> [RI] -> Maybe RI +zero' _ _ [] = Nothing +zero' e f (d:ds) + | imageContainsZero == Just False = + zero' e f ds + | imageContainsZero == Just True && reachedSufficientAccuracy = + Just d + | cannotSplit = + error $ "zero: cannot split interval " ++ show d + | otherwise = + zero' e f (dl:dr:ds) + where + cannotSplit = (dl |==? d) == Just True || (dr |==? d) == Just True + imageContainsZero = fd |<=? 0 + reachedSufficientAccuracy = + case width fd True + _ -> False + (dl,dr) = bisect Nothing d + fd = f d + + + diff --git a/src/Numeric/AERN/DoubleBasis/Interval.hs b/src/Numeric/AERN/DoubleBasis/Interval.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/DoubleBasis/Interval.hs @@ -0,0 +1,590 @@ +{-# LANGUAGE FlexibleContexts #-} +{-| + Module : Numeric.AERN.DoubleBasis.Interval + Description : Interval Double type and operations + Copyright : (c) Michal Konecny, Jan Duracz + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Intervals with Double endpoints. +-} +module Numeric.AERN.DoubleBasis.Interval +( + -- | + -- A convenience module re-exporting various interval operations + -- with default effort indicators. + + -- * Main type + DI, + + -- ** associated operations + width, bisect, + + -- * Order relations + -- | + -- There are two types of order relations to consider: + -- + -- * the /numerical/ order, generalising the order relation + -- on Doubles and + -- + -- * the /refinement/ order, generalising the reverse-inclusion + -- relation on consistent intervals. + -- + -- The consistent intervals in 'DI' form a /meet/-semilattice + -- corresponding to the refiniement order under the operation /\\ + -- returning the subset-least interval containing the /union/ of + -- its argument intervals. The operation is extended to all of 'DI' + -- by returning the highest interval below both of its argument + -- intervals. + -- + -- The structure ({ 'di' | 'di' is consistent \}, /\\, + -- 'bottom') is a complete meet-semilattice. + -- + -- Lower and upper approximations of the exact operation /\\ + -- are given by '' and '>/\<' respectively. + -- + -- The dual operation to /\\ is partial on consistent intervals, + -- since the /intersection/ of disjoint sets is empty. Therefore, + -- the /join/-semilattice structure on 'DI' comes in two flavours: + -- + -- * the partial consistent interval-valued join \\/\? which + -- returns 'Nothing' for disjoint and anticonsistent arguments + -- and + -- + -- * the total join \\/ which returns the lowest interval in + -- 'DI' above both of its argument intervals. + -- + -- The structure ('DI', \/\\, \\\/, 'bottom', 'top') is a complete + -- lattice. + -- + -- Lower and upper approximations of the exact operations \\/\? + -- and \\\/ are given by '<\/>?', '<\/>' and '>\/<' respectively. + + -- ** Numerical order + -- | + -- Interval extensions of the corresponding tests and relations on + -- Double. + + -- *** Extrema + -- | + -- The values retured by 'least' and 'greatest' complete the + -- numerical partial order on 'DI'. + least,greatest, + + -- *** Comparability tests + (==?),(<==>?),(?), + + -- *** Order relations + (?),(<=?),(>=?), + + -- ** Refinement order + -- | + -- Tests and relations in the interval poset. + + -- *** Extrema + -- | + -- The values retured by 'bottom' and 'top' complete the + -- refinement partial order on 'DI'. + + -- **** ASCII versions + bottom,top, + + -- **** Unicode versions + (⊥),(⊤), + + -- *** Comparability tests + (|==?),(|<==>?),(|?), + + -- *** Order relations + + -- **** ASCII versions + (|?),(|<=?),(|>=?), + + -- **** Unicode versions + (⊏?),(⊑?),(⊒?),(⊐?), + + -- * Outward rounded operations + -- | + -- Interval extensions of common functions. The 'Num', 'Fractional' + -- and 'Floating' instances for 'DI' use such versions as instance + -- methods. + + -- ** Order operations + + -- *** Numerical order + -- | + -- Outward rounded interval extensions of the corresponding + -- operations on Double. + minOut,maxOut, + + -- *** Refinement order + -- | + -- Outward rounded lattice operations in the interval poset. + + -- **** ASCII versions + (),(<\/>),(<\/>?), + + -- **** Unicode versions + (<⊓>),(<⊔>),(<⊔>?), + + -- ** Field operations + + -- *** Interval operations + (<+>),(<->),(<*>),(), + + -- *** Mixed type operations + (|<+>),(<+>|),(|<*>),(<*>|),(|),(<^>), + + -- ** Special constants + piOut,eOut, + + -- ** Elementary functions + absOut,expOut,sqrtOut, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expOutIters 10 x + -- + -- which means that at most 10 iterations should be used while computing exp + expOutIters,sqrtOutIters, + + -- * Inward rounded operations + + -- ** Order operations + + -- *** Numerical order + -- | + -- Inward rounded interval extensions of the corresponding + -- operations on Double. + minIn,maxIn, + + -- *** Refinement order + + -- **** ASCII versions + (>/\<),(>\/<), + + -- **** Unicode versions + (>⊓<),(>⊔<), + + -- ** Field operations + + -- *** Interval operations + (>+<),(>-<),(>*<),(>/<), + + -- *** Mixed type operations + (|>+<),(>+<|),(|>*<),(>*<|),(>/<|),(>^<), + + -- ** Special constants + piIn,eIn, + + -- ** Elementary functions + absIn,expIn,sqrtIn, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expInIters 10 x + -- + -- which means that at most 10 iterations should be used while computing exp + expInIters,sqrtInIters, + + -- * Low level facilities + + -- ** Access functions + getEndpoints,fromEndpoints, + + -- ** Base type + Interval(..), +) +where + +import Numeric.AERN.Basics.Interval + (Interval(..)) + +import qualified Numeric.AERN.Basics.Interval as BI + (getEndpoints,fromEndpoints) + +import qualified Numeric.AERN.Basics.NumericOrder as BNO + (least,greatest) + +import qualified Numeric.AERN.Basics.NumericOrder.OpsDefaultEffort as BNOODE + ((==?),(<==>?),(?), + (?),(<=?),(>=?), + minOut,maxOut,minIn,maxIn) + +import qualified Numeric.AERN.Basics.RefinementOrder as BRO + (bottom,top,(⊥),(⊤)) + +import qualified Numeric.AERN.Basics.RefinementOrder.OpsDefaultEffort as BROODE + ((|==?),(|<==>?),(|?), + (|?),(|<=?),(|>=?),(⊏?),(⊑?),(⊒?),(⊐?), + (),(<\/>),(<\/>?),(<⊓>),(<⊔>),(<⊔>?), + (>/\<),(>\/<),(>⊓<),(>⊔<)) + +import Numeric.AERN.RealArithmetic.Interval() + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as RAROR + (RoundedMixedAdd(..),RoundedMixedMultiply(..),RoundedMixedDivide(..)) + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsDefaultEffort as RARORODE + ((<+>),(<->),(<*>),(),(|<+>),(<+>|),(|<*>),(<*>|),(|),(<^>), + piOut,eOut,absOut,expOut,sqrtOut, + (>+<),(>-<),(>*<),(>/<),(|>+<),(>+<|),(|>*<),(>*<|),(>/<|),(>^<), + piIn,eIn,absIn,expIn,sqrtIn) + +import qualified Numeric.AERN.RealArithmetic.Interval.ElementaryFromFieldOps as RAIEFFO + (expOutIters, expInIters, sqrtOutIters, sqrtInIters) + +import Numeric.AERN.RealArithmetic.Basis.Double() + +import Numeric.AERN.RealArithmetic.Interval.Double(width, bisect) + +import qualified Numeric.AERN.Basics.NumericOrder as NumOrd + +import Test.QuickCheck + +infix 4 ==?, <==>?, ?, =?, >? + +infix 4 |==?, |<==>?, |?, |=?, |>?, ⊏?, ⊑?, ⊒?, ⊐? +infixr 3 , >/\<, <⊓>, >⊓< +infixr 2 <\/>?, <\/>, >\/<, <⊔>?, <⊔>, >⊔< + +infixl 6 <+>, >+<, <->, >-< +infixl 7 <*>, >*< +infixl 8 <^>, >^< +infixl 7 , >/< + +infixr 6 |<+>, |>+< +infixl 6 <+>|, >+<| +infixr 7 |<*>, |>*< +infixl 7 <*>|, >*<| +infixl 7 |, >/<| + +-- | +-- Intervals with Double endpoints. +-- +-- Note that ('l','r') = 'getEndpoints' ('di' :: 'DI') does not +-- fix an ordering of 'l' and 'r'. +-- +-- * 'di' is called /consistent/ when 'l' '<=' 'r' +-- +-- * 'di' is called /anticonsistent/ when 'r' '<=' 'l' +-- +-- A consistent interval 'di' may be identified with the set defined by +-- \{ 'x' | 'l' '<=' 'x' and 'x' '<=' 'r' \}. +type DI = Interval Double + +-- | Given an argument interval 'i' 'getEndpoints' returns the endpoint pair +-- ('leftEndpoint' 'i','rightEndpoint' 'i'). +getEndpoints :: DI -> (Double, Double) +getEndpoints = BI.getEndpoints + +-- | Constructs an interval from an endpoint pair. +fromEndpoints :: (Double, Double) -> DI +fromEndpoints = BI.fromEndpoints + +sampleDI :: DI +sampleDI = Interval 0 0 + +least :: DI +least = BNO.least + +greatest :: DI +greatest = BNO.greatest + +-- | Partial equality +(==?) :: DI -> DI -> Maybe Bool +(==?) = (BNOODE.==?) + +-- | Partial `is comparable to` +(<==>?) :: DI -> DI -> Maybe Bool +(<==>?) = (BNOODE.<==>?) + +-- | Partial `is not comparable to` +(?) :: DI -> DI -> Maybe Bool +(?) = (BNOODE.?) + +-- | Partial `strictly less than` +( DI -> Maybe Bool +(?) :: DI -> DI -> Maybe Bool +(>?) = (BNOODE.>?) + +-- | Partial `less than or equal to` +(<=?) :: DI -> DI -> Maybe Bool +(<=?) = (BNOODE.<=?) + +-- | Partial `greater than or equal to` +(>=?) :: DI -> DI -> Maybe Bool +(>=?) = (BNOODE.>=?) + +-- | Outward rounded minimum +minOut :: DI -> DI -> DI +minOut = BNOODE.minOut + +-- | Outward rounded maximum +maxOut :: DI -> DI -> DI +maxOut = BNOODE.maxOut + +-- | Inward rounded minimum +minIn :: DI -> DI -> DI +minIn = BNOODE.minIn + +-- | Inward rounded maximum +maxIn :: DI -> DI -> DI +maxIn = BNOODE.maxIn + +bottom :: DI +bottom = BRO.bottom + +top :: DI +top = BRO.top + +-- | Convenience Unicode notation for 'bottom' +(⊥) :: DI +(⊥) = (BRO.⊥) + +-- | Convenience Unicode notation for 'top' +(⊤) :: DI +(⊤) = (BRO.⊤) + +-- | Partial equality +(|==?) :: DI -> DI -> Maybe Bool +(|==?) = (BROODE.|==?) + +-- | Partial `is comparable to` +(|<==>?) :: DI -> DI -> Maybe Bool +(|<==>?) = (BROODE.|<==>?) + +-- | Partial `is not comparable to` +(|?) :: DI -> DI -> Maybe Bool +(|?) = (BROODE.|?) + +-- | Partial `strictly below` +(| DI -> Maybe Bool +(|?) :: DI -> DI -> Maybe Bool +(|>?) = (BROODE.|>?) + +-- | Partial `below or equal to` +(|<=?) :: DI -> DI -> Maybe Bool +(|<=?) = (BROODE.|<=?) + +-- | Partial `above or equal to` +(|>=?) :: DI -> DI -> Maybe Bool +(|>=?) = (BROODE.|>=?) + +{-| Convenience Unicode notation for '| DI -> Maybe Bool +(⊏?) = (BROODE.⊏?) + +{-| Convenience Unicode notation for '|<=?' -} +(⊑?) :: DI -> DI -> Maybe Bool +(⊑?) = (BROODE.⊑?) + +{-| Convenience Unicode notation for '|>=?' -} +(⊒?) :: DI -> DI -> Maybe Bool +(⊒?) = (BROODE.⊒?) + +{-| Convenience Unicode notation for '|>?' -} +(⊐?) :: DI -> DI -> Maybe Bool +(⊐?) = (BROODE.⊐?) + +-- | Outward rounded meet +() :: DI -> DI -> DI +() = (BROODE.) + +-- | Outward rounded join +(<\/>) :: DI -> DI -> DI +(<\/>) = (BROODE.<\/>) + +-- | Inward rounded meet +(>/\<) :: DI -> DI -> DI +(>/\<) = (BROODE.>/\<) + +-- | Inward rounded join +(>\/<) :: DI -> DI -> DI +(>\/<) = (BROODE.>\/<) + +{-| Convenience Unicode notation for '' -} +(<⊓>) :: DI -> DI -> DI +(<⊓>) = (BROODE.<⊓>) + +{-| Convenience Unicode notation for '<\/>' -} +(<⊔>) :: DI -> DI -> DI +(<⊔>) = (BROODE.<⊔>) + +{-| Convenience Unicode notation for '>/\<' -} +(>⊓<) :: DI -> DI -> DI +(>⊓<) = (BROODE.>⊓<) + +{-| Convenience Unicode notation for '>\/<' -} +(>⊔<) :: DI -> DI -> DI +(>⊔<) = (BROODE.>⊔<) + +-- | Partial outward rounded join +(<\/>?) :: DI -> DI -> Maybe DI +(<\/>?) = (BROODE.<\/>?) + +{-| Convenience Unicode notation for '<\/>?' -} +(<⊔>?) :: DI -> DI -> Maybe DI +(<⊔>?) = (BROODE.<⊔>?) + +-- | Outward rounded addition +(<+>) :: DI -> DI -> DI +(<+>) = (RARORODE.<+>) + +-- | Outward rounded subtraction +(<->) :: DI -> DI -> DI +(<->) = (RARORODE.<->) + +-- | Outward rounded multiplication +(<*>) :: DI -> DI -> DI +(<*>) = (RARORODE.<*>) + +-- | Outward rounded division +() :: DI -> DI -> DI +() = (RARORODE.) + +-- | Inward rounded addition +(>+<) :: DI -> DI -> DI +(>+<) = (RARORODE.>+<) + +-- | Inward rounded subtraction +(>-<) :: DI -> DI -> DI +(>-<) = (RARORODE.>-<) + +-- | Inward rounded multiplication +(>*<) :: DI -> DI -> DI +(>*<) = (RARORODE.>*<) + +-- | Inward rounded division +(>/<) :: DI -> DI -> DI +(>/<) = (RARORODE.>/<) + +-- | Outward rounded additive scalar left action +(|<+>) :: RAROR.RoundedMixedAdd DI tn => tn -> DI -> DI +(|<+>) = (RARORODE.|<+>) + +-- | Inward rounded additive scalar left action +(|>+<) :: RAROR.RoundedMixedAdd DI tn => tn -> DI -> DI +(|>+<) = (RARORODE.|>+<) + +-- | Outward rounded additive scalar right action +(<+>|) :: RAROR.RoundedMixedAdd DI tn => DI -> tn -> DI +(<+>|) = (RARORODE.<+>|) + +-- | Inward rounded additive scalar right action +(>+<|) :: RAROR.RoundedMixedAdd DI tn => DI -> tn -> DI +(>+<|) = (RARORODE.>+<|) + +-- | Outward rounded multiplicative scalar left action +(|<*>) :: RAROR.RoundedMixedMultiply DI tn => tn -> DI -> DI +(|<*>) = (RARORODE.|<*>) + +-- | Inward rounded multiplicative scalar left action +(|>*<) :: RAROR.RoundedMixedMultiply DI tn => tn -> DI -> DI +(|>*<) = (RARORODE.|>*<) + +-- | Outward rounded multiplicative scalar right action +(<*>|) :: RAROR.RoundedMixedMultiply DI tn => DI -> tn -> DI +(<*>|) = (RARORODE.<*>|) + +-- | Inward rounded multiplicative scalar right action +(>*<|) :: RAROR.RoundedMixedMultiply DI tn => DI -> tn -> DI +(>*<|) = (RARORODE.>*<|) + +-- | Outward rounded multiplicative scalar reciprocal right action +(|) :: RAROR.RoundedMixedDivide DI tn => DI -> tn -> DI +(|) = (RARORODE.|) + +-- | Inward rounded multiplicative scalar reciprocal right action +(>/<|) :: RAROR.RoundedMixedDivide DI tn => DI -> tn -> DI +(>/<|) = (RARORODE.>/<|) + +-- | Outward rounded power +(<^>) :: DI -> Int -> DI +(<^>) = (RARORODE.<^>) + +-- | Inward rounded power +(>^<) :: DI -> Int -> DI +(>^<) = (RARORODE.>^<) + +-- | Outward rounded pi +piOut :: DI +piOut = RARORODE.piOut + +-- | Outward rounded e +eOut :: DI +eOut = RARORODE.eOut + +-- | Inward rounded pi +piIn :: DI +piIn = RARORODE.piIn + +-- | Inward rounded e +eIn :: DI +eIn = RARORODE.eIn + +-- | Outward rounded absolute value +absOut :: DI -> DI +absOut = RARORODE.absOut + +-- | Outward rounded exponential +expOut :: DI -> DI +expOut = RARORODE.expOut + +-- | Outward rounded square root +sqrtOut :: DI -> DI +sqrtOut = RARORODE.sqrtOut + +-- | Inward rounded absolute value +absIn :: DI -> DI +absIn = RARORODE.absIn + +-- | Inward rounded exponential +expIn :: DI -> DI +expIn = RARORODE.expIn + +-- | Inward rounded square root +sqrtIn :: DI -> DI +sqrtIn = RARORODE.sqrtIn + +expOutIters :: Int -> DI -> DI +expOutIters = RAIEFFO.expOutIters + +sqrtOutIters :: Int -> DI -> DI +sqrtOutIters = RAIEFFO.sqrtOutIters + +expInIters :: Int -> DI -> DI +expInIters = RAIEFFO.expInIters + +sqrtInIters :: Int -> DI -> DI +sqrtInIters = RAIEFFO.sqrtInIters + +newtype PositiveDI = PositiveDI { unPositiveDI :: DI } + +instance Show PositiveDI where + show (PositiveDI i) = show i + +instance Arbitrary PositiveDI + where + arbitrary = + do + NumOrd.UniformlyOrderedPair (l,h) <- arbitrary + return $ PositiveDI (Interval (pos l) (pos h)) + where + pos e + | e > 0 = e + | e == 0 = 1 + | otherwise = (-e) diff --git a/src/Numeric/AERN/DoubleBasis/MInterval.hs b/src/Numeric/AERN/DoubleBasis/MInterval.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/DoubleBasis/MInterval.hs @@ -0,0 +1,465 @@ +{-# LANGUAGE FlexibleContexts #-} +{-| + Module : Numeric.AERN.DoubleBasis.MInterval + Description : Interval Double type and operations + Copyright : (c) Michal Konecny, Jan Duracz + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Mutable intervals with Double endpoints. +-} +module Numeric.AERN.DoubleBasis.MInterval +( + -- | + -- A convenience module re-exporting various in-place interval + -- operations with default effort indicators. + + -- * Main type + MDI, + + -- * Outward rounded operations + + -- | + -- In-place interval extensions of common functions. + -- + -- The /first/ parameter of the in-place operations listed below + -- is the /out/ parameter. Actual parameters are allowed to appear + -- both as in and out paramers as in e.g. + -- + -- > meetOutInPlace xM xM yM + -- + -- which is equivalent to the assignment version + -- + -- > xM = yM + + -- ** Order operations + + -- *** Numerical order + -- | + -- Outward rounded in-place interval extensions of the corresponding + -- operations on Double. + minOutInPlace,maxOutInPlace, + + -- *** Refinement order + -- | + -- Outward rounded in-place lattice operations in the interval poset. + + -- **** Operations with explicit out parameter + meetOutInPlace,joinOutInPlace,partialJoinOutInPlace, + + -- **** Assignment operations + + -- ***** ASCII versions + (=),(<\/>=), + + -- ***** Unicode versions + (<⊓>=),(<⊔>=), + + -- ** Field operations + + -- *** Interval operations + + -- **** Operations with explicit out parameter + addOutInPlace,subtrOutInPlace, + multOutInPlace,divOutInPlace, + + -- **** Assignment operations + (<+>=),(<->=),(<*>=),(=), + + -- *** Mixed type operations + + -- **** Operations with explicit out parameter + mixedAddOutInPlace,mixedMultOutInPlace,mixedDivOutInPlace, + powerToNonnegIntOutInPlace, + + -- **** Assignment operations + (<+>|=),(<*>|=),(|=),(<^>=), + + -- ** Elementary functions + absOutInPlace,expOutInPlace,sqrtOutInPlace, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expOutInPlaceIters 10 resM xM + -- + -- which means that at most 10 iterations should be used while computing exp of x + expOutInPlaceIters,sqrtOutInPlaceIters, + + -- * Inward rounded operations + + -- ** Order operations + + -- *** Numerical order + -- | + -- Inward rounded in-place interval extensions of the corresponding + -- operations on Double. + minInInPlace,maxInInPlace, + + -- *** Refinement order + -- | + -- Inward rounded in-place lattice operations in the interval poset. + + -- **** Operations with explicit out parameter + meetInInPlace,joinInInPlace,partialJoinInInPlace, + + -- **** Assignment operations + + -- ***** ASCII versions + (>/\<=),(>\/<=), + + -- ***** Unicode versions + (>⊓<=),(>⊔<=), + + -- ** Field operations + + -- *** Interval operations + + -- **** Operations with explicit out parameter + addInInPlace,subtrInInPlace, + multInInPlace,divInInPlace, + + -- **** Assignment operations + (>+<=),(>-<=),(>*<=),(>/<=), + + -- *** Mixed type operations + + -- **** Operations with explicit out parameter + mixedAddInInPlace,mixedMultInInPlace,mixedDivInInPlace, + powerToNonnegIntInInPlace, + + -- **** Assignment operations + (>+<|=),(>*<|=),(>/<|=),(>^<=), + + -- ** Elementary functions + absInInPlace,expInInPlace,sqrtInInPlace, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expInInPlaceIters 10 resM xM + -- + -- which means that at most 10 iterations should be used while computing exp of x + expInInPlaceIters,sqrtInInPlaceIters, + + -- * Base class and associted type + CanBeMutable(..) +) +where + +import Numeric.AERN.Basics.Mutable + (CanBeMutable(..),OpMutable2,OpMutable1,OpPartialMutable2,OpMutableNonmut,OpNonmut) + +import qualified Numeric.AERN.Basics.NumericOrder.InPlace.OpsDefaultEffort as BNOIPODE + (minOutInPlace,maxOutInPlace, + minInInPlace,maxInInPlace) + +import qualified Numeric.AERN.Basics.RefinementOrder.InPlace.OpsDefaultEffort as BROIPODE + (meetOutInPlace,(=),(<⊓>=), + joinOutInPlace,(<\/>=),(<⊔>=), + partialJoinOutInPlace, + meetInInPlace,(>/\<=),(>⊓<=), + joinInInPlace,(>\/<=),(>⊔<=), + partialJoinInInPlace) + +import Numeric.AERN.RealArithmetic.Basis.Double() +import Numeric.AERN.RealArithmetic.Interval.Mutable() + +import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as NumOrd + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as RAROR + (RoundedMixedAddInPlace(..),RoundedMixedMultiplyInPlace(..),RoundedMixedDivideInPlace(..)) + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsDefaultEffort as RARORIPODE + (addOutInPlace,(<+>=), + subtrOutInPlace,(<->=), + multOutInPlace,(<*>=), + divOutInPlace,(=), + absOutInPlace,expOutInPlace,sqrtOutInPlace, + mixedAddOutInPlace,(<+>|=), + mixedMultOutInPlace,(<*>|=), + mixedDivOutInPlace,(|=), + powerToNonnegIntOutInPlace,(<^>=), + addInInPlace,(>+<=), + subtrInInPlace,(>-<=), + multInInPlace,(>*<=), + divInInPlace,(>/<=), + absInInPlace,expInInPlace,sqrtInInPlace, + mixedAddInInPlace,(>+<|=), + mixedMultInInPlace,(>*<|=), + mixedDivInInPlace,(>/<|=), + powerToNonnegIntInInPlace,(>^<=)) + +import qualified Numeric.AERN.RealArithmetic.Interval.Mutable.ElementaryFromFieldOps as RAIMEFFO + (expOutInPlaceIters, expInInPlaceIters, sqrtOutInPlaceIters, sqrtInInPlaceIters) + +import Numeric.AERN.DoubleBasis.Interval +import Control.Monad.ST (runST) + +infixr 3 =, >/\<=, <⊓>=, >⊓<= +infixr 2 <\/>=, >\/<=, <⊔>=, >⊔<= + +infixl 6 <+>=, >+<=, <->=, >-<= +infixl 7 <*>=, >*<= +infixl 8 <^>=, >^<= +infixl 7 =, >/<= + +infixl 6 <+>|=, >+<|= +infixl 7 <*>|=, >*<|= +infixl 7 |=, >/<|= + +-- | +-- Mutable 'DI'. Created and handled using +-- the methods of 'CanBeMutable' as in e.g. +-- +-- > square :: DI -> DI +-- > square x = +-- > runST $ +-- > do +-- > xM <- makeMutable x +-- > xM <*>= xM +-- > result <- readMutable xM +-- > return result +type MDI = Mutable DI + +-- | Outward rounded in-place minimum +minOutInPlace :: OpMutable2 DI s +minOutInPlace = BNOIPODE.minOutInPlace + +-- | Outward rounded in-place maximum +maxOutInPlace :: OpMutable2 DI s +maxOutInPlace = BNOIPODE.maxOutInPlace + +-- | Inward rounded in-place minimum +minInInPlace :: OpMutable2 DI s +minInInPlace = BNOIPODE.minInInPlace + +-- | Inward rounded in-place maximum +maxInInPlace :: OpMutable2 DI s +maxInInPlace = BNOIPODE.maxInInPlace + +-- | Outward rounded in-place meet +meetOutInPlace :: OpMutable2 DI s +meetOutInPlace = BROIPODE.meetOutInPlace + +-- | Outward rounded meet assignment +(=) :: OpMutable1 DI s +(=) = (BROIPODE.=) + +-- | Inward rounded in-place meet +meetInInPlace :: OpMutable2 DI s +meetInInPlace = BROIPODE.meetInInPlace + +-- | Inward rounded meet assignment +(>/\<=) :: OpMutable1 DI s +(>/\<=) = (BROIPODE.>/\<=) + +-- | Outward rounded in-place join +joinOutInPlace :: OpMutable2 DI s +joinOutInPlace = BROIPODE.joinOutInPlace + +-- | Outward rounded join assignment +(<\/>=) :: OpMutable1 DI s +(<\/>=) = (BROIPODE.<\/>=) + +-- | Inward rounded in-place join +joinInInPlace :: OpMutable2 DI s +joinInInPlace = BROIPODE.joinInInPlace + +-- | Inward rounded join assignment +(>\/<=) :: OpMutable1 DI s +(>\/<=) = (BROIPODE.>\/<=) + +-- | Partial outward rounded in-place join +partialJoinOutInPlace :: OpPartialMutable2 DI s +partialJoinOutInPlace = BROIPODE.partialJoinOutInPlace + +-- | Partial inward rounded in-place join +partialJoinInInPlace :: OpPartialMutable2 DI s +partialJoinInInPlace = BROIPODE.partialJoinInInPlace + +{-| Convenience Unicode notation for '<\/>=' -} +(<⊔>=) :: OpMutable1 DI s +(<⊔>=) = (<\/>=) + +{-| Convenience Unicode notation for '=' -} +(<⊓>=) :: OpMutable1 DI s +(<⊓>=) = (=) + +{-| Convenience Unicode notation for '>\/<=' -} +(>⊔<=) :: OpMutable1 DI s +(>⊔<=) = (>\/<=) + +{-| Convenience Unicode notation for '>/\<=' -} +(>⊓<=) :: OpMutable1 DI s +(>⊓<=) = (>/\<=) + +-- | Inward rounded in-place addition +addInInPlace :: OpMutable2 DI s +addInInPlace = RARORIPODE.addInInPlace + +-- | Inward rounded addition assignment +(>+<=) :: OpMutable1 DI s +(>+<=) = (RARORIPODE.>+<=) + +-- | Outward rounded in-place addition +addOutInPlace :: OpMutable2 DI s +addOutInPlace = RARORIPODE.addOutInPlace + +-- | Outward rounded addition assignment +(<+>=) :: OpMutable1 DI s +(<+>=) = (RARORIPODE.<+>=) + +-- | Inward rounded in-place subtraction +subtrInInPlace :: OpMutable2 DI s +subtrInInPlace = RARORIPODE.subtrInInPlace + +-- | Inward rounded subtraction assignment +(>-<=) :: OpMutable1 DI s +(>-<=) = (RARORIPODE.>-<=) + +-- | Outward rounded in-place subtraction +subtrOutInPlace :: OpMutable2 DI s +subtrOutInPlace = RARORIPODE.subtrOutInPlace + +-- | Outward rounded subtraction assignment +(<->=) :: OpMutable1 DI s +(<->=) = (RARORIPODE.<->=) + +-- | Inward rounded in-place absolute value +absInInPlace :: OpMutable1 DI s +absInInPlace = RARORIPODE.absInInPlace + +-- | Outward rounded in-place absolute value +absOutInPlace :: OpMutable1 DI s +absOutInPlace = RARORIPODE.absOutInPlace + +-- | Inward rounded in-place multiplication +multInInPlace :: OpMutable2 DI s +multInInPlace = RARORIPODE.multInInPlace + +-- | Inward rounded multiplication assignment +(>*<=) :: OpMutable1 DI s +(>*<=) = (RARORIPODE.>*<=) + +-- | Outward rounded in-place multiplication +multOutInPlace :: OpMutable2 DI s +multOutInPlace = RARORIPODE.multOutInPlace + +-- | Outward rounded multiplication assignment +(<*>=) :: OpMutable1 DI s +(<*>=) = (RARORIPODE.<*>=) + +-- | Inward rounded in-place power +powerToNonnegIntInInPlace :: OpMutableNonmut DI Int s +powerToNonnegIntInInPlace = RARORIPODE.powerToNonnegIntInInPlace + +-- | Inward rounded in-place power assignment +(>^<=) :: OpNonmut DI Int s +(>^<=) = (RARORIPODE.>^<=) + +-- | Outward rounded in-place power +powerToNonnegIntOutInPlace :: OpMutableNonmut DI Int s +powerToNonnegIntOutInPlace = RARORIPODE.powerToNonnegIntOutInPlace + +-- | Inward rounded in-place power assignment +(<^>=) :: OpNonmut DI Int s +(<^>=) = (RARORIPODE.<^>=) + +-- | Inward rounded in-place division +divInInPlace :: OpMutable2 DI s +divInInPlace = RARORIPODE.divInInPlace + +-- | Inward rounded division assignment +(>/<=) :: OpMutable1 DI s +(>/<=) = (RARORIPODE.>/<=) + +-- | Outward rounded in-place division +divOutInPlace :: OpMutable2 DI s +divOutInPlace = RARORIPODE.divOutInPlace + +-- | Outward rounded division assignment +(=) :: OpMutable1 DI s +(=) = (RARORIPODE.=) + +-- | Inward rounded in-place mixed addition +mixedAddInInPlace :: (RAROR.RoundedMixedAddInPlace DI tn) => + OpMutableNonmut DI tn s +mixedAddInInPlace = RARORIPODE.mixedAddInInPlace + +-- | Inward rounded additive scalar action assignment +(>+<|=) :: (RAROR.RoundedMixedAddInPlace DI tn) => OpNonmut DI tn s +(>+<|=) = (RARORIPODE.>+<|=) + +-- | Outward rounded in-place mixed addition +mixedAddOutInPlace :: (RAROR.RoundedMixedAddInPlace DI tn) => + OpMutableNonmut DI tn s +mixedAddOutInPlace = RARORIPODE.mixedAddOutInPlace + +-- | Outward rounded additive scalar action assignment +(<+>|=) :: (RAROR.RoundedMixedAddInPlace DI tn) => OpNonmut DI tn s +(<+>|=) = (RARORIPODE.<+>|=) + +-- | Inward rounded in-place mixed multiplication +mixedMultInInPlace :: (RAROR.RoundedMixedMultiplyInPlace DI tn) => + OpMutableNonmut DI tn s +mixedMultInInPlace = RARORIPODE.mixedMultInInPlace + +-- | Inward rounded multiplicative scalar action assignment +(>*<|=) :: (RAROR.RoundedMixedMultiplyInPlace DI tn) => OpNonmut DI tn s +(>*<|=) = (RARORIPODE.>*<|=) + +-- | Outward rounded in-place mixed multiplication +mixedMultOutInPlace :: (RAROR.RoundedMixedMultiplyInPlace DI tn) => + OpMutableNonmut DI tn s +mixedMultOutInPlace = RARORIPODE.mixedMultOutInPlace + +-- | Outward rounded multiplicative scalar action assignment +(<*>|=) :: (RAROR.RoundedMixedMultiplyInPlace DI tn) => OpNonmut DI tn s +(<*>|=) = (RARORIPODE.<*>|=) + +-- | Inward rounded in-place mixed reciprocal action +mixedDivInInPlace :: (RAROR.RoundedMixedDivideInPlace DI tn) => + OpMutableNonmut DI tn s +mixedDivInInPlace = RARORIPODE.mixedDivInInPlace + +-- | Inward rounded multiplicative scalar reciprocal action assignment +(>/<|=) :: (RAROR.RoundedMixedDivideInPlace DI tn) => OpNonmut DI tn s +(>/<|=) = (RARORIPODE.>/<|=) + +-- | Outward rounded in-place mixed reciprocal action +mixedDivOutInPlace :: (RAROR.RoundedMixedDivideInPlace DI tn) => + OpMutableNonmut DI tn s +mixedDivOutInPlace = RARORIPODE.mixedDivOutInPlace + +-- | Outward rounded multiplicative scalar reciprocal action assignment +(|=) :: (RAROR.RoundedMixedDivideInPlace DI tn) => OpNonmut DI tn s +(|=) = (RARORIPODE.|=) + +-- | Inward rounded in-place exponential +expInInPlace :: OpMutable1 DI s +expInInPlace = RARORIPODE.expInInPlace + +-- | Outward rounded in-place exponential +expOutInPlace :: OpMutable1 DI s +expOutInPlace = RARORIPODE.expOutInPlace + +-- | Inward rounded in-place square root +sqrtInInPlace :: OpMutable1 DI s +sqrtInInPlace = RARORIPODE.sqrtInInPlace + +-- | Outward rounded in-place square root +sqrtOutInPlace :: OpMutable1 DI s +sqrtOutInPlace = RARORIPODE.sqrtOutInPlace + +expOutInPlaceIters, sqrtOutInPlaceIters, + expInInPlaceIters, sqrtInInPlaceIters :: Int -> OpMutable1 DI s +expOutInPlaceIters = RAIMEFFO.expOutInPlaceIters +sqrtOutInPlaceIters = RAIMEFFO.sqrtOutInPlaceIters +expInInPlaceIters = RAIMEFFO.expInInPlaceIters +sqrtInInPlaceIters = RAIMEFFO.sqrtInInPlaceIters diff --git a/src/Numeric/AERN/DoubleBasis/MRealApprox.hs b/src/Numeric/AERN/DoubleBasis/MRealApprox.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/DoubleBasis/MRealApprox.hs @@ -0,0 +1,266 @@ +{-# LANGUAGE FlexibleContexts #-} +{-| + Module : Numeric.AERN.DoubleBasis.MRealApprox + Description : Mutable Double intervals for approximating real numbers + Copyright : (c) Michal Konecny, Jan Duracz + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Mutable version of the abstract data type 'RealApprox'. +-} +module Numeric.AERN.DoubleBasis.MRealApprox +( + -- | + -- A convenience module re-exporting various in-place interval + -- operations with default effort indicators. + + -- * Main type + MRealApprox, + + -- * Outward rounded operations + + -- | + -- In-place interval extensions of common functions. + -- + -- The /first/ parameter of the in-place operations listed below + -- is the /out/ parameter. Actual parameters are allowed to appear + -- both as in and out paramers as in e.g. + -- + -- > meetOutInPlace xM xM yM + -- + -- which is equivalent to the assignment version + -- + -- > xM = yM + + -- ** Order operations + + -- *** Numerical order + -- | + -- Outward rounded in-place interval extensions of the corresponding + -- operations on Double. + minOutInPlace,maxOutInPlace, + + -- *** Refinement order + -- | + -- Outward rounded in-place lattice operations in the interval poset. + + -- **** Operations with explicit out parameter + meetOutInPlace,partialJoinOutInPlace, + + -- **** Assignment operations + + -- ***** ASCII versions + (=), + + -- ***** Unicode versions + (<⊓>=), + + -- ** Field operations + + -- *** Interval operations + + -- **** Operations with explicit out parameter + addOutInPlace,subtrOutInPlace, + multOutInPlace,divOutInPlace, + + -- **** Assignment operations + (<+>=),(<->=),(<*>=),(=), + + -- *** Mixed type operations + + -- **** Operations with explicit out parameter + mixedAddOutInPlace,mixedMultOutInPlace,mixedDivOutInPlace, + powerToNonnegIntOutInPlace, + + -- **** Assignment operations + (<+>|=),(<*>|=),(|=),(<^>=), + + -- ** Elementary functions + absOutInPlace,expOutInPlace,sqrtOutInPlace, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expOutInPlaceIters 10 resM xM + -- + -- which means that at most 10 iterations should be used while computing exp of x + expOutInPlaceIters,sqrtOutInPlaceIters, + + -- * Base class and associted type + CanBeMutable(..) +) +where + +import Numeric.AERN.Basics.Mutable + (CanBeMutable(..),OpMutable2,OpMutable1,OpPartialMutable2,OpMutableNonmut,OpNonmut) + +import qualified Numeric.AERN.Basics.NumericOrder.InPlace.OpsDefaultEffort as BNOIPODE + (minOutInPlace,maxOutInPlace) + +import Numeric.AERN.Basics.RefinementOrder +import qualified Numeric.AERN.Basics.RefinementOrder.InPlace.OpsDefaultEffort as BROIPODE + (meetOutInPlace,(=),(<⊓>=), + partialJoinOutInPlace) + +import Numeric.AERN.RealArithmetic.Basis.Double() +import Numeric.AERN.RealArithmetic.Interval.Mutable() + +import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as NumOrd + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as RAROR + (RoundedMixedAddInPlace(..),RoundedMixedMultiplyInPlace(..),RoundedMixedDivideInPlace(..)) + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsDefaultEffort as RARORIPODE + (addOutInPlace,(<+>=), + subtrOutInPlace,(<->=), + multOutInPlace,(<*>=), + divOutInPlace,(=), + absOutInPlace, + expOutInPlace, + sqrtOutInPlace, + mixedAddOutInPlace,(<+>|=), + mixedMultOutInPlace,(<*>|=), + mixedDivOutInPlace,(|=), + powerToNonnegIntOutInPlace,(<^>=)) + +import qualified Numeric.AERN.RealArithmetic.Interval.Mutable.ElementaryFromFieldOps as RAIMEFFO + (expOutInPlaceIters, sqrtOutInPlaceIters) + +import Numeric.AERN.DoubleBasis.RealApprox (RealApprox) +import Control.Monad.ST (runST) + +infixr 3 =, <⊓>= + +infixl 6 <+>=, <->= +infixl 7 <*>= +infixl 8 <^>= +infixl 7 = + +infixl 6 <+>|= +infixl 7 <*>|= +infixl 7 |= + +-- | +-- Mutable 'RealApprox'. Created and handled using +-- the methods of 'CanBeMutable' as in e.g. +-- +-- > square :: RealApprox -> RealApprox +-- > square x = +-- > runST $ +-- > do +-- > xM <- makeMutable x +-- > xM <*>= xM +-- > result <- readMutable xM +-- > return result +type MRealApprox = Mutable RealApprox + +-- | Outward rounded in-place minimum +minOutInPlace :: OpMutable2 RealApprox s +minOutInPlace = BNOIPODE.minOutInPlace + +-- | Outward rounded in-place maximum +maxOutInPlace :: OpMutable2 RealApprox s +maxOutInPlace = BNOIPODE.maxOutInPlace + +-- | Outward rounded in-place meet +meetOutInPlace :: OpMutable2 RealApprox s +meetOutInPlace = BROIPODE.meetOutInPlace + +-- | Outward rounded meet assignment +(=) :: OpMutable1 RealApprox s +(=) = (BROIPODE.=) + +-- | Partial outward rounded in-place join +partialJoinOutInPlace :: OpPartialMutable2 RealApprox s +partialJoinOutInPlace = BROIPODE.partialJoinOutInPlace + +{-| Convenience Unicode notation for '=' -} +(<⊓>=) :: OpMutable1 RealApprox s +(<⊓>=) = (=) + +-- | Outward rounded in-place addition +addOutInPlace :: OpMutable2 RealApprox s +addOutInPlace = RARORIPODE.addOutInPlace + +-- | Outward rounded addition assignment +(<+>=) :: OpMutable1 RealApprox s +(<+>=) = (RARORIPODE.<+>=) + +-- | Outward rounded in-place subtraction +subtrOutInPlace :: OpMutable2 RealApprox s +subtrOutInPlace = RARORIPODE.subtrOutInPlace + +-- | Outward rounded subtraction assignment +(<->=) :: OpMutable1 RealApprox s +(<->=) = (RARORIPODE.<->=) + +-- | Outward rounded in-place absolute value +absOutInPlace :: OpMutable1 RealApprox s +absOutInPlace = RARORIPODE.absOutInPlace + +-- | Outward rounded in-place multiplication +multOutInPlace :: OpMutable2 RealApprox s +multOutInPlace = RARORIPODE.multOutInPlace + +-- | Outward rounded multiplication assignment +(<*>=) :: OpMutable1 RealApprox s +(<*>=) = (RARORIPODE.<*>=) + +-- | Outward rounded in-place power +powerToNonnegIntOutInPlace :: OpMutableNonmut RealApprox Int s +powerToNonnegIntOutInPlace = RARORIPODE.powerToNonnegIntOutInPlace + +-- | Inward rounded in-place power assignment +(<^>=) :: OpNonmut RealApprox Int s +(<^>=) = (RARORIPODE.<^>=) + +-- | Outward rounded in-place division +divOutInPlace :: OpMutable2 RealApprox s +divOutInPlace = RARORIPODE.divOutInPlace + +-- | Outward rounded division assignment +(=) :: OpMutable1 RealApprox s +(=) = (RARORIPODE.=) + +-- | Outward rounded in-place mixed addition +mixedAddOutInPlace :: (RAROR.RoundedMixedAddInPlace RealApprox tn) => + OpMutableNonmut RealApprox tn s +mixedAddOutInPlace = RARORIPODE.mixedAddOutInPlace + +-- | Outward rounded additive scalar action assignment +(<+>|=) :: (RAROR.RoundedMixedAddInPlace RealApprox tn) => OpNonmut RealApprox tn s +(<+>|=) = (RARORIPODE.<+>|=) + +-- | Outward rounded in-place mixed multiplication +mixedMultOutInPlace :: (RAROR.RoundedMixedMultiplyInPlace RealApprox tn) => + OpMutableNonmut RealApprox tn s +mixedMultOutInPlace = RARORIPODE.mixedMultOutInPlace + +-- | Outward rounded multiplicative scalar action assignment +(<*>|=) :: (RAROR.RoundedMixedMultiplyInPlace RealApprox tn) => OpNonmut RealApprox tn s +(<*>|=) = (RARORIPODE.<*>|=) + +-- | Outward rounded in-place mixed reciprocal action +mixedDivOutInPlace :: (RAROR.RoundedMixedDivideInPlace RealApprox tn) => + OpMutableNonmut RealApprox tn s +mixedDivOutInPlace = RARORIPODE.mixedDivOutInPlace + +-- | Outward rounded multiplicative scalar reciprocal action assignment +(|=) :: (RAROR.RoundedMixedDivideInPlace RealApprox tn) => OpNonmut RealApprox tn s +(|=) = (RARORIPODE.|=) + +-- | Outward rounded in-place exponential +expOutInPlace :: OpMutable1 RealApprox s +expOutInPlace = RARORIPODE.expOutInPlace + +-- | Outward rounded in-place square root +sqrtOutInPlace :: OpMutable1 RealApprox s +sqrtOutInPlace = RARORIPODE.sqrtOutInPlace + +expOutInPlaceIters, sqrtOutInPlaceIters :: Int -> OpMutable1 RealApprox s +expOutInPlaceIters = RAIMEFFO.expOutInPlaceIters +sqrtOutInPlaceIters = RAIMEFFO.sqrtOutInPlaceIters diff --git a/src/Numeric/AERN/DoubleBasis/MRealIntervalApprox.hs b/src/Numeric/AERN/DoubleBasis/MRealIntervalApprox.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/DoubleBasis/MRealIntervalApprox.hs @@ -0,0 +1,466 @@ +{-# LANGUAGE FlexibleContexts #-} +{-| + Module : Numeric.AERN.DoubleBasis.MRealIntervalApprox + Description : Mutable Double intervals for approximating real intervals + Copyright : (c) Michal Konecny, Jan Duracz + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Mutable versions of the abstract data type 'RealIntervalApprox' +-} +module Numeric.AERN.DoubleBasis.MRealIntervalApprox +( + -- | + -- A convenience module re-exporting various in-place interval + -- operations with default effort indicators. + + -- * Main type + MRealIntervalApprox, + + -- * Outward rounded operations + + -- | + -- In-place interval extensions of common functions. + -- + -- The /first/ parameter of the in-place operations listed below + -- is the /out/ parameter. Actual parameters are allowed to appear + -- both as in and out paramers as in e.g. + -- + -- > meetOutInPlace xM xM yM + -- + -- which is equivalent to the assignment version + -- + -- > xM = yM + + -- ** Order operations + + -- *** Numerical order + -- | + -- Outward rounded in-place interval extensions of the corresponding + -- operations on Double. + minOutInPlace,maxOutInPlace, + + -- *** Refinement order + -- | + -- Outward rounded in-place lattice operations in the interval poset. + + -- **** Operations with explicit out parameter + meetOutInPlace,joinOutInPlace,partialJoinOutInPlace, + + -- **** Assignment operations + + -- ***** ASCII versions + (=),(<\/>=), + + -- ***** Unicode versions + (<⊓>=),(<⊔>=), + + -- ** Field operations + + -- *** Interval operations + + -- **** Operations with explicit out parameter + addOutInPlace,subtrOutInPlace, + multOutInPlace,divOutInPlace, + + -- **** Assignment operations + (<+>=),(<->=),(<*>=),(=), + + -- *** Mixed type operations + + -- **** Operations with explicit out parameter + mixedAddOutInPlace,mixedMultOutInPlace,mixedDivOutInPlace, + powerToNonnegIntOutInPlace, + + -- **** Assignment operations + (<+>|=),(<*>|=),(|=),(<^>=), + + -- ** Elementary functions + absOutInPlace,expOutInPlace,sqrtOutInPlace, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expOutInPlaceIters 10 resM xM + -- + -- which means that at most 10 iterations should be used while computing exp of x + expOutInPlaceIters,sqrtOutInPlaceIters, + + -- * Inward rounded operations + + -- ** Order operations + + -- *** Numerical order + -- | + -- Inward rounded in-place interval extensions of the corresponding + -- operations on Double. + minInInPlace,maxInInPlace, + + -- *** Refinement order + -- | + -- Inward rounded in-place lattice operations in the interval poset. + + -- **** Operations with explicit out parameter + meetInInPlace,joinInInPlace,partialJoinInInPlace, + + -- **** Assignment operations + + -- ***** ASCII versions + (>/\<=),(>\/<=), + + -- ***** Unicode versions + (>⊓<=),(>⊔<=), + + -- ** Field operations + + -- *** Interval operations + + -- **** Operations with explicit out parameter + addInInPlace,subtrInInPlace, + multInInPlace,divInInPlace, + + -- **** Assignment operations + (>+<=),(>-<=),(>*<=),(>/<=), + + -- *** Mixed type operations + + -- **** Operations with explicit out parameter + mixedAddInInPlace,mixedMultInInPlace,mixedDivInInPlace, + powerToNonnegIntInInPlace, + + -- **** Assignment operations + (>+<|=),(>*<|=),(>/<|=),(>^<=), + + -- ** Elementary functions + absInInPlace,expInInPlace,sqrtInInPlace, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expInInPlaceIters 10 resM xM + -- + -- which means that at most 10 iterations should be used while computing exp of x + expInInPlaceIters,sqrtInInPlaceIters, + + -- * Base class and associted type + CanBeMutable(..) +) +where + +import Numeric.AERN.Basics.Mutable + (CanBeMutable(..),OpMutable2,OpMutable1,OpPartialMutable2,OpMutableNonmut,OpNonmut) + +import qualified Numeric.AERN.Basics.NumericOrder.InPlace.OpsDefaultEffort as BNOIPODE + (minOutInPlace,maxOutInPlace, + minInInPlace,maxInInPlace) + +import qualified Numeric.AERN.Basics.RefinementOrder.InPlace.OpsDefaultEffort as BROIPODE + (meetOutInPlace,(=),(<⊓>=), + joinOutInPlace,(<\/>=),(<⊔>=), + partialJoinOutInPlace, + meetInInPlace,(>/\<=),(>⊓<=), + joinInInPlace,(>\/<=),(>⊔<=), + partialJoinInInPlace) + +import Numeric.AERN.RealArithmetic.Basis.Double() +import Numeric.AERN.RealArithmetic.Interval.Mutable() + +import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as NumOrd + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as RAROR + (RoundedMixedAddInPlace(..),RoundedMixedMultiplyInPlace(..),RoundedMixedDivideInPlace(..)) + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding.InPlace.OpsDefaultEffort as RARORIPODE + (addOutInPlace,(<+>=), + subtrOutInPlace,(<->=), + multOutInPlace,(<*>=), + divOutInPlace,(=), + absOutInPlace,expOutInPlace,sqrtOutInPlace, + mixedAddOutInPlace,(<+>|=), + mixedMultOutInPlace,(<*>|=), + mixedDivOutInPlace,(|=), + powerToNonnegIntOutInPlace,(<^>=), + addInInPlace,(>+<=), + subtrInInPlace,(>-<=), + multInInPlace,(>*<=), + divInInPlace,(>/<=), + absInInPlace,expInInPlace,sqrtInInPlace, + mixedAddInInPlace,(>+<|=), + mixedMultInInPlace,(>*<|=), + mixedDivInInPlace,(>/<|=), + powerToNonnegIntInInPlace,(>^<=)) + +import qualified Numeric.AERN.RealArithmetic.Interval.Mutable.ElementaryFromFieldOps as RAIMEFFO + (expOutInPlaceIters, expInInPlaceIters, sqrtOutInPlaceIters, sqrtInInPlaceIters) + +import Numeric.AERN.DoubleBasis.RealIntervalApprox (RealIntervalApprox) +import Control.Monad.ST (runST) + +infixr 3 =, >/\<=, <⊓>=, >⊓<= +infixr 2 <\/>=, >\/<=, <⊔>=, >⊔<= + +infixl 6 <+>=, >+<=, <->=, >-<= +infixl 7 <*>=, >*<= +infixl 8 <^>=, >^<= +infixl 7 =, >/<= + +infixl 6 <+>|=, >+<|= +infixl 7 <*>|=, >*<|= +infixl 7 |=, >/<|= + +-- | +-- Mutable 'RealIntervalApprox'. Created and handled using +-- the methods of 'CanBeMutable' as in e.g. +-- +-- > square :: RealIntervalApprox -> RealIntervalApprox +-- > square x = +-- > runST $ +-- > do +-- > xM <- makeMutable x +-- > xM <*>= xM +-- > result <- readMutable xM +-- > return result +type MRealIntervalApprox = Mutable RealIntervalApprox + +-- | Outward rounded in-place minimum +minOutInPlace :: OpMutable2 RealIntervalApprox s +minOutInPlace = BNOIPODE.minOutInPlace + +-- | Outward rounded in-place maximum +maxOutInPlace :: OpMutable2 RealIntervalApprox s +maxOutInPlace = BNOIPODE.maxOutInPlace + +-- | Inward rounded in-place minimum +minInInPlace :: OpMutable2 RealIntervalApprox s +minInInPlace = BNOIPODE.minInInPlace + +-- | Inward rounded in-place maximum +maxInInPlace :: OpMutable2 RealIntervalApprox s +maxInInPlace = BNOIPODE.maxInInPlace + +-- | Outward rounded in-place meet +meetOutInPlace :: OpMutable2 RealIntervalApprox s +meetOutInPlace = BROIPODE.meetOutInPlace + +-- | Outward rounded meet assignment +(=) :: OpMutable1 RealIntervalApprox s +(=) = (BROIPODE.=) + +-- | Inward rounded in-place meet +meetInInPlace :: OpMutable2 RealIntervalApprox s +meetInInPlace = BROIPODE.meetInInPlace + +-- | Inward rounded meet assignment +(>/\<=) :: OpMutable1 RealIntervalApprox s +(>/\<=) = (BROIPODE.>/\<=) + +-- | Outward rounded in-place join +joinOutInPlace :: OpMutable2 RealIntervalApprox s +joinOutInPlace = BROIPODE.joinOutInPlace + +-- | Outward rounded join assignment +(<\/>=) :: OpMutable1 RealIntervalApprox s +(<\/>=) = (BROIPODE.<\/>=) + +-- | Inward rounded in-place join +joinInInPlace :: OpMutable2 RealIntervalApprox s +joinInInPlace = BROIPODE.joinInInPlace + +-- | Inward rounded join assignment +(>\/<=) :: OpMutable1 RealIntervalApprox s +(>\/<=) = (BROIPODE.>\/<=) + +-- | Partial outward rounded in-place join +partialJoinOutInPlace :: OpPartialMutable2 RealIntervalApprox s +partialJoinOutInPlace = BROIPODE.partialJoinOutInPlace + +-- | Partial inward rounded in-place join +partialJoinInInPlace :: OpPartialMutable2 RealIntervalApprox s +partialJoinInInPlace = BROIPODE.partialJoinInInPlace + +{-| Convenience Unicode notation for '<\/>=' -} +(<⊔>=) :: OpMutable1 RealIntervalApprox s +(<⊔>=) = (<\/>=) + +{-| Convenience Unicode notation for '=' -} +(<⊓>=) :: OpMutable1 RealIntervalApprox s +(<⊓>=) = (=) + +{-| Convenience Unicode notation for '>\/<=' -} +(>⊔<=) :: OpMutable1 RealIntervalApprox s +(>⊔<=) = (>\/<=) + +{-| Convenience Unicode notation for '>/\<=' -} +(>⊓<=) :: OpMutable1 RealIntervalApprox s +(>⊓<=) = (>/\<=) + +-- | Inward rounded in-place addition +addInInPlace :: OpMutable2 RealIntervalApprox s +addInInPlace = RARORIPODE.addInInPlace + +-- | Inward rounded addition assignment +(>+<=) :: OpMutable1 RealIntervalApprox s +(>+<=) = (RARORIPODE.>+<=) + +-- | Outward rounded in-place addition +addOutInPlace :: OpMutable2 RealIntervalApprox s +addOutInPlace = RARORIPODE.addOutInPlace + +-- | Outward rounded addition assignment +(<+>=) :: OpMutable1 RealIntervalApprox s +(<+>=) = (RARORIPODE.<+>=) + +-- | Inward rounded in-place subtraction +subtrInInPlace :: OpMutable2 RealIntervalApprox s +subtrInInPlace = RARORIPODE.subtrInInPlace + +-- | Inward rounded subtraction assignment +(>-<=) :: OpMutable1 RealIntervalApprox s +(>-<=) = (RARORIPODE.>-<=) + +-- | Outward rounded in-place subtraction +subtrOutInPlace :: OpMutable2 RealIntervalApprox s +subtrOutInPlace = RARORIPODE.subtrOutInPlace + +-- | Outward rounded subtraction assignment +(<->=) :: OpMutable1 RealIntervalApprox s +(<->=) = (RARORIPODE.<->=) + +-- | Inward rounded in-place absolute value +absInInPlace :: OpMutable1 RealIntervalApprox s +absInInPlace = RARORIPODE.absInInPlace + +-- | Outward rounded in-place absolute value +absOutInPlace :: OpMutable1 RealIntervalApprox s +absOutInPlace = RARORIPODE.absOutInPlace + +-- | Inward rounded in-place multiplication +multInInPlace :: OpMutable2 RealIntervalApprox s +multInInPlace = RARORIPODE.multInInPlace + +-- | Inward rounded multiplication assignment +(>*<=) :: OpMutable1 RealIntervalApprox s +(>*<=) = (RARORIPODE.>*<=) + +-- | Outward rounded in-place multiplication +multOutInPlace :: OpMutable2 RealIntervalApprox s +multOutInPlace = RARORIPODE.multOutInPlace + +-- | Outward rounded multiplication assignment +(<*>=) :: OpMutable1 RealIntervalApprox s +(<*>=) = (RARORIPODE.<*>=) + +-- | Inward rounded in-place power +powerToNonnegIntInInPlace :: OpMutableNonmut RealIntervalApprox Int s +powerToNonnegIntInInPlace = RARORIPODE.powerToNonnegIntInInPlace + +-- | Inward rounded in-place power assignment +(>^<=) :: OpNonmut RealIntervalApprox Int s +(>^<=) = (RARORIPODE.>^<=) + +-- | Outward rounded in-place power +powerToNonnegIntOutInPlace :: OpMutableNonmut RealIntervalApprox Int s +powerToNonnegIntOutInPlace = RARORIPODE.powerToNonnegIntOutInPlace + +-- | Inward rounded in-place power assignment +(<^>=) :: OpNonmut RealIntervalApprox Int s +(<^>=) = (RARORIPODE.<^>=) + +-- | Inward rounded in-place division +divInInPlace :: OpMutable2 RealIntervalApprox s +divInInPlace = RARORIPODE.divInInPlace + +-- | Inward rounded division assignment +(>/<=) :: OpMutable1 RealIntervalApprox s +(>/<=) = (RARORIPODE.>/<=) + +-- | Outward rounded in-place division +divOutInPlace :: OpMutable2 RealIntervalApprox s +divOutInPlace = RARORIPODE.divOutInPlace + +-- | Outward rounded division assignment +(=) :: OpMutable1 RealIntervalApprox s +(=) = (RARORIPODE.=) + +-- | Inward rounded in-place mixed addition +mixedAddInInPlace :: (RAROR.RoundedMixedAddInPlace RealIntervalApprox tn) => + OpMutableNonmut RealIntervalApprox tn s +mixedAddInInPlace = RARORIPODE.mixedAddInInPlace + +-- | Inward rounded additive scalar action assignment +(>+<|=) :: (RAROR.RoundedMixedAddInPlace RealIntervalApprox tn) => OpNonmut RealIntervalApprox tn s +(>+<|=) = (RARORIPODE.>+<|=) + +-- | Outward rounded in-place mixed addition +mixedAddOutInPlace :: (RAROR.RoundedMixedAddInPlace RealIntervalApprox tn) => + OpMutableNonmut RealIntervalApprox tn s +mixedAddOutInPlace = RARORIPODE.mixedAddOutInPlace + +-- | Outward rounded additive scalar action assignment +(<+>|=) :: (RAROR.RoundedMixedAddInPlace RealIntervalApprox tn) => OpNonmut RealIntervalApprox tn s +(<+>|=) = (RARORIPODE.<+>|=) + +-- | Inward rounded in-place mixed multiplication +mixedMultInInPlace :: (RAROR.RoundedMixedMultiplyInPlace RealIntervalApprox tn) => + OpMutableNonmut RealIntervalApprox tn s +mixedMultInInPlace = RARORIPODE.mixedMultInInPlace + +-- | Inward rounded multiplicative scalar action assignment +(>*<|=) :: (RAROR.RoundedMixedMultiplyInPlace RealIntervalApprox tn) => OpNonmut RealIntervalApprox tn s +(>*<|=) = (RARORIPODE.>*<|=) + +-- | Outward rounded in-place mixed multiplication +mixedMultOutInPlace :: (RAROR.RoundedMixedMultiplyInPlace RealIntervalApprox tn) => + OpMutableNonmut RealIntervalApprox tn s +mixedMultOutInPlace = RARORIPODE.mixedMultOutInPlace + +-- | Outward rounded multiplicative scalar action assignment +(<*>|=) :: (RAROR.RoundedMixedMultiplyInPlace RealIntervalApprox tn) => OpNonmut RealIntervalApprox tn s +(<*>|=) = (RARORIPODE.<*>|=) + +-- | Inward rounded in-place mixed reciprocal action +mixedDivInInPlace :: (RAROR.RoundedMixedDivideInPlace RealIntervalApprox tn) => + OpMutableNonmut RealIntervalApprox tn s +mixedDivInInPlace = RARORIPODE.mixedDivInInPlace + +-- | Inward rounded multiplicative scalar reciprocal action assignment +(>/<|=) :: (RAROR.RoundedMixedDivideInPlace RealIntervalApprox tn) => OpNonmut RealIntervalApprox tn s +(>/<|=) = (RARORIPODE.>/<|=) + +-- | Outward rounded in-place mixed reciprocal action +mixedDivOutInPlace :: (RAROR.RoundedMixedDivideInPlace RealIntervalApprox tn) => + OpMutableNonmut RealIntervalApprox tn s +mixedDivOutInPlace = RARORIPODE.mixedDivOutInPlace + +-- | Outward rounded multiplicative scalar reciprocal action assignment +(|=) :: (RAROR.RoundedMixedDivideInPlace RealIntervalApprox tn) => OpNonmut RealIntervalApprox tn s +(|=) = (RARORIPODE.|=) + +-- | Inward rounded in-place exponential +expInInPlace :: OpMutable1 RealIntervalApprox s +expInInPlace = RARORIPODE.expInInPlace + +-- | Outward rounded in-place exponential +expOutInPlace :: OpMutable1 RealIntervalApprox s +expOutInPlace = RARORIPODE.expOutInPlace + +-- | Inward rounded in-place square root +sqrtInInPlace :: OpMutable1 RealIntervalApprox s +sqrtInInPlace = RARORIPODE.sqrtInInPlace + +-- | Outward rounded in-place square root +sqrtOutInPlace :: OpMutable1 RealIntervalApprox s +sqrtOutInPlace = RARORIPODE.sqrtOutInPlace + +expOutInPlaceIters, sqrtOutInPlaceIters, + expInInPlaceIters, sqrtInInPlaceIters :: Int -> OpMutable1 RealIntervalApprox s +expOutInPlaceIters = RAIMEFFO.expOutInPlaceIters +sqrtOutInPlaceIters = RAIMEFFO.sqrtOutInPlaceIters +expInInPlaceIters = RAIMEFFO.expInInPlaceIters +sqrtInInPlaceIters = RAIMEFFO.sqrtInInPlaceIters + diff --git a/src/Numeric/AERN/DoubleBasis/RealApprox.hs b/src/Numeric/AERN/DoubleBasis/RealApprox.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/DoubleBasis/RealApprox.hs @@ -0,0 +1,413 @@ +{-# LANGUAGE FlexibleContexts #-} +{-| + Module : Numeric.AERN.DoubleBasis.RealApprox + Description : Double intervals for approximating real numbers + Copyright : (c) Michal Konecny, Jan Duracz + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Intervals with Double endpoints as an + abstract data type for approximating real numbers. + Each interval represents a single real number. + Only operations that respect this view are available + via this module. +-} +module Numeric.AERN.DoubleBasis.RealApprox +( + -- | + -- A convenience module re-exporting various interval operations + -- with default effort indicators. + + -- * Main type + RealApprox, + + -- * Order relations + -- | + -- There are two types of order relations to consider: + -- + -- * the /numerical/ order, generalising the order relation + -- on Doubles and + -- + -- * the /refinement/ order, generalising the reverse-inclusion + -- relation on consistent intervals. + -- + -- The intervals in 'RealApprox' form a /meet/-semilattice + -- corresponding to the refiniement order under the operation /\\ + -- returning the subset-least interval containing the /union/ of + -- its argument intervals. + -- + -- A safe approximation of the exact operation /\\ + -- is given by ''. + -- + -- The dual operation to /\\ is partial + -- since the /intersection/ of disjoint sets is empty. + -- + -- A safe approximation of the exact operation \\/\? + -- is given by '<\/>?'. + + -- ** Numerical order + -- | + -- Interval extensions of the corresponding tests and relations on + -- Double. + + -- *** Extrema + -- | + -- The values retured by 'least' and 'greatest' complete the + -- numerical partial order on 'RealApprox'. + least,greatest, + + -- *** Comparability tests + (==?),(<==>?),(?), + + -- *** Order relations + (?),(<=?),(>=?), + + -- ** Refinement order + -- | + -- Tests and relations in the interval poset. + + -- *** Extrema + -- | + -- The values retured by 'bottom' and 'top' complete the + -- refinement partial order on 'RealApprox'. + + -- **** ASCII versions + bottom,top, + + -- **** Unicode versions + (⊥),(⊤), + + -- *** Comparability tests + (|==?),(|<==>?),(|?), + + -- *** Order relations + + -- **** ASCII versions + (|?),(|<=?),(|>=?), + + -- **** Unicode versions + (⊏?),(⊑?),(⊒?),(⊐?), + + -- * Outward rounded operations + -- | + -- Interval extensions of common functions. The 'Num', 'Fractional' + -- and 'Floating' instances for 'RealApprox' use such versions as instance + -- methods. + + -- ** Order operations + + -- *** Numerical order + -- | + -- Outward rounded interval extensions of the corresponding + -- operations on Double. + minOut,maxOut, + + -- *** Refinement order + -- | + -- Outward rounded lattice operations in the interval poset. + + -- **** ASCII versions + (),(<\/>?), + + -- **** Unicode versions + (<⊓>),(<⊔>?), + + -- ** Field operations + + -- *** Interval operations + (<+>),(<->),(<*>),(), + + -- *** Mixed type operations + (|<+>),(<+>|),(|<*>),(<*>|),(|),(<^>), + + -- ** Special constants + piOut,eOut, + + -- ** Elementary functions + absOut,expOut,sqrtOut, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expOutIters 10 x + -- + -- which means that at most 10 iterations should be used while computing exp + expOutIters,sqrtOutIters +) +where + +import Numeric.AERN.Basics.Interval + (Interval(..)) + +import qualified Numeric.AERN.Basics.NumericOrder as BNO + (least,greatest) + +import qualified Numeric.AERN.Basics.NumericOrder.OpsDefaultEffort as BNOODE + ((==?),(<==>?),(?), + (?),(<=?),(>=?), + minOut,maxOut,minIn,maxIn) + +import qualified Numeric.AERN.Basics.RefinementOrder as BRO + (bottom,top,(⊥),(⊤)) + +import qualified Numeric.AERN.Basics.RefinementOrder.OpsDefaultEffort as BROODE + ((|==?),(|<==>?),(|?), + (|?),(|<=?),(|>=?),(⊏?),(⊑?),(⊒?),(⊐?), + (),(<\/>?),(<⊓>),(<⊔>?)) + +import Numeric.AERN.RealArithmetic.Interval() + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as RAROR + (RoundedMixedAdd(..),RoundedMixedMultiply(..),RoundedMixedDivide(..)) + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsDefaultEffort as RARORODE + ((<+>),(<->),(<*>),(),(|<+>),(<+>|),(|<*>),(<*>|),(|),(<^>), + piOut,eOut,absOut,expOut,sqrtOut) + +import qualified Numeric.AERN.RealArithmetic.Interval.ElementaryFromFieldOps as RAIEFFO + (expOutIters, sqrtOutIters) + +import Numeric.AERN.RealArithmetic.Basis.Double() + +import qualified Numeric.AERN.Basics.NumericOrder as NumOrd + +import Test.QuickCheck + +-- | +-- Intervals with Double endpoints, presented as an abstract +-- data type for approximating real numbers. One interval +-- represents a single real number contained in it. Only +-- operations supporting this view are provided by this module. +type RealApprox = Interval Double + +sampleRealApprox :: RealApprox +sampleRealApprox = Interval 0 0 + +least :: RealApprox +least = BNO.least + +greatest :: RealApprox +greatest = BNO.greatest + +infix 4 ==?, <==>?, ?, =?, >? + +-- | Partial equality +(==?) :: RealApprox -> RealApprox -> Maybe Bool +(==?) = (BNOODE.==?) + +-- | Partial `is comparable to` +(<==>?) :: RealApprox -> RealApprox -> Maybe Bool +(<==>?) = (BNOODE.<==>?) + +-- | Partial `is not comparable to` +(?) :: RealApprox -> RealApprox -> Maybe Bool +(?) = (BNOODE.?) + +-- | Partial `strictly less than` +( RealApprox -> Maybe Bool +(?) :: RealApprox -> RealApprox -> Maybe Bool +(>?) = (BNOODE.>?) + +-- | Partial `less than or equal to` +(<=?) :: RealApprox -> RealApprox -> Maybe Bool +(<=?) = (BNOODE.<=?) + +-- | Partial `greater than or equal to` +(>=?) :: RealApprox -> RealApprox -> Maybe Bool +(>=?) = (BNOODE.>=?) + +-- | Outward rounded minimum +minOut :: RealApprox -> RealApprox -> RealApprox +minOut = BNOODE.minOut + +-- | Outward rounded maximum +maxOut :: RealApprox -> RealApprox -> RealApprox +maxOut = BNOODE.maxOut + +-- | Inward rounded minimum +minIn :: RealApprox -> RealApprox -> RealApprox +minIn = BNOODE.minIn + +-- | Inward rounded maximum +maxIn :: RealApprox -> RealApprox -> RealApprox +maxIn = BNOODE.maxIn + +bottom :: RealApprox +bottom = BRO.bottom + +top :: RealApprox +top = BRO.top + +-- | Convenience Unicode notation for 'bottom' +(⊥) :: RealApprox +(⊥) = (BRO.⊥) + +-- | Convenience Unicode notation for 'top' +(⊤) :: RealApprox +(⊤) = (BRO.⊤) + +infix 4 |==?, |<==>?, |?, |=?, |>?, ⊏?, ⊑?, ⊒?, ⊐? +infixr 3 , <⊓> +infixr 2 <\/>?, <⊔>? + +-- | Partial equality +(|==?) :: RealApprox -> RealApprox -> Maybe Bool +(|==?) = (BROODE.|==?) + +-- | Partial `is comparable to` +(|<==>?) :: RealApprox -> RealApprox -> Maybe Bool +(|<==>?) = (BROODE.|<==>?) + +-- | Partial `is not comparable to` +(|?) :: RealApprox -> RealApprox -> Maybe Bool +(|?) = (BROODE.|?) + +-- | Partial `strictly below` +(| RealApprox -> Maybe Bool +(|?) :: RealApprox -> RealApprox -> Maybe Bool +(|>?) = (BROODE.|>?) + +-- | Partial `below or equal to` +(|<=?) :: RealApprox -> RealApprox -> Maybe Bool +(|<=?) = (BROODE.|<=?) + +-- | Partial `above or equal to` +(|>=?) :: RealApprox -> RealApprox -> Maybe Bool +(|>=?) = (BROODE.|>=?) + +{-| Convenience Unicode notation for '| RealApprox -> Maybe Bool +(⊏?) = (BROODE.⊏?) + +{-| Convenience Unicode notation for '|<=?' -} +(⊑?) :: RealApprox -> RealApprox -> Maybe Bool +(⊑?) = (BROODE.⊑?) + +{-| Convenience Unicode notation for '|>=?' -} +(⊒?) :: RealApprox -> RealApprox -> Maybe Bool +(⊒?) = (BROODE.⊒?) + +{-| Convenience Unicode notation for '|>?' -} +(⊐?) :: RealApprox -> RealApprox -> Maybe Bool +(⊐?) = (BROODE.⊐?) + +-- | Outward rounded meet +() :: RealApprox -> RealApprox -> RealApprox +() = (BROODE.) + +{-| Convenience Unicode notation for '' -} +(<⊓>) :: RealApprox -> RealApprox -> RealApprox +(<⊓>) = (BROODE.<⊓>) + +-- | Partial outward rounded join +(<\/>?) :: RealApprox -> RealApprox -> Maybe RealApprox +(<\/>?) = (BROODE.<\/>?) + +{-| Convenience Unicode notation for '<\/>?' -} +(<⊔>?) :: RealApprox -> RealApprox -> Maybe RealApprox +(<⊔>?) = (BROODE.<⊔>?) + +infixl 6 <+>, <-> +infixl 7 <*> +infixl 8 <^> +infixl 7 + +infixr 6 |<+> +infixl 6 <+>| +infixr 7 |<*> +infixl 7 <*>| +infixl 7 | + +-- | Outward rounded addition +(<+>) :: RealApprox -> RealApprox -> RealApprox +(<+>) = (RARORODE.<+>) + +-- | Outward rounded subtraction +(<->) :: RealApprox -> RealApprox -> RealApprox +(<->) = (RARORODE.<->) + +-- | Outward rounded multiplication +(<*>) :: RealApprox -> RealApprox -> RealApprox +(<*>) = (RARORODE.<*>) + +-- | Outward rounded division +() :: RealApprox -> RealApprox -> RealApprox +() = (RARORODE.) + +-- | Outward rounded additive scalar left action +(|<+>) :: RAROR.RoundedMixedAdd RealApprox tn => tn -> RealApprox -> RealApprox +(|<+>) = (RARORODE.|<+>) + +-- | Outward rounded additive scalar right action +(<+>|) :: RAROR.RoundedMixedAdd RealApprox tn => RealApprox -> tn -> RealApprox +(<+>|) = (RARORODE.<+>|) + +-- | Outward rounded multiplicative scalar left action +(|<*>) :: RAROR.RoundedMixedMultiply RealApprox tn => tn -> RealApprox -> RealApprox +(|<*>) = (RARORODE.|<*>) + +-- | Outward rounded multiplicative scalar right action +(<*>|) :: RAROR.RoundedMixedMultiply RealApprox tn => RealApprox -> tn -> RealApprox +(<*>|) = (RARORODE.<*>|) + +-- | Outward rounded multiplicative scalar reciprocal right action +(|) :: RAROR.RoundedMixedDivide RealApprox tn => RealApprox -> tn -> RealApprox +(|) = (RARORODE.|) + +-- | Outward rounded power +(<^>) :: RealApprox -> Int -> RealApprox +(<^>) = (RARORODE.<^>) + +-- | Outward rounded pi +piOut :: RealApprox +piOut = RARORODE.piOut + +-- | Outward rounded e +eOut :: RealApprox +eOut = RARORODE.eOut + +-- | Outward rounded absolute value +absOut :: RealApprox -> RealApprox +absOut = RARORODE.absOut + +-- | Outward rounded exponential +expOut :: RealApprox -> RealApprox +expOut = RARORODE.expOut + +-- | Outward rounded square root +sqrtOut :: RealApprox -> RealApprox +sqrtOut = RARORODE.sqrtOut + +expOutIters :: Int -> RealApprox -> RealApprox +expOutIters = RAIEFFO.expOutIters + +sqrtOutIters :: Int -> RealApprox -> RealApprox +sqrtOutIters = RAIEFFO.sqrtOutIters + +newtype PositiveRealApprox = + PositiveRealApprox { unPositiveRealApprox :: RealApprox } + +instance Show PositiveRealApprox where + show (PositiveRealApprox i) = show i + +instance Arbitrary PositiveRealApprox + where + arbitrary = + do + NumOrd.UniformlyOrderedPair (l,h) <- arbitrary + return $ PositiveRealApprox (Interval (pos l) (pos h)) + where + pos e + | e > 0 = e + | e == 0 = 1 + | otherwise = (-e) diff --git a/src/Numeric/AERN/DoubleBasis/RealIntervalApprox.hs b/src/Numeric/AERN/DoubleBasis/RealIntervalApprox.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/DoubleBasis/RealIntervalApprox.hs @@ -0,0 +1,609 @@ +{-# LANGUAGE FlexibleContexts #-} +{-| + Module : Numeric.AERN.DoubleBasis.RealIntervalApprox + Description : Double intervals for approximating real intervals + Copyright : (c) Michal Konecny, Jan Duracz + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Intervals with Double endpoints as an + abstract data type for approximating real number intervals. + Each interval is either an outer or inner approximation + of another interval. + Only operations that respect this view are available + via this module. +-} +module Numeric.AERN.DoubleBasis.RealIntervalApprox +( + -- | + -- A convenience module re-exporting various interval operations + -- with default effort indicators. + + -- * Main type + RealIntervalApprox, + + -- ** associated operations + width, bisect, + + -- * Order relations + -- | + -- There are two types of order relations to consider: + -- + -- * the /numerical/ order, generalising the order relation + -- on Doubles and + -- + -- * the /refinement/ order, generalising the reverse-inclusion + -- relation on consistent intervals. + -- + -- The consistent intervals in 'RealIntevalApprox' form a /meet/-semilattice + -- corresponding to the refiniement order under the operation /\\ + -- returning the subset-least interval containing the /union/ of + -- its argument intervals. The operation is extended to all of 'RealIntevalApprox' + -- by returning the highest interval below both of its argument + -- intervals. + -- + -- The structure ({ 'di' | 'di' is consistent \}, /\\, + -- 'bottom') is a complete meet-semilattice. + -- + -- Lower and upper approximations of the exact operation /\\ + -- are given by '' and '>/\<' respectively. + -- + -- The dual operation to /\\ is partial on consistent intervals, + -- since the /intersection/ of disjoint sets is empty. Therefore, + -- the /join/-semilattice structure on 'RealIntevalApprox' comes in two flavours: + -- + -- * the partial consistent interval-valued join \\/\? which + -- returns 'Nothing' for disjoint and anticonsistent arguments + -- and + -- + -- * the total join \\/ which returns the lowest interval in + -- 'RealIntevalApprox' above both of its argument intervals. + -- + -- The structure ('RealIntevalApprox', \/\\, \\\/, 'bottom', 'top') is a complete + -- lattice. + -- + -- Lower and upper approximations of the exact operations \\/\? + -- and \\\/ are given by '<\/>?', '<\/>' and '>\/<' respectively. + + -- ** Numerical order + -- | + -- Interval extensions of the corresponding tests and relations on + -- Double. + + -- *** Extrema + -- | + -- The values retured by 'least' and 'greatest' complete the + -- numerical partial order on 'RealIntevalApprox'. + least,greatest, + + -- *** Comparability tests + (==?),(<==>?),(?), + + -- *** Order relations + (?),(<=?),(>=?), + + -- ** Refinement order + -- | + -- Tests and relations in the interval poset. + + -- *** Extrema + -- | + -- The values retured by 'bottom' and 'top' complete the + -- refinement partial order on 'RealIntevalApprox'. + + -- **** ASCII versions + bottom,top, + + -- **** Unicode versions + (⊥),(⊤), + + -- *** Comparability tests + (|==?),(|<==>?),(|?), + + -- *** Order relations + + -- **** ASCII versions + (|?),(|<=?),(|>=?), + + -- **** Unicode versions + (⊏?),(⊑?),(⊒?),(⊐?), + + -- * Outward rounded operations + -- | + -- Interval extensions of common functions. The 'Num', 'Fractional' + -- and 'Floating' instances for 'RealIntevalApprox' use such versions as instance + -- methods. + + -- ** Order operations + + -- *** Numerical order + -- | + -- Outward rounded interval extensions of the corresponding + -- operations on Double. + minOut,maxOut, + + -- *** Refinement order + -- | + -- Outward rounded lattice operations in the interval poset. + + -- **** ASCII versions + (),(<\/>),(<\/>?), + + -- **** Unicode versions + (<⊓>),(<⊔>),(<⊔>?), + + -- ** Field operations + + -- *** Interval operations + (<+>),(<->),(<*>),(), + + -- *** Mixed type operations + (|<+>),(<+>|),(|<*>),(<*>|),(|),(<^>), + + -- ** Special constants + piOut,eOut, + + -- ** Elementary functions + absOut,expOut,sqrtOut, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expOutIters 10 x + -- + -- which means that at most 10 iterations should be used while computing exp + expOutIters,sqrtOutIters, + + -- * Inward rounded operations + + -- ** Order operations + + -- *** Numerical order + -- | + -- Inward rounded interval extensions of the corresponding + -- operations on Double. + minIn,maxIn, + + -- *** Refinement order + + -- **** ASCII versions + (>/\<),(>\/<), + + -- **** Unicode versions + (>⊓<),(>⊔<), + + -- ** Field operations + + -- *** Interval operations + (>+<),(>-<),(>*<),(>/<), + + -- *** Mixed type operations + (|>+<),(>+<|),(|>*<),(>*<|),(>/<|),(>^<), + + -- ** Special constants + piIn,eIn, + + -- ** Elementary functions + absIn,expIn,sqrtIn, + + -- *** Elementary functions with iteration effort control + -- | + -- To be used eg as follows: + -- + -- > expInIters 10 x + -- + -- which means that at most 10 iterations should be used while computing exp + expInIters,sqrtInIters +) +where + +import Numeric.AERN.Basics.Interval + (Interval(..)) + +import qualified Numeric.AERN.Basics.Interval as BI + (getEndpoints,fromEndpoints) + +import qualified Numeric.AERN.Basics.NumericOrder as BNO + (least,greatest) + +import qualified Numeric.AERN.Basics.NumericOrder.OpsDefaultEffort as BNOODE + ((==?),(<==>?),(?), + (?),(<=?),(>=?), + minOut,maxOut,minIn,maxIn) + +import qualified Numeric.AERN.Basics.RefinementOrder as BRO + (bottom,top,(⊥),(⊤)) + +import qualified Numeric.AERN.Basics.RefinementOrder.OpsDefaultEffort as BROODE + ((|==?),(|<==>?),(|?), + (|?),(|<=?),(|>=?),(⊏?),(⊑?),(⊒?),(⊐?), + (),(<\/>),(<\/>?),(<⊓>),(<⊔>),(<⊔>?), + (>/\<),(>\/<),(>⊓<),(>⊔<)) + +import Numeric.AERN.RealArithmetic.Interval() + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as RAROR + (RoundedMixedAdd(..),RoundedMixedMultiply(..),RoundedMixedDivide(..)) + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsDefaultEffort as RARORODE + ((<+>),(<->),(<*>),(),(|<+>),(<+>|),(|<*>),(<*>|),(|),(<^>), + piOut,eOut,absOut,expOut,sqrtOut, + (>+<),(>-<),(>*<),(>/<),(|>+<),(>+<|),(|>*<),(>*<|),(>/<|),(>^<), + piIn,eIn,absIn,expIn,sqrtIn) + +import qualified Numeric.AERN.RealArithmetic.Interval.ElementaryFromFieldOps as RAIEFFO + (expOutIters, expInIters, sqrtOutIters, sqrtInIters) + +import Numeric.AERN.RealArithmetic.Basis.Double() + +import qualified Numeric.AERN.RealArithmetic.Interval.Double as RAID + (width, bisect) + +import qualified Numeric.AERN.Basics.NumericOrder as NumOrd + +import Test.QuickCheck + +-- | +-- Intervals with Double endpoints, presented as an abstract +-- data type for approximating real number intervals from outside +-- or from inside. +-- +-- Note that ('l','r') = 'getEndpoints' ('di' :: 'RealIntervalApprox') does not +-- fix an ordering of 'l' and 'r'. +-- +-- * 'di' is called /consistent/ when 'l' '<=' 'r' +-- +-- * 'di' is called /anticonsistent/ when 'r' '<=' 'l' +-- +-- A consistent interval 'di' may be identified with the set defined by +-- \{ 'x' | 'l' '<=' 'x' and 'x' '<=' 'r' \}. +type RealIntervalApprox = Interval Double + +-- | Given an argument interval 'i' 'getEndpoints' returns the endpoint pair +-- ('leftEndpoint' 'i','rightEndpoint' 'i'). +getEndpoints :: RealIntervalApprox -> (Double, Double) +getEndpoints = BI.getEndpoints + +-- | Constructs an interval from an endpoint pair. +fromEndpoints :: (Double, Double) -> RealIntervalApprox +fromEndpoints = BI.fromEndpoints + +sampleRealIntervalApprox :: RealIntervalApprox +sampleRealIntervalApprox = Interval 0 0 + +{-| + Calculate the width of an interval. + The result may not be thin since the width calculation uses outwards rounding. +-} +width :: RealIntervalApprox -> RealIntervalApprox +width = RAID.width + +{-| + Split an interval into two subintervals that share only one point + and whose union is the original interval. +-} +bisect :: + Maybe Double {-^ optional parameter, indicating where to split the interval -} -> + RealIntervalApprox {-^ the interval to split -} -> + (RealIntervalApprox, RealIntervalApprox) +bisect = RAID.bisect + +least :: RealIntervalApprox +least = BNO.least + +greatest :: RealIntervalApprox +greatest = BNO.greatest + +infix 4 ==?, <==>?, ?, =?, >? + +-- | Partial equality +(==?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(==?) = (BNOODE.==?) + +-- | Partial `is comparable to` +(<==>?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(<==>?) = (BNOODE.<==>?) + +-- | Partial `is not comparable to` +(?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(?) = (BNOODE.?) + +-- | Partial `strictly less than` +( RealIntervalApprox -> Maybe Bool +(?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(>?) = (BNOODE.>?) + +-- | Partial `less than or equal to` +(<=?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(<=?) = (BNOODE.<=?) + +-- | Partial `greater than or equal to` +(>=?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(>=?) = (BNOODE.>=?) + +-- | Outward rounded minimum +minOut :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +minOut = BNOODE.minOut + +-- | Outward rounded maximum +maxOut :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +maxOut = BNOODE.maxOut + +-- | Inward rounded minimum +minIn :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +minIn = BNOODE.minIn + +-- | Inward rounded maximum +maxIn :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +maxIn = BNOODE.maxIn + +bottom :: RealIntervalApprox +bottom = BRO.bottom + +top :: RealIntervalApprox +top = BRO.top + +-- | Convenience Unicode notation for 'bottom' +(⊥) :: RealIntervalApprox +(⊥) = (BRO.⊥) + +-- | Convenience Unicode notation for 'top' +(⊤) :: RealIntervalApprox +(⊤) = (BRO.⊤) + +infix 4 |==?, |<==>?, |?, |=?, |>?, ⊏?, ⊑?, ⊒?, ⊐? +infixr 3 , >/\<, <⊓>, >⊓< +infixr 2 <\/>?, <\/>, >\/<, <⊔>?, <⊔>, >⊔< + +-- | Partial equality +(|==?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(|==?) = (BROODE.|==?) + +-- | Partial `is comparable to` +(|<==>?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(|<==>?) = (BROODE.|<==>?) + +-- | Partial `is not comparable to` +(|?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(|?) = (BROODE.|?) + +-- | Partial `strictly below` +(| RealIntervalApprox -> Maybe Bool +(|?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(|>?) = (BROODE.|>?) + +-- | Partial `below or equal to` +(|<=?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(|<=?) = (BROODE.|<=?) + +-- | Partial `above or equal to` +(|>=?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(|>=?) = (BROODE.|>=?) + +{-| Convenience Unicode notation for '| RealIntervalApprox -> Maybe Bool +(⊏?) = (BROODE.⊏?) + +{-| Convenience Unicode notation for '|<=?' -} +(⊑?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(⊑?) = (BROODE.⊑?) + +{-| Convenience Unicode notation for '|>=?' -} +(⊒?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(⊒?) = (BROODE.⊒?) + +{-| Convenience Unicode notation for '|>?' -} +(⊐?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe Bool +(⊐?) = (BROODE.⊐?) + +-- | Outward rounded meet +() :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +() = (BROODE.) + +-- | Outward rounded join +(<\/>) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(<\/>) = (BROODE.<\/>) + +-- | Inward rounded meet +(>/\<) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(>/\<) = (BROODE.>/\<) + +-- | Inward rounded join +(>\/<) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(>\/<) = (BROODE.>\/<) + +{-| Convenience Unicode notation for '' -} +(<⊓>) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(<⊓>) = (BROODE.<⊓>) + +{-| Convenience Unicode notation for '<\/>' -} +(<⊔>) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(<⊔>) = (BROODE.<⊔>) + +{-| Convenience Unicode notation for '>/\<' -} +(>⊓<) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(>⊓<) = (BROODE.>⊓<) + +{-| Convenience Unicode notation for '>\/<' -} +(>⊔<) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(>⊔<) = (BROODE.>⊔<) + +-- | Partial outward rounded join +(<\/>?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe RealIntervalApprox +(<\/>?) = (BROODE.<\/>?) + +{-| Convenience Unicode notation for '<\/>?' -} +(<⊔>?) :: RealIntervalApprox -> RealIntervalApprox -> Maybe RealIntervalApprox +(<⊔>?) = (BROODE.<⊔>?) + +infixl 6 <+>, >+<, <->, >-< +infixl 7 <*>, >*< +infixl 8 <^>, >^< +infixl 7 , >/< + +infixr 6 |<+>, |>+< +infixl 6 <+>|, >+<| +infixr 7 |<*>, |>*< +infixl 7 <*>|, >*<| +infixl 7 |, >/<| + +-- | Outward rounded addition +(<+>) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(<+>) = (RARORODE.<+>) + +-- | Outward rounded subtraction +(<->) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(<->) = (RARORODE.<->) + +-- | Outward rounded multiplication +(<*>) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(<*>) = (RARORODE.<*>) + +-- | Outward rounded division +() :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +() = (RARORODE.) + +-- | Inward rounded addition +(>+<) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(>+<) = (RARORODE.>+<) + +-- | Inward rounded subtraction +(>-<) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(>-<) = (RARORODE.>-<) + +-- | Inward rounded multiplication +(>*<) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(>*<) = (RARORODE.>*<) + +-- | Inward rounded division +(>/<) :: RealIntervalApprox -> RealIntervalApprox -> RealIntervalApprox +(>/<) = (RARORODE.>/<) + +-- | Outward rounded additive scalar left action +(|<+>) :: RAROR.RoundedMixedAdd RealIntervalApprox tn => tn -> RealIntervalApprox -> RealIntervalApprox +(|<+>) = (RARORODE.|<+>) + +-- | Inward rounded additive scalar left action +(|>+<) :: RAROR.RoundedMixedAdd RealIntervalApprox tn => tn -> RealIntervalApprox -> RealIntervalApprox +(|>+<) = (RARORODE.|>+<) + +-- | Outward rounded additive scalar right action +(<+>|) :: RAROR.RoundedMixedAdd RealIntervalApprox tn => RealIntervalApprox -> tn -> RealIntervalApprox +(<+>|) = (RARORODE.<+>|) + +-- | Inward rounded additive scalar right action +(>+<|) :: RAROR.RoundedMixedAdd RealIntervalApprox tn => RealIntervalApprox -> tn -> RealIntervalApprox +(>+<|) = (RARORODE.>+<|) + +-- | Outward rounded multiplicative scalar left action +(|<*>) :: RAROR.RoundedMixedMultiply RealIntervalApprox tn => tn -> RealIntervalApprox -> RealIntervalApprox +(|<*>) = (RARORODE.|<*>) + +-- | Inward rounded multiplicative scalar left action +(|>*<) :: RAROR.RoundedMixedMultiply RealIntervalApprox tn => tn -> RealIntervalApprox -> RealIntervalApprox +(|>*<) = (RARORODE.|>*<) + +-- | Outward rounded multiplicative scalar right action +(<*>|) :: RAROR.RoundedMixedMultiply RealIntervalApprox tn => RealIntervalApprox -> tn -> RealIntervalApprox +(<*>|) = (RARORODE.<*>|) + +-- | Inward rounded multiplicative scalar right action +(>*<|) :: RAROR.RoundedMixedMultiply RealIntervalApprox tn => RealIntervalApprox -> tn -> RealIntervalApprox +(>*<|) = (RARORODE.>*<|) + +-- | Outward rounded multiplicative scalar reciprocal right action +(|) :: RAROR.RoundedMixedDivide RealIntervalApprox tn => RealIntervalApprox -> tn -> RealIntervalApprox +(|) = (RARORODE.|) + +-- | Inward rounded multiplicative scalar reciprocal right action +(>/<|) :: RAROR.RoundedMixedDivide RealIntervalApprox tn => RealIntervalApprox -> tn -> RealIntervalApprox +(>/<|) = (RARORODE.>/<|) + +-- | Outward rounded power +(<^>) :: RealIntervalApprox -> Int -> RealIntervalApprox +(<^>) = (RARORODE.<^>) + +-- | Inward rounded power +(>^<) :: RealIntervalApprox -> Int -> RealIntervalApprox +(>^<) = (RARORODE.>^<) + +-- | Outward rounded pi +piOut :: RealIntervalApprox +piOut = RARORODE.piOut + +-- | Outward rounded e +eOut :: RealIntervalApprox +eOut = RARORODE.eOut + +-- | Inward rounded pi +piIn :: RealIntervalApprox +piIn = RARORODE.piIn + +-- | Inward rounded e +eIn :: RealIntervalApprox +eIn = RARORODE.eIn + +-- | Outward rounded absolute value +absOut :: RealIntervalApprox -> RealIntervalApprox +absOut = RARORODE.absOut + +-- | Outward rounded exponential +expOut :: RealIntervalApprox -> RealIntervalApprox +expOut = RARORODE.expOut + +-- | Outward rounded square root +sqrtOut :: RealIntervalApprox -> RealIntervalApprox +sqrtOut = RARORODE.sqrtOut + +-- | Inward rounded absolute value +absIn :: RealIntervalApprox -> RealIntervalApprox +absIn = RARORODE.absIn + +-- | Inward rounded exponential +expIn :: RealIntervalApprox -> RealIntervalApprox +expIn = RARORODE.expIn + +-- | Inward rounded square root +sqrtIn :: RealIntervalApprox -> RealIntervalApprox +sqrtIn = RARORODE.sqrtIn + +expOutIters :: Int -> RealIntervalApprox -> RealIntervalApprox +expOutIters = RAIEFFO.expOutIters + +sqrtOutIters :: Int -> RealIntervalApprox -> RealIntervalApprox +sqrtOutIters = RAIEFFO.sqrtOutIters + +expInIters :: Int -> RealIntervalApprox -> RealIntervalApprox +expInIters = RAIEFFO.expInIters + +sqrtInIters :: Int -> RealIntervalApprox -> RealIntervalApprox +sqrtInIters = RAIEFFO.sqrtInIters + +newtype PositiveRealIntervalApprox = + PositiveRealIntervalApprox + { unPositiveRealIntervalApprox :: RealIntervalApprox } + +instance Show PositiveRealIntervalApprox where + show (PositiveRealIntervalApprox i) = show i + +instance Arbitrary PositiveRealIntervalApprox + where + arbitrary = + do + NumOrd.UniformlyOrderedPair (l,h) <- arbitrary + return $ PositiveRealIntervalApprox (Interval (pos l) (pos h)) + where + pos e + | e > 0 = e + | e == 0 = 1 + | otherwise = (-e) diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE TypeFamilies #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double + Description : Instances for Double as interval endpoints. + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable (indirect FFI) + + Instances of Double required for serving as interval endpoints, + namely providing granularity, Comparison, lattice, rounded field and + rounded elementary operations. +-} +module Numeric.AERN.RealArithmetic.Basis.Double +(sampleD, nanD) +where + +import Numeric.AERN.RealArithmetic.Basis.Double.ShowInternals +import Numeric.AERN.RealArithmetic.Basis.Double.NumericOrder +import Numeric.AERN.RealArithmetic.Basis.Double.Conversion +import Numeric.AERN.RealArithmetic.Basis.Double.FieldOps +import Numeric.AERN.RealArithmetic.Basis.Double.MixedFieldOps +import Numeric.AERN.RealArithmetic.Basis.Double.Measures +import Numeric.AERN.RealArithmetic.Basis.Double.Mutable +import Numeric.AERN.RealArithmetic.Basis.Double.SpecialConst + +import Numeric.AERN.RealArithmetic.NumericOrderRounding +import Numeric.AERN.Basics.Exception + +instance HasLegalValues Double where + isLegal d + | isNaN d = False +-- | isInfinite d = False + | otherwise = True + +instance RoundedReal Double where + type RoundedRealEffortIndicator Double = () + roundedRealDefaultEffort _ = () + rrEffortComp _ _ = () + rrEffortMinmax _ _ = () + rrEffortToInt _ _ = () + rrEffortFromInt _ _ = () + rrEffortToInteger _ _ = () + rrEffortFromInteger _ _ = () + rrEffortToDouble _ _ = () + rrEffortFromDouble _ _ = () + rrEffortToRational _ _ = () + rrEffortFromRational _ _ = () + rrEffortAbs _ _ = () + rrEffortField _ _ = () + rrEffortIntMixedField _ _ = () + rrEffortIntegerMixedField _ _ = () + rrEffortDoubleMixedField _ _ = () + rrEffortRationalMixedField _ _ = () + +instance RoundedRealInPlace Double diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double/Conversion.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double/Conversion.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double/Conversion.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double.Conversion + Description : conversions between Double and standard numeric types + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Conversions between Double and standard numeric types. + + This is a private module reexported publicly via its parent. +-} + +module Numeric.AERN.RealArithmetic.Basis.Double.Conversion where + +import Numeric.AERN.RealArithmetic.NumericOrderRounding + +import Numeric.AERN.Basics.Exception +import Control.Exception + +instance Convertible Integer Double where + type ConvertEffortIndicator Integer Double = () + convertDefaultEffort _ _ = () + convertUpEff _ n + | ndn >= n = Just dn + | otherwise = Just dnUp + where + dn = fromInteger n + ndn = floor dn + (m, e) = decodeFloat dn + dnUp = encodeFloat (m + 1) e + convertDnEff _ n + | ndn <= n = Just dn + | otherwise = Just dnDn + where + dn = fromInteger n + ndn = ceiling dn + (m, e) = decodeFloat dn + dnDn = encodeFloat (m - 1) e + +instance Convertible Int Double where + type ConvertEffortIndicator Int Double = () + convertDefaultEffort _ _ = () + convertUpEff effort n = + convertUpEff effort (toInteger n) + convertDnEff effort n = + convertDnEff effort (toInteger n) + +instance Convertible Double Integer where + type ConvertEffortIndicator Double Integer = () + convertDefaultEffort _ _ = () + convertUpEff _ d + | isInfinite d = Nothing + | otherwise = Just $ ceiling d + convertDnEff _ d + | isInfinite d = Nothing + | otherwise = Just $ floor d + +instance Convertible Double Int where + type ConvertEffortIndicator Double Int = () + convertDefaultEffort _ _ = () + convertUpEff effort d = + case mdUpInteger of + Nothing -> Nothing + Just dUpInteger + | dUpInteger > (toInteger intMax) -> Nothing + | otherwise -> Just $ fromInteger dUpInteger + where + mdUpInteger = convertUpEff effort d + intMax = maxBound :: Int + convertDnEff effort d = + case mdDnInteger of + Nothing -> Nothing + Just dDnInteger + | dDnInteger < (toInteger intMin) -> Nothing + | otherwise -> Just $ fromInteger dDnInteger + where + mdDnInteger = convertDnEff effort d + intMin = minBound :: Int + +instance Convertible Double Double where + type ConvertEffortIndicator Double Double = () + convertDefaultEffort _ _ = () + convertUpEff _ d = Just d + convertDnEff _ d = Just d + +instance Convertible Rational Double where + type ConvertEffortIndicator Rational Double = () + convertDefaultEffort _ _ = () + convertUpEff _ r + | rdr >= r = Just dr + | otherwise = Just drUp + where + rdr = toRational dr + dr = fromRational r + (m, e) = decodeFloat dr + drUp = encodeFloat (m + 1) e + convertDnEff _ r + | rdr <= r = Just dr + | otherwise = Just drDn + where + rdr = toRational dr + dr = fromRational r + (m, e) = decodeFloat dr + drDn = encodeFloat (m - 1) e + +instance Convertible Double Rational where + type ConvertEffortIndicator Double Rational = () + convertDefaultEffort _ _ = () + convertUpEff _ d + | isInfinite d = Nothing + | otherwise = Just $ toRational d + convertDnEff eff d = convertUpEff eff d + diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double/FieldOps.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double/FieldOps.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double/FieldOps.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double.FieldOps + Description : rounded arithmetic instances for Double + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Rounded arithmetic instances for Double. + + This is a private module reexported publicly via its parent. +-} + +module Numeric.AERN.RealArithmetic.Basis.Double.FieldOps +(setMachineRoundingModeUp) +where + +import Numeric.AERN.RealArithmetic.Basis.Double.NumericOrder + +import Numeric.AERN.RealArithmetic.NumericOrderRounding + +import Numeric.AERN.Basics.Effort + +import Numeric.IEEE.RoundMode +import System.IO.Unsafe + +import Numeric.AERN.Basics.Exception +import Control.Exception + +withUpwardsRounding :: a -> a +withUpwardsRounding a = + unsafePerformIO $ + do + setMachineRoundingModeUp + aa <- return $! a + return aa + +setMachineRoundingModeUp :: IO () +setMachineRoundingModeUp = + do + currentRndMode <- getRound + case currentRndMode == Upward of + True -> + do +-- putStrLn "setMachineRoundingModeUp: already up" + return () + False -> + do + success <- setRound Upward + case success of + True -> + do +-- putStrLn $ "setMachineRoundingModeUp: switching up from " ++ show currentRndMode + return () + False -> + error "Numeric.AERN.RealArithmetic.Basics.Double: failed to switch rounding mode" + +detectNaNThrow :: String -> Double -> Double +detectNaNThrow msg a + | isNaN a = + throw (AERNDomViolationException $ "domain violation in " ++ msg) + | otherwise = a + +detectNaNUp :: String -> Double -> Double +detectNaNUp _ a + | isNaN a = 1/0 + | otherwise = a + +detectNaNDn :: String -> Double -> Double +detectNaNDn _ a + | isNaN a = -1/0 + | otherwise = a + +instance RoundedAddEffort Double where + type AddEffortIndicator Double = () + addDefaultEffort _ = () + +instance RoundedAdd Double where + addUpEff effort d1 d2 = + detectNaNUp ("addition " ++ show d1 ++ " +^ " ++ show d2 ) $ + withUpwardsRounding $ d1 + d2 + addDnEff effort d1 d2 = + detectNaNDn ("addition " ++ show d1 ++ " +. " ++ show d2 ) $ + negate $ withUpwardsRounding $ (negate d1) + (negate d2) + -- the following is an exagerated rounding version meant for testing: +-- type AddEffortIndicator Double = Int1To100 +-- addDefaultEffort _ = Int1To100 10 +-- addUpEff effort d1 d2 = +-- withUpwardsRounding $ +-- d1 + d2 + (1/effortD) +-- where +-- effortD = fromInteger $ toInteger $ fromInt1To100 $ effort +-- addDnEff effort d1 d2 = +-- negate $ withUpwardsRounding $ +-- (negate d1) + (negate d2) + (1/effortD) +-- where +-- effortD = fromInteger $ toInteger $ fromInt1To100 $ effort + +instance RoundedSubtr Double + +instance RoundedAbsEffort Double where + type AbsEffortIndicator Double = () + absDefaultEffort _ = () + +instance RoundedAbs Double where + absDnEff _ = abs + absUpEff _ = abs + +instance RoundedMultiplyEffort Double where + type MultEffortIndicator Double = () + multDefaultEffort _ = () + +instance RoundedMultiply Double where + multUpEff effort d1 d2 = + detectNaNUp ("multiplication " ++ show d1 ++ " *^ " ++ show d2 ) $ + withUpwardsRounding $ d1 * d2 + multDnEff effort d1 d2 = + detectNaNDn ("multiplication " ++ show d1 ++ " *. " ++ show d2 ) $ + negate $ withUpwardsRounding $ (negate d1) * d2 + -- the following is an exagerated rounding version meant for testing: +-- type MultEffortIndicator Double = Int1To100 +-- multDefaultEffort _ = Int1To100 10 +-- multUpEff effort d1 d2 = +-- withUpwardsRounding $ +-- d1 * d2 + (1/effortD) +-- where +-- effortD = fromInteger $ toInteger $ fromInt1To100 $ effort +-- multDnEff effort d1 d2 = +-- negate $ withUpwardsRounding $ +-- (negate d1) * d2 + (1/effortD) +-- where +-- effortD = fromInteger $ toInteger $ fromInt1To100 $ effort + +instance RoundedPowerNonnegToNonnegIntEffort Double where + type PowerNonnegToNonnegIntEffortIndicator Double = + PowerNonnegToNonnegIntEffortIndicatorFromMult Double + powerNonnegToNonnegIntDefaultEffort = + powerNonnegToNonnegIntDefaultEffortFromMult + +instance RoundedPowerNonnegToNonnegInt Double where + powerNonnegToNonnegIntUpEff = + powerNonnegToNonnegIntUpEffFromMult + powerNonnegToNonnegIntDnEff = + powerNonnegToNonnegIntDnEffFromMult + +instance RoundedPowerToNonnegIntEffort Double where + type PowerToNonnegIntEffortIndicator Double = + PowerToNonnegIntEffortIndicatorFromMult Double + powerToNonnegIntDefaultEffort = + powerToNonnegIntDefaultEffortFromMult + +instance RoundedPowerToNonnegInt Double where + powerToNonnegIntUpEff = + powerToNonnegIntUpEffFromMult + powerToNonnegIntDnEff = + powerToNonnegIntDnEffFromMult + +instance RoundedDivideEffort Double where + type DivEffortIndicator Double = () + divDefaultEffort _ = () + +instance RoundedDivide Double where + divUpEff effort d1 d2 = + detectNaNUp ("division " ++ show d1 ++ " /^ " ++ show d2 ) $ + withUpwardsRounding $ d1 / d2 + divDnEff effort d1 d2 = + detectNaNDn ("division " ++ show d1 ++ " /. " ++ show d2 ) $ + negate $ withUpwardsRounding $ (negate d1) / d2 + +instance RoundedRingEffort Double + where + type RingOpsEffortIndicator Double = () + ringOpsDefaultEffort _ = () + ringEffortAdd _ _ = () + ringEffortMult _ _ = () + ringEffortPow _ _ = () + +instance RoundedRing Double + +instance RoundedFieldEffort Double + where + type FieldOpsEffortIndicator Double = () + fieldOpsDefaultEffort _ = () + fldEffortAdd _ _ = () + fldEffortMult _ _ = () + fldEffortPow _ _ = () + fldEffortDiv _ _ = () + +instance RoundedField Double + +--test1 :: [Double] +--test1 = +-- let ?multUpDnEffort = () :: MultEffortIndicator Double in +-- let up = foldl1 (*^) [1/3,1/3,1/3] +-- dn = foldl1 (*.) [1/3,1/3,1/3] +-- in +-- [up, dn] + + + diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double/Measures.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double/Measures.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double/Measures.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE UndecidableInstances #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double.Measures + Description : distance between Double numbers + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Distance between Double numbers. + + This is a private module reexported publicly via its parent. +-} + +module Numeric.AERN.RealArithmetic.Basis.Double.Measures where + +import Numeric.AERN.RealArithmetic.Basis.Double.NumericOrder +import Numeric.AERN.RealArithmetic.Basis.Double.FieldOps + +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as ArithInOut +import Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsDefaultEffort +import Numeric.AERN.RealArithmetic.ExactOps +import Numeric.AERN.RealArithmetic.Measures +import Numeric.AERN.RealArithmetic.Interval.Double + +import Numeric.AERN.Basics.Interval + +instance HasDistance Double where + type Distance Double = DI + type DistanceEffortIndicator Double = ArithInOut.AddEffortIndicator DI + distanceDefaultEffort d = ArithInOut.addDefaultEffort (sampleDI :: DI) + distanceBetweenEff effort d1 d2 = +-- | d1 == 1/0 && d2 == 1/0 = zero +-- -- distance between two infinities is zero (beware: distance not continuous at infinities!) +-- | d1 == -1/0 && d2 == -1/0 = zero +-- | otherwise = + ArithInOut.absOutEff ((),()) (d2I <-> d1I) + where + d1I = Interval d1 d1 + d2I = Interval d2 d2 diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double/MixedFieldOps.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double/MixedFieldOps.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double/MixedFieldOps.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double.MixedFieldOps + Description : rounded basic arithmetic operations mixing Double and another type + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Rounded basic arithmetical operations mixing Double and another type. + + This module is hidden and reexported via its parent Double. +-} + +module Numeric.AERN.RealArithmetic.Basis.Double.MixedFieldOps where + +import Numeric.AERN.RealArithmetic.Basis.Double.Conversion +import Numeric.AERN.RealArithmetic.Basis.Double.NumericOrder +import Numeric.AERN.RealArithmetic.Basis.Double.FieldOps + +import Numeric.AERN.RealArithmetic.NumericOrderRounding + +instance RoundedMixedAddEffort Double Int + where + type MixedAddEffortIndicator Double Int = + MixedAddEffortIndicatorByConversion Double Int + mixedAddDefaultEffort = mixedAddDefaultEffortByConversion +instance RoundedMixedAdd Double Int + where + mixedAddUpEff = mixedAddUpEffByConversion + mixedAddDnEff = mixedAddDnEffByConversion + +instance RoundedMixedMultiplyEffort Double Int + where + type MixedMultEffortIndicator Double Int = + MixedMultEffortIndicatorByConversion Double Int + mixedMultDefaultEffort = mixedMultDefaultEffortByConversion +instance RoundedMixedMultiply Double Int + where + mixedMultUpEff = mixedMultUpEffByConversion + mixedMultDnEff = mixedMultDnEffByConversion + +instance RoundedMixedDivideEffort Double Int + where + type MixedDivEffortIndicator Double Int = + MixedDivEffortIndicatorByConversion Double Int + mixedDivDefaultEffort = mixedDivDefaultEffortByConversion +instance RoundedMixedDivide Double Int + where + mixedDivUpEff = mixedDivUpEffByConversion + mixedDivDnEff = mixedDivDnEffByConversion + +instance RoundedMixedRingEffort Double Int + where + type MixedRingOpsEffortIndicator Double Int = () + mixedRingOpsDefaultEffort _ _ = () + mxringEffortAdd _ _ _ = ((),()) + mxringEffortMult _ _ _ = ((),(),()) + +instance RoundedMixedRing Double Int + +instance RoundedMixedFieldEffort Double Int + where + type MixedFieldOpsEffortIndicator Double Int = () + mixedFieldOpsDefaultEffort _ _ = () + mxfldEffortAdd _ _ _ = ((),()) + mxfldEffortMult _ _ _ = ((),(),()) + mxfldEffortDiv _ _ _ = ((),(),((),())) + +instance RoundedMixedField Double Int + + + +instance RoundedMixedAddEffort Double Integer + where + type MixedAddEffortIndicator Double Integer = + MixedAddEffortIndicatorByConversion Double Integer + mixedAddDefaultEffort = mixedAddDefaultEffortByConversion +instance RoundedMixedAdd Double Integer + where + mixedAddUpEff = mixedAddUpEffByConversion + mixedAddDnEff = mixedAddDnEffByConversion + +instance RoundedMixedMultiplyEffort Double Integer + where + type MixedMultEffortIndicator Double Integer = + MixedMultEffortIndicatorByConversion Double Integer + mixedMultDefaultEffort = mixedMultDefaultEffortByConversion +instance RoundedMixedMultiply Double Integer + where + mixedMultUpEff = mixedMultUpEffByConversion + mixedMultDnEff = mixedMultDnEffByConversion + +instance RoundedMixedDivideEffort Double Integer + where + type MixedDivEffortIndicator Double Integer = + MixedDivEffortIndicatorByConversion Double Integer + mixedDivDefaultEffort = mixedDivDefaultEffortByConversion +instance RoundedMixedDivide Double Integer + where + mixedDivUpEff = mixedDivUpEffByConversion + mixedDivDnEff = mixedDivDnEffByConversion + +instance RoundedMixedRingEffort Double Integer + where + type MixedRingOpsEffortIndicator Double Integer = () + mixedRingOpsDefaultEffort _ _ = () + mxringEffortAdd _ _ _ = ((),()) + mxringEffortMult _ _ _ = ((),(),()) + +instance RoundedMixedRing Double Integer + +instance RoundedMixedFieldEffort Double Integer + where + type MixedFieldOpsEffortIndicator Double Integer = () + mixedFieldOpsDefaultEffort _ _ = () + mxfldEffortAdd _ _ _ = ((),()) + mxfldEffortMult _ _ _ = ((),(),()) + mxfldEffortDiv _ _ _ = ((),(),((),())) + +instance RoundedMixedField Double Integer + + + +instance RoundedMixedAddEffort Double Rational + where + type MixedAddEffortIndicator Double Rational = + MixedAddEffortIndicatorByConversion Double Rational + mixedAddDefaultEffort = mixedAddDefaultEffortByConversion +instance RoundedMixedAdd Double Rational + where + mixedAddUpEff = mixedAddUpEffByConversion + mixedAddDnEff = mixedAddDnEffByConversion + +instance RoundedMixedMultiplyEffort Double Rational + where + type MixedMultEffortIndicator Double Rational = + MixedMultEffortIndicatorByConversion Double Rational + mixedMultDefaultEffort = mixedMultDefaultEffortByConversion +instance RoundedMixedMultiply Double Rational + where + mixedMultUpEff = mixedMultUpEffByConversion + mixedMultDnEff = mixedMultDnEffByConversion + +instance RoundedMixedDivideEffort Double Rational + where + type MixedDivEffortIndicator Double Rational = + MixedDivEffortIndicatorByConversion Double Rational + mixedDivDefaultEffort = mixedDivDefaultEffortByConversion +instance RoundedMixedDivide Double Rational + where + mixedDivUpEff = mixedDivUpEffByConversion + mixedDivDnEff = mixedDivDnEffByConversion + +instance RoundedMixedRingEffort Double Rational + where + type MixedRingOpsEffortIndicator Double Rational = () + mixedRingOpsDefaultEffort _ _ = () + mxringEffortAdd _ _ _ = ((),()) + mxringEffortMult _ _ _ = ((),(),()) + +instance RoundedMixedRing Double Rational + +instance RoundedMixedFieldEffort Double Rational + where + type MixedFieldOpsEffortIndicator Double Rational = () + mixedFieldOpsDefaultEffort _ _ = () + mxfldEffortAdd _ _ _ = ((),()) + mxfldEffortMult _ _ _ = ((),(),()) + mxfldEffortDiv _ _ _ = ((),(),((),())) + +instance RoundedMixedField Double Rational + + + +instance RoundedMixedAddEffort Double Double + where + type MixedAddEffortIndicator Double Double = () + mixedAddDefaultEffort _ _ = () +instance RoundedMixedAdd Double Double + where + mixedAddUpEff _ a b = addUpEff () a b + mixedAddDnEff _ a b = addDnEff () a b + +instance RoundedMixedMultiplyEffort Double Double + where + type MixedMultEffortIndicator Double Double = () + mixedMultDefaultEffort _ _ = () +instance RoundedMixedMultiply Double Double + where + mixedMultUpEff _ a b = multUpEff () a b + mixedMultDnEff _ a b = multDnEff () a b + +instance RoundedMixedDivideEffort Double Double + where + type MixedDivEffortIndicator Double Double = () + mixedDivDefaultEffort _ _ = () +instance RoundedMixedDivide Double Double + where + mixedDivUpEff _ a b = divUpEff () a b + mixedDivDnEff _ a b = divDnEff () a b + +instance RoundedMixedRingEffort Double Double + where + type MixedRingOpsEffortIndicator Double Double = () + mixedRingOpsDefaultEffort _ _ = () + mxringEffortAdd _ _ _ = () + mxringEffortMult _ _ _ = () + +instance RoundedMixedRing Double Double + +instance RoundedMixedFieldEffort Double Double + where + type MixedFieldOpsEffortIndicator Double Double = () + mixedFieldOpsDefaultEffort _ _ = () + mxfldEffortAdd _ _ _ = () + mxfldEffortMult _ _ _ = () + mxfldEffortDiv _ _ _ = () + +instance RoundedMixedField Double Double diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double/Mutable.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double/Mutable.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double.Mutable + Description : mutable version of Double + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + One, zero, negation etc for Double numbers. + + This is a private module reexported publicly via its parent. +-} + +module Numeric.AERN.RealArithmetic.Basis.Double.Mutable where + +import Numeric.AERN.Basics.Mutable +import Numeric.AERN.Basics.NumericOrder + +import Numeric.AERN.RealArithmetic.ExactOps +import Numeric.AERN.RealArithmetic.NumericOrderRounding + +import Numeric.AERN.RealArithmetic.Basis.Double.FieldOps +import Numeric.AERN.RealArithmetic.Basis.Double.MixedFieldOps + +import Data.STRef +import Data.Ratio + + +instance CanBeMutable Double where + data Mutable Double s = + MDouble { unMDouble :: STRef s Double } + makeMutable a = + do + v <- newSTRef a + return $ MDouble v + unsafeMakeMutable = makeMutable + writeMutable (MDouble v) a = writeSTRef v a + unsafeWriteMutable = writeMutable + readMutable (MDouble v) = readSTRef v + unsafeReadMutable = readMutable + +instance RoundedLatticeInPlace Double + where + maxUpInPlaceEff = maxUpInPlaceEffFromPure + maxDnInPlaceEff = maxDnInPlaceEffFromPure + minUpInPlaceEff = minUpInPlaceEffFromPure + minDnInPlaceEff = minDnInPlaceEffFromPure +instance NegInPlace Double +instance RoundedAddInPlace Double + where + addUpInPlaceEff = addUpInPlaceEffFromPure + addDnInPlaceEff = addDnInPlaceEffFromPure + +instance RoundedSubtrInPlace Double + +instance RoundedAbsInPlace Double + where + absUpInPlaceEff = absUpInPlaceEffFromPure + absDnInPlaceEff = absDnInPlaceEffFromPure + +instance RoundedMultiplyInPlace Double + where + multUpInPlaceEff = multUpInPlaceEffFromPure + multDnInPlaceEff = multDnInPlaceEffFromPure + +instance RoundedPowerNonnegToNonnegIntInPlace Double + where + powerNonnegToNonnegIntUpInPlaceEff = powerNonnegToNonnegIntUpInPlaceEffFromMult + powerNonnegToNonnegIntDnInPlaceEff = powerNonnegToNonnegIntDnInPlaceEffFromMult + +instance RoundedPowerToNonnegIntInPlace Double + where + powerToNonnegIntUpInPlaceEff = powerToNonnegIntUpInPlaceEffFromPure + powerToNonnegIntDnInPlaceEff = powerToNonnegIntDnInPlaceEffFromPure + +instance RoundedDivideInPlace Double + where + divUpInPlaceEff = divUpInPlaceEffFromPure + divDnInPlaceEff = divDnInPlaceEffFromPure + +instance RoundedRingInPlace Double +instance RoundedFieldInPlace Double + +instance RoundedMixedAddInPlace Double Int + where + mixedAddUpInPlaceEff = mixedAddUpInPlaceEffFromPure + mixedAddDnInPlaceEff = mixedAddDnInPlaceEffFromPure + +instance RoundedMixedAddInPlace Double Integer + where + mixedAddUpInPlaceEff = mixedAddUpInPlaceEffFromPure + mixedAddDnInPlaceEff = mixedAddDnInPlaceEffFromPure + +instance RoundedMixedAddInPlace Double Double + where + mixedAddUpInPlaceEff = mixedAddUpInPlaceEffFromPure + mixedAddDnInPlaceEff = mixedAddDnInPlaceEffFromPure + +instance RoundedMixedAddInPlace Double Rational + where + mixedAddUpInPlaceEff = mixedAddUpInPlaceEffFromPure + mixedAddDnInPlaceEff = mixedAddDnInPlaceEffFromPure + + +instance RoundedMixedMultiplyInPlace Double Int + where + mixedMultUpInPlaceEff = mixedMultUpInPlaceEffFromPure + mixedMultDnInPlaceEff = mixedMultDnInPlaceEffFromPure + +instance RoundedMixedMultiplyInPlace Double Integer + where + mixedMultUpInPlaceEff = mixedMultUpInPlaceEffFromPure + mixedMultDnInPlaceEff = mixedMultDnInPlaceEffFromPure + +instance RoundedMixedMultiplyInPlace Double Double + where + mixedMultUpInPlaceEff = mixedMultUpInPlaceEffFromPure + mixedMultDnInPlaceEff = mixedMultDnInPlaceEffFromPure + +instance RoundedMixedMultiplyInPlace Double Rational + where + mixedMultUpInPlaceEff = mixedMultUpInPlaceEffFromPure + mixedMultDnInPlaceEff = mixedMultDnInPlaceEffFromPure + + +instance RoundedMixedDivideInPlace Double Int + where + mixedDivUpInPlaceEff = mixedDivUpInPlaceEffFromPure + mixedDivDnInPlaceEff = mixedDivDnInPlaceEffFromPure + +instance RoundedMixedDivideInPlace Double Integer + where + mixedDivUpInPlaceEff = mixedDivUpInPlaceEffFromPure + mixedDivDnInPlaceEff = mixedDivDnInPlaceEffFromPure + +instance RoundedMixedDivideInPlace Double Double + where + mixedDivUpInPlaceEff = mixedDivUpInPlaceEffFromPure + mixedDivDnInPlaceEff = mixedDivDnInPlaceEffFromPure + +instance RoundedMixedDivideInPlace Double Rational + where + mixedDivUpInPlaceEff = mixedDivUpInPlaceEffFromPure + mixedDivDnInPlaceEff = mixedDivDnInPlaceEffFromPure + +instance RoundedMixedRingInPlace Double Int +instance RoundedMixedRingInPlace Double Integer +instance RoundedMixedRingInPlace Double Double +instance RoundedMixedRingInPlace Double Rational + +instance RoundedMixedFieldInPlace Double Int +instance RoundedMixedFieldInPlace Double Integer +instance RoundedMixedFieldInPlace Double Double +instance RoundedMixedFieldInPlace Double Rational + + + diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double/NumericOrder.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double/NumericOrder.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double/NumericOrder.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE TypeFamilies #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double.NumericOrder + Description : numeric order instances for Double + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Numeric order Comparison and lattice instances for Double. + + This is a private module reexported publicly via its parent. +-} +module Numeric.AERN.RealArithmetic.Basis.Double.NumericOrder +where + +import Prelude hiding (EQ,LT,GT) + +import Numeric.AERN.Basics.Exception +import Control.Exception + +import Numeric.AERN.Basics.PartialOrdering +import qualified Numeric.AERN.Basics.NumericOrder as NumOrd + +import Test.QuickCheck +import Numeric.AERN.Misc.QuickCheck +import Test.Framework (testGroup, Test) +import Test.Framework.Providers.QuickCheck2 (testProperty) + +import Numeric.AERN.Misc.List +import Numeric.AERN.Misc.Debug + +import Data.Maybe + +sampleD :: Double +sampleD = 0 + +nanD :: Double +nanD = 0/0 + +instance NumOrd.HasLeast Double where + least = - 1/0 + +instance NumOrd.HasGreatest Double where + greatest = 1/0 + +instance NumOrd.HasExtrema Double where + +instance NumOrd.RoundedLatticeEffort Double where + type NumOrd.MinmaxEffortIndicator Double = () + minmaxDefaultEffort _ = () + +instance NumOrd.RoundedLattice Double where + maxUpEff _ a b = Prelude.max a b + maxDnEff = NumOrd.maxUpEff + minUpEff _ a b = Prelude.min a b + minDnEff = NumOrd.minUpEff + + + + + + diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double/ShowInternals.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double/ShowInternals.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double/ShowInternals.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE TypeFamilies #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double.ShowInternals + Description : showing Double values with mantissa and exponent + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Rounded arithmetic instances for Double. + + This is a private module reexported publicly via its parent. +-} + +module Numeric.AERN.RealArithmetic.Basis.Double.ShowInternals where + +import Numeric.AERN.Basics.ShowInternals + +instance ShowInternals Double where + type ShowInternalsIndicator Double = Bool + defaultShowIndicator d = False + showInternals True d = + show d ++ "[" ++ show mantissa ++ "," ++ show exponent ++ "]" + where + (mantissa, exponent) = decodeFloat d + showInternals False d = show d + diff --git a/src/Numeric/AERN/RealArithmetic/Basis/Double/SpecialConst.hs b/src/Numeric/AERN/RealArithmetic/Basis/Double/SpecialConst.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Basis/Double/SpecialConst.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE TypeFamilies #-} +{-| + Module : Numeric.AERN.RealArithmetic.Basis.Double.SpecialConst + Description : common constants such as pi + Copyright : (c) Michal Konecny + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Common constants such as pi. +-} + +module Numeric.AERN.RealArithmetic.Basis.Double.SpecialConst where + +import Numeric.AERN.RealArithmetic.NumericOrderRounding + +instance + RoundedSpecialConstEffort Double + where + type SpecialConstEffortIndicator Double = () + specialConstDefaultEffort _ = () + +instance + RoundedSpecialConst Double + where + piUpEff _ = encodeFloat 7074237752028441 (-51) + piDnEff _ = encodeFloat 7074237752028440 (-51) + eUpEff _ = encodeFloat 6121026514868074 (-51) + eDnEff _ = encodeFloat 6121026514868073 (-51) + diff --git a/src/Numeric/AERN/RealArithmetic/Interval/Double.hs b/src/Numeric/AERN/RealArithmetic/Interval/Double.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/AERN/RealArithmetic/Interval/Double.hs @@ -0,0 +1,88 @@ +{-| + Module : Numeric.AERN.RealArithmetic.Interval.Double + Description : Interval Double utilities and tests + Copyright : (c) Michal Konecny, Jan Duracz + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable + + Interval Double utilities and tests. +-} +module Numeric.AERN.RealArithmetic.Interval.Double +( + DI, + sampleDI, + PositiveDI(..), + width, + bisect, + module Numeric.AERN.Basics.Interval +) +where + +import Numeric.AERN.Basics.Interval + +import Numeric.AERN.RealArithmetic.Interval + +import Numeric.AERN.RealArithmetic.Basis.Double.ShowInternals +import Numeric.AERN.RealArithmetic.Basis.Double.FieldOps + +import qualified Numeric.AERN.Basics.NumericOrder as NumOrd +import Numeric.AERN.RealArithmetic.RefinementOrderRounding.OpsDefaultEffort + +import Test.QuickCheck + +type DI = Interval Double + +sampleDI :: DI +sampleDI = Interval 0 0 + +newtype PositiveDI = PositiveDI { unPositiveDI :: DI } + +instance Show PositiveDI where + show (PositiveDI i) = show i + +instance Arbitrary PositiveDI + where + arbitrary = + do + NumOrd.UniformlyOrderedPair (l,r) <- arbitrary + return $ PositiveDI (Interval (pos l) (pos r)) + where + pos e + | e > 0 = e + | e == 0 = 1 + | otherwise = (-e) + +{-| + Calculate the width of an interval. + The result may not be thin since the width calculation uses outwards rounding. +-} +width :: DI -> DI +width i = + irI <-> ilI + where + irI = Interval ir ir + ilI = Interval il il + Interval il ir = i + +{-| + Split an interval into two subintervals that share only one point + and whose union is the original interval. +-} +bisect :: + Maybe Double {-^ optional parameter, indicating where to split the interval -} -> + DI {-^ the interval to split -} -> + (DI, DI) +bisect maybeMidpoint i = + (l,r) + where + r = Interval midpoint ir + l = Interval il midpoint + midpoint + = case maybeMidpoint of + Nothing -> 0.5*(il + ir) + Just m -> m + Interval il ir = i + diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE TypeFamilies #-} +{-| + Module : Main + Description : run all tests defined in the AERN-Real package + Copyright : (c) Michal Konecny, Jan Duracz + License : BSD3 + + Maintainer : mikkonecny@gmail.com + Stability : experimental + Portability : portable +-} +module Main where + +import Numeric.AERN.RealArithmetic.Basis.Double +import Numeric.AERN.RealArithmetic.Interval.Double +import Numeric.AERN.RealArithmetic.Interval +import Numeric.AERN.RealArithmetic.Interval.ElementaryFromFieldOps +import Numeric.AERN.RealArithmetic.Interval.Mutable +import Numeric.AERN.RealArithmetic.Interval.Mutable.ElementaryFromFieldOps +import Numeric.AERN.Basics.Interval + +import Numeric.AERN.Basics.Consistency +import qualified Numeric.AERN.Basics.NumericOrder as NumOrd +import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd + +import Numeric.AERN.RealArithmetic.Measures +import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as ArithUpDn +import qualified Numeric.AERN.RealArithmetic.RefinementOrderRounding as ArithInOut + +import Test.Framework (defaultMain) + +main = + do + defaultMain tests + +tests = testsDouble ++ testsDI + +testsDouble = + [ +-- NumOrd.testsArbitraryTuple ("Double", sampleD, NumOrd.compare), + NumOrd.testsPartialComparison ("Double", sampleD), + NumOrd.testsRoundedLatticeDistributive ("Double", sampleD), -- (Just ("NaN", nanD)), + NumOrd.testsRoundedLatticeInPlace ("Double", sampleD), + testsDistance ("Double", sampleD), + ArithUpDn.testsConvert ("Double", sampleD, "Integer", sampleI), + ArithUpDn.testsConvert ("Integer", sampleI, "Double", sampleD), + ArithUpDn.testsConvert ("Double", sampleD, "Rational", sampleR), + ArithUpDn.testsConvert ("Rational", sampleR, "Double", sampleD), + ArithUpDn.testsConvert ("Double", sampleD, "Double", sampleD), + ArithUpDn.testsUpDnAdd ("Double", sampleD), + ArithUpDn.testsUpDnSubtr ("Double", sampleD), + ArithUpDn.testsUpDnAbs ("Double", sampleD), + ArithUpDn.testsUpDnMult ("Double", sampleD), + ArithUpDn.testsUpDnIntPower ("Double", sampleD), + ArithUpDn.testsUpDnDiv ("Double", sampleD), + ArithUpDn.testsUpDnFieldOpsInPlace ("Double", sampleD), + ArithUpDn.testsUpDnMixedFieldOps ("Double", sampleD) ("Integer", sampleI), + ArithUpDn.testsUpDnMixedFieldOps ("Double", sampleD) ("Rational", sampleR), + ArithUpDn.testsUpDnMixedFieldOps ("Double", sampleD) ("Double", sampleD), + ArithUpDn.testsUpDnMixedFieldOpsInPlace ("Double", sampleD) ("Integer", sampleI), + ArithUpDn.testsUpDnMixedFieldOpsInPlace ("Double", sampleD) ("Rational", sampleR), + ArithUpDn.testsUpDnMixedFieldOpsInPlace ("Double", sampleD) ("Double", sampleD) + ] + +testsDI = + [ + testsConsistency ("DI", sampleDI), + NumOrd.testsPartialComparison ("DI", sampleDI), + NumOrd.testsRefinementRoundedLatticeDistributiveMonotone ("DI", sampleDI), + NumOrd.testsRefinementRoundedLatticeInPlace ("DI", sampleDI), + RefOrd.testsPartialComparison ("DI", sampleDI), + RefOrd.testsRoundedBasis ("DI", sampleDI), + RefOrd.testsOuterInnerRoundedBasisInPlace ("DI", sampleDI), + RefOrd.testsRoundedLatticeDistributive ("DI", sampleDI), + RefOrd.testsOuterInnerRoundedLatticeInPlace ("DI", sampleDI), + testsDistance ("DI", sampleDI), + testsImprecision ("DI", sampleDI), + ArithInOut.testsConvertNumOrd ("Integer", sampleI, "DI", sampleDI), + ArithInOut.testsConvertNumOrd ("Double", sampleD, "DI", sampleDI), + ArithInOut.testsConvertNumOrd ("Rational", sampleR, "DI", sampleDI), + ArithInOut.testsInOutAdd ("DI", sampleDI), + ArithInOut.testsInOutSubtr ("DI", sampleDI), + ArithInOut.testsInOutAbs ("DI", sampleDI), + ArithInOut.testsInOutMult ("DI", sampleDI), + ArithInOut.testsInOutIntPower ("DI", sampleDI), + ArithInOut.testsInOutDiv ("DI", sampleDI), + ArithInOut.testsInOutFieldOpsInPlace ("DI", sampleDI), + ArithInOut.testsInOutMixedFieldOps ("DI", sampleDI) ("Integer", sampleI), + ArithInOut.testsInOutMixedFieldOps ("DI", sampleDI) ("Rational", sampleR), + ArithInOut.testsInOutMixedFieldOps ("DI", sampleDI) ("Double", sampleD), + ArithInOut.testsInOutMixedFieldOpsInPlace ("DI", sampleDI) ("Integer", sampleI), + ArithInOut.testsInOutMixedFieldOpsInPlace ("DI", sampleDI) ("Rational", sampleR), + ArithInOut.testsInOutMixedFieldOpsInPlace ("DI", sampleDI) ("Double", sampleD), + ArithInOut.testsInOutExp ("DI", sampleDI), + ArithInOut.testsInOutExpInPlace ("DI", sampleDI), + ArithInOut.testsInOutSqrt ("DI", sampleDI) unPositiveDI, + ArithInOut.testsInOutSqrtInPlace ("DI", sampleDI) unPositiveDI + ] + +sampleI = 1 :: Integer +sampleR = 1 :: Rational