1#' @include geom-polygon.r
2NULL
3
4#' Polygons from a reference map
5#'
6#' This is pure annotation, so does not affect position scales.
7#'
8#' @eval rd_aesthetics("geom", "map")
9#' @export
10#' @param map Data frame that contains the map coordinates.  This will
11#'   typically be created using [fortify()] on a spatial object.
12#'   It must contain columns `x` or `long`, `y` or
13#'   `lat`, and `region` or `id`.
14#' @inheritParams layer
15#' @inheritParams geom_point
16#' @examples
17#' # When using geom_polygon, you will typically need two data frames:
18#' # one contains the coordinates of each polygon (positions),  and the
19#' # other the values associated with each polygon (values).  An id
20#' # variable links the two together
21#'
22#' ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3"))
23#'
24#' values <- data.frame(
25#'   id = ids,
26#'   value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5)
27#' )
28#'
29#' positions <- data.frame(
30#'   id = rep(ids, each = 4),
31#'   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,
32#'   0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3),
33#'   y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5,
34#'   2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2)
35#' )
36#'
37#' ggplot(values) +
38#'   geom_map(aes(map_id = id), map = positions) +
39#'   expand_limits(positions)
40#' ggplot(values, aes(fill = value)) +
41#'   geom_map(aes(map_id = id), map = positions) +
42#'   expand_limits(positions)
43#' ggplot(values, aes(fill = value)) +
44#'   geom_map(aes(map_id = id), map = positions) +
45#'   expand_limits(positions) + ylim(0, 3)
46#'
47#' # Better example
48#' if (require(maps)) {
49#'
50#'   crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
51#'
52#'   # Equivalent to crimes %>% tidyr::pivot_longer(Murder:Rape)
53#'   vars <- lapply(names(crimes)[-1], function(j) {
54#'     data.frame(state = crimes$state, variable = j, value = crimes[[j]])
55#'   })
56#'   crimes_long <- do.call("rbind", vars)
57#'
58#'   states_map <- map_data("state")
59#'   ggplot(crimes, aes(map_id = state)) +
60#'     geom_map(aes(fill = Murder), map = states_map) +
61#'     expand_limits(x = states_map$long, y = states_map$lat)
62#'
63#'   last_plot() + coord_map()
64#'   ggplot(crimes_long, aes(map_id = state)) +
65#'     geom_map(aes(fill = value), map = states_map) +
66#'     expand_limits(x = states_map$long, y = states_map$lat) +
67#'     facet_wrap( ~ variable)
68#' }
69geom_map <- function(mapping = NULL, data = NULL,
70                     stat = "identity",
71                     ...,
72                     map,
73                     na.rm = FALSE,
74                     show.legend = NA,
75                     inherit.aes = TRUE) {
76  # Get map input into correct form
77  if (!is.data.frame(map)) {
78    abort("`map` must be a data.frame")
79  }
80  if (!is.null(map$lat)) map$y <- map$lat
81  if (!is.null(map$long)) map$x <- map$long
82  if (!is.null(map$region)) map$id <- map$region
83  if (!all(c("x", "y", "id") %in% names(map))) {
84    abort("`map` must have the columns `x`, `y`, and `id`")
85  }
86
87  layer(
88    data = data,
89    mapping = mapping,
90    stat = stat,
91    geom = GeomMap,
92    position = PositionIdentity,
93    show.legend = show.legend,
94    inherit.aes = inherit.aes,
95    params = list(
96      map = map,
97      na.rm = na.rm,
98      ...
99    )
100  )
101}
102
103#' @rdname ggplot2-ggproto
104#' @format NULL
105#' @usage NULL
106#' @export
107GeomMap <- ggproto("GeomMap", GeomPolygon,
108  draw_panel = function(data, panel_params, coord, map) {
109    # Only use matching data and map ids
110    common <- intersect(data$map_id, map$id)
111    data <- data[data$map_id %in% common, , drop = FALSE]
112    map <- map[map$id %in% common, , drop = FALSE]
113
114    # Munch, then set up id variable for polygonGrob -
115    # must be sequential integers
116    coords <- coord_munch(coord, map, panel_params)
117    coords$group <- coords$group %||% coords$id
118    grob_id <- match(coords$group, unique(coords$group))
119
120    # Align data with map
121    data_rows <- match(coords$id[!duplicated(grob_id)], data$map_id)
122    data <- data[data_rows, , drop = FALSE]
123
124    polygonGrob(coords$x, coords$y, default.units = "native", id = grob_id,
125      gp = gpar(
126        col = data$colour, fill = alpha(data$fill, data$alpha),
127        lwd = data$size * .pt
128      )
129    )
130  },
131
132  required_aes = c("map_id")
133)
134