gg_accrual.R

#' @title {Accrual of Patients in a Clinical Trial}
#' @description {This function plots the expected, randomised and registered number of patients
#' in a clinical trial.}
#' @param start Character. Start date of the trial. Default is "2020-01-01".
#' @param end Character. End date of the trial. Default is "2022-12-31".
#' @param n_target Numeric. Expected number of patients in the trial.
#' @param finished Is patient recruitment finished?
#' @param dates_rando Numeric. Vector of dates of randomised patients.
#' @param dates_regi Numeric. Vector of dates of registered patients.
#' @param x_axis_text Position of X-axis text: 'asis' (default)), 'shifted'.
#' @return A ggplot object.
#' @examples
#' gg_accrual()
#' @export
#' @importFrom purrr map2_int map_vec
#' @importFrom tidyr pivot_longer nest
#' @import lubridate
#' @import dplyr
#' @import ggplot2
gg_accrual <- function(
    start = "2020-01-01",
    end = "2022-12-31",
    n_target = 150,
    finished = FALSE,
    dates_rando = NULL,
    dates_regi = NULL,
    x_axis_text = 'asis'
) {

  n.dodge <- if (x_axis_text == 'asis') {
    1 } else if (x_axis_text == 'shifted') {
      2
    } else {
      stop("Please choose between 'asis' and 'shifted'!")
    }


  # if dates_regi is null, set dates_regi to NA
  if (is.null(dates_regi)) dates_regi <- lubridate::ymd(NA)
  # if dates_rando is null, set dates_rando to NA
  if (is.null(dates_rando)) dates_rando <- lubridate::ymd(NA)

  # convert dates_rando to a list
  dates_rando <- list(dates_rando)
  # convert dates_regi to a list
  dates_regi <- list(dates_regi)
  # convert start to ymd
  start <- lubridate::ymd(start)
  # convert end to ymd
  end <- lubridate::ymd(end)
  # calculate the number of months between start and end
  # if end is less than today's date, set end to today's date
  n_months <- (lubridate::interval(start, end) %/% months(1) + 1)

  if (end > lubridate::ymd(Sys.Date()) & finished == FALSE) {
    end <- lubridate::ymd(Sys.Date())
  } else if  (end < lubridate::ymd(Sys.Date()) & finished == TRUE)  {
    end <- map_vec(dates_rando, max)
  } else {
    end <- end
  }

  # create a dataframe with a column of dates between start and end
  # and a column of months between start and end
  df.ACCRUAL <- dplyr::tibble(
    DATE = seq(start, end, by = "days"),
    MONTH = format(DATE, "%Y-%m")
  ) %>%
    # group by month
    dplyr::group_by(MONTH) %>%
    # nest the dataframe
    tidyr::nest() %>%
    dplyr::mutate(
      # calculate the number of patients expected per month
      N = n_target / n_months,
      # calculate the number of randomised patients per month
      N_RANDO = purrr::map2_int(
        .x = dates_rando,
        .y = data,
        # if the randomised patient's date is within the month, add 1
        ~ sum(ymd(.x) %within% lubridate::interval(
          min(.y$DATE, na.rm = TRUE),
          max(.y$DATE, na.rm = TRUE)
        ), na.rm = TRUE)
      ),
      # calculate the number of registered patients per month
      N_REGI = purrr::map2_int(
        .x = dates_regi,
        .y = data,
        # if the registered patient's date is within the month, add 1
        ~ sum(ymd(.x) %within% lubridate::interval(
          min(.y$DATE, na.rm = TRUE),
          max(.y$DATE, na.rm = TRUE)
        ), na.rm = TRUE)
      )
    ) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(
      # calculate the cumulative number of expected patients
      N_EXP = round(cumsum(N)),
      # if the cumulative number of expected patients is greater than the
      # number of expected patients, set the cumulative number of expected
      # patients to the number of expected patients
      N_EXP = ifelse(N_EXP > n_target, n_target, N_EXP),
      # calculate the cumulative number of randomised patients
      N_RANDO = cumsum(N_RANDO),
      # calculate the cumulative number of registered patients
      N_REGI = cumsum(N_REGI),
      # convert the month column to numeric
      MONTH = as.numeric(as.factor(MONTH))
    ) %>%
    # select the month, expected, randomised and registered columns
    dplyr::select(MONTH, N_EXP, N_RANDO, N_REGI) %>%
    # pivot the dataframe
    tidyr::pivot_longer(
      cols = starts_with("N_"),
      values_to = "NMB",
      names_to = "PATIENTS"
    ) %>%
    dplyr::mutate(
      # convert the patients column to a factor
      PATIENTS = case_when(
        PATIENTS == "N_EXP" ~ "expected",
        PATIENTS == "N_RANDO" ~ "randomised",
        PATIENTS == "N_REGI" ~ "registered"
      ),
      PATIENTS = factor(
        PATIENTS,
        levels = c(
          "expected",
          "registered",
          "randomised"
        )
      )
    ) %>%
    na.omit() %>%
    droplevels() %>%
    dplyr::rename(Patients = PATIENTS)
  # create a plot

  ggplot(
    df.ACCRUAL,
    aes(
      x = MONTH,
      y = NMB,
      colour = Patients,
      group = Patients
    )
  ) +
    # add a line to the plot
    geom_line() +
    # add points to the plot
    geom_point() +
    # set the x-axis breaks to every 2 months
    scale_x_continuous(breaks = seq(1, max(df.ACCRUAL$MONTH), 2),
                       guide = guide_axis(n.dodge = n.dodge)) +
    # add a vertical line to the plot
    geom_vline(
      xintercept = max(df.ACCRUAL$MONTH),
      linetype = 4,
      linewidth = 1,
      colour = "gray"
    ) +
    # set the colour of the lines and points
    scale_color_manual(values = c("darkgreen", "blue3", "red3")) +
    # add labels to the plot
    geom_label(
      data = filter(df.ACCRUAL, MONTH == max(MONTH)),
      aes(label = NMB),
      show.legend = FALSE
    ) +
    # set the theme of the plot
    theme_bw() +
    theme(
      # modify grid
      panel.grid.minor.x = element_blank(),
      panel.grid.major.x = element_blank(),
      panel.spacing = unit(0.60, "cm"),
      # modify text
      axis.text.x = element_text(size = 10),
      axis.text.y = element_text(size = 10),
      axis.title.x = element_text(size = 10, hjust = 1),
      axis.title.y = element_text(
        angle = 90,
        color = "grey50",
        size = 10,
        hjust = 0.5
      ),
      # headers of facets
      strip.text = element_text(colour = "white", face = "bold", size = 12),
      strip.background = element_rect(fill = "#4c4a4a"),
      # legend
      legend.text = element_text(size = 12),
      legend.position = "top",
      # caption
      plot.caption = element_text(hjust = 0, color = "grey50")
    ) +
    # set the title, x-axis and y-axis labels
    labs(
      title = NULL,
      x = paste0("Months since start of trial (", start, ")"),
      y = "Number of patients"
    )
}
NULL