Permalink
Browse files

Better drawing strategy for geom_raster.

Fixes #463
  • Loading branch information...
1 parent 9e4a684 commit 6597202515988fb7a9f50b1094122977fa08254d @hadley hadley committed Apr 13, 2012
Showing with 22 additions and 8 deletions.
  1. +1 −0 NEWS
  2. +21 −8 R/geom-raster.r
View
1 NEWS
@@ -35,6 +35,7 @@ BUG FIXES
* discrete scales now accept named vectors of labels again (Fixes #427)
+* `geom_raster` works better with categorical input (Fixes #463)
ggplot2 0.9.0
----------------------------------------------------------------
View
@@ -41,13 +41,13 @@ NULL
#' benchplot(base + geom_raster())
#' benchplot(base + geom_tile())
#'
-#' # padding
+#' # justification
#' df <- expand.grid(x = 0:5, y = 0:5)
#' df$z <- runif(nrow(df))
#' # default is compatible with geom_tile()
#' ggplot(df, aes(x, y, fill = z)) + geom_raster()
#' # zero padding
-#' ggplot(df, aes(x, y, fill = z)) + geom_raster(hpad = 0, vpad = 0)
+#' ggplot(df, aes(x, y, fill = z)) + geom_raster(hjust = 0, vjust = 0)
#' }
geom_raster <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", hjust = 0.5, vjust = 0.5, interpolate = FALSE, ...) {
stopifnot(is.numeric(hjust), length(hjust) == 1)
@@ -73,19 +73,32 @@ GeomRaster <- proto(Geom, {
df
}
- draw <- function(., data, scales, coordinates, hjust = 0.5, vjust = 0.5, interpolate = FALSE, ...) {
+ # This is a dummy function to make sure that vjust and hjust are recongised
+ # as parameters and are accessible to reparameterise.
+ draw <- function(vjust = 0.5, hjust = 0.5) {}
+
+ draw_groups <- function(., data, scales, coordinates, interpolate = FALSE, ...) {
if (!inherits(coordinates, "cartesian")) {
stop("geom_raster only works with Cartesian coordinates", call. = FALSE)
}
- data <- remove_missing(data, TRUE, c("x", "y", "fill"), name = "geom_raster")
+ data <- remove_missing(data, TRUE, c("x", "y", "fill"),
+ name = "geom_raster")
data <- coord_transform(coordinates, data, scales)
-
- raster <- acast(data, list("y", "x"), value.var = "fill")
- raster <- raster[nrow(raster):1, , drop = FALSE]
+ # Convert vector of data to raster
+ x_pos <- as.integer((data$x - min(data$x)) / resolution(data$x, FALSE))
+ y_pos <- as.integer((data$y - min(data$y)) / resolution(data$y, FALSE))
+
+ nrow <- max(y_pos) + 1
+ ncol <- max(x_pos) + 1
+
+ raster <- matrix(NA_character_, nrow = nrow, ncol = ncol)
+ raster[cbind(nrow - y_pos, x_pos + 1)] <- data$fill
+
+ # Figure out dimensions of raster on plot
x_rng <- c(min(data$xmin, na.rm = TRUE), max(data$xmax, na.rm = TRUE))
y_rng <- c(min(data$ymin, na.rm = TRUE), max(data$ymax, na.rm = TRUE))
-
+
rasterGrob(raster, x = mean(x_rng), y = mean(y_rng),
width = diff(x_rng), height = diff(y_rng),
default.units = "native", interpolate = interpolate)

0 comments on commit 6597202

Please sign in to comment.