我在为一家诊所做一个预约安排模拟。这个想法是，当模拟运行时，当患者到达系统时，他们请求与医生预约。他们必须等到约定的时间。

对于问题的细节，我有：
模拟运行21个时间单位（小时）有6个患者到达，时间为1、2、3、4、5和6医生检查患者正好需要1个时间单位（小时）可用的预约时间段为时间1、2、3、4、5、11、12、14、15、19和20
我的想法是使用一个名为df_appointment_slots的tibble来跟踪每个患者的插槽分配。这不仅仅是一项监测活动，因为患者只能选择未分配的时间段。
第一个代码定义了通过模拟可用的预约时隙。理想情况下，随着模拟的进行，表示时隙的每一行都将其assigned列更新为TRUE，并且在患者id属性之后是patient_id。

library(simmer)
library(tidyverse)

df_appointment_slots = tibble(sim_time = df_appointment_slots = tibble(
  sim_time = c(1,2,3,4,5,11,12,14,15,19,20),
  assigned = rep(FALSE, length(sim_time)),
  patient_id = rep(NA, length(sim_time)))

在此函数中，我有几个预约分配方案，为了示例的目的，我想将每个患者随机分配到可用的预约时段。在我的真实的应用程序中，遵循更复杂的规则，所以我需要它在一个我可以修改的函数中。

assign_appointment = function(env, env_now ,df = df_appointment_slots){
 p_id = function(){get_attribute(env, "patient_id")}
  
 #Randomly select an available time slot after current simulation time.
 df_assigned = df %>% 
   filter(assigned == FALSE,
          sim_time >= env_now) %>% 
   slice_sample() %>% 
    mutate(assigned = TRUE, patient_id = p_id) 
 
  #If there are no available time slots then the patient takes other    trajectory and leaves the system
  
  if(nrow(df_assigned) == 0){
    return(-1)
#We will check later that if this function returns a value of -1
#instead of using it for a timeout, we decide to change trajectory
#and make the patient leave the system. 
  }
   
  #df_updated switches the assigned time slot into the original df_appointment slots. If there is a better way to do this i'm open to ideas.

  df_updated = df %>% 
    anti_join(df_assigned, by="sim_time") %>% 
    rbind(df_assigned) %>% 
    arrange(sim_time)
  
  
  #Results of the function
  #We want to update de dataframe that is outside of this scope and of the simulation. That way next patient can't be assigned to a time_slot that is already assigned.
                    
  df_appointment_slots <<- df_updated 
  
  # We return the appointment time
  return(df_assigned$sim_time)
}

最后但并非最不重要的是，这里是模拟

clinic = simmer("Clinic") 

patient_trajectory <-
  trajectory("Patient_trajectory") %>% 
  
  #We assign a id to each patient
  set_attribute("patient_id", 1, mod = "+") %>% 

  #Appointment assignment
  set_attribute("appointment_time",
                assign_appointment(env = clinic,
                                   env_now = simmer::now(clinic),
                                   df = df_appointment_slots)) %>% 
  
  #If assign_appointment returns -1 then there are no more time_slots available and the patient leaves the system
  
  branch(
    option = function() {ifelse(get_attribute("appointment_time") == -1, 1,2)},
    continue = c(T, F),
    trajectory("leave_system") %>% 
      log_("There was no appointment slot available")
    ) %>% 
  
  #If the appointment was succesfully scheduled then the patient waits until the appointment time
  
  log_("The patient waits for the appointment") %>% 
  timeout(
    function(){get_attribute("appointment_time") - simmer::now(clinic)}) %>%
  
  #After waiting, the patient seizes the doctor for 1 hour
  seize("doctor") %>% 
  timeout(1) %>% 
  release("doctor")
  
clinic %>%
  add_generator("Patient", patient_trajectory, at(1,2,3,4,5,6)) %>% 
  run(until = 21)

当然，我会得到以下错误：

Error in `mutate()`:
i In argument: `patient_id = p_id`.
Caused by error:
! `patient_id` must be a vector, not a function.

它告诉我，assign_appointment函数中的p_id = function(){get_attribute(env, "patient_id")}被保存为函数，并且在模拟过程中不会动态评估，因此我可以将患者ID保存在df_appointment_slots tibble中。
我还担心我从根本上误解了R Simmer库及其功能。如果有更好的方法以完全定制的方式动态指定患者的时间段，我愿意接受建议。