Dynamically modify a dataframe as a R simmer simulation runs? I need it for appointment scheduling simulation

[Tricipy]

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 this problem the situation is as follows:

• Simulation runs for 21 time units (hours)
• There are 6 patient arrivals, at times 1,2,3,4,5 and 6
• There is only one doctor and can only check 1 patient at a time
• 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

It is kind of different to the traditional "push" simulations because the resource needs to be seized at specific moments in time. I'm even wondering if it is possible to have a simulation of this kind in R simmer.

I drew a diagram showing the logic:

I'm posting the code now

library(simmer)
library(tidyverse)

#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


#This dataframe is the one I want to update as the simulation goes on
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)))



########################## Assignment function #################################

# This global variable is used for debugging purposes. For each patient that 
# goes through an appointment assignment, it should increment the counter by
# 1

times_run_assign_appointment_counter = 0

assign_appointment = function(p_id, env_now ,df = df_appointment_slots){
  
  times_run_assign_appointment_counter <<- times_run_assign_appointment_counter + 1
  
  # 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.
  
  
  #This block of code should be removed_________________________________________
  # I want p_id that comes from a get_attribute function to give me the 
  # patient_id number. Instead it is returning a function that can't be inserted
  # In the dataframe (tibble) below. How can I fix this ????
  
  # I'm doing this so that the code doesn't crashes.
  if(is.function(p_id)){
    p_id <- 9999}
  #_____________________________________________________________________________
  
  df_assigned = df %>% 
    filter(assigned == FALSE,
           sim_time >= env_now) %>% 
    slice_sample() %>% #Randomly select an available time slot that is after
    #the current simulation time.
    mutate(assigned = TRUE, patient_id = p_id) #Change the time slot status
  
  
  #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)
  
  df_updated
  
  #Results of the function
  df_appointment_slots <<- df_updated #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.
  
  
  # We return the appointment time
  return(df_assigned$sim_time %>% as.numeric())
}

############################ PATIENT ID FUNCTION ###############################

patient_counter_n = -1
patient_counter = function(){
  patient_counter_n <<- patient_counter_n + 1
  return(patient_counter_n)
}

############################ Simulation ########################################


clinic = simmer("Clinic") 

patient_trajectory <-
  trajectory("Patient_trajectory") %>% 
  
  #We assign a id to each patient. This works as intended
  set_attribute("patient_id", patient_counter) %>% 
  
  #Appointment assignment
  #This doesn't work as intended for two reasons
  #get_attribute(Clinic, "patient_id") is returning a function and not a number
  #The whole function only runs one time and not each time a new patient arrives
  set_attribute("appointment_time",
                assign_appointment(p_id = function(){get_attribute(Clinic, "patient_id")},
                                   env_now = simmer::now(clinic),
                                   df = df_appointment_slots)) %>% 
  
  #If assign_appointment returns -1 then there are no more time_slots available
  #the patient leaves the system
  
  branch(
    option = function() {ifelse(get_attribute(clinic, "appointment_time") == -1, 1,0)},
    continue = c(T),
    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_(function() {paste0("Patient: ", 
                          get_attribute(clinic, "patient_id"), 
                          " is wating until ", 
                          get_attribute(clinic, "appointment_time") )}) %>% 
  timeout(
    function(){get_attribute(clinic, "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), mon = 2) %>% 
  add_resource("doctor", capacity = 1) %>% 
  run(until = 21) %>% 
  get_mon_attributes()


############################## Results #########################################
#This should be printing 6. I don't get why that function is only running 1 time
#and not everytime a patient arrives...
print(paste0("Number of times the assignment_function was run: ", times_run_assign_appointment_counter))

#I also print the dataframe to show that it's only running 1 time and it is not
#registering the patient_id correctly
df_appointment_slots %>% print()

So in summary I have two issues in this section of the code:

set_attribute("appointment_time",
                assign_appointment(p_id = function(){get_attribute(Clinic, "patient_id")},
                                   env_now = simmer::now(clinic),
                                   df = df_appointment_slots))

1. p_id = function(){get_attribute(Clinic, "patient_id") is returning a function to the assign_appointment function instead of a number of the patient_id attribute. I need to be able to register the patient_id in the dataframe.

2. The whole assign_appointment() function is only running one time, when i need it to run 6 times, each for when a patient arrives a asks for an appointment. I don't get why it only runs 1 time and for example, the simple patient counter in set_attribute("patient_id", patient_counter) is working as intended and updating the global variable patient_counter_n. I should be able to update a dataframe in a similar way right?

[Enchufa2]

As you discovered here, you were executing the assign_appointment once when the trajectory was created. Instead, it needs to be enclosed in a parameterless function, so that it is executed each time an arrival reaches that point in the trajectory, in the same way you did with the patient_counter function. Therefore,

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

Please, next time, try to avoid crossposting. This generates unnecessary duplicity.