boin_plot.R

library(tidyverse)


dec_labs = c("E = Escalate to the next higher dose",
             "S = Stay at the current dose",
             "D = De-escalate to the next lower dose",
             "DE = De-escalate and eleminate the current and higher doses")

#cf BOIN design
db = tibble(
  n_eval = 1:10,
  escalate_max = c(0, 0, 0, 0, 0, 0, 1, 1, 1, 1),
  deecalate_min = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3),
  eliminate_min = c(NA, NA, 2, 3, 3, 3, 4, 4, 4, 5)
)

#Infos patients from CSV file
#pat = read.csv2("patients.csv")

#Example
pat =
  tribble(
  ~subjid, ~dose, ~DLT,
  1,       1,     "No",
  2,       1,     "No",
  3,       2,     "No",
  4,       2,     "No",
  5,       2,     "No",
  6,       2,     "Yes",
  7,       1,     "No",
  8,       1,     "No",
  9,       1,     "Yes",
)

pat = pat %>% 
  mutate(
    subjid = paste0("#", subjid),
    n_dlt = cumsum(DLT=="Yes"),
    n_eval = row_number(), 
    .by=dose
  ) %>% 
  filter(!is.na(DLT) & DLT!="")

x = db %>% 
  rowwise() %>% 
  mutate(
    dose = list(0:2),
    rows = list(tibble(
      n_dlt = seq(0, n_eval),
      decision = case_when(
        n_dlt >= eliminate_min ~ "DE",
        n_dlt >= deecalate_min ~ "D",
        n_dlt <= escalate_max ~ "E",
        .default = "S"
      )
    ))
  ) %>% 
  unnest(rows) %>% 
  unnest(dose) %>% 
  mutate(
    decision_label = factor(decision,
                            levels = c("E", "S", "D", "DE"),
                            labels = dec_labs %>% str_wrap(40)),
  ) %>% 
  left_join(pat, by=c("n_eval", "dose", "n_dlt"))
x




p = x %>% 
  ggplot(aes(x=factor(n_eval), y=factor(n_dlt), fill=decision_label, label=decision)) +
  geom_tile() + geom_text() + 
  geom_label(aes(label=subjid), na.rm=TRUE, fill="yellow") +
  facet_grid(.~dose) +
  scale_fill_manual(values = c("#5fff33", "#33d2ff", "#ff96c5", "#ff3367")) + 
  coord_fixed() +
  labs(x="Nummber of evaluable patients treated at current dose", 
       y="Number of patients with DLT", 
       fill="Decision") +
  theme_minimal() +
  theme(
    axis.line = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),
    legend.position="top"
    # legend.position=c(0,1)
  )

print(p)

Maybe we could add dates to the input and add a Gant diagram below?