これは、最も有益で楽しいシミュレーションの1つです。コンピューターで独立したエージェントを作成し、それらに相互作用させ、彼らが何をするかを追跡し、何が起こるかを調べます。これは、複雑なシステム、特に純粋に数学的な分析では理解できないシステム（ただし、これらに限定されない）について学ぶ素晴らしい方法です。
このようなシミュレーションを構築する最良の方法は、トップダウン設計です。
最高レベルでは、コードは次のようになります。
initialize(...)
while (process(get.next.event())) {}
（これとそれに続くすべての例は、単なる擬似コードではなく実行可能な Rコードです。）ループはイベント駆動型シミュレーションです。対象となるget.next.event()「イベント」を見つけ、その説明をに渡しprocessます。それに関する情報）。TRUE正常に動作している限り戻ります。エラーまたはシミュレーションの終了を識別すると、を返しFALSE、ループを終了します。
ニューヨークの結婚許可証、または運転免許証や電車の切符を待っている人など、このキューの物理的な実装を想像すると、2種類のエージェントが考えられます。顧客と「アシスタント」（またはサーバー）です。 。顧客は現れることによって自分自身を発表します。アシスタントは、ライトまたはサインをオンにするか、窓を開けることで、空き時間を通知します。これらは、処理する2種類のイベントです。
このようなシミュレーションの理想的な環境は、オブジェクトが変更可能な真のオブジェクト指向環境です。オブジェクトは状態を変更して、周囲の事柄に独立して応答できます。 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実装）と（顧客とアシスタントの対話の実装）が必要になることを指摘します。
「イベント」とは何ですか？誰が行動しているか、どのような行動をしているのか、いつ発生しているのか に関する情報が含まれている必要があります。したがって、私のコードでは、これらの3種類の情報を含むリストを使用しています。ただし、get.next.event時間の検査のみが必要です。イベントのキューを維持することのみを担当します。
イベントを受信すると、キューに入れることができます。
キュー内の最も古いイベントを簡単に抽出して、呼び出し元に渡すことができます。
この最良の実施プライオリティキューはなりヒープ、それはあまりにもうるさいでありますR。Norman MatloffのThe Art of R Programming（より柔軟で抽象的なが制限されたキューシミュレーターを提供する）の提案に従って、データフレームを使用してイベントを保持し、そのレコードから最小時間を検索しました。
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単に顧客を保留キューから取り出し、座って別のイベントを待ちます。場合によっては、2つの方法で新しい顧客を探す必要があります。1つ目は、ドアで待っているかどうかを確認する方法です（2つ目）。2つ目は、探していなかったときに来たかどうかです。
明らかに、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配列です。顧客を説明し、シミュレーション中の経験を記録する 4つの行（フィールドとして機能）があります。「到着済み」、「提供済み」、「期間」、および「アシスタント」（もしあれば、サービスを提供したアシスタントの正の数値ID）それら、およびそれ以外の場合-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)
}
これは簡単です。 （サービスレートを与える）とのASSISTANTS2つのフィールドを持つデータフレームで、アシスタントが次に空いているときにフラグを立てます。アシスタントは、アシスタントの機能に応じてランダムなサービス期間を生成し、アシスタントが次に利用可能になる時間を更新し、サービス間隔をデータ構造に記録することでサービスを受けます。このフラグは、テストとデバッグに便利です。trueの場合、主要な処理ポイントを説明する英語の文のストリームを発行します。capabilitiesavailableCUSTOMERSVERBOSE
アシスタントが顧客に割り当てられる方法は重要で興味深いものです。 いくつかの手順を想像できます。ランダムな割り当て、固定された順序による割り当て、または誰が最も長い（または最も短い）時間解放されているかによる割り当てです。これらの多くはコメントアウトされたコードで示されています：
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標準のデータ構造、主に保留キュー用の循環バッファを実装するように説得するための単なる日常的な作業です。グローバルでamokを実行したくないので、これらすべてを1つの手順にまとめましたsim。その引数は問題を説明します：シミュレートする顧客の数（n.events）、顧客の到着率、アシスタントの機能、および保留キューのサイズ（ゼロに設定してキューを完全に削除できます）。
r <- sim(n.events=250, arrival.rate=60/45, capabilities=1:5/10, hold.queue.size=10)
シミュレーション中に維持されるデータ構造のリストを返します。最も重要なのはCUSTOMERS配列です。 Rこの配列の重要な情報を興味深い方法で簡単にプロットできます。これは、顧客のより長いシミュレーションにおける最後の顧客を示す1つの出力です。25050250
各顧客のエクスペリエンスは、到着時の円形のシンボル、待機中の黒い実線、アシスタントとの対話の継続時間の色付きの線（色と線の種類）とともに、水平なタイムラインとしてプロットされますアシスタント間で区別します）。このCustomersプロットの下は、アシスタントの体験を示すものであり、アシスタントが顧客と関わっていた時間とされなかった時間を示しています。アクティビティの各間隔のエンドポイントは、縦棒で区切られています。
で実行する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
...
（左側の数字は、各メッセージが送信された時間です。）これらの説明を、顧客プロットのから間にある部分に一致させることができます。165160165
保留中の期間を顧客識別子ごとにプロットし、特別な（赤）記号を使用してビジー信号を受信している顧客を示すことで、顧客の保留中のエクスペリエンスを調査できます。
（これらすべてのプロットが、このサービスキューを管理する人にとって素晴らしいリアルタイムダッシュボードになるとは限りません！）
に渡されるパラメーターを変化させて得られるプロットと統計を比較するのは魅力的simです。顧客の到着が速すぎて処理できない場合はどうなりますか？保留キューを小さくしたり削除したりするとどうなりますか？アシスタントが異なる方法で選択された場合、何が変わりますか？アシスタントの数と能力は、カスタマーエクスペリエンスにどのように影響しますか？一部の顧客が背を向け始めたり、長時間保留になったりする重要なポイントは何ですか？
通常、このような自習用の明らかな質問については、ここで終了し、残りの詳細は演習として残します。ただし、ここまで進んだ可能性があり、自分で試してみたい（そして、変更して他の目的で構築する）読者に失望したくないので、以下に完全な動作コードを追加します。
（このサイトの処理は、記号を含むすべての行のインデントを台無しにしますが、コードをテキストファイルに貼り付けると、読みやすいインデントが復元されます。）TEバツドル
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)