aern2-mp 0.1.3.1 → 0.1.4

raw patch · 27 files changed

+1340/−817 lines, 27 filesdep ~mixed-types-num

Dependency ranges changed: mixed-types-num

Files

aern2-mp.cabal +14/−14
changelog.md +4/−0
src-cdar/AERN2/MP/Float/Arithmetic.hs +104/−0
src-cdar/AERN2/MP/Float/Conversions.hs +152/−0
src-cdar/AERN2/MP/Float/Type.hs +79/−0
src-rounded/AERN2/MP/Float/Arithmetic.hs +117/−0
src-rounded/AERN2/MP/Float/Conversions.hs +178/−0
src-rounded/AERN2/MP/Float/RoundedAdaptor.hs +84/−0
src-rounded/AERN2/MP/Float/Type.hs +76/−0
src/AERN2/MP/Ball/Conversions.hs +8/−10
src/AERN2/MP/Ball/Elementary.hs +24/−17
src/AERN2/MP/Ball/Field.hs +24/−15
src/AERN2/MP/Ball/Type.hs +6/−8
src/AERN2/MP/Dyadic.hs +16/−12
src/AERN2/MP/Enclosure.hs +17/−1
src/AERN2/MP/ErrorBound.hs +4/−4
src/AERN2/MP/Float.hs +9/−19
src/AERN2/MP/Float/Auxi.hs +36/−0
src/AERN2/MP/Float/Constants.hs +0/−58
src/AERN2/MP/Float/Operators.hs +79/−17
src/AERN2/MP/Float/Tests.hs +289/−195
src/AERN2/MP/Float/UseRounded/Arithmetic.hs +0/−151
src/AERN2/MP/Float/UseRounded/Conversions.hs +0/−161
src/AERN2/MP/Float/UseRounded/RoundedAdaptor.hs +0/−84
src/AERN2/MP/Float/UseRounded/Type.hs +0/−49
src/AERN2/MP/Precision.hs +3/−2
src/AERN2/Norm.hs +17/−0

aern2-mp.cabal view

@@ -1,11 +1,11 @@ name:           aern2-mp-version:        0.1.3.1+version:        0.1.4 cabal-version:  >= 1.9.2 build-type:     Simple homepage:       https://github.com/michalkonecny/aern2 author:         Michal Konecny maintainer:     Michal Konecny <mikkonecny@gmail.com>-copyright:      (c) 2015-2018 Michal Konecny+copyright:      (c) 2015-2019 Michal Konecny license:        BSD3 license-file:   LICENSE extra-source-files:  changelog.md@@ -31,7 +31,7 @@   subdir: aern2-mp  flag UseCDAR-  Description: Use an integer-only backend (work in progress, not default)+  Description: Use CDAR (mBound branch) as an Integer-only backend instead of MPFR   Default:     False  library@@ -46,15 +46,15 @@     , QuickCheck     , lens     , template-haskell-    , mixed-types-num+    , mixed-types-num >= 0.3.2   if flag(UseCDAR)-    cpp-options: -DUseCDAR+    hs-source-dirs:  src-cdar     build-depends:       cdar   else+    hs-source-dirs:  src-rounded     build-depends:       rounded == 0.1.*--- TODO   ghc-options:     -Wall -fno-warn-orphans   extensions:     RebindableSyntax,@@ -70,15 +70,15 @@     FlexibleContexts,     FlexibleInstances,     UndecidableInstances-  if flag(UseCDAR)-    exposed-modules:-  else+  if !flag(UseCDAR)     exposed-modules:-      AERN2.MP.Float.UseRounded.Type-      AERN2.MP.Float.UseRounded.RoundedAdaptor-      AERN2.MP.Float.UseRounded.Arithmetic-      AERN2.MP.Float.UseRounded.Conversions+      AERN2.MP.Float.RoundedAdaptor   exposed-modules:+    -- modules that depend on backend choice:+    AERN2.MP.Float.Type+    AERN2.MP.Float.Arithmetic+    AERN2.MP.Float.Conversions+    -- modules common to all backends:     AERN2.Utils.Bench     AERN2.Normalize     AERN2.Norm@@ -86,8 +86,8 @@     AERN2.MP.Accuracy     AERN2.MP.Enclosure     AERN2.MP.ErrorBound+    AERN2.MP.Float.Auxi     AERN2.MP.Float.Operators-    AERN2.MP.Float.Constants     AERN2.MP.Float.Tests     AERN2.MP.Float     AERN2.MP.Dyadic

changelog.md view

@@ -1,5 +1,9 @@ # Change log for aern2-mp +* v 0.1.4 2019-03-19+  * CDAR-based Integer-only backend+    * needs the mBound branch of CDAR+  * adapts to mixed-types-num 0.3.2 (new divI, mod) * v 0.1.3.1 2018-11-21   * small fixes, mainly documentation * v 0.1.3.0 2018-11-20

+ src-cdar/AERN2/MP/Float/Arithmetic.hs view

@@ -0,0 +1,104 @@+{-|+    Module      :  AERN2.MP.Float.Arithmetic+    Description :  Arbitrary precision floating point numbers+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Arbitrary precision floating-point numbers with up/down-rounded operations.+-}++module AERN2.MP.Float.Arithmetic+  (+   -- * MPFloat basic arithmetic+     addCEDU, subCEDU+   , mulCEDU, divCEDU, recipCEDU+   -- * MPFloat selected constants and operations+   , piCEDU+   , cosCEDU, sinCEDU+   , sqrtCEDU, expCEDU, logCEDU+   )+where++import MixedTypesNumPrelude+import qualified Prelude as P++import AERN2.MP.Precision++import qualified Data.CDAR as MPLow++import AERN2.MP.Float.Auxi+import AERN2.MP.Float.Type++{- common functions -}++instance CanNeg MPFloat where+  negate = P.negate++instance CanAbs MPFloat where+  abs = P.abs++addCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+addCEDU = binaryCEDU (P.+)++subCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+subCEDU = binaryCEDU (P.-)++mulCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+mulCEDU = binaryCEDU (P.*)++divCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+divCEDU x y +    | y P.== (P.fromInteger 0) = getBoundsCEDU MPLow.Bottom+    | otherwise = binaryCEDU (P./) x y++recipCEDU :: MPFloat -> BoundsCEDU MPFloat+recipCEDU = unaryCEDU P.recip++{- special constants and functions -}++piCEDU :: Precision -> BoundsCEDU MPFloat+piCEDU pp = +    getBoundsCEDU $ MPLow.piA (p2cdarPrec pp)++cosCEDU :: MPFloat -> BoundsCEDU MPFloat+cosCEDU = unaryPrecCEDU 0 MPLow.cosA++sinCEDU :: MPFloat -> BoundsCEDU MPFloat+sinCEDU = unaryPrecCEDU 0 MPLow.sinA+            +sqrtCEDU :: MPFloat -> BoundsCEDU MPFloat+sqrtCEDU = unaryCEDU MPLow.sqrtA+            +expCEDU :: MPFloat -> BoundsCEDU MPFloat+expCEDU = unaryCEDU MPLow.expA++logCEDU :: MPFloat -> BoundsCEDU MPFloat+logCEDU = unaryCEDU MPLow.logA++{- auxiliary functions to automatically determine result precision from operand precisions -}++binaryCEDU ::+    (MPFloat -> MPFloat -> MPFloat) ->+    (MPFloat -> MPFloat -> BoundsCEDU MPFloat)+binaryCEDU op x y =+    getBoundsCEDU $ op x y++unaryCEDU ::+    (MPFloat -> MPFloat) ->+    (MPFloat -> BoundsCEDU MPFloat)+unaryCEDU op x =+    getBoundsCEDU $ op x++unaryPrecCEDU ::+    Integer ->+    (MPLow.Precision -> MPFloat -> MPFloat) ->+    (MPFloat -> BoundsCEDU MPFloat)+unaryPrecCEDU addPrec op x@(MPLow.Approx mb _ _ s) =+    getBoundsCEDU $ op ((-s P.+ mb) P.+ (int addPrec)) x+unaryPrecCEDU addPrec op MPLow.Bottom =+    getBoundsCEDU $ op ((int $ integer defaultPrecision) P.+ (int addPrec)) MPLow.Bottom+

+ src-cdar/AERN2/MP/Float/Conversions.hs view

@@ -0,0 +1,152 @@+{-|+    Module      :  AERN2.MP.Float.Conversions+    Description :  Conversions and comparisons of arbitrary precision floats+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Conversions and comparisons of arbitrary precision floating point numbers+-}++module AERN2.MP.Float.Conversions+  (+   -- * MPFloat to other types (see also instances)+   toDouble+   -- * MPFloat constructors (see also instances)+   , CanBeMPFloat, mpFloat+   , fromIntegerCEDU+   , fromRationalCEDU+   -- * comparisons and constants (see also instances)+   , zero, one, two+   , nan, infinity+   )+where++import MixedTypesNumPrelude+import qualified Prelude as P++import Data.Ratio+import Data.Convertible++-- import AERN2.Norm+import AERN2.MP.Precision++import qualified Data.CDAR as MPLow++import AERN2.MP.Float.Auxi+import AERN2.MP.Float.Type+import AERN2.MP.Float.Arithmetic+++{- conversions to MPFloat -}++type CanBeMPFloat t = ConvertibleExactly t MPFloat+mpFloat :: (CanBeMPFloat t) => t -> MPFloat+mpFloat = convertExactly++instance ConvertibleExactly Integer MPFloat where+    safeConvertExactly =+      Right . P.fromInteger++instance ConvertibleExactly Int MPFloat where+    safeConvertExactly = safeConvertExactly . integer++fromIntegerCEDU :: Precision -> Integer -> BoundsCEDU MPFloat+fromIntegerCEDU pp =+  setPrecisionCEDU pp . P.fromInteger++fromRationalCEDU :: Precision -> Rational -> BoundsCEDU MPFloat+fromRationalCEDU pp =+  setPrecisionCEDU pp . (MPLow.toApprox (p2cdarPrec pp))++{- conversions from MPFloat -}++instance ConvertibleExactly MPFloat Rational where+  safeConvertExactly = Right . P.toRational+    +toDouble :: MPFloat -> Double+toDouble = P.fromRational . rational++instance Convertible MPFloat Double where+  safeConvert x+    | isFinite dbl = Right dbl+    | otherwise = convError "conversion to double: out of bounds" x+    where+    dbl = toDouble x+++instance CanRound MPFloat where+  properFraction x = (n,f)+    where+      r = rational x+      n = (numerator r) `P.quot` (denominator r)+      f =  ceduCentre $ x `subCEDU` (P.fromInteger n)+  +{- comparisons -}++instance HasEqAsymmetric MPFloat MPFloat+instance HasEqAsymmetric MPFloat Integer where+  equalTo = convertSecond equalTo+instance HasEqAsymmetric Integer MPFloat where+  equalTo = convertFirst equalTo+instance HasEqAsymmetric MPFloat Int where+  equalTo = convertSecond equalTo+instance HasEqAsymmetric Int MPFloat where+  equalTo = convertFirst equalTo+instance HasEqAsymmetric MPFloat Rational where+  equalTo = convertFirst equalTo+instance HasEqAsymmetric Rational MPFloat where+  equalTo = convertSecond equalTo++instance CanTestZero MPFloat++instance HasOrderAsymmetric MPFloat MPFloat+instance HasOrderAsymmetric MPFloat Integer where+  lessThan = convertSecond lessThan+  leq = convertSecond leq+instance HasOrderAsymmetric Integer MPFloat where+  lessThan = convertFirst lessThan+  leq = convertFirst leq+instance HasOrderAsymmetric MPFloat Int where+  lessThan = convertSecond lessThan+  leq = convertSecond leq+instance HasOrderAsymmetric Int MPFloat where+  lessThan = convertFirst lessThan+  leq = convertFirst leq+instance HasOrderAsymmetric Rational MPFloat where+  lessThan = convertSecond lessThan+  leq = convertSecond leq+instance HasOrderAsymmetric MPFloat Rational where+  lessThan = convertFirst lessThan+  leq = convertFirst leq++instance CanTestPosNeg MPFloat++{- min, max -}++instance CanMinMaxAsymmetric MPFloat MPFloat++{- constants -}++zero, one, two :: MPFloat+zero = mpFloat 0+one = mpFloat 1+two = mpFloat 2++nan, infinity :: MPFloat+nan = MPLow.Bottom+infinity = nan++itisNaN :: MPFloat -> Bool+itisNaN MPLow.Bottom = True+itisNaN _ = False++instance CanTestFinite MPFloat where+  isInfinite = itisNaN+  isFinite = not . itisNaN++instance CanTestNaN MPFloat where+  isNaN = itisNaN

+ src-cdar/AERN2/MP/Float/Type.hs view

@@ -0,0 +1,79 @@+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.Float.Type+    Description :  Arbitrary precision floating point numbers (via cdar)+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Arbitrary precision floating-point numbers, re-using CDAR Approx type.+-}++module AERN2.MP.Float.Type+  (+   -- * MPFloat numbers and their basic operations+   MPFloat+   , showMPFloat+   , setPrecisionCEDU+   , p2cdarPrec+   , getBoundsCEDU+   )+where++import MixedTypesNumPrelude+import qualified Prelude as P++-- import Data.Bits (unsafeShiftL)+import Data.Typeable++import AERN2.Norm+import AERN2.MP.Precision+import AERN2.MP.Float.Auxi++import qualified Data.CDAR as MPLow++{-| Multiple-precision floating-point type based on CDAR.Approx with 0 radius. -}+type MPFloat = MPLow.Approx++showMPFloat :: MPFloat -> String+showMPFloat x = MPLow.showA x++deriving instance (Typeable MPFloat)++p2cdarPrec :: Precision -> MPLow.Precision+p2cdarPrec = P.fromInteger . integer++getBoundsCEDU :: MPFloat -> BoundsCEDU MPFloat+getBoundsCEDU (MPLow.Approx mb m e s) = +  BoundsCEDU +    (MPLow.Approx mb m 0 s) (MPLow.approxMB eb_mb e 0 s)+    (MPLow.Approx mb (m-e) 0 s) (MPLow.Approx mb (m+e) 0 s)+getBoundsCEDU MPLow.Bottom =+  BoundsCEDU+    MPLow.Bottom MPLow.Bottom MPLow.Bottom MPLow.Bottom++{-| The bit-size bound for the error bound in CEDU -}+eb_prec :: Precision+eb_prec = prec 63++{-| The bit-size bound for the error bound in CEDU -}+eb_mb :: Int+eb_mb = int $ integer eb_prec++instance HasPrecision MPFloat where+  getPrecision (MPLow.Approx mb _ _ _) = prec (P.toInteger $ mb)+  getPrecision MPLow.Bottom = error "illegal MPFloat (Bottom)"+  ++instance CanSetPrecision MPFloat where+  setPrecision p = ceduCentre . setPrecisionCEDU p++setPrecisionCEDU :: Precision -> MPFloat -> BoundsCEDU MPFloat+setPrecisionCEDU pp = getBoundsCEDU . MPLow.enforceMB . MPLow.setMB (p2cdarPrec pp)++instance HasNorm MPFloat where+  getNormLog (MPLow.Approx _ m _ s) = (getNormLog m) + (integer s)+  getNormLog MPLow.Bottom = error "getNormLog undefined for Bottom"

+ src-rounded/AERN2/MP/Float/Arithmetic.hs view

@@ -0,0 +1,117 @@+{-|+    Module      :  AERN2.MP.Float.Arithmetic+    Description :  Arbitrary precision floating point numbers+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Arbitrary precision floating-point numbers with up/down-rounded operations.+-}++module AERN2.MP.Float.Arithmetic+  (+   -- * MPFloat basic arithmetic+     addCEDU, subCEDU+   , mulCEDU, divCEDU, recipCEDU+   -- * MPFloat selected constants and operations+   , piCEDU+   , cosCEDU, sinCEDU+   , sqrtCEDU, expCEDU, logCEDU+   -- * auxiliary functions+   , constCEDU, unaryCEDU, binaryCEDU+   )+where++import MixedTypesNumPrelude+import qualified Prelude as P++import AERN2.MP.Precision++import qualified AERN2.MP.Float.RoundedAdaptor as MPLow++import AERN2.MP.Float.Auxi+import AERN2.MP.Float.Type++one :: MPFloat+one = MPLow.one++{- common functions -}++instance CanNeg MPFloat where+  negate = ceduUp . unaryCEDU MPLow.neg++instance CanAbs MPFloat where+  abs x+    | x P.< MPLow.zero = negate x+    | otherwise = x+++addCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+addCEDU = binaryCEDU MPLow.add++subCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+subCEDU = binaryCEDU MPLow.sub++mulCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+mulCEDU = binaryCEDU MPLow.mul++divCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+divCEDU = binaryCEDU MPLow.div++recipCEDU :: MPFloat -> BoundsCEDU MPFloat+recipCEDU x = divCEDU one x++{- special constants and functions -}++piCEDU :: Precision -> BoundsCEDU MPFloat+piCEDU pp = +    constCEDU MPLow.pi (p2mpfrPrec pp)++cosCEDU :: MPFloat -> BoundsCEDU MPFloat+cosCEDU = unaryCEDU MPLow.cos++sinCEDU :: MPFloat -> BoundsCEDU MPFloat+sinCEDU = unaryCEDU MPLow.sin+            +sqrtCEDU :: MPFloat -> BoundsCEDU MPFloat+sqrtCEDU = unaryCEDU MPLow.sqrt+            +expCEDU :: MPFloat -> BoundsCEDU MPFloat+expCEDU = unaryCEDU MPLow.exp+            +logCEDU :: MPFloat -> BoundsCEDU MPFloat+logCEDU = unaryCEDU MPLow.log++{- auxiliary functions to automatically determine result precision from operand precisions -}++binaryCEDU :: +    (MPLow.RoundMode -> MPLow.Precision -> MPFloat -> MPFloat -> MPFloat) -> +    MPFloat -> MPFloat -> BoundsCEDU MPFloat+binaryCEDU op x y =+    getCEDU d u+    where+    d = op MPLow.Down p x y+    u = op MPLow.Up p x y+    p = p2mpfrPrec $ (getPrecision x) `max` (getPrecision y)++unaryCEDU :: +    (MPLow.RoundMode -> MPLow.Precision -> MPFloat -> MPFloat) -> +    MPFloat -> BoundsCEDU MPFloat+unaryCEDU op x =+    getCEDU d u+    where+    d = op MPLow.Down p x+    u = op MPLow.Up p x+    p = p2mpfrPrec $ getPrecision x++constCEDU :: +    (MPLow.RoundMode -> MPLow.Precision -> MPFloat) -> +    MPLow.Precision -> BoundsCEDU MPFloat+constCEDU op p =+    getCEDU d u+    where+    d = op MPLow.Down p+    u = op MPLow.Up p

+ src-rounded/AERN2/MP/Float/Conversions.hs view

@@ -0,0 +1,178 @@+{-|+    Module      :  AERN2.MP.Float.Conversions+    Description :  Conversions and comparisons of arbitrary precision floats+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Conversions and comparisons of arbitrary precision floating point numbers+-}++module AERN2.MP.Float.Conversions+  (+   -- * MPFloat to other types (see also instances)+   toDouble+   -- * MPFloat constructors (see also instances)+   , CanBeMPFloat, mpFloat+   , fromIntegerCEDU+   , fromRationalCEDU+   -- * comparisons and constants (see also instances)+   , zero, one, two+   , nan, infinity+   )+where++import MixedTypesNumPrelude+import qualified Prelude as P++import Data.Ratio+import Data.Convertible++import AERN2.Norm+import AERN2.MP.Precision++import AERN2.MP.Float.Auxi+import AERN2.MP.Float.Type+import AERN2.MP.Float.Arithmetic++import qualified AERN2.MP.Float.RoundedAdaptor as MPLow++mpToDouble :: MPLow.RoundMode -> MPFloat -> Double+mpToDouble = MPLow.toDoubleA++mpToRational :: MPFloat -> Rational+mpToRational x+  | x == 0 = 0.0+  | otherwise = MPLow.toRationalA x++mpFromRationalA :: MPLow.RoundMode -> MPLow.Precision -> Rational -> MPFloat+mpFromRationalA = MPLow.fromRationalA++{- conversions to MPFloat -}++type CanBeMPFloat t = ConvertibleExactly t MPFloat+mpFloat :: (CanBeMPFloat t) => t -> MPFloat+mpFloat = convertExactly++instance ConvertibleExactly Integer MPFloat where+    safeConvertExactly n =+        findExact $ map (flip fromIntegerCEDU n) $ standardPrecisions initPrec+        where+        initPrec =+            case getNormLog n of+              NormBits b -> prec (b + 8)+              _ -> prec 8+        findExact [] =+            convError "integer too high to represent exactly" n+        findExact (cedu : rest)+            | ceduErr cedu P.> zero = findExact rest+            | otherwise = Right (ceduCentre cedu)++instance ConvertibleExactly Int MPFloat where+    safeConvertExactly = safeConvertExactly . integer++fromIntegerCEDU :: Precision -> Integer -> BoundsCEDU MPFloat+fromIntegerCEDU pp n =+  constCEDU (\r p -> MPLow.fromIntegerA r p n) (p2mpfrPrec pp)++fromRationalCEDU :: Precision -> Rational -> BoundsCEDU MPFloat+fromRationalCEDU pp q =+  constCEDU (\r p -> mpFromRationalA r p q) (p2mpfrPrec pp)++{- conversions from MPFloat -}++instance ConvertibleExactly MPFloat Rational where+  safeConvertExactly = Right . mpToRational++toDouble :: MPFloat -> Double+toDouble = mpToDouble MPLow.Up++instance Convertible MPFloat Double where+  safeConvert x+    | isFinite dbl = Right dbl+    | otherwise = convError "conversion to double: out of bounds" x+    where+    dbl = toDouble x++instance CanRound MPFloat where+  properFraction x = (n,f)+    where+      r = rational x+      n = (numerator r) `P.quot` (denominator r)+      f = ceduCentre $ x `subCEDU` (mpFloat n)++{- comparisons -}++instance HasEqAsymmetric MPFloat MPFloat+instance HasEqAsymmetric MPFloat Integer where+  equalTo = convertSecond equalTo+instance HasEqAsymmetric Integer MPFloat where+  equalTo = convertFirst equalTo+instance HasEqAsymmetric MPFloat Int where+  equalTo = convertSecond equalTo+instance HasEqAsymmetric Int MPFloat where+  equalTo = convertFirst equalTo+instance HasEqAsymmetric MPFloat Rational where+  equalTo = convertFirst equalTo+instance HasEqAsymmetric Rational MPFloat where+  equalTo = convertSecond equalTo++instance CanTestZero MPFloat++instance HasOrderAsymmetric MPFloat MPFloat+instance HasOrderAsymmetric MPFloat Integer where+  lessThan = convertSecond lessThan+  leq = convertSecond leq+instance HasOrderAsymmetric Integer MPFloat where+  lessThan = convertFirst lessThan+  leq = convertFirst leq+instance HasOrderAsymmetric MPFloat Int where+  lessThan = convertSecond lessThan+  leq = convertSecond leq+instance HasOrderAsymmetric Int MPFloat where+  lessThan = convertFirst lessThan+  leq = convertFirst leq+instance HasOrderAsymmetric Rational MPFloat where+  lessThan = convertSecond lessThan+  leq = convertSecond leq+instance HasOrderAsymmetric MPFloat Rational where+  lessThan = convertFirst lessThan+  leq = convertFirst leq++instance CanTestPosNeg MPFloat++{- min, max -}++instance CanMinMaxAsymmetric MPFloat MPFloat++{- constants -}++zero, one, two :: MPFloat+zero = MPLow.zero+one = MPLow.one+two = MPLow.add MPLow.Up (MPLow.getPrec one) one one++nan, infinity :: MPFloat+nan = ceduCentre $ divCEDU zero zero +infinity = ceduCentre $ divCEDU one zero ++itisNaN :: MPFloat -> Bool+itisNaN x = not $ x P.== x++itisInfinite :: MPFloat -> Bool+itisInfinite x =+  ceduCentre (mulCEDU x two) P.== x+  &&+  x P./= zero++instance CanTestFinite MPFloat where+  isInfinite = itisInfinite+  isFinite x = not (itisInfinite x || itisNaN x)++instance CanTestNaN MPFloat where+  isNaN = itisNaN++

+ src-rounded/AERN2/MP/Float/RoundedAdaptor.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE DataKinds, ExistentialQuantification, RankNTypes #-}+-- {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.Float.UseRounded.RoundedAdaptor+    Description :  Numeric.Rounded + variable precision+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Numeric.Rounded + variable precision+-}+module AERN2.MP.Float.RoundedAdaptor+(+  module AERN2.MP.Float.RoundedAdaptor+, module Numeric.Rounded.Simple+)+where++import Prelude hiding (div, pi)+-- import qualified Prelude as P++import Numeric.Rounded.Simple+-- import qualified Numeric.RoundedSimple as R++instance Show Rounded where+  show = show'++getPrec :: Rounded -> Int+getPrec = precision++getExp :: Rounded -> Int+getExp = exponent'++data RoundMode = Up | Down++withRoundMode :: (RoundingMode -> t) -> (RoundMode -> t)+withRoundMode op Up = op TowardInf+withRoundMode op Down = op TowardNegInf+{-# INLINE withRoundMode #-}++set :: RoundMode -> Precision -> Rounded -> Rounded+set = withRoundMode precRound++defaultPrecision :: Precision+defaultPrecision = 53++pi :: RoundMode -> Precision -> Rounded+pi = withRoundMode kPi++fromIntegerA :: RoundMode -> Precision -> Integer -> Rounded+fromIntegerA = withRoundMode fromInteger'++zero, one :: Rounded+zero = fromIntegerA Up defaultPrecision 0+one = fromIntegerA Up defaultPrecision 1++toDoubleA :: RoundMode -> Rounded -> Double+toDoubleA = withRoundMode toDouble++fromRationalA :: RoundMode -> Precision -> Rational -> Rounded+fromRationalA = withRoundMode fromRational'++toRationalA :: Rounded -> Rational+toRationalA = toRational' TowardNearest++add, sub, mul, div, atan2 :: RoundMode -> Precision -> Rounded -> Rounded -> Rounded+add = withRoundMode add_+sub = withRoundMode sub_+mul = withRoundMode mul_+div = withRoundMode div_+atan2 = withRoundMode atan2_++neg, abs, sqrt, exp, log, sin, cos :: RoundMode -> Precision -> Rounded -> Rounded+neg = withRoundMode negate_+abs = withRoundMode abs_+sqrt = withRoundMode sqrt_+exp = withRoundMode exp_+log = withRoundMode log_+sin = withRoundMode sin_+cos = withRoundMode cos_+-- TODO: add more ops

+ src-rounded/AERN2/MP/Float/Type.hs view

@@ -0,0 +1,76 @@+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.Float.Type+    Description :  Arbitrary precision floating point numbers (MPFR)+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Arbitrary precision floating-point numbers using MPFR via package rounded.+-}++module AERN2.MP.Float.Type+  (+   -- * MPFloat numbers and their basic operations+   MPFloat+   , showMPFloat+   , setPrecisionCEDU+   , getCEDU+   , p2mpfrPrec+   )+where++import MixedTypesNumPrelude+import qualified Prelude as P++import AERN2.Norm+import AERN2.MP.Precision+import AERN2.MP.Float.Auxi++import qualified AERN2.MP.Float.RoundedAdaptor as MPLow+import Data.Typeable++{-| Multiple-precision floating-point type based on MPFR via rounded. -}+type MPFloat = MPLow.Rounded++showMPFloat :: MPFloat -> String+showMPFloat = show++deriving instance (Typeable MPFloat)++p2mpfrPrec :: Precision -> MPLow.Precision+p2mpfrPrec = P.fromInteger . integer++getCEDU :: MPFloat -> MPFloat -> BoundsCEDU MPFloat+getCEDU d u = BoundsCEDU c e d u+  where+  c = u+  e = MPLow.sub MPLow.Up (MPLow.getPrec c) u d++instance HasPrecision MPFloat where+  getPrecision x = prec (P.toInteger $ MPLow.getPrec x)++instance CanSetPrecision MPFloat where+  setPrecision = setPrecisionUp++setPrecisionUp :: Precision -> MPFloat -> MPFloat+setPrecisionUp p = MPLow.set MPLow.Up (p2mpfrPrec p)++setPrecisionDown :: Precision -> MPFloat -> MPFloat+setPrecisionDown p = MPLow.set MPLow.Down (p2mpfrPrec p)++setPrecisionCEDU :: Precision -> MPFloat -> BoundsCEDU MPFloat+setPrecisionCEDU p x =+  getCEDU d u +  where+  d = setPrecisionDown p x+  u = setPrecisionUp p x++instance HasNorm MPFloat where+  getNormLog x+    | x P.== MPLow.zero = NormZero+    | otherwise = NormBits (P.toInteger $ MPLow.getExp x)+

src/AERN2/MP/Ball/Conversions.hs view

@@ -27,8 +27,8 @@ import AERN2.MP.Float (mpFloat) -- import AERN2.MP.Float.Operators import AERN2.MP.Precision-import qualified AERN2.MP.ErrorBound as EB-import AERN2.MP.ErrorBound (errorBound)+-- import qualified AERN2.MP.ErrorBound as EB+import AERN2.MP.ErrorBound (ErrorBound, errorBound)  import AERN2.MP.Ball.Type @@ -40,7 +40,7 @@     where       (l,r) = endpointsMP b -instance Convertible MPBall EB.ErrorBound where+instance Convertible MPBall ErrorBound where   safeConvert b =     Right (errorBound (max (abs l) (abs r)))     where@@ -54,7 +54,7 @@ instance ConvertibleExactly Dyadic MPBall where   safeConvertExactly x = Right $ MPBall (mpFloat x) (errorBound 0) -instance ConvertibleExactly EB.ErrorBound MPBall where+instance ConvertibleExactly ErrorBound MPBall where   safeConvertExactly eb = Right $ MPBall (mpFloat eb) (errorBound 0)  instance@@ -86,9 +86,8 @@     | isFinite b = Right b     | otherwise = convError ("too large to convert to MPBall with precision " ++ show p) x     where-    b = MPBall xUp (xUp `EB.subMP` xDn)-    xUp = MPFloat.fromIntegerUp p x-    xDn = MPFloat.fromIntegerDown p x+    b = MPBall xC (errorBound xErr)+    (xC, xErr) = MPFloat.ceduCentreErr $ MPFloat.fromIntegerCEDU p x  instance ConvertibleWithPrecision Int MPBall where   safeConvertP p = safeConvertP p . integer@@ -105,9 +104,8 @@     | isFinite b = Right b     | otherwise = convError ("too large to convert to MPBall with precision " ++ show p) x     where-    b = MPBall xUp (xUp `EB.subMP` xDn)-    xUp = MPFloat.fromRationalUp p x-    xDn = MPFloat.fromRationalDown p x+    b = MPBall xC (errorBound xErr)+    (xC, xErr) = MPFloat.ceduCentreErr $ MPFloat.fromRationalCEDU p x  instance ConvertibleWithPrecision (Rational, Rational) MPBall where   safeConvertP p (x,e)

src/AERN2/MP/Ball/Elementary.hs view

@@ -26,10 +26,10 @@  import AERN2.MP.Dyadic (Dyadic) import qualified AERN2.MP.Float as MPFloat-import AERN2.MP.Float (MPFloat, mpFloat)+import AERN2.MP.Float (MPFloat, mpFloat, ceduCentreErr) -- import AERN2.MP.Float.Operators import AERN2.MP.Precision-import qualified AERN2.MP.ErrorBound as EB+-- import qualified AERN2.MP.ErrorBound as EB import AERN2.MP.ErrorBound (errorBound)  import AERN2.MP.Ball.Type@@ -41,10 +41,9 @@ {- trigonometrics -}  piBallP :: Precision -> MPBall-piBallP p = MPBall piUp (piUp `EB.subMP` piDown)+piBallP p = MPBall piC (errorBound piErr)   where-  piUp = MPFloat.piUp p-  piDown = MPFloat.piDown p+  (piC, piErr) = MPFloat.ceduCentreErr $ MPFloat.piCEDU p  instance CanSinCos MPBall where   sin = sinB 1@@ -53,7 +52,7 @@ sinB :: Integer -> MPBall -> MPBall sinB i x =     -- increasingPrecisionUntilNotImproving (fromApproxWithLipschitz MPFloat.sinDown MPFloat.sinUp lip) x-    fromApproxWithLipschitz MPFloat.sinDown MPFloat.sinUp lip x+    fromApproxWithLipschitz MPFloat.sinCEDU lip x     where     lip         | i == 0 = mpFloat 1@@ -62,7 +61,7 @@ cosB :: Integer -> MPBall -> MPBall cosB i x =     -- increasingPrecisionUntilNotImproving (fromApproxWithLipschitz MPFloat.cosDown MPFloat.cosUp lip) x-    fromApproxWithLipschitz MPFloat.cosDown MPFloat.cosUp lip x+    fromApproxWithLipschitz MPFloat.cosCEDU lip x     where     lip         | i == 0 = mpFloat 1@@ -92,12 +91,22 @@ instance CanLog MPBall where   type LogType MPBall = CN MPBall   log x+    | x_!>! 1 =+        cn $ setPrecision p $ ballFunctionUsingLipschitz log_ logLip x_+    | x_!>! 0 =+        cn $ setPrecision p $ intervalFunctionByEndpoints log_ x_     | x !>! 0 =-        cn $ intervalFunctionByEndpointsUpDown MPFloat.logDown MPFloat.logUp x+        cn $ setPrecision p $ intervalFunctionByEndpoints log_ x     | x !<=! 0 = noValueNumErrorCertainCN err     | otherwise = noValueNumErrorPotentialCN err     where+    p = getPrecision x+    x_ = reducePrecionIfInaccurate x     err = OutOfRange $ "log: argument must be > 0: " ++ show x+    log_ (MPBall c e) = MPBall lc (e + (errorBound le))+      where+      (lc, le) = ceduCentreErr $ MPFloat.logCEDU c+    logLip y = errorBound $ (1/!y)  instance CanPow MPBall MPBall where   powNoCN b e = (~!) $ pow b e@@ -131,16 +140,14 @@     Lipschitz constant for @f@, i.e. @|f(x) - f(y)| <= lip * |x - y|@ for all @x@,@y@. -} fromApproxWithLipschitz ::-    (MPFloat -> MPFloat) {-^ @fDown@: a version of @f@ on MPFloat rounding *downwards* -} ->-    (MPFloat -> MPFloat) {-^ @fUp@: a version of @f@ on MPFloat rounding *upwards* -} ->+    (MPFloat -> MPFloat.BoundsCEDU MPFloat) {-^ @fCEDU@: a version of @f@ on MPFloat returning rigorous bounds -} ->     MPFloat {-^ @lip@ a Lipschitz constant for @f@, @lip > 0@ -} ->     (MPBall -> MPBall) {-^ @f@ on MPBall rounding *outwards* -}-fromApproxWithLipschitz fDown fUp lip _x@(MPBall xc xe) =-    normalize $ MPBall fxc err+fromApproxWithLipschitz fCEDU lip _x@(MPBall xc xe) =+    normalize $ MPBall fxCP err     where-    fxl = fDown xc-    fxu = fUp xc-    (MPBall fxc fxe) =-      setPrecision (getPrecision xc) $ -- beware, some MPFR functions increase precision, eg sine and cosine-        fromEndpointsMP fxl fxu+    (fxC, fxErr) = MPFloat.ceduCentreErr $ fCEDU xc+    (MPBall fxCP fxe) =+      setPrecision (getPrecision xc) $ -- beware, some MPFloat functions may increase precision, eg sine and cosine+        (MPBall fxC (errorBound fxErr))     err = (errorBound lip) * xe  +  fxe

src/AERN2/MP/Ball/Field.hs view

@@ -23,10 +23,11 @@ import AERN2.Normalize  import AERN2.MP.Dyadic (Dyadic)+import qualified AERN2.MP.Float as MPFloat import AERN2.MP.Float (mpFloat) import AERN2.MP.Float.Operators import AERN2.MP.Precision-import qualified AERN2.MP.ErrorBound as EB+-- import qualified AERN2.MP.ErrorBound as EB  import AERN2.MP.Ball.Type import AERN2.MP.Ball.Conversions ()@@ -37,10 +38,9 @@ instance CanAddAsymmetric MPBall MPBall where   type AddType MPBall MPBall = MPBall   add (MPBall x1 e1) (MPBall x2 e2) =-    normalize $ MPBall sumUp ((sumUp `EB.subMP` sumDn) + e1 + e2)+    normalize $ MPBall sumC (e1 + e2 + sumErr)     where-    sumUp = x1 +^ x2-    sumDn = x1 +. x2+    (sumC, sumErr) = MPFloat.ceduCentreErr $ MPFloat.addCEDU x1 x2  instance CanAddAsymmetric MPBall Int where   type AddType MPBall Int = MPBall@@ -138,13 +138,11 @@  instance CanMulAsymmetric MPBall MPBall where   mul (MPBall x1 e1) (MPBall x2 e2) =-    normalize $ MPBall x12Up (e12 + e1*(abs x2) + e2*(abs x1) + e1*e2)+    normalize $ MPBall x12C (e12 + e1*(abs x2) + e2*(abs x1) + e1*e2)       -- the mixed operations above automatically convert       -- MPFloat to ErrorBound, checking non-negativity     where-    x12Up = x1 *^ x2-    x12Down = x1 *. x2-    e12 = x12Up -^ x12Down+    (x12C, e12) = MPFloat.ceduCentreErr $ MPFloat.mulCEDU x1 x2  instance CanMulAsymmetric MPBall Int where   type MulType MPBall Int = MPBall@@ -207,25 +205,24 @@   type DivType MPBall MPBall = CN MPBall   divide (MPBall x1 e1) b2@(MPBall x2 e2)     | isCertainlyNonZero b2 =-        cn $ normalize $ MPBall x12Up err+        cn $ normalize $ MPBall x12C err     | isCertainlyZero b2 =         noValueNumErrorCertainCN DivByZero     | otherwise =         noValueNumErrorPotentialCN DivByZero     where-    x12Up = x1 /^ x2-    x12Down = x1 /. x2-    x12AbsUp = (abs x12Up) `max` (abs x12Down)-    e12 = x12Up -^ x12Down+    (x12C, e12) = MPFloat.ceduCentreErr $ MPFloat.divCEDU x1 x2+    x12AbsUp = (abs x12C) +^ e12+    x2abs = abs x2     err =-        ((e12 *^ (abs x2)) -- e12 * |x2|+        ((e12 *^ x2abs) -- e12 * |x2|          +          e1          +          (e2 * x12AbsUp) -- e2 * |x|         )         *-        ((mpFloat 1) /^ ((abs x2) -. (mpFloat e2)))+        ((mpFloat 1) /^ (x2abs -. (mpFloat e2)))             -- 1/(|x2| - e2) rounded upwards {- A derivation of the above formula for an upper bound on the error:@@ -342,3 +339,15 @@   type PowType (CollectErrors es  a) MPBall =     EnsureCE es (PowType a MPBall)   pow = lift2TCE pow++instance+  CanDivIMod MPBall MPBall+  where+  divIMod x m +    | m !>! 0 = (cn d, cn xm)+    | otherwise = (err (0 :: Integer), err xm)+    where+    d = floor $ centre $ (centreAsBall x) /! (centreAsBall m)+    xm = x - m*d+    err :: (CanEnsureCN t) => t -> EnsureCN t+    err s = noValueNumErrorCertainECN (Just s) $ OutOfRange $ "modulus not positive: " ++ show m

src/AERN2/MP/Ball/Type.hs view

@@ -40,11 +40,10 @@  import AERN2.MP.Dyadic import qualified AERN2.MP.Float as MPFloat-import AERN2.MP.Float (MPFloat, mpFloat)+import AERN2.MP.Float (MPFloat, mpFloat, showMPFloat) import AERN2.MP.Float.Operators import AERN2.MP.Precision import AERN2.MP.Accuracy-import qualified AERN2.MP.ErrorBound as EB import AERN2.MP.ErrorBound (ErrorBound, errorBound) import AERN2.MP.Enclosure @@ -61,7 +60,7 @@     where     show b@(MPBall x _e) =       -- printf "[%s ± %s](prec=%s)" (show x) (showAC $ getAccuracy b) (show $ integer $ getPrecision b)-      printf "[%s ± %s]" (show x) (showAC $ getAccuracy b)+      printf "[%s ± %s]" (showMPFloat x) (showAC $ getAccuracy b)       -- "[" ++ show x ++ " ± " ++ show e ++ "](prec=" ++ (show $ integer $ getPrecision x) ++ ")"       where       showAC Exact = "0"@@ -241,7 +240,7 @@         isAccurate = getAccuracy b < ac         approx             | closeToN = n-            | otherwise = MPFloat.setPrecisionUp (prec (fromAccuracy ac)) x+            | otherwise = MPFloat.ceduCentre $ MPFloat.setPrecisionCEDU (prec (fromAccuracy ac)) x             where             n = mpFloat $ round $ rational x             closeToN = ((abs $ x -^ n) <= e)@@ -251,12 +250,11 @@  instance CanSetPrecision MPBall where     setPrecision p (MPBall x e)-        | p >= pPrev = MPBall xUp e-        | otherwise  = MPBall xUp (e + (xUp `EB.subMP` xDown))+        | p >= pPrev = MPBall xC e+        | otherwise  = MPBall xC (e + (xErr))         where         pPrev = MPFloat.getPrecision x-        xUp = MPFloat.setPrecisionUp p x-        xDown = MPFloat.setPrecisionDown p x+        (xC, xErr) = MPFloat.ceduCentreErr $ MPFloat.setPrecisionCEDU p x  {- negation & abs -}

src/AERN2/MP/Dyadic.hs view

@@ -148,7 +148,7 @@  instance ConvertibleExactly Rational Dyadic where   safeConvertExactly q-    | isDyadic = Right $ Dyadic (fromRationalUp (prec $ max 2 (dp + np + 1)) q)+    | isDyadic = Right $ Dyadic (ceduCentre $ fromRationalCEDU (prec $ max 2 (dp + np + 1)) q)     | otherwise = convError "this number is not dyadic" q     where     isDyadic = d == 2^!dp@@ -333,7 +333,7 @@ {- addition -}  instance CanAddAsymmetric Dyadic Dyadic where-  add = lift2 addDown addUp+  add = lift2 addCEDU  instance CanAddAsymmetric Integer Dyadic where   type AddType Integer Dyadic = Dyadic@@ -383,7 +383,7 @@ {- subtraction -}  instance CanSub Dyadic Dyadic where-  sub = lift2 subDown subUp+  sub = lift2 subCEDU  instance CanSub Integer Dyadic where   type SubType Integer Dyadic = Dyadic@@ -434,7 +434,7 @@ {- multiplication -}  instance CanMulAsymmetric Dyadic Dyadic where-  mul = lift2 mulDown mulUp+  mul = lift2 mulCEDU  instance CanMulAsymmetric Integer Dyadic where   type MulType Integer Dyadic = Dyadic@@ -573,24 +573,28 @@     EnsureCE es (PowType a Dyadic)   pow = lift2TCE pow +instance CanTestFinite Dyadic where+  isFinite = isFinite . dyadicMPFloat+  isInfinite = isInfinite . dyadicMPFloat+ lift2 ::-  (MPFloat -> MPFloat -> MPFloat) ->-  (MPFloat -> MPFloat -> MPFloat) ->+  (MPFloat -> MPFloat -> BoundsCEDU MPFloat) ->   (Dyadic -> Dyadic -> Dyadic)-lift2 opDown opUp (Dyadic x0) (Dyadic y0) = Dyadic (opExact x0 y0)+lift2 opCEDU (Dyadic x0) (Dyadic y0) = Dyadic (opExact x0 y0)   where     opExact x y-      | rUp == rDown = rUp+      | rE P.== zero = rC       | otherwise =-          maybeTrace (printf "Dyadic.lift2: rUp = %s; rDown = %s; p = %s" (show rUp) (show rDown) (show $ integer p)) $+          maybeTrace (printf "Dyadic.lift2: rC = %s; rE = %s; p = %s" (show rC) (show rE) (show $ integer p)) $           opExact xH yH       where-      rUp = opUp x y-      rDown = opDown x y+      rC = ceduCentre rCEDU+      rE = ceduErr rCEDU+      rCEDU = opCEDU x y       xH = setPrecision pH x       yH = setPrecision pH y       pH = precisionTimes2 p-      p = getPrecision rUp+      p = getPrecision rC  instance Arbitrary Dyadic where   arbitrary =

src/AERN2/MP/Enclosure.hs view

@@ -13,7 +13,7 @@ -} module AERN2.MP.Enclosure (-  IsBall(..)+  IsBall(..), ballFunctionUsingLipschitz   , IsInterval(..), intervalFunctionByEndpoints, intervalFunctionByEndpointsUpDown   , CanTestContains(..), CanMapInside(..), specCanMapInside   , CanIntersectAsymmetric(..), CanIntersect@@ -57,6 +57,22 @@     updateRadius (+r) c     where     (c, r) = centreAsBallAndRadius v++{-|+    Computes a ball function @f@ on the centre and updating the error bound using a Lipschitz constant.+-}+ballFunctionUsingLipschitz ::+  (IsBall t, HasEqCertainly t t)+  =>+  (t -> t) {-^ @fThin@: a version of @f@ that works well on thin balls -} ->+  (t -> ErrorBound) {-^ @fLip@: a Lipschitz function of @f@ over large balls -} ->+  (t -> t) {-^ @f@ on *large* balls -}+ballFunctionUsingLipschitz fThin fLip x+  | r == 0 = fThin c+  | otherwise = updateRadius (+ (fLip x)*r) (fThin c)+  where+  (c, r) = centreAsBallAndRadius x+  {- interval-specific operations -}

src/AERN2/MP/ErrorBound.hs view

@@ -32,7 +32,7 @@ import AERN2.MP.Precision import AERN2.MP.Accuracy import qualified AERN2.MP.Float as MPFloat-import AERN2.MP.Float (MPFloat, mpFloat, frequencyElements)+import AERN2.MP.Float (MPFloat, mpFloat, frequencyElements, one, ceduUp) import AERN2.MP.Float.Operators import AERN2.MP.Dyadic @@ -63,7 +63,7 @@       | otherwise = NoInformation       where       eN = floor $ rational e-      eRecipN = ceiling $ rational $ MPFloat.recipDown e+      eRecipN = ceiling $ rational $ one /. e  {- conversions -} @@ -87,7 +87,7 @@  instance Convertible MPFloat ErrorBound where   safeConvert x-    | x >= 0 = Right $ ErrorBound $ MPFloat.setPrecisionUp errorBoundPrecision x+    | x >= 0 = Right $ ErrorBound $ ceduUp $ MPFloat.setPrecisionCEDU errorBoundPrecision x     | otherwise = convError "Trying to construct a negative ErrorBound" x  instance Convertible Integer ErrorBound where@@ -216,6 +216,6 @@         | otherwise =           do           (s :: Integer) <- arbitrary-          let resultR = ((abs s) `mod` (2^!35))/!(2^!32)+          let resultR = ((abs s) `P.mod` (2^!35))/!(2^!32)           let result = convert resultR           return result

src/AERN2/MP/Float.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-|     Module      :  AERN2.MP.Float     Description :  Arbitrary precision floating point numbers@@ -10,26 +9,23 @@     Portability :  portable      Arbitrary precision floating-point numbers with up/down-rounded operations.--    Currently, we use hmpfr when compiling with ghc 7.10 and higher-    and haskell-mpfr when compiling with ghc 7.8. -}  module AERN2.MP.Float   (    -- * Precision operations-   module AERN2.MP.Precision+   module Precision+   -- * Helper structure+   , module Auxi    -- * The type definition and basic operations    , module Type    -- * Arithmetic operations    , module Arithmetic    , distUp, distDown, avgUp, avgDown-   -- * Conversions, comparisons and norm+   -- * Conversions, comparisons and norm, constants such as NaN, infinity    , module Conversions    -- * Infix operators for up/down-rounded operations    , module Operators-   -- * Constants such as NaN, infinity-   , module Constants    -- * Tests    , module Tests    )@@ -38,20 +34,14 @@ import MixedTypesNumPrelude -- import qualified Prelude as P -import AERN2.MP.Precision+import AERN2.MP.Precision as Precision+import AERN2.MP.Float.Auxi as Auxi -#ifdef UseCDAR-import AERN2.MP.Float.UseCDAR.Type as Type-import AERN2.MP.Float.UseCDAR.Arithmetic as Arithmetic-import AERN2.MP.Float.UseCDAR.Conversions as Conversions-#else-import AERN2.MP.Float.UseRounded.Type as Type-import AERN2.MP.Float.UseRounded.Arithmetic as Arithmetic-import AERN2.MP.Float.UseRounded.Conversions as Conversions-#endif+import AERN2.MP.Float.Type as Type+import AERN2.MP.Float.Arithmetic as Arithmetic+import AERN2.MP.Float.Conversions as Conversions  import AERN2.MP.Float.Operators as Operators-import AERN2.MP.Float.Constants as Constants import AERN2.MP.Float.Tests as Tests  -- | Computes an upper bound to the distance @|x - y|@ of @x@ and @y@.

+ src/AERN2/MP/Float/Auxi.hs view

@@ -0,0 +1,36 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-|+    Module      :  AERN2.MP.Float.Auxi+    Description :  Auxiliary structures+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Auxiliary structures for bounds on result and printing.+-}+module AERN2.MP.Float.Auxi+(+    BoundsCEDU(..)+    , ceduDownUp+    , ceduCentreErr+)+where++data BoundsCEDU a =+  BoundsCEDU +  {+    ceduCentre :: a+  , ceduErr :: a+  , ceduDown :: a+  , ceduUp :: a+  }++ceduDownUp :: BoundsCEDU a -> (a,a)+ceduDownUp cedu = (ceduDown cedu, ceduUp cedu)++ceduCentreErr :: BoundsCEDU a -> (a,a)+ceduCentreErr cedu = (ceduCentre cedu, ceduErr cedu)

− src/AERN2/MP/Float/Constants.hs

@@ -1,58 +0,0 @@-{-# LANGUAGE CPP #-}-{-|-    Module      :  AERN2.MP.Float.Constants-    Description :  Special constants NaN, infinity etc-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mikkonecny@gmail.com-    Stability   :  experimental-    Portability :  portable--    Special constants NaN, infinity etc--}--module AERN2.MP.Float.Constants-  (-    zero, one-    , nan, infinity-  )-where--import MixedTypesNumPrelude-import qualified Prelude as P--- import Data.Ratio--#ifdef UseCDAR-import AERN2.MP.Float.UseCDAR.Type-import AERN2.MP.Float.UseCDAR.Conversions-#else-import AERN2.MP.Float.UseRounded.Type-import AERN2.MP.Float.UseRounded.Conversions-#endif--import AERN2.MP.Float.Operators--zero, one :: MPFloat-zero = mpFloat 0-one = mpFloat 1--nan, infinity :: MPFloat-nan = zero /. zero-infinity = one /. zero--itisNaN :: MPFloat -> Bool-itisNaN x = x *^ one /= x--itisInfinite :: MPFloat -> Bool-itisInfinite x =-  x *^ (mpFloat 2) P.== x-  &&-  x P./= (mpFloat 0)--instance CanTestFinite MPFloat where-  isInfinite = itisInfinite-  isFinite x = not (itisInfinite x || itisNaN x)--instance CanTestNaN MPFloat where-  isNaN = itisNaN

src/AERN2/MP/Float/Operators.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-|     Module      :  AERN2.MP.Float.Operators     Description :  Infix operators for up/down-rounded floating-point numbers@@ -12,33 +11,96 @@     Infix operators for up/down-rounded floating-point numbers -} -module AERN2.MP.Float.Operators where+module AERN2.MP.Float.Operators +(+    -- upwards and downwards rounded operations+    (+^), (+.)+    , (-^), (-.)+    , (*^), (*.)+    , (/^), (/.)+    -- upwards and downwards rounded conversions+    , fromIntegerUp, fromIntegerDown+    , fromRationalUp, fromRationalDown+    -- upwards and downwards rounded selected elementary functions+    , cosUp, cosDown, sinUp, sinDown+    , sqrtUp, sqrtDown, expUp, expDown, logUp, logDown+)+where -#ifdef UseCDAR-import AERN2.MP.Float.UseCDAR.Type-import AERN2.MP.Float.UseCDAR.Arithmetic-#else-import AERN2.MP.Float.UseRounded.Type-import AERN2.MP.Float.UseRounded.Arithmetic-#endif+import MixedTypesNumPrelude +import AERN2.MP.Precision+import AERN2.MP.Float.Auxi++import AERN2.MP.Float.Type+import AERN2.MP.Float.Arithmetic+import AERN2.MP.Float.Conversions+ infixl 6  +^, -^, +., -. infixl 7  *^, *., /^, /.  (+^) :: MPFloat -> MPFloat -> MPFloat-(+^) = addUp+(+^) = up2 addCEDU (-^) :: MPFloat -> MPFloat -> MPFloat-(-^) = subUp+(-^) = up2 subCEDU (*^) :: MPFloat -> MPFloat -> MPFloat-(*^) = mulUp+(*^) = up2 mulCEDU (/^) :: MPFloat -> MPFloat -> MPFloat-(/^) = divUp+(/^) = up2 divCEDU +fromIntegerUp :: Precision -> Integer -> MPFloat+fromIntegerUp p = up1 (fromIntegerCEDU p)+fromRationalUp :: Precision -> Rational -> MPFloat+fromRationalUp p = up1 (fromRationalCEDU p)++cosUp :: MPFloat -> MPFloat+cosUp = up1 cosCEDU+sinUp :: MPFloat -> MPFloat+sinUp = up1 sinCEDU+sqrtUp :: MPFloat -> MPFloat+sqrtUp = up1 sqrtCEDU+expUp :: MPFloat -> MPFloat+expUp = up1 expCEDU+logUp :: MPFloat -> MPFloat+logUp = up1 logCEDU++ (+.) :: MPFloat -> MPFloat -> MPFloat-(+.) = addDown+(+.) = down2 addCEDU (-.) :: MPFloat -> MPFloat -> MPFloat-(-.) = subDown+(-.) = down2 subCEDU (*.) :: MPFloat -> MPFloat -> MPFloat-(*.) = mulDown+(*.) = down2 mulCEDU (/.) :: MPFloat -> MPFloat -> MPFloat-(/.) = divDown+(/.) = down2 divCEDU++fromIntegerDown :: Precision -> Integer -> MPFloat+fromIntegerDown p = down1 (fromIntegerCEDU p)+fromRationalDown :: Precision -> Rational -> MPFloat+fromRationalDown p = down1 (fromRationalCEDU p)++cosDown :: MPFloat -> MPFloat+cosDown = down1 cosCEDU+sinDown :: MPFloat -> MPFloat+sinDown = down1 sinCEDU+sqrtDown :: MPFloat -> MPFloat+sqrtDown = down1 sqrtCEDU+expDown :: MPFloat -> MPFloat+expDown = down1 expCEDU+logDown :: MPFloat -> MPFloat+logDown = down1 logCEDU+++up1, down1 :: +    (t -> BoundsCEDU MPFloat) -> +    (t -> MPFloat)+up1 op x = ceduUp $ op x+down1 op x = ceduDown $ op x++up2, down2 :: +    (t1 -> t2 -> BoundsCEDU MPFloat) -> +    (t1 -> t2 -> MPFloat)+up2 op x y = ceduUp $ op x y+down2 op x y = ceduDown $ op x y++

src/AERN2/MP/Float/Tests.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-|     Module      :  AERN2.MP.Float.Tests     Description :  Tests for operations on arbitrary precision floats@@ -21,7 +20,8 @@ module AERN2.MP.Float.Tests   (     specMPFloat, tMPFloat-    , (=~=), approxEqual, approxEqualWithArgs+    , enforceRangeMP+    , approxEqual, approxEqualWithArgs     , frequencyElements   ) where@@ -30,28 +30,23 @@ -- import qualified Prelude as P -- import Data.Ratio import Text.Printf-import Data.Maybe+-- import Data.Maybe  import Test.Hspec import Test.QuickCheck -- import qualified Test.Hspec.SmallCheck as SC +import Control.CollectErrors  import AERN2.Norm import AERN2.MP.Precision+import AERN2.MP.Float.Auxi -#ifdef UseCDAR-import AERN2.MP.Float.UseCDAR.Type-import AERN2.MP.Float.UseCDAR.Arithmetic-import AERN2.MP.Float.UseCDAR.Conversions-#else-import AERN2.MP.Float.UseRounded.Type-import AERN2.MP.Float.UseRounded.Arithmetic-import AERN2.MP.Float.UseRounded.Conversions-#endif+import AERN2.MP.Float.Type+import AERN2.MP.Float.Arithmetic+import AERN2.MP.Float.Conversions  import AERN2.MP.Float.Operators-import AERN2.MP.Float.Constants  instance Arbitrary MPFloat where   arbitrary =@@ -68,19 +63,72 @@           (s :: Integer) <- arbitrary           ex <- choose (-20,10)           let resultR = s * (10.0^!ex)-          let result = fromRationalUp p resultR+          let result = ceduCentre $ fromRationalCEDU p resultR           return result  frequencyElements :: ConvertibleExactly t Int => [(t, a)] -> Gen a frequencyElements elems = frequency [(int n, return e) | (n,e) <- elems] +{-| +    @enforceRange (Just l, Just u) a@ where @l < u@ returns an arbitrary value @b@ with @u < b < l@.+    Moreover, the returned values are distributed roughly evenly if the input values @a@ are distributed +    roughly evenly in a large neighbourhood of the interval @[l,r]@.+    In most cases, when @l<a<u@, then @b=a@.+-}+enforceRangeMP ::+    (Maybe Integer, Maybe Integer) -> MPFloat -> MPFloat+enforceRangeMP _ a+    | isNaN a = a -- pass NaN unchanged+enforceRangeMP (Just l_, Just u_) a+    | not (l < u) = error "enforceRange: inconsistent range"+    | isInfinite a = (u -^ l)/^two+    | l < a && a < u = a+    | l < b && b < u = b+    | otherwise = (u -^ l)/^two+    where+    l = mpFloat l_+    u = mpFloat u_+    b = l +^ ((abs a) `modNoCN` (u-^l))+enforceRangeMP (Just l_, _) a+    | isInfinite a = abs a+    | l < a = a+    | l == a = a +^ one+    | otherwise = (two*^l -^ a)+    where+    l = mpFloat l_+enforceRangeMP (_, Just u_) a+    | isInfinite a = - (abs a)+    | a < u = a+    | a == u = a -. one+    | otherwise = (two*.u -. a)+    where+    u = mpFloat u_+enforceRangeMP _ a = a++instance CanEnsureCE NumErrors MPFloat++instance CanDivIMod MPFloat MPFloat where+  divIMod x m +    | (not (isFinite m)) = (errM (d :: Integer), errM xm)+    | (not (isFinite x)) = (errX (d :: Integer), errX xm)+    | m > zero = (cn d, cn xm)+    | otherwise = (errM (d :: Integer), errM xm)+    where+    d = floor (x /^ m)+    xm = x -^ (mpFloat d)*^m+    errM :: (CanEnsureCN t) => t -> EnsureCN t+    errM s = noValueNumErrorCertainECN (Just s) $ OutOfRange $ "modulus not finite and positive: " ++ show m+    errX :: (CanEnsureCN t) => t -> EnsureCN t+    errX s = noValueNumErrorCertainECN (Just s) $ OutOfRange $ "modulus input not finite: " ++ show x++ {- approximate comparison -} -infix 4 =~=+-- infix 4 =~= -(=~=) :: MPFloat -> MPFloat -> Property-l =~= r =-  approxEqualWithArgs [] l r+-- (=~=) :: MPFloat -> MPFloat -> Property+-- l =~= r =+--   approxEqualWithArgs 1 [(l, "L"),(r, "R")] l r  {-|   Assert equality of two MPFloat's with tolerance @1/2^p@.@@ -101,33 +149,51 @@  {-|   Assert equality of two MPFloat's with tolerance derived from the size and precision-  of the given intermediate values.+  of the given list of input and intermediate values.+  The result is expected to have at least as many significant digits+  as the (highest) nominal precision of the input and intermediate numbers+  minus the given precision loss parameter.+   When the assertion fails, report the given values using the given names. -} approxEqualWithArgs ::+  Integer {-^ bits of extra precision loss allowed -} ->   [(MPFloat, String)] {-^ intermediate values from which to determine tolerance, their names to report when the equality fails -} ->   MPFloat {-^ LHS of equation-} ->   MPFloat {-^ RHS of equation -}->   Property-approxEqualWithArgs argsPre l r =+approxEqualWithArgs precLoss args l r =   counterexample description $ approxEqual e l r   where+  description =+    printf "args:\n%s tolerance: <= 2^(%d)" argsS (-e)+  argsS =+    unlines+      [printf "    %s = %s (p=%s)" argS (show arg) (show $ getPrecision arg) +      | (arg, argS) <- args ++ [(l, "L"), (r, "R"), (abs(r-.l), "|R-L|")]+      ]++  e = p - resNorm - precLoss+  resNorm =+    case (getNormLog l, getNormLog r) of+     (NormBits nl, NormBits nr) -> nl `max` nr; +     (NormBits nl, _) -> nl+     (_, NormBits nr) -> nr+     _ -> 0+  p = foldl max 2 $ map (integer . getPrecision . fst) args++  {-     args = argsPre ++ [(l, "L"), (r, "R"), (abs (l-.r),"|L-R|")]     e =-      (foldl min 1000000 $ catMaybes $ map getNminusP args)+      (foldl min 1000000 $ catMaybes $ map getAbsPrecBits args)       - (length argsPre)-    getNminusP (x,_) =-      case norm of+    getAbsPrecBits (x,_) =+      case getNormLog x of         NormZero -> Nothing -- ideally infinity-        NormBits b -> Just (pI-b-1)+        NormBits b -> Just (pI-b-precLoss)       where-      norm = getNormLog x       pI = integer $ getPrecision x-    description =-      printf "args:\n%s tolerance: <= %s (e=%d)" argsS (show (double (0.5^!e))) e-    argsS =-      unlines-        [printf "    %s = %s (p=%s)" argS (show arg) (show $ getPrecision arg) | (arg, argS) <- args]+  -}  {-|   A runtime representative of type @MPFloat@.@@ -136,10 +202,33 @@ tMPFloat :: T MPFloat tMPFloat = T "MPFloat" +trueForNotFinite :: +  (CanTestFinite t1, CanTestFinite t2) => +  (t1 -> t2 -> Bool) -> +  (t1 -> t2 -> Bool)+trueForNotFinite rel a b +  | isFinite a && isFinite b = rel a b+  | otherwise = True+ specMPFloat :: Spec specMPFloat =+  let+    infix 4 <=%, >=%, ==%+    (<=%), (>=%) :: +      (CanTestFinite t1, CanTestFinite t2, +       HasOrderAsymmetric t1 t2, OrderCompareType t1 t2 ~ Bool) => +      t1 -> t2 -> Bool+    (==%) :: +      (CanTestFinite t1, CanTestFinite t2, +       HasEqAsymmetric t1 t2, EqCompareType t1 t2 ~ Bool) => +      t1 -> t2 -> Bool+    (<=%) = trueForNotFinite (<=)+    (>=%) = trueForNotFinite (>=) +    (==%) = trueForNotFinite (==) +  in   describe ("MPFloat") $ do-    specCanSetPrecision tMPFloat (printArgsIfFails2 "=~=" (=~=))+    specCanSetPrecision tMPFloat +      (printArgsIfFails2 "=~=" (\xPrec x -> approxEqualWithArgs 1 [(xPrec, "xPrec")] x xPrec))     specCanRound tMPFloat     specCanNegNum tMPFloat     specCanAbs tMPFloat@@ -161,255 +250,259 @@     describe "approximate addition" $ do       it "down <= up" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          not (isNaN (x +. y))-          ==>-          x +. y <= x +^ y+          x +. y <=% x +^ y       it "up ~ down" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          x +. y =~= x +^ y+          let+            (=~~=) = approxEqualWithArgs 1 [(x,"x"), (y,"y")]+            infix 4 =~~=+          in+          x +. y =~~= x +^ y       it "absorbs 0" $ do         property $ \ (x :: MPFloat) ->-          (not $ isNaN x) ==>-            x +. (mpFloat 0) == x+          not (isNaN x) ==>+            x +. zero == x       it "approximately commutative" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          (not $ isNaN $ x +. y) ==>-          x +. y <= y +^ x+          x +. y <=% y +^ x           &&-          x +^ y >= y +. x+          x +^ y >=% y +. x       it "approximately associative" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) (z :: MPFloat) ->-          (not $ isNaN $ x +. y +. z) ==>-          (x +. y) +. z <= x +^ (y +^ z)+          (x +. y) +. z <=% x +^ (y +^ z)           &&-          (x +^ y) +^ z >= x +. (y +. z)+          (x +^ y) +^ z >=% x +. (y +. z)     describe "approximate subtraction" $ do       it "down <= up" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          not (isNaN (x -. y))-          ==>-          x -. y <= x -^ y+          x -. y <=% x -^ y       it "up ~ down" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          x -. y =~= x -^ y+          let+            (=~~=) = approxEqualWithArgs 1 [(x,"x"), (y,"y")]+            infix 4 =~~=+          in+          x -. y =~~= x -^ y       it "same as negate and add" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          (not $ isNaN $ x -. y) ==>-          x -. y <= x +^ (-y)+          x -. y <=% x +^ (-y)           &&-          x -^ y >= x +. (-y)+          x -^ y >=% x +. (-y)     describe "approximate multiplication" $ do       it "down <= up" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          not (isNaN (x *. y))-          ==>-          x *. y <= x *^ y+          x *. y <=% x *^ y       it "up ~ down" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          x *. y =~= x *^ y+          let+            (=~~=) = approxEqualWithArgs 1 [(x,"x"), (y,"y")]+            infix 4 =~~=+          in+          x *. y =~~= x *^ y       it "absorbs 1" $ do         property $ \ (x :: MPFloat) ->-          (not $ isNaN x) ==>-            x *. (mpFloat 1) == x+            x *. one ==% x       it "approximately commutative" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          not (isNaN (x *. y)) ==>-          x *. y <= y *^ x+          x *. y <=% y *^ x           &&-          x *^ y >= y *. x+          x *^ y >=% y *. x       it "approximately associative" $ do-        property $ \ (x :: MPFloat) (y :: MPFloat) (z :: MPFloat) ->-          (x >= 0 && y >= 0 && z >= 0-           && not (isInfinite x) && not (isInfinite y) && not (isInfinite z)) ==>-          (x *. y) *. z <= x *^ (y *^ z)+        property $ \ (x_ :: MPFloat) (y_ :: MPFloat) (z_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          let y = enforceRangeMP (Just 0, Nothing) y_ in+          let z = enforceRangeMP (Just 0, Nothing) z_ in+          (not (isInfinite x) && not (isInfinite y) && not (isInfinite z)) ==>+          (x *. y) *. z <=% x *^ (y *^ z)           &&-          (x *^ y) *^ z >= x *. (y *. z)+          (x *^ y) *^ z >=% x *. (y *. z)       it "approximately distributes over addition" $ do-        property $ \ (x :: MPFloat) (y :: MPFloat) (z :: MPFloat) ->-          (x >= 0 && y >= 0 && z >= 0-           && not (isInfinite x) && not (isInfinite y) && not (isInfinite z)) ==>-          x *. (y +. z) <= (x *^ y) +^ (x *^ z)+        property $ \ (x_ :: MPFloat) (y_ :: MPFloat) (z_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          let y = enforceRangeMP (Just 0, Nothing) y_ in+          let z = enforceRangeMP (Just 0, Nothing) z_ in+          (not (isInfinite x) && not (isInfinite y) && not (isInfinite z)) ==>+          x *. (y +. z) <=% (x *^ y) +^ (x *^ z)           &&-          x *^ (y +^ z) >= (x *. y) +. (x *. z)+          x *^ (y +^ z) >=% (x *. y) +. (x *. z)     describe "approximate division" $ do       it "down <= up" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->-          not (isNaN (x /. y))-          ==>-          x /. y <= x /^ y+          x /. y <=% x /^ y       it "up ~ down" $ do         property $ \ (x :: MPFloat) (y :: MPFloat) ->           let-            (=~~=) = approxEqualWithArgs [(x /. y,"x/.y")]+            (=~~=) = approxEqualWithArgs 10 [(x,"x"), (y,"y"), (x /. y,"x/.y"), (x /^ y,"x/^y")]             infix 4 =~~=           in-          not (isNaN (x /. y))+          isFinite y && y /= 0           ==>           x /. y =~~= x /^ y       it "recip(recip x) = x" $ do         property $ \ (x :: MPFloat) ->-          (x > 0 || x < 0) ==>-          one /. (one /^ x) <= x+          (not (isFinite x) || x > 0 || x < 0) ==>+          one /. (one /^ x) <=% x           &&-          one /^ (one /. x) >= x-      it "x/1 = x" $ do+          one /^ (one /. x) >=% x+      it "x/1 = x" $ do          property $ \ (x :: MPFloat) ->-          not (isNaN x) ==>-          (x /. one) == x+          (x /. one) <=% x+          &&+          (x /^ one) >=% x       it "x/x = 1" $ do         property $ \ (x :: MPFloat) ->-          (isCertainlyNonZero x && (not $ isNaN $ x /. x)) ==>-            (x /. x) <= one+          -- (isCertainlyNonZero x && (not $ isNaN $ x /. x)) ==>+            (x /. x) <=% one             &&-            (x /^ x) >= one+            (x /^ x) >=% one       it "x/y = x*(1/y)" $ do-        property $ \ (x :: MPFloat) (y :: MPFloat) ->-          (y > 0 && x >= 0 && x/.y >= 0) ==>-          (x /. y) <= x *^ (one /^ y)+        property $ \ (x_ :: MPFloat) (y_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          let y = enforceRangeMP (Just 0, Nothing) y_ in+          (x /. y) <=% x *^ (one /^ y)           &&-          (x /^ y) >= x *. (one /. y)+          (x /^ y) >=% x *. (one /. y)     describe "approximate sqrt" $ do       it "down <= up" $ do-        property $ \ (x :: MPFloat) ->-          not (isNaN (sqrtDown x))-          ==>-          sqrtDown x <= sqrtUp x+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          sqrtDown x <=% sqrtUp x       it "up ~ down" $ do-        property $ \ (x :: MPFloat) ->-          (x >= 0)-          ==>-          sqrtDown x =~= sqrtUp x+        property $ \ (x_ :: MPFloat) ->+          let +            x = enforceRangeMP (Just 0, Nothing) x_ +            (=~~=) = approxEqualWithArgs 2 [(x,"x")]+            infix 4 =~~=+          in+          sqrtDown x =~~= sqrtUp x       it "sqrt(x) >= 0" $ do-        property $ \ (x :: MPFloat) ->-          (x >= 0)-          ==>-          sqrtUp x >= 0+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          sqrtUp x >=% 0       it "sqrt(x)^2 ~ x" $ do-        property $ \ (x :: MPFloat) ->-          (x >= 0)-          ==>-          (sqrtDown x) *. (sqrtDown x) <= x+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          (sqrtDown x) *. (sqrtDown x) <=% x           &&-          (sqrtUp x) *^ (sqrtUp x) >= x+          (sqrtUp x) *^ (sqrtUp x) >=% x     describe "approximate exp" $ do       it "down <= up" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          expDown x <= expUp x+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+          expDown x <=% expUp x       it "up ~ down" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in           let-            (=~~=) = approxEqualWithArgs [(x,"x")]+            (=~~=) = approxEqualWithArgs 3 [(x,"x")]             infix 4 =~~=           in           expDown x =~~= expUp x       it "exp(-x) == 1/(exp x)" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          one /. (expUp x) <= expUp (-x)+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+          one /. (expUp x) <=% expUp (-x)           &&-          one /^ (expDown x) >= expDown (-x)+          one /^ (expDown x) >=% expDown (-x)       it "exp(x+y) = exp(x)*exp(y)" $ do-        property $ \ (x :: MPFloat) (y :: MPFloat) ->-          (abs x < 1000000 && abs y < 1000000)-          ==>-          expDown (x +. y) <= (expUp x) *^ (expUp y)+        property $ \ (x_ :: MPFloat) (y_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+          let y = enforceRangeMP (Just (-1000000), Just 1000000) y_ in+          expDown (x +. y) <=% (expUp x) *^ (expUp y)           &&-          expUp (x +^ y) >= (expDown x) *. (expDown y)+          expUp (x +^ y) >=% (expDown x) *. (expDown y)     describe "approximate log" $ do       it "down <= up" $ do-        property $ \ (x :: MPFloat) ->-          (x > 0)-          ==>-          logDown x <= logUp x-      it "up ~ down" $ do-        property $ \ (x :: MPFloat) ->-          (x > 0)-          ==>-          logDown x =~= logUp x+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          logDown x <=% logUp x+      -- TODO: fix accuracy of CDAR mBounds logA x for x near 1+      -- it "up ~ down" $ do+      --   property $ \ (x_ :: MPFloat) ->+      --     let x = enforceRangeMP (Just 0, Nothing) x_ in+      --     let+      --       (=~~=) = approxEqualWithArgs 10 [(x,"x")]+      --       infix 4 =~~=+      --     in+      --     logDown x =~~= logUp x       it "log(1/x) == -(log x)" $ do-        property $ \ (x :: MPFloat) ->-          (x > 0)-          ==>-          logDown (one /. x) <= -(logDown x)+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          logDown (one /. x) <=% -(logDown x)           &&-          logUp (one /^ x) >= -(logUp x)+          logUp (one /^ x) >=% -(logUp x)       it "log(x*y) = log(x)+log(y)" $ do-        property $ \ (x :: MPFloat) (y :: MPFloat) ->-          (x > 0 && y > 0)-          ==>-          logDown (x *. y) <= (logUp x) +^ (logUp y)+        property $ \ (x_ :: MPFloat) (y_ :: MPFloat) ->+          let x = enforceRangeMP (Just 0, Nothing) x_ in+          let y = enforceRangeMP (Just 0, Nothing) y_ in+          logDown (x *. y) <=% (logUp x) +^ (logUp y)           &&-          logUp (x *^ y) >= (logDown x) +. (logDown y)+          logUp (x *^ y) >=% (logDown x) +. (logDown y)       it "log(exp x) == x" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          logDown (expDown x) <= x+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000), Just 10000) x_ in+          logDown (expDown x) <=% x           &&-          logUp (expUp x) >= x+          logUp (expUp x) >=% x     describe "approximate sine" $ do       it "down <= up" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          sinDown x <= sinUp x-      it "up ~ down" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          let-            (=~~=) = approxEqualWithArgs [(x,"x")]-            infix 4 =~~=-          in-          sinDown x =~~= sinUp x-      it "sin(pi)=0" $ do-        property $ \ (p :: Precision) ->-          let-            (=~~=) = approxEqualWithArgs [(piDown p,"pi")]-            infix 4 =~~=-          in-          sinUp(piDown p) =~~= (fromIntegerUp p 0)+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+          sinDown x <=% sinUp x+      -- TODO: fix accuracy of CDAR mBounds sine+      -- it "up ~ down" $ do+      --   property $ \ (x_ :: MPFloat) ->+      --     let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+      --     let+      --       (=~~=) = approxEqualWithArgs 1 [(x,"x")]+      --       infix 4 =~~=+      --     in+      --     sinDown x =~~= sinUp x+      -- it "sin(pi/2) ~ 1" $ do+      --   property $ \ (p :: Precision) ->+      --     let+      --       piA = ceduCentre $ piCEDU p+      --       (=~~=) = approxEqualWithArgs 1 [(piA,"pi")]+      --       infix 4 =~~=+      --     in+      --     sinUp(piA/.(setPrecision (p+10) $ mpFloat 2)) =~~= one       it "in [-1,1]" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          sinDown x <= one+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+          sinDown x <=% 1           &&-          sinUp x >= -one+          sinUp x >=% -1     describe "approximate cosine" $ do       it "down <= up" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          cosDown x <= cosUp x-      it "up ~ down" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          let-            (=~~=) = approxEqualWithArgs [(x,"x")]-            infix 4 =~~=-          in-          cosDown x =~~= cosUp x+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+          cosDown x <=% cosUp x+      -- TODO: fix accuracy of CDAR mBounds cosine+      -- it "up ~ down" $ do+      --   property $ \ (x_ :: MPFloat) ->+      --     let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+      --     let+      --       (=~~=) = approxEqualWithArgs 1 [(x,"x")]+      --       infix 4 =~~=+      --     in+      --     cosDown x =~~= cosUp x       it "in [-1,1]" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>-          cosDown x <= one+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in+          cosDown x <=% 1           &&-          cosUp x >= -one+          cosUp x >=% -1       it "cos(pi)=-1" $ do         property $ \ (p :: Precision) ->-          cosUp(piDown p) =~= (fromIntegerUp p (-1))+          let+            piA = ceduCentre $ piCEDU p+            (=~~=) = approxEqualWithArgs 1 [(piA,"pi")]+            infix 4 =~~=+          in+          cosUp(piA) =~~= (-one)       it "cos(x)^2 + sin(x)^2 = 1" $ do-        property $ \ (x :: MPFloat) ->-          (abs x < 1000000)-          ==>+        property $ \ (x_ :: MPFloat) ->+          let x = enforceRangeMP (Just (-1000000), Just 1000000) x_ in           let             cosxU = cosUp x             cosxD = cosDown x@@ -426,6 +519,7 @@               | sinxU < 0 = sinxU *. sinxU               | otherwise = mpFloat 0           in-          (cosx2D +. sinx2D) <= one+          (isFinite x ) ==>+          (cosx2D +. sinx2D) <=% 1           &&-          (cosx2U +^ sinx2U) >= one+          (cosx2U +^ sinx2U) >=% 1

− src/AERN2/MP/Float/UseRounded/Arithmetic.hs

@@ -1,151 +0,0 @@-{-|-    Module      :  AERN2.MP.Float.UseRounded.Arithmetic-    Description :  Arbitrary precision floating point numbers-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mikkonecny@gmail.com-    Stability   :  experimental-    Portability :  portable--    Arbitrary precision floating-point numbers with up/down-rounded operations.--    Currently, we use hmpfr when compiling with ghc 7.10 and higher-    and haskell-mpfr when compiling with ghc 7.8.--}--module AERN2.MP.Float.UseRounded.Arithmetic-  (-   -- * MPFloat basic arithmetic-     addUp, addDown, subUp, subDown-   , mulUp, mulDown, divUp, divDown, recipUp, recipDown-   -- * MPFloat selected constants and operations-   , piUp, piDown-   , cosUp, cosDown, sinUp, sinDown-   , sqrtUp, sqrtDown, expUp, expDown, logUp, logDown-   )-where--import MixedTypesNumPrelude-import qualified Prelude as P--import AERN2.MP.Precision--import qualified AERN2.MP.Float.UseRounded.RoundedAdaptor as MPLow-import AERN2.MP.Float.UseRounded.Type--one :: MPFloat-one = MPLow.one--{- common functions -}--instance CanNeg MPFloat where-  negate = unaryUp MPLow.neg--instance CanAbs MPFloat where-  abs x-    | x P.< MPLow.zero = negate x-    | otherwise = x--addUp, addDown :: MPFloat -> MPFloat -> MPFloat-addUp = binaryUp True MPLow.add-addDown = binaryDown True MPLow.add--subUp, subDown :: MPFloat -> MPFloat -> MPFloat-subUp = binaryUp True MPLow.sub-subDown = binaryDown True MPLow.sub--mulUp, mulDown :: MPFloat -> MPFloat -> MPFloat-mulUp = binaryUp True MPLow.mul-mulDown = binaryDown True MPLow.mul--divUp,divDown :: MPFloat -> MPFloat -> MPFloat-divUp = binaryUp False MPLow.div-divDown = binaryDown False MPLow.div--recipUp :: MPFloat -> MPFloat-recipUp x = divUp one x--recipDown :: MPFloat -> MPFloat-recipDown x = divDown one x---{- special constants and functions -}--piUp :: Precision -> MPFloat-piUp p =-    MPLow.pi MPLow.Up (p2mpfrPrec p)--piDown :: Precision -> MPFloat-piDown p =-    MPLow.pi MPLow.Down (p2mpfrPrec p)--cosUp :: MPFloat -> MPFloat-cosUp = unaryUp MPLow.cos--cosDown :: MPFloat -> MPFloat-cosDown = unaryDown MPLow.cos--sinUp :: MPFloat -> MPFloat-sinUp = unaryUp MPLow.sin--sinDown :: MPFloat -> MPFloat-sinDown = unaryDown MPLow.sin--sqrtUp :: MPFloat -> MPFloat-sqrtUp = unaryUp MPLow.sqrt--sqrtDown :: MPFloat -> MPFloat-sqrtDown = unaryDown MPLow.sqrt--expUp :: MPFloat -> MPFloat-expUp = unaryUp MPLow.exp--expDown :: MPFloat -> MPFloat-expDown = unaryDown MPLow.exp--logUp :: MPFloat -> MPFloat-logUp = unaryUp MPLow.log--logDown :: MPFloat -> MPFloat-logDown = unaryDown MPLow.log--{- auxiliary functions to automatically determine result precision from operand precisions -}--unaryUp ::-    (MPLow.RoundMode -> MPLow.Precision -> MPFloat -> MPFloat) ->-    (MPFloat -> MPFloat)-unaryUp opRP x = opRP MPLow.Up p x-    where-    p = MPLow.getPrec x--unaryDown ::-    (MPLow.RoundMode -> MPLow.Precision -> MPFloat -> MPFloat) ->-    (MPFloat -> MPFloat)-unaryDown opRP x = opRP MPLow.Down p x-    where-    p = MPLow.getPrec x--binaryUp ::-    Bool ->-    (MPLow.RoundMode -> MPLow.Precision -> MPFloat -> MPFloat -> MPFloat) ->-    (MPFloat -> MPFloat -> MPFloat)-binaryUp = binaryApprox True--binaryDown ::-    Bool ->-    (MPLow.RoundMode -> MPLow.Precision -> MPFloat -> MPFloat -> MPFloat) ->-    (MPFloat -> MPFloat -> MPFloat)-binaryDown = binaryApprox False--binaryApprox ::-    Bool -> Bool ->-    (MPLow.RoundMode -> MPLow.Precision -> MPFloat -> MPFloat -> MPFloat) ->-    (MPFloat -> MPFloat -> MPFloat)-binaryApprox isUp _canBeExact opRP x y =-    withPrec pMax-    where-    pMax = (getPrecision x) `max` (getPrecision y)-    withPrec p-        | isUp = opRP MPLow.Up (p2mpfrPrec p) x y-        | otherwise = opRP MPLow.Down (p2mpfrPrec p) x y

− src/AERN2/MP/Float/UseRounded/Conversions.hs

@@ -1,161 +0,0 @@-{-|-    Module      :  AERN2.MP.Float.UseRounded.Conversions-    Description :  Conversions and comparisons of arbitrary precision floats-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mikkonecny@gmail.com-    Stability   :  experimental-    Portability :  portable--    Conversions and comparisons of arbitrary precision floating point numbers--    Currently, we use hmpfr when compiling with ghc 7.10 and higher-    and haskell-mpfr when compiling with ghc 7.8.--}--module AERN2.MP.Float.UseRounded.Conversions-  (-   -- * MPFloat to other types (see also instances)-   toDoubleUp, toDoubleDown-   -- * MPFloat constructors (see also instances)-   , CanBeMPFloat, mpFloat-   , fromIntegerUp, fromIntegerDown-   , fromRationalUp, fromRationalDown-   )-where--import MixedTypesNumPrelude-import qualified Prelude as P--import Data.Ratio-import Data.Convertible--import AERN2.Norm-import AERN2.MP.Precision--import AERN2.MP.Float.UseRounded.Type-import AERN2.MP.Float.UseRounded.Arithmetic--import qualified AERN2.MP.Float.UseRounded.RoundedAdaptor as MPLow--mpToDouble :: MPLow.RoundMode -> MPFloat -> Double-mpToDouble = MPLow.toDoubleA--mpToRational :: MPFloat -> Rational-mpToRational x-  | x == 0 = 0.0-  | otherwise = MPLow.toRationalA x--mpFromRationalA :: MPLow.RoundMode -> MPLow.Precision -> Rational -> MPFloat-mpFromRationalA = MPLow.fromRationalA--instance HasNorm MPFloat where-  getNormLog x-    | x == 0 = NormZero-    | otherwise = NormBits (P.toInteger $ MPLow.getExp x)--{- conversions -}--instance CanRound MPFloat where-  properFraction x = (n,f)-    where-      r = rational x-      n = (numerator r) `quot` (denominator r)-      f = x `subUp` (mpFloat n)--instance ConvertibleExactly MPFloat Rational where-  safeConvertExactly = Right . mpToRational--toDoubleUp :: MPFloat -> Double-toDoubleUp = mpToDouble MPLow.Up--toDoubleDown :: MPFloat -> Double-toDoubleDown = mpToDouble MPLow.Down--fromIntegerUp :: Precision -> Integer -> MPFloat-fromIntegerUp p i = MPLow.fromIntegerA MPLow.Up (p2mpfrPrec p) i--fromIntegerDown :: Precision -> Integer -> MPFloat-fromIntegerDown p i = MPLow.fromIntegerA MPLow.Down (p2mpfrPrec p) i--type CanBeMPFloat t = ConvertibleExactly t MPFloat-mpFloat :: (CanBeMPFloat t) => t -> MPFloat-mpFloat = convertExactly--instance ConvertibleExactly Integer MPFloat where-    safeConvertExactly n =-        findExact $ map upDown $ standardPrecisions initPrec-        where-        initPrec =-            case getNormLog n of-              NormBits b -> prec (b + 8)-              _ -> prec 8-        upDown p = (fromIntegerDown p n, fromIntegerUp p n)-        findExact [] =-            convError "integer too high to represent exactly" n-        findExact ((nDown, nUp) : rest)-            | nDown == nUp = Right nUp-            | otherwise = findExact rest--instance ConvertibleExactly Int MPFloat where-    safeConvertExactly = safeConvertExactly . integer--fromRationalUp :: Precision -> Rational -> MPFloat-fromRationalUp p x =-    mpFromRationalA MPLow.Up (p2mpfrPrec p) x--fromRationalDown :: Precision -> Rational -> MPFloat-fromRationalDown p x =-    mpFromRationalA MPLow.Down (p2mpfrPrec p) x--instance Convertible MPFloat Double where-  safeConvert x-    | isFinite dbl = Right dbl-    | otherwise = convError "conversion to double: out of bounds" x-    where-    dbl = toDoubleUp x--{- comparisons -}--instance HasEqAsymmetric MPFloat MPFloat-instance HasEqAsymmetric MPFloat Integer where-  equalTo = convertSecond equalTo-instance HasEqAsymmetric Integer MPFloat where-  equalTo = convertFirst equalTo-instance HasEqAsymmetric MPFloat Int where-  equalTo = convertSecond equalTo-instance HasEqAsymmetric Int MPFloat where-  equalTo = convertFirst equalTo-instance HasEqAsymmetric MPFloat Rational where-  equalTo = convertFirst equalTo-instance HasEqAsymmetric Rational MPFloat where-  equalTo = convertSecond equalTo--instance CanTestZero MPFloat--instance HasOrderAsymmetric MPFloat MPFloat-instance HasOrderAsymmetric MPFloat Integer where-  lessThan = convertSecond lessThan-  leq = convertSecond leq-instance HasOrderAsymmetric Integer MPFloat where-  lessThan = convertFirst lessThan-  leq = convertFirst leq-instance HasOrderAsymmetric MPFloat Int where-  lessThan = convertSecond lessThan-  leq = convertSecond leq-instance HasOrderAsymmetric Int MPFloat where-  lessThan = convertFirst lessThan-  leq = convertFirst leq-instance HasOrderAsymmetric Rational MPFloat where-  lessThan = convertSecond lessThan-  leq = convertSecond leq-instance HasOrderAsymmetric MPFloat Rational where-  lessThan = convertFirst lessThan-  leq = convertFirst leq--instance CanTestPosNeg MPFloat--{- min, max -}--instance CanMinMaxAsymmetric MPFloat MPFloat

− src/AERN2/MP/Float/UseRounded/RoundedAdaptor.hs

@@ -1,84 +0,0 @@-{-# LANGUAGE DataKinds, ExistentialQuantification, RankNTypes #-}--- {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, StandaloneDeriving #-}-{-|-    Module      :  AERN2.MP.Float.UseRounded.RoundedAdaptor-    Description :  Numeric.Rounded + variable precision-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mikkonecny@gmail.com-    Stability   :  experimental-    Portability :  portable--    Numeric.Rounded + variable precision--}-module AERN2.MP.Float.UseRounded.RoundedAdaptor-(-  module AERN2.MP.Float.UseRounded.RoundedAdaptor-, module Numeric.Rounded.Simple-)-where--import Prelude hiding (div, pi)--- import qualified Prelude as P--import Numeric.Rounded.Simple--- import qualified Numeric.RoundedSimple as R--instance Show Rounded where-  show = show'--getPrec :: Rounded -> Int-getPrec = precision--getExp :: Rounded -> Int-getExp = exponent'--data RoundMode = Up | Down--withRoundMode :: (RoundingMode -> t) -> (RoundMode -> t)-withRoundMode op Up = op TowardInf-withRoundMode op Down = op TowardNegInf-{-# INLINE withRoundMode #-}--set :: RoundMode -> Precision -> Rounded -> Rounded-set = withRoundMode precRound--defaultPrecision :: Precision-defaultPrecision = 10--pi :: RoundMode -> Precision -> Rounded-pi = withRoundMode kPi--fromIntegerA :: RoundMode -> Precision -> Integer -> Rounded-fromIntegerA = withRoundMode fromInteger'--zero, one :: Rounded-zero = fromIntegerA Up defaultPrecision 0-one = fromIntegerA Up defaultPrecision 1--toDoubleA :: RoundMode -> Rounded -> Double-toDoubleA = withRoundMode toDouble--fromRationalA :: RoundMode -> Precision -> Rational -> Rounded-fromRationalA = withRoundMode fromRational'--toRationalA :: Rounded -> Rational-toRationalA = toRational' TowardNearest--add, sub, mul, div, atan2 :: RoundMode -> Precision -> Rounded -> Rounded -> Rounded-add = withRoundMode add_-sub = withRoundMode sub_-mul = withRoundMode mul_-div = withRoundMode div_-atan2 = withRoundMode atan2_--neg, abs, sqrt, exp, log, sin, cos :: RoundMode -> Precision -> Rounded -> Rounded-neg = withRoundMode negate_-abs = withRoundMode abs_-sqrt = withRoundMode sqrt_-exp = withRoundMode exp_-log = withRoundMode log_-sin = withRoundMode sin_-cos = withRoundMode cos_--- TODO: add more ops

− src/AERN2/MP/Float/UseRounded/Type.hs

@@ -1,49 +0,0 @@-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, StandaloneDeriving #-}-{-|-    Module      :  AERN2.MP.Float.UseRounded.Type-    Description :  Arbitrary precision floating point numbers (MPFR)-    Copyright   :  (c) Michal Konecny-    License     :  BSD3--    Maintainer  :  mikkonecny@gmail.com-    Stability   :  experimental-    Portability :  portable--    Arbitrary precision floating-point numbers using MPFR via package rounded.--}--module AERN2.MP.Float.UseRounded.Type-  (-   -- * MPFloat numbers and their basic operations-   MPFloat, setPrecisionUp, setPrecisionDown-   , p2mpfrPrec-   )-where--import MixedTypesNumPrelude-import qualified Prelude as P--import AERN2.MP.Precision--import qualified AERN2.MP.Float.UseRounded.RoundedAdaptor as MPLow-import Data.Typeable--{-| Multiple-precision floating-point type based on MPFR via rounded. -}-type MPFloat = MPLow.Rounded--deriving instance (Typeable MPFloat)--p2mpfrPrec :: Precision -> MPLow.Precision-p2mpfrPrec = P.fromInteger . integer--instance HasPrecision MPFloat where-  getPrecision x = prec (P.toInteger $ MPLow.getPrec x)--instance CanSetPrecision MPFloat where-  setPrecision = setPrecisionUp--setPrecisionUp :: Precision -> MPFloat -> MPFloat-setPrecisionUp p = MPLow.set MPLow.Up (p2mpfrPrec p)--setPrecisionDown :: Precision -> MPFloat -> MPFloat-setPrecisionDown p = MPLow.set MPLow.Down (p2mpfrPrec p)

src/AERN2/MP/Precision.hs view

@@ -141,13 +141,14 @@   | otherwise = x  specCanSetPrecision ::-  (CanSetPrecision t, Arbitrary t, Show t, Testable prop)+  (CanSetPrecision t, CanTestFinite t, Arbitrary t, Show t, Testable prop)   =>   (T t) -> (t -> t -> prop) -> Spec specCanSetPrecision (T typeName :: T t) check =   describe (printf "CanSetPrecision %s" typeName) $ do     it "set then get" $ do       property $ \ (x :: t) (p :: Precision) ->+        isFinite x ==>         let xP = setPrecision p x in           p == getPrecision xP     it "setPrecision x ~ x" $ do@@ -215,7 +216,7 @@  instance Arbitrary Precision where   arbitrary =-    sized $ \size -> choose (4,10+size) >>= return . prec+    sized $ \size -> choose (4*(size+1),10*(size+1)) >>= return . prec  $(declForTypes   [[t| Bool |], [t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]

src/AERN2/Norm.hs view

@@ -65,3 +65,20 @@   where   getNormLog (a :+ i) =     (getNormLog a) `max` (getNormLog i)++instance CanAddAsymmetric NormLog Integer where+    type AddType NormLog Integer = NormLog+    add NormZero _ = NormZero+    add (NormBits b) n = NormBits (b+n)++instance CanAddAsymmetric Integer NormLog where+    type AddType Integer NormLog = NormLog+    add _ NormZero = NormZero+    add n (NormBits b) = NormBits (b+n)++instance CanSub NormLog Integer where+    type SubType NormLog Integer = NormLog+    sub NormZero _ = NormZero+    sub (NormBits b) n = NormBits (b-n)+    +