diff --git a/Friday/SimulatorT.hs b/Friday/SimulatorT.hs new file mode 100644 index 0000000..98c06c6 --- /dev/null +++ b/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 diff --git a/Friday/SimulatorT_Interface.hs b/Friday/SimulatorT_Interface.hs new file mode 100644 index 0000000..810d696 --- /dev/null +++ b/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