Browse Source

better waffle geom

pull/65/head
boB Rudis 5 years ago
parent
commit
42549ea326
No known key found for this signature in database GPG Key ID: 1D7529BE14E2BBA9
  1. 1
      .gitignore
  2. 12
      DESCRIPTION
  3. 5
      NAMESPACE
  4. 66
      R/a-geom-rect.R
  5. 8
      R/aaa.r
  6. 467
      R/geom-pictogram.R
  7. 46
      R/geom-rtile.R
  8. 302
      R/geom-waffle.R
  9. 285
      R/stat-pictogram.R
  10. 195
      R/stat-waffle.R
  11. 355
      R/sw2.R
  12. 12
      R/utils.r
  13. 8
      README.md
  14. BIN
      README_files/figure-gfm/geoms-1.png
  15. BIN
      README_files/figure-gfm/waffle-bars-1.png
  16. 90
      man/geom_pictogram.Rd
  17. 31
      man/geom_waffle.Rd
  18. 2
      vignettes/.gitignore
  19. 332
      vignettes/building-waffle-charts.Rmd

1
.gitignore

@ -5,3 +5,4 @@
src/*.o
src/*.so
src/*.dll
inst/doc

12
DESCRIPTION

@ -26,10 +26,15 @@ Encoding: UTF-8
URL: https://gitlab.com/hrbrmstr/waffle
BugReports: https://gitlab.com/hrbrmstr/waffle/issues
Suggests:
testthat
testthat,
knitr,
rmarkdown,
dplyr,
hrbrthemes,
ggthemes
Depends:
R (>= 3.2.0),
ggplot2 (>= 2.0.0)
R (>= 3.5.0),
ggplot2 (>= 3.1.0)
License: GPL (>= 2)
Imports:
RColorBrewer,
@ -43,3 +48,4 @@ Imports:
htmlwidgets,
DT
RoxygenNote: 6.1.1
VignetteBuilder: knitr

5
NAMESPACE

@ -1,17 +1,12 @@
# Generated by roxygen2: do not edit by hand
export(GeomPictogram)
export(GeomWaffle)
export(StatPictogram)
export(StatWaffle)
export(draw_key_pictogram)
export(fa_grep)
export(fa_list)
export(geom_pictogram)
export(geom_waffle)
export(install_fa_fonts)
export(iron)
export(stat_pictogram)
export(stat_waffle)
export(theme_enhance_waffle)
export(waffle)

66
R/a-geom-rect.R

@ -0,0 +1,66 @@
geom_rrect <- function(mapping = NULL, data = NULL, # nocov start
stat = "identity", position = "identity",
radius = grid::unit(6, "pt"),
...,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomRrect,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
radius = radius,
na.rm = na.rm,
...
)
)
}
GeomRrect <- ggplot2::ggproto(
"GeomRrect", ggplot2::Geom,
default_aes = ggplot2::aes(
fill = "grey35", size = 0.5, linetype = 1, alpha = NA#, colour = NA
),
required_aes = c("xmin", "xmax", "ymin", "ymax"),
draw_panel = function(self, data, panel_params, coord,
radius = grid::unit(6, "pt")) {
coords <- coord$transform(data, panel_params)
lapply(1:length(coords$xmin), function(i) {
grid::roundrectGrob(
coords$xmin[i], coords$ymax[i],
width = (coords$xmax[i] - coords$xmin[i]),
height = (coords$ymax[i] - coords$ymin)[i],
r = radius,
default.units = "native",
just = c("left", "top"),
gp = grid::gpar(
col = coords$colour[i],
fill = alpha(coords$fill[i], coords$alpha[i]),
lwd = coords$size[i] * .pt,
lty = coords$linetype[i],
lineend = "butt"
)
)
}) -> gl
grobs <- do.call(grid::gList, gl)
ggname("geom_rrect", grid::grobTree(children = grobs))
},
draw_key = ggplot2::draw_key_polygon
) # nocov end

8
R/aaa.r

@ -1 +1,9 @@
utils::globalVariables(c("x", "y", "value"))
.dbg <- TRUE
msg <- function(...) {
if (.dbg) message(...)
}

467
R/geom-pictogram.R

@ -1,233 +1,234 @@
#' @export
draw_key_pictogram <- function(data, params, size) {
# message("Called draw_key_pictogram()")
# print(str(data, 1))
# print(str(params, 1))
# print(str(size, 1))
# return(draw_key_text(data, params, size))
data[["label"]] <- .fa_unicode[.fa_unicode[["name"]] %in% data[["fa_glyph"]], "unicode"]
fat <- .fa_unicode[.fa_unicode[["name"]] %in% data[["fa_glyph"]], "type"]
ftrans <- c(solid = "FontAwesome5Free-Solid", brands = "FontAwesome5Brands-Regular")
data[["family"]] <- ftrans[fat]
data[["size"]] <- data[["size"]] * 2
grid::textGrob(
data$label, 0.5, 0.25,
rot = data$angle %||% 0,
gp = grid::gpar(
col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
fontfamily = data$family %||% "",
fontface = data$fontface %||% 1,
fontsize = (data$size %||% 3.88) * .pt
)
)
}
#' Isotype pictogram "waffle" charts
#'
#' There are two special/critical `aes()` mappings:
#' - `colour` (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 flip If `TRUE`, flip x and y coords. n_rows then becomes n_cols.
#' Useful to achieve waffle column chart effect. Defaults is `FALSE`.
#' @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
#' @examples
#' data.frame(
#' parts = factor(rep(month.abb[1:3], 3), levels=month.abb[1:3]),
#' values = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
#' fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
#' ) -> xdf
#'
#' ggplot(xdf, aes(fill = parts, values = values)) +
#' geom_pictogram() +
#' facet_wrap(~fct) +
#' coord_equal()
geom_pictogram <- function(
mapping = NULL, data = NULL,
n_rows = 10, flip = FALSE, make_proportional = FALSE,
na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, ...) {
# message("Called geom_pictogram()")
ggplot2::layer(
data = data,
mapping = mapping,
stat = "pictogram",
geom = GeomPictogram,
position = "identity",
show.legend = show.legend,
inherit.aes = inherit.aes,
check.aes = FALSE,
params = list(
na.rm = na.rm,
n_rows = n_rows,
flip = flip,
make_proportional = make_proportional,
use = "colour",
...
)
)
}
#' @rdname geom_pictogram
#' @export
GeomPictogram <- ggplot2::ggproto(
`_class` = "GeomPictogram",
`_inherit` = ggplot2::Geom,
default_aes = ggplot2::aes(
fa_glyph = "circle", fa_type = "solid",
fill = NA, colour = "#b2b2b2", alpha = NA,
size = 2, linetype = 1, width = NA, height = NA
),
required_aes = c("x", "y", "values", "fa_glyph", "fa_type"),
extra_params = c("na.rm", "width", "height", "flip", "use"),
setup_data = function(data, params) {
# message("Called GeomPictogram::setup_data()")
# print(str(data, 1))
waf.dat <- data
# swap x and y values if flip is TRUE
if (params$flip) {
waf.dat$x_temp <- waf.dat$x
waf.dat$x <- waf.dat$y
waf.dat$y <- waf.dat$x_temp
waf.dat$x_temp <- NULL
}
# reduce all values by 0.5
# this allows for axis ticks to align _between_ square rows/cols
# rather than in the middle of a row/col
waf.dat$x <- waf.dat$x - 0.5
waf.dat$y <- waf.dat$y - 0.5
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
# print(str(xdat, 1))
xdat
},
draw_group = function(self, data, panel_params, coord,
n_rows = 10, make_proportional = FALSE) {
# message("Called GeomPictogram::draw_group()")
# message("Called GEOM draw_group()")
tile_data <- data
# tile_data$size <- border_size
# tile_data$colour <- border_col
coord <- ggplot2::coord_equal()
# gg <- gg + geom_tile(
# color = "#00000000", fill = "#00000000", size = size,
# alpha = 0, show.legend = FALSE
# )
gtdat <- tile_data
gtdat[["colour"]] <- "#00000000"
gtdat[["color"]] <- "#00000000"
gtdat[["fill"]] <- "#00000000"
g_pgdat <<- tile_data
self$default_aes[["fa_glyph"]] <- tile_data[["fa_glyph"]][[1]]
pgdat <- tile_data
pgdat[["label"]] <- .fa_unicode[.fa_unicode[["name"]] %in% pgdat[["fa_glyph"]], "unicode"]
fat <- .fa_unicode[.fa_unicode[["name"]] %in% pgdat[["fa_glyph"]], "type"]
ftrans <- c(solid = "FontAwesome5Free-Solid", brands = "FontAwesome5Brands-Regular")
pgdat[["family"]] <- ftrans[fat]
pgdat[["size"]] <- pgdat[["size"]] * 2
pgdat[["angle"]] = 0
pgdat[["hjust"]] <- 0.5
pgdat[["vjust"]] <- 0.5
pgdat[["fontface"]] <- 1
pgdat[["lineheight"]] <- 1
# print(str(pgdat, 1))
# gg <- gg + geom_text(
# aes(color = value, label = fontlab),
# family = glyph_font_family,
# size = glyph_size,
# show.legend = FALSE
# )
grid::gList(
# GeomTile$draw_panel(gtdat, panel_params, coord),
GeomText$draw_panel(pgdat, panel_params, coord)
) -> grobs
ggname("geom_pictogram", grid::grobTree(children = grobs))
},
aesthetics = function(self) {
# message("Called GeomPictogram::aesthetics()")
c(union(self$required_aes, names(self$default_aes)), self$optional_aes, "group")
},
draw_key = draw_key_pictogram
)
# #' @export
# draw_key_pictogram <- function(data, params, size) {
#
# # message("Called draw_key_pictogram()")
#
# # print(str(data, 1))
# # print(str(params, 1))
# # print(str(size, 1))
#
# # return(draw_key_text(data, params, size))
#
# data[["label"]] <- .fa_unicode[.fa_unicode[["name"]] %in% data[["fa_glyph"]], "unicode"]
# fat <- .fa_unicode[.fa_unicode[["name"]] %in% data[["fa_glyph"]], "type"]
# ftrans <- c(solid = "FontAwesome5Free-Solid", brands = "FontAwesome5Brands-Regular")
# data[["family"]] <- ftrans[fat]
# data[["size"]] <- data[["size"]] * 2
#
# grid::textGrob(
# data$label, 0.5, 0.25,
# rot = data$angle %||% 0,
# gp = grid::gpar(
# col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
# fontfamily = data$family %||% "",
# fontface = data$fontface %||% 1,
# fontsize = (data$size %||% 3.88) * .pt
# )
# )
# }
# #' Isotype pictogram "waffle" charts
# #'
# #' There are two special/critical `aes()` mappings:
# #' - `colour` (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 flip If `TRUE`, flip x and y coords. n_rows then becomes n_cols.
# #' Useful to achieve waffle column chart effect. Defaults is `FALSE`.
# #' @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
# #' @examples
# #' data.frame(
# #' parts = factor(rep(month.abb[1:3], 3), levels=month.abb[1:3]),
# #' values = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
# #' fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
# #' ) -> xdf
# #'
# #' ggplot(xdf, aes(fill = parts, values = values)) +
# #' geom_pictogram() +
# #' facet_wrap(~fct) +
# #' coord_equal()
# geom_pictogram <- function(
# mapping = NULL, data = NULL,
# n_rows = 10, flip = FALSE, make_proportional = FALSE,
# na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, ...) {
#
# # message("Called geom_pictogram()")
#
# ggplot2::layer(
# data = data,
# mapping = mapping,
# stat = "pictogram",
# geom = GeomPictogram,
# position = "identity",
# show.legend = show.legend,
# inherit.aes = inherit.aes,
# check.aes = FALSE,
# params = list(
# na.rm = na.rm,
# n_rows = n_rows,
# flip = flip,
# make_proportional = make_proportional,
# use = "colour",
# ...
# )
# )
#
# }
#
# #' @rdname geom_pictogram
# #' @export
# GeomPictogram <- ggplot2::ggproto(
# `_class` = "GeomPictogram",
# `_inherit` = ggplot2::Geom,
#
# default_aes = ggplot2::aes(
# fa_glyph = "circle", fa_type = "solid",
# fill = NA, colour = "#b2b2b2", alpha = NA,
# size = 2, linetype = 1, width = NA, height = NA
# ),
#
# required_aes = c("x", "y", "values", "fa_glyph", "fa_type"),
#
# extra_params = c("na.rm", "width", "height", "flip", "use"),
#
# setup_data = function(data, params) {
#
# # message("Called GeomPictogram::setup_data()")
# # print(str(data, 1))
#
# waf.dat <- data
#
# # swap x and y values if flip is TRUE
# if (params$flip) {
# waf.dat$x_temp <- waf.dat$x
# waf.dat$x <- waf.dat$y
# waf.dat$y <- waf.dat$x_temp
# waf.dat$x_temp <- NULL
# }
#
# # reduce all values by 0.5
# # this allows for axis ticks to align _between_ square rows/cols
# # rather than in the middle of a row/col
# waf.dat$x <- waf.dat$x - 0.5
# waf.dat$y <- waf.dat$y - 0.5
#
# 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
#
# # print(str(xdat, 1))
#
# xdat
#
# },
#
# draw_group = function(self, data, panel_params, coord,
# n_rows = 10, make_proportional = FALSE) {
#
# # message("Called GeomPictogram::draw_group()")
#
# # message("Called GEOM draw_group()")
#
# tile_data <- data
# # tile_data$size <- border_size
# # tile_data$colour <- border_col
#
# coord <- ggplot2::coord_equal()
#
# # gg <- gg + geom_tile(
# # color = "#00000000", fill = "#00000000", size = size,
# # alpha = 0, show.legend = FALSE
# # )
#
# gtdat <- tile_data
# gtdat[["colour"]] <- "#00000000"
# gtdat[["color"]] <- "#00000000"
# gtdat[["fill"]] <- "#00000000"
#
# g_pgdat <<- tile_data
#
# self$default_aes[["fa_glyph"]] <- tile_data[["fa_glyph"]][[1]]
#
# pgdat <- tile_data
# pgdat[["label"]] <- .fa_unicode[.fa_unicode[["name"]] %in% pgdat[["fa_glyph"]], "unicode"]
# fat <- .fa_unicode[.fa_unicode[["name"]] %in% pgdat[["fa_glyph"]], "type"]
# ftrans <- c(solid = "FontAwesome5Free-Solid", brands = "FontAwesome5Brands-Regular")
# pgdat[["family"]] <- ftrans[fat]
# pgdat[["size"]] <- pgdat[["size"]] * 2
# pgdat[["angle"]] = 0
# pgdat[["hjust"]] <- 0.5
# pgdat[["vjust"]] <- 0.5
# pgdat[["fontface"]] <- 1
# pgdat[["lineheight"]] <- 1
#
# # print(str(pgdat, 1))
#
# # gg <- gg + geom_text(
# # aes(color = value, label = fontlab),
# # family = glyph_font_family,
# # size = glyph_size,
# # show.legend = FALSE
# # )
#
# grid::gList(
# # GeomTile$draw_panel(gtdat, panel_params, coord),
# GeomText$draw_panel(pgdat, panel_params, coord)
# ) -> grobs
#
# ggname("geom_pictogram", grid::grobTree(children = grobs))
#
# },
#
# aesthetics = function(self) {
# # message("Called GeomPictogram::aesthetics()")
# c(union(self$required_aes, names(self$default_aes)), self$optional_aes, "group")
# },
#
# draw_key = draw_key_pictogram
#
# )
#

46
R/geom-rtile.R

@ -0,0 +1,46 @@
geom_rtile <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
radius = grid::unit(6, "pt"),
...,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
ggplot2::layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomRtile,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
radius = radius,
na.rm = na.rm,
...
)
)
}
GeomRtile <- ggplot2::ggproto("GeomRtile", GeomRrect,
extra_params = c("na.rm", "width", "height"),
setup_data = function(data, params) {
data$width <- data$width %||% params$width %||% ggplot2::resolution(data$x, FALSE)
data$height <- data$height %||% params$height %||% ggplot2::resolution(data$y, FALSE)
transform(data,
xmin = x - width / 2, xmax = x + width / 2, width = NULL,
ymin = y - height / 2, ymax = y + height / 2, height = NULL
)
},
default_aes = ggplot2::aes(
fill = "grey20", colour = NA, size = 0.1, linetype = 1, alpha = NA
),
required_aes = c("x", "y"),
draw_key = ggplot2::draw_key_polygon
)

302
R/geom-waffle.R

@ -1,152 +1,154 @@
#' 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 flip If `TRUE`, flip x and y coords. n_rows then becomes n_cols.
#' Useful to achieve waffle column chart effect. Defaults is `FALSE`.
#' @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
#' @examples
#' data.frame(
#' parts = factor(rep(month.abb[1:3], 3), levels=month.abb[1:3]),
#' values = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
#' fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
#' ) -> xdf
#'
#' ggplot(xdf, aes(fill = parts, values = values)) +
#' geom_waffle() +
#' facet_wrap(~fct) +
#' coord_equal()
geom_waffle <- function(
mapping = NULL, data = NULL,
n_rows = 10, flip = FALSE, make_proportional = FALSE,
na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, ...) {
# #' 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 flip If `TRUE`, flip x and y coords. n_rows then becomes n_cols.
# #' Useful to achieve waffle column chart effect. Defaults is `FALSE`.
# #' @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
# #' @examples
# #' data.frame(
# #' parts = factor(rep(month.abb[1:3], 3), levels=month.abb[1:3]),
# #' values = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
# #' fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
# #' ) -> xdf
# #'
# #' ggplot(xdf, aes(fill = parts, values = values)) +
# #' geom_waffle() +
# #' facet_wrap(~fct) +
# #' coord_equal()
# geom_waffle <- function(
# mapping = NULL, data = NULL,
# n_rows = 10, flip = FALSE, 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,
# flip = flip,
# make_proportional = make_proportional,
# use = "fill",
# ...
# )
# )
#
# }
#
# #' @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", "flip", "use"),
#
# setup_data = function(data, params) {
#
# # message("Called GEOM setup_data()")
#
# waf.dat <- data #data.frame(data)#, stringsAsFactors=FALSE)
#
# # swap x and y values if flip is TRUE
# if (params$flip) {
# waf.dat$x_temp <- waf.dat$x
# waf.dat$x <- waf.dat$y
# waf.dat$y <- waf.dat$x_temp
# waf.dat$x_temp <- NULL
# }
#
# # reduce all values by 0.5
# # this allows for axis ticks to align _between_ square rows/cols
# # rather than in the middle of a row/col
# waf.dat$x <- waf.dat$x - .5
# waf.dat$y <- waf.dat$y - .5
#
# 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
#
# )
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,
flip = flip,
make_proportional = make_proportional,
use = "fill",
...
)
)
}
#' @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", "flip", "use"),
setup_data = function(data, params) {
# message("Called GEOM setup_data()")
waf.dat <- data #data.frame(data)#, stringsAsFactors=FALSE)
# swap x and y values if flip is TRUE
if (params$flip) {
waf.dat$x_temp <- waf.dat$x
waf.dat$x <- waf.dat$y
waf.dat$y <- waf.dat$x_temp
waf.dat$x_temp <- NULL
}
# reduce all values by 0.5
# this allows for axis ticks to align _between_ square rows/cols
# rather than in the middle of a row/col
waf.dat$x <- waf.dat$x - .5
waf.dat$y <- waf.dat$y - .5
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
)

285
R/stat-pictogram.R

@ -1,142 +1,143 @@
#' @rdname geom_pictogram
#' @export
stat_pictogram <- function(mapping = NULL, data = NULL,
n_rows = 10, make_proportional = FALSE,
na.rm = NA, show.legend = NA,
inherit.aes = TRUE, ...) {
layer(
stat = StatPictogram,
data = data,
mapping = mapping,
geom = "pictogram",
position = "identity",
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
n_rows = n_rows,
make_proportional = make_proportional,
...
)
)
}
#' @rdname geom_pictogram
#' @export
StatPictogram <- ggplot2::ggproto(
`_class` = "StatPictogram",
`_inherit` = ggplot2::Stat,
required_aes = c("colour", "values", "fa_type", "fa_glyph"),
extra_params = c("na.rm", "width", "height", "flip", "use"),
setup_params = function(data, params) {
# message("Called StatPictogram::setup_params()")
params
},
setup_data = function(data, params) {
# message("Called StatPictogram::setup_data()")
# print(str(data, 1))
data
},
compute_layer = function(self, data, params, panels) {
# message("Called StatPictogram::compute_layer()")
# print(str(data, 1))
use <- params[["use"]]
if (inherits(data[[use]], "factor")) {
flvls <- levels(data[[use]])
} else {
flvls <- levels(factor(data[[use]]))
}
tr1 <- data[c(use, "fa_glyph", "fa_type")]
tr1 <- tr1[!duplicated(tr1), ]
gtrans <- tr1[, "fa_glyph"]
names(gtrans) <- tr1[, use]
ttrans <- tr1[, "fa_type"]
names(ttrans) <- tr1[, use]
# print(str(tr1, 1))
p <- split(data, data$PANEL)
lapply(p, function(.x) {
parts_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
rep(as.character(.x[[use]][i]), .x[["values"]][i])
}))
pgrp_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
rep(.x$group, .x[[use]][i])
}))
expand.grid(
y = 1:params$n_rows,
x = seq_len((ceiling(sum(.x[["values"]]) / params$n_rows)))#,
# stringsAsFactors = FALSE
) -> tdf
parts_vec <- c(parts_vec, rep(NA, nrow(tdf) - length(parts_vec)))
# tdf$parts <- parts_vec
tdf[["values"]] <- parts_vec
tdf[[use]] <- parts_vec
tdf[["fa_glyph"]] <- gtrans[tdf[[use]]]
tdf[["fa_type"]] <- ttrans[tdf[[use]]]
tdf[["PANEL"]] <- .x[["PANEL"]][1]
tdf[["group"]] <- 1:nrow(tdf)
tdf <- tdf[sapply(tdf[[use]], function(x) !is.na(x)),]
tdf
}) -> p
p <- plyr::rbind.fill(p)
p[[use]] <- factor(p[[use]], levels=flvls)
# print(str(p, 1))
p
},
finish_layer = function(self, data, params) {
# message("Called StatPictogram::finish_layer()")
self$default_aes[["fa_glyph"]] <- "square"
# print(str(data,1))
# print(str(params, 1))
data
},
compute_panel = function(self, data, scales, na.rm = FALSE,
n_rows = 10, make_proportional = FALSE) {
# message("Called StatPictogram::compute_panel()")
ggproto_parent(Stat, self)$compute_panel(
data, scales,
n_rows = n_rows,
make_proportional = make_proportional,
na.rm = na.rm
)
},
aesthetics = function(self) {
# message("Called StatPictogram::aesthetics()")
c(union(self$required_aes, names(self$default_aes)), "group")
}
)
# #' @rdname geom_pictogram
# #' @export
# stat_pictogram <- function(mapping = NULL, data = NULL,
# n_rows = 10, make_proportional = FALSE,
# na.rm = NA, show.legend = NA,
# inherit.aes = TRUE, ...) {
#
# layer(
# stat = StatPictogram,
# data = data,
# mapping = mapping,
# geom = "pictogram",
# position = "identity",
# show.legend = show.legend,
# inherit.aes = inherit.aes,
# params = list(
# na.rm = na.rm,
# n_rows = n_rows,
# make_proportional = make_proportional,
# ...
# )
# )
# }
#
# #' @rdname geom_pictogram
# #' @export
# StatPictogram <- ggplot2::ggproto(
# `_class` = "StatPictogram",
# `_inherit` = ggplot2::Stat,
#
# required_aes = c("colour", "values", "fa_type", "fa_glyph"),
# extra_params = c("na.rm", "width", "height", "flip", "use"),
#
# setup_params = function(data, params) {
# # message("Called StatPictogram::setup_params()")
# params
# },
#
# setup_data = function(data, params) {
# # message("Called StatPictogram::setup_data()")
# # print(str(data, 1))
# data
# },
#
# compute_layer = function(self, data, params, panels) {
#
# # message("Called StatPictogram::compute_layer()")
# # print(str(data, 1))
#
# use <- params[["use"]]
#
# if (inherits(data[[use]], "factor")) {
# flvls <- levels(data[[use]])
# } else {
# flvls <- levels(factor(data[[use]]))
# }
#
# tr1 <- data[c(use, "fa_glyph", "fa_type")]
# tr1 <- tr1[!duplicated(tr1), ]
#
# gtrans <- tr1[, "fa_glyph"]
# names(gtrans) <- tr1[, use]
#
# ttrans <- tr1[, "fa_type"]
# names(ttrans) <- tr1[, use]
#
# # print(str(tr1, 1))
#
# p <- split(data, data$PANEL)
#
# lapply(p, function(.x) {
#
# parts_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
# rep(as.character(.x[[use]][i]), .x[["values"]][i])
# }))
#
# pgrp_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
# rep(.x$group, .x[[use]][i])
# }))
#
# expand.grid(
# y = 1:params$n_rows,
# x = seq_len((ceiling(sum(.x[["values"]]) / params$n_rows)))#,
# # stringsAsFactors = FALSE
# ) -> tdf
#
# parts_vec <- c(parts_vec, rep(NA, nrow(tdf) - length(parts_vec)))
#
# # tdf$parts <- parts_vec
# tdf[["values"]] <- parts_vec
# tdf[[use]] <- parts_vec
#
# tdf[["fa_glyph"]] <- gtrans[tdf[[use]]]
# tdf[["fa_type"]] <- ttrans[tdf[[use]]]
#
# tdf[["PANEL"]] <- .x[["PANEL"]][1]
# tdf[["group"]] <- 1:nrow(tdf)
#
# tdf <- tdf[sapply(tdf[[use]], function(x) !is.na(x)),]
#
# tdf
#
# }) -> p
#
# p <- plyr::rbind.fill(p)
# p[[use]] <- factor(p[[use]], levels=flvls)
#
# # print(str(p, 1))
#
# p
#
# },
#
# finish_layer = function(self, data, params) {
# # message("Called StatPictogram::finish_layer()")
# self$default_aes[["fa_glyph"]] <- "square"
# # print(str(data,1))
# # print(str(params, 1))
# data
# },
#
# compute_panel = function(self, data, scales, na.rm = FALSE,
# n_rows = 10, make_proportional = FALSE) {
#
# # message("Called StatPictogram::compute_panel()")
#
# ggproto_parent(Stat, self)$compute_panel(
# data, scales,
# n_rows = n_rows,
# make_proportional = make_proportional,
# na.rm = na.rm
# )
#
# },
#
# aesthetics = function(self) {
# # message("Called StatPictogram::aesthetics()")
# c(union(self$required_aes, names(self$default_aes)), "group")
# }
#
#
# )
#

195
R/stat-waffle.R

@ -1,97 +1,98 @@
#' @rdname geom_waffle
#' @export
stat_waffle<- function(mapping = NULL, data = NULL,
n_rows = 10, make_proportional = FALSE,
na.rm = NA, show.legend = NA,
inherit.aes = TRUE, ...) {
layer(
stat = StatWaffle,
data = data,
mapping = mapping,
geom = "waffle",
position = "identity",
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
n_rows = n_rows,
make_proportional = make_proportional,
...
)
)
}
#' @rdname geom_waffle
#' @export
StatWaffle <- ggplot2::ggproto(
`_class` = "StatWaffle",
`_inherit` = ggplot2::Stat,
required_aes = c("fill", "values"),
extra_params = c("na.rm", "width", "height", "flip", "use"),
compute_layer = function(self, data, params, panels) {
use <- params[["use"]]
if (inherits(data[[use]], "factor")) {
flvls <- levels(data[[use]])
} else {
flvls <- levels(factor(data[[use]]))
}
p <- split(data, data$PANEL)
lapply(p, function(.x) {
parts_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
rep(as.character(.x[[use]][i]), .x[["values"]][i])
}))
pgrp_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
rep(.x$group, .x[[use]][i])
}))
expand.grid(
y = 1:params$n_rows,
x = seq_len((ceiling(sum(.x[["values"]]) / params$n_rows)))#,
# stringsAsFactors = FALSE
) -> tdf
parts_vec <- c(parts_vec, rep(NA, nrow(tdf)-length(parts_vec)))
# tdf$parts <- parts_vec
tdf[["values"]] <- NA
tdf[[use]] <- parts_vec
tdf[["PANEL"]] <- .x[["PANEL"]][1]
tdf[["group"]] <- 1:nrow(tdf)
tdf <- tdf[sapply(tdf[[use]], function(x) !is.na(x)),]
}) -> p
p <- plyr::rbind.fill(p)
p[[use]] <- factor(p[[use]], levels=flvls)
# print(str(p))
p
},
compute_panel = function(self, data, scales, na.rm = FALSE,
n_rows = 10, make_proportional = FALSE) {
# message("Called STAT compute_panel()")
ggproto_parent(Stat, self)$compute_panel(
data, scales,
n_rows = 10,
make_proportional = FALSE
)
}
)
# #' @rdname geom_waffle
# #' @export
# stat_waffle<- function(mapping = NULL, data = NULL,
# n_rows = 10, make_proportional = FALSE,
# na.rm = NA, show.legend = NA,
# inherit.aes = TRUE, ...) {
#
# layer(
# stat = StatWaffle,
# data = data,
# mapping = mapping,
# geom = "waffle",
# position = "identity",
# show.legend = show.legend,
# inherit.aes = inherit.aes,
# params = list(
# na.rm = na.rm,
# n_rows = n_rows,
# make_proportional = make_proportional,
# ...
# )
# )
# }
#
# #' @rdname geom_waffle
# #' @export
# StatWaffle <- ggplot2::ggproto(
# `_class` = "StatWaffle",
# `_inherit` = ggplot2::Stat,
#
# required_aes = c("fill", "values"),
#
# extra_params = c("na.rm", "width", "height", "flip", "use"),
#
# compute_layer = function(self, data, params, panels) {
#
# use <- params[["use"]]
#
# if (inherits(data[[use]], "factor")) {
# flvls <- levels(data[[use]])
# } else {
# flvls <- levels(factor(data[[use]]))
# }
#
# p <- split(data, data$PANEL)
#
# lapply(p, function(.x) {
#
# parts_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
# rep(as.character(.x[[use]][i]), .x[["values"]][i])
# }))
#
# pgrp_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
# rep(.x$group, .x[[use]][i])
# }))
#
# expand.grid(
# y = 1:params$n_rows,
# x = seq_len((ceiling(sum(.x[["values"]]) / params$n_rows)))#,
# # stringsAsFactors = FALSE
# ) -> tdf
#
# parts_vec <- c(parts_vec, rep(NA, nrow(tdf)-length(parts_vec)))
#
# # tdf$parts <- parts_vec
# tdf[["values"]] <- NA
# tdf[[use]] <- parts_vec
# tdf[["PANEL"]] <- .x[["PANEL"]][1]
# tdf[["group"]] <- 1:nrow(tdf)
#
# tdf <- tdf[sapply(tdf[[use]], function(x) !is.na(x)),]
#
# }) -> p
#
# p <- plyr::rbind.fill(p)
# p[[use]] <- factor(p[[use]], levels=flvls)
#
# # print(str(p))
#
# p
#
# },
#
# compute_panel = function(self, data, scales, na.rm = FALSE,
# n_rows = 10, make_proportional = FALSE) {
#
# # message("Called STAT compute_panel()")
#
# ggproto_parent(Stat, self)$compute_panel(
# data, scales,
# n_rows = 10,
# make_proportional = FALSE
# )
#
# }
#
# )
#

355
R/sw2.R

@ -0,0 +1,355 @@
draw_key_waffle <- function(data, params, size, ...) { # nocov start
# msg("Called => draw_key_waffle()")
#
# print(str(data, 1))
# print(str(params, 1))
# print(str(size, 1))
# print(str(list(...), 1))
grid::roundrectGrob(
r = min(params$radius, unit(3, "pt")),
default.units = "native",
width = 0.9, height = 0.9,
name = "lkey",
gp = grid::gpar(
col = params[["color"]][[1]] %l0% params[["colour"]][1] %l0% data[["colour"]][[1]] %l0% "#00000000",
fill = alpha(data$fill %||% data$colour %||% "grey20", data$alpha),
lty = data$linetype %||% 1
)
)
} # nocov end
#' 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 flip If `TRUE`, flip x and y coords. n_rows then becomes n_cols.
#' Useful to achieve waffle column chart effect. Defaults is `FALSE`.
#' @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 radius radius
#' @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
#' @examples
#' data.frame(
#' parts = factor(rep(month.abb[1:3], 3), levels=month.abb[1:3]),
#' vals = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
#' fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
#' ) -> xdf
#'
#' ggplot(xdf, aes(fill = parts, values = vals)) +
#' geom_waffle() +
#' facet_wrap(~fct)
geom_waffle <- function(mapping = NULL, data = NULL,
n_rows = 10, make_proportional = FALSE,
na.rm = NA, show.legend = NA, flip = FALSE,
radius = grid::unit(0, "npc"),
inherit.aes = TRUE, ...) {
# msg("Called => geom_waffle::geom_waffle()")
# msg("Done With => geom_waffle::geom_waffle()")
layer(
stat = StatWaffle,
data = data,
mapping = mapping,
geom = GeomWaffle,
position = "identity",
show.legend = show.legend,
inherit.aes = inherit.aes,
check.param = FALSE,
params = list(
na.rm = na.rm,
n_rows = n_rows,
make_proportional = make_proportional,
flip = flip,
radius = radius,
...
)
)
}
#' @rdname geom_waffle
#' @export
GeomWaffle <- ggplot2::ggproto(
`_class` = "GeomWaffle",
`_inherit` = GeomRtile,
default_aes = ggplot2::aes(
fill = NA, alpha = NA, colour = NA,
size = 0.125, linetype = 1, width = NA, height = NA
),
draw_group = function(self, data, panel_params, coord,
n_rows = 10, make_proportional = FALSE, flip = FALSE,
radius = grid::unit(0, "npc")) {
# msg("Called => GeomWaffle::draw_group()")
coord <- ggplot2::coord_equal()
grobs <- GeomRtile$draw_panel(data, panel_params, coord, radius)
# msg("Done With => GeomWaffle::draw_group()")
ggname("geom_waffle", grid::grobTree(children = grobs))
},
draw_panel = function(self, data, panel_params, coord,
n_rows = 10, make_proportional = FALSE, flip = FALSE,
radius = grid::unit(0, "npc")) {
# msg("Called => GeomWaffle::draw_panel()")
coord <- ggplot2::coord_equal()
# grid::gList(
grobs <- GeomRtile$draw_panel(data, panel_params, coord, radius)
# ) -> grobs
# msg("Done With => GeomWaffle::draw_panel()")
ggname("geom_waffle", grid::grobTree(children = grobs))
},
draw_key = draw_key_waffle
)
#' @rdname geom_waffle
#' @export
stat_waffle <- function(mapping = NULL, data = NULL, geom = "blank",
n_rows = 10, make_proportional = FALSE, flip = FALSE,
radius = grid::unit(0, "npc"),
na.rm = NA, show.legend = NA,
inherit.aes = TRUE, ...) {
# msg("Called => stat_waffle::stat_waffle()")
# msg("Done With => stat_waffle::stat_waffle()")
layer(
stat = StatWaffle,
data = data,
mapping = mapping,
geom = geom,
position = "identity",
show.legend = show.legend,
inherit.aes = inherit.aes,
check.param = FALSE,
params = list(
na.rm = na.rm,
n_rows = n_rows,
make_proportional = make_proportional,
flip = flip,
radius = radius,
...
)
)
}
#' @rdname geom_waffle
#' @export
StatWaffle <- ggplot2::ggproto(
`_class` = "StatWaffle",
`_inherit` = ggplot2::Stat,
extra_params = c("na.rm", "n_rows", "make_proportional", "flip", "radius"),
required_aes = c("fill", "values", "colour"),
setup_params = function(data, params) {
# msg("Called => StatWaffle::setup_params()")
# msg("Done With => StatWaffle::setup_params()")
params
},
setup_data = function(data, params) {
# msg("Called => StatWaffle::setup_data()")
#
# print(str(data, 1))
# print(str(params, 1))
use <- "fill"
if (inherits(data[[use]], "factor")) {
flvls <- levels(data[[use]])
} else {
flvls <- levels(factor(data[[use]]))
}
if (inherits(data[["colour"]], "factor")) {
clvls <- levels(data[["colour"]])
} else {
clvls <- levels(factor(data[["colour"]]))
}
if (!("colour" %in% names(data))) {
data[["colour"]] <- "white"
} else {
if (any(is.na(as.character(data[["colour"]])))) {
data[["colour"]] <- "white"
} else {
data[["colour"]] <- as.character(data[["colour"]])
}
}
p <- split(data, data$PANEL)
lapply(p, function(.x) {
if (params[["make_proportional"]]) {
.x[["values"]] <- .x[["values"]] / sum(.x[["values"]])
.x[["values"]] <- round_preserve_sum(.x[["values"]], digits = 2)
.x[["values"]] <- as.integer(.x[["values"]] * 100)
}
parts_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
rep(as.character(.x[[use]][i]), .x[["values"]][i])
}))
pgrp_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
rep(.x$group, .x[["values"]][i])
}))
# print(str(.x, 1))
colour_vec <- unlist(sapply(1:length(.x[[use]]), function(i) {
rep(.x[["colour"]][i], .x[["values"]][i])
}))
expand.grid(
y = 1:params$n_rows,
x = seq_len((ceiling(sum(.x[["values"]]) / params$n_rows)))#,
# stringsAsFactors = FALSE
) -> tdf
parts_vec <- c(parts_vec, rep(NA, nrow(tdf)-length(parts_vec)))
colour_vec <- c(colour_vec, rep(NA, nrow(tdf)-length(colour_vec)))
# tdf$parts <- parts_vec
tdf[["values"]] <- NA
tdf[["colour"]] <- colour_vec
tdf[[use]] <- parts_vec
tdf[["PANEL"]] <- .x[["PANEL"]][1]
tdf[["group"]] <- 1:nrow(tdf)
tdf <- tdf[sapply(tdf[[use]], function(x) !is.na(x)),]
}) -> p
p <- plyr::rbind.fill(p)
p[[use]] <- factor(p[[use]], levels=flvls)
p[["colour"]] <- factor(p[["colour"]], levels = clvls)
# print(str(p, 1))
#
# msg("Done With => StatWaffle::setup_data()")
# data
wdat <- p
if (params$flip) {
x_temp <- wdat$x
wdat$x <- wdat$y
wdat$y <- x_temp
x_temp <- NULL
}
wdat$width <- wdat$width %||% params$width %||% ggplot2::resolution(wdat$x, FALSE)
wdat$height <- wdat$height %||% params$height %||% ggplot2::resolution(wdat$y, FALSE)
transform(
wdat,
xmin = x - width / 2,
xmax = x + width / 2,
width = NULL,
ymin = y - height / 2,
ymax = y + height / 2,
height = NULL
) -> p
p
},
compute_layer = function(self, data, params, layout) {
# msg("Called => StatWaffle::compute_layer()")
# print(str(data, 1))
# print(str(params, 1))
# msg("Done With => StatWaffle::compute_layer()")
data
},
finish_layer = function(self, data, params) {
# msg("Called => StatWaffle::finish_layer()")
# msg("Done With => StatWaffle::finish_layer()")
data
},
compute_panel = function(self, data, scales, ...) {
# msg("Called => StatWaffle::compute_panel()")
# msg("Done With => StatWaffle::compute_panel()")
data
}
)

12
R/utils.r

@ -1,3 +1,12 @@
round_preserve_sum <- function(x, digits = 0) {
up <- 10^digits
x <- x * up
y <- floor(x)
indices <- tail(order(x - y), round(sum(x)) - sum(y))
y[indices] <- y[indices] + 1
y / up
}
# VIA: http://stackoverflow.com/q/13294952/1457051
rbind_gtable_max <- function(...) {
@ -86,5 +95,6 @@ ggname <- function(prefix, grob) {
}
"%||%" <- function(a, b) { if (!is.null(a)) a else b }
"%l0%" <- function(a, b) { if (length(a)) a else b }
.pt <- 2.84527559055118
.pt <- ggplot2::.pt

8
README.md

@ -182,7 +182,7 @@ waffle(
### Replicating an old favourite
![](http://graphics8.nytimes.com/images/2008/07/20/business/20debtgraphic.jpg)
![](https://graphics8.nytimes.com/images/2008/07/20/business/20debtgraphic.jpg)
Via: <https://www.nytimes.com/2008/07/20/business/20debt.html>
@ -290,9 +290,9 @@ cloc::cloc_pkg_md()
```
| Lang | \# Files | (%) | LoC | (%) | Blank lines | (%) | \# Lines | (%) |
| :--- | -------: | ---: | --: | ---: | ----------: | ---: | -------: | ---: |
| R | 12 | 0.92 | 387 | 0.75 | 140 | 0.66 | 269 | 0.74 |
| Rmd | 1 | 0.08 | 131 | 0.25 | 72 | 0.34 | 93 | 0.26 |
| :--- | -------: | --: | --: | ---: | ----------: | ---: | -------: | ---: |
| R | 18 | 0.9 | 545 | 0.63 | 202 | 0.61 | 1011 | 0.85 |
| Rmd | 2 | 0.1 | 317 | 0.37 | 130 | 0.39 | 181 | 0.15 |
## Code of Conduct

BIN
README_files/figure-gfm/geoms-1.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 60 KiB

After

Width:  |  Height:  |  Size: 60 KiB

BIN
README_files/figure-gfm/waffle-bars-1.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 108 KiB

After

Width:  |  Height:  |  Size: 106 KiB

90
man/geom_pictogram.Rd

@ -1,90 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/geom-pictogram.R, R/stat-pictogram.R
\docType{data}
\name{geom_pictogram}
\alias{geom_pictogram}
\alias{GeomPictogram}
\alias{stat_pictogram}
\alias{StatPictogram}
\title{Isotype pictogram "waffle" charts}
\format{An object of class \code{GeomPictogram} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 8.}
\usage{
geom_pictogram(mapping = NULL, data = NULL, n_rows = 10,
flip = FALSE, make_proportional = FALSE, fa_key = NA,
na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, ...)
GeomPictogram
stat_pictogram(mapping = NULL, data = NULL, n_rows = 10,
make_proportional = FALSE, na.rm = NA, show.legend = NA,
fa_key = NA, inherit.aes = TRUE, ...)
StatPictogram
}
\arguments{
\item{mapping}{Set of aesthetic mappings created by \code{aes()} or
\code{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{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{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{n_rows}{how many rows should there be in the waffle chart? default is 10}
\item{flip}{If \code{TRUE}, flip x and y coords. n_rows then becomes n_cols.
Useful to achieve waffle column chart effect. Defaults is \code{FALSE}.}
\item{make_proportional}{compute proportions from the raw values? (i.e. each
value \code{n} will be replaced with \code{n}/\code{sum(n)}); default is \code{FALSE}.}
\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.
It can also be a named logical vector to finely select the aesthetics to
display.}
\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{borders()}.}
\item{...}{other arguments passed on to \code{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.}
}
\description{
There are two special/critical \code{aes()} mappings:
\itemize{
\item \code{colour} (so the geom knows which column to map the country names/abbrevs to)
\item \code{values} (which column you're mapping the filling for the squares with)
}
}
\examples{
data.frame(
parts = factor(rep(month.abb[1:3], 3), levels=month.abb[1:3]),
values = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
) -> xdf
ggplot(xdf, aes(fill = parts, values = values)) +
geom_pictogram() +
facet_wrap(~fct) +
coord_equal()
}
\keyword{datasets}

31
man/geom_waffle.Rd

@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/geom-waffle.R, R/stat-waffle.R
% Please edit documentation in R/sw2.R
\docType{data}
\name{geom_waffle}
\alias{geom_waffle}
@ -7,16 +7,18 @@
\alias{stat_waffle}
\alias{StatWaffle}
\title{Waffle (Square pie chart) Geom}
\format{An object of class \code{GeomWaffle} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 7.}
\format{An object of class \code{GeomWaffle} (inherits from \code{GeomRtile}, \code{GeomRrect}, \code{Geom}, \code{ggproto}, \code{gg}) of length 5.}
\usage{
geom_waffle(mapping = NULL, data = NULL, n_rows = 10, flip = FALSE,
make_proportional = FALSE, na.rm = TRUE, show.legend = NA,
inherit.aes = TRUE, ...)
geom_waffle(mapping = NULL, data = NULL, n_rows = 10,
make_proportional = FALSE, na.rm = NA, show.legend = NA,
flip = FALSE, radius = grid::unit(0, "npc"), inherit.aes = TRUE,
...)
GeomWaffle
stat_waffle(mapping = NULL, data = NULL, n_rows = 10,
make_proportional = FALSE, na.rm = NA, show.legend = NA,
stat_waffle(mapping = NULL, data = NULL, geom = "blank",
n_rows = 10, make_proportional = FALSE, flip = FALSE,
radius = grid::unit(0, "npc"), na.rm = NA, show.legend = NA,
inherit.aes = TRUE, ...)
StatWaffle
@ -43,9 +45,6 @@ will be used as the layer data.}
\item{n_rows}{how many rows should there be in the waffle chart? default is 10}
\item{flip}{If \code{TRUE}, flip x and y coords. n_rows then becomes n_cols.
Useful to achieve waffle column chart effect. Defaults is \code{FALSE}.}
\item{make_proportional}{compute proportions from the raw values? (i.e. each
value \code{n} will be replaced with \code{n}/\code{sum(n)}); default is \code{FALSE}.}
@ -58,6 +57,11 @@ a warning. If \code{TRUE}, missing values are silently removed.}
It can also be a named logical vector to finely select the aesthetics to
display.}
\item{flip}{If \code{TRUE}, flip x and y coords. n_rows then becomes n_cols.
Useful to achieve waffle column chart effect. Defaults is \code{FALSE}.}
\item{radius}{radius}
\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
@ -78,13 +82,12 @@ There are two special/critical \code{aes()} mappings:
\examples{
data.frame(
parts = factor(rep(month.abb[1:3], 3), levels=month.abb[1:3]),
values = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
vals = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
) -> xdf
ggplot(xdf, aes(fill = parts, values = values)) +
ggplot(xdf, aes(fill = parts, values = vals)) +
geom_waffle() +
facet_wrap(~fct) +
coord_equal()
facet_wrap(~fct)
}
\keyword{datasets}

2
vignettes/.gitignore

@ -0,0 +1,2 @@
*.html
*.R

332
vignettes/building-waffle-charts.Rmd

@ -0,0 +1,332 @@
---
title: "Building Waffle Charts"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Building Waffle Charts}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(
echo = TRUE, message = FALSE, warning = FALSE,
fig.width = 8, fig.height = 6, out.width = "100%"
)
```
```{r libs}
library(hrbrthemes)
library(waffle)
library(ggplot2)
library(dplyr)
```
### Our example data
```{r data}
three_states <- sample(state.name, 3)
data.frame(
states = factor(rep(three_states, 3), levels = three_states),
vals = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
col = rep(c("blue", "black", "red"), 3),
fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
) -> xdf
xdf
```
### Single waffle setup
We'll use this as a base for some of the examples to enable focusing on tweaking the contents of `geom_waffle()`:
```{r base}
xdf %>%
count(states, wt = vals) %>%
ggplot(aes(fill = states, values = n)) +
expand_limits(x=c(0,0), y=c(0,0)) +
coord_equal() +
labs(fill = NULL, colour = NULL) +
theme_ipsum_rc(grid="") +
theme_enhance_waffle() -> waf
```
### Plain waffles
```{r plain}
waf +
geom_waffle(
n_rows = 20, size = 0.33, colour = "white", flip = TRUE
)
```
### Proportional waffles
This likely should be the default. Waffles work best when they are square (makes it easier to compare parts to whole which is the purpose of the chart). You could do this normalization prior to passing data into `geom_waffle()` or let it do it for you with the `make_proportional` parameter.
```{r prop}
waf +
geom_waffle(
n_rows = 10, size = 0.33, colour = "white", flip = TRUE,
make_proportional = TRUE
)
```
### Thicker lines
Need to be careful as this can shift perception to the background grid vs the data encoding you're trying to present.
```{r bigger-lines}
waf +
geom_waffle(
n_rows = 10, size = 3, colour = "white",
make_proportional = TRUE
)
```
### Changing the line color
You can use this to match any background you're going to use or to just provide a different aesthetic feel. Note that the same problem can occur here as in the "bigger lines" case and attention can be inadvertedly shifted to the grid lines vs the colored proportions.
```{r color-change-1}
waf +
geom_waffle(
n_rows = 10, size = 0.33, colour = "black",
make_proportional = TRUE
)
```
We can also "fill in the lines" but that pretty much makes it not a waffle chart:
```{r color-change-2}
waf +
geom_waffle(
aes(colour = states),
n_rows = 10, size = 0.33, make_proportional = TRUE
)
```
You can also map the `colour` aesthetic to a column which can help make a "highlight" effect, but that's going to also contribute to perception skew:
```{r color-change-3}
waf +
geom_waffle(
aes(colour = states),
n_rows = 10, size = 0.45, make_proportional = TRUE
) +
scale_colour_manual(
values = c(alpha("black", 1/3), "black", alpha("black", 1/3))
)
```
You can possibly correct for perception skew by shrinking the width and the height of each cell to make some room for the strokes:
```{r color-change-4}
waf +
geom_waffle(
aes(colour = states),
n_rows = 10, size = 0.3, make_proportional = TRUE,
height = 0.9, width = 0.9
) +
scale_colour_manual(
values = c("white", "black", "white")
)
```
You might be better off just changing the alpha value's though:
```{r color-change-5}
waf +
geom_waffle(
n_rows = 10, size = 0.3, make_proportional = TRUE,
height = 0.9, width = 0.9
) +
scale_fill_manual(
values = c(alpha("#f8766d", 1/3), "#00ba38", alpha("#619cff", 1/3))
)
```
### Hip to not be square?
To mix things up you can also round out the corners by specifying a `grid::unit()` value to the `radius` parameter. This isn't generally recommended as the goal is to enable quick mental perception for parts to whole and the rounded corners can delay and/or skew said interpretation.
Here that is with and without proportional waffles:
```{r round-one}
waf +
geom_waffle(
n_rows = 10, size = 0.5, colour = "white",
make_proportional = TRUE,
radius = unit(4, "pt")
)
```
```{r round-two}
waf +
geom_waffle(
n_rows = 10, size = 0.5, colour = "white",
radius = unit(4, "pt")
)
```
Also, think twice when changing the stroke color as it continues to contribute to perception skew. Consider shrinking the cells to add more space between them if you choose to do this:
```{r round-three}
waf +
geom_waffle(
n_rows = 10, size = 1, colour = "black",
make_proportional = TRUE,
radius = unit(4, "pt"),
height = 0.8, width = 0.8
)
```
You can also use this for the same highlight effect as above:
```{r round-four}
waf +
geom_waffle(
aes(colour = states),
n_rows = 10, size = 0.4, make_proportional = TRUE,
radius = unit(4, "pt"),
height = 0.9, width = 0.9
) +
scale_colour_manual(
values = c("black", "white", "white")
)
```
```{r round-five}
waf +
geom_waffle(
n_rows = 10, size = 1, color = "white", make_proportional = TRUE,
radius = unit(4, "pt"),
height = 1, width = 1
) +
scale_fill_manual(
values = c("#f8766d", alpha("#00ba38", 1/3), alpha("#619cff", 1/3))
)
```
### Basic waffle bar chart
You can make a bar-like chart with the waffles by using facet wrapping and hacking on strip spacing:
```{r waffle-bar}
waf +
geom_waffle(
n_rows = 5, color = "white", show.legend = FALSE, flip = TRUE
) +
facet_wrap(~states) +
theme(panel.spacing.x = unit(0, "npc")) +
theme(strip.text.x = element_text(hjust = 0.5))
```
### Waffle buffet setup
Since you now know we can use faceting, we can go all sorts of crazy. We'll do another setup for this waffle buffet:
```{r waffle-buffet-setup}
xdf %>%
ggplot(aes(fill = states, values = vals)) +
expand_limits(x=c(0,0), y=c(0,0)) +
coord_equal() +
labs(fill = NULL, colour = NULL) +
theme_ipsum_rc(grid="") +
theme_enhance_waffle() -> buf
```
### Faceting using another variable
If you have parts-of-a-whole groups you want to compare across observations you can facet on another variable
```{r waffle-buffet}
buf +
geom_waffle(
color = "white", size = 0.33
) +
facet_wrap(~fct) +
theme(strip.text.x = element_text(hjust = 0.5))
```
Again, waffles generally work better when they are square and each one sums to 100 and this is even more true in a buffet grid of waffles:
```{r waffle-buffet-prop}
buf +
geom_waffle(
color = "white", size = 0.33,
make_proportional = TRUE, n_rows = 10
) +
facet_wrap(~fct) +
theme(legend.position = "bottom") +
theme(strip.text.x = element_text(hjust = 0.5))
```
They can be rounded tiles as well:
```{r waffle-buffet-round}
buf +
geom_waffle(
color = "white", size = 0.33,
make_proportional = TRUE, n_rows = 10,
radius = unit(2, "pt")
) +
facet_wrap(~fct) +
theme(legend.position = "bottom") +
theme(strip.text.x = element_text(hjust = 0.5))
```
And, you can do the highlight hack:
```{r waffle-buffet-high}
buf +
geom_waffle(
color = "white", size = 0.33,
make_proportional = TRUE, n_rows = 10,
radius = unit(2, "pt")
) +
facet_wrap(~fct) +
scale_fill_manual(
values = c("#f8766d", alpha("#00ba38", 1/3), alpha("#619cff", 1/3))
) +
theme(legend.position = "bottom") +
theme(strip.text.x = element_text(hjust = 0.5))
```
If you aren't going to use proportional waffle buffet charts consider altering the aesthetics to make them waffle bars instead:
```{r waffle-buffet-bars}
buf +
geom_waffle(
color = "white", size = 0.33, n_rows = 4, flip = TRUE
) +
facet_wrap(~fct) +
theme(legend.position = "bottom") +
theme(strip.text.x = element_text(hjust = 0.5))
```
### Over the top
```{r over-the-top}
storms %>%
filter(year >= 2010) %>%
count(year, status) -> storms_df
ggplot(storms_df, aes(fill = status, values = n)) +
geom_waffle(color = "white", size = .25, n_rows = 10, flip = TRUE) +
facet_wrap(~year, nrow = 1, strip.position = "bottom") +
scale_x_discrete() +
scale_y_continuous(labels = function(x) x * 10, # make this multiplyer the same as n_rows
expand = c(0,0)) +
ggthemes::scale_fill_tableau(name=NULL) +
coord_equal() +
labs(
title = "Faceted Waffle Bar Chart",
subtitle = "{dplyr} storms data",
x = "Year",
y = "Count"
) +
theme_minimal(base_family = "Roboto Condensed") +
theme(panel.grid = element_blank(), axis.ticks.y = element_line()) +
guides(fill = guide_legend(reverse = TRUE))
```
Loading…
Cancel
Save