AERN-Real-Interval-2011.1: src/Numeric/AERN/RealArithmetic/Interval/Mutable/FieldOps.hs
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-|
Module : Numeric.AERN.RealArithmetic.Interval.Mutable.FieldOps
Description : field operations for mutable intervals
Copyright : (c) Michal Konecny, Jan Duracz
License : BSD3
Maintainer : mikkonecny@gmail.com
Stability : experimental
Portability : portable
Field operations for mutable intervals.
This module is hidden and reexported via its parent Interval.Mutable.
-}
module Numeric.AERN.RealArithmetic.Interval.Mutable.FieldOps() where
import Numeric.AERN.Basics.Mutable
import Numeric.AERN.Basics.Interval
import Numeric.AERN.Basics.Interval.Mutable
import Numeric.AERN.RealArithmetic.ExactOps
import Numeric.AERN.RealArithmetic.Interval.Mutable.ExactOps
import qualified Numeric.AERN.RealArithmetic.NumericOrderRounding as ArithUpDn
import Numeric.AERN.RealArithmetic.RefinementOrderRounding
import Numeric.AERN.RealArithmetic.Interval.FieldOps
import qualified Numeric.AERN.Basics.NumericOrder as NumOrd
import qualified Numeric.AERN.Basics.RefinementOrder as RefOrd
import Control.Monad.ST (ST)
instance (ArithUpDn.RoundedAddInPlace e, CanBeMutable e) =>
RoundedAddInPlace (Interval e)
where
addInInPlaceEff eff (MInterval resL resR) (MInterval aL aR) (MInterval bL bR) =
do
ArithUpDn.addUpInPlaceEff eff resL aL bL
ArithUpDn.addDnInPlaceEff eff resR aR bR
addOutInPlaceEff eff (MInterval resL resR) (MInterval aL aR) (MInterval bL bR) =
do
ArithUpDn.addDnInPlaceEff eff resL aL bL
ArithUpDn.addUpInPlaceEff eff resR aR bR
instance
(ArithUpDn.RoundedAddInPlace e,
CanBeMutable e,
NegInPlace e) =>
RoundedSubtrInPlace (Interval e)
instance (RoundedAbs (Interval e), CanBeMutable (Interval e)) =>
RoundedAbsInPlace (Interval e)
instance
(ArithUpDn.RoundedMultiplyInPlace e,
NumOrd.RoundedLatticeInPlace e,
HasZero e, NumOrd.PartialComparison e,
CanBeMutable e) =>
RoundedMultiplyInPlace (Interval e)
where
multOutInPlaceEff (effortComp, effortMinmax, effortMult) r i1 i2 =
multiplyIntervalsInPlace
(pNonnegNonposEff effortComp)
(ArithUpDn.multDnInPlaceEff effortMult)
(ArithUpDn.multUpInPlaceEff effortMult)
(NumOrd.minDnInPlaceEff effortMinmax) -- minL
(NumOrd.minUpInPlaceEff effortMinmax) -- minR
(NumOrd.maxDnInPlaceEff effortMinmax) -- maxL
(NumOrd.maxUpInPlaceEff effortMinmax) -- maxR
(NumOrd.minDnInPlaceEff effortMinmax)
(NumOrd.maxUpInPlaceEff effortMinmax)
r i1 i2
multInInPlaceEff (effortComp, effortMinmax, effortMult) r i1 i2 =
multiplyIntervalsInPlace
(pNonnegNonposEff effortComp)
(ArithUpDn.multUpInPlaceEff effortMult)
(ArithUpDn.multDnInPlaceEff effortMult)
(NumOrd.minUpInPlaceEff effortMinmax) -- minL
(NumOrd.minDnInPlaceEff effortMinmax) -- minR
(NumOrd.maxUpInPlaceEff effortMinmax) -- maxL
(NumOrd.maxDnInPlaceEff effortMinmax) -- maxR
(NumOrd.maxUpInPlaceEff effortMinmax)
(NumOrd.minDnInPlaceEff effortMinmax)
r i1 i2
multiplyIntervalsInPlace ::
(CanBeMutable e, HasZero e) =>
(e -> (Maybe Bool, Maybe Bool)) ->
(OpMutable2 e s) ->
(OpMutable2 e s) ->
(OpMutable2 e s) ->
(OpMutable2 e s) ->
(OpMutable2 e s) ->
(OpMutable2 e s) ->
(OpMutable2 e s) ->
(OpMutable2 e s) ->
(Mutable (Interval e) s) ->
(Mutable (Interval e) s) ->
(Mutable (Interval e) s) ->
ST s ()
multiplyIntervalsInPlace
pNonnegNonpos timesLInPlace timesRInPlace
minLInPlace minRInPlace maxLInPlace maxRInPlace
combineLInPlace combineRInPlace
(MInterval lResM rResM) (MInterval l1M r1M) (MInterval l2M r2M) =
do
let _ = [minLInPlace, maxRInPlace, combineLInPlace, combineRInPlace]
l1 <- readMutable l1M
r1 <- readMutable r1M
l2 <- readMutable l2M
r2 <- readMutable r2M
case (pNonnegNonpos l1, -- sign of l1
pNonnegNonpos r1, -- sign of r1
pNonnegNonpos l2, -- sign of l2
pNonnegNonpos r2 -- sign of r2
) of
-----------------------------------------------------------
-- cases where i1 or i2 is known to be positive or negative
-----------------------------------------------------------
-- i1 negative, i2 positive
((_, Just True), (_, Just True), (Just True, _), (Just True, _)) ->
-- (l1 `timesL` r2, r1 `timesR` l2)
assignResEndpointsUsingTimesLR l1M r2M r1M l2M
-- i1 negative, i2 negative
((_, Just True), (_, Just True), (_, Just True), (_, Just True)) ->
-- (r1 `timesL` r2, l1 `timesR` l2)
assignResEndpointsUsingTimesLR r1M r2M l1M l2M
-- i1 negative, i2 consistent and containing zero
((_, Just True), (_, Just True), (_, Just True), (Just True, _)) ->
-- (l1 `timesL` r2, l1 `timesR` l2)
assignResEndpointsUsingTimesLR l1M r2M l1M l2M
-- i1 negative, i2 anti-consistent and anti-containing zero
((_, Just True), (_, Just True), (Just True, _), (_, Just True)) ->
-- (r1 `timesL` r2, r1 `timesR` l2)
assignResEndpointsUsingTimesLR r1M r2M r1M l2M
-- i1 negative, nothing known about i2:
((_, Just True), (_, Just True), _, _) ->
-- ((r1 `timesL` r2) `combineL` (l1 `timesL` r2),
-- (r1 `timesR` l2) `combineR` (l1 `timesR` l2))
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 r1M r2M
timesLInPlace temp2 l1M r2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 r1M l2M
timesRInPlace temp2 l1M l2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
-- i1 positive, i2 positive
((Just True, _), (Just True, _), (Just True, _), (Just True, _)) ->
-- (l1 `timesL` l2, r1 `timesR` r2)
do
timesLInPlace lResM l1M l2M
timesRInPlace rResM r1M r2M
-- i1 positive, i2 negative
((Just True, _), (Just True, _), (_, Just True), (_, Just True)) ->
-- (r1 `timesL` l2, l1 `timesR` r2)
assignResEndpointsUsingTimesLR r1M l2M l1M r2M
-- i1 positive, i2 consistent and containing zero
((Just True, _), (Just True, _), (_, Just True), (Just True, _)) ->
-- (r1 `timesL` l2, r1 `timesR` r2)
assignResEndpointsUsingTimesLR r1M l2M r1M r2M
-- i1 positive, i2 anti-consistent and anti-containing zero
((Just True, _), (Just True, _), (Just True, _), (_, Just True)) ->
-- (l1 `timesL` l2, l1 `timesR` r2)
assignResEndpointsUsingTimesLR l1M l2M l1M r2M
-- i1 positive, nothing known about i2:
((Just True, _), (Just True, _), _, _) ->
-- ((r1 `timesL` l2) `combineL` (l1 `timesL` l2),
-- (r1 `timesR` r2) `combineR` (l1 `timesR` r2))
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 r1M l2M
timesLInPlace temp2 l1M l2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 r1M r2M
timesRInPlace temp2 l1M r2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
-- i1 consistent and containing zero, i2 positive
((_, Just True), (Just True, _), (Just True, _), (Just True, _)) ->
-- (l1 `timesL` r2, r1 `timesR` r2)
assignResEndpointsUsingTimesLR l1M r2M r1M r2M
-- i1 anti-consistent and anti-containing zero, i2 positive
((Just True, _), (_, Just True), (Just True, _), (Just True, _)) ->
-- (l1 `timesL` l2, r1 `timesR` l2)
assignResEndpointsUsingTimesLR l1M l2M r1M l2M
-- nothing known about i1, i2 positive
(_, _, (Just True, _), (Just True, _)) ->
-- ((l1 `timesL` r2) `combineL` (l1 `timesL` l2),
-- (r1 `timesR` r2) `combineR` (r1 `timesR` l2))
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 l1M r2M
timesLInPlace temp2 l1M l2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 r1M r2M
timesRInPlace temp2 r1M l2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
-- i1 consistent and containing zero, i2 negative
((_, Just True), (Just True, _), (_, Just True), (_, Just True)) ->
-- (r1 `timesL` l2, l1 `timesR` l2)
assignResEndpointsUsingTimesLR r1M l2M l1M l2M
-- i1 anti-consistent and anti-containing zero, i2 negative
((Just True, _), (_, Just True), (_, Just True), (_, Just True)) ->
-- (r1 `timesL` r2, l1 `timesR` r2)
assignResEndpointsUsingTimesLR r1M r2M l1M r2M
-- nothing known about i1, i2 negative
(_, _, (_, Just True), (_, Just True)) ->
-- ((r1 `timesL` r2) `combineL` (r1 `timesL` l2),
-- (l1 `timesR` r2) `combineR` (l1 `timesR` l2))
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 r1M r2M
timesLInPlace temp2 r1M l2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 l1M r2M
timesRInPlace temp2 l1M l2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
-----------------------------------------------------------
-- cases where both i1 or i2 are around zero
-----------------------------------------------------------
-- i1 consistent and containing zero, i2 consistent and containing zero
((_, Just True), (Just True, _), (_, Just True), (Just True, _)) ->
-- ((l1 `timesL` r2) `minL` (r1 `timesL` l2),
-- (l1 `timesR` l2) `maxR` (r1 `timesR` r2))
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 l1M r2M
timesLInPlace temp2 r1M l2M
minLInPlace temp3 temp1 temp2
timesRInPlace temp1 l1M l2M
timesRInPlace temp2 r1M r2M
maxRInPlace rResM temp1 temp2
assignMutable lResM temp3
-- i1 consistent and containing zero, i2 anti-consistent and anti-containing zero
((_, Just True), (Just True, _), (Just True, _), (_, Just True)) ->
-- (zero, zero)
do
let z = zero
let _ = [z,l1]
writeMutable lResM z
writeMutable rResM z
-- i1 consistent and containing zero, i2 unknown
((_, Just True), (Just True, _), _, _) ->
-- (((l1 `timesL` r2) `combineL` (r1 `timesL` l2)) `combineL` zero,
-- ((l1 `timesR` l2) `combineR` (r1 `timesR` r2)) `combineR` zero)
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 l1M r2M
timesLInPlace temp2 r1M l2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 l1M l2M
timesRInPlace temp2 r1M r2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
let z = zero
let _ = [z,l1]
writeMutable temp1 z
combineLInPlace lResM lResM temp1
combineRInPlace rResM rResM temp1
-- i1 anti-consistent and anti-containing zero, i2 consistent and containing zero
((Just True, _), (_, Just True), (_, Just True), (Just True, _)) ->
-- (zero, zero)
do
let z = zero
let _ = [z,l1]
writeMutable lResM z
writeMutable rResM z
-- i1 anti-consistent and anti-containing zero, i2 anti-consistent and anti-containing zero
((Just True, _), (_, Just True), (Just True, _), (_, Just True)) ->
-- ((l1 `timesL` l2) `maxL` (r1 `timesL` r2),
-- (l1 `timesR` r2) `minR` (r1 `timesR` l2))
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 l1M l2M
timesLInPlace temp2 r1M r2M
maxLInPlace temp3 temp1 temp2
timesRInPlace temp1 l1M r2M
timesRInPlace temp2 r1M l2M
minRInPlace rResM temp1 temp2
assignMutable lResM temp3
-- i1 anti-consistent and anti-containing zero, i2 unknown
((Just True, _), (_, Just True), _, _) ->
-- ((l1 `timesL` l2) `combineL` (r1 `timesL` r2) `combineL` zero,
-- (l1 `timesR` r2) `combineR` (r1 `timesR` l2) `combineR` zero)
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 l1M l2M
timesLInPlace temp2 r1M r2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 l1M r2M
timesRInPlace temp2 r1M l2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
let z = zero
let _ = [z,l1]
writeMutable temp1 z
combineLInPlace lResM lResM temp1
combineRInPlace rResM rResM temp1
-- i1 unknown, i2 anti-consistent and anti-containing zero
(_, _, (Just True, _), (_, Just True)) ->
-- ((l1 `timesL` l2) `combineL` (r1 `timesL` r2) `combineL` zero,
-- (l1 `timesR` r2) `combineR` (r1 `timesR` l2) `combineR` zero)
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 l1M l2M
timesLInPlace temp2 r1M r2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 l1M r2M
timesRInPlace temp2 r1M l2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
let z = zero
let _ = [z,l1]
writeMutable temp1 z
combineLInPlace lResM lResM temp1
combineRInPlace rResM rResM temp1
-- i1 unknown, i2 consistent and containing zero
(_, _, (_, Just True), (Just True, _)) ->
-- ((l1 `timesL` r2) `combineL` (r1 `timesL` l2) `combineL` zero,
-- (l1 `timesR` l2) `combineR` (r1 `timesR` r2) `combineR` zero)
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 l1M r2M
timesLInPlace temp2 r1M l2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 l1M l2M
timesRInPlace temp2 r1M r2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
let z = zero
let _ = [z,l1]
writeMutable temp1 z
combineLInPlace lResM lResM temp1
combineRInPlace rResM rResM temp1
-- both i1 and i2 unknown sign
_ ->
-- (foldl1 combineL [l1 `timesL` r2, r1 `timesL` l2, l1 `timesL` l2, r1 `timesL` r2],
-- foldl1 combineR [l1 `timesR` r2, r1 `timesR` l2, l1 `timesR` l2, r1 `timesR` r2])
do
temp1 <- makeMutable zero
temp2 <- makeMutable zero
temp3 <- makeMutable zero
timesLInPlace temp1 l1M r2M
timesLInPlace temp2 r1M l2M
combineLInPlace temp1 temp1 temp2
timesLInPlace temp2 l1M l2M
combineLInPlace temp1 temp1 temp2
timesLInPlace temp2 r1M r2M
combineLInPlace temp3 temp1 temp2
timesRInPlace temp1 l1M r2M
timesRInPlace temp2 r1M l2M
combineRInPlace temp1 temp1 temp2
timesRInPlace temp2 l1M l2M
combineRInPlace temp1 temp1 temp2
timesRInPlace temp2 r1M r2M
combineRInPlace rResM temp1 temp2
assignMutable lResM temp3
where
assignResEndpointsUsingTimesLR l1M l2M r1M r2M =
do
temp1 <- makeMutable zero
timesLInPlace temp1 l1M l2M -- beware of aliasing between res and param
timesRInPlace rResM r1M r2M
assignMutable lResM temp1
instance
(RoundedSubtrInPlace (Interval e),
RoundedMultiplyInPlace (Interval e),
RoundedRingEffort (Interval e)) =>
RoundedRingInPlace (Interval e)
instance
(ArithUpDn.RoundedPowerNonnegToNonnegIntInPlace e,
RoundedPowerToNonnegInt (Interval e),
RoundedMultiplyInPlace (Interval e),
HasOne e, HasZero e, NegInPlace e,
NumOrd.PartialComparison e, NumOrd.RoundedLatticeInPlace e,
CanBeMutable e
) =>
RoundedPowerToNonnegIntInPlace (Interval e)
where
powerToNonnegIntInInPlaceEff
(effPowerEndpt, effComp, effPowerFromMult@(_,effMinMax,_))
res@(MInterval resL resR) a@(MInterval aL aR) n =
do
l <- readMutable aL
r <- readMutable aR
case (pNonnegNonposEff effComp l, pNonnegNonposEff effComp r) of
((Just True, _), (Just True, _)) -> -- both non-negative
do
ArithUpDn.powerNonnegToNonnegIntUpInPlaceEff
effPowerEndpt resL aL n
ArithUpDn.powerNonnegToNonnegIntDnInPlaceEff
effPowerEndpt resR aR n
((_, Just True), (_, Just True)) -> -- both non-positive
do
-- negate the parameters, use the result as a temp space (may alias!):
negInPlace res a
-- compute the power of the positive interval:
ArithUpDn.powerNonnegToNonnegIntUpInPlaceEff
effPowerEndpt resL resL n
ArithUpDn.powerNonnegToNonnegIntDnInPlaceEff
effPowerEndpt resR resR n
case even n of
True ->
return () -- keep result positive
False ->
negInPlace res res -- back to the original sign
_ ->
do
powerToNonnegIntInInPlaceEffFromMult effPowerFromMult res a n
case even n of
True ->
do
let zeroI = zero
let _ = [zeroI, Interval l r]
zeroM <- unsafeMakeMutable zeroI
NumOrd.maxInInPlaceEff effMinMax res res zeroM
False -> return ()
powerToNonnegIntOutInPlaceEff
(effPowerEndpt, effComp, effPowerFromMult@(_,effMinMax,_))
res@(MInterval resL resR) a@(MInterval aL aR) n =
do
l <- readMutable aL
r <- readMutable aR
case (pNonnegNonposEff effComp l, pNonnegNonposEff effComp r) of
((Just True, _), (Just True, _)) -> -- both non-negative
do
ArithUpDn.powerNonnegToNonnegIntDnInPlaceEff
effPowerEndpt resL aL n
ArithUpDn.powerNonnegToNonnegIntUpInPlaceEff
effPowerEndpt resR aR n
((_, Just True), (_, Just True)) -> -- both non-positive
do
-- negate the parameters, use the result as a temp space (may alias!):
negInPlace res a
-- compute the power of the positive interval:
ArithUpDn.powerNonnegToNonnegIntDnInPlaceEff
effPowerEndpt resL resL n
ArithUpDn.powerNonnegToNonnegIntUpInPlaceEff
effPowerEndpt resR resR n
case even n of
True ->
return () -- keep result positive
False ->
negInPlace res res -- back to the original sign
_ ->
do
powerToNonnegIntOutInPlaceEffFromMult effPowerFromMult res a n
case even n of
True ->
do
let zeroI = zero
let _ = [zeroI, Interval l r]
zeroM <- unsafeMakeMutable zeroI
NumOrd.maxOutInPlaceEff effMinMax res res zeroM
False -> return ()
instance
(ArithUpDn.RoundedDivideInPlace e,
ArithUpDn.RoundedMultiplyInPlace e,
NumOrd.RoundedLatticeInPlace e,
HasZero e, HasOne e, Neg e,
NumOrd.PartialComparison e, NumOrd.HasExtrema e,
CanBeMutable e) =>
RoundedDivideInPlace (Interval e)
where
divOutInPlaceEff
(effortComp, effortMinmax, (effortMult, effortDiv))
res@(MInterval resL resR) a@(MInterval aL aR) b@(MInterval bL bR) =
do
temp <- makeMutable zero
recipIntervalInPlace
(pPosNonnegNegNonposEff effortComp)
divDn
divUp
bottom
temp b
multOutInPlaceEff (effortComp, effortMinmax, effortMult) res a temp
where
bottom = RefOrd.bottom
sampleI = getDummySample res
_ = [bottom, sampleI]
divUp = ArithUpDn.divUpInPlaceEff effortDiv
divDn = ArithUpDn.divDnInPlaceEff effortDiv
divInInPlaceEff
(effortComp, effortMinmax, (effortMult, effortDiv))
res@(MInterval resL resR) a@(MInterval aL aR) b@(MInterval bL bR) =
do
temp <- makeMutable zero
recipIntervalInPlace
(pPosNonnegNegNonposEff effortComp)
divUp
divDn
top
temp b
multInInPlaceEff (effortComp, effortMinmax, effortMult) res a temp
where
top = RefOrd.top
sampleI = getDummySample res
_ = [top, sampleI]
divUp = ArithUpDn.divUpInPlaceEff effortDiv
divDn = ArithUpDn.divDnInPlaceEff effortDiv
recipIntervalInPlace pPosNonnegNegNonpos divL divR fallback
res@(MInterval resL resR) a@(MInterval aL aR) =
do
let oneP = one
let top = RefOrd.top
let bottom = RefOrd.bottom
let _ = [top, bottom, fallback]
oneM <- unsafeMakeMutable oneP
l <- readMutable aL
r <- readMutable aR
let _ = [l, r, oneP]
case (pPosNonnegNegNonpos l, pPosNonnegNegNonpos r) of
-- positive:
((Just True, _, _, _), (Just True, _, _, _)) ->
do
divL resL oneM aR
divR resR oneM aL
-- negative:
((_, _, Just True, _), (_, _, Just True, _)) ->
do
divL resL oneM aR
divR resR oneM aL
-- consistent around zero:
((_, _, _, Just True), (_, Just True, _, _)) ->
writeMutable res bottom
-- anti-consistent around zero:
((_, Just True, _, _), (_,_,_, Just True)) ->
writeMutable res top
-- unknown:
_ ->
writeMutable res fallback
instance
(ArithUpDn.RoundedFieldInPlace e,
ArithUpDn.RoundedPowerNonnegToNonnegIntInPlace e,
HasZero e, NegInPlace e, HasOne e,
NumOrd.HasExtrema e,
NumOrd.PartialComparison e,
NumOrd.RoundedLatticeInPlace e) =>
RoundedFieldInPlace (Interval e)