Đây là một trong những loại mô phỏng thú vị và mang tính hướng dẫn nhất để thực hiện: bạn tạo các tác nhân độc lập trong máy tính, để chúng tương tác, theo dõi những gì chúng làm và nghiên cứu những gì xảy ra. Đó là một cách tuyệt vời để tìm hiểu về các hệ thống phức tạp, đặc biệt (nhưng không giới hạn) những hệ thống không thể hiểu được bằng phân tích toán học thuần túy.
Cách tốt nhất để xây dựng các mô phỏng như vậy là với thiết kế từ trên xuống.
Ở cấp độ cao nhất , mã sẽ trông giống như
initialize(...)
while (process(get.next.event())) {}
(Đây và tất cả các ví dụ tiếp theo là mã thực thi R , không chỉ là mã giả.) Vòng lặp là một mô phỏng theo hướng sự kiện : get.next.event()tìm thấy bất kỳ "sự kiện" nào quan tâm và chuyển một mô tả về nó process, thực hiện điều gì đó với nó (bao gồm cả việc ghi nhật ký thông tin về nó). Nó trở lại TRUEmiễn là mọi thứ đang chạy tốt; khi xác định một lỗi hoặc kết thúc mô phỏng, nó sẽ trả về FALSE, kết thúc vòng lặp.
Nếu chúng ta tưởng tượng việc triển khai thực tế hàng đợi này, chẳng hạn như những người đang chờ giấy phép kết hôn ở Thành phố New York hoặc bằng lái xe hoặc vé tàu gần như bất cứ nơi nào, chúng ta sẽ nghĩ đến hai loại đại lý: khách hàng và "trợ lý" (hoặc máy chủ) . Khách hàng tự thông báo bằng cách hiển thị; trợ lý thông báo sự sẵn có của họ bằng cách bật đèn hoặc ký hoặc mở cửa sổ. Đây là hai loại sự kiện để xử lý.
Môi trường lý tưởng cho một mô phỏng như vậy là một môi trường hướng đối tượng thực sự trong đó các đối tượng có thể thay đổi : chúng có thể thay đổi trạng thái để phản ứng độc lập với mọi thứ xung quanh. Rlà hoàn toàn khủng khiếp cho điều này (ngay cả Fortran sẽ tốt hơn!). Tuy nhiên, chúng tôi vẫn có thể sử dụng nó nếu chúng tôi cẩn thận. Bí quyết là duy trì tất cả thông tin trong một tập hợp các cấu trúc dữ liệu chung có thể được truy cập (và sửa đổi) bằng nhiều thủ tục tương tác riêng biệt. Tôi sẽ áp dụng quy ước sử dụng tên biến trong TẤT CẢ CAPS cho dữ liệu đó.
Cấp độ tiếp theo của thiết kế từ trên xuống là mã process. Nó đáp ứng với một mô tả sự kiện duy nhất 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)
}
Nó phải trả lời một sự kiện null khi get.next.eventkhông có sự kiện nào để báo cáo. Mặt khác, processthực hiện "quy tắc kinh doanh" của hệ thống. Nó thực tế viết chính nó từ mô tả trong câu hỏi. Cách thức hoạt động cần ít bình luận, ngoại trừ chỉ ra rằng cuối cùng chúng ta sẽ cần mã chương trình con put.on.holdvà release.hold(thực hiện hàng đợi giữ khách hàng) và serve(thực hiện các tương tác trợ lý khách hàng).
"Sự kiện" là gì? Nó phải chứa thông tin về người đang hành động, những gì loại hành động mà họ đang dùng, và khi nó đang xảy ra. Do đó, mã của tôi sử dụng một danh sách chứa ba loại thông tin này. Tuy nhiên, get.next.eventchỉ cần kiểm tra thời gian. Nó chỉ chịu trách nhiệm duy trì một hàng các sự kiện trong đó
Bất kỳ sự kiện nào cũng có thể được đưa vào hàng đợi khi nó được nhận và
Sự kiện sớm nhất trong hàng đợi có thể dễ dàng được trích xuất và chuyển cho người gọi.
Việc thực hiện tốt nhất hàng đợi ưu tiên này sẽ là một đống, nhưng điều đó quá phức tạp R. Theo gợi ý trong The Art of R Lập trình của Norman Matloff (người cung cấp trình mô phỏng hàng đợi linh hoạt, trừu tượng nhưng hạn chế hơn), tôi đã sử dụng khung dữ liệu để giữ các sự kiện và chỉ cần tìm kiếm trong thời gian tối thiểu trong số các bản ghi của nó.
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)
}
Có nhiều cách điều này có thể đã được mã hóa. Phiên bản cuối cùng được hiển thị ở đây phản ánh sự lựa chọn mà tôi đã thực hiện khi mã hóa cách processphản ứng với sự kiện "Trợ lý" và cách thức new.customerhoạt động: get.next.eventchỉ đơn giản là đưa khách hàng ra khỏi hàng đợi, sau đó ngồi lại và chờ đợi một sự kiện khác. Đôi khi sẽ cần phải tìm kiếm một khách hàng mới theo hai cách: thứ nhất, để xem liệu một người đang đợi ở cửa (như đã từng) và thứ hai, liệu một người có bước vào khi chúng ta không tìm kiếm.
Rõ ràng, new.customervà next.customer.timelà những thói quen quan trọng , vì vậy chúng ta hãy quan tâm đến chúng tiếp theo.
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
}
CUSTOMERSlà một mảng 2D, với dữ liệu cho từng khách hàng trong các cột. Nó có bốn hàng (đóng vai trò là các trường) mô tả khách hàng và ghi lại trải nghiệm của họ trong quá trình mô phỏng : "Đến", "Phục vụ", "Thời lượng" và "Trợ lý" (một số nhận dạng tích cực của trợ lý, nếu có, người phục vụ chúng, và mặt khác -1cho các tín hiệu bận rộn). Trong một mô phỏng rất linh hoạt, các cột này sẽ được tạo một cách linh hoạt, nhưng do cách Rthích làm việc, việc tạo ra tất cả các khách hàng ngay từ đầu, trong một ma trận lớn, với thời gian đến đã được tạo ngẫu nhiên. next.customer.timecó thể nhìn vào cột tiếp theo của ma trận này để xem ai sẽ đến tiếp theo. Biến toàn cụcCUSTOMER.COUNTcho biết khách hàng cuối cùng đến. Khách hàng được quản lý rất đơn giản bằng con trỏ này, tiến tới nó để có được một khách hàng mới và nhìn xa hơn (không cần tiến lên) để nhìn trộm khách hàng tiếp theo.
serve thực hiện các quy tắc kinh doanh trong mô phỏng.
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)
}
Điều này là đơn giản. ASSISTANTSlà một khung dữ liệu với hai trường: capabilities(đưa ra tốc độ dịch vụ của họ) và available, sẽ gắn cờ vào lần tiếp theo mà trợ lý sẽ được miễn phí. Một khách hàng được phục vụ bằng cách tạo thời lượng dịch vụ ngẫu nhiên theo khả năng của trợ lý, cập nhật thời gian khi trợ lý tiếp theo khả dụng và ghi lại khoảng thời gian dịch vụ trong CUSTOMERScấu trúc dữ liệu. Các VERBOSElá cờ rất thuận tiện để thử nghiệm và gỡ lỗi: khi sự thật, nó phát ra một dòng của câu tiếng Anh mô tả các điểm xử lý chủ chốt.
Làm thế nào trợ lý được phân công cho khách hàng là quan trọng và thú vị. Người ta có thể tưởng tượng một số thủ tục: chuyển nhượng ngẫu nhiên, theo một số thứ tự cố định hoặc theo người đã được miễn phí thời gian dài nhất (hoặc ngắn nhất). Nhiều trong số này được minh họa trong mã nhận xét:
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)
}
Phần còn lại của mô phỏng thực sự chỉ là một bài tập thông thường trong việc thuyết phục Rthực hiện các cấu trúc dữ liệu tiêu chuẩn, chủ yếu là một bộ đệm tròn cho hàng đợi chờ. Bởi vì bạn không muốn chạy điên cuồng với toàn cầu, tôi đặt tất cả những điều này vào một quy trình duy nhất sim. Các đối số của nó mô tả vấn đề: số lượng khách hàng mô phỏng ( n.events), tỷ lệ khách hàng đến, khả năng của trợ lý và kích thước của hàng đợi giữ (có thể được đặt thành 0 để loại bỏ hoàn toàn hàng đợi).
r <- sim(n.events=250, arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)
Nó trả về một danh sách các cấu trúc dữ liệu được duy trì trong quá trình mô phỏng; một trong những quan tâm lớn nhất là CUSTOMERSmảng. Rlàm cho nó khá dễ dàng để vẽ các thông tin cần thiết trong mảng này một cách thú vị. Đây là một đầu ra cho thấy khách hàng cuối cùng trong một mô phỏng dài hơn khách hàng.25050250
Trải nghiệm của mỗi khách hàng được vẽ như một dòng thời gian nằm ngang, với biểu tượng hình tròn tại thời điểm đến, một đường màu đen chắc chắn cho bất kỳ chờ đợi nào và một vạch màu trong suốt thời gian tương tác của họ với một trợ lý (loại màu và loại đường phân biệt giữa các trợ lý). Bên dưới âm mưu của Khách hàng này là một trong những trải nghiệm của các trợ lý, đánh dấu thời gian họ đã và không tham gia với khách hàng. Các điểm cuối của mỗi khoảng thời gian của hoạt động được phân định bởi các thanh dọc.
Khi chạy với verbose=TRUE, đầu ra văn bản của mô phỏng trông như thế này:
...
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
...
(Các số ở bên trái là số lần mỗi tin nhắn được phát ra.) Bạn có thể khớp các mô tả này với các phần của âm mưu Khách hàng nằm trong khoảng thời gian từ đến .165160165
Chúng tôi có thể nghiên cứu trải nghiệm của khách hàng bằng cách vẽ thời lượng tạm dừng theo số nhận dạng khách hàng, sử dụng biểu tượng đặc biệt (màu đỏ) để hiển thị cho khách hàng nhận được tín hiệu bận.
(Không phải tất cả các lô này sẽ tạo ra một bảng điều khiển thời gian thực tuyệt vời cho bất kỳ ai quản lý hàng đợi dịch vụ này!)
Thật thú vị khi so sánh các lô và số liệu thống kê mà bạn nhận được khi thay đổi các tham số được truyền vào sim. Điều gì xảy ra khi khách hàng đến quá nhanh để được xử lý? Điều gì xảy ra khi hàng đợi giữ được làm nhỏ hơn hoặc loại bỏ? Điều gì thay đổi khi trợ lý được lựa chọn trong cách cư xử khác nhau? Làm thế nào để số lượng và khả năng của các trợ lý ảnh hưởng đến trải nghiệm của khách hàng? Các điểm quan trọng mà một số khách hàng bắt đầu bị từ chối hoặc bắt đầu bị giữ trong thời gian dài là gì?
Thông thường, đối với các câu hỏi tự học rõ ràng như câu hỏi này, chúng tôi sẽ dừng ở đây và để lại các chi tiết còn lại như một bài tập. Tuy nhiên, tôi không muốn làm thất vọng những độc giả có thể đã đi xa đến mức này và quan tâm đến việc tự mình thử nó (và có thể sửa đổi nó và xây dựng nó cho các mục đích khác), vì vậy, bên dưới là mã làm việc đầy đủ.
(Quá trình xử lý trên trang web này sẽ gây ra sự thụt lề tại bất kỳ dòng nào có chứa ký hiệu , nhưng phải thụt dòng có thể đọc được khi mã được dán vào tệp văn bản.)$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)