R/fill-density.R

Defines functions fill.density

Documented in fill.density

#' Fill-in the density plot
#' 
#' @param density          output of \code{\link{density}} function or a data.frame with x and y columns
#'                         where x are data points and y is density
#' @param min.x,max.x      boundries of area to fill-in; if not provided the whole density is filled;
#'                         if only one of them is provided the second one is defined as the smallest
#'                         or the largest x value
#' @param col,border,\dots parameters of \code{\link{polygon}} function
#' @param add              if \code{TRUE} (default) the filled area is added to already existing plot
#' @param drawagain        if \code{TRUE} (default) lines of density plot are drawn over the existing
#'                         plot for better outlook
#' @param lcol             \code{col} parameter for \code{\link{plot.density}}
#' 
#' @references
#' \url{http://stackoverflow.com/questions/3494593/shading-a-kernel-density-plot-between-two-points}
#' 
#' @importFrom stats density
#' @export

fill.density <- function(density, min.x, max.x, col = "lightgray", ..., border = NA,
                         add = TRUE, drawagain = TRUE, lcol = "black") {
  stopifnot(class(density) == "density" ||
              ((is.list(density) || is.data.frame(density)) &&
                 c("x", "y") %in% names(density)))
  
  if (!add) plot(density, ..., type = "n")
  
  if (missing(min.x) && missing(max.x)) {
    polygon(density, col = col, border = border, ...)
  } else {
    if (missing(min.x) || min.x < min(density$x))
      min.x <- min(density$x)
    if (missing(max.x) || max.x > max(density$x))
      max.x <- max(density$x)
    
    x1 <- min(which(density$x >= min.x))
    x2 <- max(which(density$x <  max.x))
    with(density, polygon(x = c(x[c(x1, x1:x2, x2)]), y = c(0, y[x1:x2], 0), col = col, border = border, ...))
  }
  
  if (!add || drawagain) {
    lines(density, ..., col = lcol)
    abline(h=0, col = lcol)
  }
}
twolodzko/twextras documentation built on May 3, 2019, 1:52 p.m.