Extra Coordinate Systems, 'Geoms', Statistical Transformations, Scales and Fonts for 'ggplot2'
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

152 lines
4.7 KiB

#' 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{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 \dontrun{
#' # 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")
)