boB Rudis
5 years ago
25 changed files with 941 additions and 22 deletions
@ -1,18 +1,22 @@ |
|||||
Package: ggeconodist |
Package: ggeconodist |
||||
Type: Package |
Type: Package |
||||
Title: ggeconodist title goes here otherwise CRAN checks fail |
Title: Create Diminutive Distribution Charts |
||||
Version: 0.1.0 |
Version: 0.1.0 |
||||
Date: 2019-07-14 |
Date: 2019-07-14 |
||||
Authors@R: c( person("Bob", "Rudis", email = "bob@rud.is", role = |
Authors@R: c( person("Bob", "Rudis", email = "bob@rud.is", role = |
||||
c("aut", "cre"), comment = c(ORCID = "0000-0001-5670-2640")) ) |
c("aut", "cre"), comment = c(ORCID = "0000-0001-5670-2640")) ) |
||||
Maintainer: Bob Rudis <bob@rud.is> |
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 |
URL: https://gitlab.com/hrbrmstr/ggeconodist |
||||
BugReports: https://gitlab.com/hrbrmstr/ggeconodist/issues |
BugReports: https://gitlab.com/hrbrmstr/ggeconodist/issues |
||||
Encoding: UTF-8 |
Encoding: UTF-8 |
||||
License: AGPL |
License: MIT + file LICENSE |
||||
Suggests: covr, tinytest |
Suggests: covr, tinytest, scales |
||||
Depends: R (>= 3.2.0) |
Depends: R (>= 3.2.0), ggplot2 (>= 3.2.0), grid |
||||
Imports: httr, jsonlite |
Imports: |
||||
|
gtable, |
||||
|
magrittr |
||||
Roxygen: list(markdown = TRUE) |
Roxygen: list(markdown = TRUE) |
||||
RoxygenNote: 6.1.1 |
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 |
# Generated by roxygen2: do not edit by hand |
||||
|
|
||||
import(httr) |
export("%>%") |
||||
importFrom(jsonlite,fromJSON) |
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 @@ |
|||||
#' ... |
#' Create Diminutive Distribution Charts |
||||
#' |
#' |
||||
#' - URL: <https://gitlab.com/hrbrmstr/ggeconodist> |
#' 'The Economist' has a unique boxplot aesthetic for |
||||
#' - BugReports: <https://gitlab.com/hrbrmstr/ggeconodist/issues> |
#' communicating distrribution characteristics. Tools are provided |
||||
#' |
#' to create similar charts in 'ggplot2'. |
||||
|
#' |
||||
#' @md |
#' @md |
||||
#' @name ggeconodist |
#' @name ggeconodist |
||||
#' @keywords internal |
#' @keywords internal |
||||
#' @author Bob Rudis (bob@@rud.is) |
#' @author Bob Rudis (bob@@rud.is) |
||||
#' @import httr |
#' @import ggplot2 grid gtable |
||||
#' @importFrom jsonlite fromJSON |
|
||||
"_PACKAGE" |
"_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