এটি সম্পাদন করার জন্য সবচেয়ে শিক্ষণীয় এবং মজাদার ধরণের এক: আপনি কম্পিউটারে স্বতন্ত্র এজেন্ট তৈরি করেন , তাদের সাথে আলাপচারিতা করুন, তারা কী করেন সে সম্পর্কে নজর রাখুন এবং কী ঘটে তা অধ্যয়ন করুন। এটি জটিল সিস্টেমগুলি সম্পর্কে বিশেষভাবে শিখার এক দুর্দান্ত উপায়, বিশেষত (তবে সীমাবদ্ধ নয়) যেগুলি বিশুদ্ধ গাণিতিক বিশ্লেষণ দ্বারা বোঝা যায় না।
এই জাতীয় সিমুলেশনগুলি তৈরি করার সর্বোত্তম উপায় হ'ল টপ-ডাউন ডিজাইন।
খুব উচ্চ স্তরে কোডটির মতো দেখতে কিছুটা হওয়া উচিত
initialize(...)
while (process(get.next.event())) {}
(এই সব পরবর্তী উদাহরণ এক্সিকিউটেবল R কোড, না শুধু সিউডো-কোড।) লুপ একটি হল ঘটনা-চালিত সিমুলেশন: get.next.event()কোনো আগ্রহ এর "ইভেন্ট" খুঁজে পায় এবং তা একটি বিবরণ পাসের process, যা এটি সঙ্গে কিছু (যে কোন লগিং সহ এটি সম্পর্কে তথ্য)। এটি TRUEযতক্ষণ জিনিস ভাল চলছে ততক্ষণ ফিরে আসে ; ত্রুটি বা সিমুলেশনের শেষ চিহ্নিত করার পরে এটি ফিরে আসে FALSEএবং লুপটি শেষ করে।
যদি আমরা এই সারিটির শারীরিক বাস্তবায়ন কল্পনা করি, যেমন লোকেরা নিউইয়র্ক সিটিতে বিবাহের লাইসেন্সের জন্য বা ড্রাইভারের লাইসেন্স বা ট্রেনের টিকিটের জন্য প্রায় যেকোন জায়গায় অপেক্ষা করে থাকে তবে আমরা দুই ধরণের এজেন্ট: গ্রাহক এবং "সহায়ক" (বা সার্ভার) বিবেচনা করি think । গ্রাহকরা দেখিয়ে নিজেদের ঘোষণা করেন; সহায়করা একটি হালকা বা সাইন বা উইন্ডো খোলার মাধ্যমে তাদের প্রাপ্যতা ঘোষণা করে। প্রক্রিয়াজাতকরণের জন্য এটি দুটি ধরণের ঘটনা।
এই জাতীয় সিমুলেশনের জন্য আদর্শ পরিবেশটি একটি সত্য বস্তু-কেন্দ্রিক একটি যেখানে বস্তুগুলি পারস্পরিক পরিবর্তনযোগ্য : তারা চারপাশের জিনিসগুলিতে স্বাধীনভাবে প্রতিক্রিয়া জানাতে রাষ্ট্রকে পরিবর্তন করতে পারে। Rএটির জন্য একেবারে ভয়ঙ্কর (এমনকি ফোর্টরান আরও ভাল হবে!)। তবে আমরা কিছু যত্ন নিলে আমরা এটি ব্যবহার করতে পারি। কৌশলটি হ'ল ডেটা স্ট্রাকচারের একটি সাধারণ সেটে সমস্ত তথ্য বজায় রাখা যা অনেকগুলি পৃথক, ইন্টারেক্টিভ পদ্ধতি দ্বারা অ্যাক্সেস করা যায় (এবং সংশোধিত)। আমি এই জাতীয় ডেটার জন্য সমস্ত ক্যাপগুলিতে পরিবর্তনশীল নাম ব্যবহারের কনভেনশন গ্রহণ করব।
টপ-ডাউন ডিজাইনের পরবর্তী স্তরটি কোড করা 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কোনও ইভেন্টের প্রতিবেদন করার দরকার নেই তখন এটি একটি নাল ইভেন্টে প্রতিক্রিয়া জানাতে হবে । অন্যথায়, processসিস্টেমটির "ব্যবসায়িক বিধি" প্রয়োগ করে। এটি কার্যত প্রশ্নের বিবরণ থেকে নিজেকে লেখায়। এটি কীভাবে কাজ করে তার জন্য সামান্য মন্তব্য করা দরকার, শেষ পর্যন্ত আমাদের সাবরুটাইনগুলি কোড করতে হবে put.on.holdএবং release.hold(গ্রাহক-ধারক সারিতে serveপ্রয়োগ করা ) এবং (গ্রাহক-সহায়ক সহকারী মিথস্ক্রিয়াগুলি কার্যকর করা ) দরকার except
একটি "ইভেন্ট" কি? এটির সম্পর্কে তথ্য ধারণ করতে হবে যারা অভিনয় করা হয়, কি কর্ম নিয়েই বা তারা গ্রহণ করা হয়, এবং যখন এটা ঘটছে। আমার কোড তাই এই তিন ধরণের তথ্য সমন্বিত একটি তালিকা ব্যবহার করে। তবে, get.next.eventশুধুমাত্র সময়গুলি পরিদর্শন করা দরকার। এটি শুধুমাত্র ইভেন্টগুলির একটি সারি বজায় রাখার জন্য দায়বদ্ধ
যে কোনও ইভেন্ট পাওয়ার পরে তা কাতারে রাখা যায় এবং
কাতারে প্রাথমিকতম ইভেন্টটি সহজেই আহরণ করা যায় এবং কলারের কাছে পৌঁছে দেওয়া যেতে পারে।
এই অগ্রাধিকার সারির সর্বোত্তম বাস্তবায়ন হ'ল এক গাদা, তবে এটি খুব উদ্বেগজনক 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 অ্যারে is এটিতে চারটি সারি রয়েছে (ক্ষেত্র হিসাবে অভিনয় করা) যা গ্রাহকদের বর্ণনা করে এবং সিমুলেশন চলাকালীন তাদের অভিজ্ঞতা রেকর্ড করে : "আগত", "পরিবেশিত", "সময়কাল" এবং "সহকারী" (সহকারীটির একটি ইতিবাচক সংখ্যা শনাক্তকারী, যদি থাকে তবে কে পরিবেশন করেছেন সেগুলি এবং অন্যথায় -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যখন সত্য, ইংরেজি কী প্রক্রিয়াকরণ পয়েন্ট বর্ণনা বাক্যের একটি স্ট্রিম নির্গত: পতাকা পরীক্ষা এবং ডিবাগিং জন্য সুবিধাজনক।
গ্রাহকদের কীভাবে সহায়তা দেওয়া হয় তা গুরুত্বপূর্ণ এবং আকর্ষণীয়। একাধিক প্রক্রিয়া কল্পনা করা যায়: এলোমেলোভাবে নির্ধারিত কিছু নির্দিষ্ট অর্ডারের মাধ্যমে, বা কে দীর্ঘতম (বা সবচেয়ে কম) সময় অবধি মুক্ত করেছেন সে অনুসারে ment এর মধ্যে অনেকগুলি মন্তব্য-আউট কোডে চিত্রিত হয়েছে:
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)
CUSTOMERSR50250
প্রতিটি গ্রাহকের অভিজ্ঞতা অনুভূমিক টাইমলাইন হিসাবে আসার সময় একটি বৃত্তাকার প্রতীক, যে কোনও হোল্ড ধরে অপেক্ষা করার জন্য একটি শক্ত কালো রেখা, এবং সহকারীের সাথে তাদের মিথস্ক্রিয়াটির সময়কালের জন্য একটি রঙিন রেখা হিসাবে পরিকল্পনা করা হয় (রঙ এবং রেখার ধরন সহায়কদের মধ্যে পার্থক্য করুন)। এই গ্রাহকদের প্লটটির নীচে হ'ল সহায়তাকারীদের অভিজ্ঞতা প্রদর্শন করা, কখন কখন তারা ছিল এবং কখন কোনও গ্রাহকের সাথে নিযুক্ত ছিল না সেগুলি চিহ্নিত করে। ক্রিয়াকলাপের প্রতিটি বিরতির শেষ বিন্দু উল্লম্ব বার দ্বারা সীমিত করা হয়।
যখন চালানো হয় তখন 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
...
160165
গ্রাহকরা একটি ব্যস্ত সংকেত গ্রহণ করার জন্য একটি বিশেষ (লাল) প্রতীক ব্যবহার করে গ্রাহক শনাক্তকারী দ্বারা অন-হোল্ড সময়কাল প্লট করে আমরা গ্রাহকদের অভিজ্ঞতা ধরে রাখতে পারি।
(এই প্লটগুলি এই পরিষেবা সারি পরিচালনা করার জন্য কারও জন্য একটি দুর্দান্ত রিয়েল-টাইম ড্যাশবোর্ড তৈরি করবে না!)
আপনি যে প্লেটগুলি এবং প্যারামিটারগুলিতে পাস করেছেন তার পরিবর্তনের সাথে তুলনা করে আকর্ষণীয় sim। গ্রাহকরা প্রক্রিয়াজাত হওয়ার জন্য খুব দ্রুত উপস্থিত হলে কী ঘটে? হোল্ডের সারিটি ছোট করা বা মুছে ফেলা হলে কী হয়? সহায়কগুলি যখন বিভিন্ন শিষ্টাচারে নির্বাচিত হয় তখন কী পরিবর্তন হয়? সহায়কগুলির সংখ্যা এবং ক্ষমতা গ্রাহকের অভিজ্ঞতাকে কীভাবে প্রভাবিত করে? এমন কিছু জটিল পয়েন্টগুলি কী কী যেখানে কিছু গ্রাহক মুখ ফিরিয়ে নেওয়া শুরু করে বা দীর্ঘ সময়ের জন্য ধরে রাখা শুরু করে?
সাধারণত, এর মতো স্পষ্ট আত্ম-অধ্যয়ন প্রশ্নাবলীর জন্য, আমরা এখানে থামব এবং বাকী বিশদটি অনুশীলন হিসাবে রেখে দেব। যাইহোক, আমি পাঠকদের হতাশ করতে চাই না যারা সম্ভবত এটি অর্জন করেছে এবং নিজেরাই এটি চেষ্টা করে দেখতে আগ্রহী (এবং সম্ভবত এটি পরিবর্তন করে এবং এটি অন্যান্য উদ্দেশ্যে এটি নির্মাণ করে), তাই নীচে যুক্ত করা হয়েছে সম্পূর্ণ কার্যকরী কোড।
টিইএক্স$
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)