1.2.1 release

hrbrmstr · Jan 30, 2015 · fb67fde · fb67fde
1 parent 8608c46
commit fb67fde
Show file tree

Hide file tree

Showing 32 changed files with 132 additions and 109 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,8 +2,8 @@ Package: statebins
 Type: Package
 Title: statebins - U.S. State Cartogram Heatmaps in R; an alternative to
     choropleth maps for USA States
-Version: 1.1
-Date: 2014-08-29
+Version: 1.2.1
+Date: 2015-01-30
 Author: Bob Rudis (@hrbrmstr)
 Maintainer: Bob Rudis <[email protected]>
 Description: statebins is an alternative to choropleth maps for USA States and
@@ -22,6 +22,6 @@ Depends:
     R (>= 3.0.0),
     ggplot2,
     grid,
-    scales,
     gridExtra,
+    scales,
     RColorBrewer
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,4 +1,4 @@
-# Generated by roxygen2 (4.0.1): do not edit by hand
+# Generated by roxygen2 (4.1.0): do not edit by hand
 
 export(statebins)
 export(statebins_continuous)

diff --git a/R/statebins.R b/R/statebins.R
@@ -2,7 +2,8 @@ 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"),
+                                          "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",
@@ -12,16 +13,17 @@ state_coords <- structure(list(abbrev = c("AL", "AK", "AZ", "AR", "CA", "CO",
                                          "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"),
+                                         "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),
+                                       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)),
-                          .Names = c("abbrev", "state", "col", "row"), class = "data.frame", row.names = c(NA, -51L))
+                                       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") {
@@ -47,7 +49,7 @@ invert <- function(hexColor, darkColor="black", lightColor="white") {
 #' 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} or a column of state names (standard capitalization) named \code{state}
+#'   \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}
 #' }
 #'
@@ -89,20 +91,25 @@ statebins <- function(state_data, state_col="state", value_col="value",
                      legend_title="Legend", legend_position="top",
                      brewer_pal="PuBu", plot_title="", title_position="bottom") {
 
-  stopifnot(breaks > 0 && breaks < 10)
-  stopifnot(title_position %in% c("", "top", "bottom"))
-  stopifnot(legend_position %in% c("", "none", "left", "right", "top", "bottom"))
+  if (breaks <= 0 | breaks >= 10) {
+    stop("'breaks' must be between 0 & 10")
+  }
+
+  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"
   }
 
-  stopifnot(state_data[,state_col] %in% state_coords[,merge.x])
-  stopifnot(!any(duplicated(state_data[,state_col])))
+  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)
+  st.dat <- merge(state_coords, state_data, by.x=merge.x, by.y=state_col, all.y=TRUE)
 
   st.dat$fill_color <- cut(st.dat[, value_col], breaks=breaks, labels=labels)
 
@@ -147,7 +154,7 @@ statebins <- function(state_data, state_col="state", value_col="value",
 #' 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}) or a column of state names (standard capitalization) named \code{state}
+#'   \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}
 #' }
 #'
@@ -187,19 +194,25 @@ statebins_continuous <- function(state_data, state_col="state", value_col="value
                       legend_title="Legend", legend_position="top",
                       brewer_pal="PuBu", plot_title="", title_position="bottom") {
 
-  stopifnot(title_position %in% c("", "top", "bottom"))
-  stopifnot(legend_position %in% c("", "none", "top", "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"
   }
 
-  stopifnot(state_data[,state_col] %in% state_coords[,merge.x])
-  stopifnot(!any(duplicated(state_data[,state_col])))
+  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)
+  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))
@@ -242,7 +255,7 @@ statebins_continuous <- function(state_data, state_col="state", value_col="value
 #' 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} or a column of state names (standard capitalization) named \code{state}
+#'   \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}
 #' }
 #'
@@ -284,18 +297,21 @@ statebins_manual <- function(state_data, state_col="state", color_col="color",
                              legend_title="Legend", legend_position="top",
                              plot_title="", title_position="bottom") {
 
-  stopifnot(title_position %in% c("", "top", "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"
   }
 
-  stopifnot(state_data[,state_col] %in% state_coords[,merge.x])
-  stopifnot(!any(duplicated(state_data[,state_col])))
+  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)
+  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"))
@@ -332,4 +348,26 @@ statebins_manual <- function(state_data, state_col="state", color_col="color",
 
 }
 
+# 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
@@ -1,7 +1,7 @@
 ---
 title: "README"
 author: "Bob Rudis"
-date: August 29, 2014
+date: January 30, 2015
 output:
   md_document:
     variant: markdown_github
@@ -23,6 +23,7 @@ The following functions are implemented:
 
 ### News
 
+- 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
 - 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
 
@@ -76,6 +77,19 @@ gg3 <- statebins_continuous(dat, "state", "avgshare08_12",
 
 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")
+statebins_continuous(dat, "state", "death_rate", legend_title="Per 100K pop",
+                    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")
+
 # manual - perhaps good for elections?
 
 library(httr)

diff --git a/README.md b/README.md
@@ -1,5 +1,4 @@
 <!-- output: html_document -->
-
 statebins - U.S. State Cartogram Heatmaps in R; an alternative to choropleth maps for USA States
 
 The following functions are implemented:
@@ -15,29 +14,30 @@ The following functions are implemented:
 
 ### News
 
+-   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
 -   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
 
-``` {.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).
 
-``` {.r}
+``` r
 library(statebins)
 
 # current verison
 packageVersion("statebins")
 ```
 
-    ## [1] '1.0'
+    ## [1] '1.2'
 
-``` {.r}
+``` r
 # 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)
@@ -51,9 +51,9 @@ gg <- statebins(dat, "state", "avgshare94_00", breaks=4,
 gg
 ```
 
-![plot of chunk unnamed-chunk-3](./README_files/figure-markdown_github/unnamed-chunk-31.png)
+![](README_files/figure-markdown_github/unnamed-chunk-3-1.png)
 
-``` {.r}
+``` r
 # continuous scale, legend on top
 
 gg2 <- statebins_continuous(dat, "state", "avgshare01_07",
@@ -64,9 +64,9 @@ gg2 <- statebins_continuous(dat, "state", "avgshare01_07",
 gg2
 ```
 
-![plot of chunk unnamed-chunk-3](./README_files/figure-markdown_github/unnamed-chunk-32.png)
+![](README_files/figure-markdown_github/unnamed-chunk-3-2.png)
 
-``` {.r}
+``` r
 # continuous scale, no legend
 
 gg3 <- statebins_continuous(dat, "state", "avgshare08_12",
@@ -77,9 +77,30 @@ gg3 <- statebins_continuous(dat, "state", "avgshare08_12",
 gg3
 ```
 
-![plot of chunk unnamed-chunk-3](./README_files/figure-markdown_github/unnamed-chunk-33.png)
+![](README_files/figure-markdown_github/unnamed-chunk-3-3.png)
+
+``` 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)")
+```
 
-``` {.r}
+![](README_files/figure-markdown_github/unnamed-chunk-3-4.png)
+
+``` 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")
+```
+
+![](README_files/figure-markdown_github/unnamed-chunk-3-5.png)
+
+``` r
 # manual - perhaps good for elections?
 
 library(httr)
@@ -90,17 +111,17 @@ results <- results %>% mutate(color=ifelse(is.na(Obama), "#2166ac", "#b2182b"))
 results %>% statebins_manual(font_size=4, text_color = "white", labels=c("Romney", "Obama"), legend_position="right", legend_title="Winner")
 ```
 
-![plot of chunk unnamed-chunk-3](./README_files/figure-markdown_github/unnamed-chunk-34.png)
+![](README_files/figure-markdown_github/unnamed-chunk-3-6.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)
 }
 ```
 
-``` {.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
 
@@ -141,14 +162,12 @@ sb("avgshare08_12", "2008-2012")
 </td><td width="50%"> &nbsp; </td></tr></table>
 
 -->
-
 <center>
 ![img](./tmp/statebins-composite.png)
 </center>
-
 And, we'll throw in a gratuitous animation for good measure:
 
-``` {.r}
+``` r
 # data set from StatsAmerica - http://www.statsamerica.org/profiles/sip_index.html
 
 # median household income from the ACS survey
@@ -179,20 +198,20 @@ system("convert -background white -alpha remove -layers OptimizePlus -delay 150
 
 <center>
 ![img](./tmp/household.gif)
-</embed></center>
-
+</embed>
+</center>
 ### Test Results
 
-``` {.r}
+``` r
 library(statebins)
 library(testthat)
 
 date()
 ```
 
-    ## [1] "Fri Aug 29 12:38:53 2014"
+    ## [1] "Fri Jan 30 05:36:28 2015"
 
-``` {.r}
+``` r
 test_dir("tests/")
 ```
 

diff --git a/README_files/figure-markdown_github/unnamed-chunk-3-1.png b/README_files/figure-markdown_github/unnamed-chunk-3-1.png
diff --git a/README_files/figure-markdown_github/unnamed-chunk-3-2.png b/README_files/figure-markdown_github/unnamed-chunk-3-2.png
diff --git a/README_files/figure-markdown_github/unnamed-chunk-3-3.png b/README_files/figure-markdown_github/unnamed-chunk-3-3.png
diff --git a/README_files/figure-markdown_github/unnamed-chunk-3-4.png b/README_files/figure-markdown_github/unnamed-chunk-3-4.png
diff --git a/README_files/figure-markdown_github/unnamed-chunk-3-5.png b/README_files/figure-markdown_github/unnamed-chunk-3-5.png
diff --git a/README_files/figure-markdown_github/unnamed-chunk-3-6.png b/README_files/figure-markdown_github/unnamed-chunk-3-6.png