Permalink
Browse files

Basic implementation of geom_raster

  • Loading branch information...
1 parent 39534a5 commit 8578fd05233885ede2fe8c3cd173c124c3a6cc6d @hadley hadley committed Dec 1, 2011
Showing with 92 additions and 0 deletions.
  1. +1 −0 DESCRIPTION
  2. +1 −0 NAMESPACE
  3. +58 −0 R/geom-raster.r
  4. +32 −0 man/geom_raster.Rd
View
@@ -184,3 +184,4 @@ Collate:
'guide-colorbar.r'
'stat-aggr-2d.r'
'stat-aggr-hex.r'
+ 'geom-raster.r'
View
@@ -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)
View
@@ -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"
+})
View
@@ -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())
+}
+

0 comments on commit 8578fd0

Please sign in to comment.