R/ggplot_4pl.R

In koncina/elisar: Elisa 4PL regression

#' @import ggplot2

NULL

# Creating a 4PL regression curve layer for ggplot
# Adapted from the example http://docs.ggplot2.org/dev/vignettes/extending-ggplot2.html

Stat4PL <- ggplot2::ggproto("Stat4PL", ggplot2::Stat, 
                            required_aes = c("x", "y"),
                            compute_group = function(data, scales, logDose, n) {
                              x_range <- scales$x$get_limits()
                              if (isTRUE(logDose)){
                                if (scales$x$trans$name == "log-10") {
                                  message("adjusting drc::drm logDose to 10")
                                  logDose <- 10
                                }
                                else logDose <- NULL
                              }
                              model_4pl <- drc::drm(y ~ x, data = data, fct = drc::LL.4(names = c("Slope", "Lower", "Upper", "ED50")), logDose = logDose)
                              grid <- data.frame(x = seq(x_range[1], x_range[2], length.out = n))
                              grid["y"] <- predict(model_4pl, grid)
                              grid
                            }
)

#' Draws a 4-PL regression line
#'
#' stat_4pl() performs a 4 parameter logistic regression (using drc::drm) for plotting in ggplot2.
#' @inheritParams ggplot2::stat_identity
#' 
#' @param logDose a numeric value or NULL. Argument to be passed to \code{drc::drm}. See \code{?drc::drm} for more informations. If no value is set, \code{stat_4pl} detects if \code{scale_x_log10()} has been used and adjusts logDose to 10.
#' 
#' @param n Number of points used for interpolation.
#' 
#' @param na.rm If TRUE, remove NA values.
#' 
#' @export
stat_4pl <- function(mapping = NULL, data = NULL, geom = "line",
                     position = "identity", na.rm = FALSE, show.legend = NA, 
                     inherit.aes = TRUE, logDose = NULL, n = 100, ...) {
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    stop("ggplot2 needed for this function to work. Please install it.",
         call. = FALSE)
  }
  if (!"drc" %in% rownames(installed.packages())) stop("could not find drc library")
  if (!is.null(logDose) && !is.numeric(logDose)) stop("bad logDose argument. See ?drc::drm")
  if (missing(logDose)) logDose <- TRUE
  layer(
    stat = Stat4PL, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(logDose = logDose, n = n, na.rm = na.rm, ...)
  ) 
}