乱舞するメッセージ（２）

１．小さな会社

小さな会社の従業員は、購買担当者、営業担当者、経理担当者の3人とし、小さな会社は現金取引で商いをしているとする。購買担当者は仕入れをしたとき、経理担当者にその個数を伝えるものとし、販売担当者は販売をしたとき、経理担当者にやはりその個数を伝えるものとする。仕入れの単価は80円で、販売の単価は100円とする。経理担当者は、彼らからの伝達から会計用の帳簿を作るものとする。

２．エージェント間でのメッセージ・パッシング

とりあえず、購買担当者あるいは営業担当者から経理担当者へ、購入数あるいは販売数を伝えるために、この三人をプロセスとし、それぞれの間で、メッセージ・パッシングにより情報が伝達できるようにする。

購買担当者あるいは営業担当者の仕事の様子は、乱数を用いてシミュレーションすることにする。即ち、購買担当者は、ランダムな時間間隔(0.5-1秒)でランダムな個数(51-100)の購入を行うとする。購買担当者は、ランダムな時間間隔(0.25-0.5秒)でランダムな個数(1-50)の購入を行うとする。
経理担当者は新たなトランザクションがあった時は、それをコンソールプロセスに伝え、コンソールプロセスは、その内容を表示するものとする。
以下がこのプログラムである。
このプログラムで気を付ける点は、乱数発生の部分である。乱数発生のための関数getStdRandomはIOモナドを出力する。しかし、このプログラムの世界はCHPモナドの世界なので、IOモナドからCHPモナドに移してあげる必要がある。これをしてくれるのが、liftIO_CHPである。その後、>>=になっているので、その値は、CHPモナドの世界から純粋な世界に戻され、writeChannelあるいはwaitForへの入力として与えられる。これらの結果は、再び、CHPモナドの世界である。

import Control.Concurrent.CHP
import qualified Control.Concurrent.CHP.Common as CHP
import Control.Concurrent.CHP.Console
import Control.Monad
import Control.Monad.Trans
import System.Random

main :: IO ()
main = runCHP_(consoleProcess concurrentAgents)

sales :: Chanout Int -> CHP ()
sales chanout = 
  forever $ 
    do writeC
       randomDelay
    where
      writeC = liftIO_CHP (getStdRandom (randomR (1,50))) >>= writeChannel chanout 
      randomDelay = liftIO_CHP (getStdRandom (randomR (250000,500000))) >>= waitFor

purchasing :: Chanout Int -> CHP ()
purchasing chanout = 
  forever $ 
    do writeC
       randomDelay
    where
      writeC = liftIO_CHP (getStdRandom (randomR (51,100))) >>= writeChannel chanout 
      randomDelay = liftIO_CHP (getStdRandom (randomR (500000,1000000))) >>= waitFor

acountant :: ConsoleChans -> Chanin Int -> Chanin Int -> CHP ()
acountant chans chaninS chaninC = 
  forever $ 
    (readChannel chaninS >>= outProcessS) <-> (readChannel chaninC >>= outProcessC)
    where
      outProcessS :: Int -> CHP ()
      outProcessS x = printString ("Sales:" ++ show x  ++ "\n")
      outProcessC :: Int -> CHP ()
      outProcessC x = printString ("Purchasing:" ++ show x  ++ "\n")
      printString = mapM_(writeChannel (cStdout chans))

concurrentAgents :: ConsoleChans -> CHP ()
concurrentAgents chans = 
  do s <- newChannel
     p <- newChannel
     runParallel_
       [ sales (writer s)
       , purchasing (writer p)
       , acountant chans (reader s) (reader p)]