forked from tidyverse/ggplot2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathgeom-map.r
103 lines (93 loc) · 3.51 KB
/
geom-map.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
#' @include geom-polygon.r
NULL
#' Polygons from a reference map.
#'
#' Does not affect position scales.
#'
#' @section Aesthetics:
#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "map")}
#'
#' @export
#' @param map Data frame that contains the map coordinates. This will
#' typically be created using \code{\link{fortify}} on a spatial object.
#' It must contain columns \code{x} or \code{long}, \code{y} or
#' \code{lat}, and \code{region} or \code{id}.
#' @inheritParams geom_point
#' @examples
#' # When using geom_polygon, you will typically need two data frames:
#' # one contains the coordinates of each polygon (positions), and the
#' # other the values associated with each polygon (values). An id
#' # variable links the two together
#'
#' ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3"))
#'
#' values <- data.frame(
#' id = ids,
#' value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5)
#' )
#'
#' positions <- data.frame(
#' id = rep(ids, each = 4),
#' x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3,
#' 0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3),
#' y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5,
#' 2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2)
#' )
#'
#' 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)
#' library(reshape2) # for melt
#' 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)
#'
#' last_plot() + coord_map()
#' 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)
#' }
geom_map <- function(mapping = NULL, data = NULL, map, stat = "identity", ...) {
# 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)))
GeomMap$new(geom_params = list(map = map, ...), mapping = mapping,
data = data, stat = stat, ...)
}
GeomMap <- proto(GeomPolygon, {
objname <- "map"
draw_groups <- function(., data, scales, coordinates, map, ...) {
# Only use matching data and map ids
common <- intersect(data$map_id, map$id)
data <- data[data$map_id %in% common, , drop = FALSE]
map <- map[map$id %in% common, , drop = FALSE]
# Munch, then set up id variable for polygonGrob -
# must be sequential integers
coords <- coord_munch(coordinates, map, scales)
coords$group <- coords$group %||% coords$id
grob_id <- match(coords$group, unique(coords$group))
# Align data with map
data_rows <- match(coords$id[!duplicated(grob_id)], data$map_id)
data <- data[data_rows, , drop = FALSE]
polygonGrob(coords$x, coords$y, default.units = "native", id = grob_id,
gp = gpar(
col = data$colour, fill = alpha(data$fill, data$alpha),
lwd = data$size * .pt))
}
required_aes <- c("map_id")
})