Bu, gerçekleştirilecek en öğretici ve eğlenceli simülasyon türlerinden biridir: bağımsız aracılar oluşturursunuz bilgisayarda , etkileşime girmelerine izin verir, ne yaptıklarını takip eder ve ne olduğunu incelersiniz. Karmaşık sistemleri, özellikle de sadece matematiksel analizle anlaşılamayanları (ancak bunlarla sınırlı olmamak üzere) öğrenmenin harika bir yoludur.
Bu simülasyonları oluşturmanın en iyi yolu yukarıdan aşağıya tasarımdır.
En üst düzeyde kod şöyle görünmelidir:
initialize(...)
while (process(get.next.event())) {}
(Bu ve sonraki tüm örnekler, yalnızca sahte kod değil , yürütülebilir R koddur.) Döngü, olaya dayalı bir simülasyondur: get.next.event()ilgilenilen herhangi bir "olayı" bulur ve bununla ilgili bir processşey yapan bir açıklama geçirir. hakkında bilgi). Her TRUEşey yolunda gittiği sürece geri döner ; bir hata veya simülasyonun FALSEsonu belirlendiğinde, döngü sona erdirilir.
Bu sıranın, New York'ta bir evlilik lisansı veya sürücü ehliyeti veya neredeyse her yerde tren bileti için bekleyen insanlar gibi fiziksel bir uygulamasını hayal edersek, iki tür aracıyı düşünürüz: müşteriler ve "asistanlar" (veya sunucular) . Müşteriler kendilerini göstererek duyururlar; asistanlar bir ışık ya da işaret ya da bir pencere açarak uygunluklarını bildirir. Bunlar işlenecek iki tür olaydır.
Böyle bir simülasyon için ideal ortam, nesnelerin değişebildiği gerçek bir nesne yönelimli ortamdır : etraflarındaki şeylere bağımsız olarak yanıt vermek için durumu değiştirebilirler. Rbunun için kesinlikle korkunç (hatta Fortran daha iyi olurdu!). Ancak, biraz dikkat edersek de kullanabiliriz. İşin püf noktası, tüm bilgileri, birbiriyle etkileşen birçok ayrı prosedürle erişilebilen (ve değiştirilebilen) ortak bir veri yapıları kümesinde tutmaktır. Bu tür veriler için TÜM CAPS'TA değişken adları kullanma kuralını benimseyeceğim.
Yukarıdan aşağıya tasarımın bir sonraki seviyesi kodlamadır process. Tek bir olay tanımlayıcısına yanıt verir 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)
}
Bildirilecek bir etkinlik get.next.eventolmadığında boş bir olaya yanıt vermek zorundadır. Aksi takdirde, processsistemin "iş kuralları" nı uygular. Pratik olarak kendisini sorudaki açıklamadan yazar. Nasıl çalıştığı çok az yorum gerektirmelidir, ancak sonuçta alt rutinleri put.on.holdve release.hold(müşteri tutma kuyruğunu serveuygulama ) ve (müşteri-yardımcı etkileşimlerini uygulama ) kodlamamız gerektiğine dikkat çekmek gerekir .
"Etkinlik" nedir? Kimin hareket ettiği, ne tür önlemler aldıkları ve ne zaman gerçekleştiği hakkında bilgi içermelidir . Kodum bu nedenle bu üç tür bilgiyi içeren bir liste kullanır. Ancak, get.next.eventsadece zamanları incelemek gerekir. Sadece bir olay sırasını korumaktan sorumludur.
Herhangi bir olay alındığında sıraya konabilir ve
Kuyruktaki en eski olay kolayca çıkarılabilir ve arayan kişiye aktarılabilir.
Bu öncelik sırasının en iyi uygulanması bir yığın olacaktır, ancak bu çok telaşlı R. Norman Matloff'un The Art of R Programming'deki (daha esnek, soyut, ancak sınırlı bir kuyruk simülatörü sunan) bir öneriden sonra, olayları tutmak ve sadece kayıtları arasında minimum süre aramak için bir veri çerçevesi kullandım.
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)
}
Bunun kodlanmasının birçok yolu vardır. Burada gösterilen son sürüm process, bir "Asistan" etkinliğine nasıl tepki verdiğini ve nasıl new.customerçalıştığını kodlarken yaptığım bir seçimi yansıtır : get.next.eventsadece bir müşteriyi bekletme kuyruğundan çıkarır, sonra arkanıza yaslanır ve başka bir etkinlik bekler. Bazen iki şekilde yeni bir müşteri aramak gerekebilir: birincisi, birinin kapıda beklediğini (olduğu gibi) görmek ve ikincisi, bakmadığımızda içeri girip gelmediğini görmek.
Açıkçası new.customerve next.customer.timeönemli rutinlerdir , bu yüzden bunlarla ilgilenelim.
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
}
CUSTOMERSsütunlarda her müşteriye ait verileri içeren bir 2D dizisidir. Simülasyon sırasında müşterileri tanımlayan ve deneyimlerini kaydeden dört satır (alan görevi görür) vardır : "Geldi", "Sunuldu", "Süre" ve "Asistan" (varsa asistanın pozitif sayısal tanımlayıcısı) ve aksi takdirde -1meşgul sinyaller için). Oldukça esnek bir simülasyonda bu sütunlar dinamik olarak oluşturulacaktı, ancak nasıl Rçalışmayı sevdiğinden dolayı , başlangıç zamanları rastgele oluşturulmuş olarak tüm müşterileri başlangıçta tek bir büyük matriste oluşturmak uygun. next.customer.timekimin geleceğini görmek için bu matrisin bir sonraki sütununa bakabilir. Global değişkenCUSTOMER.COUNTen son gelen müşteriyi gösterir. Müşteriler, bu işaretçiyle çok basit bir şekilde yönetilir, yeni bir müşteri elde etmek için ilerletilir ve bir sonraki müşteriye bakmak için ötesine (ilerlemeden) bakılır.
serve simülasyonda iş kurallarını uygular.
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)
}
Bu çok açık. ASSISTANTSiki alanlı bir veri çerçevesidir: capabilities(hizmet ücretlerini vererek) ve bir availablesonraki sefer asistanın ücretsiz olacağı bayrakları işaretler. Bir müşteriye, asistanın yeteneklerine göre rasgele bir servis süresi oluşturarak, asistanın bir sonraki müsait olduğu zamanı güncelleyerek ve servis aralığını CUSTOMERSveri yapısına kaydederek sunulur . VERBOSEGerçek, bu anahtar işleme noktaları açıklayan İngiliz cümle akışı yayar zaman: bayrak test ve hata ayıklama için kullanışlıdır.
Asistanların müşterilere nasıl atandıkları önemli ve ilginç. Birkaç prosedür düşünülebilir: rastgele atama, bazı sabit siparişlerle veya kimin en uzun (veya en kısa) süreyi serbest bıraktığına göre atama. Bunların çoğu yorumlanmış kodda gösterilmiştir:
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)
}
Simülasyonun geri kalanı,R standart veri yapılarını, özellikle de bekletme kuyruğu için dairesel bir tamponu uygulamaya ikna etmede gerçekten rutin bir egzersizdir . Çünkü küresellerle alay etmek istemiyorsun, hepsini tek bir prosedüre koydum sim. Argümanları sorunu açıklıyor: simüle edilecek müşteri sayısı ( n.events), müşteri varış oranı, asistanların yetenekleri ve tutma kuyruğunun boyutu (kuyruğu tamamen ortadan kaldırmak için sıfıra ayarlanabilir).
r <- sim(n.events=250, arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)
CUSTOMERSR50250
Her müşterinin deneyimi, varış sırasında dairesel bir sembol, beklemede olan herhangi bir bekleme için düz siyah bir çizgi ve bir asistanla (renk ve çizgi tipi) etkileşimleri süresince renkli bir çizgi ile yatay bir zaman çizgisi olarak çizilir. asistanlar arasında ayrım yapabilir). Bu Müşteriler grafiğinin altında, asistanların deneyimlerini gösteren, bir müşteriyle ne zaman meşgul olduklarını ve bir müşteriyle etkileşimde bulunmadıklarını gösteren bir konu vardır. Her aktivite aralığının uç noktaları dikey çubuklarla sınırlandırılır.
İle çalıştırıldığında verbose=TRUE, simülasyonun metin çıktısı şöyle görünür:
...
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
Meşgul sinyal alan müşterileri göstermek için özel (kırmızı) bir sembol kullanarak, müşteri tanımlayıcısına göre bekletme sürelerini çizerek müşterilerin deneyimlerini beklemeye alabiliriz.
(Tüm bu araziler, bu hizmet kuyruğunu yöneten herkes için harika bir gerçek zamanlı gösterge tablosu yapmaz!)
Geçilen parametreleri değiştirerek elde ettiğiniz grafikleri ve istatistikleri karşılaştırmak büyüleyici sim. Müşteriler işlenmek için çok hızlı geldiğinde ne olur? Bekletme kuyruğu küçültüldüğünde veya ortadan kaldırıldığında ne olur? Asistanlar farklı şekillerde seçildiğinde ne değişir? Asistanların sayıları ve yetenekleri müşteri deneyimini nasıl etkiler? Bazı müşterilerin geri çevrilmeye veya uzun süre beklemeye alınmaya başladıkları kritik noktalar nelerdir?
Normalde, bunun gibi açık ve kendi kendine çalışma soruları için, burada duracağız ve kalan ayrıntıları bir egzersiz olarak bırakacağız. Ancak, bu kadar kazanmış ve kendileri için denemek isteyen (ve belki de değiştirip başka amaçlar için inşa etmek isteyen) okuyucuları hayal kırıklığına uğratmak istemiyorum, bu yüzden aşağıda tam çalışma kodu verilmiştir.
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)