AERN-Net-0.2.1.1: examples/DemoMax.hs

{-|
    A simple two-process network, one providing
    information about the function (1-4(x-1/2)^2)
    and the other one finding the maximum of
    this function in the interval [0,1].
-}
module Main where

import qualified Control.ERNet.Foundations.Manager as MAN
import qualified Control.ERNet.Foundations.Channel as CH
import qualified Control.ERNet.Foundations.Event.Logger as LG
import Control.ERNet.Foundations.Event.JavaScript

import Control.ERNet.Deployment.Local.Manager

import Control.ERNet.Foundations.Protocol
import Control.ERNet.Foundations.Protocol.StandardCombinators
import Control.ERNet.Foundations.Process

import Control.ERNet.Blocks.Basic
import Control.ERNet.Blocks.Control.Basic
import Control.ERNet.Blocks.Real.Basic
import Control.ERNet.Blocks.Real.Protocols
import Control.ERNet.Blocks.RnToRm.Basic
import Control.ERNet.Blocks.RnToRm.Protocols

import qualified Data.Number.ER.Real.Approx as RA
import qualified Data.Number.ER.RnToRm.Approx as FA
import qualified Data.Number.ER.BasicTypes.DomainBox as DBox
import qualified Data.Number.ER.Real.Approx.Elementary as RAEL
import Data.Number.ER.BasicTypes

import qualified Data.Number.ER.Real.DefaultRepr as RATypes
import qualified Data.Number.ER.RnToRm.DefaultRepr as FATypes


type B = RATypes.BAP
type IRA = RATypes.IRA B
type RA = RATypes.RA B
type FA = FATypes.FAPWP B
type Box a = FATypes.Box a

sampleDomRA = (0 :: RA)
sampleRanRA = (0 :: RA)
sampleFA = (0 :: FA)


waitTillEnd = True 
{- 
    Use the above to produce a HTML+JavaScript document for browsing the trace.
    The fixed HTML page "ernet-trace.html" imports the JavaScript file
    "ernet-trace.js", which is generated by this program.
    
    Instead, you can enable the code below for a continual textual log
    to the standard output.  This can be overwhelming but is the only
    option when the network does not terminate correctly.
-}
--waitTillEnd = False

main = 
    do
    RA.initialiseBaseArithmetic (0 :: RA)
    (ernetManager, _) <- MAN.new "main"
    let _ = ernetManager :: ManagerLocal
    logger <- runTheNet ernetManager waitTillEnd
    case waitTillEnd of
        True ->
            do
            events <- LG.emptyAndGetEvents logger
            writeFile "ernet-trace.js" $ constructJS events
        False ->
            LG.emptyAndDo logger $ 
                putStrLn . show

runTheNet = runMaxFn

runMaxFn ::
    (MAN.Manager man lg sIn sOut sInAnyProt sOutAnyProt) =>
    man ->
    Bool ->
    IO lg
runMaxFn ernetManager waitTillEnd =
    MAN.runDialogue 
        ernetManager
        maxFnProcess
        maxFnSockN
        maxFnSockT
        maxFnDialogue
        waitTillEnd

maxFnDialogue makeQueryGetAnswer =
    do
    mapM (doQuerySol) [1..8]
    return ()
    where
    doQuerySol ix =
        do
        a <- makeQueryGetAnswer $ QARealQ
        let _ = [a, QARealA sampleRanRA]
        return ()

maxFnSockT = chTReal (0 :: RA)
maxFnSockN = 0

maxFnProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt) =>
    ERProcess sInAnyProt sOutAnyProt
maxFnProcess =
    subnetProcess
        "MAX-FN"
        [] -- input sockets
        [(chTReal sampleDomRA, maxN)] -- output sockets
        -- sub-processes:
        [
         (constantProcess "FN" answerFn (chTFn1 sampleFA)
         ,([],    [fnN]))
        ,
         (maxOverDomProcess "MAX" (DBox.unary $ 0 RA.\/ 1) sampleFA
         ,([fnN],    [maxN]))
        ]
    where
    maxN : fnN
        : _ = [0..]
    answerFn _ | False = QAFn1A sampleFA -- clarify the type
    answerFn qry =
        makeAnswerFn1ByBoxesNoIx computeFnBounds qry
    computeFnBounds domB =
        [1 - 4*(dom - 0.5)^2]
        where
        [dom] = DBox.elems domB
        _ = [sampleDomRA, dom]