Dies ist eine der lehrreichsten und unterhaltsamsten Arten von Simulationen: Sie erstellen unabhängige Agenten im Computer, lassen sie interagieren, verfolgen, was sie tun, und untersuchen, was passiert. Es ist eine wunderbare Möglichkeit, komplexe Systeme kennenzulernen, insbesondere (aber nicht ausschließlich) solche, die mit rein mathematischer Analyse nicht verstanden werden können.
Der beste Weg, solche Simulationen zu erstellen, ist das Top-Down-Design.
Auf der höchsten Ebene sollte der Code ungefähr so aussehen
initialize(...)
while (process(get.next.event())) {}
(Dieses und alle nachfolgenden Beispiele sind ausführbarer R Code, nicht nur Pseudocode.) Die Schleife ist eine ereignisgesteuerte Simulation: Sie get.next.event()findet jedes "Ereignis" von Interesse und übergibt eine Beschreibung davon an process, die etwas damit zu tun hat (einschließlich der Protokollierung eines beliebigen) Informationen darüber). Es kehrt zurück, TRUEsolange die Dinge gut laufen. Wenn ein Fehler oder das Ende der Simulation identifiziert wird, kehrt er zurück FALSEund beendet die Schleife.
Wenn wir uns eine physische Implementierung dieser Warteschlange vorstellen, z. B. Menschen, die fast überall in New York auf eine Heiratsurkunde oder auf einen Führerschein oder eine Fahrkarte warten, denken wir an zwei Arten von Agenten: Kunden und "Assistenten" (oder Server). . Kunden melden sich an, indem sie auftauchen; Assistenten geben ihre Verfügbarkeit bekannt, indem sie ein Licht oder ein Schild einschalten oder ein Fenster öffnen. Dies sind die beiden Arten von Ereignissen, die verarbeitet werden müssen.
Die ideale Umgebung für eine solche Simulation ist eine echte objektorientierte Umgebung, in der Objekte veränderlich sind : Sie können den Zustand ändern, um unabhängig auf Dinge um sie herum zu reagieren. Rist absolut schrecklich dafür (sogar Fortran wäre besser!). Wir können es jedoch weiterhin verwenden, wenn wir vorsichtig sind. Der Trick besteht darin, alle Informationen in einem gemeinsamen Satz von Datenstrukturen zu verwalten, auf die durch viele separate, interagierende Verfahren zugegriffen (und geändert) werden kann. Ich werde die Konvention der Verwendung von Variablennamen IN ALL CAPS für solche Daten übernehmen.
Die nächste Ebene des Top-Down-Designs ist das Codieren process. Es reagiert auf einen einzelnen Ereignisdeskriptor e:
process <- function(e) {
if (is.null(e)) return(FALSE)
if (e$type == "Customer") {
i <- find.assistant(e$time)
if (is.null(i)) put.on.hold(e$x, e$time) else serve(i, e$x, e$time)
} else {
release.hold(e$time)
}
return(TRUE)
}
Es muss auf ein Nullereignis reagieren, wenn get.next.eventkeine Ereignisse zu melden sind. Andernfalls werden processdie "Geschäftsregeln" des Systems implementiert. Es schreibt sich praktisch aus der Beschreibung in der Frage. Wie es funktioniert, sollte wenig Kommentar erfordern, außer um darauf hinzuweisen, dass wir schließlich Unterprogramme put.on.holdund release.hold(Implementieren einer Kundenwarteschlange) und serve(Implementieren der Kunden-Assistenten-Interaktionen) codieren müssen .
Was ist ein "Ereignis"? Es muss Informationen darüber enthalten, wer handelt, welche Art von Maßnahmen sie ergreifen und wann sie stattfinden. Mein Code verwendet daher eine Liste mit diesen drei Arten von Informationen. Muss jedoch get.next.eventnur die Zeiten überprüfen. Es ist nur für die Aufrechterhaltung einer Warteschlange von Ereignissen verantwortlich, in denen
Jedes Ereignis kann in die Warteschlange gestellt werden, wenn es empfangen wird und
Das früheste Ereignis in der Warteschlange kann einfach extrahiert und an den Anrufer übergeben werden.
Die beste Implementierung dieser Prioritätswarteschlange wäre ein Haufen, aber das ist zu pingelig R. Nach einem Vorschlag in Norman Matloffs The Art of R Programming (der einen flexibleren, abstrakteren, aber begrenzten Warteschlangensimulator bietet) habe ich einen Datenrahmen verwendet, um die Ereignisse zu speichern und sie einfach nach der minimalen Zeit in den Datensätzen zu durchsuchen.
get.next.event <- function() {
if (length(EVENTS$time) <= 0) new.customer() # Wait for a customer$
if (length(EVENTS$time) <= 0) return(NULL) # Nothing's going on!$
if (min(EVENTS$time) > next.customer.time()) new.customer()# See text
i <- which.min(EVENTS$time)
e <- EVENTS[i, ]; EVENTS <<- EVENTS[-i, ]
return (e)
}
Es gibt viele Möglichkeiten, wie dies codiert werden könnte. Die hier gezeigte endgültige Version spiegelt eine Entscheidung wider, die ich beim Codieren getroffen habe, wie processauf ein "Assistent" -Ereignis reagiert und wie es new.customerfunktioniert: get.next.eventNimmt lediglich einen Kunden aus der Warteschlange, lehnt sich zurück und wartet auf ein anderes Ereignis. Es wird manchmal notwendig sein, auf zwei Arten nach einem neuen Kunden zu suchen: erstens, um zu sehen, ob einer an der Tür wartet (sozusagen) und zweitens, ob man hereingekommen ist, als wir nicht gesucht haben.
Klar, new.customerund next.customer.timesind wichtige Routinen , also kümmern wir uns als nächstes um sie.
new.customer <- function() {
if (CUSTOMER.COUNT < dim(CUSTOMERS)[2]) {
CUSTOMER.COUNT <<- CUSTOMER.COUNT + 1
insert.event(CUSTOMER.COUNT, "Customer",
CUSTOMERS["Arrived", CUSTOMER.COUNT])
}
return(CUSTOMER.COUNT)
}
next.customer.time <- function() {
if (CUSTOMER.COUNT < dim(CUSTOMERS)[2]) {
x <- CUSTOMERS["Arrived", CUSTOMER.COUNT]
} else {x <- Inf}
return(x) # Time when the next customer will arrive
}
CUSTOMERSist ein 2D-Array mit Daten für jeden Kunden in Spalten. Es verfügt über vier Zeilen (als Felder), die Kunden beschreiben und ihre Erfahrungen während der Simulation aufzeichnen : "Angekommen", "Bedient", "Dauer" und "Assistent" (eine positive numerische Kennung des Assistenten, falls vorhanden, der gedient hat) sie und sonst -1für Besetztzeichen). In einer hochflexiblen Simulation würden diese Spalten dynamisch generiert. Aufgrund der RArbeitsweise ist es jedoch praktisch, alle Kunden zu Beginn in einer einzigen großen Matrix zu generieren, deren Ankunftszeiten bereits zufällig generiert wurden. next.customer.timeIch kann in die nächste Spalte dieser Matrix schauen, um zu sehen, wer als nächstes kommt. Die globale VariableCUSTOMER.COUNTgibt den zuletzt ankommenden Kunden an. Kunden werden sehr einfach mit diesem Zeiger verwaltet, indem sie ihn weiterentwickeln, um einen neuen Kunden zu gewinnen, und darüber hinaus schauen (ohne voranzukommen), um einen Blick auf den nächsten Kunden zu werfen.
serve implementiert die Geschäftsregeln in der Simulation.
serve <- function(i, x, time.now) {
#
# Serve customer `x` with assistant `i`.
#
a <- ASSISTANTS[i, ]
r <- rexp(1, a$rate) # Simulate the duration of service
r <- round(r, 2) # (Make simple numbers)
ASSISTANTS[i, ]$available <<- time.now + r # Update availability
#
# Log this successful service event for later analysis.
#
CUSTOMERS["Assistant", x] <<- i
CUSTOMERS["Served", x] <<- time.now
CUSTOMERS["Duration", x] <<- r
#
# Queue the moment the assistant becomes free, so they can check for
# any customers on hold.
#
insert.event(i, "Assistant", time.now + r)
if (VERBOSE) cat(time.now, ": Assistant", i, "is now serving customer",
x, "until", time.now + r, "\n")
return (TRUE)
}
Das ist unkompliziert. ASSISTANTSist ein Datenrahmen mit zwei Feldern: capabilities(unter Angabe der Servicerate) und available, der das nächste Mal markiert , wenn der Assistent frei ist. Ein Kunde wird bedient, indem eine zufällige Servicedauer gemäß den Fähigkeiten des Assistenten generiert, die Zeit aktualisiert wird, zu der der Assistent das nächste Mal verfügbar ist, und das Serviceintervall in der CUSTOMERSDatenstruktur protokolliert wird . Das VERBOSEFlag ist praktisch zum Testen und Debuggen: Wenn true, wird ein Strom englischer Sätze ausgegeben, die die wichtigsten Verarbeitungspunkte beschreiben.
Wie Assistenten den Kunden zugewiesen werden, ist wichtig und interessant. Man kann sich mehrere Verfahren vorstellen: zufällige Zuordnung, durch eine feste Reihenfolge oder je nachdem, wer die längste (oder kürzeste) Zeit frei hatte. Viele davon sind in auskommentiertem Code dargestellt:
find.assistant <- function(time.now) {
j <- which(ASSISTANTS$available <= time.now)
#if (length(j) > 0) {
# i <- j[ceiling(runif(1) * length(j))]
#} else i <- NULL # Random selection
#if (length(j) > 0) i <- j[1] else i <- NULL # Pick first assistant
#if (length(j) > 0) i <- j[length(j)] else i <- NULL # Pick last assistant
if (length(j) > 0) {
i <- j[which.min(ASSISTANTS[j, ]$available)]
} else i <- NULL # Pick most-rested assistant
return (i)
}
Der Rest der Simulation ist eigentlich nur eine Routineübung , um Rzu überzeugen , Standarddatenstrukturen zu implementieren, hauptsächlich einen kreisförmigen Puffer für die Warteschlange in der Warteschleife. Da Sie nicht mit Globals Amok laufen möchten, habe ich all dies in einer einzigen Prozedur zusammengefasst sim. Seine Argumente beschreiben das Problem: die Anzahl der zu simulierenden Kunden ( n.events), die Kundenankunftsrate, die Fähigkeiten der Assistenten und die Größe der Warteschlange (die auf Null gesetzt werden kann, um die Warteschlange insgesamt zu beseitigen).
r <- sim(n.events=250, arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)
CUSTOMERSR50250
Die Erfahrung jedes Kunden wird als horizontale Zeitlinie mit einem kreisförmigen Symbol zum Zeitpunkt der Ankunft, einer durchgezogenen schwarzen Linie für Wartezeiten und einer farbigen Linie für die Dauer der Interaktion mit einem Assistenten (Farbe und Linientyp) dargestellt zwischen den Assistenten unterscheiden). Unter diesem Kundenplot befindet sich einer, der die Erfahrungen der Assistenten zeigt und die Zeiten angibt, zu denen sie mit einem Kunden beschäftigt waren und nicht. Die Endpunkte jedes Aktivitätsintervalls werden durch vertikale Balken begrenzt.
Bei Ausführung mit verbose=TRUEsieht die Textausgabe der Simulation folgendermaßen aus:
...
160.71 : Customer 211 put on hold at position 1
161.88 : Customer 212 put on hold at position 2
161.91 : Assistant 3 is now serving customer 213 until 163.24
161.91 : Customer 211 put on hold at position 2
162.68 : Assistant 4 is now serving customer 212 until 164.79
162.71 : Assistant 5 is now serving customer 211 until 162.9
163.51 : Assistant 5 is now serving customer 214 until 164.05
...
160165
Wir können die Erfahrung der Kunden in der Warteschleife untersuchen, indem wir die Dauer der Warteschleife anhand der Kundenkennung aufzeichnen und ein spezielles (rotes) Symbol verwenden, um Kunden anzuzeigen, die ein Besetztzeichen erhalten.
(Würden nicht alle diese Diagramme ein wunderbares Echtzeit-Dashboard für jeden sein, der diese Servicewarteschlange verwaltet!)
Es ist faszinierend, die Diagramme und Statistiken zu vergleichen, die Sie erhalten, wenn Sie die übergebenen Parameter variieren sim. Was passiert, wenn Kunden zu schnell ankommen, um bearbeitet zu werden? Was passiert, wenn die Warteschlange kleiner oder kleiner wird? Was ändert sich, wenn Assistenten auf unterschiedliche Weise ausgewählt werden? Wie beeinflussen die Anzahl und die Fähigkeiten der Assistenten das Kundenerlebnis? Was sind die kritischen Punkte, an denen einige Kunden abgewiesen oder für längere Zeit in die Warteschleife gelegt werden?
Normalerweise würden wir bei offensichtlichen Fragen zum Selbststudium wie dieser hier anhalten und die verbleibenden Details als Übung belassen. Ich möchte jedoch Leser nicht enttäuschen, die möglicherweise so weit gekommen sind und daran interessiert sind, dies selbst auszuprobieren (und es möglicherweise zu ändern und für andere Zwecke darauf aufzubauen). Im Folgenden finden Sie den vollständigen Arbeitscode.
T.E.X.$
sim <- function(n.events, verbose=FALSE, ...) {
#
# Simulate service for `n.events` customers.
#
# Variables global to this simulation (but local to the function):
#
VERBOSE <- verbose # When TRUE, issues informative message
ASSISTANTS <- list() # List of assistant data structures
CUSTOMERS <- numeric(0) # Array of customers that arrived
CUSTOMER.COUNT <- 0 # Number of customers processed
EVENTS <- list() # Dynamic event queue
HOLD <- list() # Customer on-hold queue
#............................................................................#
#
# Start.
#
initialize <- function(arrival.rate, capabilities, hold.queue.size) {
#
# Create common data structures.
#
ASSISTANTS <<- data.frame(rate=capabilities, # Service rate
available=0 # Next available time
)
CUSTOMERS <<- matrix(NA, nrow=4, ncol=n.events,
dimnames=list(c("Arrived", # Time arrived
"Served", # Time served
"Duration", # Duration of service
"Assistant" # Assistant id
)))
EVENTS <<- data.frame(x=integer(0), # Assistant or customer id
type=character(0), # Assistant or customer
time=numeric(0) # Start of event
)
HOLD <<- list(first=1, # Index of first in queue
last=1, # Next available slot
customers=rep(NA, hold.queue.size+1))
#
# Generate all customer arrival times in advance.
#
CUSTOMERS["Arrived", ] <<- cumsum(round(rexp(n.events, arrival.rate), 2))
CUSTOMER.COUNT <<- 0
if (VERBOSE) cat("Started.\n")
return(TRUE)
}
#............................................................................#
#
# Dispatching.
#
# Argument `e` represents an event, consisting of an assistant/customer
# identifier `x`, an event type `type`, and its time of occurrence `time`.
#
# Depending on the event, a customer is either served or an attempt is made
# to put them on hold.
#
# Returns TRUE until no more events occur.
#
process <- function(e) {
if (is.null(e)) return(FALSE)
if (e$type == "Customer") {
i <- find.assistant(e$time)
if (is.null(i)) put.on.hold(e$x, e$time) else serve(i, e$x, e$time)
} else {
release.hold(e$time)
}
return(TRUE)
}#$
#............................................................................#
#
# Event queuing.
#
get.next.event <- function() {
if (length(EVENTS$time) <= 0) new.customer()
if (length(EVENTS$time) <= 0) return(NULL)
if (min(EVENTS$time) > next.customer.time()) new.customer()
i <- which.min(EVENTS$time)
e <- EVENTS[i, ]; EVENTS <<- EVENTS[-i, ]
return (e)
}
insert.event <- function(x, type, time.occurs) {
EVENTS <<- rbind(EVENTS, data.frame(x=x, type=type, time=time.occurs))
return (NULL)
}
#
# Customer arrivals (called by `get.next.event`).
#
# Updates the customers pointer `CUSTOMER.COUNT` and returns the customer
# it newly points to.
#
new.customer <- function() {
if (CUSTOMER.COUNT < dim(CUSTOMERS)[2]) {
CUSTOMER.COUNT <<- CUSTOMER.COUNT + 1
insert.event(CUSTOMER.COUNT, "Customer",
CUSTOMERS["Arrived", CUSTOMER.COUNT])
}
return(CUSTOMER.COUNT)
}
next.customer.time <- function() {
if (CUSTOMER.COUNT < dim(CUSTOMERS)[2]) {
x <- CUSTOMERS["Arrived", CUSTOMER.COUNT]
} else {x <- Inf}
return(x) # Time when the next customer will arrive
}
#............................................................................#
#
# Service.
#
find.assistant <- function(time.now) {
#
# Select among available assistants.
#
j <- which(ASSISTANTS$available <= time.now)
#if (length(j) > 0) {
# i <- j[ceiling(runif(1) * length(j))]
#} else i <- NULL # Random selection
#if (length(j) > 0) i <- j[1] else i <- NULL # Pick first assistant
#if (length(j) > 0) i <- j[length(j)] else i <- NULL # Pick last assistant
if (length(j) > 0) {
i <- j[which.min(ASSISTANTS[j, ]$available)]
} else i <- NULL # Pick most-rested assistant
return (i)
}#$
serve <- function(i, x, time.now) {
#
# Serve customer `x` with assistant `i`.
#
a <- ASSISTANTS[i, ]
r <- rexp(1, a$rate) # Simulate the duration of service
r <- round(r, 2) # (Make simple numbers)
ASSISTANTS[i, ]$available <<- time.now + r # Update availability
#
# Log this successful service event for later analysis.
#
CUSTOMERS["Assistant", x] <<- i
CUSTOMERS["Served", x] <<- time.now
CUSTOMERS["Duration", x] <<- r
#
# Queue the moment the assistant becomes free, so they can check for
# any customers on hold.
#
insert.event(i, "Assistant", time.now + r)
if (VERBOSE) cat(time.now, ": Assistant", i, "is now serving customer",
x, "until", time.now + r, "\n")
return (TRUE)
}
#............................................................................#
#
# The on-hold queue.
#
# This is a cicular buffer implemented by an array and two pointers,
# one to its head and the other to the next available slot.
#
put.on.hold <- function(x, time.now) {
#
# Try to put customer `x` on hold.
#
if (length(HOLD$customers) < 1 ||
(HOLD$first - HOLD$last %% length(HOLD$customers) == 1)) {
# Hold queue is full, alas. Log this occurrence for later analysis.
CUSTOMERS["Assistant", x] <<- -1 # Busy signal
if (VERBOSE) cat(time.now, ": Customer", x, "got a busy signal.\n")
return(FALSE)
}
#
# Add the customer to the hold queue.
#
HOLD$customers[HOLD$last] <<- x
HOLD$last <<- HOLD$last %% length(HOLD$customers) + 1
if (VERBOSE) cat(time.now, ": Customer", x, "put on hold at position",
(HOLD$last - HOLD$first - 1) %% length(HOLD$customers) + 1, "\n")
return (TRUE)
}
release.hold <- function(time.now) {
#
# Pick up the next customer from the hold queue and place them into
# the event queue.
#
if (HOLD$first != HOLD$last) {
x <- HOLD$customers[HOLD$first] # Take the first customer
HOLD$customers[HOLD$first] <<- NA # Update the hold queue
HOLD$first <<- HOLD$first %% length(HOLD$customers) + 1
insert.event(x, "Customer", time.now)
}
}$
#............................................................................#
#
# Summaries.
#
# The CUSTOMERS array contains full information about the customer experiences:
# when they arrived, when they were served, how long the service took, and
# which assistant served them.
#
summarize <- function() return (list(c=CUSTOMERS, a=ASSISTANTS, e=EVENTS,
h=HOLD))
#............................................................................#
#
# The main event loop.
#
initialize(...)
while (process(get.next.event())) {}
#
# Return the results.
#
return (summarize())
}
#------------------------------------------------------------------------------#
#
# Specify and run a simulation.
#
set.seed(17)
n.skip <- 200 # Number of initial events to skip in subsequent summaries
system.time({
r <- sim(n.events=50+n.skip, verbose=TRUE,
arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)
})
#------------------------------------------------------------------------------#
#
# Post processing.
#
# Skip the initial phase before equilibrium.
#
results <- r$c
ids <- (n.skip+1):(dim(results)[2])
arrived <- results["Arrived", ]
served <- results["Served", ]
duration <- results["Duration", ]
assistant <- results["Assistant", ]
assistant[is.na(assistant)] <- 0 # Was on hold forever
ended <- served + duration
#
# A detailed plot of customer experiences.
#
n.events <- length(ids)
n.assistants <- max(assistant, na.rm=TRUE)
colors <- rainbow(n.assistants + 2)
assistant.color <- colors[assistant + 2]
x.max <- max(results["Served", ids] + results["Duration", ids], na.rm=TRUE)
x.min <- max(min(results["Arrived", ids], na.rm=TRUE) - 2, 0)
#
# Lay out the graphics.
#
layout(matrix(c(1,1,2,2), 2, 2, byrow=TRUE), heights=c(2,1))
#
# Set up the customers plot.
#
plot(c(x.min, x.max), range(ids), type="n",
xlab="Time", ylab="Customer Id", main="Customers")
#
# Place points at customer arrival times.
#
points(arrived[ids], ids, pch=21, bg=assistant.color[ids], col="#00000070")
#
# Show wait times on hold.
#
invisible(sapply(ids, function(i) {
if (!is.na(served[i])) lines(x=c(arrived[i], served[i]), y=c(i,i))
}))
#
# More clearly show customers getting a busy signal.
#
ids.not.served <- ids[is.na(served[ids])]
ids.served <- ids[!is.na(served[ids])]
points(arrived[ids.not.served], ids.not.served, pch=4, cex=1.2)
#
# Show times of service, colored by assistant id.
#
invisible(sapply(ids.served, function(i) {
lines(x=c(served[i], ended[i]), y=c(i,i), col=assistant.color[i], lty=assistant[i])
}))
#
# Plot the histories of the assistants.
#
plot(c(x.min, x.max), c(1, n.assistants)+c(-1,1)/2, type="n", bty="n",
xlab="", ylab="Assistant Id", main="Assistants")
abline(h=1:n.assistants, col="#808080", lwd=1)
invisible(sapply(1:(dim(results)[2]), function(i) {
a <- assistant[i]
if (a > 0) {
lines(x=c(served[i], ended[i]), y=c(a, a), lwd=3, col=colors[a+2])
points(x=c(served[i], ended[i]), y=c(a, a), pch="|", col=colors[a+2])
}
}))
#
# Plot the customer waiting statistics.
#
par(mfrow=c(1,1))
i <- is.na(served)
plot(served - arrived, xlab="Customer Id", ylab="Minutes",
main="Service Wait Durations")
lines(served - arrived, col="Gray")
points(which(i), rep(0, sum(i)), pch=16, col="Red")
#
# Summary statistics.
#
mean(!is.na(served)) # Proportion of customers served
table(assistant)