#' Map polygons layer enabling the display of show statistical information #' #' This replicates the old behaviour of \code{geom_map()}, enabling specifying of #' \code{x} and \code{y} aesthetics. #' #' @section Aesthetics: #' \code{geom_cartogram} understands the following aesthetics (required aesthetics are in bold): #' \itemize{ #' \item \code{\strong{map_id}} #' \item \code{alpha} #' \item \code{colour} #' \item \code{fill} #' \item \code{group} #' \item \code{linetype} #' \item \code{size} #' \item \code{x} #' \item \code{y} #' } #' #' @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}, \code{long} or \code{longitude}, #' \code{y}, \code{lat} or \code{latitude} and \code{region} or \code{id}. #' @inheritParams ggplot2::layer #' @inheritParams ggplot2::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() + #' geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) #' #' ggplot() + #' geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) + #' geom_cartogram(data=values, map=positions, aes(fill = value, map_id=id)) #' #' ggplot() + #' geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) + #' geom_cartogram(data=values, map=positions, aes(fill = value, map_id=id)) + #' ylim(0, 3) #' #' # Better example #' crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests) #' crimesm <- reshape2::melt(crimes, id = 1) #' #' if (require(maps)) { #' #' states_map <- map_data("state") #' #' ggplot() + #' geom_cartogram(aes(long, lat, map_id = region), map = states_map, data=states_map) + #' geom_cartogram(aes(fill = Murder, map_id = state), map=states_map, data=crimes) #' #' last_plot() + coord_map("polyconic") #' #' ggplot() + #' geom_cartogram(aes(long, lat, map_id=region), map = states_map, data=states_map) + #' geom_cartogram(aes(fill = value, map_id=state), map = states_map, data=crimesm) + #' coord_map("polyconic") + #' facet_wrap( ~ variable) #' } geom_cartogram <- function(mapping = NULL, data = NULL, stat = "identity", ..., map, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { # Get map input into correct form stopifnot(is.data.frame(map)) if (!is.null(map$latitude)) map$y <- map$latitude if (!is.null(map$lat)) map$y <- map$lat if (!is.null(map$longitude)) map$x <- map$longitude 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))) layer( data = data, mapping = mapping, stat = stat, geom = GeomCartogram, position = PositionIdentity, show.legend = show.legend, inherit.aes = inherit.aes, params = list( map = map, na.rm = na.rm, ... ) ) } #' Geom Cartogram #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export GeomCartogram <- ggproto("GeomCartogram", GeomPolygon, draw_panel = function(data, panel_scales, coord, 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(coord, map, panel_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] grid::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 ) ) }, optional_aes = c("x", "y"), required_aes = c("map_id") )