aern2-mp 0.2.4.0 → 0.2.5.0

raw patch · 10 files changed

+834/−169 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• aern2-mp.cabal +9/−2
• changelog.md +3/−0
• src/AERN2/MP/WithCurrentPrec.hs +10/−167
• src/AERN2/MP/WithCurrentPrec/Comparisons.hs +199/−0
• src/AERN2/MP/WithCurrentPrec/Elementary.hs +120/−0
• src/AERN2/MP/WithCurrentPrec/Field.hs +201/−0
• src/AERN2/MP/WithCurrentPrec/Limit.hs +51/−0
• src/AERN2/MP/WithCurrentPrec/PreludeInstances.hs +97/−0
• src/AERN2/MP/WithCurrentPrec/Type.hs +96/−0
• src/AERN2/Select.hs +48/−0

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 59805057da90f7bf5d2552756df7e049bc228e506b006e1fb8357f26c3efb204+-- hash: f380106cebd760457afe30f95f96a4613a687aa0d3f908c17172376defe10224  name:           aern2-mp-version:        0.2.4.0+version:        0.2.5.0 synopsis:       Multi-precision ball (interval) arithmetic description:    Please see the README on GitHub at <https://github.com/michalkonecny/aern2/#readme> category:       Math@@ -54,8 +54,15 @@       AERN2.MP.Float.Type       AERN2.MP.Precision       AERN2.MP.WithCurrentPrec+      AERN2.MP.WithCurrentPrec.Comparisons+      AERN2.MP.WithCurrentPrec.Elementary+      AERN2.MP.WithCurrentPrec.Field+      AERN2.MP.WithCurrentPrec.Limit+      AERN2.MP.WithCurrentPrec.PreludeInstances+      AERN2.MP.WithCurrentPrec.Type       AERN2.Norm       AERN2.Normalize+      AERN2.Select       AERN2.Utils.Bench   other-modules:       Paths_aern2_mp

@@ -1,5 +1,8 @@ # Change log for aern2-mp +* v 0.2.5 2021-05-27+  * add generic multivalued select + Kleenean instances+  * WithCurrentPrec: add MixedTypesNumPrelude class instances * v 0.2.4 2021-05-26   * use endpoint multiplication in integer power to avoid crossing 0 * v 0.2.3 2021-05-22

@@ -16,182 +16,25 @@      Type wrapper setting default precision. -    Not suitable for use with MixedTypesNumPrelude since we need binary operators to enforce-    the same precision on both operands via the equality of their types.-     Borrowed some tricks from https://github.com/ekmett/rounded/blob/master/src/Numeric/Rounded/Precision.hs -} module AERN2.MP.WithCurrentPrec (     WithCurrentPrec(..), runWithPrec, HasCurrentPrecision(..)     , WithAnyPrec(..)+    , mpBallCP+    , piCP     -- , _example1 , _example2 , _example3+    -- , _example1P , _example2P , _example3P ) where -import qualified MixedTypesNumPrelude as MxP-import Prelude+-- import MixedTypesNumPrelude+-- import qualified Prelude as P -- import Text.Printf --- import Text.Printf-import Numeric.CollectErrors (CN, cn, NumErrors, CanTakeErrors(..))--- import qualified Numeric.CollectErrors as CN--import Data.Proxy-import Data.Reflection-import GHC.TypeLits---- import Data.Complex--import AERN2.Limit-import AERN2.MP.Precision-import AERN2.MP.Ball--class HasCurrentPrecision p where-    getCurrentPrecision :: proxy p -> Precision--instance KnownNat n => HasCurrentPrecision n where-    getCurrentPrecision p = max (prec 2) . min maximumPrecision $ prec (natVal p)--{-|--An existential type wrapper for convenient conversions, eg using aern2-real:--> _x :: KnownNat p => WithCurrentPrec (CN MPBall) p-> _x = undefined->-> _r_x :: CReal-> _r_x = creal $ WithAnyPrec _x---}--newtype WithAnyPrec t = WithAnyPrec (forall p. (KnownNat p) => WithCurrentPrec t p)----- data PrecAdd10 (p :: *)---- instance (HasCurrentPrecision p) => HasCurrentPrecision (PrecAdd10 p) where---     isPrecision (_ :: proxy _) = 10 + isPrecision (undefined :: proxy p)--newtype WithCurrentPrec t p = WithCurrentPrec { unWithCurrentPrec :: t }-    deriving (Show)--deriving instance (CanTakeErrors NumErrors t) => (CanTakeErrors NumErrors (WithCurrentPrec t p))--runWithPrec :: Precision -> (forall n. (KnownNat n) => WithCurrentPrec t n) -> t-runWithPrec p (wfp :: (forall n. (KnownNat n) => WithCurrentPrec t n)) = -    reifyNat (MxP.integer p) withNat-    where-    withNat :: KnownNat n => Proxy n -> t-    withNat (_ :: Proxy n) = -        unWithCurrentPrec (wfp :: WithCurrentPrec t n)---- -- The following does not work:--- instance (CanAddAsymmetric t1 t2) => (CanAddAsymmetric (WithCurrentPrec t1 p) (WithCurrentPrec t2 p)) where---     type AddType (WithCurrentPrec t1 p) (WithCurrentPrec t2 p) = WithCurrentPrec (AddType t1 t2) p---     add (WithCurrentPrec a1) (WithCurrentPrec a2) = WithCurrentPrec $ a1 + a2--instance -    (MxP.HasOrderAsymmetric t1 t2)-    =>-    MxP.HasOrderAsymmetric (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) -    where-    type OrderCompareType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = MxP.OrderCompareType t1 t2-    greaterThan (WithCurrentPrec v1) (WithCurrentPrec v2) = MxP.greaterThan v1 v2-    lessThan (WithCurrentPrec v1) (WithCurrentPrec v2) = MxP.lessThan v1 v2-    geq (WithCurrentPrec v1) (WithCurrentPrec v2) = MxP.geq v1 v2-    leq (WithCurrentPrec v1) (WithCurrentPrec v2) = MxP.leq v1 v2--instance -    (MxP.CanMinMaxAsymmetric t1 t2, p1 ~ p2)-    =>-    MxP.CanMinMaxAsymmetric (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) -    where-    type MinMaxType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = WithCurrentPrec (MxP.MinMaxType t1 t2) p1-    min (WithCurrentPrec v1) (WithCurrentPrec v2) = WithCurrentPrec $ MxP.min v1 v2-    max (WithCurrentPrec v1) (WithCurrentPrec v2) = WithCurrentPrec $ MxP.max v1 v2--instance Eq t => Eq (WithCurrentPrec t p) where-    (==) = lift2P (==)-instance Ord t => Ord (WithCurrentPrec t p) where-    compare = lift2P compare--instance -    (HasCurrentPrecision p, Num t, ConvertibleWithPrecision Integer t) -    => -    Num (WithCurrentPrec t p) -    where-    fromInteger n = r-        where   -        r = WithCurrentPrec $ convertP (getCurrentPrecision r) n-    negate = lift1 negate-    abs = lift1 abs-    (+) = lift2 (+)-    (*) = lift2 (*)-    signum = lift1 signum--instance -    (HasCurrentPrecision p, Fractional t-    , ConvertibleWithPrecision Integer t, ConvertibleWithPrecision Rational t) -    => -    Fractional (WithCurrentPrec t p) -    where-    fromRational q = r-        where   -        r = WithCurrentPrec $ convertP (getCurrentPrecision r) q-    recip = lift1 recip-    (/) = lift2 (/)--instance (HasCurrentPrecision p) => Floating (WithCurrentPrec (CN MPBall) p) where-    pi = r -        where-        r = WithCurrentPrec $ cn $ piBallP (getCurrentPrecision r)-    sqrt = lift1 sqrt-    exp = lift1 exp-    log = lift1 log-    sin = lift1 sin-    cos = lift1 cos-    asin = lift1 asin-    acos = lift1 acos-    atan = lift1 atan-    sinh = lift1 sinh-    cosh = lift1 cosh-    asinh = lift1 asinh-    acosh = lift1 acosh-    atanh = lift1 atanh--instance -    (HasLimits ix (CN MPBall -> CN MPBall)-    , LimitType ix (CN MPBall -> CN MPBall) ~ (CN MPBall -> CN MPBall)-    ,HasCurrentPrecision p)-    => -    HasLimits ix (WithCurrentPrec (CN MPBall) p) -    where-    type LimitType ix (WithCurrentPrec (CN MPBall) p) = WithCurrentPrec (CN MPBall) p-    limit (s :: ix -> (WithCurrentPrec (CN MPBall) p)) = -        WithCurrentPrec $ limit (snop) $ sample-        where-        sample :: CN MPBall-        sample = setPrecision (getCurrentPrecision sampleP) 0 -        sampleP :: WithCurrentPrec MPBall p-        sampleP = error "sampleP is not defined, it is only a type proxy"-        snop :: ix -> (CN MPBall -> CN MPBall)-        snop ix _sample = unWithCurrentPrec $ s ix--lift1 :: (t1 -> t2) -> (WithCurrentPrec t1 p) -> (WithCurrentPrec t2 p)-lift1 f (WithCurrentPrec v1) = WithCurrentPrec (f v1)--lift2 :: (t1 -> t2 -> t3) -> (WithCurrentPrec t1 p) -> (WithCurrentPrec t2 p) -> (WithCurrentPrec t3 p)-lift2 f (WithCurrentPrec v1) (WithCurrentPrec v2) = WithCurrentPrec (f v1 v2)--lift2P :: (t1 -> t2 -> t3) -> (WithCurrentPrec t1 p) -> (WithCurrentPrec t2 p) -> t3-lift2P f (WithCurrentPrec v1) (WithCurrentPrec v2) = f v1 v2--_example1 :: CN MPBall-_example1 = runWithPrec (prec 1000) pi--_example2 :: CN MPBall-_example2 = runWithPrec (prec 1000) $ pi - pi--_example3 :: CN MPBall-_example3 = runWithPrec (prec 1000) $ sqrt 2+import AERN2.MP.WithCurrentPrec.Type+import AERN2.MP.WithCurrentPrec.Comparisons ()+import AERN2.MP.WithCurrentPrec.Field ()+import AERN2.MP.WithCurrentPrec.Elementary (piCP)+import AERN2.MP.WithCurrentPrec.PreludeInstances ()

@@ -0,0 +1,199 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.WithCurrentPrec.Comparisons+    Description :  WithCurrentPrec order relations and operations+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    WithCurrentPrec order relations and operations+-}+module AERN2.MP.WithCurrentPrec.Comparisons+()+where++import MixedTypesNumPrelude+-- import qualified Prelude as P+-- import Text.Printf++-- import qualified Numeric.CollectErrors as CN++import AERN2.MP.Dyadic++import AERN2.MP.WithCurrentPrec.Type++instance+    (HasEqAsymmetric t1 t2, p1 ~ p2)+    =>+    HasEqAsymmetric (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) +    where+    type EqCompareType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = EqCompareType t1 t2+    equalTo = lift2P equalTo+    notEqualTo = lift2P notEqualTo++instance+    (HasOrderAsymmetric t1 t2, p1 ~ p2)+    =>+    HasOrderAsymmetric (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) +    where+    type OrderCompareType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = OrderCompareType t1 t2+    greaterThan = lift2P greaterThan+    lessThan = lift2P lessThan+    geq = lift2P geq+    leq = lift2P leq++instance+    (CanAbs t)+    =>+    CanAbs (WithCurrentPrec t p)+    where+    type AbsType (WithCurrentPrec t p) = WithCurrentPrec (AbsType t) p+    abs = lift1 abs++instance+    (CanMinMaxAsymmetric t1 t2, p1 ~ p2)+    =>+    CanMinMaxAsymmetric (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) +    where+    type MinMaxType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = WithCurrentPrec (MinMaxType t1 t2) p1+    min = lift2 min+    max = lift2 max++-- mixed type instances:++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |], [t| Dyadic |]]+  (\ t -> [d|++    -- min, max++    instance+      (CanMinMaxAsymmetric a $t)+      => +      CanMinMaxAsymmetric (WithCurrentPrec a p) $t+      where+      type MinMaxType (WithCurrentPrec a p) $t = WithCurrentPrec (MinMaxType a $t) p+      min = lift1T min+      max = lift1T max++    instance+      (CanMinMaxAsymmetric a (CN $t))+      => +      CanMinMaxAsymmetric (WithCurrentPrec a p) (CN $t)+      where+      type MinMaxType (WithCurrentPrec a p) (CN $t) = WithCurrentPrec (MinMaxType a (CN $t)) p+      min = lift1T min+      max = lift1T max++    instance+      (CanMinMaxAsymmetric $t a)+      => +      CanMinMaxAsymmetric $t (WithCurrentPrec a p)+      where+      type MinMaxType $t (WithCurrentPrec a p) = WithCurrentPrec (MinMaxType $t a) p+      min = liftT1 min+      max = liftT1 max++    instance+      (CanMinMaxAsymmetric (CN $t) a)+      => +      CanMinMaxAsymmetric (CN $t) (WithCurrentPrec a p)+      where+      type MinMaxType (CN $t) (WithCurrentPrec a p) = WithCurrentPrec (MinMaxType (CN $t) a) p+      min = liftT1 min+      max = liftT1 max++    -- equality++    instance+      (HasEqAsymmetric a $t)+      => +      HasEqAsymmetric (WithCurrentPrec a p) $t+      where+      type EqCompareType (WithCurrentPrec a p) $t = EqCompareType a $t+      equalTo = lift1TP (==)+      notEqualTo = lift1TP (/=)++    instance+      (HasEqAsymmetric a (CN $t))+      => +      HasEqAsymmetric (WithCurrentPrec a p) (CN $t)+      where+      type EqCompareType (WithCurrentPrec a p) (CN $t) = EqCompareType a (CN $t)+      equalTo = lift1TP (==)+      notEqualTo = lift1TP (/=)++    instance+      (HasEqAsymmetric $t a)+      =>+      HasEqAsymmetric $t (WithCurrentPrec a p)+      where+      type EqCompareType $t (WithCurrentPrec a p) = EqCompareType $t a+      equalTo = liftT1P (==)+      notEqualTo = liftT1P (/=)++    instance+      (HasEqAsymmetric (CN $t) a)+      =>+      HasEqAsymmetric (CN $t) (WithCurrentPrec a p)+      where+      type EqCompareType (CN $t) (WithCurrentPrec a p) = EqCompareType (CN $t) a+      equalTo = liftT1P (==)+      notEqualTo = liftT1P (/=)++    -- order++    instance+      (HasOrderAsymmetric a $t)+      => +      HasOrderAsymmetric (WithCurrentPrec a p) $t+      where+      type OrderCompareType (WithCurrentPrec a p) $t = OrderCompareType a $t+      lessThan = lift1TP lessThan+      greaterThan = lift1TP greaterThan+      leq = lift1TP leq+      geq = lift1TP geq++    instance+      (HasOrderAsymmetric a (CN $t))+      => +      HasOrderAsymmetric (WithCurrentPrec a p) (CN $t)+      where+      type OrderCompareType (WithCurrentPrec a p) (CN $t) = OrderCompareType a (CN $t)+      lessThan = lift1TP lessThan+      greaterThan = lift1TP greaterThan+      leq = lift1TP leq+      geq = lift1TP geq++    instance+      (HasOrderAsymmetric $t a)+      =>+      HasOrderAsymmetric $t (WithCurrentPrec a p)+      where+      type OrderCompareType $t (WithCurrentPrec a p) = OrderCompareType $t a+      lessThan = liftT1P lessThan+      greaterThan = liftT1P greaterThan+      leq = liftT1P leq+      geq = liftT1P geq++    instance+      (HasOrderAsymmetric (CN $t) a)+      =>+      HasOrderAsymmetric (CN $t) (WithCurrentPrec a p)+      where+      type OrderCompareType (CN $t) (WithCurrentPrec a p) = OrderCompareType (CN $t) a+      lessThan = liftT1P lessThan+      greaterThan = liftT1P greaterThan+      leq = liftT1P leq+      geq = liftT1P geq++  |]))

@@ -0,0 +1,120 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.WithCurrentPrec.Elementary+    Description :  WithCurrentPrec elementary operations+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    WithCurrentPrec elementary operations+-}+module AERN2.MP.WithCurrentPrec.Elementary+(   +    piCP+    , _example1 , _example2 , _example3+)+where++import MixedTypesNumPrelude+-- import qualified Prelude as P+-- import Text.Printf++import GHC.TypeLits ( KnownNat )++-- import qualified Numeric.CollectErrors as CN++import AERN2.MP.Ball++import AERN2.MP.WithCurrentPrec.Type++import AERN2.MP.WithCurrentPrec.Field ()++piCP :: (KnownNat p) => WithCurrentPrec (CN MPBall) p+piCP = r +    where+    r = WithCurrentPrec $ cn $ piBallP (getCurrentPrecision r)++instance+    (CanSinCos t)+    =>+    CanSinCos (WithCurrentPrec t p)+    where+    type SinCosType (WithCurrentPrec t p) = WithCurrentPrec (SinCosType t) p+    sin = lift1 sin+    cos = lift1 cos++instance+    (CanSqrt t)+    =>+    CanSqrt (WithCurrentPrec t p)+    where+    type SqrtType (WithCurrentPrec t p) = WithCurrentPrec (SqrtType t) p+    sqrt = lift1 sqrt++instance+    (CanExp t)+    =>+    CanExp (WithCurrentPrec t p)+    where+    type ExpType (WithCurrentPrec t p) = WithCurrentPrec (ExpType t) p+    exp = lift1 exp++instance+    (CanLog t)+    =>+    CanLog (WithCurrentPrec t p)+    where+    type LogType (WithCurrentPrec t p) = WithCurrentPrec (LogType t) p+    log = lift1 log++instance+    (CanPow t1 t2, p1~p2)+    =>+    (CanPow (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2)) where+    type PowType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = WithCurrentPrec (PowType t1 t2) p1+    pow = lift2 pow++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |]]+  (\ e -> [d|++  instance +    (CanPow b $e)+    =>+    CanPow (WithCurrentPrec b p) $e +    where+    type PowType (WithCurrentPrec b p) $e = WithCurrentPrec (PowType b $e) p+    pow = lift1T pow++  |]))++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |]]+  (\ b -> [d|++  instance +    (CanPow $b e, HasOrderCertainly e Integer, CanTestInteger e)+    =>+    CanPow $b (WithCurrentPrec e p) +    where+    type PowType $b (WithCurrentPrec e p) = WithCurrentPrec (PowType $b e) p+    pow = liftT1 pow+  |]))++_example1 :: CN MPBall+_example1 = runWithPrec (prec 1000) piCP++_example2 :: CN MPBall+_example2 = runWithPrec (prec 1000) $ piCP - piCP++_example3 :: CN MPBall+_example3 = runWithPrec (prec 1000) $ sqrt (mpBallCP 2)

@@ -0,0 +1,201 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.WithCurrentPrec.Field+    Description :  WithCurrentPrec field operations+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    WithCurrentPrec field operations+-}+module AERN2.MP.WithCurrentPrec.Field+()+where++import MixedTypesNumPrelude+-- import qualified Prelude as P+-- import Text.Printf++import AERN2.MP.Dyadic++-- import qualified Numeric.CollectErrors as CN++import AERN2.MP.WithCurrentPrec.Type++instance+    (CanAddAsymmetric t1 t2, p1~p2)+    =>+    (CanAddAsymmetric (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2)) where+    type AddType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = WithCurrentPrec (AddType t1 t2) p1+    add = lift2 add++instance+    (CanSub t1 t2, p1~p2)+    =>+    (CanSub (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2)) where+    type SubType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = WithCurrentPrec (SubType t1 t2) p1+    sub = lift2 sub++instance+    (CanMulAsymmetric t1 t2, p1~p2)+    =>+    (CanMulAsymmetric (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2)) where+    type MulType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = WithCurrentPrec (MulType t1 t2) p1+    mul = lift2 mul++instance+    (CanDiv t1 t2, p1~p2)+    =>+    (CanDiv (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2)) where+    type DivType (WithCurrentPrec t1 p1) (WithCurrentPrec t2 p2) = WithCurrentPrec (DivType t1 t2) p1+    divide = lift2 divide+++---------------------------------------------------+---------------------------------------------------+-- Integer, Rational etc. mixed-type arithmetic+---------------------------------------------------+---------------------------------------------------++$(declForTypes+  [[t| Integer |], [t| Int |], [t| Rational |], [t| Dyadic |]]+  (\ t -> [d|++    instance+      (CanAddAsymmetric a $t)+      => +      CanAddAsymmetric (WithCurrentPrec a p) $t+      where+      type AddType (WithCurrentPrec a p) $t = WithCurrentPrec (AddType a $t) p+      add = lift1T add++    instance+      (CanAddAsymmetric a (CN $t))+      => +      CanAddAsymmetric (WithCurrentPrec a p) (CN $t)+      where+      type AddType (WithCurrentPrec a p) (CN $t) = WithCurrentPrec (AddType a (CN $t)) p+      add = lift1T add++    instance+      (CanAddAsymmetric $t a)+      => +      CanAddAsymmetric $t (WithCurrentPrec a p)+      where+      type AddType $t (WithCurrentPrec a p) = WithCurrentPrec (AddType $t a) p+      add = liftT1 add++    instance+      (CanAddAsymmetric (CN $t) a)+      => +      CanAddAsymmetric (CN $t) (WithCurrentPrec a p)+      where+      type AddType (CN $t) (WithCurrentPrec a p) = WithCurrentPrec (AddType (CN $t) a) p+      add = liftT1 add++    instance+      (CanSub a $t)+      => +      CanSub (WithCurrentPrec a p) $t+      where+      type SubType (WithCurrentPrec a p) $t = WithCurrentPrec (SubType a $t) p+      sub = lift1T sub++    instance+      (CanSub a (CN $t))+      => +      CanSub (WithCurrentPrec a p) (CN $t)+      where+      type SubType (WithCurrentPrec a p) (CN $t) = WithCurrentPrec (SubType a (CN $t)) p+      sub = lift1T sub++    instance+      (CanSub $t a)+      => +      CanSub $t (WithCurrentPrec a p)+      where+      type SubType $t (WithCurrentPrec a p) = WithCurrentPrec (SubType $t a) p+      sub = liftT1 sub++    instance+      (CanSub (CN $t) a)+      => +      CanSub (CN $t) (WithCurrentPrec a p)+      where+      type SubType (CN $t) (WithCurrentPrec a p) = WithCurrentPrec (SubType (CN $t) a) p+      sub = liftT1 sub++    instance+      (CanMulAsymmetric a $t)+      => +      CanMulAsymmetric (WithCurrentPrec a p) $t+      where+      type MulType (WithCurrentPrec a p) $t = WithCurrentPrec (MulType a $t) p+      mul = lift1T mul++    instance+      (CanMulAsymmetric a (CN $t))+      => +      CanMulAsymmetric (WithCurrentPrec a p) (CN $t)+      where+      type MulType (WithCurrentPrec a p) (CN $t) = WithCurrentPrec (MulType a (CN $t)) p+      mul = lift1T mul++    instance+      (CanMulAsymmetric $t a)+      => +      CanMulAsymmetric $t (WithCurrentPrec a p)+      where+      type MulType $t (WithCurrentPrec a p) = WithCurrentPrec (MulType $t a) p+      mul = liftT1 mul++    instance+      (CanMulAsymmetric (CN $t) a)+      => +      CanMulAsymmetric (CN $t) (WithCurrentPrec a p)+      where+      type MulType (CN $t) (WithCurrentPrec a p) = WithCurrentPrec (MulType (CN $t) a) p+      mul = liftT1 mul++    instance+      (CanDiv a $t)+      => +      CanDiv (WithCurrentPrec a p) $t+      where+      type DivType (WithCurrentPrec a p) $t = WithCurrentPrec (DivType a $t) p+      divide = lift1T divide++    instance+      (CanDiv a (CN $t))+      => +      CanDiv (WithCurrentPrec a p) (CN $t)+      where+      type DivType (WithCurrentPrec a p) (CN $t) = WithCurrentPrec (DivType a (CN $t)) p+      divide = lift1T divide++    instance+      (CanDiv $t a)+      => +      CanDiv $t (WithCurrentPrec a p)+      where+      type DivType $t (WithCurrentPrec a p) = WithCurrentPrec (DivType $t a) p+      divide = liftT1 divide++    instance+      (CanDiv (CN $t) a)+      => +      CanDiv (CN $t) (WithCurrentPrec a p)+      where+      type DivType (CN $t) (WithCurrentPrec a p) = WithCurrentPrec (DivType (CN $t) a) p+      divide = liftT1 divide++  |]))

@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.WithCurrentPrec.Limit+    Description :  WithCurrentPrec limits+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    WithCurrentPrec limits+-}+module AERN2.MP.WithCurrentPrec.Limit+()+where++import MixedTypesNumPrelude+-- import qualified Prelude as P+-- import Text.Printf++-- import qualified Numeric.CollectErrors as CN++import AERN2.MP.Ball++import AERN2.Limit++import AERN2.MP.WithCurrentPrec.Type++instance +    (HasLimits ix (CN MPBall -> CN MPBall)+    , LimitType ix (CN MPBall -> CN MPBall) ~ (CN MPBall -> CN MPBall)+    ,HasCurrentPrecision p)+    => +    HasLimits ix (WithCurrentPrec (CN MPBall) p) +    where+    type LimitType ix (WithCurrentPrec (CN MPBall) p) = WithCurrentPrec (CN MPBall) p+    limit (s :: ix -> (WithCurrentPrec (CN MPBall) p)) = +        WithCurrentPrec $ limit (snop) $ sample+        where+        sample :: CN MPBall+        sample = setPrecision (getCurrentPrecision sampleP) (cn $ mpBall 0)+        sampleP :: WithCurrentPrec MPBall p+        sampleP = error "sampleP is not defined, it is only a type proxy"+        snop :: ix -> (CN MPBall -> CN MPBall)+        snop ix _sample = unWithCurrentPrec $ s ix

@@ -0,0 +1,97 @@+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.WithCurrentPrec.PreludeInstances+    Description :  WithCurrentPrec instances of Prelude classes+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    WithCurrentPrec instances of Prelude classes+-}+module AERN2.MP.WithCurrentPrec.PreludeInstances+(+    _example1P , _example2P , _example3P+)+where++import Prelude+-- import Text.Printf++import Numeric.CollectErrors (cn, CN)++import AERN2.MP.Precision+import AERN2.MP.Ball++import AERN2.MP.WithCurrentPrec.Type++{-+********************************+Instances of Prelude classes+********************************+-}++instance Eq t => Eq (WithCurrentPrec t p) where+    (==) = lift2P (==)+instance Ord t => Ord (WithCurrentPrec t p) where+    compare = lift2P compare++instance +    (HasCurrentPrecision p, Num t, ConvertibleWithPrecision Integer t) +    => +    Num (WithCurrentPrec t p) +    where+    fromInteger n = r+        where   +        r = WithCurrentPrec $ convertP (getCurrentPrecision r) n+    negate = lift1 negate+    abs = lift1 abs+    (+) = lift2 (+)+    (*) = lift2 (*)+    signum = lift1 signum++instance +    (HasCurrentPrecision p, Fractional t+    , ConvertibleWithPrecision Integer t, ConvertibleWithPrecision Rational t) +    => +    Fractional (WithCurrentPrec t p) +    where+    fromRational q = r+        where   +        r = WithCurrentPrec $ convertP (getCurrentPrecision r) q+    recip = lift1 recip+    (/) = lift2 (/)++instance (HasCurrentPrecision p) => Floating (WithCurrentPrec (CN MPBall) p) where+    pi = r +        where+        r = WithCurrentPrec $ cn $ piBallP (getCurrentPrecision r)+    sqrt = lift1 sqrt+    exp = lift1 exp+    log = lift1 log+    sin = lift1 sin+    cos = lift1 cos+    asin = lift1 asin+    acos = lift1 acos+    atan = lift1 atan+    sinh = lift1 sinh+    cosh = lift1 cosh+    asinh = lift1 asinh+    acosh = lift1 acosh+    atanh = lift1 atanh++_example1P :: CN MPBall+_example1P = runWithPrec (prec 1000) pi++_example2P :: CN MPBall+_example2P = runWithPrec (prec 1000) $ pi - pi++_example3P :: CN MPBall+_example3P = runWithPrec (prec 1000) $ sqrt 2

@@ -0,0 +1,96 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-|+    Module      :  AERN2.MP.WithCurrentPrec.Type+    Description :  Type wrapper setting default precision+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Type wrapper setting default precision.++    Borrowed some tricks from https://github.com/ekmett/rounded/blob/master/src/Numeric/Rounded/Precision.hs+-}+module AERN2.MP.WithCurrentPrec.Type where++import MixedTypesNumPrelude+-- import Text.Printf++-- import Text.Printf+import Numeric.CollectErrors (NumErrors, CanTakeErrors(..))+-- import qualified Numeric.CollectErrors as CN++import Data.Proxy+import Data.Reflection+import GHC.TypeLits++import AERN2.MP++class HasCurrentPrecision p where+    getCurrentPrecision :: proxy p -> Precision++instance KnownNat n => HasCurrentPrecision n where+    getCurrentPrecision p = max (prec 2) . min maximumPrecision $ prec (natVal p)++{-|++An existential type wrapper for convenient conversions, eg using aern2-real:++> _x :: KnownNat p => WithCurrentPrec (CN MPBall) p+> _x = undefined+>+> _r_x :: CReal+> _r_x = creal $ WithAnyPrec _x++-}+newtype WithAnyPrec t = WithAnyPrec (forall p. (KnownNat p) => WithCurrentPrec t p)++-- data PrecAdd10 (p :: *)++-- instance (HasCurrentPrecision p) => HasCurrentPrecision (PrecAdd10 p) where+--     isPrecision (_ :: proxy _) = 10 + isPrecision (undefined :: proxy p)++newtype WithCurrentPrec t p = WithCurrentPrec { unWithCurrentPrec :: t }+    deriving (Show)++deriving instance (CanTakeErrors NumErrors t) => (CanTakeErrors NumErrors (WithCurrentPrec t p))++runWithPrec :: Precision -> (forall n. (KnownNat n) => WithCurrentPrec t n) -> t+runWithPrec p (wfp :: (forall n. (KnownNat n) => WithCurrentPrec t n)) = +    reifyNat (integer p) withNat+    where+    withNat :: KnownNat n => Proxy n -> t+    withNat (_ :: Proxy n) = +        unWithCurrentPrec (wfp :: WithCurrentPrec t n)++lift1 :: (t1 -> t2) -> (WithCurrentPrec t1 p) -> (WithCurrentPrec t2 p)+lift1 f (WithCurrentPrec v1) = WithCurrentPrec (f v1)++lift2 :: (p1 ~ p2) => (t1 -> t2 -> t3) -> (WithCurrentPrec t1 p1) -> (WithCurrentPrec t2 p2) -> (WithCurrentPrec t3 p1)+lift2 f (WithCurrentPrec v1) (WithCurrentPrec v2) = WithCurrentPrec (f v1 v2)++lift2P :: (p1 ~ p2) => (t1 -> t2 -> t3) -> (WithCurrentPrec t1 p1) -> (WithCurrentPrec t2 p2) -> t3+lift2P f (WithCurrentPrec v1) (WithCurrentPrec v2) = f v1 v2++lift1T :: (t1 -> t2 -> t3) -> (WithCurrentPrec t1 p1) -> t2 -> (WithCurrentPrec t3 p1)+lift1T f (WithCurrentPrec v1) v2 = WithCurrentPrec (f v1 v2)++lift1TP :: (t1 -> t2 -> t3) -> (WithCurrentPrec t1 p1) -> t2 -> t3+lift1TP f (WithCurrentPrec v1) v2 = f v1 v2++liftT1 :: (t1 -> t2 -> t3) -> t1 -> (WithCurrentPrec t2 p2) -> (WithCurrentPrec t3 p1)+liftT1 f v1 (WithCurrentPrec v2) = WithCurrentPrec (f v1 v2)++liftT1P :: (t1 -> t2 -> t3) -> t1 -> (WithCurrentPrec t2 p2) -> t3+liftT1P f v1 (WithCurrentPrec v2) = f v1 v2++mpBallCP :: (CanBeMPBallP t, KnownNat p) => t -> WithCurrentPrec (CN MPBall) p+mpBallCP v = r +    where+    r = WithCurrentPrec $ cn $ mpBallP (getCurrentPrecision r) v

@@ -0,0 +1,48 @@+{-|+    Module      :  AERN2.Select+    Description :  multivalued select operation+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Generic multivalued select operation+-}+module AERN2.Select where++import MixedTypesNumPrelude++import qualified Numeric.CollectErrors as CN++import AERN2.Kleenean++class (IsBool (SelectType k)) => CanSelect k where+  {-| Must be Bool or similar -}+  type SelectType k +  {-|+    Execute two lazy computations "in parallel" until one of them succeeds. +  -}+  select :: k -> k -> (SelectType k) {-^ True means that the first computation succeeded. -}++instance CanSelect Kleenean where+  type SelectType Kleenean = CN Bool+  select CertainTrue _ = cn True+  select _ CertainTrue = cn False+  select CertainFalse CertainFalse =+    CN.noValueNumErrorPotential $ +      CN.NumError "select (Kleenean): Both branches failed!"+  select _ _ = +    CN.noValueNumErrorPotential $ +      CN.NumError "select (Kleenean): Insufficient information to determine selection."++instance CanSelect (CN Kleenean) where+  type SelectType (CN Kleenean) = CN Bool+  select cnk1 cnk2 =+    do+    k1 <- cnk1+    k2 <- cnk2+    select k1 k2++