diff --git a/.Rbuildignore b/.Rbuildignore index 399461e..5db1bc9 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,3 +10,6 @@ ^tmp/$ ^tmp/.*$ ^cran-comments\.md$ +^README.gfm-ascii_identifiers_files$ +^README.gfm-ascii_identifiers_files/$ +^README.gfm-ascii_identifiers_files/.*$ \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index e840a93..cf190b0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,29 +1,27 @@ Package: statebins Type: Package -Title: U.S. State Cartogram Heatmaps in R; an Alternative to - Choropleth Maps for USA States -Version: 1.2.2 -Date: 2015-12-21 -Author: Bob Rudis (@hrbrmstr) -Maintainer: Bob Rudis -Description: Cartogram heatmaps are an alternative to choropleth maps for USA States - and are based on work by the Washington Post graphics department in their report - on "The states most threatened by trade". "State bins" preserve as much of the - geographic placement of the states as possible but has the look and feel of a - traditional heatmap. Functions are provided that allow for use of a binned, - discrete scale, a continuous scale or manually specified colors depending on - what is needed for the underlying data. -URL: http://github.com/hrbrmstr/statebins +Title: Create 'U.S.' Uniform Square State Cartogram Heatmaps +Version: 1.3.0 +Date: 2018-11-14 +Author: Bob Rudis (bob@rud.is) +Maintainer: Bob Rudis +Description: Cartogram heatmaps are an alternative to choropleth maps for 'USA' States + and are based on work by the 'Washington Post' graphics department in their report + on "The states most threatened by trade" + . + "State bins" preserve as much of the geographic placement of the states as + possible but has the look and feel of a traditional heatmap. Functions are + provided that allow for use of a binned, discrete scale, a continuous scale + or manually specified colors depending on what is needed for the underlying data. +URL: https://github.com/hrbrmstr/statebins BugReports: https://github.com/hrbrmstr/statebins/issues License: MIT + file LICENSE Suggests: testthat Depends: - R (>= 3.0.0), + R (>= 3.2.0), Imports: - ggplot2, - grid, - gridExtra, - scales, - RColorBrewer -RoxygenNote: 5.0.1 + ggplot2 (>= 2.2.0), + scales (>= 0.5.0), + RColorBrewer (>= 1.1-2) +RoxygenNote: 6.0.1 diff --git a/NAMESPACE b/NAMESPACE index a7801e7..06425be 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,7 +4,6 @@ export(statebins) export(statebins_continuous) export(statebins_manual) import(RColorBrewer) -import(gridExtra) importFrom(ggplot2,aes) importFrom(ggplot2,aes_string) importFrom(ggplot2,coord_equal) @@ -20,6 +19,7 @@ importFrom(ggplot2,ggtitle) importFrom(ggplot2,guide_legend) importFrom(ggplot2,guides) importFrom(ggplot2,labs) +importFrom(ggplot2,rel) importFrom(ggplot2,scale_color_manual) importFrom(ggplot2,scale_fill_brewer) importFrom(ggplot2,scale_fill_gradientn) @@ -29,13 +29,4 @@ importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,scale_y_reverse) importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) -importFrom(grid,arrow) -importFrom(grid,gpar) -importFrom(grid,grid.draw) -importFrom(grid,grid.newpage) -importFrom(grid,textGrob) -importFrom(grid,unit) -importFrom(grid,unit.c) -importFrom(grid,unit.pmax) -importFrom(grid,unit.pmin) importFrom(scales,alpha) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..cd10a74 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,20 @@ +# statebins 1.3.0 +* Added support for `VI`/`Virgin Islands` + +# statebins 1.2.2 +* CRAN update + +# statebins 1.2.1 +* Added support for `PR`/`Puerto Rico`[[1](https://github.com/hrbrmstr/statebins/issues/2)] + and fixed a bug (#3) when using anything but a `data.frame` as input. Also no longer fails + (deals with the following but with a warning) when duplicate states are in the input data + or invalid states are in the input data. + +# statebins 1.1.0 +* `statebins_manual()` for manual placement of colors and moving of AK in support of a + (PR #1 by @hansthompson) + +# statebins 1.0.0 +* initial release + + diff --git a/R/aaa.R b/R/aaa.R new file mode 100644 index 0000000..1ef8667 --- /dev/null +++ b/R/aaa.R @@ -0,0 +1,27 @@ +state_coords <- structure(list(abbrev = c("AL", "AK", "AZ", "AR", "CA", "CO", + "CT", "DC", "DE", "FL", "GA", "HI", "ID", "IL", "IN", "IA", "KS", + "KY", "LA", "ME", "MD", "MA", "MI", "MN", "MS", "MO", "MT", "NE", + "NV", "NH", "NJ", "NM", "NY", "NC", "ND", "OH", "OK", "OR", "PA", + "RI", "SC", "SD", "TN", "TX", "UT", "VT", "VA", "WA", "WV", "WI", "WY", + "PR", "VI"), + state = c("Alabama", "Alaska", "Arizona", "Arkansas", + "California", "Colorado", "Connecticut", "District of Columbia", + "Delaware", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", + "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", + "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", + "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", + "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", + "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", + "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", + "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming", + "Puerto Rico", "Virgin Islands"), + col = c(8L, 1L, 3L, 6L, 2L, 4L, 11L, 10L, 11L, 10L, + 9L, 1L, 3L, 7L, 7L, 6L, 5L, 7L, 6L, 12L, 10L, 11L, 8L, 6L, 7L, + 6L, 4L, 5L, 3L, 12L, 10L, 4L, 10L, 8L, 5L, 8L, 5L, 2L, 9L, 12L, + 9L, 5L, 7L, 5L, 3L, 11L, 9L, 2L, 8L, 7L, 4L, 12L, 0L), + row = c(7L, 7L, + 6L, 6L, 5L, 5L, 4L, 6L, 5L, 8L, 7L, 8L, 3L, 3L, 4L, 4L, 6L, 5L, + 7L, 1L, 5L, 3L, 3L, 3L, 7L, 5L, 3L, 5L, 4L, 2L, 4L, 6L, 3L, 6L, + 3L, 4L, 7L, 4L, 4L, 4L, 6L, 4L, 6L, 8L, 5L, 2L, 5L, 3L, 5L, 2L, 4L, 8L, 6L)), + .Names = c("abbrev", "state", "col", "row"), class = "data.frame", row.names = c(NA, -53L)) + diff --git a/R/statebins-continuous.R b/R/statebins-continuous.R new file mode 100644 index 0000000..a061053 --- /dev/null +++ b/R/statebins-continuous.R @@ -0,0 +1,105 @@ +#' Create a new ggplot-based "statebin" chart for USA states (continuous scale) +#' +#' \code{statebins()} creates "statebin" charts in the style of \url{http://bit.ly/statebins} +#' +#' This version uses a continuous scale based on \code{RColorBrewer} scales +#' (passing in a 6 element \code{RColorBrewer} palette to \code{scale_fill_gradientn}). +#' +#' The function minimally expects the caller to pass in a data frame that: +#' +#' \itemize{ +#' \item has one column of all state abbreviationis (all caps, including \code{DC} & +#' \code{PR} ) or a column of state names (standard capitalization) named \code{state} +#' \item has another column of values named \code{value} +#' } +#' +#' Doing so will create a "statebin" chart with 5 breaks and return a \code{ggplot2} object. +#' +#' You can use a different column for the state names and values by changing \code{state_col} +#' and \code{value_col} accordingly. +#' +#' To add a title, change \code{plot_title} to anything but an empty atomic string vector (i.e. \code{""}) +#' and set \code{title_position} to "\code{top}" or "\code{bottom}". Choosing "\code{bottom}" +#' will cause \code{statebins} to use \code{arrangeGrob} to position the title via \code{sub} and +#' return a frame grob instead of a ggplot2 object. +#' +#' @param state_data data frame of states and values to plot +#' @param state_col column name in \code{state_data} that has the states. no duplicates +#' and can be names (e.g. "\code{Maine}") or abbreviatons (e.g. "\code{ME}") +#' @param value_col column name in \code{state_data} that holds the values to be plotted +#' @param text_color default "\code{black}" +#' @param font_size font size (default = \code{3}) +#' @param state_border_col default "\code{white}" - this creates the "spaces" between boxes +#' @param legend_title title for the legend +#' @param legend_position "\code{none}", "\code{top}", "\code{left}", "\code{right}" or +#' "\code{bottom}" (defaults to "\code{top}") +#' @param brewer_pal which named \code{RColorBrewer} palette to use (defaults to "PuBu") +#' @param plot_title title for the plot +#' @param title_position where to put the title ("\code{bottom}" or "\code{top}" or "" +#' for none); if "\code{bottom}", you get back a grob vs a ggplot object +#' @return ggplot2 object or grob +#' @export +#' @examples +#' \dontrun{ +#' data(USArrests) +#' USArrests$state <- rownames(USArrests) +#' statebins_continuous(USArrests, value_col="Murder", text_color="black", font_size=3, +#' legend_title = "Murder", legend_position="bottom") +#' } +statebins_continuous <- function(state_data, state_col="state", value_col="value", + text_color="black", font_size=3, + state_border_col="white", + legend_title="Legend", legend_position="top", + brewer_pal="PuBu", plot_title="", title_position="bottom") { + + if (!title_position %in% c("", "top", "bottom")) { + stop("'title_position' must be either blank, 'top' or 'bottom'") + } + + if (!legend_position %in% c("", "none", "top", "bottom")) { + stop("'legend_position' must be either blank, 'none', 'top' or 'bottom'") + } + + state_data <- data.frame(state_data, stringsAsFactors=FALSE) + + if (max(nchar(state_data[,state_col])) == 2) { + merge.x <- "abbrev" + } else { + merge.x <- "state" + } + + state_data <- validate_states(state_data, state_col, merge.x) + + st.dat <- merge(state_coords, state_data, by.x=merge.x, by.y=state_col, all.y=TRUE) + + gg <- ggplot(st.dat, aes_string(x="col", y="row", label="abbrev")) + gg <- gg + geom_tile(aes_string(fill=value_col)) + gg <- gg + geom_tile(color=state_border_col, + aes_string(fill=value_col), size=3, show.legend=FALSE) + gg <- gg + geom_text(color=text_color, size=font_size) + gg <- gg + scale_y_reverse() + gg <- gg + scale_fill_gradientn(colours = brewer.pal(6, brewer_pal), name=legend_title) + gg <- gg + coord_equal() + gg <- gg + labs(x=NULL, y=NULL, title=NULL) + gg <- gg + theme_bw() + gg <- gg + theme(legend.position=legend_position) + gg <- gg + theme(panel.border=element_blank()) + gg <- gg + theme(panel.grid=element_blank()) + gg <- gg + theme(panel.background=element_blank()) + gg <- gg + theme(axis.ticks=element_blank()) + gg <- gg + theme(axis.text=element_blank()) + + if (plot_title != "") { + + if (title_position == "bottom") { + gg <- gg + labs(x=plot_title) + gg <- gg + theme(axis.text.x=element_text(hjust=0.5, size=ggplot2::rel(1.2), angle=0)) + } else { + gg <- gg + ggtitle(plot_title) + } + + } + + return(gg) + +} diff --git a/R/statebins-manual.R b/R/statebins-manual.R new file mode 100644 index 0000000..f35aae5 --- /dev/null +++ b/R/statebins-manual.R @@ -0,0 +1,116 @@ +#' Create a new ggplot-based "statebin" chart for USA states (manually colored) +#' +#' \code{statebins()} creates "statebin" charts in the style of \url{http://bit.ly/statebins} +#' +#' This version uses manual colors (i.e. pass in a column that defines the color per-state) +#' +#' The function minimally expects the caller to pass in a data frame that: +#' +#' \itemize{ +#' \item has one column of all state abbreviationis (all caps, including \code{DC} & +#' \code{PR} or a column of state names (standard capitalization) named \code{state} +#' \item has another column of colors named \code{color} +#' } +#' +#' Doing so will create a "statebin" chart with the colors specified as a ggplot2 object. +#' +#' You can use a different column for the state names and colors by changing \code{state_col} +#' and \code{color_col} accordingly. +#' +#' To add a title, change \code{plot_title} to anything but an empty atomic string vector (i.e. \code{""}) +#' and set \code{title_position} to "\code{top}" or "\code{bottom}". Choosing "\code{bottom}" +#' will cause \code{statebins} to use \code{arrangeGrob} to position the title via \code{sub} and +#' return a frame grob instead of a ggplot2 object. +#' +#' @param state_data data frame of states and values to plot +#' @param state_col column name in \code{state_data} that has the states. no duplicates +#' and can be names (e.g. "\code{Maine}") or abbreviatons (e.g. "\code{ME}") +#' @param color_col column name in \code{state_data} that holds the colors to be used +#' @param text_color default "\code{black}" +#' @param font_size font size (default = \code{3}) +#' @param state_border_col default "\code{white}" - this creates the "spaces" between boxes +#' @param labels labels for the legend (should be the same number as distinct colors in +#' \code{color_col}); \code{NULL} == no labels/legend +#' @param legend_title title for the legend +#' @param legend_position "\code{none}", "\code{top}", "\code{left}", "\code{right}" or +#' "\code{bottom}" (defaults to "\code{top}") +#' @param plot_title title for the plot +#' @param title_position where to put the title ("\code{bottom}" or "\code{top}" or "" +#' for none); if "\code{bottom}", you get back a grob vs a ggplot object +#' @return ggplot2 object or grob +#' @export +#' @examples +#' \dontrun{ +#' library(httr) +#' library(dplyr) +#' election_2012 <- +#' GET("https://raw.githubusercontent.com/hrbrmstr/statebins/master/tmp/election2012.csv") +#' results <- read.csv(textConnection(content(election_2012, as="text")), +#' header=TRUE, stringsAsFactors=FALSE) +#' results <- results %>% +#' mutate(color=ifelse(is.na(Obama), "#2166ac", "#b2182b")) %>% +#' select(state, color) +#' results %>% +#' statebins_manual(font_size=4, +#' text_color = "white", labels=c("Romney", "Obama"), +#' legend_position="right", legend_title="Winner") +#' } +statebins_manual <- function(state_data, state_col="state", color_col="color", + text_color="black", font_size=3, + state_border_col="white", labels=NULL, + legend_title="Legend", legend_position="top", + plot_title="", title_position="bottom") { + + if (!title_position %in% c("", "top", "bottom")) { + stop("'title_position' must be either blank, 'top' or 'bottom'") + } + + state_data <- data.frame(state_data, stringsAsFactors=FALSE) + + if (max(nchar(state_data[,state_col])) == 2) { + merge.x <- "abbrev" + } else { + merge.x <- "state" + } + + state_data <- validate_states(state_data, state_col, merge.x) + + st.dat <- merge(state_coords, state_data, by.x=merge.x, by.y=state_col, all.y=TRUE) + + gg <- ggplot(st.dat, aes_string(x="col", y="row", label="abbrev")) + gg <- gg + geom_tile(aes_string(fill="color")) + gg <- gg + geom_tile(color=state_border_col, aes_string(fill="color"), + size=2, show.legend=FALSE) + gg <- gg + geom_text(color=text_color, size=font_size) + gg <- gg + scale_y_reverse() + if (is.null(labels)) { + gg <- gg + scale_fill_manual(values=unique(st.dat[,color_col])) + legend_position = "none" + } else { + gg <- gg + scale_fill_manual(values=unique(st.dat[,color_col]), + labels=labels, name=legend_title) + } + gg <- gg + coord_equal() + gg <- gg + labs(x=NULL, y=NULL, title=NULL) + gg <- gg + theme_bw() + gg <- gg + theme(legend.position=legend_position) + gg <- gg + theme(panel.border=element_blank()) + gg <- gg + theme(panel.grid=element_blank()) + gg <- gg + theme(panel.background=element_blank()) + gg <- gg + theme(axis.ticks=element_blank()) + gg <- gg + theme(axis.text=element_blank()) + + if (plot_title != "") { + + if (title_position == "bottom") { + gg <- gg + labs(x=plot_title) + gg <- gg + theme(axis.text.x=element_text(hjust=0.5, size=ggplot2::rel(1.2), angle=0)) + } else { + gg <- gg + ggtitle(plot_title) + } + + } + + return(gg) + +} diff --git a/R/statebins-package.R b/R/statebins-package.R index 97236a9..8fe987d 100644 --- a/R/statebins-package.R +++ b/R/statebins-package.R @@ -1,16 +1,15 @@ #' statebins is an alternative to choropleth maps for US States #' +#' @md #' @name statebins-package #' @docType package -#' @author Bob Rudis (@@hrbrmstr) -#' @import gridExtra RColorBrewer +#' @author Bob Rudis (bob@@rud.is) +#' @import RColorBrewer #' @importFrom scales alpha #' @importFrom ggplot2 ggplot geom_tile scale_fill_manual guides geom_tile ggplotGrob #' @importFrom ggplot2 geom_point geom_text scale_color_manual guides theme labs #' @importFrom ggplot2 scale_x_continuous scale_y_continuous coord_equal theme_bw #' @importFrom ggplot2 aes guide_legend element_rect element_blank element_text #' @importFrom ggplot2 aes_string scale_y_reverse scale_fill_gradientn -#' @importFrom ggplot2 scale_fill_brewer ggtitle -#' @importFrom grid arrow unit grid.newpage grid.draw unit.c unit.pmax unit.pmin -#' @importFrom grid textGrob gpar +#' @importFrom ggplot2 scale_fill_brewer ggtitle rel NULL diff --git a/R/statebins.R b/R/statebins.R index 401718b..c7930cc 100644 --- a/R/statebins.R +++ b/R/statebins.R @@ -1,45 +1,3 @@ -state_coords <- structure(list(abbrev = c("AL", "AK", "AZ", "AR", "CA", "CO", - "CT", "DC", "DE", "FL", "GA", "HI", "ID", "IL", "IN", "IA", "KS", - "KY", "LA", "ME", "MD", "MA", "MI", "MN", "MS", "MO", "MT", "NE", - "NV", "NH", "NJ", "NM", "NY", "NC", "ND", "OH", "OK", "OR", "PA", - "RI", "SC", "SD", "TN", "TX", "UT", "VT", "VA", "WA", "WV", "WI", "WY", - "PR"), - state = c("Alabama", "Alaska", "Arizona", "Arkansas", - "California", "Colorado", "Connecticut", "District of Columbia", - "Delaware", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", - "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", - "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", - "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", - "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", - "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", - "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", - "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming", - "Puerto Rico"), - col = c(8L, 1L, 3L, 6L, 2L, 4L, 11L, 10L, 11L, 10L, - 9L, 1L, 3L, 7L, 7L, 6L, 5L, 7L, 6L, 12L, 10L, 11L, 8L, 6L, 7L, - 6L, 4L, 5L, 3L, 12L, 10L, 4L, 10L, 8L, 5L, 8L, 5L, 2L, 9L, 12L, - 9L, 5L, 7L, 5L, 3L, 11L, 9L, 2L, 8L, 7L, 4L, 12L), - row = c(7L, 7L, - 6L, 6L, 5L, 5L, 4L, 6L, 5L, 8L, 7L, 8L, 3L, 3L, 4L, 4L, 6L, 5L, - 7L, 1L, 5L, 3L, 3L, 3L, 7L, 5L, 3L, 5L, 4L, 2L, 4L, 6L, 3L, 6L, - 3L, 4L, 7L, 4L, 4L, 4L, 6L, 4L, 6L, 8L, 5L, 2L, 5L, 3L, 5L, 2L, 4L, 8L)), - .Names = c("abbrev", "state", "col", "row"), class = "data.frame", row.names = c(NA, -52L)) - - -invert <- function(hexColor, darkColor="black", lightColor="white") { - - hexColor <- gsub("#", "", hexColor) - - R <- as.integer(paste("0x", substr(hexColor,1,2), sep="")) - G <- as.integer(paste("0x", substr(hexColor,3,4), sep="")) - B <- as.integer(paste("0x", substr(hexColor,5,6), sep="")) - - YIQ <- ((R*299) + (G*587) + (B*114)) / 1000 - - return(ifelse(YIQ >= 128, darkColor, lightColor)) - -} - #' Create a new ggplot-based "statebin" chart for USA states (discrete scale) #' #' \code{statebins()} creates "statebin" charts in the style of \url{http://bit.ly/statebins} @@ -120,7 +78,8 @@ statebins <- function(state_data, state_col="state", value_col="value", gg <- ggplot(st.dat, aes_string(x="col", y="row", label="abbrev")) gg <- gg + geom_tile(aes_string(fill="fill_color")) - gg <- gg + geom_tile(color=state_border_col, aes_string(fill="fill_color"), size=2, show_guide=FALSE) + gg <- gg + geom_tile(color=state_border_col, aes_string(fill="fill_color"), + size=2, show.legend=FALSE) gg <- gg + geom_text(color=text_color, size=font_size) gg <- gg + scale_y_reverse() gg <- gg + scale_fill_brewer(palette=brewer_pal, name=legend_title) @@ -137,228 +96,8 @@ statebins <- function(state_data, state_col="state", value_col="value", if (plot_title != "") { if (title_position == "bottom") { - gg <- arrangeGrob(gg, sub=textGrob(plot_title, gp=gpar(cex=1))) - } else { - gg <- gg + ggtitle(plot_title) - } - - } - - return(gg) - -} - - -#' Create a new ggplot-based "statebin" chart for USA states (continuous scale) -#' -#' \code{statebins()} creates "statebin" charts in the style of \url{http://bit.ly/statebins} -#' -#' This version uses a continuous scale based on \code{RColorBrewer} scales -#' (passing in a 6 element \code{RColorBrewer} palette to \code{scale_fill_gradientn}). -#' -#' The function minimally expects the caller to pass in a data frame that: -#' -#' \itemize{ -#' \item has one column of all state abbreviationis (all caps, including \code{DC} & -#' \code{PR} ) or a column of state names (standard capitalization) named \code{state} -#' \item has another column of values named \code{value} -#' } -#' -#' Doing so will create a "statebin" chart with 5 breaks and return a \code{ggplot2} object. -#' -#' You can use a different column for the state names and values by changing \code{state_col} -#' and \code{value_col} accordingly. -#' -#' To add a title, change \code{plot_title} to anything but an empty atomic string vector (i.e. \code{""}) -#' and set \code{title_position} to "\code{top}" or "\code{bottom}". Choosing "\code{bottom}" -#' will cause \code{statebins} to use \code{arrangeGrob} to position the title via \code{sub} and -#' return a frame grob instead of a ggplot2 object. -#' -#' @param state_data data frame of states and values to plot -#' @param state_col column name in \code{state_data} that has the states. no duplicates -#' and can be names (e.g. "\code{Maine}") or abbreviatons (e.g. "\code{ME}") -#' @param value_col column name in \code{state_data} that holds the values to be plotted -#' @param text_color default "\code{black}" -#' @param font_size font size (default = \code{3}) -#' @param state_border_col default "\code{white}" - this creates the "spaces" between boxes -#' @param legend_title title for the legend -#' @param legend_position "\code{none}", "\code{top}", "\code{left}", "\code{right}" or -#' "\code{bottom}" (defaults to "\code{top}") -#' @param brewer_pal which named \code{RColorBrewer} palette to use (defaults to "PuBu") -#' @param plot_title title for the plot -#' @param title_position where to put the title ("\code{bottom}" or "\code{top}" or "" -#' for none); if "\code{bottom}", you get back a grob vs a ggplot object -#' @return ggplot2 object or grob -#' @export -#' @examples -#' \dontrun{ -#' data(USArrests) -#' USArrests$state <- rownames(USArrests) -#' statebins_continuous(USArrests, value_col="Murder", text_color="black", font_size=3, -#' legend_title = "Murder", legend_position="bottom") -#' } -statebins_continuous <- function(state_data, state_col="state", value_col="value", - text_color="black", font_size=3, - state_border_col="white", - legend_title="Legend", legend_position="top", - brewer_pal="PuBu", plot_title="", title_position="bottom") { - - if (!title_position %in% c("", "top", "bottom")) { - stop("'title_position' must be either blank, 'top' or 'bottom'") - } - - if (!legend_position %in% c("", "none", "top", "bottom")) { - stop("'legend_position' must be either blank, 'none', 'top' or 'bottom'") - } - - state_data <- data.frame(state_data, stringsAsFactors=FALSE) - - if (max(nchar(state_data[,state_col])) == 2) { - merge.x <- "abbrev" - } else { - merge.x <- "state" - } - - state_data <- validate_states(state_data, state_col, merge.x) - - st.dat <- merge(state_coords, state_data, by.x=merge.x, by.y=state_col, all.y=TRUE) - - gg <- ggplot(st.dat, aes_string(x="col", y="row", label="abbrev")) - gg <- gg + geom_tile(aes_string(fill=value_col)) - gg <- gg + geom_tile(color=state_border_col, - aes_string(fill=value_col), size=3, show_guide=FALSE) - gg <- gg + geom_text(color=text_color, size=font_size) - gg <- gg + scale_y_reverse() - gg <- gg + scale_fill_gradientn(colours = brewer.pal(6, brewer_pal), name=legend_title) - gg <- gg + coord_equal() - gg <- gg + labs(x=NULL, y=NULL, title=NULL) - gg <- gg + theme_bw() - gg <- gg + theme(legend.position=legend_position) - gg <- gg + theme(panel.border=element_blank()) - gg <- gg + theme(panel.grid=element_blank()) - gg <- gg + theme(panel.background=element_blank()) - gg <- gg + theme(axis.ticks=element_blank()) - gg <- gg + theme(axis.text=element_blank()) - - if (plot_title != "") { - - if (title_position == "bottom") { - gg <- arrangeGrob(gg, sub=textGrob(plot_title, gp=gpar(cex=1))) - } else { - gg <- gg + ggtitle(plot_title) - } - - } - - return(gg) - -} - - -#' Create a new ggplot-based "statebin" chart for USA states (manually colored) -#' -#' \code{statebins()} creates "statebin" charts in the style of \url{http://bit.ly/statebins} -#' -#' This version uses manual colors (i.e. pass in a column that defines the color per-state) -#' -#' The function minimally expects the caller to pass in a data frame that: -#' -#' \itemize{ -#' \item has one column of all state abbreviationis (all caps, including \code{DC} & -#' \code{PR} or a column of state names (standard capitalization) named \code{state} -#' \item has another column of colors named \code{color} -#' } -#' -#' Doing so will create a "statebin" chart with the colors specified as a ggplot2 object. -#' -#' You can use a different column for the state names and colors by changing \code{state_col} -#' and \code{color_col} accordingly. -#' -#' To add a title, change \code{plot_title} to anything but an empty atomic string vector (i.e. \code{""}) -#' and set \code{title_position} to "\code{top}" or "\code{bottom}". Choosing "\code{bottom}" -#' will cause \code{statebins} to use \code{arrangeGrob} to position the title via \code{sub} and -#' return a frame grob instead of a ggplot2 object. -#' -#' @param state_data data frame of states and values to plot -#' @param state_col column name in \code{state_data} that has the states. no duplicates -#' and can be names (e.g. "\code{Maine}") or abbreviatons (e.g. "\code{ME}") -#' @param color_col column name in \code{state_data} that holds the colors to be used -#' @param text_color default "\code{black}" -#' @param font_size font size (default = \code{3}) -#' @param state_border_col default "\code{white}" - this creates the "spaces" between boxes -#' @param labels labels for the legend (should be the same number as distinct colors in -#' \code{color_col}); \code{NULL} == no labels/legend -#' @param legend_title title for the legend -#' @param legend_position "\code{none}", "\code{top}", "\code{left}", "\code{right}" or -#' "\code{bottom}" (defaults to "\code{top}") -#' @param plot_title title for the plot -#' @param title_position where to put the title ("\code{bottom}" or "\code{top}" or "" -#' for none); if "\code{bottom}", you get back a grob vs a ggplot object -#' @return ggplot2 object or grob -#' @export -#' @examples -#' \dontrun{ -#' library(httr) -#' library(dplyr) -#' election_2012 <- -#' GET("https://raw.githubusercontent.com/hrbrmstr/statebins/master/tmp/election2012.csv") -#' results <- read.csv(textConnection(content(election_2012, as="text")), -#' header=TRUE, stringsAsFactors=FALSE) -#' results <- results %>% -#' mutate(color=ifelse(is.na(Obama), "#2166ac", "#b2182b")) %>% -#' select(state, color) -#' results %>% -#' statebins_manual(font_size=4, -#' text_color = "white", labels=c("Romney", "Obama"), -#' legend_position="right", legend_title="Winner") -#' } -statebins_manual <- function(state_data, state_col="state", color_col="color", - text_color="black", font_size=3, - state_border_col="white", labels=NULL, - legend_title="Legend", legend_position="top", - plot_title="", title_position="bottom") { - - if (!title_position %in% c("", "top", "bottom")) { - stop("'title_position' must be either blank, 'top' or 'bottom'") - } - - state_data <- data.frame(state_data, stringsAsFactors=FALSE) - - if (max(nchar(state_data[,state_col])) == 2) { - merge.x <- "abbrev" - } else { - merge.x <- "state" - } - - state_data <- validate_states(state_data, state_col, merge.x) - - st.dat <- merge(state_coords, state_data, by.x=merge.x, by.y=state_col, all.y=TRUE) - - gg <- ggplot(st.dat, aes_string(x="col", y="row", label="abbrev")) - gg <- gg + geom_tile(aes_string(fill="color")) - gg <- gg + geom_tile(color=state_border_col, aes_string(fill="color"), size=2, show_guide=FALSE) - gg <- gg + geom_text(color=text_color, size=font_size) - gg <- gg + scale_y_reverse() - if (is.null(labels)) { - gg <- gg + scale_fill_manual(values=unique(st.dat[,color_col])) - legend_position = "none" - } else { - gg <- gg + scale_fill_manual(values=unique(st.dat[,color_col]), labels=labels, name=legend_title) - } - gg <- gg + coord_equal() - gg <- gg + labs(x=NULL, y=NULL, title=NULL) - gg <- gg + theme_bw() - gg <- gg + theme(legend.position=legend_position) - gg <- gg + theme(panel.border=element_blank()) - gg <- gg + theme(panel.grid=element_blank()) - gg <- gg + theme(panel.background=element_blank()) - gg <- gg + theme(axis.ticks=element_blank()) - gg <- gg + theme(axis.text=element_blank()) - - if (plot_title != "") { - - if (title_position == "bottom") { - gg <- arrangeGrob(gg, sub=textGrob(plot_title, gp=gpar(cex=1))) + gg <- gg + labs(x=plot_title) + gg <- gg + theme(axis.text.x=element_text(hjust=0.5, size=ggplot2::rel(1.2), angle=0)) } else { gg <- gg + ggtitle(plot_title) } @@ -368,27 +107,3 @@ statebins_manual <- function(state_data, state_col="state", color_col="color", return(gg) } - -# sanity checks for state values -validate_states <- function(state_data, state_col, merge.x) { - - good_states <- state_data[,state_col] %in% state_coords[,merge.x] - if (any(!good_states)) { - invalid <- state_data[,state_col][which(!good_states)] - state_data <- state_data[which(good_states),] - warning("Found invalid state values: ", invalid) - } - - dups <- duplicated(state_data[,state_col]) - if (any(dups)) { - state_data <- state_data[which(!dups),] - warning("Removing duplicate state rows") - } - - return(state_data) - -} - - - - diff --git a/R/util.R b/R/util.R new file mode 100644 index 0000000..1e10f79 --- /dev/null +++ b/R/util.R @@ -0,0 +1,33 @@ +invert <- function(hexColor, darkColor="black", lightColor="white") { + + hexColor <- gsub("#", "", hexColor) + + R <- as.integer(paste("0x", substr(hexColor,1,2), sep="")) + G <- as.integer(paste("0x", substr(hexColor,3,4), sep="")) + B <- as.integer(paste("0x", substr(hexColor,5,6), sep="")) + + YIQ <- ((R*299) + (G*587) + (B*114)) / 1000 + + return(ifelse(YIQ >= 128, darkColor, lightColor)) + +} + +# sanity checks for state values +validate_states <- function(state_data, state_col, merge.x) { + + good_states <- state_data[,state_col] %in% state_coords[,merge.x] + if (any(!good_states)) { + invalid <- state_data[,state_col][which(!good_states)] + state_data <- state_data[which(good_states),] + warning("Found invalid state values: ", invalid) + } + + dups <- duplicated(state_data[,state_col]) + if (any(dups)) { + state_data <- state_data[which(!dups),] + warning("Removing duplicate state rows") + } + + return(state_data) + +} diff --git a/README.Rmd b/README.Rmd index 4467c2f..31afec1 100644 --- a/README.Rmd +++ b/README.Rmd @@ -1,14 +1,16 @@ --- -title: "statebins" -output: - html_document: - keep_md: true - md_document: - variant: markdown_github +output: rmarkdown::github_document --- - +```{r echo=FALSE, message=FALSE, warning=FALSE, error=FALSE, include=FALSE} +knitr::opts_chunk$set(message=FALSE, warning=FALSE, fig.retina=2) +options(width=120) +``` + +# statebins + +Create 'U.S.' Uniform Square State Cartogram Heatmaps -statebins - U.S. State Cartogram Heatmaps in R; an alternative to choropleth maps for USA States +## What's in the tin? The following functions are implemented: @@ -16,78 +18,91 @@ The following functions are implemented: - `statebins_continuous` - creates "statebin" charts in the style of http://bit.ly/statebins - This version uses a continuous scale based on `RColorBrewer` scales (passing in a 6 element `RColorBrewer` palette to `scale_fill_gradientn`). - `statebins_manual` - creates "statebin" charts using manually specified colors in a column -### TODO +## TODO - The current version is usable, but I think the plot margins and the legends need work - Apply algorithm to switch to light-on-dark depending on the background tile color -### News - -- Version `1.2.2` released (CRAN update) -- Version `1.2.1` released - Added support for `PR`/`Puerto Rico`[[1](https://github.com/hrbrmstr/statebins/issues/2)] and fixed a bug[[2](https://github.com/hrbrmstr/statebins/issues/3)] when using anything but a `data.frame` as input. Also no longer fails (deals with the following but with a warning) when duplicate states are in the input data or invalid states are in the input data. -- Version `1.1.0` released - `statebins_manual()` for manual placement of colors and moving of AK in support of a [pull request](https://github.com/hrbrmstr/statebins/pull/1) by [hansthompson](https://github.com/hansthompson) -- Version `1.0.0` released - -### Installation +## Installation ```{r eval=FALSE} devtools::install_github("hrbrmstr/statebins") ``` -```{r echo=FALSE, message=FALSE, warning=FALSE, error=FALSE} -options(width=120) -``` - -### Usage +## Usage All of the following examples use the [WaPo data](http://www.washingtonpost.com/wp-srv/special/business/states-most-threatened-by-trade/states.csv?cache=1). It looks like the columns they use are scaled data and I didn't take the time to figure out what they did, so the final figure just mimics their output (including the non-annotated legend). -```{r message=FALSE} +```{r} library(statebins) +library(tidyverse) # current verison packageVersion("statebins") # the original wapo data - -dat <- read.csv("http://www.washingtonpost.com/wp-srv/special/business/states-most-threatened-by-trade/states.csv?cache=1", stringsAsFactors=FALSE) - -gg <- statebins(dat, "state", "avgshare94_00", breaks=4, - labels=c("0-1", "1-2", "2-3", "3-4"), - legend_title="Share of workforce with jobs lost or threatened by trade", font_size=3, - brewer_pal="Blues", text_color="black", - plot_title="1994-2000", title_position="bottom") +cols( + fipst = col_character(), stab = col_character(), state = col_character(), workers1994 = col_integer(), workers1995 = col_integer(), workers1996 = col_integer(), workers1997 = col_integer(), workers1998 = col_integer(), workers1999 = col_integer(), workers2000 = col_integer(), workers2001 = col_integer(), workers2002 = col_integer(), workers2003 = col_integer(), workers2004 = col_integer(), workers2005 = col_integer(), workers2006 = col_integer(), workers2007 = col_integer(), workers2008 = col_integer(), workers2009 = col_integer(), workers2010 = col_integer(), workers2011 = col_integer(), workers2012 = col_integer(), workers2013 = col_integer(), + share_cut1994 = col_double(), share_cut1995 = col_double(), share_cut1996 = col_double(), share_cut1997 = col_double(), share_cut1998 = col_double(), share_cut1999 = col_double(), share_cut2000 = col_double(), share_cut2001 = col_double(), share_cut2002 = col_double(), share_cut2003 = col_double(), share_cut2004 = col_double(), share_cut2005 = col_double(), share_cut2006 = col_double(), share_cut2007 = col_double(), share_cut2008 = col_double(), share_cut2009 = col_double(), share_cut2010 = col_double(), share_cut2011 = col_double(), share_cut2012 = col_double(), share_cut2013 = col_double(), + avgshare = col_double(), avgshare94_00 = col_double(), avgshare01_07 = col_double(), avgshare08_12 = col_double() +) -> wapo_cols + +adat <- read_csv("http://www.washingtonpost.com/wp-srv/special/business/states-most-threatened-by-trade/states.csv?cache=1", + col_types = wapo_cols) + +gg <- statebins( + adat, "state", "avgshare94_00", + breaks = 4, + labels = c("0-1", "1-2", "2-3", "3-4"), + legend_title = "Share of workforce with jobs lost or threatened by trade", + font_size = 3, + brewer_pal = "Blues", + text_color = "black", + plot_title = "1994-2000", + title_position = "bottom" +) gg # continuous scale, legend on top -gg2 <- statebins_continuous(dat, "state", "avgshare01_07", - legend_title="Share of workforce with jobs lost or threatened by trade", legend_position="top", - brewer_pal="OrRd", text_color="black", font_size=3, - plot_title="2001-2007", title_position="bottom") +gg2 <- statebins_continuous( + adat, "state", "avgshare01_07", + legend_title="Share of workforce with jobs lost or threatened by trade", legend_position="top", + brewer_pal="OrRd", text_color="black", font_size=3, + plot_title="2001-2007", title_position="bottom" +) gg2 # continuous scale, no legend -gg3 <- statebins_continuous(dat, "state", "avgshare08_12", - legend_title="States", legend_position="none", - brewer_pal="Purples", text_color="black", font_size=3, - plot_title="2008-2012", title_position="bottom") +gg3 <- statebins_continuous( + adat, "state", "avgshare08_12", + legend_title="States", legend_position="none", + brewer_pal="Purples", text_color="black", font_size=3, + plot_title="2008-2012", title_position="bottom" +) gg3 # mortality (only to show PR and using a data.table) # from: http://www.cdc.gov/nchs/fastats/state-and-territorial-data.htm -dat <- data.table::fread("http://dds.ec/data/deaths.csv") +cols( + state = col_character(), + births = col_integer(), + fertility_rate = col_double(), + deaths = col_integer(), + death_rate = col_double() +) -> deaths_cols + +dat <- read_csv("http://datadrivensecurity.info/data/deaths.csv", col_types=deaths_cols) statebins_continuous(dat, "state", "death_rate", legend_title="Per 100K pop", - plot_title="Mortality Rate (2010)") + plot_title="Mortality Rate (2010)") # fertility (only to show tbl_dt) -dat <- dplyr::tbl_dt(dat) statebins_continuous(dat, "state", "fertility_rate", legend_title="Per 100K pop", plot_title="Fertility Rate (2010)", brewer_pal="PuBuGn") @@ -95,15 +110,30 @@ statebins_continuous(dat, "state", "fertility_rate", legend_title="Per 100K pop" library(httr) library(dplyr) + election_2012 <- GET("https://raw.githubusercontent.com/hrbrmstr/statebins/master/tmp/election2012.csv") -results <- read.csv(textConnection(content(election_2012, as="text")), header=TRUE, stringsAsFactors=FALSE) -results <- results %>% mutate(color=ifelse(is.na(Obama), "#2166ac", "#b2182b")) %>% select(state, color) -results %>% statebins_manual(font_size=4, text_color = "white", labels=c("Romney", "Obama"), legend_position="right", legend_title="Winner") + +read.csv( + textConnection(content(election_2012, as="text")), + header=TRUE, stringsAsFactors=FALSE +) %>% + mutate(color=ifelse(is.na(Obama), "#2166ac", "#b2182b")) %>% + select(state, color) -> results + +statebins_manual( + results, + font_size=4, text_color = "white", + labels=c("Romney", "Obama"), legend_position="right", legend_title="Winner" +) # or, more like the one in the WaPo article; i might be picking the wrong columns here. it's just for an example sb <- function(col, title) { - statebins(dat, "state",col, brewer_pal="Blues", text_color="black", legend_position="none", font_size=3, plot_title=title, breaks=4, labels=1:4) + statebins( + adat, "state", col, brewer_pal="Blues", text_color="black", + legend_position="none", font_size=3, plot_title=title, + breaks=4, labels=1:4 + ) } ``` @@ -154,44 +184,39 @@ sb("avgshare08_12", "2008-2012") And, we'll throw in a gratuitous animation for good measure: ```{r eval=FALSE} +library(magick) # data set from StatsAmerica - http://www.statsamerica.org/profiles/sip_index.html # median household income from the ACS survey -miacs <- read.csv("http://dds.ec/data/median-income-acs.csv", header=TRUE, stringsAsFactors=FALSE) +miacs <- read.csv("http://datadrivensecurity.info/data/median-income-acs.csv", + header=TRUE, stringsAsFactors=FALSE) # generate frames based on year -sapply(unique(miacs$year), function(year) { +purrr::map(unique(miacs$year), function(year) { - png(file=sprintf("tmp/household%d.png", year), - type="quartz", antialias="subpixel", width=800, height=600) + cat(".") + + fig <- magick::image_graph(res=144) rng <- floor(range(miacs[miacs$year==year,]$mh_inc)) - ggtmp <- statebins(miacs[miacs$year==year,], "state", "mh_inc", - legend_title="States", legend_position="none", - brewer_pal="Greens", text_color="black", font_size=3, - plot_title=sprintf("Median Household Income (ACS) %d\n$%s - $%s", year, comma(rng[1]), comma(rng[2])), title_position="top") + statebins( + miacs[miacs$year==year,], "state", "mh_inc", + legend_title="States", legend_position="none", + brewer_pal="Greens", text_color="black", font_size=3, + plot_title=sprintf("Median Household Income (ACS) %d\n$%s - $%s", year, + scales::comma(rng[1]), scales::comma(rng[2])), + title_position="top" + ) -> ggtmp print(ggtmp) dev.off() -}) - -# animate them with ImageMagick -system("convert -background white -alpha remove -layers OptimizePlus -delay 150 tmp/*.png -loop 1 tmp/household.gif") + fig + +}) %>% image_join() %>% + image_animate(fps=2, loop=1) ```
![img](./tmp/household.gif)
- -### Test Results - -```{r} -library(statebins) -library(testthat) - -date() - -test_dir("tests/") -``` - diff --git a/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-1.png b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-1.png new file mode 100644 index 0000000..202f327 Binary files /dev/null and b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-1.png differ diff --git a/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-2.png b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-2.png new file mode 100644 index 0000000..5583104 Binary files /dev/null and b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-2.png differ diff --git a/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-3.png b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-3.png new file mode 100644 index 0000000..e65bdf3 Binary files /dev/null and b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-3.png differ diff --git a/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-4.png b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-4.png new file mode 100644 index 0000000..2f94ddf Binary files /dev/null and b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-4.png differ diff --git a/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-5.png b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-5.png new file mode 100644 index 0000000..1e00809 Binary files /dev/null and b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-5.png differ diff --git a/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-6.png b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-6.png new file mode 100644 index 0000000..bb4480a Binary files /dev/null and b/README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-6.png differ diff --git a/README.html b/README.html deleted file mode 100644 index d327097..0000000 --- a/README.html +++ /dev/null @@ -1,284 +0,0 @@ - - - - - - - - - - - - -statebins - - - - - - - - - - - - - - - - - - - - - -
- - - - - - -

statebins - U.S. State Cartogram Heatmaps in R; an alternative to choropleth maps for USA States

-

The following functions are implemented:

-
    -
  • statebins - creates “statebin” charts in the style of http://bit.ly/statebins - This version uses discrete RColorBrewer scales, binned by the “breaks” parameter.
    • -
  • statebins_continuous - creates “statebin” charts in the style of http://bit.ly/statebins - This version uses a continuous scale based on RColorBrewer scales (passing in a 6 element RColorBrewer palette to scale_fill_gradientn).
    • -
  • statebins_manual - creates “statebin” charts using manually specified colors in a column
    • -
-
-

TODO

-
    -
  • The current version is usable, but I think the plot margins and the legends need work
    • -
  • Apply algorithm to switch to light-on-dark depending on the background tile color
    • -
-
-
-

News

-
    -
  • Version 1.2.1 released - Added support for PR/Puerto Rico[1] and fixed a bug[2] when using anything but a data.frame as input. Also no longer fails (deals with the following but with a warning) when duplicate states are in the input data or invalid states are in the input data.
    • -
  • Version 1.1.0 released - statebins_manual() for manual placement of colors and moving of AK in support of a pull request by hansthompson
    • -
  • Version 1.0.0 released
    • -
-
-
-

Installation

-
devtools::install_github("hrbrmstr/statebins")
-
-
-

Usage

-

All of the following examples use the WaPo data. It looks like the columns they use are scaled data and I didn’t take the time to figure out what they did, so the final figure just mimics their output (including the non-annotated legend).

-
library(statebins)
-
-# current verison
-packageVersion("statebins")
-
## [1] '1.2.2'
-
# the original wapo data
-
-dat <- read.csv("http://www.washingtonpost.com/wp-srv/special/business/states-most-threatened-by-trade/states.csv?cache=1", stringsAsFactors=FALSE)
-
-gg <- statebins(dat, "state", "avgshare94_00", breaks=4, 
-                labels=c("0-1", "1-2", "2-3", "3-4"),
-                legend_title="Share of workforce with jobs lost or threatened by trade", font_size=3, 
-                brewer_pal="Blues", text_color="black", 
-                plot_title="1994-2000", title_position="bottom")
-
## Warning: `show_guide` has been deprecated. Please use `show.legend` instead.
-
gg
-
## TableGrob (2 x 1) "arrange": 2 grobs
-##     z     cells    name              grob
-##     1 (1-1,1-1) arrange    gtable[layout]
-## sub 2 (2-2,1-1) arrange text[GRID.text.1]
-
# continuous scale, legend on top
-
-gg2 <- statebins_continuous(dat, "state", "avgshare01_07",
-                            legend_title="Share of workforce with jobs lost or threatened by trade", legend_position="top",
-                            brewer_pal="OrRd", text_color="black", font_size=3, 
-                            plot_title="2001-2007", title_position="bottom")
-
## Warning: `show_guide` has been deprecated. Please use `show.legend` instead.
-
gg2
-
## TableGrob (2 x 1) "arrange": 2 grobs
-##     z     cells    name               grob
-##     1 (1-1,1-1) arrange     gtable[layout]
-## sub 2 (2-2,1-1) arrange text[GRID.text.53]
-
# continuous scale, no legend
-
-gg3 <- statebins_continuous(dat, "state", "avgshare08_12",
-                            legend_title="States", legend_position="none",
-                            brewer_pal="Purples", text_color="black", font_size=3, 
-                            plot_title="2008-2012", title_position="bottom")
-
## Warning: `show_guide` has been deprecated. Please use `show.legend` instead.
-
gg3
-
## TableGrob (2 x 1) "arrange": 2 grobs
-##     z     cells    name               grob
-##     1 (1-1,1-1) arrange     gtable[layout]
-## sub 2 (2-2,1-1) arrange text[GRID.text.89]
-
# mortality (only to show PR and using a data.table)
-# from: http://www.cdc.gov/nchs/fastats/state-and-territorial-data.htm
-
-dat <- data.table::fread("http://dds.ec/data/deaths.csv")
-statebins_continuous(dat, "state", "death_rate", legend_title="Per 100K pop",
-                    plot_title="Mortality Rate (2010)")
-
## Warning: `show_guide` has been deprecated. Please use `show.legend` instead.
-
## TableGrob (2 x 1) "arrange": 2 grobs
-##     z     cells    name                grob
-##     1 (1-1,1-1) arrange      gtable[layout]
-## sub 2 (2-2,1-1) arrange text[GRID.text.117]
-
# fertility (only to show tbl_dt)
-
-dat <- dplyr::tbl_dt(dat)
-statebins_continuous(dat, "state", "fertility_rate", legend_title="Per 100K pop", 
-                     plot_title="Fertility Rate (2010)", brewer_pal="PuBuGn")
-
## Warning: `show_guide` has been deprecated. Please use `show.legend` instead.
-
## TableGrob (2 x 1) "arrange": 2 grobs
-##     z     cells    name                grob
-##     1 (1-1,1-1) arrange      gtable[layout]
-## sub 2 (2-2,1-1) arrange text[GRID.text.153]
-
# manual - perhaps good for elections?
-
-library(httr)
-library(dplyr)
-election_2012 <- GET("https://raw.githubusercontent.com/hrbrmstr/statebins/master/tmp/election2012.csv")
-results <- read.csv(textConnection(content(election_2012, as="text")), header=TRUE, stringsAsFactors=FALSE)
-results <- results %>% mutate(color=ifelse(is.na(Obama), "#2166ac", "#b2182b")) %>% select(state, color)
-results %>% statebins_manual(font_size=4, text_color = "white", labels=c("Romney", "Obama"), legend_position="right", legend_title="Winner")
-
## Warning: `show_guide` has been deprecated. Please use `show.legend` instead.
-

-
# or, more like the one in the WaPo article; i might be picking the wrong columns here. it's just for an example
-
-sb <- function(col, title) {
-  statebins(dat, "state",col, brewer_pal="Blues", text_color="black", legend_position="none", font_size=3, plot_title=title, breaks=4, labels=1:4)
-}
-
# cheating and using <table> to arrange them below and also making a WaPo-like legend, 
-# since mucking with grid graphics margins/padding was not an option time-wise at the moment
-
-sb("avgshare94_00", "1994-2000")
-sb("avgshare01_07", "2001-2007")
-sb("avgshare08_12", "2008-2012")
- - - -
-img -
-

And, we’ll throw in a gratuitous animation for good measure:

-
# data set from StatsAmerica - http://www.statsamerica.org/profiles/sip_index.html
-
-# median household income from the ACS survey
-miacs <- read.csv("http://dds.ec/data/median-income-acs.csv", header=TRUE, stringsAsFactors=FALSE)
-
-# generate frames based on year
-sapply(unique(miacs$year), function(year) {
-  
-  png(file=sprintf("tmp/household%d.png", year),
-      type="quartz", antialias="subpixel", width=800, height=600)
-  
-  rng <- floor(range(miacs[miacs$year==year,]$mh_inc))
-  
-  ggtmp <- statebins(miacs[miacs$year==year,], "state", "mh_inc",
-                   legend_title="States", legend_position="none",
-                   brewer_pal="Greens", text_color="black", font_size=3,
-                   plot_title=sprintf("Median Household Income (ACS) %d\n$%s - $%s", year, comma(rng[1]), comma(rng[2])), title_position="top")
-  
-  print(ggtmp)
-  
-  dev.off()
-  
-})
-
-# animate them with ImageMagick
-system("convert -background white -alpha remove -layers OptimizePlus -delay 150 tmp/*.png -loop 1 tmp/household.gif")
-
-img -
-
-
-

Test Results

-
library(statebins)
-library(testthat)
-
-date()
-
## [1] "Mon Dec 21 08:21:03 2015"
-
test_dir("tests/")
-
## testthat results ========================================================================================================
-## OK: 0 SKIPPED: 0 FAILED: 0
-
- - -
- - - - - - - - diff --git a/README.md b/README.md index 5944045..7401b17 100644 --- a/README.md +++ b/README.md @@ -1,191 +1,176 @@ -# statebins - - -statebins - U.S. State Cartogram Heatmaps in R; an alternative to choropleth maps for USA States -The following functions are implemented: +# statebins -- `statebins` - creates "statebin" charts in the style of http://bit.ly/statebins - This version uses discrete `RColorBrewer` scales, binned by the "breaks" parameter. -- `statebins_continuous` - creates "statebin" charts in the style of http://bit.ly/statebins - This version uses a continuous scale based on `RColorBrewer` scales (passing in a 6 element `RColorBrewer` palette to `scale_fill_gradientn`). -- `statebins_manual` - creates "statebin" charts using manually specified colors in a column +Create ‘U.S.’ Uniform Square State Cartogram Heatmaps -### TODO +## What’s in the tin? -- The current version is usable, but I think the plot margins and the legends need work -- Apply algorithm to switch to light-on-dark depending on the background tile color +The following functions are implemented: -### News + - `statebins` - creates “statebin” charts in the style of + - This version uses discrete + `RColorBrewer` scales, binned by the “breaks” parameter. + - `statebins_continuous` - creates “statebin” charts in the style of + - This version uses a continuous scale + based on `RColorBrewer` scales (passing in a 6 element + `RColorBrewer` palette to `scale_fill_gradientn`). + - `statebins_manual` - creates “statebin” charts using manually + specified colors in a column -- Version `1.2.1` released - Added support for `PR`/`Puerto Rico`[[1](https://github.com/hrbrmstr/statebins/issues/2)] and fixed a bug[[2](https://github.com/hrbrmstr/statebins/issues/3)] when using anything but a `data.frame` as input. Also no longer fails (deals with the following but with a warning) when duplicate states are in the input data or invalid states are in the input data. -- Version `1.1.0` released - `statebins_manual()` for manual placement of colors and moving of AK in support of a [pull request](https://github.com/hrbrmstr/statebins/pull/1) by [hansthompson](https://github.com/hansthompson) -- Version `1.0.0` released +## TODO -### Installation + - The current version is usable, but I think the plot margins and the + legends need work + - Apply algorithm to switch to light-on-dark depending on the + background tile color +## Installation -```r +``` r devtools::install_github("hrbrmstr/statebins") ``` +## Usage +All of the following examples use the [WaPo +data](http://www.washingtonpost.com/wp-srv/special/business/states-most-threatened-by-trade/states.csv?cache=1). +It looks like the columns they use are scaled data and I didn’t take the +time to figure out what they did, so the final figure just mimics their +output (including the non-annotated legend). -### Usage - -All of the following examples use the [WaPo data](http://www.washingtonpost.com/wp-srv/special/business/states-most-threatened-by-trade/states.csv?cache=1). It looks like the columns they use are scaled data and I didn't take the time to figure out what they did, so the final figure just mimics their output (including the non-annotated legend). - - -```r +``` r library(statebins) +library(tidyverse) # current verison packageVersion("statebins") ``` -``` -## [1] '1.2.2' -``` + ## [1] '1.3.0' -```r +``` r # the original wapo data +cols( + fipst = col_character(), stab = col_character(), state = col_character(), workers1994 = col_integer(), workers1995 = col_integer(), workers1996 = col_integer(), workers1997 = col_integer(), workers1998 = col_integer(), workers1999 = col_integer(), workers2000 = col_integer(), workers2001 = col_integer(), workers2002 = col_integer(), workers2003 = col_integer(), workers2004 = col_integer(), workers2005 = col_integer(), workers2006 = col_integer(), workers2007 = col_integer(), workers2008 = col_integer(), workers2009 = col_integer(), workers2010 = col_integer(), workers2011 = col_integer(), workers2012 = col_integer(), workers2013 = col_integer(), + share_cut1994 = col_double(), share_cut1995 = col_double(), share_cut1996 = col_double(), share_cut1997 = col_double(), share_cut1998 = col_double(), share_cut1999 = col_double(), share_cut2000 = col_double(), share_cut2001 = col_double(), share_cut2002 = col_double(), share_cut2003 = col_double(), share_cut2004 = col_double(), share_cut2005 = col_double(), share_cut2006 = col_double(), share_cut2007 = col_double(), share_cut2008 = col_double(), share_cut2009 = col_double(), share_cut2010 = col_double(), share_cut2011 = col_double(), share_cut2012 = col_double(), share_cut2013 = col_double(), + avgshare = col_double(), avgshare94_00 = col_double(), avgshare01_07 = col_double(), avgshare08_12 = col_double() +) -> wapo_cols + +adat <- read_csv("http://www.washingtonpost.com/wp-srv/special/business/states-most-threatened-by-trade/states.csv?cache=1", + col_types = wapo_cols) + +gg <- statebins( + adat, "state", "avgshare94_00", + breaks = 4, + labels = c("0-1", "1-2", "2-3", "3-4"), + legend_title = "Share of workforce with jobs lost or threatened by trade", + font_size = 3, + brewer_pal = "Blues", + text_color = "black", + plot_title = "1994-2000", + title_position = "bottom" +) -dat <- read.csv("http://www.washingtonpost.com/wp-srv/special/business/states-most-threatened-by-trade/states.csv?cache=1", stringsAsFactors=FALSE) - -gg <- statebins(dat, "state", "avgshare94_00", breaks=4, - labels=c("0-1", "1-2", "2-3", "3-4"), - legend_title="Share of workforce with jobs lost or threatened by trade", font_size=3, - brewer_pal="Blues", text_color="black", - plot_title="1994-2000", title_position="bottom") -``` - -``` -## Warning: `show_guide` has been deprecated. Please use `show.legend` instead. -``` - -```r gg ``` -``` -## TableGrob (2 x 1) "arrange": 2 grobs -## z cells name grob -## 1 (1-1,1-1) arrange gtable[layout] -## sub 2 (2-2,1-1) arrange text[GRID.text.1] -``` + -```r +``` r # continuous scale, legend on top -gg2 <- statebins_continuous(dat, "state", "avgshare01_07", - legend_title="Share of workforce with jobs lost or threatened by trade", legend_position="top", - brewer_pal="OrRd", text_color="black", font_size=3, - plot_title="2001-2007", title_position="bottom") -``` - -``` -## Warning: `show_guide` has been deprecated. Please use `show.legend` instead. -``` +gg2 <- statebins_continuous( + adat, "state", "avgshare01_07", + legend_title="Share of workforce with jobs lost or threatened by trade", legend_position="top", + brewer_pal="OrRd", text_color="black", font_size=3, + plot_title="2001-2007", title_position="bottom" +) -```r gg2 ``` -``` -## TableGrob (2 x 1) "arrange": 2 grobs -## z cells name grob -## 1 (1-1,1-1) arrange gtable[layout] -## sub 2 (2-2,1-1) arrange text[GRID.text.53] -``` + -```r +``` r # continuous scale, no legend -gg3 <- statebins_continuous(dat, "state", "avgshare08_12", - legend_title="States", legend_position="none", - brewer_pal="Purples", text_color="black", font_size=3, - plot_title="2008-2012", title_position="bottom") -``` - -``` -## Warning: `show_guide` has been deprecated. Please use `show.legend` instead. -``` +gg3 <- statebins_continuous( + adat, "state", "avgshare08_12", + legend_title="States", legend_position="none", + brewer_pal="Purples", text_color="black", font_size=3, + plot_title="2008-2012", title_position="bottom" +) -```r gg3 ``` -``` -## TableGrob (2 x 1) "arrange": 2 grobs -## z cells name grob -## 1 (1-1,1-1) arrange gtable[layout] -## sub 2 (2-2,1-1) arrange text[GRID.text.89] -``` + -```r +``` r # mortality (only to show PR and using a data.table) # from: http://www.cdc.gov/nchs/fastats/state-and-territorial-data.htm -dat <- data.table::fread("http://dds.ec/data/deaths.csv") -statebins_continuous(dat, "state", "death_rate", legend_title="Per 100K pop", - plot_title="Mortality Rate (2010)") -``` +cols( + state = col_character(), + births = col_integer(), + fertility_rate = col_double(), + deaths = col_integer(), + death_rate = col_double() +) -> deaths_cols -``` -## Warning: `show_guide` has been deprecated. Please use `show.legend` instead. +dat <- read_csv("http://datadrivensecurity.info/data/deaths.csv", col_types=deaths_cols) +statebins_continuous(dat, "state", "death_rate", legend_title="Per 100K pop", + plot_title="Mortality Rate (2010)") ``` -``` -## TableGrob (2 x 1) "arrange": 2 grobs -## z cells name grob -## 1 (1-1,1-1) arrange gtable[layout] -## sub 2 (2-2,1-1) arrange text[GRID.text.117] -``` + -```r +``` r # fertility (only to show tbl_dt) -dat <- dplyr::tbl_dt(dat) statebins_continuous(dat, "state", "fertility_rate", legend_title="Per 100K pop", plot_title="Fertility Rate (2010)", brewer_pal="PuBuGn") ``` -``` -## Warning: `show_guide` has been deprecated. Please use `show.legend` instead. -``` - -``` -## TableGrob (2 x 1) "arrange": 2 grobs -## z cells name grob -## 1 (1-1,1-1) arrange gtable[layout] -## sub 2 (2-2,1-1) arrange text[GRID.text.153] -``` + -```r +``` r # manual - perhaps good for elections? library(httr) library(dplyr) + election_2012 <- GET("https://raw.githubusercontent.com/hrbrmstr/statebins/master/tmp/election2012.csv") -results <- read.csv(textConnection(content(election_2012, as="text")), header=TRUE, stringsAsFactors=FALSE) -results <- results %>% mutate(color=ifelse(is.na(Obama), "#2166ac", "#b2182b")) %>% select(state, color) -results %>% statebins_manual(font_size=4, text_color = "white", labels=c("Romney", "Obama"), legend_position="right", legend_title="Winner") -``` -``` -## Warning: `show_guide` has been deprecated. Please use `show.legend` instead. +read.csv( + textConnection(content(election_2012, as="text")), + header=TRUE, stringsAsFactors=FALSE +) %>% + mutate(color=ifelse(is.na(Obama), "#2166ac", "#b2182b")) %>% + select(state, color) -> results + +statebins_manual( + results, + font_size=4, text_color = "white", + labels=c("Romney", "Obama"), legend_position="right", legend_title="Winner" +) ``` -![](README_files/figure-html/unnamed-chunk-3-1.png) + -```r +``` r # or, more like the one in the WaPo article; i might be picking the wrong columns here. it's just for an example sb <- function(col, title) { - statebins(dat, "state",col, brewer_pal="Blues", text_color="black", legend_position="none", font_size=3, plot_title=title, breaks=4, labels=1:4) + statebins( + adat, "state", col, brewer_pal="Blues", text_color="black", + legend_position="none", font_size=3, plot_title=title, + breaks=4, labels=1:4 + ) } ``` - -```r +``` r # cheating and using to arrange them below and also making a WaPo-like legend, # since mucking with grid graphics margins/padding was not an option time-wise at the moment @@ -195,7 +180,9 @@ sb("avgshare08_12", "2008-2012") ``` + + -
![img](./tmp/statebins-composite.png)
+
+ +![img](./tmp/statebins-composite.png) -And, we'll throw in a gratuitous animation for good measure: +
+And, we’ll throw in a gratuitous animation for good measure: -```r +``` r +library(magick) # data set from StatsAmerica - http://www.statsamerica.org/profiles/sip_index.html # median household income from the ACS survey -miacs <- read.csv("http://dds.ec/data/median-income-acs.csv", header=TRUE, stringsAsFactors=FALSE) +miacs <- read.csv("http://datadrivensecurity.info/data/median-income-acs.csv", + header=TRUE, stringsAsFactors=FALSE) # generate frames based on year -sapply(unique(miacs$year), function(year) { +purrr::map(unique(miacs$year), function(year) { - png(file=sprintf("tmp/household%d.png", year), - type="quartz", antialias="subpixel", width=800, height=600) + cat(".") + + fig <- magick::image_graph(res=144) rng <- floor(range(miacs[miacs$year==year,]$mh_inc)) - ggtmp <- statebins(miacs[miacs$year==year,], "state", "mh_inc", - legend_title="States", legend_position="none", - brewer_pal="Greens", text_color="black", font_size=3, - plot_title=sprintf("Median Household Income (ACS) %d\n$%s - $%s", year, comma(rng[1]), comma(rng[2])), title_position="top") + statebins( + miacs[miacs$year==year,], "state", "mh_inc", + legend_title="States", legend_position="none", + brewer_pal="Greens", text_color="black", font_size=3, + plot_title=sprintf("Median Household Income (ACS) %d\n$%s - $%s", year, + scales::comma(rng[1]), scales::comma(rng[2])), + title_position="top" + ) -> ggtmp print(ggtmp) dev.off() -}) - -# animate them with ImageMagick -system("convert -background white -alpha remove -layers OptimizePlus -delay 150 tmp/*.png -loop 1 tmp/household.gif") -``` - -
![img](./tmp/household.gif)
- -### Test Results - - -```r -library(statebins) -library(testthat) - -date() -``` - -``` -## [1] "Mon Dec 21 08:21:03 2015" + fig + +}) %>% image_join() %>% + image_animate(fps=2, loop=1) ``` -```r -test_dir("tests/") -``` +
-``` -## testthat results ======================================================================================================== -## OK: 0 SKIPPED: 0 FAILED: 0 -``` +![img](./tmp/household.gif) +
diff --git a/man/statebins-package.Rd b/man/statebins-package.Rd index fe597ff..6a4bba4 100644 --- a/man/statebins-package.Rd +++ b/man/statebins-package.Rd @@ -8,6 +8,5 @@ statebins is an alternative to choropleth maps for US States } \author{ -Bob Rudis (@hrbrmstr) +Bob Rudis (bob@rud.is) } - diff --git a/man/statebins.Rd b/man/statebins.Rd index 82cbff1..578e7b4 100644 --- a/man/statebins.Rd +++ b/man/statebins.Rd @@ -76,4 +76,3 @@ statebins(USArrests, value_col="Assault", text_color="black", font_size=3, legend_title = "Assault", legend_position="bottom") } } - diff --git a/man/statebins_continuous.Rd b/man/statebins_continuous.Rd index 560476b..ee80409 100644 --- a/man/statebins_continuous.Rd +++ b/man/statebins_continuous.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/statebins.R +% Please edit documentation in R/statebins-continuous.R \name{statebins_continuous} \alias{statebins_continuous} \title{Create a new ggplot-based "statebin" chart for USA states (continuous scale)} @@ -71,4 +71,3 @@ statebins_continuous(USArrests, value_col="Murder", text_color="black", font_siz legend_title = "Murder", legend_position="bottom") } } - diff --git a/man/statebins_manual.Rd b/man/statebins_manual.Rd index 87d8bba..200924a 100644 --- a/man/statebins_manual.Rd +++ b/man/statebins_manual.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/statebins.R +% Please edit documentation in R/statebins-manual.R \name{statebins_manual} \alias{statebins_manual} \title{Create a new ggplot-based "statebin" chart for USA states (manually colored)} @@ -80,4 +80,3 @@ results \%>\% legend_position="right", legend_title="Winner") } } - diff --git a/tmp/household.gif b/tmp/household.gif index bca4716..c887c93 100644 Binary files a/tmp/household.gif and b/tmp/household.gif differ diff --git a/tmp/household2000.png b/tmp/household2000.png index 823aeef..c18cd00 100644 Binary files a/tmp/household2000.png and b/tmp/household2000.png differ diff --git a/tmp/household2001.png b/tmp/household2001.png index 44bac26..b054f9e 100644 Binary files a/tmp/household2001.png and b/tmp/household2001.png differ diff --git a/tmp/household2002.png b/tmp/household2002.png index 0ca3bda..26a6bd7 100644 Binary files a/tmp/household2002.png and b/tmp/household2002.png differ diff --git a/tmp/household2003.png b/tmp/household2003.png index 1b32d4c..352c39c 100644 Binary files a/tmp/household2003.png and b/tmp/household2003.png differ diff --git a/tmp/household2004.png b/tmp/household2004.png index 97ec0ab..f0c81c4 100644 Binary files a/tmp/household2004.png and b/tmp/household2004.png differ diff --git a/tmp/household2005.png b/tmp/household2005.png index 97505bf..67aba39 100644 Binary files a/tmp/household2005.png and b/tmp/household2005.png differ diff --git a/tmp/household2006.png b/tmp/household2006.png index 55248c6..0425fc8 100644 Binary files a/tmp/household2006.png and b/tmp/household2006.png differ diff --git a/tmp/household2007.png b/tmp/household2007.png index 3a1935e..554a964 100644 Binary files a/tmp/household2007.png and b/tmp/household2007.png differ diff --git a/tmp/household2008.png b/tmp/household2008.png index 8002b18..c3588a0 100644 Binary files a/tmp/household2008.png and b/tmp/household2008.png differ diff --git a/tmp/household2009.png b/tmp/household2009.png index a358d7d..b88b7e4 100644 Binary files a/tmp/household2009.png and b/tmp/household2009.png differ diff --git a/tmp/household2010.png b/tmp/household2010.png index 2c1b06c..8ce5b61 100644 Binary files a/tmp/household2010.png and b/tmp/household2010.png differ diff --git a/tmp/household2011.png b/tmp/household2011.png index 122fcca..4032a46 100644 Binary files a/tmp/household2011.png and b/tmp/household2011.png differ diff --git a/tmp/household2012.png b/tmp/household2012.png index 3d677cc..75d6d83 100644 Binary files a/tmp/household2012.png and b/tmp/household2012.png differ