{-|
    Module      :  Control.ERNet.Blocks.RnToRm.Basic
    Description :  basic processes for function enclosures
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable

    A few processes universally useful when representing (1st-order) real functions
    as single data entities via 'FA.ERFnDomApprox'.   
-}
module Control.ERNet.Blocks.RnToRm.Basic 
(
    boundingProcess,
    integrateFAProcess,
    integrateIsectMeasureFAProcess,
    applyFieldProcess,
    joinFADomProcess,
    splitFADomProcess,
    rateFnProcess,
    getEndpointValsProcess,
    maxOverDomProcess
)
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.RnToRm.Protocols
import Control.ERNet.Blocks.Real.Protocols
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.BasicTypes
-- import Misc

import qualified Data.Number.ER.RnToRm.BisectionTree as BISTR

import qualified Text.Html as H

import Data.Typeable
import Data.Maybe

import qualified Data.Map as Map

import Control.Concurrent as Concurrent
import Control.Concurrent.STM as STM
import Data.Number.ER.MiscSTM


{-|
    A pass-through process for first order real functions with effort index 
    that is almost equal to the identity.
    
    It restricts the function's graph at certain given intervals
    to the given boxes.
-}
boundingProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    Bool {-^ should use channel cache? -} ->
    ERProcessName -> 
    ChannelType->
    fa {-^ sample approximation to aid typechecking -} ->
    EffortIndex 
        {- ^ below this threshold precision do not pass the query through 
             if it can be answered via the bounds -} ->
    [(domra, ranra)]
        {- ^ one bounding box for each order of derivative -} ->
    ERProcess sInAnyProt sOutAnyProt
boundingProcess useCache name chtp sampleFA thrsIx bounds =
    maybePassThroughProcess useCache name noPass makeAnswer id adjustAnswer chtp chtp
    where
    noPass (QAIxQ ix qry) =
        (ix < thrsIx) && (qryInBounds qry)
    boundsExt = 
        bounds ++ (repeat (RA.bottomApprox, RA.bottomApprox))
    qryInBounds qry =
        and $
        (map (\(r,b) -> r `RA.refines` b) $ zip regions $ map fst boundsExt)
        where
        regions = 
            case qry of 
                (QAFn1QPt xB) -> DBox.elems xB
                (QAFn1QDom dB) -> DBox.elems dB
                (QAFn1QAll) -> [RA.bottomApprox]
    makeAnswer (QAIxQ ix qry) =
        QAIxA $ case qry of
            (_) | False -> QAFn1A sampleFA -- never happens, only here to unify "fa" types 
            (QAFn1QPt xB) -> QAFn1APt $ [bound0]
            (QAFn1QDom dB) -> QAFn1A $ boundFA
            (QAFn1QAll) -> QAFn1A $ boundFA
            where
            (dom0, bound0) = head boundsExt
            boundFA =  
                FA.partialIntersect
                    ix 
                    (DBox.unary dom0) (FA.const DBox.noinfo [bound0])
                    (FA.const DBox.noinfo [RA.bottomApprox]) 
    adjustAnswer qry ans = ans
{-            
    adjustAnswer qry ans =
        case (chqryType qry,ans) of
            (ChQryDeriv n, ChAnsDeriv ra) ->
                ChAnsDeriv $ bound (boundsExt !! n, ra)
            (ChQryDerivsUpTo n, ChAnsDerivs ras) ->
                ChAnsDerivs $ map bound $ zip boundsExt ras
            _ -> error "type mismatch in boundingProcess query"
        where
        [region] = chqryArgNums qry
        bound ((domRA, imgRA), ra)
            | region `RA.refines` domRA = ra /\ imgRA
            | otherwise = ra
-}


{-|
    A simple integrator process for first-order linear domain functions 
    with effort index using the default integration 
    of the 'FA.ERFnDomApprox' instance.
-}
integrateFAProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    ERProcessName {-^ process identifier (string) -} ->
    ChannelType {-^ result channel type -} ->
    fa {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
integrateFAProcess defName chtpFn sampleFA =
    ERProcess defName deploy [chtpFn, chtpFn] [chtpFn]
    where
    deploy deployName [valueAtOriginCHA, derivCHA] [resCHA] _ =
        dispatcher
        where
        derivCH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: integrateFAProcess: derivCH:"
                derivCHA 
        valueAtOriginCH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: integrateFAProcess: valueAtOriginCH:"
                valueAtOriginCHA 
        resCH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: integrateFAProcess: resCH:" 
                resCHA 
        
        -- determine channel protocol types:
        _ = [derivCH, valueAtOriginCH]
        _ = CH.answerQuery False resCH (0, QAIxA $ QAFn1A sampleFA)
        
        dispatcher = -- standard code
            do
            qryData <- CH.waitForQuery resCH
            forkIO $ responder qryData
            dispatcher
        responder (resQryId, (QAIxQ ix qry)) =
            do
            derivQryId <- 
                CH.makeQuery resCH resQryId derivCH 
                    (QAIxQ ix $ QAFn1QDom (DBox.unary dom))
            valQryId <- 
                CH.makeQuery resCH resQryId valueAtOriginCH 
                    (QAIxQ ix $ QAFn1QPt (DBox.unary origin))
            (QAIxA (QAFn1APt [val])) <- 
                CH.waitForAnswer resCH resQryId valueAtOriginCH valQryId
            (QAIxA (QAFn1A deriv)) <- 
                CH.waitForAnswer resCH resQryId derivCH derivQryId
            CH.answerQuery False resCH
                (resQryId, QAIxA $ getAns val deriv)
            where
            origin = 0
            dom = 
                case qry of
                    (QAFn1QDom domB) -> 
                        (dom RA.\/ origin)
                        where
                        dom = case DBox.elems domB of [dom] -> dom
                    (QAFn1QAll) -> (RA.bottomApprox)
                    (QAFn1QPt xB) -> (x RA.\/ origin)
                        where
                        x = case DBox.elems xB of [x] -> x
            getAns valRA derivFA =
                case qry of
                    (QAFn1QPt xB) -> QAFn1APt $ FA.eval xB resFA
                    _ -> QAFn1A resFA 
                where
                resFA = FA.integrateUnary ix derivFA dom origin [valRA] 
                             

{-|
    An intersecting and improvement measuring stateful integrator process using 
    default intersecting & measuring integration of the 
    'FA.ERFnDomApprox' instance.
-}
integrateIsectMeasureFAProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    ERProcessName {-^ process identifier (string) -} ->
    fa {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
integrateIsectMeasureFAProcess defName sampleFA =
    ERProcess defName deploy [chtpFn, chtpFnNoIx, chtpRNoIxC] [chtpFnFn]
    where
    chtpFn = chTIx chtpFnNoIx
    chtpFnFn = chTIx $ chTProd chtpFnNoIx chtpFnNoIx
    chtpFnNoIx = chTFn1 sampleFA
    chtpRNoIxC = chTChanges (chTReal sampleRanRA)
    sampleDomRA = 0
    sampleRanRA = head $ FA.eval (DBox.unary sampleDomRA) sampleFA
    deploy deployName [derivCHA, initFnCHA, origCHA] [resCHA] _ =
        do
        dispatcher Nothing Nothing
        where
        derivCH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: integrateIsectMeasureFAProcess: derivCH:"
                derivCHA 
        initFnCH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: integrateIsectMeasureFAProcess: initFnCH:"
                initFnCHA 
        origCH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: integrateIsectMeasureFAProcess: origCH:"
                origCHA 
        resCH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: integrateIsectMeasureFAProcess: resCH:"
                resCHA

        -- determine channel protocol types:
        _ = CH.answerQuery False resCH (0, QAIxA $ QAProdABoth (QAFn1A sampleFA) (QAFn1A sampleFA))
--        _ = CH.answerQuery False resCH (0, QAIxA $ QAProdABoth (QAFn1APt [sampleRanRA]) (QAFn1APt [sampleRanRA]))
--        _ = do
--            (QAIxA (QAFn1A derivFA)) <- CH.waitForAnswer resCH 0 derivCH 0
--            (QAIxA (QAFn1APt [derivRA])) <- CH.waitForAnswer resCH 0 derivCH 0
--            (QAFn1A initFnFA) <- CH.waitForAnswer resCH 0 initFnCH 0
--            (QAFn1APt [initFnRA]) <- CH.waitForAnswer resCH 0 initFnCH 0
--            (QAChangesANew (QARealA origRA)) <- CH.waitForAnswer resCH 0 origCH 0
--            let _ = [sampleFA, derivFA, initFnFA]
--            let _ = [sampleRanRA, derivRA, initFnRA]
--            let _ = [sampleDomRA, origRA]
--            return ()
        
        -- the remaining protocols are determined from the following code
        
        dispatcher maybePrevFA maybeOriginData = -- standard code
            do
            qryData <- CH.waitForQuery resCH
            originData <- case maybeOriginData of
                Nothing -> getFirstOriginData qryData
                Just originData -> return originData
            (newFA, newOriginData) <- responder maybePrevFA originData qryData
            dispatcher (Just newFA) (Just newOriginData)
            
        getFirstOriginData (resQryId, _) =
            do
            originQryId <- 
                CH.makeQuery resCH resQryId origCH (QAChangesQ QARealQ)
            (QAChangesANew (QARealA originRA)) <-
                CH.waitForAnswer resCH resQryId origCH originQryId
            return (originQryId, originRA)
            
        responder maybePrevFA (originQryId, originRA) (resQryId, (QAIxQ ix (QAProdQBoth fnQ imprQ))) =
            do
            -- enquire derivative first because it is likely to take the longest:
            derivQryId <- 
                CH.makeQuery resCH resQryId derivCH (QAIxQ ix fnQ)
            -- now inspect the origin to establish whether it has changed:
            testOriginQryId <-
                CH.makeQuery resCH resQryId origCH (QAChangesQIfNew originQryId QARealQ)
            testOriginAns <-
                CH.waitForAnswer resCH resQryId origCH testOriginQryId
            (updatedOrigin, updatedFA) <- case (testOriginAns, maybePrevFA) of
                (QAChangesASame, Just prevFA)  -> 
                    return (originRA, prevFA) -- no changes
                (QAChangesANew (QARealA updatedOriginRA), Just prevFA) -> -- origin changed
                    do
                    -- need to obtain new approximation to solution (new origin -> new initial values) 
                    initFnQryId <-
                        CH.makeQuery resCH resQryId initFnCH QAFn1QAll
                    (QAFn1A updatedFA) <-
                        CH.waitForAnswer resCH resQryId initFnCH initFnQryId
                    return (updatedOriginRA, updatedFA)
                (_, Nothing) -> -- no previous function
                    do
                    -- need to obtain initial approximation to solution: 
                    initFnQryId <-
                        CH.makeQuery resCH resQryId initFnCH QAFn1QAll 
                    (QAFn1A initialFA) <-
                        CH.waitForAnswer resCH resQryId initFnCH initFnQryId
                    return (originRA, initialFA)
            -- get an approximation of the derivative: 
            (QAIxA (QAFn1A derivFA)) <-
                CH.waitForAnswer resCH resQryId derivCH derivQryId
            -- do the integration:
            let [dom] = DBox.elems (FA.dom derivFA)
                (resFA, imprFA) = 
                     FA.integrateMeasureImprovementUnary 
                        ix derivFA dom updatedOrigin updatedFA
            CH.answerQuery False resCH
                (resQryId, QAIxA $ QAProdABoth (QAFn1A resFA) (QAFn1A imprFA))
            return (resFA, (originQryId, updatedOrigin))

                             
{-|
    Apply a function transformer ((R^m->R^n) -> (R^m->R^n)) to a function (R^m->R^n).
-}
applyFieldProcess ::                
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    ERProcessName {-^ process identifier (string) -} ->
    fa {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
applyFieldProcess defName sampleFA =
    ERProcess defName deploy [chtpFld, chtpFnNoIx] [chtpFn]
    where
    chtpFn = chTIx chtpFnNoIx 
    chtpFnNoIx = chTFn1 sampleFA
    chtpFld = chTFn2 sampleFA
    deploy deployName [fieldCHA, fnCHA] [resCHA] _ =
        dispatcher
        where
        fieldCH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: applyFieldProcess: fieldCH:"
                fieldCHA 
        fnCH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: applyFieldProcess: fnCH:"
                fnCHA
        resCH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: applyFieldProcess: resCH:"
                resCHA
        
        dispatcher = -- standard code
            do
            qryData <- CH.waitForQuery resCH
            forkIO $ responder qryData
            dispatcher
            
        responder (resQryId, (QAIxQ ix qry)) =
            do
            fnQryId <- CH.makeQuery resCH resQryId fnCH qry
            (QAFn1A argFA) <-
                CH.waitForAnswer resCH resQryId fnCH fnQryId
            return $ [sampleFA, argFA] -- unify "fa" from chtpFn and from actual channels
            fieldQryId <- 
                CH.makeQuery resCH resQryId fieldCH (QAIxQ ix (QAFn2QPt argFA))
            (QAIxA (QAFn2APt resFA)) <- 
                CH.waitForAnswer resCH resQryId fieldCH fieldQryId
            CH.answerQuery False resCH (resQryId, QAIxA $ QAFn1A resFA)
            

{-|
    A process joining two functions for adjacent domains 
    to one function on the joint domain.
    
    Each query is split accordingly to two queries on the
    two halves of the bisected domain, respectively.
-}
joinFADomProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    ERProcessName {-^ process identifier (string) -} ->
    fa {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
joinFADomProcess defName sampleFA =
    ERProcess defName deploy [chtpFnC, chtpFnC] [chtpFnC]
    where
    chtpFnC = chTChanges chtpFn
    chtpFn = chTIx chtpFnNoIx
    chtpFnNoIx = chTFn1 sampleFA
    deploy deployName [fn1CHA, fn2CHA] [resCHA] _ =
        dispatcher
        where
        fn1CH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: joinFADomProcess: fn1CH:"
                fn1CHA
        fn2CH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: joinFADomProcess: fn2CH:"
                fn2CHA
        resCH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: joinFADomProcess: resCH:"
                resCHA
                
        _ = CH.answerQuery False resCH (0, QAChangesANew $ QAIxA $ QAFn1A sampleFA)
        
        dispatcher = -- standard code
            do
            qryData <- CH.waitForQuery resCH
            forkIO $ responder qryData
            dispatcher
            
        responder (resQryId, (QAChangesQWhenNew _ (QAIxQ ix qry))) =
            do
            fnQryId1 <- CH.makeQuery resCH resQryId fn1CH (QAChangesQWhenNew 0 $ QAIxQ ix qry1)
            fnQryId2 <- CH.makeQuery resCH resQryId fn2CH (QAChangesQWhenNew 0 $ QAIxQ ix qry2)
            ans1 <-
                CH.waitForAnswer resCH resQryId fn1CH fnQryId1
            ans2 <- 
                CH.waitForAnswer resCH resQryId fn2CH fnQryId2
            case (ans1, ans2) of
                (QAChangesANew (QAIxA (QAFn1A fa1)), 
                 QAChangesANew (QAIxA (QAFn1A fa2))) ->                    
                    CH.answerQuery False resCH 
                        (resQryId, 
                         QAChangesANew $ QAIxA $ QAFn1A $ FA.unBisect defaultVar (fa1,fa2))
                _ -> CH.answerQuery False resCH (resQryId, QAChangesAGivenUp)
            where
            (qry1, qry2) =
                case qry of
                    QAFn1QAll -> 
                        (QAFn1QAll, QAFn1QAll)
                    QAFn1QDom domB -> 
                        (QAFn1QDom (DBox.unary dom1), QAFn1QDom (DBox.unary dom2))
                        where
                        (dom1, dom2) = RA.bisectDomain Nothing dom
                        [dom] = DBox.elems domB

{-|
    A process splitting a function into two based on a bisection of the domain.
    
    A query for either half of the function results in a query for the whole.
    The whole function is then cached to answer an analogous query for the second half.
    Only one such result is cached (always the last one).  
-}
splitFADomProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    ERProcessName {-^ process identifier (string) -} ->
    fa {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
splitFADomProcess defName sampleFA =
    ERProcess defName deploy [chtpFnNoIx] [chtpFnNoIx, chtpFnNoIx]
    where
    chtpFnNoIx = chTFn1 sampleFA
    deploy deployName [fnCHA] [res1CHA, res2CHA] _ =
        dispatcher Nothing
        where
        fnCH = 
            CH.castIn "ERNet.Blocks.RnToRm.Basic: splitFADomProcess: fnCH:"
                fnCHA
        res1CH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: splitFADomProcess: res1CH:"
                res1CHA
        res2CH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: splitFADomProcess: res2CH:"
                res2CHA
                
        _ = do
            (QAFn1A fnFA) <- CH.waitForAnswer res1CH 0 fnCH 0
            let _ = [sampleFA, fnFA]
            return ()
        
        dispatcher maybeFnSideQry =
            do
            (chN, (resQryId, QueryAnyProt qry)) <- CH.waitForQueryMulti [res1CHA, res2CHA]
            -- explore the history and see whether the answer is already known
            (maybeAnsFA, updatedMaybeFnSideQry) <- case (maybeFnSideQry, cast qry) of
                (Just (fnFA, prevN, prevQry), Just newQry)
                    | chN /= prevN && prevQry == newQry -> -- got it!
                        return (Just $ getHalfFA chN fnFA, Nothing)
                (_, Just qry) -> -- nope, need to get the function again
                    do
                    fnQryId <- CH.makeQuery (resCH chN) resQryId fnCH qry -- assuming QAFn1QAll
                    ans <- CH.waitForAnswer (resCH chN) resQryId fnCH fnQryId
                    return $
                        case ans of
                            (QAFn1A fullFA) ->
--                            QAChangesAGivenUp -> 
--                                (Nothing, Nothing)
--                            QAChangesANew (QAIxA (QAFn1A fullFA)) ->
                                (Just $ getHalfFA chN fullFA, Just (fullFA, chN, qry))
            -- answer original query
            CH.answerQuery False (resCH chN) (resQryId, makeAns maybeAnsFA)
            dispatcher updatedMaybeFnSideQry
            where
            resCH chN = [res1CH, res2CH] !! chN
            
--        makeAns Nothing = QAChangesAGivenUp
        makeAns (Just resFA) =
--            QAChangesANew (QAIxA (QAFn1A resFA))
            QAFn1A resFA
        getHalfFA chN fullFA =
            ([fst, snd] !! chN) $ FA.bisect defaultVar Nothing fullFA

            
{-|
    A process passing on information about a real function, trying to improve the
    convergence rate in successive queries.
    
    Each query may refer to a previous query.  When it does,
    the query will not be answered until either:
    
    * the information about the function has improved by the desired amount since last time 
    
    * the number of queries made in response to this query has reached the given limit
-}
rateFnProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    ERProcessName {-^ process identifier (string) -} ->
    Rational {-^ desired ratio of improvement -} ->
    Int {-^ maximum number of attempts to reach desired improvement -} ->
    fa {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
rateFnProcess defName desiredImpr maxAttepts sampleFA =
    rateProcess defName goodEnough maxAttepts chtpFnC
    where
    chtpFnC = chTChanges chtpFn
    chtpFn = chTIx chtpFnNoIx
    chtpFnNoIx = chTFn1 sampleFA
    goodEnough _ QAChangesAGivenUp = True
    goodEnough QAChangesAGivenUp _ = True
    goodEnough
        (QAChangesANew (QAIxA (QAFn1A prevFA))) 
        (QAChangesANew (QAIxA (QAFn1A newFA))) =
            case RA.compareReals (impr) (fromRational desiredImpr) of
                Just LT -> False 
                _ -> True
            where
            (_, impr) = FA.intersectMeasureImprovement 20 prevFA newFA
            _ = prevFA == sampleFA

            
{-|
    A process passing on information about the values of a real function 
    at its domain endpoints.  
    
    Protocols are wrapped in 'ChannelComm.ChTChanges' 
    in order to be able to communicate failure.
-}
getEndpointValsProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    ERProcessName {-^ process identifier (string) -} ->
    fa {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
getEndpointValsProcess defName sampleFA =
    ERProcess defName deploy [chtpFnC, chtpFnNoIx] [chtpRsC, chtpRsC]
    where
    chtpFnC = chTChanges chtpFn
    chtpFn = chTIx chtpFnNoIx
    chtpFnNoIx = chTFn1 sampleFA
    chtpRNoIxC = chTChanges (chTReal sampleRanRA)
    sampleDomRA = 0
    sampleRanRA = head $ FA.eval (DBox.unary sampleDomRA) sampleFA
    chtpRsC = chTChanges $ chTIx $ chTList $ chTReal sampleRanRA
    deploy _ [fnCHA, fastFnCHA] [res1CHA, res2CHA] _ =
        do
        dispatcher Nothing
        where
        fnCH =
            CH.castIn "ERNet.Blocks.RnToRm.Basic: getEndpointValsProcess: fnCH:"
                fnCHA
        fastFnCH =
            CH.castIn "ERNet.Blocks.RnToRm.Basic: getEndpointValsProcess: fastFnCH:"
                fastFnCHA
        res1CH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: getEndpointValsProcess: res1CH:"
                res1CHA
        res2CH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: getEndpointValsProcess: res2CH:"
                res2CHA
        _ = do
            (QAChangesANew (QAIxA (QAFn1A fnFA))) <- CH.waitForAnswer res1CH 0 fnCH 0
            (QAFn1A fastFnFA) <- CH.waitForAnswer res1CH 0 fastFnCH 0
            let _ = [sampleFA, fnFA, fastFnFA]
            return ()

        dispatcher maybeEndpoints =
            do
            (chN, qryData) <- CH.waitForQueryMulti [res1CHA, res2CHA]
            endPoints <- case maybeEndpoints of
                Just endPoints -> return endPoints
                Nothing -> obtainEndpoints qryData ([res1CH, res2CH] !! chN)
            case chN of
                0 -> forkIO $ responder qryData (fst endPoints) res1CH
                1 -> forkIO $ responder qryData (snd endPoints) res2CH
            dispatcher (Just endPoints)
            
        obtainEndpoints qryData@(resQryId, _) resCH =
            do
            fnQryId <- CH.makeQuery resCH resQryId fastFnCH QAFn1QAll
            (QAFn1A fa) <- CH.waitForAnswer resCH resQryId fastFnCH fnQryId
            let [dom] = DBox.elems $ FA.dom fa
            return $ RA.bounds dom
            
        responder (resQryId, (QueryAnyProt qry)) endPoint resCH =
            do
            fnQryId <- CH.makeQuery resCH resQryId fnCH fnQry
            fnAns <- CH.waitForAnswer resCH resQryId fnCH fnQryId
            let ans = case fnAns of
                        QAChangesAGivenUp -> 
                            QAChangesAGivenUp
                        QAChangesANew (QAIxA (QAFn1APt vals)) -> 
                            QAChangesANew $ QAIxA $ QAListA $ map QARealA vals
            CH.answerQuery False resCH (resQryId, ans)
            where
            Just (QAChangesQWhenNew _ (QAIxQ ix (QAListQAllHomog (QARealQ)))) = cast qry
            fnQry = 
                QAChangesQWhenNew 0 $ 
                    QAIxQ ix $ QAFn1QPt (DBox.unary endPoint)
                     

{-|
    A process passing on information about the values of a real function 
    over a fixed domain.
    
    Protocols are wrapped in 'ChannelComm.ChTChanges' 
    in order to be able to communicate failure.
-}
maxOverDomProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     FA.ERFnDomApprox box varid domra ranra fa,
     Typeable box, Typeable fa, Show box, H.HTML fa,
     RAEL.ERApproxElementary domra, RAEL.ERApproxElementary ranra,
     Typeable domra, Typeable ranra) =>
    ERProcessName {-^ process identifier (string) -} ->
    box {-^ domain over which to search for maximum -} ->
    fa {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
maxOverDomProcess defName dom sampleFA =
    ERProcess defName deploy [chtpFnNoIx] [chtpRNoIx]
    where
    chtpFnNoIx = chTFn1 sampleFA
    chtpRNoIx = chTReal sampleRanRA
    sampleDomRA = 0
    sampleRanRA = head $ FA.eval (DBox.unary sampleDomRA) sampleFA
    deploy _ [fnCHA] [resCHA] _ =
        do
--        activePartitionTV <-
--            atomically $ newTVar $ 
--                (False, BISTR.const domC (Just RA.bottomApprox))
--        dispatcher activePartitionTV
        dispatcher (RA.bottomApprox, BISTR.const dom (Just RA.bottomApprox))
        where
        fnCH =
            CH.castIn "ERNet.Blocks.RnToRm.Basic: maxOverDomProcess: fnCH:"
                fnCHA
        resCH = 
            CH.castOut "ERNet.Blocks.RnToRm.Basic: maxOverDomProcess: resCH:"
                resCHA

--        _ = CH.answerQuery False fnCH (0, QAIxA $ QAFn1A sampleFA)
        _ = CH.answerQuery False resCH (0, QARealA sampleRanRA)
        _ = do
            (QAFn1A fnFA) <- CH.waitForAnswer resCH 0 fnCH 0
            let _ = [sampleFA, fnFA]
            return ()
        
        dispatcher (prevResult, prevBistr) =
            do
            qryData <- CH.waitForQuery resCH
--            forkIO $ responder activePartitionTV qryData
            (newResult, newBistr) <- responder (prevResult, prevBistr) qryData
            dispatcher (newResult, newBistr)
            
        responder (prevResult, prevBistr) qryData@(qryId, qry) =
            do
--            atomically $ getLock activePartitionTV
--            (_, oldBistr) <- atomically $ readTVar activePartitionTV
            splitBistr <- BISTR.doMapLeaves (processLeaf qryId) Nothing prevBistr
            let (newBistr, newResult) = normalisePartition prevResult splitBistr
            CH.answerQuery False resCH (qryId, QARealA newResult) 
            return (newResult, newBistr) 
--            atomically $ writeTVar activePartitionTV (True, newBistr)  
--            atomically $ releaseLock activePartitionTV
            
        -- ignore a segment that we have marked as ruled out: 
        processLeaf _ bistr@(BISTR.Leaf _ _ Nothing) = 
            return bistr 
        -- split a segment that we have not yet ruled out: 
        processLeaf resQryId bistr@(BISTR.Leaf depth dom (Just b)) =
            do
            domLOQryId <- 
                CH.makeQuery resCH resQryId fnCH $ 
                    QAFn1QPt domLO   
            domHIQryId <- 
                CH.makeQuery resCH resQryId fnCH $ 
                    QAFn1QPt domHI
            (QAFn1APt [boundLO]) <-
                CH.waitForAnswer resCH resQryId fnCH domLOQryId
            (QAFn1APt [boundHI]) <-
                CH.waitForAnswer resCH resQryId fnCH domHIQryId
            return $
                BISTR.Node depth dom var pt 
                    (bistrLO { BISTR.bistrVal = Just boundLO }) 
                    (bistrHI { BISTR.bistrVal = Just boundHI })
            where
            (var, pt) = DBox.bestSplit dom
            (domLO, domHI) = DBox.split dom var pt
            BISTR.Node _ _ _ _ bistrLO bistrHI =
                BISTR.split undefined 0 var pt dom bistr

        -- mark all segments that cannot contain maximum
        -- and recompute the current best knowledge about the maximum from the partition: 
        normalisePartition prevQryBound bistr =
            (normalisedBistr, resBound RA./\ prevQryBound)
            where
            resBound = resBoundLO RA.\/ resBoundHI
            (resBoundLO, resBoundHI) = 
                foldl addBound (-1/0, -1/0) $ BISTR.collectValues bistr
                where
                addBound prevBounds Nothing = prevBounds  
                addBound (prevBoundLO, prevBoundHI) (Just newBound) =
                    (max newBoundLO prevBoundLO, max newBoundHI prevBoundHI)
                    where
                    (newBoundLO, newBoundHI) = RA.bounds newBound 
            normalisedBistr = 
                BISTR.mapWithDom removeIrrelevantBound bistr
                where
                removeIrrelevantBound dom Nothing = Nothing
                removeIrrelevantBound dom (Just bound)
                    | boundHI `RA.ltSingletons` resBoundLO = Nothing
                        -- ie this box has to be strictly below the maximum
                    | boundHI `RA.eqSingletons` resBoundLO && boundHI `RA.ltSingletons` resBoundHI = Nothing
                        -- ie the function could potentially reach its maximum in this box 
                        -- but such maximum would be also have to be reached in another box
                        -- (although it is much more likely that the function 
                        --  does not reach its maximum in this box) 
                    | otherwise = Just bound
                    where
                    (_, boundHI) = RA.bounds bound
                       
--        getLock activePartitionTV =
--                do
--                (locked, partition) <- readTVar activePartitionTV
--                case locked of
--                    True -> retry
--                    False -> 
--                        writeTVar activePartitionTV (True, partition) 
--        releaseLock activePartitionTV =
--                do
--                (_, partition) <- readTVar activePartitionTV
--                writeTVar activePartitionTV (False, partition)
--