在 Do_Parallel 中使用分支时，R Simmer 中的轨迹不完整

Question

我正在使用

simmer

包在 R 中构建模拟。

该模拟模拟了一家餐厅，顾客在下订单后等待食物。

每个订单资源的使用时间不同。

Branch

根据选择的资源分配具有相关超时值的轨迹，并记录所使用的资源是数字资源还是实时资源，以供以后参考。请注意，该轨迹本身并不完整（稍后解释）。

一个订单最多可以包含三种类型的产品，每种类型都有不同的概率，并且组装所需的时间也不同。这里的限制资源是组装订单的空间。装配体只有在其托盘有空间时才会启动。轨迹由以下函数返回。

# Packages and model variables used
library(simmer)
library(simmer.plot)
library(simmer.bricks)
library(tidyr)

# (p) probability
p_rts <- 0.125 # ready to serve menu item
p_hot <- 0.25 # hot food item
p_bev <- 0.7 # Beverage

# (t) time in seconds - average from 
t_rts <- 10
t_hot <- 175
t_bev <- 25

# arrival distribution
r_arrive <- function(){
    runif(20, min = 0, max = 600) %>% # all arrivals occur within first 600 seconds
    sort
}

# The trajectory where the issue likely exists
f_order_prepare <- function(e, p_rts, p_hot, p_bev, t_rts, t_hot, t_bev){
  trajectory() %>%
    set_attribute("start_assembly", function() now(e)) %>%
    do_parallel(
      traj = list(
        trajectory() %>% branch(
          function() ifelse(runif(1) <= p_rts, 1, 2),
          continue = c(TRUE, TRUE), 
          trajectory() %>% set_attribute("has_rts", 1) %>% timeout(t_rts), 
          trajectory() %>% set_attribute("has_rts", 0)),
        trajectory() %>% branch(
          function() ifelse(runif(1) <= p_hot, 1, 2),
          continue = c(TRUE, TRUE), 
          trajectory() %>% set_attribute("has_hot", 1) %>% timeout(t_hot),
          trajectory() %>% set_attribute("has_hot", 0)),
        trajectory() %>% branch(
          function() ifelse(runif(1) <= p_bev, 1, 2),
          continue = c(TRUE, TRUE), 
          trajectory() %>% set_attribute("has_bev", 1) %>% timeout(t_bev), 
          trajectory() %>% set_attribute("has_bev", 0))
      ),
      .env = e, 
      wait = TRUE
    ) %>%
    log_("order ready") %>%
    set_attribute("order_ready", function() now(e))
}

我们记录装配何时开始，然后并行运行三个分支。如果选择了一个产品，它会设置其超时并记录它被选择；否则，记录该产品未被选中。

do_parallel

等待三个轨迹中最长的一个完成，然后继续。

trj_QSR <- trajectory() %>%
  seize("pickup_capacity", 1) %>%
  log_("seized the pick_up capacity") %>%
  simmer::join(
    f_order_prepare(env, p_rts, p_hot, p_bev, 
                  t_rts, t_hot, t_bev)
    )%>%
  timeout(20) %>% #delay for customer to collect tray
  release("pickup_capacity", 1) %>%
  set_attribute("transaction_done", function() now(env))

## Initiate
reset(env)
set.seed(12345)
env <- simmer() 
env <- env %>%
  add_resource("pickup_capacity", 12) %>%
  add_generator("transaction", trj_QSR, 
                distribution = at(r_arrive()), mon = 2)

env %>% run(until=50000000) #~578 days to ensure issues are not related to run time

脚本执行没有错误；然而，只有前 13 件到达的产品能够走得足够远，以记录哪些产品在

do_parallel

中被选中，并且只有 2 件完成了他们的轨迹。另外 11 个人记录了选择，但随后停止了。以下代码总结了我跟踪的用于故障排除的属性。

get_mon_attributes(env) %>%
  dplyr::select(-c("time", "replication")) %>%
  pivot_wider(
    names_from = key,
    values_from = value
  ) %>%
  View(title = "atts")

总结： 由于某种原因，大多数到达者没有完成

do_parallel

轨迹，因此永远不会释放“pickup_capacity”资源，将剩余的到达者留在队列中。

我正在寻求帮助来找出发生这种情况的原因。谢谢。

Answer 1

我仍然想解决上面的问题，因为我觉得这种方法对于其他应用程序有好处；然而，我采取了不同的方法来实现我的目标，我想分享它，以防它对其他人有帮助。

主要变化：

• 我放弃了

  do_parallel

  方法。
• 选项数据（概率和时间）现在存储在数据框中而不是单个变量中。
• 使用函数从选项数据框中选择项目，并返回与选项数量相同的数字，每个数字充当二项式值

  1

  （如果未选择）和

  2

  （如果选择）。因为 simmer 属性必须是数字，所以使用

  0

  和

  1

  不起作用，因为前导零将会丢失。
• 超时函数然后将这些值分割成一个向量，并使用这些值来过滤产品数据。这不是运行多个轨迹并等待最后一个轨迹完成，而是简单地找到所选产品的单个最长时间并将其用作超时。

options <- data.frame(
  option = c(1, 2, 3),
  name = c("rts", "hot", "bev"),
  probability = c(0.125, 0.25, 0.7),  # probabilities for each option
  time = c(10, 175, 20)  # time taken by each option
)

# Select options based on probabilities ensure at least one is selected
select_options <- function() {
  selected <- rbinom(n = 3, size = 1, prob = options$probability) + 1
  # If no options are selected, randomly select one, using the same weighted probability
  if (all(selected == 1)) {
    selected[sample(1:length(selected), 1, prob = options$probability)] <- 2
  }
  as.numeric(paste(selected, collapse = ""))
}


trj_assemble <- trajectory() %>%
  set_attribute("selected_options", function() select_options()) %>%
  timeout(function() {
    selected <- as.numeric(
      strsplit(
        as.character(
          get_attribute(env, "selected_options")), "")[[1]])
    max(options$time[selected > 1])
  })

trj_main <- trajectory() %>%
  seize("pickup_capacity", 1) %>%
  set_attribute("start_assembly", function() now(env)) %>%
  simmer::join(trj_assemble) %>%
  set_attribute("order_ready", function() now(env)) %>%
  release("pickup_capacity", 1) 

reset(env)
set.seed(12345)
env <- simmer() 
env <- env %>%
  add_resource("pickup_capacity", n_tray_pu) %>% #n_tray_pu <- 12
  add_generator("transaction", trj_main, 
                distribution = at(r_arrive()), mon = 2)

env %>% run(until=7200)

除了工作（总是一个优点）之外，这种方法使用数据框更容易缩放或更改选项。