module Control.ERNet.Blocks.Real.Basic
(
rateRProcess,
rateRsProcess
)
where
import Control.ERNet.Foundations.Protocol
import Control.ERNet.Foundations.Protocol.StandardCombinators
import qualified Control.ERNet.Foundations.Channel as CH
import Control.ERNet.Foundations.Process
import Control.ERNet.Blocks.Basic
import Control.ERNet.Blocks.Real.Protocols
import qualified Data.Number.ER.Real.Approx as RA
import qualified Data.Number.ER.Real.Approx.Elementary as RAEL
import Data.Typeable
rateRProcess ::
(CH.Channel sIn sOut sInAnyProt sOutAnyProt,
RAEL.ERApproxElementary ra, Typeable ra) =>
ERProcessName ->
Rational ->
Int ->
ra ->
ERProcess sInAnyProt sOutAnyProt
rateRProcess defName desiredImpr maxAttepts sampleRA =
rateProcess defName goodEnough maxAttepts chtpRC
where
chtpRC = chTChanges $ chTIx $ chtpRNoIx
chtpRNoIx = chTReal sampleRA
goodEnough _ QAChangesAGivenUp = True
goodEnough QAChangesAGivenUp _ = True
goodEnough
(QAChangesANew (QAIxA (QARealA prevRA)))
(QAChangesANew (QAIxA (QARealA newRA))) =
case RA.compareReals (impr) (fromRational desiredImpr) of
Just LT -> False
_ -> True
where
(_, impr) = RA.intersectMeasureImprovement 20 prevRA newRA
_ = prevRA == sampleRA
rateRsProcess ::
(CH.Channel sIn sOut sInAnyProt sOutAnyProt,
RAEL.ERApproxElementary ra, Typeable ra) =>
ERProcessName ->
Rational ->
Int ->
ra ->
ERProcess sInAnyProt sOutAnyProt
rateRsProcess defName desiredImpr maxAttepts sampleRA =
rateProcess defName goodEnough maxAttepts chtpRsC
where
chtpRsC = chTChanges $ chTIx $ chTList chtpRNoIx
chtpRNoIx = chTReal sampleRA
goodEnough _ QAChangesAGivenUp = True
goodEnough QAChangesAGivenUp _ = True
goodEnough
(QAChangesANew (QAIxA (QAListA prevAs)))
(QAChangesANew (QAIxA (QAListA newAs))) =
case RA.compareReals (impr) (fromRational desiredImpr) of
Just LT -> False
_ -> True
where
impr = foldl max 1 $ zipWith getImprAs prevAs newAs
getImprAs (QARealA prevRA) (QARealA newRA) =
snd $ RA.intersectMeasureImprovement 20 prevRA newRA
where
_ = prevRA == sampleRA