Questo è uno dei tipi di simulazione più istruttivi e divertenti da eseguire: si creano agenti indipendenti nel computer, si lascia interagire, si tiene traccia di ciò che fanno e si studia cosa succede. È un modo meraviglioso per conoscere sistemi complessi, specialmente (ma non solo) quelli che non possono essere compresi con analisi puramente matematiche.
Il modo migliore per costruire tali simulazioni è con un design top-down.
Al livello più alto il codice dovrebbe assomigliare a qualcosa
initialize(...)
while (process(get.next.event())) {}
(Questo e tutti gli esempi successivi sono codice eseguibile R , non solo pseudo-codice.) Il ciclo è una simulazione guidata dagli eventi : get.next.event()trova qualsiasi "evento" di interesse e ne passa una descrizione process, che fa qualcosa con esso (inclusa la registrazione di qualsiasi informazioni al riguardo). Ritorna TRUEfintanto che le cose vanno bene; dopo aver identificato un errore o la fine della simulazione, ritorna FALSE, terminando il ciclo.
Se immaginiamo un'implementazione fisica di questa coda, come persone in attesa di una licenza di matrimonio a New York City o di una patente di guida o di un biglietto del treno quasi ovunque, pensiamo a due tipi di agenti: clienti e "assistenti" (o server) . I clienti si annunciano presentandosi; gli assistenti annunciano la loro disponibilità accendendo una luce o firmando o aprendo una finestra. Questi sono i due tipi di eventi da elaborare.
L'ambiente ideale per tale simulazione è un vero oggetto orientato agli oggetti in cui gli oggetti sono mutabili : possono cambiare stato per rispondere in modo indipendente alle cose che li circondano. Rè assolutamente terribile per questo (anche Fortran sarebbe meglio!). Tuttavia, possiamo ancora usarlo se ci prendiamo cura di noi. Il trucco è mantenere tutte le informazioni in un insieme comune di strutture dati a cui è possibile accedere (e modificare) mediante molte procedure separate e interagenti. Adotterò la convenzione di utilizzare nomi di variabili IN TUTTO MAIUSCOLO per tali dati.
Il livello successivo del design top-down è la codifica process. Risponde a un singolo descrittore di eventi 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)
}
Deve rispondere a un evento null quando get.next.eventnon ci sono eventi da segnalare. In caso contrario, processimplementa le "regole commerciali" del sistema. Praticamente si scrive dalla descrizione nella domanda. Il suo funzionamento dovrebbe richiedere pochi commenti, tranne per sottolineare che alla fine dovremo codificare le subroutine put.on.holde release.hold(implementare una coda di attesa del cliente) e serve(implementare le interazioni cliente-assistente).
Che cos'è un "evento"? Deve contenere informazioni su chi agisce, che tipo di azione sta intraprendendo e quando si sta verificando. Il mio codice utilizza quindi un elenco contenente questi tre tipi di informazioni. Tuttavia, get.next.eventdeve solo controllare i tempi. È responsabile solo del mantenimento di una coda di eventi in cui
Qualsiasi evento può essere inserito nella coda quando viene ricevuto e
Il primo evento nella coda può essere facilmente estratto e passato al chiamante.
La migliore implementazione di questa coda prioritaria sarebbe un mucchio, ma è troppo esigente R. Seguendo un suggerimento in The Art of R Programming di Norman Matloff (che offre un simulatore di coda più flessibile, astratto, ma limitato), ho usato un frame di dati per contenere gli eventi e cercare semplicemente il tempo minimo tra i suoi record.
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)
}
Ci sono molti modi in cui questo potrebbe essere stato codificato. La versione finale mostrata qui riflette una scelta che ho fatto nel codificare come processreagisce a un evento "Assistant" e come new.customerfunziona: si get.next.eventlimita a togliere un cliente dalla coda di attesa, quindi si siede e aspetta un altro evento. A volte sarà necessario cercare un nuovo cliente in due modi: primo, per vedere se uno sta aspettando alla porta (per così dire) e in secondo luogo, se uno è entrato quando non stavamo guardando.
Chiaramente, new.customere next.customer.timesono routine importanti , quindi prendiamoci cura di loro in seguito.
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
}
CUSTOMERSè un array 2D, con i dati per ciascun cliente in colonne. Ha quattro righe (che fungono da campi) che descrivono i clienti e registrano le loro esperienze durante la simulazione : "Arrivato", "Servito", "Durata" e "Assistente" (un identificatore numerico positivo dell'assistente, se presente, che ha servito loro, e altrimenti -1per segnali di occupato). In una simulazione altamente flessibile queste colonne verrebbero generate dinamicamente, ma a causa del modo in cui Rpiace lavorare è conveniente generare tutti i clienti all'inizio, in un'unica matrice di grandi dimensioni, con i loro tempi di arrivo già generati a caso. next.customer.timepuò dare un'occhiata alla colonna successiva di questa matrice per vedere chi verrà dopo. La variabile globaleCUSTOMER.COUNTindica l'ultimo cliente ad arrivare. I clienti vengono gestiti in modo molto semplice tramite questo puntatore, avanzandolo per ottenere un nuovo cliente e guardando oltre (senza avanzare) per sbirciare il cliente successivo.
serve implementa le regole di business nella simulazione.
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)
}
Questo è semplice. ASSISTANTSè un frame di dati con due campi: capabilities(che fornisce la loro tariffa di servizio) e available, che contrassegna la volta successiva in cui l'assistente sarà libero. Un cliente viene servito generando una durata del servizio casuale in base alle capacità dell'assistente, aggiornando il momento in cui l'assistente diventa disponibile e registrando l'intervallo di servizio nella CUSTOMERSstruttura dei dati. Il VERBOSEflag è utile per i test e il debug: quando è vero, emette un flusso di frasi inglesi che descrivono i punti di elaborazione chiave.
Il modo in cui gli assistenti sono assegnati ai clienti è importante e interessante. Si possono immaginare diverse procedure: assegnazione a caso, con un ordine fisso o secondo chi è stato libero il tempo più lungo (o più breve). Molti di questi sono illustrati nel codice commentato:
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)
}
Il resto della simulazione è in realtà solo un esercizio di routine per persuadere Rad implementare strutture di dati standard, principalmente un buffer circolare per la coda di attesa. Dato che non vuoi divertirti con i globi, ho messo tutti questi in un'unica procedura sim. I suoi argomenti descrivono il problema: il numero di clienti da simulare ( n.events), il tasso di arrivo dei clienti, le capacità degli assistenti e le dimensioni della coda di attesa (che può essere impostata su zero per eliminare del tutto la coda).
r <- sim(n.events=250, arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)
Restituisce un elenco delle strutture dati gestite durante la simulazione; quello di maggiore interesse è l' CUSTOMERSarray. Rrende abbastanza facile tracciare le informazioni essenziali in questo array in modo interessante. Ecco un output che mostra gli ultimi clienti in una simulazione più lunga di clienti.50250
L'esperienza di ogni cliente viene tracciata come una linea temporale orizzontale, con un simbolo circolare al momento dell'arrivo, una linea nera continua per ogni attesa in attesa e una linea colorata per la durata della loro interazione con un assistente (il colore e il tipo di linea differenziare tra gli assistenti). Al di sotto di questo diagramma dei clienti c'è uno che mostra le esperienze degli assistenti, segnando i tempi in cui erano e non erano coinvolti con un cliente. Gli endpoint di ciascun intervallo di attività sono delimitati da barre verticali.
Quando eseguito verbose=TRUE, l'output di testo della simulazione è simile al seguente:
...
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
...
(I numeri a sinistra sono i tempi in cui ogni messaggio è stato emesso.) Puoi abbinare queste descrizioni alle parti del diagramma Clienti comprese tra i tempi e .160165
Siamo in grado di studiare l'esperienza dei clienti in attesa, pianificando le durate in attesa tramite l'identificatore del cliente, utilizzando un simbolo speciale (rosso) per mostrare ai clienti che ricevono un segnale di occupato.
(Non tutte queste trame sarebbero una meravigliosa dashboard in tempo reale per chiunque gestisca questa coda di servizio!)
È affascinante confrontare i grafici e le statistiche ottenute variando i parametri passati sim. Cosa succede quando i clienti arrivano troppo rapidamente per essere elaborati? Cosa succede quando la coda di attesa viene ridotta o eliminata? Cosa cambia quando gli assistenti vengono selezionati in modi diversi? In che modo i numeri e le capacità degli assistenti influenzano l'esperienza del cliente? Quali sono i punti critici in cui alcuni clienti iniziano ad allontanarsi o a rimanere in attesa per lunghi periodi?
Normalmente, per evidenti domande di autoapprendimento come questa, ci fermiamo qui e lasciamo i dettagli rimanenti come esercizio. Tuttavia, non voglio deludere i lettori che potrebbero essersi spinti così lontano e che siano interessati a provarlo da soli (e magari a modificarlo e svilupparlo per altri scopi), quindi di seguito è riportato il codice di lavoro completo.
(L' elaborazione su questo sito incasinerà il rientro in tutte le righe che contengono un simbolo , ma il rientro leggibile dovrebbe essere ripristinato quando il codice viene incollato in un file di testo.)TEX$
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)