Browse Source

updated geom_cartogram examples

tags/v0.4.0
boB Rudis 7 years ago
parent
commit
f061b527d7
  1. 65
      R/geom_cartogram.r
  2. 75
      R/utils.r
  3. 63
      man/geom_cartogram.Rd
  4. 2
      man/macros/aesthetics.Rd

65
R/geom_cartogram.r

@ -1,6 +1,10 @@
#' Polygons from a reference map #' Map polygons layer enabling the display of show statistical information
#' #'
#' This is pure annotation, so does not affect position scales. #' This replicates the old behaviour of \code{geom_map()}, enabling specifying of
#' \code{x} and \code{y} aesthetics.
#'
#' @section Aesthetics:
#' \aesthetics{geom}{cartogram}
#' #'
#' @export #' @export
#' @param map Data frame that contains the map coordinates. This will #' @param map Data frame that contains the map coordinates. This will
@ -9,6 +13,59 @@
#' \code{y}, \code{lat} or \code{latitude} and \code{region} or \code{id}. #' \code{y}, \code{lat} or \code{latitude} and \code{region} or \code{id}.
#' @inheritParams ggplot2::layer #' @inheritParams ggplot2::layer
#' @inheritParams ggplot2::geom_point #' @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, geom_cartogram <- function(mapping = NULL, data = NULL,
stat = "identity", stat = "identity",
..., ...,
@ -77,5 +134,7 @@ GeomCartogram <- ggproto("GeomCartogram", GeomPolygon,
) )
}, },
required_aes = c("x", "y", "map_id") optional_aes = c("x", "y"),
required_aes = c("map_id")
) )

75
R/utils.r

@ -65,3 +65,78 @@ ggname <- function(prefix, grob) {
grob$name <- grobName(grob, prefix) grob$name <- grobName(grob, prefix)
grob grob
} }
# Convert a snake_case string to camelCase
camelize <- function(x, first = FALSE) {
x <- gsub("_(.)", "\\U\\1", x, perl = TRUE)
if (first) x <- firstUpper(x)
x
}
snakeize <- function(x) {
x <- gsub("([A-Za-z])([A-Z])([a-z])", "\\1_\\2\\3", x)
x <- gsub(".", "_", x, fixed = TRUE)
x <- gsub("([a-z])([A-Z])", "\\1_\\2", x)
tolower(x)
}
firstUpper <- function(s) {
paste(toupper(substring(s, 1,1)), substring(s, 2), sep = "")
}
snake_class <- function(x) {
snakeize(class(x)[1])
}
# Look for object first in parent environment and if not found, then in
# ggplot2 namespace environment. This makes it possible to override default
# scales by setting them in the parent environment.
find_global <- function(name, env, mode = "any") {
if (exists(name, envir = env, mode = mode)) {
return(get(name, envir = env, mode = mode))
}
nsenv <- asNamespace("ggalt")
if (exists(name, envir = nsenv, mode = mode)) {
return(get(name, envir = nsenv, mode = mode))
}
NULL
}
find_subclass <- function (super, class, env) {
name <- paste0(super, camelize(class, first = TRUE))
obj <- find_global(name, env = env)
if (is.null(name)) {
stop("No ", tolower(super), " called ", name, ".", call. = FALSE)
}
else if (!inherits(obj, super)) {
stop("Found object is not a ", tolower(super), ".", call. = FALSE)
}
obj
}
alt_aesthetics <- function(type, name) {
obj <- switch(type,
geom = find_subclass("Geom", name, globalenv()),
stat = find_subclass("Stat", name, globalenv())
)
aes <- alt_aesthetics_item(obj)
paste("\\code{", type, "_", name, "} ",
"understands the following aesthetics (required aesthetics are in bold):\n\n",
"\\itemize{\n",
paste(" \\item \\code{", aes, "}", collapse = "\n", sep = ""),
"\n}\n", sep = "")
}
alt_aesthetics_item <- function(x) {
req <- x$required_aes
all <- union(req, sort(x$aesthetics()))
ifelse(all %in% req,
paste0("\\strong{", all, "}"),
all
)
}

63
man/geom_cartogram.Rd

@ -2,7 +2,7 @@
% Please edit documentation in R/geom_cartogram.r % Please edit documentation in R/geom_cartogram.r
\name{geom_cartogram} \name{geom_cartogram}
\alias{geom_cartogram} \alias{geom_cartogram}
\title{Polygons from a reference map} \title{Map polygons layer enabling the display of show statistical information}
\usage{ \usage{
geom_cartogram(mapping = NULL, data = NULL, stat = "identity", ..., map, geom_cartogram(mapping = NULL, data = NULL, stat = "identity", ..., map,
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) na.rm = FALSE, show.legend = NA, inherit.aes = TRUE)
@ -53,6 +53,65 @@ that define both data and aesthetics and shouldn't inherit behaviour from
the default plot specification, e.g. \code{\link{borders}}.} the default plot specification, e.g. \code{\link{borders}}.}
} }
\description{ \description{
This is pure annotation, so does not affect position scales. This replicates the old behaviour of \code{geom_map()}, enabling specifying of
\code{x} and \code{y} aesthetics.
}
\section{Aesthetics}{
\aesthetics{geom}{cartogram}
}
\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)
}
} }

2
man/macros/aesthetics.Rd

@ -1 +1 @@
\newcommand{\aesthetics}{\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("#1", "#2")}} \newcommand{\aesthetics}{\Sexpr[results=rd,stage=build]{ggalt:::alt_aesthetics("#1", "#2")}}

Loading…
Cancel
Save