R Simmer:如何将溢出逻辑应用于循环计数器选择

Question

我试图模拟一个队列，其中有两个计数器，它们有不同数量的代理接受调用。

我使用自定义循环来将客户分配到计数器(分配到计数器容量，如果两者都有相似数量的代理，那么它将是默认的慢炖循环(。

我想应用一种溢出机制，如果所选计数器繁忙，调用方会等待30秒，如果没有占用计数器，则会发生另一个选择，推翻循环并使用第一个可用策略。这是我想不通的部分。

到目前为止，我得到的是：

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)

Answer 1

经过大量的测试和尝试，我想我最终找到了答案。我不得不使用一些分支和一些启发式方法来复制我脑海中的情况。这是最终的解决方案。

# 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")