Monte-Carlo-Simulation in R.

11

Ich versuche, die folgende Übung zu lösen, habe aber keine Ahnung, wie ich damit anfangen soll. Ich habe in meinem Buch einen Code gefunden, der so aussieht, aber es ist eine völlig andere Übung, und ich weiß nicht, wie ich sie miteinander in Beziehung setzen soll. Wie kann ich mit der Simulation von Ankünften beginnen und woher weiß ich, wann sie fertig sind? Ich weiß, wie man sie speichert und a, b, c, d danach berechnet. Aber ich weiß nicht, wie ich die Monte-Carlo-Simulation tatsächlich simulieren muss. Könnte mir bitte jemand beim Einstieg helfen? Ich weiß, dass dies kein Ort ist, an dem Ihre Fragen für Sie beantwortet, sondern nur gelöst werden. Aber das Problem ist, dass ich nicht weiß, wie ich anfangen soll.

Ein IT-Support-Helpdesk stellt ein Warteschlangensystem dar, in dem fünf Assistenten Anrufe von Kunden entgegennehmen. Die Anrufe erfolgen nach einem Poisson-Prozess mit einer durchschnittlichen Rate von einem Anruf alle 45 Sekunden. Die Servicezeiten für den 1., 2., 3., 4. und 5. Assistenten sind alle exponentielle Zufallsvariablen mit den Parametern λ1 = 0,1, λ2 = 0,2, λ3 = 0,3, λ4 = 0,4 bzw. λ5 = 0,5 min - 1 (die Der j-te Helpdesk-Assistent hat λk = k / 10 min - 1). Neben den Kunden, die unterstützt werden, können bis zu zehn weitere Kunden in die Warteschleife gestellt werden. Zu Zeiten, in denen diese Kapazität erreicht ist, erhalten die neuen Anrufer ein Besetztzeichen. Verwenden Sie die Monte-Carlo-Methoden, um die folgenden Leistungsmerkmale abzuschätzen:

(a) der Anteil der Kunden, die ein Besetztzeichen erhalten;

(b) die erwartete Antwortzeit;

(c) die durchschnittliche Wartezeit;

(d) den Anteil der Kunden, die von jedem Helpdesk-Assistenten bedient werden;

EDIT: was ich bisher habe ist (nicht viel):

pa = 1/45sec-1

jobs = rep(1,5); onHold = rep(1,10);

jobsIndex = 0;

onHoldIndex = 0;

u = runif(1)
for (i in 1:1000) {

    if(u  <= pa){ # new arrival

        if(jobsIndex < 5) # assistant is free, #give job to assistant

            jobsIndex++;

        else #add to onHold array

            onHoldIndex++;
    }
}
user3485470
quelle
Es geht nicht genau darum, wie man MC macht, aber kennen Sie dieses Paket: r-bloggers.com/… ? Es scheint perfekt für die Art von Problemen zu passen, die Sie beschreiben (obwohl Sie ein anderes Modell verwenden).
Tim
Ich versuche tatsächlich, dies ohne externe Bibliotheken zu lösen, aber wenn ich das nicht kann, werde ich Ihre sicher verwenden :)
user3485470
Zeigen Sie, was Sie bisher getan haben. Sie können nicht einfach hierher kommen und nach einer Lösung für Ihre Hausarbeit fragen.
Aksakal

Antworten:

21

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

  1. Jedes Ereignis kann in die Warteschlange gestellt werden, wenn es empfangen wird und

  2. 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

Abbildung 1

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.

Figur 2

(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)
whuber
quelle
2
+1 Erstaunlich! Könnten Sie alle Fragen mit dieser Vollständigkeit und Liebe zum Detail beantworten? Träume, nur Träume ...
Aleksandr Blekh
+1 Was kann ich sagen? Heute habe ich so viele interessante Dinge gelernt! Möchten Sie bitte ein Buch zur weiteren Lektüre hinzufügen?
Mugen
1
@mugen Ich habe das Matloff-Buch im Text erwähnt. Dies ist möglicherweise für Neueinsteiger geeignet R, die eine andere (aber ziemlich ähnliche) Perspektive auf Warteschlangensimulationen wünschen. Während ich diesen kleinen Simulator schrieb, dachte ich viel darüber nach, wie viel ich durch das Studium des Codes in (der ersten Ausgabe von) Andrew Tanenbaums Text Betriebssysteme / Design und Implementierung gelernt habe . Ich habe auch praktische Datenstrukturen wie Haufen aus Jon Bentleys Artikeln in CACM und seiner Buchreihe Programming Pearls gelernt . Tanenbaum und Bentley sind großartige Autoren, die jeder lesen sollte.
whuber
1
@mugen, gibt es ein kostenloses Online - Lehrbuch über Warteschlangentheorie von Moshe hier . Auch der Kurs für diskrete Stochastoc-Prozesse von Prof. Gallager behandelt dieses Thema am MIT OCW . Die Videovorträge sind wirklich gut.
Aksakal
@whuber, eine tolle Antwort. Obwohl ich nicht glaube, dass man heutzutage Kinder dazu bringen kann, Tanenbaum und Bentley zu lesen :)
Aksakal