I'm trying to simulate a queue wherein there are two counters that have a different number of agents taking calls.
I'm using a custom round-robin to distribute customers to counters (apportioned to counters capacity, if both have a similar number of agents then it will be the default simmer round-robin).
I want to apply an overflow mechanism where if the selected counter is busy, the caller waits for 30 sec and if not seized the counter then another selection happens overruling the round-robin and using a first-available policy. This is the part I can't figure out.
Here is what I've got so far:
callers2 <-
trajectory("Caller's Path") %>%
log_("Caller Connects") %>%
renege_in(function() rnorm(1,avg_time_before_abandon,sd_time_before_abandon), # max time the customer waits before abandon
out = trajectory("Caller Abandones") %>%
log_("I abandon")) %>%
set_attribute("start_time", function() {now(helpline2)}) %>% #defnie start time
log_(function() {paste("Vendor 1 Occupancy: ", get_server_count(helpline2, c("vendor1")))}) %>%
log_(function() {paste("Vendor 2 Occupancy: ", get_server_count(helpline2, c("vendor2")))}) %>%
set_attribute("vendor_selector", function() {runif(1,0,1)}) %>%
# custom round-robin
simmer::select(function() {
if(get_attribute(helpline2, "vendor_selector") < no_of_vendor1_agents/(no_of_vendor1_agents+no_of_vendor2_agents)){
vendors_str[1]
}
else{
vendors_str[2]
}
}) %>%
log_(function() {paste("Selected: ", get_selected(helpline2), "with occupancy", get_server_count_selected(helpline2))}) %>%
seize_selected(1) %>% #occupy the selected agent
renege_abort() %>% # in case the customer reaches the agent before abandoning kill the abandon trigger
log_(function() {paste("Waited: ", now(helpline2) - get_attribute(helpline2, "start_time"))}) %>% # calculate wait time
timeout(function() rnorm(1, avg_handling_time, sd_handling_time)) %>% # add handling time
release_selected(1) %>% #release the selected agent
log_(function() {paste("Call Handled: ", now(helpline2))})
helpline2 <-
simmer("helpline") %>%
add_resource("vendor1", no_of_vendor1_agents) %>%
add_resource("vendor2", no_of_vendor2_agents) %>%
add_generator("Caller", callers2, function() rexp(1, lambda)) # caller arrival
set.seed(100)
testrun <- helpline2 %>% run(until = 1600)
A lot of tests and tries and I think I eventually figured it out. I had to use a few branches and some heuristic approaches to replicate the situation I had in mind. Here is the final solution.
# LOAD LIBRARIES ----
library(simmer)
library(Rcpp)
library(dplyr)
library(tidyr)
library("simmer.plot")
options(scipen = 999)
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::----
#////////////////////////////////////////////////////////////////////////////////////////////////////////
# Multiple Agents from Multiple Vendors One Queue Abandonment, Custom Round Robin Allocation with overflow ----
#////////////////////////////////////////////////////////////////////////////////////////////////////////
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# GLOB PARAM ----
vendors_str <- paste0("vendor", 1:2)
no_of_vendor1_agents <- 3
no_of_vendor2_agents <- 5
avg_time_before_abandon <- 150
sd_time_before_abandon <- 40
avg_handling_time <- 500
sd_handling_time <- 100
lambda <- 0.0278
OverflowTime <- 30
# Functions ----
check_resource_unavailable <- function(){
get_capacity_selected(helpline) - get_server_count_selected(helpline) == 0
}
check_resource_available <- function(){
get_capacity_selected(helpline) - get_server_count_selected(helpline) > 0
}
abandon_func <- function(){
#avg_time_before_abandon
rnorm(1,avg_time_before_abandon,sd_time_before_abandon)
}
overflow_abandon_func <- function(){
#avg_time_before_abandon - OverflowTime
rnorm(1,avg_time_before_abandon,sd_time_before_abandon)
}
# Temp_RR_Assignment_Worked_Trej ----
Temp_RR_Assignment_Worked_Trej <-
trajectory() %>%
set_attribute("Retry_Worked", function() {1}) %>%
log_("entredtempregular") %>%
#log_(function() {paste("Seized: ", get_seized_selected(helpline))}) %>%
renege_abort() %>% # in case the customer reaches the agent before abandoning kill the abandon trigger
log_(function() {paste("Waited: ", now(helpline) - get_attribute(helpline, "start_time"))}) %>% # calculate wait time
set_attribute("Time_Waited_In_RR_Assignment_Worked", function() {now(helpline) - get_attribute(helpline, "start_time")}) %>%
timeout(function() rnorm(1, avg_handling_time, sd_handling_time)) %>% # add handling time
set_attribute("Handled_In_RR_Retry", function() {now(helpline) - get_attribute(helpline, "start_time")-get_attribute(helpline, "Time_Waited_In_RR_Assignment_Worked")}) %>%
release_selected(1) %>% #release the selected agent
log_(function() {paste("Call Handled: ", now(helpline))})
# Overflow_Triggered_Trej ----
Overflow_Triggered_Trej <-
trajectory() %>%
set_attribute("Overflows_Retry_Not_Worked", function() {1}) %>%
renege_in(overflow_abandon_func, # max time the customer waits before abandon
out = trajectory("Caller Abandones") %>%
set_attribute("Abandones_In_Overflow", function() {1}) %>%
log_("#### Overflow Abandon")) %>%
log_("Entered_Overflow") %>%
#simmer::select(vendors_str, policy = "first-available") %>%
simmer::select(vendors_str, policy = "shortest-queue-available") %>%
set_queue_size_selected(1000) %>%
set_attribute("selected_overflow_vendor", function() {as.numeric(gsub("vendor","", get_selected(helpline)))}) %>%
log_(function() {paste("Selected 2nd: ", get_selected(helpline), "with occupancy", get_server_count_selected(helpline))}) %>%
seize_selected(1) %>% #occupy the selected agent
#log_(function() {paste("Seized: ", get_seized_selected(helpline))}) %>%
renege_abort() %>% # in case the customer reaches the agent before abandoning kill the abandon trigger
log_(function() {paste("Waited: ", now(helpline) - get_attribute(helpline, "start_time"))}) %>% # calculate wait time
set_attribute("Time_Waited_In_Overflow", function() {now(helpline) - get_attribute(helpline, "start_time")}) %>%
timeout(function() rnorm(1, avg_handling_time, sd_handling_time)) %>% # add handling time
set_attribute("Handled_In_Overflow", function() {now(helpline) - get_attribute(helpline, "start_time")-get_attribute(helpline, "Time_Waited_In_Overflow")}) %>%
release_selected(1) %>% #release the selected agent
log_(function() {paste("Call Handled: ", now(helpline))})
# Temp_RR_Assignment_Retry_Trej ----
Temp_RR_Assignment_Retry_Trej <-
trajectory() %>%
set_queue_size_selected(1000) %>%
set_attribute("In_RR_Retry_Step", function() {1}) %>%
renege_in(abandon_func, # max time the customer waits before abandon
out = trajectory("Caller Abandones") %>%
set_attribute("Abandones_In_RR_Retry", function() {1}) %>%
log_("#### Temp Assignment Abandon")) %>%
log_(function() {paste("rr vendor occupancy:", get_server_count_selected(helpline))}) %>%
log_(function() {paste("Queue of the rr selected: ", get_queue_count_selected(helpline))}) %>%
simmer::select(function () paste0("vendor", get_attribute(helpline, "selected_rr_vendor"))) %>%
log_(function() {paste("rr vendor selected again:", get_selected(helpline))}) %>%
log_("Entered retry loop") %>%
branch(
check_resource_available, continue = F,
trajectory() %>%
set_attribute("Time_Spent_In_Success_RR_Retry", function() {now(helpline) - get_attribute(helpline, "start_time")}) %>%
seize_selected (continue = T, post.seize = Temp_RR_Assignment_Worked_Trej)
) %>%
timeout(0.5) %>%
log_(function() {paste("Total wait in loop: ", now(helpline) - get_attribute(helpline, "start_time"))}) %>% # calculate wait time
rollback(amount = 3, times = OverflowTime*2-1) %>%
set_attribute("Time_Spent_In_Failed_RR_Retry", function() {now(helpline) - get_attribute(helpline, "start_time")}) %>%
branch(option = function() {1}, continue = T, Overflow_Triggered_Trej)
# RR_Worked_Trej ----
RR_Worked_Trej <-
trajectory() %>%
set_attribute("RR_Worked_Trej", function() {1}) %>%
renege_in(abandon_func, # max time the customer waits before abandon
out = trajectory("Caller Abandones") %>%
set_attribute("Abandones_In_RR_Worked", function() {1}) %>%
log_("####RR Worked Abandon")) %>%
seize_selected(1) %>% #occupy the selected agent
#log_(function() {paste("Seized: ", get_seized_selected(helpline))}) %>%
renege_abort() %>% # in case the customer reaches the agent before abandoning kill the abandon trigger
log_(function() {paste("Waited: ", now(helpline) - get_attribute(helpline, "start_time"))}) %>% # calculate wait time
timeout(function() rnorm(1, avg_handling_time, sd_handling_time)) %>% # add handling time
set_attribute("Handled_In_RR_Worked", function() {now(helpline) - get_attribute(helpline, "start_time")}) %>%
release_selected(1) %>% #release the selected agent
log_(function() {paste("Call Handled: ", now(helpline))})
# Caller_Main_Trej ----
Caller_Main_Trej <-
trajectory("Caller's Path") %>%
log_("Caller Connects") %>%
set_attribute("start_time", function() {now(helpline)}) %>%
log_(function() {paste("Vendor 1 Occupancy: ", get_server_count(helpline, c("vendor1")))}) %>%
log_(function() {paste("Vendor 2 Occupancy: ", get_server_count(helpline, c("vendor2")))}) %>%
set_attribute("vendor_selector", function() {runif(1,0,1)}) %>%
log_(function() {paste("vendor_selector: ", get_attribute(helpline, "vendor_selector"))}) %>%
simmer::select(function() {
if(get_attribute(helpline, "vendor_selector") < no_of_vendor1_agents/(no_of_vendor1_agents+no_of_vendor2_agents)){
vendors_str[1]
}
else{
vendors_str[2]
}
}) %>%
log_(function() {paste("RR Vendor Selected: ", get_selected(helpline), "with occupancy", get_server_count_selected(helpline))}) %>%
set_attribute("selected_rr_vendor", function() {as.numeric(gsub("vendor","", get_selected(helpline)))}) %>%
branch(
check_resource_available, continue = F,
RR_Worked_Trej
) %>%
branch(
check_resource_unavailable, continue = TRUE,
trajectory() %>%
set_queue_size_selected(0) %>%
seize_selected (continue = c(T, T), post.seize = Overflow_Triggered_Trej, reject = Temp_RR_Assignment_Retry_Trej)
)
# Resources - Generator ----
helpline <-
simmer("helpline") %>%
add_resource("vendor1", no_of_vendor1_agents) %>%
add_resource("vendor2", no_of_vendor2_agents) %>%
add_generator("Caller", Caller_Main_Trej, function() rexp(1, lambda), mon = 2) # caller arrival
# Run ----
set.seed(10)
testrun <- helpline %>% run(until = 3600)
# Outcome ----
Resource.df <- as.data.frame(testrun %>% get_mon_resources())
Arrivals.df <- as.data.frame(get_mon_arrivals(testrun, per_resource = T, ongoing = T) %>%
transform(waiting_time = round(end_time - start_time - activity_time)))
Attr.df <- get_mon_attributes(testrun) %>% as.data.frame() %>% mutate_if(is.character, as.factor)
Attr.df %>% filter(key %like% "%Time_Waited%") %>%
ggplot(aes(time, value)) +
geom_line()+
geom_smooth(method = "loess")