gg_accrual_by_month.R

#' @title {Plot Accrual of patients by month}
#' @description {This function creates a plot of the accrual of patients by month.}
#' @param data A data frame containing the dates column.
#' @param dates The name of the dates column in \code{data}.
#' @return A ggplot object.
#' @export
#' @examples
#' # Create a data frame
#' df <- data.frame(
#'   dates = seq(as.Date("2020-01-01"), as.Date("2020-07-01"), by = "month")
#' )
#'
#' # Create the plot
#' gg_accrual_by_month(data = df, dates = "dates")
gg_accrual_by_month <- function(data, dates) {

  # Complete sequence of months
  date.min <- data %>%
    select({{ dates }}) %>%
    pull() %>%
    min(na.rm = TRUE)
  date.max <- data %>%
    select({{ dates }}) %>%
    pull() %>%
    max(na.rm = TRUE)
  date.seq <- seq(date.min, date.max, by = "day")
  df.month <- data.frame(
    YEAR = lubridate::year(date.seq),
    MONTH = lubridate::format_ISO8601(date.seq, precision = "ym")
  ) %>%
    distinct()


  # select the dates column from the data frame
  data <- data %>%
    select({{dates}}) %>%
    # rename the dates column to DATES
    rename(DATES = 1) %>%
    # create two new columns, YEAR and MONTH
    mutate(
      YEAR = lubridate::year(DATES),
      MONTH = lubridate::format_ISO8601(DATES, precision = "ym")
    ) %>%
    right_join(df.month, by = c("YEAR", "MONTH")) %>%
    # count the number of patients randomised per month
    group_by(MONTH) %>%
    summarise(n = sum(!is.na(DATES))) %>%
    ungroup() %>%
    # create a new column, MONTH_FIRST, which is TRUE if the month is January
    mutate(MONTH_FIRST = str_detect(MONTH, "01$"))

  # find the position of the vertical lines
  pos.vlines <- which(data$MONTH_FIRST == TRUE) - 0.5

  # plot the data
  ggplot(data, aes(x = MONTH, y = n)) +
    # plot the bars
    geom_col(width = 0.5, fill = 'grey', alpha = 0.5) +
    geom_smooth(se = FALSE, method = 'loess',
                formula = 'y ~ x',
                aes(group = 1)) +
    geom_label(aes(label = n), nudge_y = .2, label.size = NA) +
    geom_vline(xintercept = pos.vlines, color = 'red3', linetype = 'dashed') +
    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 = 8, angle = 90),
      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")
    ) +
    labs(x = NULL,
         y = 'Number of patients randomised')

}