geom_cartogram

DESCRIPTION

@@ -57,6 +57,7 @@ Collate:
     'geom_bkde.r'
     'geom_bkde2d.r'
     'geom_dumbbell.R'
+    'geom_cartogram.r'
     'geom_encircle.r'
     'geom_lollipop.r'
     'geom_table.r'

NAMESPACE

@@ -10,6 +10,7 @@ export(CoordProj)
 export(Gb)
 export(GeomBkde)
 export(GeomBkde2d)
+export(GeomCartogram)
 export(GeomDumbbell)
 export(GeomEncircle)
 export(GeomLollipop)
@@ -30,6 +31,7 @@ export(bytes)
 export(coord_proj)
 export(geom_bkde)
 export(geom_bkde2d)
+export(geom_cartogram)
 export(geom_dumbbell)
 export(geom_encircle)
 export(geom_lollipop)
@@ -75,6 +77,7 @@ importFrom(grid,grobWidth)
 importFrom(grid,grobX)
 importFrom(grid,grobY)
 importFrom(grid,pointsGrob)
+importFrom(grid,polygonGrob)
 importFrom(grid,segmentsGrob)
 importFrom(grid,textGrob)
 importFrom(grid,unit.c)

R/geom_cartogram.r

@@ -0,0 +1,81 @@
+#' Polygons from a reference map
+#'
+#' This is pure annotation, so does not affect position scales.
+#'
+#' @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
+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
+      )
+    )
+  },
+
+  required_aes = c("x", "y", "map_id")
+)

R/ggalt-package.r

@@ -11,7 +11,7 @@
 #' @importFrom scales rescale expand_range
 #' @importFrom grid grobName grobTree unit.c grobHeight grobWidth viewport
 #'                  grid.draw grobX grobY gTree gList textGrob gpar pointsGrob
-#'                  segmentsGrob
+#'                  segmentsGrob polygonGrob
 #' @importFrom gtable gtable_col gtable_height gtable_width gtable_row gtable_col
 #' @importFrom RColorBrewer brewer.pal
 #' @importFrom extrafont loadfonts fonts ttf_import

man/geom_cartogram.Rd

@@ -0,0 +1,58 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/geom_cartogram.r
+\name{geom_cartogram}
+\alias{geom_cartogram}
+\title{Polygons from a reference map}
+\usage{
+geom_cartogram(mapping = NULL, data = NULL, stat = "identity", ..., map,
+  na.rm = FALSE, show.legend = NA, inherit.aes = TRUE)
+}
+\arguments{
+\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or
+\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the
+default), it is combined with the default mapping at the top level of the
+plot. You must supply \code{mapping} if there is no plot mapping.}
+
+\item{data}{The data to be displayed in this layer. There are three
+   options:
+
+   If \code{NULL}, the default, the data is inherited from the plot
+   data as specified in the call to \code{\link{ggplot}}.
+
+   A \code{data.frame}, or other object, will override the plot
+   data. All objects will be fortified to produce a data frame. See
+   \code{\link{fortify}} for which variables will be created.
+
+   A \code{function} will be called with a single argument,
+   the plot data. The return value must be a \code{data.frame.}, and
+   will be used as the layer data.}
+
+\item{stat}{The statistical transformation to use on the data for this
+layer, as a string.}
+
+\item{...}{other arguments passed on to \code{\link{layer}}. These are
+often aesthetics, used to set an aesthetic to a fixed value, like
+\code{color = "red"} or \code{size = 3}. They may also be parameters
+to the paired geom/stat.}
+
+\item{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}.}
+
+\item{na.rm}{If \code{FALSE}, the default, missing values are removed with
+a warning. If \code{TRUE}, missing values are silently removed.}
+
+\item{show.legend}{logical. Should this layer be included in the legends?
+\code{NA}, the default, includes if any aesthetics are mapped.
+\code{FALSE} never includes, and \code{TRUE} always includes.}
+
+\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics,
+rather than combining with them. This is most useful for helper functions
+that define both data and aesthetics and shouldn't inherit behaviour from
+the default plot specification, e.g. \code{\link{borders}}.}
+}
+\description{
+This is pure annotation, so does not affect position scales.
+}
+

man/ggplot2-ggproto.Rd

@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/geom_cartogram.r
+\docType{data}
+\name{GeomCartogram}
+\alias{GeomCartogram}
+\title{Geom Cartogram}
+\description{
+Geom Cartogram
+}
+\keyword{datasets}
+

man/macros/aesthetics.Rd

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