module AERN2.Sequence.Field
(
)
where
import MixedTypesNumPrelude
import Control.Arrow
import Control.CollectErrors
import AERN2.MP.Ball
import AERN2.MP.Dyadic
import AERN2.QA.Protocol
import AERN2.AccuracySG
import AERN2.Sequence.Type
import AERN2.Sequence.Helpers
import AERN2.Sequence.Ring (mulGetInitAC)
instance
(QAArrow to, CanDiv a b, HasNorm (EnsureNoCN a), HasNorm (EnsureNoCN b)
, SuitableForSeq a, SuitableForSeq b
, SuitableForSeq (DivType a b), SuitableForSeq (DivTypeNoCN a b))
=>
CanDiv (SequenceA to a) (SequenceA to b)
where
type DivType (SequenceA to a) (SequenceA to b) = SequenceA to (DivType a b)
divide = binaryOp "/" divide divGetInitQ1Q2
type DivTypeNoCN (SequenceA to a) (SequenceA to b) = SequenceA to (DivTypeNoCN a b)
divideNoCN = binaryOp "/" divideNoCN divGetInitQ1Q2
divGetInitQ1Q2 ::
(QAArrow to
, HasNorm (EnsureNoCN a), HasNorm (EnsureNoCN b)
, SuitableForSeq a, SuitableForSeq b)
=>
Maybe (QAId to) -> SequenceA to a -> SequenceA to b -> AccuracySG `to` ((AccuracySG, Maybe a), (AccuracySG, Maybe b))
divGetInitQ1Q2 me a1 a2 =
proc q ->
do
b1 <- seqWithAccuracy a1 me -< q
let jPre2 = mulGetInitAC b1 q
b2 <- seqWithAccuracy a2 me -< jPre2
let jInit1 = divGetInitAC1 b2 q
let jInit2 = divGetInitAC2 b1 b2 q
returnA -< ((jInit1, Just b1), (jInit2, Just b2))
divGetInitAC1 ::
(HasNorm (EnsureNoCN denom), CanEnsureCN denom)
=>
denom -> AccuracySG -> AccuracySG
divGetInitAC1 denom acSG =
case ensureNoCN denom of
(Just denomNoCN, _) ->
case getNormLog denomNoCN of
NormBits denomNL -> max acSG0 (acSG denomNL)
NormZero -> acSG0
_ -> acSG0
divGetInitAC2 ::
(HasNorm (EnsureNoCN numer), CanEnsureCN numer
, HasNorm (EnsureNoCN denom), CanEnsureCN denom)
=>
numer -> denom -> AccuracySG -> AccuracySG
divGetInitAC2 numer denom acSG =
case (ensureNoCN numer, ensureNoCN denom) of
((Just numerNoCN, _), (Just denomNoCN, _)) ->
case (getNormLog numerNoCN, getNormLog denomNoCN) of
(_, NormZero) -> acSG0
(NormZero, _) -> acSG0
(NormBits numerNL, NormBits denomNL) -> max acSG0 (acSG + numerNL 2 * denomNL)
_ -> acSG0
instance
(CanDiv a MPBall, SuitableForSeq a
, CanSetPrecision (DivType a MPBall), CanSetPrecision (DivTypeNoCN a MPBall))
=>
CanDiv (Sequence a) MPBall
where
type DivType (Sequence a) MPBall = DivType a MPBall
divide = binaryWithEnclTranslateAC (\ _ -> divGetInitAC1) divide
type DivTypeNoCN (Sequence a) MPBall = DivTypeNoCN a MPBall
divideNoCN = binaryWithEnclTranslateAC (\ _ -> divGetInitAC1) divideNoCN
instance
(CanDiv MPBall b, SuitableForSeq b
, HasNorm (EnsureNoCN b), CanEnsureCN b
, CanSetPrecision (DivType MPBall b)
, CanSetPrecision (DivTypeNoCN MPBall b))
=>
CanDiv MPBall (Sequence b)
where
type DivType MPBall (Sequence b) = DivType MPBall b
divide = flip (binaryWithEnclTranslateAC (flip divGetInitAC2) (flip divide))
type DivTypeNoCN MPBall (Sequence b) = DivTypeNoCN MPBall b
divideNoCN = flip (binaryWithEnclTranslateAC (flip divGetInitAC2) (flip divideNoCN))
instance
(CanDiv (SequenceA to a) b
, CanEnsureCE es b
, CanEnsureCE es (DivType (SequenceA to a) b)
, CanEnsureCE es (DivTypeNoCN (SequenceA to a) b)
, SuitableForCE es)
=>
CanDiv (SequenceA to a) (CollectErrors es b)
where
type DivType (SequenceA to a) (CollectErrors es b) =
EnsureCE es (DivType (SequenceA to a) b)
divide = lift2TLCE divide
type DivTypeNoCN (SequenceA to a) (CollectErrors es b) =
EnsureCE es (DivTypeNoCN (SequenceA to a) b)
divideNoCN = lift2TLCE divideNoCN
instance
(CanDiv a (SequenceA to b)
, CanEnsureCE es a
, CanEnsureCE es (DivType a (SequenceA to b))
, CanEnsureCE es (DivTypeNoCN a (SequenceA to b))
, SuitableForCE es)
=>
CanDiv (CollectErrors es a) (SequenceA to b)
where
type DivType (CollectErrors es a) (SequenceA to b) =
EnsureCE es (DivType a (SequenceA to b))
divide = lift2TCE divide
type DivTypeNoCN (CollectErrors es a) (SequenceA to b) =
EnsureCE es (DivTypeNoCN a (SequenceA to b))
divideNoCN = lift2TCE divideNoCN
divGetInitQ1T ::
(Arrow to, HasNorm (EnsureNoCN denom), CanEnsureCN denom)
=>
Maybe (QAId to) -> SequenceA to numer -> denom -> AccuracySG `to` (AccuracySG, Maybe numer)
divGetInitQ1T _me _numerSeq denom =
arr $ \q -> (divGetInitAC1 denom q, Nothing)
divGetInitQ2T ::
(QAArrow to
, HasNorm (EnsureNoCN numer), CanEnsureCN numer
, HasNorm (EnsureNoCN denom), CanEnsureCN denom)
=>
Maybe (QAId to) -> numer -> SequenceA to denom -> AccuracySG `to` (AccuracySG, Maybe denom)
divGetInitQ2T me numer denomSeq =
proc q ->
do
denom <- seqWithAccuracy denomSeq me -< q
returnA -< (divGetInitAC2 numer denom q, Just denom)
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Dyadic |]]
(\ t -> [d|
instance
(QAArrow to, CanDiv a $t, SuitableForSeq a
, SuitableForSeq (DivType a $t), SuitableForSeq (DivTypeNoCN a $t))
=>
CanDiv (SequenceA to a) $t
where
type DivType (SequenceA to a) $t = SequenceA to (DivType a $t)
divide = binaryOpWithPureArg "/" divide divGetInitQ1T
type DivTypeNoCN (SequenceA to a) $t = SequenceA to (DivTypeNoCN a $t)
divideNoCN = binaryOpWithPureArg "/" divideNoCN divGetInitQ1T
instance
(QAArrow to, CanDiv $t b, SuitableForSeq b
, SuitableForSeq (DivType $t b)
, SuitableForSeq (DivTypeNoCN $t b)
, HasNorm (EnsureNoCN b))
=>
CanDiv $t (SequenceA to b)
where
type DivType $t (SequenceA to b) = SequenceA to (DivType $t b)
divide = flip $ binaryOpWithPureArg "/" (flip divide) (\ me -> flip (divGetInitQ2T me))
type DivTypeNoCN $t (SequenceA to b) = SequenceA to (DivTypeNoCN $t b)
divideNoCN = flip $ binaryOpWithPureArg "/" (flip divideNoCN) (\ me -> flip (divGetInitQ2T me))
|]))