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
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")
|
|
|
|
)
|
|
|