From f098516c60dcd2463636a4f9ab3f418764aa189c Mon Sep 17 00:00:00 2001 From: boB Rudis Date: Mon, 11 Apr 2016 11:14:25 -0400 Subject: [PATCH] geom_dumbbell --- DESCRIPTION | 1 + NAMESPACE | 2 + R/geom_dumbbell.R | 101 +++++++ README.Rmd | 41 +++ README.html | 573 ++++++++++++++++++++++++++++++++---- README.md | 532 +++++++++++++++++++++++++++++++-- README_figs/README-coord_proj-1.png | Bin 186677 -> 187805 bytes README_figs/README-dumbbell-1.png | Bin 0 -> 124110 bytes README_figs/README-stateface-1.png | Bin 114814 -> 38907 bytes Rplot.png | Bin 0 -> 74648 bytes man/geom_dumbbell.Rd | 80 +++++ man/ggalt-ggproto.Rd | 3 +- 12 files changed, 1251 insertions(+), 82 deletions(-) create mode 100644 R/geom_dumbbell.R create mode 100644 README_figs/README-dumbbell-1.png create mode 100644 Rplot.png create mode 100644 man/geom_dumbbell.Rd diff --git a/DESCRIPTION b/DESCRIPTION index a405b3a..7579be2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -62,6 +62,7 @@ Collate: 'ggalt-package.r' 'grob_absolute.r' 'geom_lollipop.r' + 'geom_dumbbell.R' 'guide_axis.r' 'pokemon.r' 'stateface.r' diff --git a/NAMESPACE b/NAMESPACE index 372c84c..acd7326 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ export(CoordProj) export(Gb) export(GeomBkde) export(GeomBkde2d) +export(GeomDumbbell) export(GeomEncircle) export(GeomLollipop) export(GeomStateface) @@ -26,6 +27,7 @@ export(bytes) export(coord_proj) export(geom_bkde) export(geom_bkde2d) +export(geom_dumbbell) export(geom_encircle) export(geom_lollipop) export(geom_stateface) diff --git a/R/geom_dumbbell.R b/R/geom_dumbbell.R new file mode 100644 index 0000000..de4fb3b --- /dev/null +++ b/R/geom_dumbbell.R @@ -0,0 +1,101 @@ +#' Dumbell charts +#' +#' The dumbbell geom is used to create dumbbell charts. +#' +#' Dumbbell dot plots — dot plots with two or more series of data — are an +#' alternative to the clustered bar chart or slope graph.\cr +#' \cr +#' Use these dot plots to visualize two or three different points in time. Or, +#' use them to triangulate different viewpoints (e.g., one dot for Republicans +#' and another dot for Democrats, or one dot for principals and another dot for +#' teachers). +#' +#' @section Aesthetics: +#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "point")} +#' @inheritParams ggplot2::layer +#' @param na.rm If \code{FALSE} (the default), removes missing values with +#' a warning. If \code{TRUE} silently removes missing values. +#' @param ... other arguments passed on to \code{\link{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. +#' @param point.size.l the size of the left point +#' @param point.colour.l the colour of the left point +#' @param point.size.r the size of the right point +#' @param point.colour.r the colour of the right point +#' @inheritParams ggplot2::layer +#' @export +#' @examples +#' df <- data.frame(trt=LETTERS[1:10], +#' value=seq(100, 10, by=-10)) +#' +#' ggplot(df, aes(trt, value)) + geom_lollipop() +#' +#' ggplot(df, aes(value, trt)) + geom_lollipop(horizontal=TRUE) +geom_dumbbell <- function(mapping = NULL, data = NULL, ..., + point.colour.l = NULL, point.size.l = NULL, + point.colour.r = NULL, point.size.r = NULL, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { + + layer( + data = data, + mapping = mapping, + stat = "identity", + geom = GeomDumbbell, + position = "identity", + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list( + na.rm = na.rm, + point.colour.l = point.colour.l, + point.size.l = point.size.l, + point.colour.r = point.colour.r, + point.size.r = point.size.r, + ... + ) + ) +} + +#' @rdname ggalt-ggproto +#' @format NULL +#' @usage NULL +#' @export +GeomDumbbell <- ggproto("GeomDumbbell", Geom, + required_aes = c("x", "xend", "y"), + non_missing_aes = c("size", "shape", + "point.colour.l", "point.size.l", + "point.colour.r", "point.size.r"), + default_aes = aes( + shape = 19, colour = "black", size = 0.5, fill = NA, + alpha = NA, stroke = 0.5 + ), + + setup_data = function(data, params) { + transform(data, yend = y) + }, + + draw_group = function(data, panel_scales, coord, + point.colour.l = NULL, point.size.l = NULL, + point.colour.r = NULL, point.size.r = NULL) { + + points.r <- data + points.r$colour <- point.colour.r %||% data$colour + points.r$size <- point.size.r %||% (data$size * 2.5) + + points.l <- data + points.l$x <- points.l$xend + points.l$colour <- point.colour.l %||% data$colour + points.l$size <- point.size.l %||% (data$size * 2.5) + + gList( + ggplot2::GeomSegment$draw_panel(data, panel_scales, coord), + ggplot2::GeomPoint$draw_panel(points.l, panel_scales, coord), + ggplot2::GeomPoint$draw_panel(points.r, panel_scales, coord) + ) + + }, + + draw_key = draw_key_point +) + + diff --git a/README.Rmd b/README.Rmd index df9db0d..a017194 100644 --- a/README.Rmd +++ b/README.Rmd @@ -40,6 +40,7 @@ The following functions are implemented: - `scale_fill_pokemon` : discrete pokemon scales (data taken from the hard work by the ) - `byte_format`: + helpers. e.g. turn `10000` into `10 Kb` - `geom_lollipop()`: Dead easy lollipops (horizontal or vertical) +- `geom_dumbberll()` : Dead easy dumbbell plots ### Installation @@ -290,6 +291,46 @@ gg <- gg + theme(plot.caption=element_text(size=8, margin=margin(t=10))) gg ``` +```{r dumbbell} +library(dplyr) +library(tidyr) +library(scales) +library(ggplot2) +library(ggalt) # devtools::install_github("hrbrmstr/ggalt") + +health <- read.csv("https://gist.githubusercontent.com/hrbrmstr/0d206070cea01bcb0118/raw/0ea32190a8b2f54b5a9770cb6582007132571c98/zhealth.csv", stringsAsFactors=FALSE, + header=FALSE, col.names=c("pct", "area_id")) + +areas <- read.csv("https://gist.githubusercontent.com/hrbrmstr/0d206070cea01bcb0118/raw/0ea32190a8b2f54b5a9770cb6582007132571c98/zarea_trans.csv", stringsAsFactors=FALSE, header=TRUE) + +health %>% + mutate(area_id=trunc(area_id)) %>% + arrange(area_id, pct) %>% + mutate(year=rep(c("2014", "2013"), 26), + pct=pct/100) %>% + left_join(areas, "area_id") %>% + mutate(area_name=factor(area_name, levels=unique(area_name))) -> health + +setNames(bind_cols(filter(health, year==2014), filter(health, year==2013))[,c(4,1,5)], + c("area_name", "pct_2014", "pct_2013")) -> health + + +gg <- ggplot(health, aes(x=pct_2013, xend=pct_2014, y=area_name, group=area_name)) +gg <- gg + geom_dumbbell(color="#a3c4dc", size=0.75, point.colour.l="#0e668b") +gg <- gg + scale_x_continuous(label=percent) +gg <- gg + labs(x=NULL, y=NULL) +gg <- gg + theme_bw() +gg <- gg + theme(plot.background=element_rect(fill="#f7f7f7")) +gg <- gg + theme(panel.background=element_rect(fill="#f7f7f7")) +gg <- gg + theme(panel.grid.minor=element_blank()) +gg <- gg + theme(panel.grid.major.y=element_blank()) +gg <- gg + theme(panel.grid.major.x=element_line()) +gg <- gg + theme(axis.ticks=element_blank()) +gg <- gg + theme(legend.position="top") +gg <- gg + theme(panel.border=element_blank()) +gg +``` + ### Code of Conduct Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). diff --git a/README.html b/README.html index 6e2ec53..1d93503 100644 --- a/README.html +++ b/README.html @@ -7,7 +7,7 @@ - + @@ -38,25 +38,7 @@ if (window.hljs && document.readyState && document.readyState === "complete") { - - - - - + + + + + + +