Extra Coordinate Systems, 'Geoms', Statistical Transformations, Scales and Fonts for 'ggplot2'
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

#### 135 lines 3.9 KiB Raw Blame History

 #' Compute and display a univariate averaged shifted histogram (polynomial kernel) #' #' See \code{\link[ash]{bin1}} & \code{\link[ash]{ash1}} for more information. #' #' \if{html}{ #' A sample of the output from \code{stat_ash()}: #' #' \figure{statash01.png}{options: width="100\%" alt="Figure: statash01.png"} #' } #' #' \if{latex}{ #' A sample of the output from \code{stat_ash()}: #' #' \figure{statash01.png}{options: width=10cm} #' } #' #' @inheritParams ggplot2::geom_area #' @param geom Use to override the default Geom #' @param ab half-open interval for bins \emph{[a,b)}. If no value is specified, #' the range of x is stretched by \code{5\%} at each end and used the #' interval. #' @param nbin number of bins desired. Default \code{50}. #' @param m integer smoothing parameter; Default \code{5}. #' @param kopt vector of length 2 specifying the kernel, which is proportional #' to \emph{( 1 - abs(i/m)^kopt(1) )i^kopt(2)}; (2,2)=biweight (default); #' (0,0)=uniform; (1,0)=triangle; (2,1)=Epanechnikov; (2,3)=triweight. #' @references David Scott (1992), \emph{"Multivariate Density Estimation,"} #' John Wiley, (chapter 5 in particular).\cr #' \cr #' B. W. Silverman (1986), \emph{"Density Estimation for Statistics #' and Data Analysis,"} Chapman & Hall. #' @section Aesthetics: #' \code{geom_ash} understands the following aesthetics (required aesthetics #' are in bold): #' \itemize{ #' \item \strong{\code{x}} #' \item \code{alpha} #' \item \code{color} #' \item \code{fill} #' \item \code{linetype} #' \item \code{size} #' } #' @section Computed variables: #' \describe{ #' \item{\code{density}}{ash density estimate} #' } #' @export #' @examples #' # compare #' library(gridExtra) #' set.seed(1492) #' dat <- data.frame(x=rnorm(100)) #' grid.arrange(ggplot(dat, aes(x)) + stat_ash(), #' ggplot(dat, aes(x)) + stat_bkde(), #' ggplot(dat, aes(x)) + stat_density(), #' nrow=3) #' #' cols <- RColorBrewer::brewer.pal(3, "Dark2") #' ggplot(dat, aes(x)) + #' stat_ash(alpha=1/2, fill=cols[3]) + #' stat_bkde(alpha=1/2, fill=cols[2]) + #' stat_density(alpha=1/2, fill=cols[1]) + #' geom_rug() + #' labs(x=NULL, y="density/estimate") + #' scale_x_continuous(expand=c(0,0)) + #' theme_bw() + #' theme(panel.grid=element_blank()) + #' theme(panel.border=element_blank()) stat_ash <- function(mapping = NULL, data = NULL, geom = "area",  position = "stack",  ab = NULL, nbin = 50, m = 5, kopt = c(2, 2),  na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) {    layer(  data = data,  mapping = mapping,  stat = StatAsh,  geom = geom,  position = position,  show.legend = show.legend,  inherit.aes = inherit.aes,  params = list(  na.rm = na.rm,  ab = ab,  nbin = nbin,  m = m,  kopt = kopt,  ...  )  )   }   #' Geom Proto #' @rdname ggalt-ggproto #' @format NULL #' @usage NULL #' @keywords internal #' @export StatAsh <- ggproto("StatAsh", Stat,    required_aes = c("x"),    default_aes = aes(y = ..density.., colour = NA, fill = "gray20", size = 0.5,  linetype = 1, alpha = NA),      setup_params = function(data, params) {  if (!is.null(data$y) || !is.null(params$y)) {  stop("stat_ash() must not be used with a y aesthetic.", call. = FALSE)  }  params  },    compute_group = function(data, scales, ab = NULL,  nbin = 50, m = 5, kopt = c(2, 2)) {    if (is.null(ab)) ab <- nicerange(data$x)    bin_res <- ash::bin1(data$x, ab, nbin)  ash_msg <- capture.output(ash_res <- ash1(bin_res))    if (ash_res$ier == 1) message("Estimate nonzero outside interval ab.")    data.frame(x=ash_res$x, density=ash_res\$y)    }   )   nicerange <- function (x, beta = 0.1) {  ab <- range(x)  del <- ((ab[2] - ab[1]) * beta)/2  return(c(ab + c(-del, del))) }