R/plot_attendance_data.R

In LisaHopcroft/CTutils: Helpful Functions for Clinical Trial Data Analysis at SCTRU (Public Health Scotland)

#' CAlculate how much data is missing for each patient, visit and test battery.
#'
#' @param missing_data_percentages The tibble generated by calculate_missing_data.
#' @param id_var A quosure representing the column that contains the patient label.
#' @param site_var A quosure representing the column that contains the site name for that patient.
#' @param patient_attendance The tibble representing attendance at visits (containing the patient label, hospital, visit annotation and all dates).
#' @param width.expansion A coefficient to control the width of the panels for each site
#' @param height.expansion A coefficient to control the height of the panels for each visit
#' @param first_column.width A measurement (using unit()) for the width of the row labels
#' @param visit_string_removal A string to remove from the visit column name for display
#' @param panel_sizes The relative sizes (heights) of the two panels
#'
#' @importFrom cowplot plot_grid
#' @importFrom dplyr pull
#' @importFrom dplyr filter
#' @importFrom dplyr mutate
#' @importFrom dplyr %>%
#' @importFrom ggplot2 facet_grid
#' @importFrom ggplot2 geom_text
#' @importFrom ggplot2 geom_tile
#' @importFrom ggplot2 ggplot_build
#' @importFrom ggplot2 ggplot_gtable
#' @importFrom ggplot2 scale_fill_manual
#' @importFrom ggplot2 theme
#' @importFrom ggplot2 element_text
#' @importFrom grid grid.draw
#' @importFrom grid unit
#' @importFrom graphics plot
#' @importFrom RColorBrewer brewer.pal
#' @importFrom rlang .data
#'
#' @export
plot_attendance_data = function( missing_data_percentages,
                                 id_var,
                                 site_var,
                                 patient_attendance,
                                 width.expansion = 15,
                                 height.expansion = 8,
                                 first_column.width = unit(4,"cm"),
                                 visit_string_removal = "Date_Form_Comp",
                                 # annotation_threshold = 0,
                                 panel_sizes=c(1,1) ) {

  panel_widths = missing_data_percentages %>%
    group_by( !!site_var ) %>%
    summarise( n_patients = length(unique( !!id_var ) ) )

  ### Patient attendance

  attendance_variable.list = setdiff( colnames(patient_attendance),
                                      c(quo_name( id_var  ),
                                        quo_name( site_var) ) )

  patient_attendance.d = patient_attendance %>%
    pivot_longer( -c({{id_var}}, {{site_var}}),
                  names_to = "column_name",
                  values_to = "value" ) %>%
    ### Required to avoid the warning:
    ###  Warning message:
    ###  Column `column_name` has different attributes on LHS and RHS of join
    ### It seems that pivot_longer adds a names attribute?
    mutate( column_name = as.character(.data$column_name)) %>%
    mutate( present = .data$value!="" ) %>%
    inner_join( missing_data_percentages %>%
                  select(.data$column_name, .data$param_visit),
                by="column_name" )  %>%
    mutate( column_name = factor( .data$column_name,
                                  levels=rev(attendance_variable.list) )) %>%
    mutate( visit_label = generate_visit_label( .data$column_name,
                                                visit_string_removal,
                                                .data$param_visit ) )


  panel_heights = patient_attendance.d %>%
    group_by( .data$param_visit ) %>%
    summarise( n_appointments = length(unique(.data$column_name) ) )

  patient_attendance_plot =
    ggplot( patient_attendance.d,
            aes( x={{id_var}},
                 y=.data$visit_label,
                 fill=.data$present ) ) +
    geom_tile( col="white") +
    xlab( "" ) +
    ylab( "" ) +
    facet_grid( rows=vars(.data$param_visit),
                cols=vars(!!site_var),
                scales="free" ) +
    scale_fill_manual( values=c( "TRUE"  = brewer.pal(7,"Greens")[6],
                                 "FALSE" = brewer.pal(7,"Greys")[3]),
                       guide=FALSE ) +
    theme_bw( ) +
    theme( axis.text.x = element_text(angle=90) ) +
    theme( # TOP RIGHT BOTTOM LEFT
      plot.margin = unit(c(0, 5.5, 0, 5.5), "pt"))

  patient_attendance_plot.corrected = rejig_panel_dimensions(
    patient_attendance_plot,
    w=panel_widths$n_patients,
    w.expansion=width.expansion,
    h=panel_heights$n_appointments,
    h.expansion=height.expansion,
    c1.w = first_column.width )

  ### Patient level plot (over all missing data)

  # final_plot = plot_grid( #patient_annotations_plot.corrected,
                          # patient_attendance_plot.corrected,
                          # ncol=1,
                          # rel_heights=panel_sizes)

  plot( patient_attendance_plot.corrected )

}