1#' @include geom-map.r
2NULL
3
4#' Annotation: a map
5#'
6#' Display a fixed map on a plot. This function predates the [`geom_sf()`]
7#' framework and does not work with sf geometry columns as input. However,
8#' it can be used in conjunction with `geom_sf()` layers and/or
9#' [`coord_sf()`] (see examples).
10#'
11#' @param map Data frame representing a map. See [`geom_map()`] for
12#'   details.
13#' @param ... Other arguments used to modify visual parameters, such as
14#'   `colour` or `fill`.
15#' @export
16#' @examples
17#' \dontrun{
18#' if (requireNamespace("maps", quietly = TRUE)) {
19#' # location of cities in North Carolina
20#' df <- data.frame(
21#'   name = c("Charlotte", "Raleigh", "Greensboro"),
22#'   lat = c(35.227, 35.772, 36.073),
23#'   long = c(-80.843, -78.639, -79.792)
24#' )
25#'
26#' p <- ggplot(df, aes(x = long, y = lat)) +
27#'   annotation_map(
28#'     map_data("state"),
29#'     fill = "antiquewhite", colour = "darkgrey"
30#'   ) +
31#'   geom_point(color = "blue") +
32#'   geom_text(
33#'     aes(label = name),
34#'     hjust = 1.105, vjust = 1.05, color = "blue"
35#'   )
36#'
37#' # use without coord_sf() is possible but not recommended
38#' p + xlim(-84, -76) + ylim(34, 37.2)
39#'
40#' if (requireNamespace("sf", quietly = TRUE)) {
41#' # use with coord_sf() for appropriate projection
42#' p +
43#'   coord_sf(
44#'     crs = st_crs(3347),
45#'     default_crs = st_crs(4326),  # data is provided as long-lat
46#'     xlim = c(-84, -76),
47#'     ylim = c(34, 37.2)
48#'   )
49#'
50#' # you can mix annotation_map() and geom_sf()
51#' nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
52#' p +
53#'   geom_sf(
54#'     data = nc, inherit.aes = FALSE,
55#'     fill = NA, color = "black", size = 0.1
56#'   ) +
57#'   coord_sf(crs = st_crs(3347), default_crs = st_crs(4326))
58#' }}}
59annotation_map <- function(map, ...) {
60  # Get map input into correct form
61  if (!is.data.frame(map)) {
62    abort("`map` must be a data.frame")
63  }
64  if (!is.null(map$lat)) map$y <- map$lat
65  if (!is.null(map$long)) map$x <- map$long
66  if (!is.null(map$region)) map$id <- map$region
67  if (!all(c("x", "y", "id") %in% names(map))) {
68    abort("`map`must have the columns `x`, `y`, and `id`")
69  }
70
71  layer(
72    data = dummy_data(),
73    stat = StatIdentity,
74    geom = GeomAnnotationMap,
75    position = PositionIdentity,
76    inherit.aes = FALSE,
77    params = list(map = map, ...)
78  )
79}
80
81#' @rdname ggplot2-ggproto
82#' @format NULL
83#' @usage NULL
84#' @export
85GeomAnnotationMap <- ggproto("GeomAnnotationMap", GeomMap,
86  extra_params = "",
87  handle_na = function(data, params) {
88    data
89  },
90
91  draw_panel = function(data, panel_params, coord, map) {
92    # Munch, then set up id variable for polygonGrob -
93    # must be sequential integers
94    coords <- coord_munch(coord, map, panel_params)
95    coords$group <- coords$group %||% coords$id
96    grob_id <- match(coords$group, unique(coords$group))
97
98    polygonGrob(coords$x, coords$y, default.units = "native",
99      id = grob_id,
100      gp = gpar(
101        col = data$colour, fill = alpha(data$fill, data$alpha),
102        lwd = data$size * .pt)
103      )
104  },
105
106  required_aes = c()
107)
108