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