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.
123 lines
4.1 KiB
123 lines
4.1 KiB
#' Waffle (Square pie chart) Geom
|
|
#'
|
|
#' There are two special/critical `aes()` mappings:
|
|
#' - `fill` (so the geom knows which column to map the country names/abbrevs to)
|
|
#' - `values` (which column you're mapping the filling for the squares with)
|
|
#'
|
|
#' @md
|
|
#' @param mapping Set of aesthetic mappings created by `aes()` or
|
|
#' `aes_()`. If specified and `inherit.aes = TRUE` (the
|
|
#' default), it is combined with the default mapping at the top level of the
|
|
#' plot. You must supply `mapping` if there is no plot mapping.
|
|
#' @param n_rows how many rows should there be in the waffle chart? default is 10
|
|
#' @param make_proportional compute proportions from the raw values? (i.e. each
|
|
#' value `n` will be replaced with `n`/`sum(n)`); default is `FALSE`.
|
|
#' @param data The data to be displayed in this layer. There are three
|
|
#' options:
|
|
#'
|
|
#' If `NULL`, the default, the data is inherited from the plot
|
|
#' data as specified in the call to `ggplot()`.
|
|
#'
|
|
#' A `data.frame`, or other object, will override the plot
|
|
#' data. All objects will be fortified to produce a data frame. See
|
|
#' `fortify()` for which variables will be created.
|
|
#'
|
|
#' A `function` will be called with a single argument,
|
|
#' the plot data. The return value must be a `data.frame.`, and
|
|
#' will be used as the layer data.
|
|
#' @param na.rm If `FALSE`, the default, missing values are removed with
|
|
#' a warning. If `TRUE`, missing values are silently removed.
|
|
#' @param show.legend logical. Should this layer be included in the legends?
|
|
#' `NA`, the default, includes if any aesthetics are mapped.
|
|
#' `FALSE` never includes, and `TRUE` always includes.
|
|
#' It can also be a named logical vector to finely select the aesthetics to
|
|
#' display.
|
|
#' @param inherit.aes If `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. `borders()`.
|
|
#' @param ... other arguments passed on to `layer()`. These are
|
|
#' often aesthetics, used to set an aesthetic to a fixed value, like
|
|
#' `color = "red"` or `size = 3`. They may also be parameters
|
|
#' to the paired geom/stat.
|
|
#' @export
|
|
geom_waffle <- function(
|
|
mapping = NULL, data = NULL,
|
|
n_rows = 10, make_proportional = FALSE,
|
|
na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, ...) {
|
|
|
|
ggplot2::layer(
|
|
data = data,
|
|
mapping = mapping,
|
|
stat = "waffle",
|
|
geom = GeomWaffle,
|
|
position = "identity",
|
|
show.legend = show.legend,
|
|
inherit.aes = inherit.aes,
|
|
params = list(
|
|
na.rm = TRUE,
|
|
n_rows = n_rows,
|
|
make_proportional = make_proportional,
|
|
...
|
|
)
|
|
)
|
|
|
|
}
|
|
|
|
#' @rdname geom_waffle
|
|
#' @export
|
|
GeomWaffle <- ggplot2::ggproto(
|
|
`_class` = "GeomWaffle",
|
|
`_inherit` = ggplot2::Geom,
|
|
|
|
default_aes = ggplot2::aes(
|
|
values = "values",
|
|
fill = NA, colour = "#b2b2b2", alpha = NA,
|
|
size = 0.125, linetype = 1, width = NA, height = NA
|
|
),
|
|
|
|
required_aes = c("x", "y"),
|
|
|
|
extra_params = c("na.rm", "width", "height"),
|
|
|
|
setup_data = function(data, params) {
|
|
|
|
# message("Called GEOM setup_data()")
|
|
|
|
waf.dat <- data #data.frame(data)#, stringsAsFactors=FALSE)
|
|
|
|
waf.dat$width <- waf.dat$width %||% params$width %||% ggplot2::resolution(waf.dat$x, FALSE)
|
|
waf.dat$height <- waf.dat$height %||% params$height %||% ggplot2::resolution(waf.dat$y, FALSE)
|
|
|
|
transform(
|
|
waf.dat,
|
|
xmin = x - width / 2, xmax = x + width / 2, width = NULL,
|
|
ymin = y - height / 2, ymax = y + height / 2, height = NULL
|
|
) -> xdat
|
|
|
|
xdat
|
|
|
|
},
|
|
|
|
draw_group = function(self, data, panel_params, coord,
|
|
n_rows = 10, make_proportional = FALSE) {
|
|
|
|
# message("Called GEOM draw_group()")
|
|
|
|
tile_data <- data
|
|
# tile_data$size <- border_size
|
|
# tile_data$colour <- border_col
|
|
|
|
coord <- ggplot2::coord_equal()
|
|
|
|
grid::gList(
|
|
GeomTile$draw_panel(tile_data, panel_params, coord)
|
|
) -> grobs
|
|
|
|
ggname("geom_waffle", grid::grobTree(children = grobs))
|
|
|
|
},
|
|
|
|
draw_key = ggplot2::draw_key_polygon
|
|
|
|
)
|
|
|