Browse files

New map annotation.

With tweaks to raster annotation to match
  • Loading branch information...
1 parent 15896d2 commit fb63e1d42d7585ca3dd7a7bcd3ce0d947d588189 @hadley committed Dec 1, 2011
Showing with 63 additions and 4 deletions.
  1. +1 −0 DESCRIPTION
  2. +2 −0 NEWS
  3. +33 −0 R/annotation-map.r
  4. +8 −2 R/annotation-raster.r
  5. +1 −0 R/geom-map.r
  6. +1 −1 R/layer.r
  7. +17 −1 man/geom_map.Rd
View
1 DESCRIPTION
@@ -187,3 +187,4 @@ Collate:
'zxx.r'
'geom-raster.r'
'annotation-raster.r'
+ 'annotation-map.r'
View
2 NEWS
@@ -9,6 +9,8 @@ NEW GEOMS/ANNOTATIONS
* `annotation_raster`
+* `annotation_map`
+
MINOR CHANGES
* `geom_text` now supports `fontfamily`, `fontface`, and `lineheight`
View
33 R/annotation-map.r
@@ -0,0 +1,33 @@
+#' @include geom-map.r
+NULL
+
+#'
+annotation_map <- function(map, ...) {
+
+ # Get map input into correct form
+ stopifnot(is.data.frame(map))
+ if (!is.null(map$lat)) map$y <- map$lat
+ if (!is.null(map$long)) map$x <- map$long
+ if (!is.null(map$region)) map$id <- map$region
+ stopifnot(all(c("x", "y", "id") %in% names(map)))
+
+ GeomAnnotationMap$new(geom_params = list(map = map, ...), data =
+ NULL, inherit.aes = FALSE)
+}
+
+GeomAnnotationMap <- proto(GeomMap, {
+ objname <- "map"
+
+ draw_groups <- function(., data, scales, coordinates, map, ...) {
+ coords <- coord_munch(coordinates, map, scales)
+ id <- match(map$group, unique(map$group))
+
+ polygonGrob(coords$x, coords$y, default.units = "native", id = id,
+ gp = gpar(
+ col = data$colour, fill = alpha(data$fill, data$alpha),
+ lwd = data$size * .pt))
+ }
+
+ required_aes <- c()
+
+})
View
10 R/annotation-raster.r
@@ -16,10 +16,16 @@ NULL
#' # Generate data
#' rainbow <- matrix(hcl(seq(0, 360, length = 50 * 50), 80, 70), nrow = 50)
#' qplot(mpg, wt, data = mtcars) +
-#' annotation_raster(redGradient, 15, 20, 3, 4)
+#' annotation_raster(rainbow, 15, 20, 3, 4)
+#' # To fill up whole plot
+#' qplot(mpg, wt, data = mtcars) +
+#' annotation_raster(rainbow, -Inf, Inf, -Inf, Inf) +
+#' geom_point()
annotation_raster <- function (raster, xmin, xmax, ymin, ymax) {
raster <- as.raster(raster)
- GeomRasterAnn$new(geom_params = list(raster = raster, xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax), stat = "identity", position = "identity")
+ GeomRasterAnn$new(geom_params = list(raster = raster, xmin = xmin,
+ xmax = xmax, ymin = ymin, ymax = ymax), stat = "identity",
+ position = "identity", data = NULL, inherit.aes = TRUE)
}
GeomRasterAnn <- proto(GeomRaster, {
View
1 R/geom-map.r
@@ -62,6 +62,7 @@ GeomMap <- proto(GeomPolygon, {
objname <- "map"
draw_groups <- function(., data, scales, coordinates, map, ...) {
+ if (!is.null(data$map_id))
data <- data[data$map_id %in% names(map), , drop = FALSE]
polys <- rbind.fill(map[data$map_id])
View
2 R/layer.r
@@ -145,7 +145,7 @@ Layer <- proto(expr = {
evaled <- compact(
eval.quoted(aesthetics, data, plot$plot_env))
- # if (length(evaled) == 0) return(data.frame())
+ if (length(evaled) == 0) return(data.frame(PANEL = unique(data$PANEL)))
# evaled <- evaled[sapply(evaled, is.atomic)]
data.frame(evaled, PANEL = data$PANEL)
}
View
18 man/geom_map.Rd
@@ -29,6 +29,22 @@ positions <- data.frame(
2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2)
)
-ggplot(values, aes(x=x, y=y)) + geom_map(aes(map_id = id), map = positions)
+ggplot(values) + geom_map(aes(map_id = id), map = positions) +
+ expand_limits(positions)
+ggplot(values, aes(fill = value)) +
+ geom_map(aes(map_id = id), map = positions) +
+ expand_limits(positions)
+ggplot(values, aes(fill = value)) +
+ geom_map(aes(map_id = id), map = positions) +
+ expand_limits(positions) + ylim(0, 3)
+
+# Better example
+crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
+crimesm <- melt(crimes, id = 1)
+if (require(maps)) {
+ states_map <- map_data("state")
+ ggplot(crimes, aes(map_id = state)) + geom_map(aes(fill = Murder), map = states_map) + expand_limits(x = states_map$long, y = states_map$lat)
+ ggplot(crimesm, aes(map_id = state)) + geom_map(aes(fill = value), map = states_map) + expand_limits(x = states_map$long, y = states_map$lat) + facet_wrap( ~ variable)
+}
}

0 comments on commit fb63e1d

Please sign in to comment.