AERN-Real-2011.1: src/Numeric/AERN/RealArithmetic/NumericOrderRounding/InPlace/FieldOps.hs
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE RankNTypes #-}
{-|
Module : Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps
Description : rounded basic arithmetic operations
Copyright : (c) Michal Konecny, Jan Duracz
License : BSD3
Maintainer : mikkonecny@gmail.com
Stability : experimental
Portability : portable
In-place versions of rounded basic arithmetic operations.
Each operations takes mutable parameters instead of pure parameters
and has one extra mutable parameter before the other parameters,
in which it stores the result.
The mutable parameters can alias arbitrarily, making it possible
to eg add to a number overwriting the original number.
The operations have as their first paramter a non-mutable sample value
to aid type-checking, ie to help work out which type the mutable parameters
contain.
This module is hidden and reexported via its parent NumericOrderRounding.InPlace.
-}
module Numeric.AERN.RealArithmetic.NumericOrderRounding.InPlace.FieldOps
where
import Prelude hiding (EQ, LT, GT)
import Numeric.AERN.Basics.PartialOrdering
import Numeric.AERN.RealArithmetic.NumericOrderRounding.FieldOps
import Numeric.AERN.RealArithmetic.Auxiliary
import Numeric.AERN.RealArithmetic.ExactOps
import Numeric.AERN.RealArithmetic.NumericOrderRounding.Conversion
import Numeric.AERN.Basics.Effort
import Numeric.AERN.Basics.Exception (HasLegalValues)
import Numeric.AERN.Basics.Mutable
import Numeric.AERN.RealArithmetic.Laws
import Numeric.AERN.RealArithmetic.Measures
import qualified Numeric.AERN.Basics.NumericOrder as NumOrd
import Numeric.AERN.Basics.NumericOrder.OpsImplicitEffort
import Test.QuickCheck
import Test.Framework (testGroup, Test)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Control.Monad.ST
import Data.Maybe
class (RoundedAddEffort t, CanBeMutable t) => RoundedAddInPlace t where
addUpInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s
addDnInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s
addUpInPlaceEffFromPure,
addDnInPlaceEffFromPure ::
(CanBeMutable t, RoundedAdd t) =>
OpMutable2Eff (AddEffortIndicator t) t s
addUpInPlaceEffFromPure = pureToMutable2Eff addUpEff
addDnInPlaceEffFromPure = pureToMutable2Eff addDnEff
addUpInPlaceEffFromInPlace,
addDnInPlaceEffFromInPlace ::
(RoundedAddInPlace t) =>
(AddEffortIndicator t) -> t -> t -> t
addUpInPlaceEffFromInPlace = mutable2EffToPure addUpInPlaceEff
addDnInPlaceEffFromInPlace = mutable2EffToPure addDnInPlaceEff
propUpDnAddInPlace ::
(NumOrd.PartialComparison t, Neg t,
RoundedAddInPlace t, RoundedAdd t,
Show t, HasLegalValues t,
Show (AddEffortIndicator t),
EffortIndicator (AddEffortIndicator t),
Show (NumOrd.PartialCompareEffortIndicator t),
EffortIndicator (NumOrd.PartialCompareEffortIndicator t)
) =>
t ->
(NumOrd.PartialCompareEffortIndicator t,
AddEffortIndicator t) ->
(NumOrd.UniformlyOrderedPair t) ->
Bool
propUpDnAddInPlace sample initEffort (NumOrd.UniformlyOrderedPair (e1, e2)) =
equalRoundingUpDn "in-place rounded addition"
expr1Up expr1Dn expr2Up expr2Dn
NumOrd.pLeqEff initEffort
where
addUpEffViaInPlace = mutable2EffToPure addUpInPlaceEff
addDnEffViaInPlace = mutable2EffToPure addDnInPlaceEff
expr1Up eff =
let (+^) = addUpEff eff in e1 +^ e2
expr1Dn eff =
let (+.) = addDnEff eff in e1 +. e2
expr2Up eff =
let (+^) = addUpEffViaInPlace eff in e1 +^ e2
expr2Dn eff =
let (+.) = addDnEffViaInPlace eff in e1 +. e2
class (RoundedAddInPlace t, NegInPlace t) => RoundedSubtrInPlace t where
subtrUpInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s
subtrDnInPlaceEff :: OpMutable2Eff (AddEffortIndicator t) t s
subtrUpInPlaceEff effort rM aM bM =
do
bbM <- cloneMutable bM
negInPlace bbM bM
addUpInPlaceEff effort rM aM bbM
subtrDnInPlaceEff effort rM aM bM =
do
bbM <- cloneMutable bM
negInPlace bbM bM
addDnInPlaceEff effort rM aM bbM
propUpDnSubtrInPlace ::
(NumOrd.PartialComparison t,
RoundedSubtrInPlace t, RoundedSubtr t,
Neg t,
Show t, HasLegalValues t,
Show (AddEffortIndicator t),
EffortIndicator (AddEffortIndicator t),
Show (NumOrd.PartialCompareEffortIndicator t),
EffortIndicator (NumOrd.PartialCompareEffortIndicator t)
) =>
t ->
(NumOrd.PartialCompareEffortIndicator t,
AddEffortIndicator t) ->
(NumOrd.UniformlyOrderedPair t) ->
Bool
propUpDnSubtrInPlace sample initEffort (NumOrd.UniformlyOrderedPair (e1, e2)) =
equalRoundingUpDn "in-place rounded subtraction"
expr1Up expr1Dn expr2Up expr2Dn
NumOrd.pLeqEff initEffort
where
subtrUpEffViaInPlace = mutable2EffToPure subtrUpInPlaceEff
subtrDnEffViaInPlace = mutable2EffToPure subtrDnInPlaceEff
expr1Up eff =
let (-^) = subtrUpEff eff in e1 -^ e2
expr1Dn eff =
let (-.) = subtrDnEff eff in e1 -. e2
expr2Up eff =
let (-^) = subtrUpEffViaInPlace eff in e1 -^ e2
expr2Dn eff =
let (-.) = subtrDnEffViaInPlace eff in e1 -. e2
class (RoundedAbsEffort t, CanBeMutable t) => RoundedAbsInPlace t where
absUpInPlaceEff :: OpMutable1Eff (AbsEffortIndicator t) t s
absDnInPlaceEff :: OpMutable1Eff (AbsEffortIndicator t) t s
absUpInPlaceEffFromPure,
absDnInPlaceEffFromPure ::
(CanBeMutable t, RoundedAbs t) =>
OpMutable1Eff (AbsEffortIndicator t) t s
absUpInPlaceEffFromPure = pureToMutable1Eff absUpEff
absDnInPlaceEffFromPure = pureToMutable1Eff absDnEff
absUpInPlaceEffFromInPlace,
absDnInPlaceEffFromInPlace ::
(RoundedAbsInPlace t) =>
(AbsEffortIndicator t) -> t -> t
absUpInPlaceEffFromInPlace = mutable1EffToPure absUpInPlaceEff
absDnInPlaceEffFromInPlace = mutable1EffToPure absDnInPlaceEff
propUpDnAbsInPlace ::
(NumOrd.PartialComparison t,
RoundedAbsInPlace t, RoundedAbs t,
Neg t,
Show t, HasLegalValues t,
Show (AbsEffortIndicator t),
EffortIndicator (AbsEffortIndicator t),
Show (NumOrd.PartialCompareEffortIndicator t),
EffortIndicator (NumOrd.PartialCompareEffortIndicator t)
) =>
t ->
(NumOrd.PartialCompareEffortIndicator t,
AbsEffortIndicator t) ->
(NumOrd.UniformlyOrderedSingleton t) ->
Bool
propUpDnAbsInPlace sample initEffort (NumOrd.UniformlyOrderedSingleton e1) =
equalRoundingUpDn "in-place rounded abs"
expr1Up expr1Dn expr2Up expr2Dn
NumOrd.pLeqEff initEffort
where
absUpEffViaInPlace = mutable1EffToPure absUpInPlaceEff
absDnEffViaInPlace = mutable1EffToPure absDnInPlaceEff
expr1Up eff = absUpEff eff e1
expr1Dn eff = absDnEff eff e1
expr2Up eff = absUpEffViaInPlace eff e1
expr2Dn eff = absDnEffViaInPlace eff e1
class (RoundedMultiplyEffort t, CanBeMutable t) => RoundedMultiplyInPlace t where
multUpInPlaceEff :: OpMutable2Eff (MultEffortIndicator t) t s
multDnInPlaceEff :: OpMutable2Eff (MultEffortIndicator t) t s
multUpInPlaceEffFromPure,
multDnInPlaceEffFromPure ::
(CanBeMutable t, RoundedMultiply t) =>
OpMutable2Eff (MultEffortIndicator t) t s
multUpInPlaceEffFromPure = pureToMutable2Eff multUpEff
multDnInPlaceEffFromPure = pureToMutable2Eff multDnEff
multUpInPlaceEffFromInPlace,
multDnInPlaceEffFromInPlace ::
(RoundedMultiplyInPlace t) =>
(MultEffortIndicator t) -> t -> t -> t
multUpInPlaceEffFromInPlace = mutable2EffToPure multUpInPlaceEff
multDnInPlaceEffFromInPlace = mutable2EffToPure multDnInPlaceEff
propUpDnMultInPlace ::
(NumOrd.PartialComparison t,
RoundedMultiplyInPlace t, RoundedMultiply t,
Neg t,
Show t, HasLegalValues t,
Show (MultEffortIndicator t),
EffortIndicator (MultEffortIndicator t),
Show (NumOrd.PartialCompareEffortIndicator t),
EffortIndicator (NumOrd.PartialCompareEffortIndicator t)
) =>
t ->
(NumOrd.PartialCompareEffortIndicator t,
MultEffortIndicator t) ->
(NumOrd.UniformlyOrderedPair t) ->
Bool
propUpDnMultInPlace sample initEffort (NumOrd.UniformlyOrderedPair (e1, e2)) =
equalRoundingUpDn "in-place rounded multiplication"
expr1Up expr1Dn expr2Up expr2Dn
NumOrd.pLeqEff initEffort
where
multUpEffViaInPlace = mutable2EffToPure multUpInPlaceEff
multDnEffViaInPlace = mutable2EffToPure multDnInPlaceEff
expr1Up eff =
let (*^) = multUpEff eff in e1 *^ e2
expr1Dn eff =
let (*.) = multDnEff eff in e1 *. e2
expr2Up eff =
let (*^) = multUpEffViaInPlace eff in e1 *^ e2
expr2Dn eff =
let (*.) = multDnEffViaInPlace eff in e1 *. e2
class (RoundedPowerNonnegToNonnegIntEffort t, CanBeMutable t) =>
RoundedPowerNonnegToNonnegIntInPlace t
where
powerNonnegToNonnegIntUpInPlaceEff ::
OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicator t) t Int s
powerNonnegToNonnegIntDnInPlaceEff ::
OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicator t) t Int s
-- default implementations, do not use these if the RoundedPowerNonnegToNonnegInt
-- instance uses the ...fromMult implementation;
-- in such cases override this implementation with the ...fromMult implementation below
-- for improved efficiency
powerNonnegToNonnegIntUpInPlaceEffFromPure,
powerNonnegToNonnegIntDnInPlaceEffFromPure ::
(CanBeMutable t, RoundedPowerNonnegToNonnegInt t) =>
OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicator t) t Int s
powerNonnegToNonnegIntUpInPlaceEffFromPure =
pureToMutableNonmutEff powerNonnegToNonnegIntUpEff
powerNonnegToNonnegIntDnInPlaceEffFromPure =
pureToMutableNonmutEff powerNonnegToNonnegIntDnEff
powerNonnegToNonnegIntUpInPlaceEffFromInPlace,
powerNonnegToNonnegIntDnInPlaceEffFromInPlace ::
(RoundedPowerNonnegToNonnegIntInPlace t) =>
(PowerNonnegToNonnegIntEffortIndicator t) -> t -> Int -> t
powerNonnegToNonnegIntUpInPlaceEffFromInPlace =
mutableNonmutEffToPure powerNonnegToNonnegIntUpInPlaceEff
powerNonnegToNonnegIntDnInPlaceEffFromInPlace =
mutableNonmutEffToPure powerNonnegToNonnegIntDnInPlaceEff
powerNonnegToNonnegIntUpInPlaceEffFromMult ::
(RoundedMultiplyInPlace t, HasOne t) =>
OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicatorFromMult t) t Int s
powerNonnegToNonnegIntUpInPlaceEffFromMult effMult rM eM n =
powerFromMultInPlace (multUpInPlaceEff effMult) rM eM n
powerNonnegToNonnegIntDnInPlaceEffFromMult ::
(RoundedMultiplyInPlace t, HasOne t) =>
OpMutableNonmutEff (PowerNonnegToNonnegIntEffortIndicatorFromMult t) t Int s
powerNonnegToNonnegIntDnInPlaceEffFromMult effMult rM eM n =
powerFromMultInPlace (multDnInPlaceEff effMult) rM eM n
class (RoundedPowerToNonnegIntEffort t, CanBeMutable t) =>
RoundedPowerToNonnegIntInPlace t
where
powerToNonnegIntUpInPlaceEff ::
OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s
powerToNonnegIntDnInPlaceEff ::
OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s
powerToNonnegIntUpInPlaceEffFromPure,
powerToNonnegIntDnInPlaceEffFromPure ::
(CanBeMutable t, RoundedPowerToNonnegInt t) =>
OpMutableNonmutEff (PowerToNonnegIntEffortIndicator t) t Int s
powerToNonnegIntUpInPlaceEffFromPure =
pureToMutableNonmutEff powerToNonnegIntUpEff
powerToNonnegIntDnInPlaceEffFromPure =
pureToMutableNonmutEff powerToNonnegIntDnEff
powerToNonnegIntUpInPlaceEffFromInPlace,
powerToNonnegIntDnInPlaceEffFromInPlace ::
(RoundedPowerToNonnegIntInPlace t) =>
(PowerToNonnegIntEffortIndicator t) -> t -> Int -> t
powerToNonnegIntUpInPlaceEffFromInPlace =
mutableNonmutEffToPure powerToNonnegIntUpInPlaceEff
powerToNonnegIntDnInPlaceEffFromInPlace =
mutableNonmutEffToPure powerToNonnegIntDnInPlaceEff
propUpDnPowerToNonnegInPlace ::
(NumOrd.PartialComparison t,
RoundedPowerToNonnegIntInPlace t,
RoundedPowerToNonnegInt t,
Neg t,
Show t, HasLegalValues t,
Show (PowerToNonnegIntEffortIndicator t),
EffortIndicator (PowerToNonnegIntEffortIndicator t),
Show (NumOrd.PartialCompareEffortIndicator t),
EffortIndicator (NumOrd.PartialCompareEffortIndicator t)
) =>
t ->
(NumOrd.PartialCompareEffortIndicator t,
PowerToNonnegIntEffortIndicator t) ->
(NumOrd.UniformlyOrderedSingleton t) ->
Int -> Bool
propUpDnPowerToNonnegInPlace sample initEffort
(NumOrd.UniformlyOrderedSingleton e1) n =
equalRoundingUpDn "in-place rounded non-neg integer power"
expr1Up expr1Dn expr2Up expr2Dn
NumOrd.pLeqEff initEffort
where
powerToNonnegIntUpEffViaInPlace =
mutableNonmutEffToPure powerToNonnegIntUpInPlaceEff
powerToNonnegIntDnEffViaInPlace =
mutableNonmutEffToPure powerToNonnegIntDnInPlaceEff
expr1Up eff =
let (^^) = powerToNonnegIntUpEff eff in e1 ^^ n
expr1Dn eff =
let (^.) = powerToNonnegIntDnEff eff in e1 ^. n
expr2Up eff =
let (^^) = powerToNonnegIntUpEffViaInPlace eff in e1 ^^ n
expr2Dn eff =
let (^.) = powerToNonnegIntDnEffViaInPlace eff in e1 ^. n
class (HasOne t, RoundedDivideEffort t, CanBeMutable t) =>
RoundedDivideInPlace t
where
divUpInPlaceEff :: OpMutable2Eff (DivEffortIndicator t) t s
divDnInPlaceEff :: OpMutable2Eff (DivEffortIndicator t) t s
recipUpInPlaceEff :: OpMutable1Eff (DivEffortIndicator t) t s
recipDnInPlaceEff :: OpMutable1Eff (DivEffortIndicator t) t s
recipUpInPlaceEff effort resM aM =
do
oneM <- unsafeMakeMutable one
divUpInPlaceEff effort resM oneM aM
recipDnInPlaceEff effort resM aM =
do
oneM <- unsafeMakeMutable one
divDnInPlaceEff effort resM oneM aM
divUpInPlaceEffFromPure,
divDnInPlaceEffFromPure ::
(CanBeMutable t, RoundedDivide t) =>
OpMutable2Eff (DivEffortIndicator t) t s
divUpInPlaceEffFromPure = pureToMutable2Eff divUpEff
divDnInPlaceEffFromPure = pureToMutable2Eff divDnEff
divUpInPlaceEffFromInPlace,
divDnInPlaceEffFromInPlace ::
(RoundedDivideInPlace t) =>
(DivEffortIndicator t) -> t -> t -> t
divUpInPlaceEffFromInPlace = mutable2EffToPure divUpInPlaceEff
divDnInPlaceEffFromInPlace = mutable2EffToPure divDnInPlaceEff
recipUpInPlaceEffFromPure,
recipDnInPlaceEffFromPure ::
(CanBeMutable t, RoundedDivide t) =>
OpMutable1Eff (DivEffortIndicator t) t s
recipUpInPlaceEffFromPure = pureToMutable1Eff recipUpEff
recipDnInPlaceEffFromPure = pureToMutable1Eff recipDnEff
recipUpInPlaceEffFromInPlace,
recipDnInPlaceEffFromInPlace ::
(RoundedDivideInPlace t) =>
(DivEffortIndicator t) -> t -> t
recipUpInPlaceEffFromInPlace = mutable1EffToPure recipUpInPlaceEff
recipDnInPlaceEffFromInPlace = mutable1EffToPure recipDnInPlaceEff
propUpDnDivInPlace ::
(NumOrd.PartialComparison t,
RoundedDivideInPlace t, RoundedDivide t,
Neg t,
Show t, HasZero t, HasLegalValues t,
Show (DivEffortIndicator t),
EffortIndicator (DivEffortIndicator t),
Show (NumOrd.PartialCompareEffortIndicator t),
EffortIndicator (NumOrd.PartialCompareEffortIndicator t)
) =>
t ->
(NumOrd.PartialCompareEffortIndicator t,
DivEffortIndicator t) ->
(NumOrd.UniformlyOrderedPair t) ->
Bool
propUpDnDivInPlace sample initEffort@(effComp, _) (NumOrd.UniformlyOrderedPair (e1, e2)) =
equalRoundingUpDn "in-place rounded division"
expr1Up expr1Dn expr2Up expr2Dn
NumOrd.pLeqEff initEffort
where
divUpEffViaInPlace = mutable2EffToPure divUpInPlaceEff
divDnEffViaInPlace = mutable2EffToPure divDnInPlaceEff
expr1Up eff =
let (/^) = divUpEff eff in e1 /^ e2
expr1Dn eff =
let (/.) = divDnEff eff in e1 /. e2
expr2Up eff =
let (/^) = divUpEffViaInPlace eff in e1 /^ e2
expr2Dn eff =
let (/.) = divDnEffViaInPlace eff in e1 /. e2
testsUpDnFieldOpsInPlace (name, sample) =
testGroup (name ++ " in-place up/down rounded ops match pure ops") $
[
testProperty "addition" (propUpDnAddInPlace sample)
,
testProperty "subtraction" (propUpDnSubtrInPlace sample)
,
testProperty "absolute value" (propUpDnAbsInPlace sample)
,
testProperty "multiplication" (propUpDnMultInPlace sample)
,
testProperty "integer power" (propUpDnMultInPlace sample)
,
testProperty "division" (propUpDnDivInPlace sample)
]
class
(RoundedSubtrInPlace t,
RoundedMultiplyInPlace t,
RoundedRingEffort t) =>
RoundedRingInPlace t
class
(RoundedRingInPlace t,
RoundedDivideInPlace t,
RoundedFieldEffort t) =>
RoundedFieldInPlace t