Browse Source

1.3.0

pull/11/head
boB Rudis 6 years ago
parent
commit
fb14579eed
No known key found for this signature in database GPG Key ID: 2A514A4997464560
  1. 3
      .Rbuildignore
  2. 40
      DESCRIPTION
  3. 11
      NAMESPACE
  4. 20
      NEWS.md
  5. 27
      R/aaa.R
  6. 105
      R/statebins-continuous.R
  7. 116
      R/statebins-manual.R
  8. 9
      R/statebins-package.R
  9. 293
      R/statebins.R
  10. 33
      R/util.R
  11. 165
      README.Rmd
  12. BIN
      README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-1.png
  13. BIN
      README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-2.png
  14. BIN
      README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-3.png
  15. BIN
      README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-4.png
  16. BIN
      README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-5.png
  17. BIN
      README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-6.png
  18. 284
      README.html
  19. 289
      README.md
  20. 3
      man/statebins-package.Rd
  21. 1
      man/statebins.Rd
  22. 3
      man/statebins_continuous.Rd
  23. 3
      man/statebins_manual.Rd
  24. BIN
      tmp/household.gif
  25. BIN
      tmp/household2000.png
  26. BIN
      tmp/household2001.png
  27. BIN
      tmp/household2002.png
  28. BIN
      tmp/household2003.png
  29. BIN
      tmp/household2004.png
  30. BIN
      tmp/household2005.png
  31. BIN
      tmp/household2006.png
  32. BIN
      tmp/household2007.png
  33. BIN
      tmp/household2008.png
  34. BIN
      tmp/household2009.png
  35. BIN
      tmp/household2010.png
  36. BIN
      tmp/household2011.png
  37. BIN
      tmp/household2012.png

3
.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/.*$

40
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 <bob@rudis.net>
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 <bob@rud.is>
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"
<http://www.washingtonpost.com/wp-srv/special/business/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

11
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)

20
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

27
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))

105
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)
}

116
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)
}

9
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

293
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)
}

33
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)
}

165
README.Rmd

@ -1,14 +1,16 @@
---
title: "statebins"
output:
html_document:
keep_md: true
md_document:
variant: markdown_github
output: rmarkdown::github_document
---
<!-- output: html_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)
```
<center>![img](./tmp/household.gif)</embed></center>
### Test Results
```{r}
library(statebins)
library(testthat)
date()
test_dir("tests/")
```

BIN
README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-1.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 84 KiB

BIN
README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-2.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 87 KiB

BIN
README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-3.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 74 KiB

BIN
README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-4.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 85 KiB

BIN
README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-5.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 84 KiB

BIN
README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-6.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 81 KiB

284
README.html

File diff suppressed because one or more lines are too long

289
README.md

@ -1,191 +1,176 @@
# statebins
<!-- output: html_document -->
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
<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
- 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]
```
<img src="README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-1.png" width="672" />
```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]
```
<img src="README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-2.png" width="672" />
```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]
```
<img src="README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-3.png" width="672" />
```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]
```
<img src="README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-4.png" width="672" />
```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]
```
<img src="README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-5.png" width="672" />
```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)
<img src="README.gfm-ascii_identifiers_files/figure-gfm/unnamed-chunk-3-6.png" width="672" />
```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 <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
@ -195,7 +180,9 @@ sb("avgshare08_12", "2008-2012")
```
<!-- uncomment the following and add backticks where appropriate and remove the reference to -->
<!-- the static image when the rmarkdown output is HTML and this will work fine. github does not render the markdown properly -->
<!--
<span style="font-size:17px; color:#333;">Share of workforce with jobs lost or threatened by trade</span><br/>
@ -227,62 +214,52 @@ sb("avgshare08_12", "2008-2012")
-->
<center>![img](./tmp/statebins-composite.png)</center>
<center>
![img](./tmp/statebins-composite.png)
And, we'll throw in a gratuitous animation for good measure:
</center>
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")
```
<center>![img](./tmp/household.gif)</embed></center>
### 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/")
```
<center>
```
## testthat results ========================================================================================================
## OK: 0 SKIPPED: 0 FAILED: 0
```
![img](./tmp/household.gif)</embed>
</center>

3
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)
}

1
man/statebins.Rd

@ -76,4 +76,3 @@ statebins(USArrests, value_col="Assault", text_color="black", font_size=3,
legend_title = "Assault", legend_position="bottom")
}
}

3
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")
}
}

3
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")
}
}

BIN
tmp/household.gif

Binary file not shown.

Before

Width:  |  Height:  |  Size: 276 KiB

After

Width:  |  Height:  |  Size: 378 KiB

BIN
tmp/household2000.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2001.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2002.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2003.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2004.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2005.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2006.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2007.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2008.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2009.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2010.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2011.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

BIN
tmp/household2012.png

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 33 KiB

Loading…
Cancel
Save