diff --git a/DESCRIPTION b/DESCRIPTION index d9a748a04c..34f4af0c13 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -184,3 +184,4 @@ Collate: 'guide-colorbar.r' 'stat-aggr-2d.r' 'stat-aggr-hex.r' + 'geom-raster.r' diff --git a/NAMESPACE b/NAMESPACE index a3618e581d..91e80d1202 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -46,6 +46,7 @@ export(geom_point) export(geom_pointrange) export(geom_polygon) export(geom_quantile) +export(geom_raster) export(geom_rect) export(geom_ribbon) export(geom_rug) diff --git a/R/geom-raster.r b/R/geom-raster.r new file mode 100644 index 0000000000..7265f23c6f --- /dev/null +++ b/R/geom-raster.r @@ -0,0 +1,58 @@ +#' High-performance rectangular tiling. +#' +#' This is a special case of \code{\link{geom_tile}} where all tiles are +#' the same size. It is implemented highly efficiently using the internal +#' \code{rasterGrob} function. +#' +#' @export +#' @examples +#' # Generate data +#' pp <- function (n,r=4) { +#' x <- seq(-r*pi, r*pi, len=n) +#' df <- expand.grid(x=x, y=x) +#' df$r <- sqrt(df$x^2 + df$y^2) +#' df$z <- cos(df$r^2)*exp(-df$r/6) +#' df +#' } +#' qplot(x, y, data = pp(20), fill = z, geom = "raster") +#' +#' # For the special cases where it is applicable, geom_raster is much +#' # faster than geom_tile: +#' pp200 <- pp(200) +#' base <- ggplot(pp200, aes(x, y, fill = z)) +#' benchplot(base + geom_raster()) +#' benchplot(base + geom_tile()) +geom_raster <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", ...) { + GeomRaster$new(mapping = mapping, data = data, stat = stat, position = position, ...) +} + +GeomRaster <- proto(Geom, { + objname <- "raster" + draw <- function(., data, scales, coordinates, ...) { + if (!inherits(coordinates, "cartesian")) { + stop("geom_raster only works with Cartesian coordinates", call. = FALSE) + } + data <- coord_transform(coordinates, data, scales) + raster <- acast(data, list("x", "y"), value.var = "fill") + + width <- resolution(data$x) + height <- resolution(data$y) + + x_rng <- range(data$x, na.rm = TRUE) + y_rng <- range(data$y, na.rm = TRUE) + + rasterGrob(raster, x_rng[1] - width / 2, y_rng[1] - height / 2, + diff(x_rng) + width, diff(y_rng) + height, default.units = "native", + just = c("left","bottom"), interpolate = FALSE) + } + + + icon <- function(.) { + rectGrob(c(0.25, 0.25, 0.75, 0.75), c(0.25, 0.75, 0.75, 0.25), width=0.5, height=c(0.67, 0.5, 0.67, 0.5), gp=gpar(col="grey20", fill=c("#804070", "#668040"))) + } + + default_stat <- function(.) StatIdentity + default_aes <- function(.) aes(fill = "grey20", alpha = 1) + required_aes <- c("x", "y") + guide_geom <- function(.) "polygon" +}) diff --git a/man/geom_raster.Rd b/man/geom_raster.Rd new file mode 100644 index 0000000000..f7052349d6 --- /dev/null +++ b/man/geom_raster.Rd @@ -0,0 +1,32 @@ +\name{geom_raster} +\alias{geom_raster} +\title{High-performance rectangular tiling.} +\usage{ + geom_raster(mapping = NULL, data = NULL, + stat = "identity", position = "identity", ...) +} +\description{ + This is a special case of \code{\link{geom_tile}} where + all tiles are the same size. It is implemented highly + efficiently using the internal \code{rasterGrob} + function. +} +\examples{ +# Generate data +pp <- function (n,r=4) { + x <- seq(-r*pi, r*pi, len=n) + df <- expand.grid(x=x, y=x) + df$r <- sqrt(df$x^2 + df$y^2) + df$z <- cos(df$r^2)*exp(-df$r/6) + df +} +qplot(x, y, data = pp(20), fill = z, geom = "raster") + +# For the special cases where it is applicable, geom_raster is much +# faster than geom_tile: +pp200 <- pp(200) +base <- ggplot(pp200, aes(x, y, fill = z)) +benchplot(base + geom_raster()) +benchplot(base + geom_tile()) +} +