R/qblandaltman.R

Defines functions qblandaltman_build_data_frame qblandaltman.data.frame qblandaltman.default qblandaltman

Documented in qblandaltman qblandaltman_build_data_frame

#' @title Bland Altman Plots
#'
#' @description Construct and plot a Bland Altman plot in ggplot2.
#'
#' @details
#' Providing a \code{data.frame} with two columns, the function returns a ggplot
#' version of a Bland Altman plot with the specified confidence intervals.
#'
#' Two ways to call the plotting function.  If you submit a \code{data.frame}
#' \code{qblandaltman} then the data needed to produce the Bland Altman plot is
#' automatically generated by a call to \code{qblandaltman_build_data_frame}.
#' Alternatively, you may call \code{qblandaltman_build_data_frame} directly and
#' then call \code{qblandaltman}.  This might be helpful if you are putting
#' multiple Bland Altman plots together into one ggplot object.  See Examples.
#'
#' More details and examples for graphics within qwraps2 are in the
#' vignette(\dQuote{qwraps2-graphics}, package = \dQuote{qwraps2})
#'
#' @param x a \code{data.frame} with two columns, or an object that can be
#' coerced to a data frame.  If a \code{data.frame} with more than two columns
#' is used only the first two columns will be used.
#' @param alpha (Defaults to 0.05) place (1 - alpha)*100% confidence levels to
#' place on the plot.
#' @param generate_data logical, defaults to TRUE.  If TRUE, then the call to
#' \code{qblandaltman_build_data_frame} is done automatically for you.  If
#' FALSE, then you should explicitly call \code{qblandaltman_build_data_frame}
#' before calling \code{qblandaltman}.
#'
#' @return a ggplot.  Minimal aesthetics have been used so that the user may
#' modify the graphic as desired with ease.
#'
#' @references
#' Altman, Douglas G., and J. Martin Bland. "Measurement in medicine: the analysis
#' of method comparison studies." The statistician (1983): 307-317.
#'
#' Bland, J. Martin, and Douglas G Altman. "Statistical methods for assessing
#' agreement between two methods of clinical measurement." The lancet 327, no. 8476
#' (1986): 307-310.
#'
#' @examples
#'
#' data(pefr)
#' pefr_m1 <-
#'   cbind("Large" = pefr[pefr$measurement == 1 & pefr$meter == "Wright peak flow meter", "pefr"],
#'         "Mini"  = pefr[pefr$measurement == 1 & pefr$meter == "Mini Wright peak flow meter", "pefr"])
#'
#' # The Bland Altman plot plots the average value on the x-axis and the
#' # difference in the measurements on the y-axis:
#' qblandaltman(pefr_m1) +
#'   ggplot2::xlim(0, 800) +
#'   ggplot2::ylim(-100, 100) +
#'   ggplot2::xlab("Average of two meters") +
#'   ggplot2::ylab("Difference in the measurements")
#'
#' @export
#' @rdname qblandaltman
qblandaltman <- function(x, alpha = getOption("qwraps2_alpha", 0.05), generate_data = TRUE) {
  UseMethod("qblandaltman")
}

#' @export
qblandaltman.default <- function(x, alpha = getOption("qwraps2_alpha", 0.05), generate_data = TRUE) {
  qblandaltman(as.data.frame(x), alpha = alpha, generate_data = generate_data)
}

#' @export
qblandaltman.data.frame <- function(x, alpha = getOption("qwraps2_alpha", 0.05), generate_data = TRUE) {

  if (is.null(attr(x, "qwraps2_generated"))) {
    if (generate_data) {
      x <- qblandaltman_build_data_frame(x, alpha)
    }
  }

  ggplot2::ggplot(x) +
  eval(substitute(ggplot2::aes(x = X, y = Y), list(X = as.name('avg'), Y = as.name('diff')))) +
  ggplot2::geom_point() +
  ggplot2::geom_hline(mapping = eval(substitute(ggplot2::aes(yintercept = Y), list(Y = as.name('lcl')))), lty = 2) +
  ggplot2::geom_hline(mapping = eval(substitute(ggplot2::aes(yintercept = Y), list(Y = as.name('ucl')))), lty = 2) +
  ggplot2::geom_hline(mapping = eval(substitute(ggplot2::aes(yintercept = Y), list(Y = as.name('mean_diff')))), lty = 3)
}

#' @export
#' @rdname qblandaltman
qblandaltman_build_data_frame <- function(x, alpha = getOption("qwraps2_alpha", 0.05)) {
  rtn      <- data.frame(x1 = x[[1]], x2 = x[[2]])
  rtn$avg  <- (rtn$x1 + rtn$x2) / 2
  rtn$diff <- (rtn$x2 - rtn$x1)
  rtn$mean_diff <- mean(rtn$diff)
  rtn$sd_diff   <- stats::sd(rtn$diff)
  rtn$lcl       <- rtn$mean_diff + stats::qnorm(alpha / 2) * rtn$sd_diff
  rtn$ucl       <- rtn$mean_diff + stats::qnorm(1 - alpha / 2) * rtn$sd_diff

  attr(rtn, "qwraps2_generated") = TRUE

  return(rtn)
}

Try the qwraps2 package in your browser

Any scripts or data that you put into this service are public.

qwraps2 documentation built on Nov. 10, 2023, 1:06 a.m.