R/blandr.plot.ggplot.r

In blandr: Bland-Altman Method Comparison

#' @title Bland-Altman plotting function, using ggplot2
#'
#' @description Draws a Bland-Altman plot using data calculated using the other functions, using ggplot2
#'
#' @author Deepankar Datta <deepankardatta@nhs.net>
#'
#' @param statistics.results A list of statistics generated by the blandr.statistics function: see the function's return list to see what variables are passed to this function
#' @param method1name (Optional) Plotting name for 1st method, default "Method 1"
#' @param method2name (Optional) Plotting name for 2nd method, default "Method 2"
#' @param plotTitle (Optional) Title name, default "Bland-Altman plot for comparison of 2 methods"
#' @param ciDisplay (Optional) TRUE/FALSE switch to plot confidence intervals for bias and limits of agreement, default is TRUE
#' @param ciShading (Optional) TRUE/FALSE switch to plot confidence interval shading to plot, default is TRUE
#' @param normalLow (Optional) If there is a normal range, entering a continuous variable will plot a vertical line on the plot to indicate its lower boundary
#' @param normalHigh (Optional) If there is a normal range, entering a continuous variable will plot a vertical line on the plot to indicate its higher boundary
#' @param overlapping (Optional) TRUE/FALSE switch to increase size of plotted point if multiple values using ggplot's geom_count, deafault=FALSE. Not currently recommend until I can tweak the graphics to make them better
#' @param x.plot.mode (Optional) Switch to change x-axis from being plotted by means (="means") or by either 1st method (="method1") or 2nd method (="method2"). Default is "means". Anything other than "means" will switch to default mode.
#' @param y.plot.mode (Optional) Switch to change y-axis from being plotted by difference (="difference") or by proportion magnitude of measurements (="proportion"). Default is "difference". Anything other than "proportional" will switch to default mode.
#' @param plotProportionalBias (Optional) TRUE/FALSE switch. Plots a proportional bias line. Default is FALSE.
#' @param plotProportionalBias.se (Optional) TRUE/FALSE switch. If proportional bias line is drawn, switch to plot standard errors. See stat_smooth for details. Default is TRUE.
#' @param assume.differences.are.normal (Optional, not operationally used currently) Assume the difference of means has a normal distribution. Will be used to build further analyses
#'
#' @return ba.plot Returns a ggplot data set that can then be plotted
#'
#' @import ggplot2
#'
#' @examples
#' # Generates two random measurements
#' measurement1 <- rnorm(100)
#' measurement2 <- rnorm(100)
#'
#' # Generates a ggplot
#' # Do note the ggplot function wasn't meant to be used on it's own
#' # and is generally called via the bland.altman.display.and.draw function
#'
#' # Passes data to the blandr.statistics function to generate Bland-Altman statistics
#' statistics.results <- blandr.statistics( measurement1 , measurement2 )
#'
#' # Generates a ggplot, with no optional arguments
#' blandr.plot.ggplot( statistics.results )
#'
#' # Generates a ggplot, with title changed
#' blandr.plot.ggplot( statistics.results , plotTitle = "Bland-Altman example plot" )
#'
#' # Generates a ggplot, with title changed, and confidence intervals off
#' blandr.plot.ggplot( statistics.results , plotTitle = "Bland-Altman example plot" ,
#' ciDisplay = FALSE , ciShading = FALSE )
#'
#' @export

blandr.plot.ggplot <- function ( statistics.results ,
                            method1name = "Method 1" ,
                            method2name = "Method 2" ,
                            plotTitle = "Bland-Altman plot for comparison of 2 methods" ,
                            ciDisplay = TRUE ,
                            ciShading = TRUE ,
                            normalLow = FALSE ,
                            normalHigh = FALSE ,
                            overlapping = FALSE ,
                            x.plot.mode = "means" ,
                            y.plot.mode = "difference" ,
                            plotProportionalBias = FALSE ,
                            plotProportionalBias.se = TRUE ,
                            assume.differences.are.normal = TRUE
                            ) {

  # Does a check if ggplot2 is available
  # It should be as it is in the imports section but in CRAN checks some systems don't have it!
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    stop("Package \"ggplot2\" needed for this function to work. Please install it.",
         call. = FALSE)
  }

  # Selects if x-axis uses means (traditional) or selects one of the methods
  # as the gold standard (non-traditional BA)
  # See Krouwer JS (2008) Why Bland-Altman plots should use X, not (Y+X)/2 when X is a reference method. Statistics in Medicine 27:778-780
  # NOT ENABLED YET
  x.axis <- statistics.results$means

  # Selects if uses differences (traditional) or proportions (non-traditional BA)
  if( y.plot.mode == "proportion" ) {
    y.axis <- statistics.results$proportion
  } else {
    y.axis <- statistics.results$differences
  }

  # Constructs the plot.data dataframe
  plot.data <- data.frame( x.axis , y.axis )

  # Rename to allow plotting
  # This was a hangover from an older version so I'm not sure we need it anymore
  # But not really a priority to check and remove now
  colnames(plot.data)[1] <- "x.axis"
  colnames(plot.data)[2] <- "y.axis"

  # Plot using ggplot
  ba.plot <- ggplot( plot.data , aes( x = plot.data$x.axis , y = plot.data$y.axis ) ) +
    geom_point() +
    theme(plot.title = element_text(hjust = 0.5)) +
    geom_hline( yintercept = 0 , linetype = 1 ) + # "0" line
    geom_hline( yintercept = statistics.results$bias , linetype = 2 ) + # Bias
    geom_hline( yintercept = statistics.results$bias + ( statistics.results$biasStdDev * statistics.results$sig.level.convert.to.z ) , linetype = 2 ) + # Upper limit of agreement
    geom_hline( yintercept = statistics.results$bias - ( statistics.results$biasStdDev * statistics.results$sig.level.convert.to.z ) , linetype = 2 ) + # Lower limit of agreement
    ggtitle( plotTitle ) +
    xlab( "Means" )

  # Re-titles the y-axis dependent on which plot option was used
  if ( y.plot.mode == "proportion" ) {
    ba.plot <- ba.plot + ylab( "Difference / Average %" )
  } else {
    ba.plot <- ba.plot + ylab( "Differences" )
  }

  # Drawing confidence intervals (OPTIONAL)
  if( ciDisplay == TRUE ) {
    ba.plot <- ba.plot +
    geom_hline( yintercept = statistics.results$biasUpperCI , linetype = 3 ) + # Bias - upper confidence interval
    geom_hline( yintercept = statistics.results$biasLowerCI , linetype = 3 ) + # Bias - lower confidence interval
    geom_hline( yintercept = statistics.results$upperLOA_upperCI , linetype = 3 ) + # Upper limit of agreement - upper confidence interval
    geom_hline( yintercept = statistics.results$upperLOA_lowerCI , linetype = 3 ) + # Upper limit of agreement - lower confidence interval
    geom_hline( yintercept = statistics.results$lowerLOA_upperCI , linetype = 3 ) + # Lower limit of agreement - upper confidence interval
    geom_hline( yintercept = statistics.results$lowerLOA_lowerCI , linetype = 3 ) # Lower limit of agreement - lower confidence interval

    # Shading areas for 95% confidence intervals (OPTIONAL)
    # This needs to be nested into the ciDisplay check
    if( ciShading == TRUE ) {
      ba.plot <- ba.plot +
        annotate( "rect", xmin = -Inf , xmax = Inf , ymin = statistics.results$biasLowerCI , ymax = statistics.results$biasUpperCI , fill="blue" , alpha=0.3 ) + # Bias confidence interval shading
        annotate( "rect", xmin = -Inf , xmax = Inf , ymin = statistics.results$upperLOA_lowerCI , ymax = statistics.results$upperLOA_upperCI , fill="green" , alpha=0.3 ) + # Upper limits of agreement confidence interval shading
        annotate( "rect", xmin = -Inf , xmax = Inf , ymin = statistics.results$lowerLOA_lowerCI , ymax = statistics.results$lowerLOA_upperCI , fill="red" , alpha=0.3 ) # Lower limits of agreement confidence interval shading
    }

  }
  ### Function has finished drawing of confidence intervals at this line

  # If a normalLow value has been sent, plots this line
  if( normalLow != FALSE ) {
    # Check validity of normalLow value to plot line
    if( is.numeric(normalLow) == TRUE ) {
      ba.plot <- ba.plot + geom_vline( xintercept = normalLow , linetype = 4 , col=6 )
    }
  }

  # If a normalHighvalue has been sent, plots this line
  if( normalHigh != FALSE ) {
    # Check validity of normalHigh value to plot line
    if( is.numeric(normalHigh) == TRUE ) {
      ba.plot <- ba.plot + geom_vline( xintercept = normalHigh , linetype = 4 , col=6 )
    }
  }

  # If overlapping=TRUE uses geom_count
  # See the param description at the top
  if( overlapping == TRUE ) {
    ba.plot <- ba.plot + geom_count()
  }

  # If plotProportionalBias switch is TRUE, plots a proportional bias line as well
  if( plotProportionalBias == TRUE ) {

    # Check for validity of options passed to the plotProportionalBias.se switch
    # As if we throw an invalid option to ggplot it will just stop with an error
    if( plotProportionalBias.se !=TRUE && plotProportionalBias.se != FALSE) {
      plotProportionalBias.se <- TRUE
    }

    # Plots line
    ba.plot <- ba.plot + ggplot2::geom_smooth( method = 'lm' , se = plotProportionalBias.se )
  } # End of drawing proportional bias line

  # Draws marginal histograms if option selected
  # Idea from http://labrtorian.com/tag/bland-altman/
  # REMOVED AS INTRODUCED SOME INCOMPATIBILITIES DEPENDENT ON USERS R VERSION
  # ALSO MASSIVELY INCREASED PACKAGE SIZE
  # if( marginalHistogram == TRUE ) { ba.plot <- ggMarginal( ba.plot , type="histogram" ) }

  # Return the ggplot2 output
  return(ba.plot)

  #END OF FUNCTION
}