module AERN2.Sequence.Ring
(
mulGetInitAC
)
where
import MixedTypesNumPrelude hiding (id)
import Control.Category (id)
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
instance
(QAArrow to, CanAddAsymmetric a b, SuitableForSeq a, SuitableForSeq b, SuitableForSeq (AddType a b))
=>
CanAddAsymmetric (SequenceA to a) (SequenceA to b)
where
type AddType (SequenceA to a) (SequenceA to b) = SequenceA to (AddType a b)
add = binaryOp "+" add (getInitQ1Q2FromSimple $ proc q -> returnA -< (q,q))
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Dyadic |]]
(\ t -> [d|
instance
(QAArrow to, CanAddAsymmetric a $t, SuitableForSeq a, SuitableForSeq (AddType a $t))
=>
CanAddAsymmetric (SequenceA to a) $t
where
type AddType (SequenceA to a) $t = SequenceA to (AddType a $t)
add = binaryOpWithPureArg "+" add (getInitQ1TFromSimple id)
instance
(QAArrow to, CanAddAsymmetric $t b, SuitableForSeq b, SuitableForSeq (AddType $t b))
=>
CanAddAsymmetric $t (SequenceA to b)
where
type AddType $t (SequenceA to b) = SequenceA to (AddType $t b)
add = flip $ binaryOpWithPureArg "+" (flip add) (getInitQ1TFromSimple id)
|]))
instance
(CanAddAsymmetric a MPBall, SuitableForSeq a
, CanSetPrecision (AddType a MPBall))
=>
CanAddAsymmetric (Sequence a) MPBall
where
type AddType (Sequence a) MPBall = AddType a MPBall
add = binaryWithEncl add
instance
(CanAddAsymmetric MPBall b, SuitableForSeq b
, CanSetPrecision (AddType MPBall b))
=>
CanAddAsymmetric MPBall (Sequence b)
where
type AddType MPBall (Sequence b) = AddType MPBall b
add = flip $ binaryWithEncl (flip add)
instance
(CanAddAsymmetric (SequenceA to a) b
, CanEnsureCE es b
, CanEnsureCE es (AddType (SequenceA to a) b)
, SuitableForCE es)
=>
CanAddAsymmetric (SequenceA to a) (CollectErrors es b)
where
type AddType (SequenceA to a) (CollectErrors es b) =
EnsureCE es (AddType (SequenceA to a) b)
add = lift2TLCE add
instance
(CanAddAsymmetric a (SequenceA to b)
, CanEnsureCE es a
, CanEnsureCE es (AddType a (SequenceA to b))
, SuitableForCE es)
=>
CanAddAsymmetric (CollectErrors es a) (SequenceA to b)
where
type AddType (CollectErrors es a) (SequenceA to b) =
EnsureCE es (AddType a (SequenceA to b))
add = lift2TCE add
instance
(QAArrow to, CanSub a b, SuitableForSeq a, SuitableForSeq b, SuitableForSeq (SubType a b))
=>
CanSub (SequenceA to a) (SequenceA to b)
where
type SubType (SequenceA to a) (SequenceA to b) = SequenceA to (SubType a b)
sub = binaryOp "-" sub (getInitQ1Q2FromSimple $ proc q -> returnA -< (q,q))
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Dyadic |]]
(\ t -> [d|
instance
(QAArrow to, CanSub a $t, SuitableForSeq a, SuitableForSeq (SubType a $t))
=>
CanSub (SequenceA to a) $t
where
type SubType (SequenceA to a) $t = SequenceA to (SubType a $t)
sub = binaryOpWithPureArg "-" sub (getInitQ1TFromSimple id)
instance
(QAArrow to, CanSub $t b, SuitableForSeq b, SuitableForSeq (SubType $t b))
=>
CanSub $t (SequenceA to b)
where
type SubType $t (SequenceA to b) = SequenceA to (SubType $t b)
sub = flip $ binaryOpWithPureArg "-" (flip sub) (getInitQ1TFromSimple id)
|]))
instance
(CanSub a MPBall, SuitableForSeq a, CanSetPrecision (SubType a MPBall))
=>
CanSub (Sequence a) MPBall
where
type SubType (Sequence a) MPBall = SubType a MPBall
sub = binaryWithEncl sub
instance
(CanSub MPBall b, SuitableForSeq b, CanSetPrecision (SubType MPBall b))
=>
CanSub MPBall (Sequence b)
where
type SubType MPBall (Sequence b) = SubType MPBall b
sub = flip $ binaryWithEncl (flip sub)
instance
(CanSub (SequenceA to a) b
, CanEnsureCE es b
, CanEnsureCE es (SubType (SequenceA to a) b)
, SuitableForCE es)
=>
CanSub (SequenceA to a) (CollectErrors es b)
where
type SubType (SequenceA to a) (CollectErrors es b) =
EnsureCE es (SubType (SequenceA to a) b)
sub = lift2TLCE sub
instance
(CanSub a (SequenceA to b)
, CanEnsureCE es a
, CanEnsureCE es (SubType a (SequenceA to b))
, SuitableForCE es)
=>
CanSub (CollectErrors es a) (SequenceA to b)
where
type SubType (CollectErrors es a) (SequenceA to b) =
EnsureCE es (SubType a (SequenceA to b))
sub = lift2TCE sub
instance
(QAArrow to, CanMulAsymmetric a b, HasNorm (EnsureNoCN a), HasNorm (EnsureNoCN b)
, SuitableForSeq a, SuitableForSeq b, SuitableForSeq (MulType a b))
=>
CanMulAsymmetric (SequenceA to a) (SequenceA to b)
where
type MulType (SequenceA to a) (SequenceA to b) = SequenceA to (MulType a b)
mul =
binaryOp "*" mul getInitQ1Q2
where
getInitQ1Q2 me a1 a2 =
proc q ->
do
b1 <- seqWithAccuracy a1 me -< q
let jInit2 = mulGetInitAC b1 q
b2 <- seqWithAccuracy a2 me -< jInit2
let jInit1 = mulGetInitAC b2 q
returnA -< ((jInit1, Just b1), (jInit2, Just b2))
mulGetInitAC ::
(HasNorm (EnsureNoCN other), CanEnsureCN other)
=>
other -> AccuracySG -> AccuracySG
mulGetInitAC other acSG =
case ensureNoCN other of
(Just otherNoCN, _) ->
case getNormLog otherNoCN of
NormBits otherNL -> max acSG0 (acSG + otherNL)
NormZero -> acSG0
_ -> acSG
instance
(CanMulAsymmetric a MPBall, SuitableForSeq a
, CanSetPrecision (MulType a MPBall))
=>
CanMulAsymmetric (Sequence a) MPBall
where
type MulType (Sequence a) MPBall = MulType a MPBall
mul = binaryWithEnclTranslateAC (\_ -> mulGetInitAC) mul
instance
(CanMulAsymmetric MPBall b, SuitableForSeq b
, CanSetPrecision (MulType MPBall b))
=>
CanMulAsymmetric MPBall (Sequence b)
where
type MulType MPBall (Sequence b) = MulType MPBall b
mul = flip $ binaryWithEnclTranslateAC (\ _ -> mulGetInitAC) (flip mul)
instance
(CanMulAsymmetric (SequenceA to a) b
, CanEnsureCE es b
, CanEnsureCE es (MulType (SequenceA to a) b)
, SuitableForCE es)
=>
CanMulAsymmetric (SequenceA to a) (CollectErrors es b)
where
type MulType (SequenceA to a) (CollectErrors es b) =
EnsureCE es (MulType (SequenceA to a) b)
mul = lift2TLCE mul
instance
(CanMulAsymmetric a (SequenceA to b)
, CanEnsureCE es a
, CanEnsureCE es (MulType a (SequenceA to b))
, SuitableForCE es)
=>
CanMulAsymmetric (CollectErrors es a) (SequenceA to b)
where
type MulType (CollectErrors es a) (SequenceA to b) =
EnsureCE es (MulType a (SequenceA to b))
mul = lift2TCE mul
mulGetInitQ1T ::
(Arrow to, HasNorm (EnsureNoCN other), CanEnsureCN other)
=>
Maybe (QAId to) -> SequenceA to t -> other -> AccuracySG `to` (AccuracySG, Maybe t)
mulGetInitQ1T _me _seq other =
arr $ \q -> (mulGetInitAC other q, Nothing)
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Dyadic |]]
(\ t -> [d|
instance
(QAArrow to, CanMulAsymmetric a $t, SuitableForSeq a, SuitableForSeq (MulType a $t))
=>
CanMulAsymmetric (SequenceA to a) $t
where
type MulType (SequenceA to a) $t = SequenceA to (MulType a $t)
mul = binaryOpWithPureArg "*" mul mulGetInitQ1T
instance
(QAArrow to, CanMulAsymmetric $t b, SuitableForSeq b, SuitableForSeq (MulType $t b))
=>
CanMulAsymmetric $t (SequenceA to b)
where
type MulType $t (SequenceA to b) = SequenceA to (MulType $t b)
mul = flip $ binaryOpWithPureArg "*" (flip mul) mulGetInitQ1T
|]))