added stateName arg to maps.

R/get_bls_county.R

@@ -3,6 +3,8 @@
 #' @description Helper function to download and format state employment data. Note: This returns only non-seasonally adjusted data.
 #' @param date_mth The month you would like data for. Accepts full month names and four-digit year.
 #' If NULL, it will return the most recent month in the database.
+#' @param stateName is an optional argument if you only want data for certain state(s). The argument is NULL by default and
+#' will return data for all 50 states.
 #' @importFrom stats na.omit
 #' @importFrom data.table rbindlist
 #' @export get_bls_county
@@ -11,16 +13,24 @@
 #' get_bls_county()
 #' 
 #' # A specific month
-#' get_bls_county("May 2016")
+#' df <- get_bls_county("May 2016")
 #' 
 #' # Multiple months
-#' get_bls_county(c("April 2016","May 2016"))
+#' df <- get_bls_county(c("April 2016","May 2016"))
+#' 
+#' # A specific state
+#' df <- get_bls_county("Florida")
+#' 
+#' # Multiple states, multiple months
+#' df<- get_bls_county(date_mth = "April 2015", 
+#'              stateName = c("Florida", "Alabama"))
 #' }
 #'
 
-get_bls_county <- function(date_mth = NULL){
+get_bls_county <- function(date_mth = NULL, stateName = NULL){
     # Set some dummy variables. This keeps CRAN check happy.
-    countyemp=contyemp=NULL
+    countyemp=contyemp=fips_state=NULL
+    state_fips <- blscrapeR::state_fips
     temp<-tempfile()
     download.file("http://www.bls.gov/lau/laucntycur14.txt", temp)
     countyemp <- read.csv(temp,
@@ -40,6 +50,25 @@ get_bls_county <- function(date_mth = NULL){
     period <- contyemp$period
     countyemp$period <- as.Date(paste("01-", countyemp$period, sep = ""), format = "%d-%b-%y")
 
+    # Check to see if user selected specific state(s).
+    if (!is.null(stateName)){
+        # Check to see if states exists.
+        state_check <- sapply(stateName, function(x) any(grepl(x, state_fips$state)))
+        if(any(state_check==FALSE)){
+            stop(message("Please make sure you state names are spelled correctly using full state names."))
+        }
+        # If state list is valid. Grab State FIPS codes from internal data set and subset countyemp
+        state_rows <- sapply(stateName, function(x) grep(x, state_fips$state))
+        state_selection <- state_fips$fips_state[state_rows]
+        statelist <- list()
+        for (s in as.numeric(state_selection)) {
+            state_vals <- subset(countyemp, fips_state==s)
+            statelist[[s]] <- state_vals
+        }
+
+        countyemp <- data.table::rbindlist(statelist)
+    }
+
     # Check for date or dates.
     if (!is.null(date_mth)){
         date_mth <- as.Date(paste("01", date_mth, sep = ""), format = '%d %b %Y')
@@ -63,6 +92,9 @@ get_bls_county <- function(date_mth = NULL){
     }
 
     # Put months to loop in list.
+    if (is.null(date_mth)){
+        date_mth <- max(countyemp$period)
+    }
     datalist <- list()
     for (i in date_mth) {
         mth_vals <- subset(countyemp, period==i)
@@ -71,14 +103,14 @@ get_bls_county <- function(date_mth = NULL){
     # Rebind.
     df <- data.table::rbindlist(datalist)
     # Correct column data fromats.
-    countyemp$unemployed <- as.numeric(gsub(",", "", as.character(countyemp$unemployed)))
-    countyemp$employed <- as.numeric(gsub(",", "", as.character(countyemp$employed)))
-    countyemp$labor_force <- as.numeric(gsub(",", "", as.character(countyemp$labor_force)))
+    df$unemployed <- as.numeric(gsub(",", "", as.character(df$unemployed)))
+    df$employed <- as.numeric(gsub(",", "", as.character(df$employed)))
+    df$labor_force <- as.numeric(gsub(",", "", as.character(df$labor_force)))
 
     # Get the FIPS code: Have to add leading zeros to any single digit number and combine them.
-    countyemp$fips_county <- formatC(countyemp$fips_county, width = 3, format = "d", flag = "0")
-    countyemp$fips_state <- formatC(countyemp$fips_state, width = 2, format = "d", flag = "0")
-    countyemp$fips=paste(countyemp$fips_state,countyemp$fips_county,sep="")
+    df$fips_county <- formatC(df$fips_county, width = 3, format = "d", flag = "0")
+    df$fips_state <- formatC(df$fips_state, width = 2, format = "d", flag = "0")
+    df$fips <- paste(df$fips_state,df$fips_county,sep="")
 
     return(df)
 }

R/maps.R

@@ -13,8 +13,10 @@
 #' @param map_data Dataframe to be used as the map's measures. Usually a result of 
 #' function calls format_county_data or format_state_data, but other dataframes, 
 #' which include FIPS codes may be used as well.
-#' @param fill_rate Column name from the dataframe that you want to use as a fill value.
-#' @param labtitle The main title label for your map passed as a string. The default is no title
+#' @param fill_rate Column name from the dataframe that you want to use as a fill value, in quotes. NOTE: This argument is mandatory!
+#' @param stateName Optional argument if you only want to map a single state or a group of selected staes. The argument
+#' accepts state full state names in quotes.
+#' @param labtitle The main title label for your map passed as a string. The default is no title.
 #' @examples \dontrun{
 #' # Download the most current month unemployment statistics on a county level.
 #' df <- get_bls_county()
@@ -23,16 +25,46 @@
 #' bls_gg <- bls_map_county(map_data = df, fill_rate = "unemployed_rate", 
 #'                  labtitle = "Unemployment Rate")
 #' bls_gg
+#' 
+#' 
+#' # Map the unemployment rate for Florida and Alabama.
+#' 
+#' df <- get_bls_county(stateName = c("Florida", "Alabama"))
+#' 
+#' bls_gg <- bls_map_county(map_data=df, fill_rate = "unemployed_rate", 
+#' stateName = c("Florida", "Alabama"))
+#' 
+#' bls_gg
 #' }
 #'
 #'
 
-bls_map_county <- function(map_data, fill_rate, labtitle=NULL){
+bls_map_county <- function(map_data, fill_rate=NULL, labtitle=NULL, stateName=NULL){
+    if (is.null(fill_rate)){
+        stop(message("Please specify a fill_rate in double quotes. What colunm in your data frame do you want to map?"))
+    }
     # Set some dummy variables. This keeps CRAN check happy.
     map=long=lat=id=group=county_map_data=NULL
     # Load pre-formatted map for ggplot.
-    map <- county_map_data
+    map <- blscrapeR::county_map_data
     # Unemployment statistics by county: Get and process data.
+    # Check to see if user selected specific state(s).
+    if (!is.null(stateName)){
+        # Get state FIPS from internal dataset.
+        state_fips <- blscrapeR::state_fips
+        # Check to see if states exists.
+        state_check <- sapply(stateName, function(x) any(grepl(x, state_fips$state)))
+        if(any(state_check==FALSE)){
+            stop(message("Please make sure you state names are spelled correctly using full state names."))
+        }
+        # If state list is valid. Grab State FIPS codes from internal data set and subset map.
+        # Add state_id to map frame
+        map$state_id <- substr(map$id, 1,2)
+        state_rows <- sapply(stateName, function(x) grep(x, state_fips$state))
+        state_selection <- state_fips$fips_state[state_rows]
+        statelist <- list()
+        map <- map[(map$state_id %in% state_selection),]
+    }
     # Plot
     ggplot2::ggplot() +
         geom_map(data=map, map=map,
@@ -87,12 +119,15 @@ bls_map_county <- function(map_data, fill_rate, labtitle=NULL){
 #'
 #'
 
-bls_map_state <- function(map_data, fill_rate, labtitle=NULL){
+bls_map_state <- function(map_data, fill_rate=NULL, labtitle=NULL){
+    if (is.null(fill_rate)){
+        stop(message("Please specify a fill_rate in double quotes. What colunm in your data frame do you want to map?"))
+    }
     # Set some dummy variables. This keeps CRAN check happy.
     map=long=lat=id=group=state_map_data=state.name=NULL
     #Maps by County
     #Load pre-formatted map for ggplot.
-    map <- state_map_data
+    map <- blscrapeR::state_map_data
     #Unemployment statistics by county: Get and process data.
     #Plot
     ggplot2::ggplot() +
@@ -115,4 +150,6 @@ bls_map_state <- function(map_data, fill_rate, labtitle=NULL){
               panel.border = element_blank(),
               panel.background = element_blank(),
               legend.title=element_blank())
-}
+}
+
+

data-raw/prep_maps.R

@@ -3,15 +3,16 @@
 # This only needs to be run onece per year, or when the census releases a new shape file.
 
 #library(sp)
-#library(ggplot2)
+#library(broom)
 #library(rgeos)
 #library(rgdal)
 #library(maptools)
 #library(devtools)
+#library(tigris)
 
 # Read county shapefile from Tiger.
 # https://www.census.gov/geo/maps-data/data/cbf/cbf_counties.html
-county <- readOGR(dsn = ".", layer = "cb_2015_us_county_20m")
+county <- tigris::counties(cb = TRUE, year = 2015)
 
 # convert it to  equal area
 us.map <- spTransform(county, CRS("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 
@@ -41,7 +42,7 @@ us.map <- us.map[!us.map$STATEFP %in% c("81", "84", "86", "87", "89", "71", "76"
 us.map <- rbind(us.map, ak, hawi)
 
 # Projuce map
-county_map_data <- fortify(us.map, region="GEOID")
+county_map_data <- broom::tidy(us.map, region="GEOID")
 # Remove helper data and save file. Be sure to remove .Randdom.seed if exists.
 rm(ak, county, hawi, us.map)
 rm(.Random.seed)
@@ -85,7 +86,7 @@ us.map <- us.map[!us.map$STATEFP %in% c("81", "84", "86", "87", "89", "71", "76"
 us.map <- rbind(us.map, ak, hawi)
 
 #Projuce map
-state_map_data <- fortify(us.map, region="GEOID")
+state_map_data <- broom::tidy(us.map, region="GEOID")
 # Remove helper data and save file. Be sure to remove .Randdom.seed if exists.
 rm(ak, state, hawi, us.map)
 rm(.Random.seed)
@@ -94,4 +95,4 @@ devtools::use_data(state_map_data, overwrite = TRUE)
 rm(state_map_data)
 
 
-
+t=plyr::join(tmap, us.map@data, by='id')