Is it possible to "dynamically" modify a dataframe as a R simmer simulation runs? I need it for appointment scheduling simulation

Question

I'm building an appointment scheduling simulation for a clinic. The idea is that as the simulation runs, when patients arrive to the system they request an appointment with a doctor. Then they have to wait until the time of the appointment.

For the details of the problem, I have that:

Simulation runs for 21 time units (hours) There are 6 patient arrivals, at times 1,2,3,4,5 and 6 The doctor takes exactly 1 time unit (hour) to check a patient Available appointment slots are at times 1,2,3,4,5,11,12,14,15,19 and 20

My idea is to use a tibble called df_appointment_slots to keep track of the assignemnt of slots to each patient. It's not a mere monitoring activity because patients can only choose time slots that are not assigned.

This first code defines the appointment slots available through the simulation. Ideally as the simulation goes, each row that represents a time slot gets it's assigned column updated to TRUE and it's patient_id after a patient id attribute.

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

Here in this function I have several appointment assignment schemes, For the sake of the example i want to assign each patient randomly to a appointment slot that is available. In my real application, follows more complex rules so I need it to be in a function I can modify.

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)
}

Last but not least, here is the simulation

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)

Of course I get the following error:

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

It's telling me that p_id = function(){get_attribute(env, "patient_id")} in the assign_appointment function is getting saved as a function and it's not being evaluated dynamically as the simulation goes so that I can save the patient id in the df_appointment_slots tibble.

I'm also worried I'm fundamentally misunderstanding the R Simmer library and it's capabilities. If there is a better way to dynamically appoint patients to time slots in a fully customizable way, I'm open to suggestions.

Answer 1

I was having troubles with the evaluation of functions inside the simulation. I just confirmed that enclosing assign_appointment() in a nameless function at the set_attribute() works as intended. Everytime assign_appointment is called the dataframe called df_appointment_slots is updated as intended.

So yeah, here is the small correction i had to make.

#Appointment assignment
  set_attribute("appointment_time",function(){
                assign_appointment(p_id = get_attribute(clinic, "patient_id"),
                                   env_now = simmer::now(clinic),
                                   df = df_appointment_slots)}) %>% 

So to answer my own question: Yes, it's posible to update a dataframe as a simulation runs.