data構造を使わずに書いてみた

Friday/SimulatorT.hs

@@ -0,0 +1,28 @@
+import SimulatorT_Interface
+
+main = do
+	(info,st,ft,randoms) <- input
+	output (ft-st)$ simulate ft info $randoms
+--シミュレーションを再帰呼び出しで行う
+simulate :: Time -> Info -> [Double] -> Info
+simulate ft info@(s,p,wwt,b,n) (r1:r2:randoms) = if now s >= ft
+	then info
+	else simulate ft (update (r1,r2) info $state info) randoms
+--イベント種類によってsystemを更新
+update rs (sy,p,wwt,b,n) nowState = case nowState of
+    CallOfLoss -> (systemC, newPacket (now sy) sy rs,wwt,b+1,n+1) where
+	systemC = (capacity sy,parameter sy,queue sy,
+			nextTime sy $ newPacket (now sy) sy rs)
+
+    EnQueue    -> (systemE, newPacket (now sy) sy rs, wwt,b,n+1) where
+	systemE = (capacity sy,parameter sy,queue sy++[p],
+			nextTime sy $ newPacket (now sy) sy rs)
+
+    Process    -> (systemP, p, wwt+stayTime, b, n) where
+	systemP = (capacity sy,parameter sy,tail$queue sy,nextTime sy p)
+	stayTime = now sy - arrive (head $ queue sy)
+--パケットを生成する
+newPacket time sy (r1,r2) = mkPacket time (parameter sy) r1 r2
+--次回イベント時刻を求める
+nextTime sy = min (escapeTime sy).arrive
+escapeTime sy = if queue sy/=[] then escape.head $queue sy else 10^10

Friday/SimulatorT_Interface.hs

@@ -0,0 +1,57 @@
+module SimulatorT_Interface where
+import System.Random
+import Data.Time.Clock
+
+type Time = Double
+type Packet = (Time,Time,Time,Bool)
+type Capacity = Int
+type Queue = [Packet]
+type System = (Capacity,(Double,Double),Queue,Time)
+type Info = (System,Packet,Time,Int,Int)
+
+data State = CallOfLoss | EnQueue | Process deriving Eq
+
+mkRandoms seed = randomRs (0.0,1.0) $ mkStdGen seed -- 乱数リスト
+
+capacity (c,_,_,_) = c
+parameter (_,lm,_,_) = lm
+queue (_,_,q,_) = q
+now (_,_,_,time) = time
+
+arrive (at,_,_,_) = at
+service (_,st,_,_) = st
+escape (_,_,et,_) = et
+
+state :: Info -> State
+state (system,p,_,_,_)
+	| arrive p == now system
+		&& length (queue system) == capacity system = CallOfLoss
+	| arrive p == now system || queue system == [] = EnQueue
+	| otherwise = Process
+
+mkPacket time (l,m) r1 r2 = (arrive,service,escape,isPriority) where
+	(arrive,service) =(time-log(1-r1)/l , -log(1-r2)/m)
+	escape = arrive + service
+	isPriority = r1 < 1/50
+
+input :: IO (Info,Time,Time,[Double])
+input = do
+        putStrLn "lambda, mu, capacity, start, finish ->"
+        (param,capa,st,ft) <-(getLine >>= return.format.words)
+        t <- (getCurrentTime >>= return.utctDayTime)
+        let
+		(r1:r2:rndList) = mkRandoms.floor.read.init.show $t
+		system = (capa,param,[],st)
+		packet = mkPacket st param r1 r2
+        return ((system,packet,0,0,0),st,ft,rndList) where
+	format :: [String] -> ((Double,Double),Int,Time,Time)
+	format [l,m,capa,st,ft]
+		 = ((read l,read m),read capa,read st, read ft)
+
+output measuredTime (system,p,wwt,b,n) = do
+        print $ system
+        putStrLn $ "call of loss == " ++ show callofloss
+        putStrLn $ "average of packets = " ++ show (wwt/measuredTime)
+        putStrLn $ "average of waiting time = " ++ show avgWaiting where
+        callofloss = fromIntegral b / fromIntegral n
+        avgWaiting = wwt / fromIntegral n