R Simmer - Reallocate resource between pots based on queue size

Question

I have a working example of a simmer DES, for a simple outpatient department service. There are high priority and low priority patients, and each has a dedicated clinic. The high priority clinic has 5 slots per day, the low priority clinic has 1 slot per day. Here is the test code:

testmixcap <- simmer()

highpriority <- trajectory("high") %>%
  log_("High priority arrival - add to wl") %>%
  select("highpclinic") %>%
  seize_selected() %>%
  log_("Attend appointment") %>%
  timeout(1) %>%
  release_selected() %>%
  log_("Discharge")

lowpriority <- trajectory("low") %>%
  log_("Low priority arrival - add to wl") %>%
  select("lowpclinic") %>%
  seize_selected() %>%
  log_("Attend appointment") %>%
  timeout(1) %>%
  release_selected() %>%
  log_("Discharge")

testmixcap %>%
  add_generator("high",highpriority,at(1,1,1,2,2,3,3,3,4)) %>%
  add_generator("low",lowpriority,at(1,1,1,1,2,2,2,3,3,3,4,4,4,5,5,6)) %>%
  add_resource("highpclinic",5) %>%
  add_resource("lowpclinic",1) 

testmixcap %>%
  run(until = 100)

testmixcap %>%
  get_mon_resources()

My question is, on days where there is no demand for the high priority clinic slots (or not all 5 are required), is there a way to tell the simmer to release the rest of the slots to the low priority resource? E.g. the high priority clinic sees 2 patients but it's remaining 3 slots are added to the low priority clinic and it gets through 4 patients?

The clinics would then need to reset to their normal capacity the following day, but I think I could do that using a schedule instead of fixed priority.

I think the answer lies in using signals but I just can't get my head around them. I also considered merging the two clinics into one pot, and using priority to allocate to the higher priority patients. But that means that there could be days when we see zero low priority patients which is very unlikely.

Any help gratefully received!

Answer 1

I managed to find a solution using global variables, and a fake arrivals generator which acts as a daily monitor for when excess capacity has been allocated to a high priority clinic.

library(simmer)
library(dplyr)

testmixcap <- simmer()

highpriority <- trajectory("high") %>%
  log_("High priority arrival - add to wl") %>%
  select("highpclinic") %>%
  seize_selected() %>%
  set_global("highpseentoday",1,"+") %>%
  log_("Attend appointment") %>%
  timeout(1) %>%
  release_selected() %>%
  log_("Discharge")

lowpriority <- trajectory("low") %>%
  log_("Low priority arrival - add to wl") %>%
  select("lowpclinic") %>%
  seize_selected() %>%
  log_("Attend appointment") %>%
  timeout(1) %>%
  release_selected() %>%
  log_("Discharge")

cap_monitor <- trajectory() %>%
  set_global("highpseentoday",0) %>% 
  timeout(0.1) %>%
  log_("Check if all today's slots used in high priority clinic") %>%
  branch(
    function(){
      seentoday <- get_global(testmixcap,"highpseentoday")
      highpcap <- get_capacity(testmixcap,"highpclinic")
      if(seentoday < highpcap) {1} else {0}
    }
    ,continue = TRUE
    ,trajectory() %>% set_capacity("lowpclinic",value = function(){
      seentoday <- get_global(testmixcap,"highpseentoday")
      highpcap <- get_capacity(testmixcap,"highpclinic")
      highpcap - seentoday
    },mod = "+")
  ) %>%
  timeout(0.9) %>%
  rollback(Inf)


testmixcap %>%
  add_generator("high",highpriority,at(1,1,1,2,2,3,3,3,4),mon = 2) %>%
  add_generator("low",lowpriority,at(1,1,1,1,2,2,2,3,3,3,4,4,4,5,5,6)) %>%
  add_resource("highpclinic",5) %>%
  add_resource("lowpclinic",schedule(c(1,2),c(1,1),2)) %>% 
  add_generator("monitor",cap_monitor,at(1))

testmixcap %>%
  run(until = 100)

testmixcap %>%
  get_mon_resources()

testmixcap %>%
  get_mon_arrivals()