Discrete event modelling revisited

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 event modelling 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!

DiscreteEMSS

# 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)"