[Arjen Markus] (22 november 2010) Discrete events simulation is something that keeps intriguing me. The code below is a rewrite of an earlier experiment (see [Discrete events simulation with coroutines]), this time using finite-state machines instead of coroutines to model the various objects. I have also thrown in a bit of graphics and statistics. The basic idea is this: * Ships come in sight of the harbour (that is: they are "created" as new objects) and wait for tugs to tow them into the harbour. * This harbour has plenty of space, so there is no need to wait for a free spot. But it should be easy to build that feature in into the model. * Once in the harbour they get unloaded (a process taking a few hours) and then they are towed away again - leaving the simulation (and being destroyed). The simulation itself depends on the ships being modelled as state machines and the various events being scheduled. If no tugs are available, then the request for tugs is stored and after each new event all these requests are examined (by invoking the object's procedure). As the object has not changed its state, the same branch of the code is run again and again until the request can be satisfied. ''Note:'' this requires the cooperation of the programmer of course and that is the most important difference to the coroutines approach. I feel a bit more comfortable with the current approach though. I have experimented with the rate at which the ships are created (in the object "ShipsCreate") and a rate of 1.0 (one ship per hour, if time is interpreted as hours) seems to be the maximum for which the system is stable. The graphs will change quite a bit with each run - the form as well as the "final" absolute values for the total time and wait time. This remains the case for values close to 1.0. Even for a value of 0.7, I got a sequence like: 4.1, 4.46, 4.97, 5.64 - so it is necessary to run the simulation several times to see how "stable" the model is. (One fancy idea I had was to draw the outline of a ship that gets towed into the harbour and out of it again, with a clock indicating time. It would have been fancy - it isn't even that difficult to achieve, but it would have given little insight into the above properties of the model.) Next step: make the code more general and make it part of Tcllib's simulation package. And perhaps use coroutines as an alternative implementation as they are intriguing as well! ====== # discrete_ships.tcl -- # Discrete events simulation: a series of ships # entering and exiting a harbour # # TODO: # NIce graphical display of the simulation # package require Tcl 8.5 package require Tk package require Plotchart # createResource -- # Create a resource consisting of a number of # identical objects # # Arguments: # name Name of the resource # amount Number of objects # # Returns: # dictionary containing the relevant information # proc createResource {name amount} { global resources dict set resources $name [dict create total $amount available $amount] } # acquireResource -- # Acquire a certain number of objects in the resource # # Arguments: # objectId ID of the object that wants the resource # resourceName Variable representing the resource # amount Amount to acquire # newstate Name of the new state if the resource is acquired # # Returns: # Whether successful (1) or not (0) # # Side effects: # If successful, the state of the object is changed to the new # state, and the amount of available resources is reduced. # If not successful, the object remains in the same state # proc acquireResource {objectId resourceName amount newstate} { global debug global resources global objects global time if { ! [dict exists $resources $resourceName] } { return -code error "Resource does not exist: $resourceName" } # # Are there enough items in the resource left? # set available [dict get $resources $resourceName available] if { $available < $amount } { if { $debug } { puts "Time: $time -- [getProperty $objectId name] ($objectId) cannot acquire $resourceName" puts " Available: $available -- requested: $amount" } newRequest $objectId return 0 } # # We can "acquire" the resource # dict set resources $resourceName available [expr {$available-$amount}] dict set objects $objectId state $newstate if { $debug } { puts "Time: $time -- [getProperty $objectId name] ($objectId) acquired $resourceName" puts " Amount: $amount" } return 1 } # releaseResource -- # Release a certain number of objects to the resource # # Arguments: # resourceName Variable representing the resource # amount Amount to release # # Returns: # Nothing # proc releaseResource {resourceName amount} { global resources global debug global time # # Sanity check: we do not get more than the original amount? # if { ! [dict exists $resources $resourceName] } { return -code error "Resource does not exist: $resourceName" } set total [dict get $resources $resourceName total] set available [dict get $resources $resourceName available] if { $available + $amount > $total } { puts "Time: $time -- releasing $resourceName: more than the original!" puts " Available: $available -- released: $amount -- original amount: $total" return -code error "Too many resources released" } # # We can "release" the resource # dict set resources $resourceName available [expr {$available+$amount}] if { $debug } { puts "Time: $time -- $resourceName released" puts " Amount: $amount" } } # stopSimulation -- # Arrange for the simulation to be stopped # # Arguments: # None # # Returns: # Nothing # # Side effects: # Sets the variable stop to make sure the event loop stops # proc stopSimulation {} { global stop set stop 1 } # newEvent -- # Create a new event # # Arguments: # delay Delay wrt current time # objectId Identification of the object # newstate New state of the object when the event fires # (optional) # # Returns: # Nothing # proc newEvent {delay objectId {newstate {}}} { global events global time global debug if { $debug } { puts "Event scheduled: $delay -- $objectId" } if { $delay < 0.0 } { return -code error "Can not schedule events in the past - delay must be non-negative" } lappend events [list [expr {$time + $delay}] $objectId $newstate] set events [lsort -index 0 -real $events] } # newRequest -- # Create a request for some resource # # Arguments: # objectId Identification of the object # # Returns: # Nothing # proc newRequest {objectId} { global newRequests global debug if { [lsearch $newRequests $objectId] < 0 } { lappend newRequests $objectId if { $debug } { puts "Request scheduled: $objectId" } } } # newState -- # Set the state of an object # # Arguments: # objectId ID of the object # state New state # # Returns: # Nothing # proc newState {objectId state} { global objects dict set objects $objectId state $state } # getProperty -- # Get a particular property of an object # # Arguments: # objectId ID of the object # property Name of the property # # Returns: # Value of the property # proc getProperty {objectId property} { global objects return [dict get $objects $objectId $property] } # setProperty -- # Set a particular property of an object # # Arguments: # objectId ID of the object # property Name of the property # value Value of the property # # Returns: # Nothing # proc setProperty {objectId property value} { global objects dict set objects $objectId $property $value } # createObject -- # Create a new object in the simulation # # Arguments: # name (Preferably) unique name for the object # objProc Name of the object procedure # args Key-value pairs defining the properties # # Returns: # ID of the dictionary representing the object # proc createObject {name objProc args} { global objectCount global objects global debug global time # # Create the object with its user-defined properties # # TODO: check that the name is unique - or should we? # incr objectCount set object [dict create name $name objProc $objProc state "CREATED"] foreach {key value} $args { if { [lsearch {name objProc state} $key] < 0 } { dict set object $key $value } else { return -code error "You should not use a property named $key in an object" } } if { $debug } { puts "Object created: $objectCount ($name) at time $time" } dict set objects $objectCount $object # # Make the event system aware of it # newEvent 0 $objectCount ;# TODO: how do we keep track of the objects? return $objectCount } # deleteObject -- # Remove the object (any pending events related to it are ignored) # # Arguments: # objectId ID of the object # # Returns: # Nothing # proc deleteObject {objectId} { global debug global objects if { $debug } { puts "Deleted object: $objectId ([dict get $objects $objectId name])" } set objects [dict remove $objects $objectId] } # doEvents -- # Handle the events # # Arguments: # None # # Returns: # Nothing # # Side effects: # Handle all events until a stop is requested or there are # no more events to be processed. # proc doEvents {} { global debug global time global resources global objects global events global newRequests global stop while { [llength $events] > 0 } { set event [lindex $events 0] set events [lrange $events 1 end] foreach {time objectId newstate} $event {break} if { $stop } { return } if { ! [dict exists $objects $objectId] } { continue } # # Let the object handle the event # set object [dict get $objects $objectId] if { $newstate != "" } { dict set objects $objectId state $newstate } [dict get $object objProc] $objectId $time [dict get $object state] # # Handle the requests for resources that could not be # satisfied immediately # set requests $newRequests set newRequests {} foreach objectId $requests { set object [dict get $objects $objectId] [dict get $object objProc] $objectId $time [dict get $object state] } } } # shipsCreate -- # Procedure to randomly create new ships # # Arguments: # objectId The "creation" object's ID # time Current simulation time # state State of the object # # Returns: # Nothing # # Side effects: # New ships are created at a given rate # proc shipsCreate {objectId time state} { if { $state == "CREATED" } { set rate [getProperty $objectId rate] set rate [expr {$rate/10.0}] ;# ten events per hour newState $objectId "RUNNING" setProperty $objectId rate $rate } else { if { $time > [getProperty $objectId endTime] } { stopSimulation return } set rate [getProperty $objectId rate] if { rand() < $rate } { createObject ship shipLifeCycle startTime $time waitTime 0.0 endTime 0.0 } } newEvent 0.1 $objectId } # shipLifeCycle -- # Procedure representing the life cycle of a "ship" object # # Arguments: # objectName The object itself (name of variable) # time Current simulation time # state State of the object # # Returns: # Nothing # # Side effects: # Changes in the state of the object, new events, etc # # Note: # When the ship arrives at the harbour (the creation event) # it will need two tugs to enter the harbour. This takes # one hour. # When it reaches the quay, it gets unloaded (which takes # two hours) and then leaves the harbour again (aided by # one tug this time) in half an hour. # When it has left the harbour, it leaves the simulation # and the object is destroyed. # proc shipLifeCycle {objectId time state} { global allShips switch -- $state { "CREATED" { if { [acquireResource $objectId tugs 2 "ENTER"] } { setProperty $objectId waitTime [expr {$time - [getProperty $objectId startTime]}] newEvent 1 $objectId } } "ENTER" { releaseResource tugs 2 newState $objectId "LEAVE" newEvent 2 $objectId setProperty $objectId leaveTime [expr {$time + 2.0}] } "LEAVE" { if { [acquireResource $objectId tugs 1 "LEFT"] } { set waitTime [getProperty $objectId waitTime] setProperty $objectId waitTime [expr {$waitTime + $time - [getProperty $objectId leaveTime]}] newEvent 0.5 $objectId } } "LEFT" { set totalTime [expr {$time - [getProperty $objectId startTime]}] set waitTime [getProperty $objectId waitTime] set allShips(totalTime) [expr {$allShips(totalTime) + $totalTime}] set allShips(waitTime) [expr {$allShips(waitTime) + $waitTime}] incr allShips(number) set totalAvg [expr {$allShips(totalTime)/$allShips(number)}] set waitAvg [expr {$allShips(waitTime)/$allShips(number)}] set number $allShips(number) $::p plot total $number $totalAvg $::p plot wait $number $waitAvg update idletasks releaseResource tugs 1 deleteObject $objectId } } } # main -- # A simple simulation # # # Initialise the library - should be hidden # set debug 0 set time 0 set stop 0 set resources [dict create] set newRequests [list] set events [list] # # Create a plot window to show the results graphically # catch { console show } pack [canvas .c -width 400 -height 300] set p [::Plotchart::createXYPlot .c {0 300 50} {0 20 5}] $p title "Average total and wait time" $p dataconfig total -type symbol -symbol plus $p dataconfig wait -type symbol -symbol cross -colour red # # Start of simulation: # We have three tugs to work with # createResource "tugs" 3 # # Create the ships at a certain rate # (rate is number of ships per hour) # #set ships [createObject "ShipsCreate" shipsCreate endTime 300 rate 1.0] set ships [createObject "ShipsCreate" shipsCreate endTime 300 rate 0.9] set allShips(totalTime) 0.0 set allShips(waitTime) 0.0 set allShips(number) 0 doEvents puts "\nStatistics:\n" puts "Mean total time: [expr {$allShips(totalTime)/$allShips(number)}]" puts "Mean wait time: [expr {$allShips(waitTime)/$allShips(number)}]" puts "Number of ships: $allShips(number)" ====== <>Category Example | Category Simulator