AERN-Net 0.2.1 → 0.2.1.1
raw patch · 15 files changed
+390/−383 lines, 15 filesdep ~AERN-Realdep ~AERN-RnToRmdep ~binaryPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: AERN-Real, AERN-RnToRm, binary
API changes (from Hackage documentation)
Files
- AERN-Net.cabal +11/−7
- ChangeLog +1/−0
- examples/DemoMax.hs +133/−0
- examples/DemoSqrt.hs +147/−0
- examples/ernet-trace.html +69/−0
- src/Control/ERNet/Blocks/Basic.hs +1/−1
- src/Control/ERNet/Blocks/Control/Basic.hs +3/−1
- src/Control/ERNet/Blocks/Real/LFT.hs +7/−7
- src/Control/ERNet/Blocks/RnToRm/Basic.hs +14/−14
- src/Control/ERNet/Blocks/RnToRm/Protocols.hs +2/−2
- src/Control/ERNet/Deployment/Local/Channel.hs +1/−1
- src/Control/ERNet/Foundations/Process.hs +1/−1
- tests/DemoMax.hs +0/−133
- tests/DemoSqrt.hs +0/−147
- tests/ernet-trace.html +0/−69
AERN-Net.cabal view
@@ -1,12 +1,13 @@ Name: AERN-Net-Version: 0.2.1+Version: 0.2.1.1 Cabal-Version: >= 1.2 Build-Type: Simple License: BSD3 License-File: LICENCE Author: Michal Konecny (Aston University)-Copyright: (c) 2007-2008 Michal Konecny-Maintainer: mik@konecny.aow.cz+Copyright: (c) 2007-2009 Michal Konecny+Maintainer: mikkonecny@gmail.com+Homepage: http://www-users.aston.ac.uk/~konecnym/DISCERN Stability: experimental Category: Math, Distributed Computing Synopsis: Compositional lazy dataflow networks for exact real number computation@@ -35,16 +36,19 @@ paper <http://www-users.aston.ac.uk/~konecnym/papers/ernets08-draft.html>. . Simple examples of usage can be found in modules @DemoMax@ and @DemoSqrt@ - in folder @tests@.+ in folder @examples@. Extra-source-files:- tests/DemoMax.hs tests/DemoSqrt.hs tests/ernet-trace.html src/ernet-trace.html-Data-files:+ examples/DemoMax.hs examples/DemoSqrt.hs examples/ernet-trace.html+ src/ernet-trace.html ChangeLog Library hs-source-dirs: src Build-Depends:- base >= 3, base < 4, containers, binary >= 0.4, html, time, stm, AERN-Real >= 0.9.9, AERN-RnToRm >= 0.4.9+ base >= 3, base < 4,+ containers, binary, html, time, stm,+ AERN-Real >= 0.10, AERN-Real < 0.10.1,+ AERN-RnToRm >= 0.5, AERN-RnToRm < 0.5.1 Exposed-modules: Control.ERNet.Deployment.Local.Manager, Control.ERNet.Deployment.Local.Logger,
ChangeLog view
@@ -1,3 +1,4 @@+0.2.1.1: 29 July 2009: adapted to the latest AERN-Real, AERN-RnToRm 0.2.1: 23 February 2009 * Added support for linear fractional transformation (LFT) real number representation of Potts & Edalat (1997) and added some simple processes that work with it.
+ examples/DemoMax.hs view
@@ -0,0 +1,133 @@+{-|+ 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]++
+ examples/DemoSqrt.hs view
@@ -0,0 +1,147 @@+{-|+ A simple exact real number network, computing the+ square root of 2 using the continued fraction expansion+ of sqrt(x).+-}+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 qualified Data.Number.ER.Real.Approx as RA+import Data.Number.ER.BasicTypes++import qualified Data.Number.ER.Real.DefaultRepr as RATypes+++type B = RATypes.BAP+type IRA = RATypes.IRA B+type RA = RATypes.RA B++sampleRA = (0 :: RA)++chtpR = chTIx $ chTReal sampleRA++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++runTheNet = runSqrtIx++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++runSqrtIx ::+ (MAN.Manager man lg sIn sOut sInAnyProt sOutAnyProt) =>+ man ->+ Bool ->+ IO lg+runSqrtIx ernetManager waitTillEnd =+ MAN.runDialogue + ernetManager+ sqrtProcess+ sqrtSockN+ sqrtSockT+ sqrtDialogue+ waitTillEnd++sqrtDialogue makeQueryGetAnswer =+ do+ mapM doQuerySol [3..12]+ return ()+ where+ doQuerySol ix =+ do+ a <- makeQueryGetAnswer $ QAIxQ ix $ QARealQ+ let _ = [a, (QAIxA $ QARealA sampleRA)]+ return ()++sqrtSockT = chtpR+sqrtSockN = 0++sqrtProcess ::+ (CH.Channel sIn sOut sInAnyProt sOutAnyProt) =>+ ERProcess sInAnyProt sOutAnyProt+sqrtProcess =+ subnetProcess+ "SQRT"+ [] -- input sockets+ [(chtpR, resN)] -- output sockets+ -- sub-processes:+ [+ (constantProcess "A" (makeAnswerR (\ix -> RA.setMinGranularityOuter (2 * (effIx2gran ix) + 10) (2::RA))) chtpR+ ,([], [aN])+ )+ ,+ (passThroughProcess False "A-1" + id (\ _ (QAIxA (QARealA r)) -> (QAIxA $ QARealA $ (r::RA) - 1)) + chtpR chtpR+ ,([aN], [aM1N])+ )+ ,+ (passThroughProcess False "X+1" + id (\ _ (QAIxA (QARealA r)) -> (QAIxA $ QARealA $ (r::RA) + 1)) + chtpR chtpR+ ,([resN], [resP1N])+ )+ ,+ (passThroughBinaryProcess False "(A-1)/(X+1)"+ (\ qry -> (qry,qry)) + (\ _ ((QAIxA (QARealA num)), (QAIxA (QARealA den))) -> (QAIxA $ QARealA $ (num::RA) / den)) + (chtpR, chtpR) chtpR+ ,([aM1N, resP1N], [resM1N])+ )+ ,+ (passThroughProcess False "(A-1)/(X+1) + 1" + id (\ _ (QAIxA (QARealA r)) -> (QAIxA $ QARealA $ (r::RA) + 1)) + chtpR chtpR+ ,([resM1N], [resCycleN])+ )+ ,+ (constantProcess "[0,oo]" + (\(QAIxQ _ QARealQ) -> (QAIxA $ QARealA $ ((max 0 RA.bottomApprox)::RA))) chtpR+ ,([], [resInitN])+ )+ ,+ (improverIxSimpleProcess "IMPR"+ chtpR+ (QARealA (0::RA))+ ,([resInitN, resCycleN], [resN])+ )+ ]+ where+ resN : resInitN : resCycleN : resM1N : resP1N : aM1N : aN+ : _ = [0..]
+ examples/ernet-trace.html view
@@ -0,0 +1,69 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html>+<head>+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">+<title>Trace of APNet</title>++<script src="ernet-trace.js"></script>++<script type="text/javascript">+function ndRef(nodeNumber, nodeName)+{+ return "<td class=\"noderef\" onclick=\"setQ(" + nodeNumber + ")\">" + nodeName + "</td>";+}+function setQ(queryNumber)+{+ var t = document.getElementById("queryTable");+ t.innerHTML = "";+ + t.insertRow(0);+ t.rows[0].innerHTML = getRow(queryNumber);+ t.rows[0].className = "mainrow";+ t.rows[0].cells[2].className = "maincell";+ + t.insertRow(1); // separator+ t.rows[1].className = "seprow";+ t.rows[1].innerHTML = "<td height=\"1ex\" colspan=\"3\"> the above answer was deduced using the following queries: </td>";+ + var childrenQueries = getChildren(queryNumber);+ var i;+ + for (i=0; i<childrenQueries.length; i++)+ {+ t.insertRow(i+2);+ t.rows[i+2].innerHTML = getRow(childrenQueries[i]);+ }+}+</script>++<style type="text/css">+.noderef+{+ background-color: #dbb;+}+.mainrow+{+} +.seprow+{+ background-color: #d76;+} +.maincell+{+ background-color: #89b;+} +</style>++</head>++<body>++<h1 id="title">Trace of APNet:</h1>++<table id="queryTable" cellpadding="10">+</table>++<script type="text/javascript">setQ(2);</script>++</body>+</html>
src/Control/ERNet/Blocks/Basic.hs view
@@ -40,7 +40,7 @@ import Control.Concurrent as Concurrent import Control.Concurrent.STM as STM-import Data.Number.ER.MiscSTM+import Data.Number.ER.Misc.STM {-| A generic stateless process with no inputs.
src/Control/ERNet/Blocks/Control/Basic.hs view
@@ -31,7 +31,7 @@ import Control.Concurrent as Concurrent import Control.Concurrent.STM as STM-import Data.Number.ER.MiscSTM+import Data.Number.ER.Misc.STM import Data.Typeable @@ -87,8 +87,10 @@ -- explore the kind of query: case qry of QAChangesQWhenNew _ _ ->+ do -- add this query to the pending list: atomically $ modifyTVar stateTV $ (:) qryData+ return () QAChangesQ (QAIxQ ix q) -> do -- forward and answer this immediately:
src/Control/ERNet/Blocks/Real/LFT.hs view
@@ -415,7 +415,7 @@ || (ra `RA.refines` ((-infty) RA.\/ rRA)) where- infty = 1/0+ infty = RA.plusInfinity {-| Work out what interval is the image of the lft when all@@ -448,8 +448,8 @@ ExtInterval ratio ratio where ratio = aRA / bRA - aRA = RA.setMinGranularity gran $ fromInteger a - bRA = RA.setMinGranularity gran $ fromInteger b + aRA = RA.setMinGranularityOuter gran $ fromInteger a + bRA = RA.setMinGranularityOuter gran $ fromInteger b [b, a] = map snd $ Map.toAscList coeffs {-|@@ -470,10 +470,10 @@ where ratioL = bRA / dRA ratioR = aRA / cRA - aRA = RA.setMinGranularity gran $ fromInteger a - bRA = RA.setMinGranularity gran $ fromInteger b - cRA = RA.setMinGranularity gran $ fromInteger c - dRA = RA.setMinGranularity gran $ fromInteger d+ aRA = RA.setMinGranularityOuter gran $ fromInteger a + bRA = RA.setMinGranularityOuter gran $ fromInteger b + cRA = RA.setMinGranularityOuter gran $ fromInteger c + dRA = RA.setMinGranularityOuter gran $ fromInteger d [d, c, b, a] = map snd $ Map.toAscList coeffs det = a * d - b * c
src/Control/ERNet/Blocks/RnToRm/Basic.hs view
@@ -37,8 +37,8 @@ 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 qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox) import Data.Number.ER.BasicTypes -- import Misc @@ -53,7 +53,7 @@ import Control.Concurrent as Concurrent import Control.Concurrent.STM as STM-import Data.Number.ER.MiscSTM+import Data.Number.ER.Misc.STM {-|@@ -170,7 +170,7 @@ derivQryId <- CH.makeQuery resCH resQryId derivCH (QAIxQ ix $ QAFn1QDom (DBox.unary dom))- valQryId <- + valQryId <- CH.makeQuery resCH resQryId valueAtOriginCH (QAIxQ ix $ QAFn1QPt (DBox.unary origin)) (QAIxA (QAFn1APt [val])) <- @@ -645,7 +645,7 @@ box {-^ domain over which to search for maximum -} -> fa {-^ sample approximation to aid typechecking -} -> ERProcess sInAnyProt sOutAnyProt-maxOverDomProcess defName dom sampleFA =+maxOverDomProcess defName domB sampleFA = ERProcess defName deploy [chtpFnNoIx] [chtpRNoIx] where chtpFnNoIx = chTFn1 sampleFA@@ -658,7 +658,7 @@ -- atomically $ newTVar $ -- (False, BISTR.const domC (Just RA.bottomApprox)) -- dispatcher activePartitionTV- dispatcher (RA.bottomApprox, BISTR.const dom (Just RA.bottomApprox))+ dispatcher (RA.bottomApprox, BISTR.const domB (Just RA.bottomApprox)) where fnCH = CH.castIn "ERNet.Blocks.RnToRm.Basic: maxOverDomProcess: fnCH:"@@ -696,7 +696,7 @@ 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)) =+ processLeaf resQryId bistr@(BISTR.Leaf depth domB (Just b)) = do domLOQryId <- CH.makeQuery resCH resQryId fnCH $ @@ -709,14 +709,14 @@ (QAFn1APt [boundHI]) <- CH.waitForAnswer resCH resQryId fnCH domHIQryId return $- BISTR.Node depth dom var pt + BISTR.Node depth domB 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+ (var, (_,pt)) = DBox.bestSplit domB+ (domLO, domHI) = DBox.split domB var (Just pt) BISTR.Node _ _ _ _ bistrLO bistrHI =- BISTR.split undefined 0 var pt dom bistr+ BISTR.split undefined 0 var pt domB bistr -- mark all segments that cannot contain maximum -- and recompute the current best knowledge about the maximum from the partition: @@ -725,7 +725,7 @@ where resBound = resBoundLO RA.\/ resBoundHI (resBoundLO, resBoundHI) = - foldl addBound (-1/0, -1/0) $ BISTR.collectValues bistr+ foldl addBound (-RA.plusInfinity, -RA.plusInfinity) $ BISTR.collectValues bistr where addBound prevBounds Nothing = prevBounds addBound (prevBoundLO, prevBoundHI) (Just newBound) =@@ -735,8 +735,8 @@ normalisedBistr = BISTR.mapWithDom removeIrrelevantBound bistr where- removeIrrelevantBound dom Nothing = Nothing- removeIrrelevantBound dom (Just bound)+ removeIrrelevantBound domB Nothing = Nothing+ removeIrrelevantBound domB (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
src/Control/ERNet/Blocks/RnToRm/Protocols.hs view
@@ -25,8 +25,8 @@ 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 qualified Data.Number.ER.BasicTypes.DomainBox as DBox+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBox, DomainIntBox) import Data.Number.ER.Misc import Data.Number.ER.BasicTypes
src/Control/ERNet/Deployment/Local/Channel.hs view
@@ -30,7 +30,7 @@ import Control.Concurrent as Concurrent import Control.Concurrent.STM-import Data.Number.ER.MiscSTM+import Data.Number.ER.Misc.STM --import System.Time import Data.Time.Clock
src/Control/ERNet/Foundations/Process.hs view
@@ -36,7 +36,7 @@ import Control.Concurrent as Concurrent import Control.Concurrent.STM as STM-import Data.Number.ER.MiscSTM+import Data.Number.ER.Misc.STM import qualified Data.Map as Map import Data.Maybe
− tests/DemoMax.hs
@@ -1,133 +0,0 @@-{-|- 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.Real.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]--
− tests/DemoSqrt.hs
@@ -1,147 +0,0 @@-{-|- A simple exact real number network, computing the- square root of 2 using the continued fraction expansion- of sqrt(x).--}-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 qualified Data.Number.ER.Real.Approx as RA-import Data.Number.ER.BasicTypes--import qualified Data.Number.ER.Real.DefaultRepr as RATypes---type B = RATypes.BAP-type IRA = RATypes.IRA B-type RA = RATypes.RA B--sampleRA = (0 :: RA)--chtpR = chTIx $ chTReal sampleRA--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--runTheNet = runSqrtIx--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--runSqrtIx ::- (MAN.Manager man lg sIn sOut sInAnyProt sOutAnyProt) =>- man ->- Bool ->- IO lg-runSqrtIx ernetManager waitTillEnd =- MAN.runDialogue - ernetManager- sqrtProcess- sqrtSockN- sqrtSockT- sqrtDialogue- waitTillEnd--sqrtDialogue makeQueryGetAnswer =- do- mapM doQuerySol [3..12]- return ()- where- doQuerySol ix =- do- a <- makeQueryGetAnswer $ QAIxQ ix $ QARealQ- let _ = [a, (QAIxA $ QARealA sampleRA)]- return ()--sqrtSockT = chtpR-sqrtSockN = 0--sqrtProcess ::- (CH.Channel sIn sOut sInAnyProt sOutAnyProt) =>- ERProcess sInAnyProt sOutAnyProt-sqrtProcess =- subnetProcess- "SQRT"- [] -- input sockets- [(chtpR, resN)] -- output sockets- -- sub-processes:- [- (constantProcess "A" (makeAnswerR (\ix -> RA.setMinGranularity (2 * (effIx2gran ix) + 10) (2::RA))) chtpR- ,([], [aN])- )- ,- (passThroughProcess False "A-1" - id (\ _ (QAIxA (QARealA r)) -> (QAIxA $ QARealA $ (r::RA) - 1)) - chtpR chtpR- ,([aN], [aM1N])- )- ,- (passThroughProcess False "X+1" - id (\ _ (QAIxA (QARealA r)) -> (QAIxA $ QARealA $ (r::RA) + 1)) - chtpR chtpR- ,([resN], [resP1N])- )- ,- (passThroughBinaryProcess False "(A-1)/(X+1)"- (\ qry -> (qry,qry)) - (\ _ ((QAIxA (QARealA num)), (QAIxA (QARealA den))) -> (QAIxA $ QARealA $ (num::RA) / den)) - (chtpR, chtpR) chtpR- ,([aM1N, resP1N], [resM1N])- )- ,- (passThroughProcess False "(A-1)/(X+1) + 1" - id (\ _ (QAIxA (QARealA r)) -> (QAIxA $ QARealA $ (r::RA) + 1)) - chtpR chtpR- ,([resM1N], [resCycleN])- )- ,- (constantProcess "[0,oo]" - (\(QAIxQ _ QARealQ) -> (QAIxA $ QARealA $ ((max 0 RA.bottomApprox)::RA))) chtpR- ,([], [resInitN])- )- ,- (improverIxSimpleProcess "IMPR"- chtpR- (QARealA (0::RA))- ,([resInitN, resCycleN], [resN])- )- ]- where- resN : resInitN : resCycleN : resM1N : resP1N : aM1N : aN- : _ = [0..]
− tests/ernet-trace.html
@@ -1,69 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">-<html>-<head>-<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">-<title>Trace of APNet</title>--<script src="ernet-trace.js"></script>--<script type="text/javascript">-function ndRef(nodeNumber, nodeName)-{- return "<td class=\"noderef\" onclick=\"setQ(" + nodeNumber + ")\">" + nodeName + "</td>";-}-function setQ(queryNumber)-{- var t = document.getElementById("queryTable");- t.innerHTML = "";- - t.insertRow(0);- t.rows[0].innerHTML = getRow(queryNumber);- t.rows[0].className = "mainrow";- t.rows[0].cells[2].className = "maincell";- - t.insertRow(1); // separator- t.rows[1].className = "seprow";- t.rows[1].innerHTML = "<td height=\"1ex\" colspan=\"3\"> the above answer was deduced using the following queries: </td>";- - var childrenQueries = getChildren(queryNumber);- var i;- - for (i=0; i<childrenQueries.length; i++)- {- t.insertRow(i+2);- t.rows[i+2].innerHTML = getRow(childrenQueries[i]);- }-}-</script>--<style type="text/css">-.noderef-{- background-color: #dbb;-}-.mainrow-{-} -.seprow-{- background-color: #d76;-} -.maincell-{- background-color: #89b;-} -</style>--</head>--<body>--<h1 id="title">Trace of APNet:</h1>--<table id="queryTable" cellpadding="10">-</table>--<script type="text/javascript">setQ(2);</script>--</body>-</html>