Pie charts

DESCRIPTION

@@ -8,6 +8,9 @@ Authors@R:
              email = "[email protected]",
              role = c("aut", "cre"),
              comment = c(ORCID = "0000-0001-7021-9380")),
+      person("Thomas Lin Pedersen",
+             role = "ctb",
+             comment = "Original author of some code in pie.R taken from 'ggforce'"),
       person("Western Sydney Local Health District, NSW Health",
              role = "cph"))
 Description: Mapping geometries based on 'ggplot2' for easy maps.
@@ -30,6 +33,7 @@ Imports:
     dplyr (>= 1.0.0),
     ggmapinset (>= 0.2.5),
     ggplot2 (>= 3.4.2),
+    ggforce (>= 0.4.1),
     packcircles (>= 0.3.4),
     rlang (>= 1.0.0),
     sf (>= 1.0),
@@ -48,6 +52,7 @@ Collate:
     'geom_centroids.R'
     'geoscatter.R'
     'ggautomap-package.R'
+    'pie.R'
     'position_circle_repel.R'
 URL: https://github.com/cidm-ph/ggautomap,
     https://cidm-ph.github.io/ggautomap/

NAMESPACE

@@ -1,11 +1,13 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(ggplot_add,ggautomap_zoom_spec)
+export(GeomPie)
 export(GeomSfInset)
 export(PositionCircleRepel)
 export(PositionCircleRepelSf)
 export(StatAutomap)
 export(StatAutomapCoords)
+export(StatCentroidPie)
 export(StatChoropleth)
 export(StatGeoscatter)
 export(StatSfCoordinatesInset)
@@ -19,6 +21,7 @@ export(geom_centroids)
 export(geom_choropleth)
 export(geom_geoscatter)
 export(geom_inset_frame)
+export(geom_pie)
 export(geom_sf_inset)
 export(geom_sf_label_inset)
 export(geom_sf_text_inset)

R/pie.R

@@ -0,0 +1,161 @@
+#' Summarise regions with pie charts
+#'
+#' @section Aesthetics:
+#' The \code{location} aesthetic is required.
+#'
+#' @param pie_radius Scale the side of all pies
+#' @param proportional If \code{TRUE}, scale the pies by the number of rows in
+#'   each region. The radius of each pi is proportional to the count.
+#' @param mapping,data,stat,position,na.rm,show.legend,inherit.aes,... See [ggplot2::geom_sf()].
+#' @inheritParams cartographer::resolve_feature_type
+#'
+#' @returns A ggplot layer.
+#' @export
+#'
+#' @examples
+#' library(ggplot2)
+#'
+#' cartographer::nc_type_example_2 |>
+#'   ggplot(aes(location = county)) +
+#'   geom_boundaries(feature_type = "sf.nc") +
+#'   geom_pie(aes(fill = type), pie_radius = 0.1)
+geom_pie <- function(mapping = ggplot2::aes(), data = NULL,
+                     stat = "centroid_pie", position = "identity",
+                     ...,
+                     feature_type = NA,
+                     pie_radius = 1,
+                     proportional = FALSE,
+                     #inset = NULL,
+                     #map_base = "clip",
+                     #map_inset = "auto",
+                     na.rm = TRUE,
+                     show.legend = TRUE,
+                     inherit.aes = TRUE) {
+  params <- rlang::list2(
+    feature_type = feature_type,
+    pie_radius = pie_radius,
+    proportional = proportional,
+    na.rm = na.rm,
+    ...
+  )
+
+  ggplot2::layer(
+    data = data, mapping = mapping,
+    stat = stat, geom = GeomPie, position = position,
+    show.legend = show.legend, inherit.aes = inherit.aes, params = params
+  )
+}
+
+#' @rdname geom_pie
+#' @usage NULL
+#' @format NULL
+#'
+#' @export
+GeomPie <- ggplot2::ggproto("GeomPie", ggforce::GeomShape,
+  default_aes = modifyList(ggforce::GeomShape$default_aes,
+                           list(linewidth = 0.2, colour = "black"))
+)
+
+#' @rdname geom_pie
+#' @usage NULL
+#' @format NULL
+#'
+#' @importFrom rlang .data
+#' @export
+StatCentroidPie <- ggplot2::ggproto("StatCentroidPie", ggplot2::Stat,
+  required_aes = c("location"),
+
+  setup_data = function(data, params) {
+    data <- ggplot2::Stat$setup_data(data, params)
+    data$location <- cartographer::resolve_feature_names(data$location, params$feature_type)
+
+    # override group, as if we had specified aes(group = location)
+    data$group <- as.integer(factor(data$location))
+
+    data <- dplyr::add_count(data, .data$group, name = "group_size")
+    data$group_size <- data$group_size / nrow(data) * length(unique(data$location))
+
+    data
+  },
+
+  setup_params = function(data, params) {
+    params <- ggplot2::Stat$setup_params(data, params)
+    if (is.null(params[["feature_type"]])) params$feature_type <- NA
+    params$feature_type <- cartographer::resolve_feature_type(params$feature_type,
+                                                              data$location)
+    params
+  },
+
+  compute_group = function(data, scales, coord, feature_type, pie_radius, proportional) {
+    entries <- data$group_size[[1]]
+
+    data <- dplyr::count(data, dplyr::across(dplyr::everything()), name = "amount")
+    angles <- cumsum(data$amount)
+    angles <- angles / max(angles) * 2 * pi
+    data$start <- c(0, angles[-length(angles)])
+    data$end <- angles
+    data <- data[, !names(data) %in% c("amount", "group_size")]
+
+    data$r <- if (proportional) entries * pie_radius else pie_radius
+
+    crs_orig <- sf::st_crs(cartographer::map_sf(feature_type))
+    crs_working <- crs_eqc_midpoint(feature_type)
+
+    geoms <- cartographer::map_sfc(data$location, feature_type)
+    geometry <- sf::st_sfc(geoms, crs = crs_orig)
+    centroids <- sf::st_transform(geometry, crs_working)
+    centroids <- sf::st_transform(sf::st_centroid(centroids), crs_orig)
+    centroids <- matrix(unlist(centroids), ncol = 2, byrow = TRUE)
+    data$x0 <- centroids[, 1]
+    data$y0 <- centroids[, 2]
+
+    arcPaths(data)
+  }
+)
+
+# nolint start
+# -----------------------------------------------------------------------------
+# The remainder of this file is adapted from the ggforce package.
+#
+# Original source:     https://github.com/thomasp85/ggforce/tree/9be635c582559f016254b111770a61e4b4aa0958
+# Original copyright:  Copyright (c) 2019 Thomas Lin Pedersen
+# Original license:    MIT License
+
+data_frame0 <- function(...) vctrs::data_frame(..., .name_repair = "minimal")
+
+make_unique <- function(x, sep = '.') {
+  if (!anyDuplicated(x)) return(x)
+  groups <- match(x, unique(x))
+  suffix <- unsplit(lapply(split(x, groups), seq_along), groups)
+  max_chars <- nchar(max(suffix))
+  suffix_format <- paste0('%0', max_chars, 'd')
+  paste0(x, sep, sprintf(suffix_format, suffix))
+}
+
+arcPaths <- function(data) {
+  trans <- ggforce::radial_trans(c(0, 1), c(0, 2 * pi), pad = 0)
+  data <- data[data$start != data$end, ]
+  data$nControl <- ceiling(360 / (2 * pi) * abs(data$end - data$start))
+  data$nControl[data$nControl < 3] <- 3
+  extraData <- !names(data) %in% c('r0', 'r', 'start', 'end', 'group')
+  data$group <- make_unique(as.character(data$group))
+  paths <- lapply(seq_len(nrow(data)), function(i) {
+    path <- data_frame0(
+      a = seq(data$start[i], data$end[i], length.out = data$nControl[i]),
+      r = data$r[i]
+    )
+    path <- vctrs::vec_rbind(path, data_frame0(a = data$start[i], r = 0))
+    path$group <- data$group[i]
+    path$index <- seq(0, 1, length.out = nrow(path))
+    path <- cbind(path, data[rep(i, nrow(path)), extraData, drop = FALSE])
+  })
+  paths <- vctrs::vec_rbind(!!!paths)
+  paths <- cbind(
+    paths[, !names(paths) %in% c('r', 'a')],
+    trans$transform(paths$r, paths$a)
+  )
+  paths$x <- paths$x + paths$x0
+  paths$y <- paths$y + paths$y0
+  paths[, !names(paths) %in% c('x0', 'y0', 'nControl')]
+}
+# nolint end

vignettes/ggautomap.Rmd

@@ -213,3 +213,25 @@ covid_cases_nsw %>%
   labs(x = NULL, y = NULL) +
   theme_void()
 ```
+
+
+## Pie charts
+
+This example also shows `geom_pie()`, which aggregates points in each location and
+makes primitive pie charts. This geom does not currently support insets.
+
+```{r pies}
+national_data <- data.frame(state = sample(c("qld", "nsw", "vic", "sa", "act"),
+                                           size = 1000, replace = TRUE,
+                                           prob = c(0.2, 0.35, 0.3, 0.1, 0.05)),
+                            type = sample(c("A", "B", "C"),
+                                          size = 1000, replace = TRUE,
+                                          prob = c(0.3, 0.6, 0.1)))
+national_data$type[national_data$state == "act"] <- "A"
+
+national_data %>%
+  ggplot(aes(location = state)) +
+  geom_boundaries(feature_type = "nswgeo.states") +
+  geom_pie(aes(fill = type), pie_radius = 1.5) +
+  theme_void()
+```