module Control.ERNet.Blocks.RnToRm.Protocols where
import Control.ERNet.Foundations.Protocol
import Control.ERNet.Foundations.Protocol.StandardCombinators
import qualified Data.Number.ER.RnToRm.Approx as FA
import qualified Data.Number.ER.Real.Approx as RA
import qualified Data.Number.ER.Real.Approx.Elementary as RAEL
import qualified Data.Number.ER.Real.DomainBox as DBox
import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)
import Data.Number.ER.Misc
import Data.Number.ER.BasicTypes
import Data.Number.ER.ShowHTML
import qualified Text.Html as H
import Data.Typeable
instance
(FA.ERFnApprox box varid domra ranra fa,
RAEL.ERApproxElementary domra,
RAEL.ERApproxElementary ranra,
Typeable box, Show box,
Typeable domra, Typeable ranra, Typeable fa,
H.HTML fa) =>
(QAProtocol (QAFn1Q box) (QAFn1A ranra fa))
where
qaMatch (QAFn1QAll) (QAFn1A _) = Nothing
qaMatch (QAFn1QDom _) (QAFn1A _) = Nothing
qaMatch (QAFn1QPt _) (QAFn1APt _) = Nothing
qaMatch q a =
Just $ "function " ++ (qaMatchDefaultMessage q a)
data QAFn1Q box
= QAFn1QAll
| QAFn1QDom box
| QAFn1QPt box
deriving (Show, Typeable)
data QAFn1A ranra fa
= QAFn1A fa
| QAFn1APt [ranra]
deriving (Show, Typeable)
chTFn1 ::
(FA.ERFnApprox box varid domra ranra fa,
RAEL.ERApproxElementary domra,
RAEL.ERApproxElementary ranra,
Typeable box, Show box,
Typeable domra, Typeable ranra, Typeable fa,
H.HTML fa) =>
fa -> ChannelType
chTFn1 sampleFA = ChannelType QAFn1QAll (QAFn1A sampleFA)
instance (DomainBox box varid domra, RA.ERApprox domra) => Eq (QAFn1Q box)
where
(QAFn1QAll) == (QAFn1QAll) = True
(QAFn1QDom dom1) == (QAFn1QDom dom2) =
(and $ map snd $ DBox.zipWithDefault RA.bottomApprox RA.equalApprox dom1 dom2)
(QAFn1QPt x1) == (QAFn1QPt x2) =
(and $ map snd $ DBox.zipWithDefault RA.bottomApprox RA.equalApprox x1 x2)
_ == _ = False
instance (DomainBox box varid domra, RA.ERApprox domra) => Ord (QAFn1Q box)
where
compare (QAFn1QAll) (QAFn1QAll) = EQ
compare (QAFn1QDom dom1) (QAFn1QDom dom2) =
compareComposeMany $ map snd $
DBox.zipWithDefault RA.bottomApprox RA.compareApprox dom1 dom2
compare (QAFn1QPt pt1) (QAFn1QPt pt2) =
compareComposeMany $ map snd $
DBox.zipWithDefault RA.bottomApprox RA.compareApprox pt1 pt2
compare (QAFn1QAll) (QAFn1QDom _) = LT
compare (QAFn1QDom _) (QAFn1QAll) = GT
compare (QAFn1QAll) (QAFn1QPt _) = LT
compare (QAFn1QPt _) (QAFn1QAll) = GT
compare (QAFn1QDom _) (QAFn1QPt _) = LT
compare (QAFn1QPt _) (QAFn1QDom _) = GT
instance (FA.ERFnApprox box varid domra ranra fa) => Eq (QAFn1A ranra fa)
where
(QAFn1A fa1) == (QAFn1A fa2) = RA.equalApprox fa1 fa2
(QAFn1APt vals1) == (QAFn1APt vals2) =
(and $ zipWith RA.equalApprox vals1 vals2)
_ == _ = False
instance (Show box) => H.HTML (QAFn1Q box) where
toHtml = toHtmlDefault
instance (Show ranra, H.HTML fa) => H.HTML (QAFn1A ranra fa)
where
toHtml (QAFn1APt doms) =
H.toHtml $ "QAFn1APt " ++ " " ++ show doms
toHtml (QAFn1A fa) =
H.toHtml $
abovesTable [H.border 2]
[
H.toHtml "QAFn1A"
,
H.toHtml fa
]
makeAnswerFn1NoIx ::
(FA.ERFnApprox box varid domra ranra fa) =>
fa ->
(QAFn1Q box) ->
(QAFn1A ranra fa)
makeAnswerFn1NoIx fa qry =
case qry of
QAFn1QAll -> QAFn1A fa
QAFn1QDom doms -> QAFn1A fa
QAFn1QPt vals ->
QAFn1APt $ FA.eval vals fa
makeAnswerFn1ByBoxesNoIx ::
(FA.ERFnDomApprox box varid domra ranra fa) =>
(box -> [ranra]) ->
(QAFn1Q box) ->
(QAFn1A ranra fa)
makeAnswerFn1ByBoxesNoIx computeBounds qry =
case qry of
(QAFn1QPt domB) ->
QAFn1APt $ computeBounds domB
(QAFn1QDom domB) ->
QAFn1A $ FA.const domB $ computeBounds domB
instance (FA.ERFnApprox box varid domra ranra fa, Typeable fa, H.HTML fa) =>
(QAProtocol (QAFn2Q fa) (QAFn2A fa))
where
qaMatch _ _ = Nothing
data QAFn2Q fa
= QAFn2QPt fa
deriving (Show, Typeable)
data QAFn2A fa
= QAFn2APt fa
deriving (Show, Typeable)
chTFn2 ::
(FA.ERFnApprox box varid domra ranra fa,
RAEL.ERApproxElementary domra,
RAEL.ERApproxElementary ranra,
Typeable box, Show box,
Typeable domra, Typeable ranra, Typeable fa,
H.HTML fa) =>
fa -> ChannelType
chTFn2 sampleFA = ChannelType (QAFn2QPt sampleFA) (QAFn2APt sampleFA)
instance (FA.ERFnApprox box varid domra ranra fa) => Eq (QAFn2Q fa)
where
(QAFn2QPt fn1) == (QAFn2QPt fn2) =
RA.equalApprox fn1 fn2
instance (FA.ERFnApprox box varid domra ranra fa) => Eq (QAFn2A fa)
where
(QAFn2APt fn1) == (QAFn2APt fn2) =
RA.equalApprox fn1 fn2
instance (FA.ERFnApprox box varid domra ranra fa) => Ord (QAFn2Q fa)
where
compare (QAFn2QPt fn1) (QAFn2QPt fn2) =
RA.compareApprox fn1 fn2
instance (H.HTML fa) => H.HTML (QAFn2Q fa)
where
toHtml (QAFn2QPt fa) =
H.toHtml $
abovesTable [H.border 2]
[
H.toHtml "QAFn2QPt "
,
H.toHtml fa
]
instance (H.HTML fa) => H.HTML (QAFn2A fa)
where
toHtml (QAFn2APt fa) =
H.toHtml $
abovesTable [H.border 2]
[
H.toHtml "QAFn2APt "
,
H.toHtml fa
]
replyFn f (QAIxQ ix QAFn1QAll) =
QAIxA $ QAFn1A (f ix)
replyFnNoIx f QAFn1QAll =
QAFn1A f
replyFn2Fn f2f (QAIxQ ix (QAFn2QPt argFA)) =
QAIxA $ QAFn2APt (f2f ix argFA)