R中的蒙特卡洛模拟

我正在尝试解决以下练习，但实际上我不知道如何开始执行此操作。我在书中找到了一些看起来像这样的代码，但这是完全不同的练习，我不知道如何将它们彼此关联。如何开始模拟到达，如何知道到达的时间？我知道如何存储它们，并据此计算a，b，c，d。但我不知道我实际需要如何模拟蒙特卡洛模拟。有人可以帮我开始吗？我知道这不是一个可以为您解答所有问题的地方，而是可以解决的。但是问题是我不知道如何开始。

一个IT支持服务台代表一个排队系统，由五名助手接听客户的电话。这些呼叫根据Poisson进程进行，平均每45秒发出一次呼叫。第1个，第2个，第3个，第4个和第5个助手的服务时间分别是参数为λ1= 0.1，λ2= 0.2，λ3= 0.3，λ4= 0.4和λ5= 0.5 min-1的指数随机变量（第j个服务台助理的λk= k / 10 min-1）。除了受帮助的客户外，最多可以保留十个其他客户。在达到此容量时，新的呼叫者会收到忙音。使用蒙特卡洛方法估算以下性能特征，

（a）收到繁忙信号的客户比例；

（b）预期的响应时间；

（c）平均轮候时间；

（d）每个服务台助理服务的客户部分；

编辑：我到目前为止（不是很多）：

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++;
    }
}

这是执行过程中最具启发性和趣味性的一种模拟：您在计算机中创建独立的代理，让它们进行交互，跟踪它们的工作并研究发生的情况。这是学习复杂系统的奇妙方法，尤其是（但不限于）那些无法通过纯粹的数学分析来理解的系统。

构造此类仿真的最佳方法是使用自上而下的设计。

在最高级别，代码应类似于

initialize(...)
while (process(get.next.event())) {}

（此示例和所有后续示例都是可执行 R代码，而不仅仅是伪代码。）该循环是事件驱动的模拟：get.next.event()查找感兴趣的任何“事件”并将其描述传递给process，从而对它进行操作（包括记录任何事件）。信息）。TRUE只要一切运行良好，它就会返回。一旦发现错误或仿真FALSE结束，它将返回，从而结束循环。

如果我们设想此队列的物理实现，例如在纽约市等待结婚证的人，或者几乎在任何地方都需要驾驶执照或火车票的人，那么我们会想到两种代理：客户代理和“助手”（或服务器） 。客户通过露面来宣布自己；助手通过打开灯或标志或打开窗户来宣布有空。这是要处理的两种事件。

这种模拟的理想环境是真正的面向对象的环境，其中的对象是可变的：它们可以更改状态以独立地响应周围的事物。 R为此绝对是可怕的（甚至Fortran也会更好！）。但是，如果我们有所注意，我们仍然可以使用它。诀窍是将所有信息维护在一组通用的数据结构中，可以通过许多单独的交互过程进行访问（和修改）。我将采用在所有大写中为此类数据使用变量名的约定。

自上而下设计的下一个层次是编码process。它响应一个事件描述符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)
}

当get.next.event没有要报告的事件时，它必须响应null事件。否则，process实施系统的“业务规则”。它实际上是根据问题的描述来写的。它的工作方式几乎不需要评论，只是指出最终我们将需要编写子例程put.on.hold和release.hold（实现客户等待队列）和serve（实现客户辅助交互）代码。

什么是“事件”？ 它必须包含有关谁在行动，他们正在采取何种行动以及何时发生的信息。因此，我的代码使用了包含这三种信息的列表。但是，get.next.event只需要检查时间。它仅负责维护事件队列，其中

1. 接收到任何事件后，都可以将其放入队列中，

2. 队列中最早的事件可以轻松提取并传递给呼叫者。

此优先级队列的最佳实现是堆，但这在中太麻烦了R。遵循诺曼·马特洛夫（Norman Matloff）的《 R编程的艺术》（该人提供了一种更灵活，抽象但受限的队列模拟器）的建议之后，我使用了一个数据框来保存事件并在其记录中搜索最短时间。

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)
}

有很多方法可以对此进行编码。此处显示的最终版本反映了我在编码中process做出的选择，即如何对“助手”事件做出反应以及如何new.customer工作：get.next.event仅将客户从保留队列中移出，然后坐下来等待另一个事件。有时有必要以两种方式寻找新客户：第一，看一个人是否正在门口（原样），第二，看是否有人在我们不在时进来。

显然，new.customer和next.customer.time是重要的程序，所以让我们照顾他们旁边。

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是一个2D数组，每个客户的数据都在列中。它有四行（充当字段），它们描述客户并在模拟过程中记录他们的经历：“到达”，“服务”，“持续时间”和“助手”（服务的助手的正数字标识符，如果有）它们，否则-1用于繁忙信号）。在高度灵活的模拟中，这些列将动态生成，但是由于R工作方式的不同，一开始就可以在单个大型矩阵中生成所有客户，并且已经随机生成了到达时间，因此非常方便。 next.customer.time可以浏览此矩阵的下一列，以了解谁将成为下一个。全局变量CUSTOMER.COUNT指示最后一位到达的顾客。通过此指针可以非常简单地管理客户，将其前进以获取新客户，然后超越该指针（不前进）来查看下一个客户。

serve 在模拟中实施业务规则。

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)
}

这很简单。 ASSISTANTS是一个具有两个字段的数据框：（capabilities给出其服务费率）和available，用于标记下一次助手将有空的时间。通过根据助手的能力生成随机的服务持续时间，更新助手下次可用时的时间以及在CUSTOMERS数据结构中记录服务间隔来为客户提供服务。该VERBOSE标志非常便于测试和调试：为true时，它将发出描述关键处理点的英语句子流。

如何将助手分配给客户非常重要且有趣。 可以想象几个过程：随机分配，按某种固定顺序分配，或根据谁有最长（或最短）时间获得分配。其中许多都用注释掉的代码说明：

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)
}

其余的模拟实际上只是说服R实现标准数据结构的常规练习，主要是用于保留队列的循环缓冲区。因为您不想对全局变量运行混乱，所以我将所有这些都放在一个过程中sim。它的参数描述了这个问题：要模拟的客户数量（n.events），客户到达率，助手的能力以及保留队列的大小（可以将其设置为零以完全消除队列）。

r <- sim(n.events=250, arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)

它返回模拟过程中维护的数据结构的列表。最大的兴趣之一就是CUSTOMERS数组。 R使得以一种有趣的方式在该数组中绘制基本信息变得相当容易。这是一个输出，显示了在客户的较长模拟中的最后客户。$50$$250$

每个客户的体验均绘制为水平时间线，到达时带有圆形符号，黑色表示等待中的所有实线，以及与助手互动期间的彩色线（颜色和线型区分助手）。在此客户图下是一个显示助手经验的图，标明了他们与客户互动的时间。每个活动间隔的端点由竖线分隔。

使用时verbose=TRUE，模拟的文本输出如下所示：

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

（左侧的数字是每条消息发出的时间。）您可以将这些描述与“时间”在到之间的“客户”图部分进行匹配。$160$$165$

我们可以通过按客户标识符绘制保留时间，并使用特殊的（红色）符号显示接收到忙碌信号的客户，来研究客户的保留时间。

（对于所有管理此服务队列的人来说，所有这些图都不会成为一个出色的实时仪表板！）

比较您在更改传递给的参数时所获得的曲线图和统计数据，这非常有趣sim。如果客户到达得太快而无法处理，会发生什么？当保持队列变小或消除时会发生什么？以不同方式选择助手时会发生什么变化？助理的人数和能力如何影响客户体验？一些客户开始被拒之门外或开始长时间搁置的关键点是什么？

通常，对于像这样的明显的自学问题，我们会在这里停下来，而将其余的细节留作练习。但是，我不想让可能已经走这么远并且有兴趣亲自尝试（并可能出于其他目的对其进行修改和构建）的读者感到失望，因此下面附有完整的工作代码。

（此站点上的处理将使包含符号的任何行的缩进变得混乱，但是当将代码粘贴到文本文件中时，应恢复可读的缩进。）$\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)