[Haskell-beginners] How to represent a (running) network?

Dmitry Vyal akamaus at gmail.com
Wed Jan 16 21:11:34 CET 2013


On 01/15/2013 12:51 AM, Martin Drautzburg wrote:
> What would be a good way to represent a Network anyways? I believe the classic
> approach is a list of nodes and a list vertices. In the simulation I will
> frequently have to find the process of an input or output and to find the
> input connected to an output. The node/vertices implementation seems to
> require scanning lists, which could be slow once I have thousands of
> processes.
>
> Other than that any pointers to how to construct networks (which go beyond
> mere graphs) would be much appreciated.
>
Hello Martin,
I guess the exact way depends on what precisely you want to achieve. I'm 
thinking about two options, hope others will suggest more. Either you 
try to model it in a pure setting or you go into IO.

In a former case you may try to make use of lazy streams, say function 
of type
f :: [a] -> [b] -> [c]
is basically your's processing unit which takes two inputs and produces 
one output.
For example, this is an integrator:

f1 xs ys = zipWith (+) xs ys
summer xs = let ret = f1 xs ys
                 ys = 0 : ret
             in ret

Here you depend on mutually recursive bindings in order to form the 
loops, so you can't make a dynamic structures this way, I believe.

Speaking about IO, you may either go the classic boring way by 
collecting all the outputs in some mutable data structure and updating 
them in a loop, or you may try to have some fun with GHC's green threads:

import Control.Monad
import Control.Concurrent
import Control.Concurrent.MVar

mkBinaryF f i1 i2 = do
   ret <- newEmptyMVar

   let worker = do
         v1 <- i1
         v2 <- i2
         res <- f v1 v2
         putMVar ret res
   forkIO $ forever worker
   return (takeMVar ret)

main = do
   inp2 <- newMVar 0
   out <- mkBinaryF (\x y -> return $ x + y) (getLine >>= return . read) 
(takeMVar inp2)

   forever $ do
     v <- out
     putStrLn $ "out: " ++ show v
     putMVar inp2 v

For a more theoretically backed approach I suggest you to look at CSP. 
http://www.cs.kent.ac.uk/projects/ofa/chp/

Best wishes,
Dmitry



More information about the Beginners mailing list