This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!

stat_density

By: ROLOO on Aug 21st, 2012  |  syntax: R  |  size: 1.80 KB  |  views: 58  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. # Quick hack for a bug with the plot range in ggplot2's stat_density
  2.  
  3. require(ggplot2)
  4. require(proto)
  5.  
  6. # Renamed to stat_density2 so as to not interfere with the ggplot2 package
  7. stat_density2 <- function (mapping = NULL, data = NULL, geom = "area", position = "stack",
  8.                                                   adjust = 1, kernel = "gaussian", trim = FALSE, na.rm = FALSE, ...) {
  9.         StatDensity2$new(mapping = mapping, data = data, geom = geom, position = position,
  10.                                         adjust = adjust, kernel = kernel, trim = trim, na.rm = na.rm, ...)
  11. }
  12.  
  13. # Also renamed, and added ggplot2::: in front of stat as this is run outside of the package
  14. StatDensity2 <- proto(ggplot2:::Stat, {
  15.         objname <- "density"
  16.        
  17.         calculate <- function(., data, scales, adjust=1, kernel="gaussian", trim=FALSE, na.rm = FALSE, ...) {
  18.                 data <- remove_missing(data, na.rm, "x", name = "stat_density2",
  19.                                                            finite = TRUE)
  20.                
  21.                 n <- nrow(data)
  22.                 if (n < 3) return(data.frame())
  23.                 if (is.null(data$weight)) data$weight <- rep(1, n) / n
  24.                
  25.                 range <- scale_dimension(scales$x, c(0, 0))
  26.                 xgrid <- seq(range[1], range[2], length=200)
  27.                
  28.                 # The Doc says that the 'trim' parameter works like 'cut' in density. This is not what
  29.                 #   happens however. As a quick fix I just removed the range here, as this trims the range
  30.                 #   without respecting the 'trim' parameter.
  31.                 dens <- density(data$x, adjust=adjust, kernel=kernel, weight=data$weight) # from=range[1], to=range[2]
  32.                 densdf <- as.data.frame(dens[c("x","y")])
  33.                
  34.                 densdf$scaled <- densdf$y / max(densdf$y, na.rm = TRUE)
  35.                 if (trim) densdf <- subset(densdf, x > min(data$x, na.rm = TRUE) & x < max(data$x, na.rm = TRUE))
  36.                
  37.                 densdf$count <- densdf$y * n
  38.                 rename(densdf, c(y = "density"))
  39.         }
  40.        
  41.         default_geom <- function(.) GeomArea
  42.         default_aes <- function(.) aes(y = ..density.., fill=NA)
  43.         required_aes <- c("x")
  44.        
  45. })
clone this paste RAW Paste Data