-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
2 changed files
with
85 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |