boB Rudis
5 years ago
25 changed files with 941 additions and 22 deletions
@ -1,18 +1,22 @@ |
|||
Package: ggeconodist |
|||
Type: Package |
|||
Title: ggeconodist title goes here otherwise CRAN checks fail |
|||
Title: Create Diminutive Distribution Charts |
|||
Version: 0.1.0 |
|||
Date: 2019-07-14 |
|||
Authors@R: c( person("Bob", "Rudis", email = "bob@rud.is", role = |
|||
c("aut", "cre"), comment = c(ORCID = "0000-0001-5670-2640")) ) |
|||
Maintainer: Bob Rudis <bob@rud.is> |
|||
Description: A good description goes here otherwise CRAN checks fail. |
|||
Description: 'The Economist' has a unique boxplot aesthetic for |
|||
communicating distrribution characteristics. Tools are provided |
|||
to create similar charts in 'ggplot2'. |
|||
URL: https://gitlab.com/hrbrmstr/ggeconodist |
|||
BugReports: https://gitlab.com/hrbrmstr/ggeconodist/issues |
|||
Encoding: UTF-8 |
|||
License: AGPL |
|||
Suggests: covr, tinytest |
|||
Depends: R (>= 3.2.0) |
|||
Imports: httr, jsonlite |
|||
License: MIT + file LICENSE |
|||
Suggests: covr, tinytest, scales |
|||
Depends: R (>= 3.2.0), ggplot2 (>= 3.2.0), grid |
|||
Imports: |
|||
gtable, |
|||
magrittr |
|||
Roxygen: list(markdown = TRUE) |
|||
RoxygenNote: 6.1.1 |
|||
|
@ -0,0 +1,2 @@ |
|||
YEAR: 2019 |
|||
COPYRIGHT HOLDER: Bob Rudis |
@ -0,0 +1,21 @@ |
|||
# MIT License |
|||
|
|||
Copyright (c) 2019 Bob Rudis |
|||
|
|||
Permission is hereby granted, free of charge, to any person obtaining a copy |
|||
of this software and associated documentation files (the "Software"), to deal |
|||
in the Software without restriction, including without limitation the rights |
|||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
|||
copies of the Software, and to permit persons to whom the Software is |
|||
furnished to do so, subject to the following conditions: |
|||
|
|||
The above copyright notice and this permission notice shall be included in all |
|||
copies or substantial portions of the Software. |
|||
|
|||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
|||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
|||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
|||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
|||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
|||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
|||
SOFTWARE. |
@ -1,4 +1,16 @@ |
|||
# Generated by roxygen2: do not edit by hand |
|||
|
|||
import(httr) |
|||
importFrom(jsonlite,fromJSON) |
|||
export("%>%") |
|||
export(GeomEconodist) |
|||
export(StatEconodist) |
|||
export(add_econodist_legend) |
|||
export(econodist_legend_grob) |
|||
export(geom_econodist) |
|||
export(left_align) |
|||
export(mammogram_costs) |
|||
export(stat_econodist) |
|||
export(theme_econodist) |
|||
import(ggplot2) |
|||
import(grid) |
|||
import(gtable) |
|||
importFrom(magrittr,"%>%") |
|||
|
@ -0,0 +1,181 @@ |
|||
#' Econodist geom / stat |
|||
#' |
|||
#' Like [ggplot2::geom_boxplot()] you can either pass in pre-computed |
|||
#' values for "ymin", "median", and "ymax" or a single y column |
|||
#' which will then use [stat_econodist()] to compute the needed |
|||
#' statistics. |
|||
#' |
|||
#' @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 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 stat ggplot2 stat to use |
|||
#' @param geom ggplot2 geom to use |
|||
#' @param position Position adjustment, either as a string, or the result of a call to a position adjustment function. |
|||
#' @param tenth_col,median_col,ninetieth_col,median_point_size colors for geom components |
|||
#' @param endcap_adjust multipler to make endcaps wider/thinner |
|||
#' @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 |
|||
#' ggplot(mammogram_costs, aes(x = city)) + |
|||
#' geom_econodist( |
|||
#' aes(ymin = tenth, median = median, ymax = ninetieth), |
|||
#' stat = "identity", |
|||
#' ) + |
|||
#' scale_y_comma(expand = c(0,0), position = "right", limits = range(0, 800)) + |
|||
#' coord_flip() + |
|||
#' labs( |
|||
#' x = NULL, y = NULL |
|||
#' ) |
|||
geom_econodist <- function(mapping = NULL, data = NULL, |
|||
stat = "econodist", position = "dodge2", |
|||
tenth_col = econ_tenth, |
|||
median_col = econ_median, |
|||
ninetieth_col = econ_ninetieth, |
|||
median_point_size = NULL, |
|||
endcap_adjust = 1.5, |
|||
..., |
|||
na.rm = FALSE, |
|||
show.legend = NA, |
|||
inherit.aes = TRUE) { |
|||
|
|||
layer( |
|||
data = data, |
|||
mapping = mapping, |
|||
stat = stat, |
|||
geom = GeomEconodist, |
|||
position = position, |
|||
show.legend = show.legend, |
|||
inherit.aes = inherit.aes, |
|||
params = list( |
|||
na.rm = na.rm, |
|||
tenth_col = tenth_col, |
|||
median_col = median_col, |
|||
ninetieth_col = ninetieth_col, |
|||
median_point_size = median_point_size, |
|||
endcap_adjust = endcap_adjust, |
|||
... |
|||
) |
|||
) |
|||
} |
|||
|
|||
#' @rdname geom_econodist |
|||
#' @export |
|||
GeomEconodist <- ggproto( |
|||
`_class` = "GeomEconodist", |
|||
`_inherit` = Geom, |
|||
|
|||
extra_params = c("na.rm", "width", |
|||
"tenth_col", "median_col", "ninetieth_col", |
|||
"median_point_size", "endcap_adjust"), |
|||
|
|||
default_aes = aes( |
|||
colour = NA, fill = econ_main, size = 1, weight = 1, |
|||
alpha = 0.2, shape = 19, linetype = "solid", stroke = 1 |
|||
), |
|||
|
|||
required_aes = c("x", "ymin", "median", "ymax"), |
|||
|
|||
setup_data = function(data, params) { |
|||
|
|||
data$width <- data$width %||% |
|||
params$width %||% (ggplot2::resolution(data$x, FALSE) * 0.6) |
|||
|
|||
data$xmin <- data$x - data$width / 2 |
|||
data$xmax <- data$x + data$width / 2 |
|||
|
|||
data |
|||
|
|||
}, |
|||
|
|||
draw_group = function(data, panel_params, coord, |
|||
tenth_col = econ_tenth, |
|||
median_col = econ_median, |
|||
ninetieth_col = econ_ninetieth, |
|||
median_point_size = NULL, |
|||
endcap_adjust = 1.5) { |
|||
|
|||
if (nrow(data) != 1) { |
|||
stop( |
|||
"It looks like you may have forgotten a grouping aesthetic, i.e. aes(group = ...)", |
|||
call. = FALSE |
|||
) |
|||
} |
|||
|
|||
transform( |
|||
data, |
|||
y = median, |
|||
fill = alpha(fill, alpha) |
|||
) -> d_range |
|||
|
|||
transform( |
|||
data, |
|||
y = median, |
|||
alpha = 1, |
|||
colour = median_col, |
|||
size = median_point_size %||% (width * 3), |
|||
fill = alpha(fill, alpha), |
|||
shape = "circle" |
|||
) -> d_median |
|||
|
|||
transform( |
|||
data, |
|||
x = xmin, |
|||
xend = xmax, |
|||
y = ymin, |
|||
yend = ymin, |
|||
size = size * (endcap_adjust %||% 1.5), |
|||
alpha = NA, |
|||
colour = tenth_col |
|||
) -> d_tenth |
|||
|
|||
transform( |
|||
data, |
|||
x = xmin, |
|||
xend = xmax, |
|||
y = ymax, |
|||
yend = ymax, |
|||
size = size * (endcap_adjust %||% 1.5), |
|||
alpha = NA, |
|||
colour = ninetieth_col |
|||
) -> d_ninetieth |
|||
|
|||
ggname("geom_econodist", grobTree( |
|||
GeomRect$draw_panel(d_range, panel_params, coord), |
|||
GeomSegment$draw_panel(d_tenth, panel_params, coord), |
|||
GeomSegment$draw_panel(d_ninetieth, panel_params, coord), |
|||
GeomPoint$draw_panel(d_median, panel_params, coord) |
|||
)) |
|||
|
|||
}, |
|||
|
|||
draw_key = ggplot2::draw_key_boxplot |
|||
|
|||
) |
@ -1,12 +1,12 @@ |
|||
#' ... |
|||
#' |
|||
#' - URL: <https://gitlab.com/hrbrmstr/ggeconodist> |
|||
#' - BugReports: <https://gitlab.com/hrbrmstr/ggeconodist/issues> |
|||
#' |
|||
#' Create Diminutive Distribution Charts |
|||
#' |
|||
#' 'The Economist' has a unique boxplot aesthetic for |
|||
#' communicating distrribution characteristics. Tools are provided |
|||
#' to create similar charts in 'ggplot2'. |
|||
#' |
|||
#' @md |
|||
#' @name ggeconodist |
|||
#' @keywords internal |
|||
#' @author Bob Rudis (bob@@rud.is) |
|||
#' @import httr |
|||
#' @importFrom jsonlite fromJSON |
|||
#' @import ggplot2 grid gtable |
|||
"_PACKAGE" |
|||
|
@ -0,0 +1,28 @@ |
|||
econ_tenth <- "#39c0d1" |
|||
econ_ninetieth <- "#14709f" |
|||
econ_plot_bg_col <- "#d7e6ee" |
|||
econ_median <- "#6b7a83" |
|||
econ_main <- "#6794a7" |
|||
econ_text_col <- "#3b454a" |
|||
econ_grid_col <- "#63696d" |
|||
|
|||
|
|||
#' Cost of a mammogram in various U.S. Citites (2016, USD) |
|||
#' |
|||
#' @docType data |
|||
#' @export |
|||
mammogram_costs <- |
|||
structure(list(city = structure(1:11, .Label = c("Houston, TX", |
|||
"Los Angeles, CA", "Dallas, TX", "Chicago, IL", "Atlanta, GA", |
|||
"Seattle, WA", "Philadelphia, PA", "New York, NY", "Boston, MA", |
|||
"Baltimore, MD", "Denver, CO"), class = "factor"), median = c(133.325464181588, |
|||
169.66205927832, 182.665045621407, 195.658588982401, 218.661693362764, |
|||
228.321864044665, 257.991713783213, 264.327954768116, 277, 277.000436737922, |
|||
300.003541118285), ninetieth = c(300.003541118285, 753.00227811943, |
|||
225.998890449604, 325.669566449085, 468.674087276762, 294.989317626506, |
|||
541.337834488131, 490.997296946376, 394.008427861519, 557.013184763748, |
|||
393.337976132863), tenth = c(60.000708223657, 116.328096412847, |
|||
102.654658341104, 115.657644684191, 128.670074009372, 104.996517900353, |
|||
141.333112997084, 164.336217377448, 197.339439795087, 197.008935421806, |
|||
153.335143238235), state = c("TX", "CA", "TX", "IL", "GA", "WA", |
|||
"PA", "NY", "MA", "MD", "CO")), class = "data.frame", row.names = c(NA, -11L)) |
@ -0,0 +1,150 @@ |
|||
#' Helper to flush ggplot2 plot components to the left |
|||
#' |
|||
#' Stolen from the BBC (don't tell Scotland Yard) |
|||
#' |
|||
#' @param gg ggplot2 plot |
|||
#' @param components ggplot2 named gtable components to operate on |
|||
#' @family Econodist legend helpers |
|||
#' @export |
|||
left_align <- function(gg, components){ |
|||
grob <- ggplot2::ggplotGrob(gg) |
|||
n <- length(components) |
|||
grob$layout$l[grob$layout$name %in% components] <- 2 |
|||
grob |
|||
} |
|||
|
|||
#' Create a legend grob that can be used with econodist charts |
|||
#' |
|||
#' @param family font family |
|||
#' @param label_size size of legend text |
|||
#' @param tenth_col color for the tenth bar |
|||
#' @param med_col color for the median point |
|||
#' @param ninetieth_col color for the ninetieth bar |
|||
#' @param label_col color of the legend text |
|||
#' @family Econodist legend helpers |
|||
#' @export |
|||
econodist_legend_grob <- function(family = "EconSansCndLig", |
|||
label_size = 10, |
|||
tenth_col = econ_tenth, |
|||
med_col = econ_median, |
|||
ninetieth_col = econ_ninetieth, |
|||
label_col = econ_text_col) { |
|||
|
|||
x_pos <- unit(4, "points") |
|||
y_pos <- unit(label_size / 2, "points") |
|||
yq <- unit(label_size / 4, "points") |
|||
|
|||
segmentsGrob( |
|||
x0 = x_pos, y0 = y_pos + yq, |
|||
x1 = x_pos, y1 = y_pos - yq, |
|||
default.units = "points", |
|||
gp = gpar( |
|||
lwd = 3 * ggplot2::.pt, |
|||
lty = "solid", |
|||
lineend = "square", |
|||
col = tenth_col |
|||
) |
|||
) -> tenth_seg |
|||
|
|||
x_pos <- x_pos + convertUnit(grobWidth(tenth_seg), "points") + unit(6, "points") |
|||
|
|||
textGrob( |
|||
label = "10th percentile", |
|||
x = x_pos, y = y_pos, |
|||
hjust = 0, vjust = 0.5, |
|||
gp = gpar( |
|||
fontfamily = family, |
|||
fontsize = label_size, |
|||
col = label_col |
|||
) |
|||
) -> tenth_text |
|||
|
|||
x_pos <- x_pos + convertUnit(grobWidth(tenth_text), "points") + unit(label_size, "points") |
|||
|
|||
pointsGrob( |
|||
x = x_pos, y = y_pos, |
|||
size = unit(label_size, "points"), pch = 19, |
|||
gp = gpar( |
|||
col = med_col, |
|||
fill = med_col |
|||
) |
|||
) -> med_pt |
|||
|
|||
x_pos <- x_pos + convertUnit(grobWidth(med_pt), "points") + unit(8, "points") |
|||
|
|||
textGrob( |
|||
label = "Median", |
|||
x = x_pos, y = y_pos, |
|||
hjust = 0, vjust = 0.5, |
|||
gp = gpar( |
|||
fontfamily = family, |
|||
fontsize = label_size, |
|||
col = label_col |
|||
) |
|||
) -> med_text |
|||
|
|||
x_pos <- x_pos + convertUnit(grobWidth(med_text), "points") + unit(label_size, "points") |
|||
|
|||
segmentsGrob( |
|||
x0 = x_pos, y0 = y_pos - yq, |
|||
x1 = x_pos, y1 = y_pos + yq, |
|||
gp = gpar( |
|||
lwd = 3 * ggplot2::.pt, |
|||
lty = "solid", |
|||
lineend = "square", |
|||
col = ninetieth_col |
|||
) |
|||
) -> ninth_seg |
|||
|
|||
x_pos <- x_pos + grobWidth(ninth_seg) + unit(8, "points") |
|||
|
|||
textGrob( |
|||
label = "90th percentile", |
|||
x = x_pos, y = y_pos, |
|||
hjust = 0, vjust = 0.5, |
|||
gp = gpar( |
|||
fontfamily = family, |
|||
fontsize = label_size, |
|||
col = label_col |
|||
) |
|||
) -> ninth_text |
|||
|
|||
vp <- viewport(default.units = "points") |
|||
|
|||
gTree( |
|||
name = "econodist_legend", |
|||
children = gList( |
|||
tenth_seg, tenth_text, |
|||
med_pt, med_text, |
|||
ninth_seg, ninth_text |
|||
), |
|||
childrenvp = vp |
|||
) |
|||
|
|||
} |
|||
|
|||
#' Helper utility to get an econodist legend into a ggplot2 plot |
|||
#' |
|||
#' @param gg ggplot2 plot object to add |
|||
#' @param legend legend grob (any grob, really) |
|||
#' @param below which named gtable element to stick it below? |
|||
#' @param legend_height height of the legend row |
|||
#' @param spacer height of the spacer that is put below `legend`? |
|||
#' @family Econodist legend helpers |
|||
#' @export |
|||
add_econodist_legend <- function(gg, legend, below = "subtitle", |
|||
legend_height = unit(16, "points"), |
|||
spacer = unit(10, "points")) { |
|||
|
|||
if (!inherits(gg, "gtable")) gg <- ggplot2::ggplotGrob(gg) |
|||
|
|||
st <- gg$layout[gg$layout$name == below,] |
|||
gtable::gtable_add_rows( |
|||
gtable::gtable_add_grob( |
|||
gtable::gtable_add_rows(gg, legend_height, st$b), |
|||
legend, t = st$b + 1, l = st$l, b = st$b + 1, r = st$r |
|||
), |
|||
spacer, st$b + 1 |
|||
) |
|||
|
|||
} |
@ -0,0 +1,74 @@ |
|||
#' @rdname geom_econodist |
|||
#' @export |
|||
stat_econodist <- function(mapping = NULL, data = NULL, |
|||
geom = "econodist", position = "dodge2", |
|||
..., |
|||
na.rm = FALSE, |
|||
show.legend = NA, |
|||
inherit.aes = TRUE) { |
|||
layer( |
|||
data = data, |
|||
mapping = mapping, |
|||
stat = StatEconodist, |
|||
geom = geom, |
|||
position = position, |
|||
show.legend = show.legend, |
|||
inherit.aes = inherit.aes, |
|||
params = list( |
|||
na.rm = na.rm, |
|||
... |
|||
) |
|||
) |
|||
} |
|||
|
|||
#' @rdname geom_econodist |
|||
#' @export |
|||
StatEconodist <- ggproto( |
|||
`_class` = "StatEconodist", |
|||
`_inherit` = Stat, |
|||
|
|||
required_aes = c("y"), |
|||
|
|||
setup_data = function(data, params) { |
|||
|
|||
data$x <- data$x %||% 0 |
|||
|
|||
ggplot2::remove_missing( |
|||
data, |
|||
na.rm = FALSE, |
|||
vars = "x", |
|||
name = "stat_econodist" |
|||
) |
|||
|
|||
}, |
|||
|
|||
setup_params = function(data, params) { |
|||
|
|||
params$width <- params$width %||% (resolution(data$x %||% 0) * 0.75) |
|||
|
|||
if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { |
|||
warning("Continuous x aesthetic -- did you forget aes(group=...)?", call. = FALSE) |
|||
} |
|||
|
|||
params |
|||
|
|||
}, |
|||
|
|||
compute_group = function(data, scales, width = NULL, na.rm = FALSE) { |
|||
|
|||
qs <- c(0.10, 0.5, 0.90) |
|||
|
|||
stats <- as.numeric(stats::quantile(data$y, qs)) |
|||
names(stats) <- c("tenth", "median", "ninetieth") |
|||
|
|||
if (length(unique(data$x)) > 1) width <- diff(range(data$x)) * 0.9 |
|||
|
|||
xdf <- new_data_frame(as.list(stats)) |
|||
xdf$x <- if (is.factor(data$x)) data$x[1] else mean(range(data$x)) |
|||
xdf$width <- width |
|||
|
|||
xdf |
|||
|
|||
} |
|||
|
|||
) |
@ -0,0 +1,40 @@ |
|||
#' A more current Economist-style ggplot2 theme |
|||
#' |
|||
#' @param econ_text_col color for text elements |
|||
#' @param econ_plot_bg_col plot background color |
|||
#' @param econ_grid_col plot grid color |
|||
#' @param econ_font core plot font |
|||
#' @param light_font light font used in various polaces |
|||
#' @param bold_font bold font used in various places |
|||
#' @note You *need* their fonts installed. You can get them from |
|||
#' [here](https://github.com/economist-components/component-typography) |
|||
#' @export |
|||
theme_econodist <- function(econ_text_col = "#3b454a", |
|||
econ_plot_bg_col = "#d7e6ee", |
|||
econ_grid_col = "#bbcad2", |
|||
econ_font = "EconSansCndReg", |
|||
light_font = "EconSansCndLig", |
|||
bold_font = "EconSansCndBol") { |
|||
|
|||
theme_minimal(base_family = econ_font) + |
|||
theme( |
|||
plot.title = element_text(family = bold_font), |
|||
plot.subtitle = element_text(family = light_font, 12), |
|||
plot.caption = element_text(family = light_font, 10, colour = econ_text_col, lineheight = 1.1), |
|||
plot.background = element_rect(fill = econ_plot_bg_col, colour = econ_plot_bg_col), |
|||
panel.background = element_rect(fill = econ_plot_bg_col, colour = econ_plot_bg_col), |
|||
axis.ticks = element_blank(), |
|||
axis.ticks.x = element_blank(), |
|||
axis.ticks.y = element_blank(), |
|||
axis.text = element_text(family = light_font, colour = econ_text_col), |
|||
axis.text.x = element_text(family = light_font, size = 10, colour = econ_text_col), |
|||
axis.text.y = element_text(hjust = 0, family = light_font, size = 10, colour = econ_text_col), |
|||
axis.line.x = element_blank(), |
|||
axis.line.y = element_line(colour = econ_grid_col, size = 0.5), |
|||
plot.margin = margin(10, 15, 10, 12), |
|||
panel.grid.major.x = element_line(linetype = "solid", size = 0.4, colour = econ_grid_col), |
|||
panel.grid.major.y = element_line(linetype = "solid", size = 0.4, colour = econ_grid_col), |
|||
panel.grid.minor.x = element_blank(), |
|||
panel.grid.minor.y = element_blank() |
|||
) |
|||
} |
@ -0,0 +1,4 @@ |
|||
`%l0%` <- function(x, y) if (length(x) == 0) y else x |
|||
`%||%` <- function(x, y) if (is.null(x)) y else x |
|||
`%@%` <- function(x, name) attr(x, name, exact = TRUE) |
|||
`%nin%` <- function(x, table) match(x, table, nomatch = 0) == 0 |
@ -0,0 +1,11 @@ |
|||
#' Pipe operator |
|||
#' |
|||
#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. |
|||
#' |
|||
#' @name %>% |
|||
#' @rdname pipe |
|||
#' @keywords internal |
|||
#' @export |
|||
#' @importFrom magrittr %>% |
|||
#' @usage lhs \%>\% rhs |
|||
NULL |
@ -0,0 +1,26 @@ |
|||
|
|||
ggname <- function(prefix, grob) { |
|||
grob$name <- grobName(grob, prefix) |
|||
grob |
|||
} |
|||
|
|||
new_data_frame <- function(x = list(), n = NULL) { |
|||
if (length(x) != 0 && is.null(names(x))) stop("Elements must be named", call. = FALSE) |
|||
lengths <- vapply(x, length, integer(1)) |
|||
if (is.null(n)) { |
|||
n <- if (length(x) == 0 || min(lengths) == 0) 0 else max(lengths) |
|||
} |
|||
for (i in seq_along(x)) { |
|||
if (lengths[i] == n) next |
|||
if (lengths[i] != 1) stop("Elements must equal the number of rows or 1", call. = FALSE) |
|||
x[[i]] <- rep(x[[i]], n) |
|||
} |
|||
|
|||
class(x) <- "data.frame" |
|||
attr(x, "row.names") <- .set_row_names(n) |
|||
x |
|||
} |
|||
|
|||
data_frame <- function(...) { |
|||
new_data_frame(list(...)) |
|||
} |
@ -0,0 +1,98 @@ |
|||
|
|||
[![Travis-CI Build |
|||
Status](https://travis-ci.org/hrbrmstr/ggeconodist.svg?branch=master)](https://travis-ci.org/hrbrmstr/ggeconodist) |
|||
[![Coverage |
|||
Status](https://codecov.io/gh/hrbrmstr/ggeconodist/branch/master/graph/badge.svg)](https://codecov.io/gh/hrbrmstr/ggeconodist) |
|||
[![CRAN\_Status\_Badge](https://www.r-pkg.org/badges/version/ggeconodist)](https://cran.r-project.org/package=ggeconodist) |
|||
|
|||
# ggeconodist |
|||
|
|||
Create Diminutive Distribution Charts |
|||
|
|||
## Description |
|||
|
|||
‘The Economist’ has a unique boxplot aesthetic for communicating |
|||
distrribution characteristics. Tools are provided to create similar |
|||
charts in ‘ggplot2’. |
|||
|
|||
Inspired by: |
|||
<https://www.economist.com/united-states/2019/06/29/will-transparent-pricing-make-americas-health-care-cheaper> |
|||
|
|||
## What’s Inside The Tin |
|||
|
|||
- `add_econodist_legend`: Helper utility to get an econodist legend |
|||
into a ggplot2 plot |
|||
- `econodist_legend_grob`: Create a legend grob that can be used with |
|||
econodist charts |
|||
- `geom_econodist`: Econodist geom / stat |
|||
- `left_align`: Helper to flush ggplot2 plot components to the left |
|||
- `mammogram_costs`: Cost of a mammogram in various U.S. Citites |
|||
(2016, USD) |
|||
- `theme_econodist`: A more current Economist-style ggplot2 theme |
|||
|
|||
The following functions are implemented: |
|||
|
|||
## Installation |
|||
|
|||
``` r |
|||
devtools::install_git("https://git.rud.is/hrbrmstr/ggeconodist.git") |
|||
# or |
|||
devtools::install_git("https://git.sr.ht/~hrbrmstr/ggeconodist") |
|||
# or |
|||
devtools::install_gitlab("hrbrmstr/ggeconodist") |
|||
# or |
|||
devtools::install_bitbucket("hrbrmstr/ggeconodist") |
|||
``` |
|||
|
|||
## Usage |
|||
|
|||
``` r |
|||
library(ggeconodist) |
|||
|
|||
# current version |
|||
packageVersion("ggeconodist") |
|||
## [1] '0.1.0' |
|||
``` |
|||
|
|||
### The whole shebang |
|||
|
|||
**YOU WILL NEED** to install [these |
|||
fonts](https://github.com/economist-components/component-typography) to |
|||
use the built-in theme. More on how to do that at some point. |
|||
|
|||
``` r |
|||
ggplot(mammogram_costs, aes(x = city)) + |
|||
geom_econodist( |
|||
aes(ymin = tenth, median = median, ymax = ninetieth), |
|||
stat = "identity", show.legend = TRUE |
|||
) + |
|||
scale_y_continuous(expand = c(0,0), position = "right", limits = range(0, 800)) + |
|||
coord_flip() + |
|||
labs( |
|||
x = NULL, y = NULL, |
|||
title = "Mammoscams", |
|||
subtitle = "United States, prices for a mammogram*\nBy metro area, 2016, $", |
|||
caption = "*For three large insurance companies\nSource: Health Care Cost Institute" |
|||
) + |
|||
theme_econodist() -> gg |
|||
|
|||
grid.newpage() |
|||
left_align(gg, c("subtitle", "title", "caption")) %>% |
|||
add_econodist_legend(econodist_legend_grob(), below = "subtitle") %>% |
|||
grid.draw() |
|||
``` |
|||
|
|||
<img src="README_files/figure-gfm/unnamed-chunk-1-1.png" width="672" /> |
|||
|
|||
## ggeconodist Metrics |
|||
|
|||
| Lang | \# Files | (%) | LoC | (%) | Blank lines | (%) | \# Lines | (%) | |
|||
| :--- | -------: | ---: | --: | ---: | ----------: | ---: | -------: | ---: | |
|||
| R | 10 | 0.91 | 338 | 0.93 | 68 | 0.75 | 125 | 0.77 | |
|||
| Rmd | 1 | 0.09 | 27 | 0.07 | 23 | 0.25 | 38 | 0.23 | |
|||
|
|||
## Code of Conduct |
|||
|
|||
Please note that this project is released with a [Contributor Code of |
|||
Conduct](CONDUCT.md). By participating in this project you agree to |
|||
abide by its terms. |
After Width: | Height: | Size: 110 KiB |
@ -0,0 +1,28 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/legend-helpers.R |
|||
\name{add_econodist_legend} |
|||
\alias{add_econodist_legend} |
|||
\title{Helper utility to get an econodist legend into a ggplot2 plot} |
|||
\usage{ |
|||
add_econodist_legend(gg, legend, below = "subtitle", |
|||
legend_height = unit(16, "points"), spacer = unit(10, "points")) |
|||
} |
|||
\arguments{ |
|||
\item{gg}{ggplot2 plot object to add} |
|||
|
|||
\item{legend}{legend grob (any grob, really)} |
|||
|
|||
\item{below}{which named gtable element to stick it below?} |
|||
|
|||
\item{legend_height}{height of the legend row} |
|||
|
|||
\item{spacer}{height of the spacer that is put below \code{legend}?} |
|||
} |
|||
\description{ |
|||
Helper utility to get an econodist legend into a ggplot2 plot |
|||
} |
|||
\seealso{ |
|||
Other Econodist legend helpers: \code{\link{econodist_legend_grob}}, |
|||
\code{\link{left_align}} |
|||
} |
|||
\concept{Econodist legend helpers} |
@ -0,0 +1,31 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/legend-helpers.R |
|||
\name{econodist_legend_grob} |
|||
\alias{econodist_legend_grob} |
|||
\title{Create a legend grob that can be used with econodist charts} |
|||
\usage{ |
|||
econodist_legend_grob(family = "EconSansCndLig", label_size = 10, |
|||
tenth_col = econ_tenth, med_col = econ_median, |
|||
ninetieth_col = econ_ninetieth, label_col = econ_text_col) |
|||
} |
|||
\arguments{ |
|||
\item{family}{font family} |
|||
|
|||
\item{label_size}{size of legend text} |
|||
|
|||
\item{tenth_col}{color for the tenth bar} |
|||
|
|||
\item{med_col}{color for the median point} |
|||
|
|||
\item{ninetieth_col}{color for the ninetieth bar} |
|||
|
|||
\item{label_col}{color of the legend text} |
|||
} |
|||
\description{ |
|||
Create a legend grob that can be used with econodist charts |
|||
} |
|||
\seealso{ |
|||
Other Econodist legend helpers: \code{\link{add_econodist_legend}}, |
|||
\code{\link{left_align}} |
|||
} |
|||
\concept{Econodist legend helpers} |
@ -0,0 +1,93 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/geom-econodist.R, R/stat-econodist.R |
|||
\docType{data} |
|||
\name{geom_econodist} |
|||
\alias{geom_econodist} |
|||
\alias{GeomEconodist} |
|||
\alias{stat_econodist} |
|||
\alias{StatEconodist} |
|||
\title{Econodist geom / stat} |
|||
\format{An object of class \code{GeomEconodist} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 7.} |
|||
\usage{ |
|||
geom_econodist(mapping = NULL, data = NULL, stat = "econodist", |
|||
position = "dodge2", tenth_col = econ_tenth, |
|||
median_col = econ_median, ninetieth_col = econ_ninetieth, |
|||
median_point_size = NULL, endcap_adjust = 1.5, ..., na.rm = FALSE, |
|||
show.legend = NA, inherit.aes = TRUE) |
|||
|
|||
GeomEconodist |
|||
|
|||
stat_econodist(mapping = NULL, data = NULL, geom = "econodist", |
|||
position = "dodge2", ..., na.rm = FALSE, show.legend = NA, |
|||
inherit.aes = TRUE) |
|||
|
|||
StatEconodist |
|||
} |
|||
\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{stat}{ggplot2 stat to use} |
|||
|
|||
\item{position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} |
|||
|
|||
\item{tenth_col, median_col, ninetieth_col, median_point_size}{colors for geom components} |
|||
|
|||
\item{endcap_adjust}{multipler to make endcaps wider/thinner} |
|||
|
|||
\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.} |
|||
|
|||
\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{geom}{ggplot2 geom to use} |
|||
} |
|||
\description{ |
|||
Like \code{\link[ggplot2:geom_boxplot]{ggplot2::geom_boxplot()}} you can either pass in pre-computed |
|||
values for "ymin", "median", and "ymax" or a single y column |
|||
which will then use \code{\link[=stat_econodist]{stat_econodist()}} to compute the needed |
|||
statistics. |
|||
} |
|||
\examples{ |
|||
ggplot(mammogram_costs, aes(x = city)) + |
|||
geom_econodist( |
|||
aes(ymin = tenth, median = median, ymax = ninetieth), |
|||
stat = "identity", |
|||
) + |
|||
scale_y_comma(expand = c(0,0), position = "right", limits = range(0, 800)) + |
|||
coord_flip() + |
|||
labs( |
|||
x = NULL, y = NULL |
|||
) |
|||
} |
|||
\keyword{datasets} |
@ -0,0 +1,21 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/legend-helpers.R |
|||
\name{left_align} |
|||
\alias{left_align} |
|||
\title{Helper to flush ggplot2 plot components to the left} |
|||
\usage{ |
|||
left_align(gg, components) |
|||
} |
|||
\arguments{ |
|||
\item{gg}{ggplot2 plot} |
|||
|
|||
\item{components}{ggplot2 named gtable components to operate on} |
|||
} |
|||
\description{ |
|||
Stolen from the BBC (don't tell Scotland Yard) |
|||
} |
|||
\seealso{ |
|||
Other Econodist legend helpers: \code{\link{add_econodist_legend}}, |
|||
\code{\link{econodist_legend_grob}} |
|||
} |
|||
\concept{Econodist legend helpers} |
@ -0,0 +1,14 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/globals.R |
|||
\docType{data} |
|||
\name{mammogram_costs} |
|||
\alias{mammogram_costs} |
|||
\title{Cost of a mammogram in various U.S. Citites (2016, USD)} |
|||
\format{An object of class \code{data.frame} with 11 rows and 5 columns.} |
|||
\usage{ |
|||
mammogram_costs |
|||
} |
|||
\description{ |
|||
Cost of a mammogram in various U.S. Citites (2016, USD) |
|||
} |
|||
\keyword{datasets} |
@ -0,0 +1,12 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/utils-pipe.R |
|||
\name{\%>\%} |
|||
\alias{\%>\%} |
|||
\title{Pipe operator} |
|||
\usage{ |
|||
lhs \%>\% rhs |
|||
} |
|||
\description{ |
|||
See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. |
|||
} |
|||
\keyword{internal} |
@ -0,0 +1,31 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/theme-econ.R |
|||
\name{theme_econodist} |
|||
\alias{theme_econodist} |
|||
\title{A more current Economist-style ggplot2 theme} |
|||
\usage{ |
|||
theme_econodist(econ_text_col = "#3b454a", |
|||
econ_plot_bg_col = "#d7e6ee", econ_grid_col = "#bbcad2", |
|||
econ_font = "EconSansCndReg", light_font = "EconSansCndLig", |
|||
bold_font = "EconSansCndBol") |
|||
} |
|||
\arguments{ |
|||
\item{econ_text_col}{color for text elements} |
|||
|
|||
\item{econ_plot_bg_col}{plot background color} |
|||
|
|||
\item{econ_grid_col}{plot grid color} |
|||
|
|||
\item{econ_font}{core plot font} |
|||
|
|||
\item{light_font}{light font used in various polaces} |
|||
|
|||
\item{bold_font}{bold font used in various places} |
|||
} |
|||
\description{ |
|||
A more current Economist-style ggplot2 theme |
|||
} |
|||
\note{ |
|||
You \emph{need} their fonts installed. You can get them from |
|||
\href{https://github.com/economist-components/component-typography}{here} |
|||
} |
Loading…
Reference in new issue