Skip to content

Commit

Permalink
Consolidate input checks in utility functions
Browse files Browse the repository at this point in the history 
- Add set_tigris_year and check_tigris_year functions to set default year + validate input year parameters
- Add check_tigris_resolution to consolidate checks for resolution parameter
- Add allow_null parameter to validate_state and validate_county
- Reverse prior commit exposing the cb parameter in erase_water
- Pass integer values to sprintf and substr (appears to work fine)
  • Loading branch information
@elipousson
elipousson committed Aug 13, 2023
1 parent 689686f commit 652bcb9
Show file tree
Hide file tree
Showing 14 changed files with 260 additions and 824 deletions.
203 changes: 51 additions & 152 deletions R/enumeration_units.R
View file

Large diffs are not rendered by default.

18 changes: 5 additions & 13 deletions R/helpers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -408,9 +408,7 @@ geo_join <- function(spatial_data, data_frame, by_sp, by_df, by = NULL, how = 'l
#' }
lookup_code <- function(state, county = NULL) {

state <- validate_state(state, .msg=FALSE)

if (is.null(state)) stop("Invalid state", call.=FALSE)
state <- validate_state(state, allow_null = FALSE, .msg = FALSE)

if (!is.null(county)) {

Expand Down Expand Up @@ -460,9 +458,7 @@ tigris_type <- function(obj) {
#' @export
list_counties <- function(state) {

state <- validate_state(state, .msg=FALSE)

if (is.null(state)) stop("Invalid state", call.=FALSE)
state <- validate_state(state, allow_null = FALSE, .msg = FALSE)

vals <- fips_codes[fips_codes$state_code == state, c("county", "county_code")]
vals$county <- gsub("\ County$", "", vals$county)
Expand Down Expand Up @@ -624,7 +620,6 @@ rbind_tigris <- function(...) {
#' for a given location.
#' @param year The year to use for the water layer; defaults to 2021 unless the
#' `tigris_year` option is otherwise set.
#' @inheritParams counties
#' @return An output sf object representing the polygons in `input_sf` with
#' water areas erased.
#' @export
Expand All @@ -647,24 +642,21 @@ rbind_tigris <- function(...) {
#' }
erase_water <- function(input_sf,
area_threshold = 0.75,
year = NULL,
cb = TRUE) {
year = NULL) {

if (!is_sf(input_sf)) {
stop("The input dataset is not an sf object.", call. = FALSE)
}

if (is.null(year)) {
year <- getOption("tigris_year", 2021)
}
year <- set_tigris_year(year, quiet = TRUE)

# Define st_erase function internally
st_erase <- function(x, y) {
suppressWarnings(sf::st_difference(x, sf::st_union(y)))
}

# Grab a dataset of counties that overlap the input sf object quietly
county_overlay <- tigris::counties(cb = cb, resolution = "500k", progress_bar = FALSE,
county_overlay <- tigris::counties(cb = TRUE, resolution = "500k", progress_bar = FALSE,
year = year, filter_by = input_sf) %>%
sf::st_transform(sf::st_crs(input_sf))

Expand Down
46 changes: 5 additions & 41 deletions R/landmarks.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,27 +19,10 @@

military <- function(year = NULL, ...) {

if (is.null(year)) {

year <- getOption("tigris_year", 2021)

message(sprintf("Retrieving data for the year %s", year))

}

if (year < 2011) {

fname <- as.character(match.call())[[1]]

msg <- sprintf("%s is not currently available for years prior to 2011. To request this feature,
file an issue at https://github.com/walkerke/tigris.", fname)

stop(msg, call. = FALSE)

}
year <- set_tigris_year(year)

url <- sprintf("https://www2.census.gov/geo/tiger/TIGER%s/MIL/tl_%s_us_mil.zip",
as.character(year), as.character(year))
year, year)

return(load_tiger(url, tigris_type = "military", ...))

Expand Down Expand Up @@ -77,37 +60,18 @@ military <- function(year = NULL, ...) {
#' @export
landmarks <- function(state, type = "point", year = NULL, ...) {

if (is.null(year)) {

year <- getOption("tigris_year", 2021)

message(sprintf("Retrieving data for the year %s", year))

}

if (year < 2011) {

fname <- as.character(match.call())[[1]]

msg <- sprintf("%s is not currently available for years prior to 2011. To request this feature,
file an issue at https://github.com/walkerke/tigris.", fname)

stop(msg, call. = FALSE)

}
year <- set_tigris_year(year)

state <- validate_state(state)

cyear <- as.character(year)

if (type == "area") {
url <- sprintf("https://www2.census.gov/geo/tiger/TIGER%s/AREALM/tl_%s_%s_arealm.zip",
cyear, cyear, state)
year, year, state)
return(load_tiger(url, tigris_type = "area_landmark", ...))

} else if (type == "point") {
url <- sprintf("https://www2.census.gov/geo/tiger/TIGER%s/POINTLM/tl_%s_%s_pointlm.zip",
cyear, cyear, state)
year, year, state)
return(load_tiger(url, tigris_type = "point_landmark", ...))

} else {
Expand Down
69 changes: 12 additions & 57 deletions R/legislative.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,13 +32,7 @@
#' }
congressional_districts <- function(state = NULL, cb = FALSE, resolution = '500k', year = NULL, ...) {

if (is.null(year)) {

year <- getOption("tigris_year", 2021)

message(sprintf("Retrieving data for the year %s", year))

}
year <- set_tigris_year(year, min_year = 2010)

if (year < 2013 && cb == TRUE) {
stop("`cb = TRUE` for congressional districts is unavailable prior to 2013. Regular TIGER/Line files are available for 2010 through 2010 with `cb = FALSE`",
Expand All @@ -59,33 +53,19 @@ congressional_districts <- function(state = NULL, cb = FALSE, resolution = '500k
congress <- "111"
}

if (year < 2010) {

fname <- as.character(match.call())[[1]]

msg <- sprintf("%s is not currently available for years prior to 2010.", fname)

stop(msg, call. = FALSE)

}

if (!(resolution %in% c('500k', '5m', '20m'))) {
stop("Invalid value for resolution. Valid values are '500k', '5m', and '20m'.", call. = FALSE)
}

cyear <- as.character(year)
check_tigris_resolution(resolution)

if (cb == TRUE) {

url <- sprintf("https://www2.census.gov/geo/tiger/GENZ%s/shp/cb_%s_us_cd%s_%s.zip",
cyear, cyear, congress, resolution)
year, year, congress, resolution)

if (year == 2013) url <- gsub("shp/", "", url)

} else {

url <- sprintf("https://www2.census.gov/geo/tiger/TIGER%s/CD/tl_%s_us_cd%s.zip",
cyear, cyear, congress)
year, year, congress)

}

Expand Down Expand Up @@ -138,25 +118,7 @@ congressional_districts <- function(state = NULL, cb = FALSE, resolution = '500k
#' }
state_legislative_districts <- function(state= NULL, house = "upper",
cb = FALSE, year = NULL, ...) {

if (is.null(year)) {

year <- getOption("tigris_year", 2021)

message(sprintf("Retrieving data for the year %s", year))

}

if (year < 2011) {

fname <- as.character(match.call())[[1]]

msg <- sprintf("%s is not currently available for years prior to 2011. To request this feature,
file an issue at https://github.com/walkerke/tigris.", fname)

stop(msg, call. = FALSE)

}
year <- set_tigris_year(year)

if (is.null(state)) {
if (year > 2018 && cb == TRUE) {
Expand All @@ -167,9 +129,7 @@ state_legislative_districts <- function(state= NULL, house = "upper",
call. = FALSE)
}
} else {
state <- validate_state(state)

if (is.null(state)) stop("Invalid state", call.=FALSE)
state <- validate_state(state, allow_null = FALSE)
}

if (!house %in% c("upper", "lower"))
Expand All @@ -189,9 +149,6 @@ state_legislative_districts <- function(state= NULL, house = "upper",

}

cyear <- as.character(year)


if (cb == TRUE) {

if (year == 2010) {
Expand All @@ -205,18 +162,18 @@ state_legislative_districts <- function(state= NULL, house = "upper",
}

url <- sprintf("https://www2.census.gov/geo/tiger/GENZ%s/shp/cb_%s_%s_%s_500k.zip",
cyear, cyear, state, type)
year, year, state, type)

if (year == 2013) url <- gsub("shp/", "", url)

} else {

if (year %in% c(2000, 2010)) {
url <- sprintf("https://www2.census.gov/geo/tiger/TIGER2010/%s/%s/tl_2010_%s_%s%s.zip",
toupper(type), cyear, state, type, substr(cyear, 3, 4))
toupper(type), year, state, type, substr(year, 3, 4))
} else {
url <- sprintf("https://www2.census.gov/geo/tiger/TIGER%s/%s/tl_%s_%s_%s.zip",
cyear, toupper(type), cyear, state, type)
year, toupper(type), year, state, type)
}

}
Expand Down Expand Up @@ -283,12 +240,10 @@ voting_districts <- function(state = NULL, county = NULL, cb = FALSE, year = 202
call. = FALSE)
}
} else {
state <- validate_state(state)

if (is.null(state)) stop("Invalid state", call.=FALSE)
state <- validate_state(state, allow_null = FALSE)
}

if (cb) {
if (cb == TRUE) {

url <- sprintf("https://www2.census.gov/geo/tiger/GENZ2020/shp/cb_2020_%s_vtd_500k.zip", state)

Expand All @@ -297,7 +252,7 @@ voting_districts <- function(state = NULL, county = NULL, cb = FALSE, year = 202
if (is.null(county)) {
return(vtds)
} else {
county = validate_county(state, county)
county <- validate_county(state, county)
vtds_sub <- vtds[vtds$COUNTYFP20 == county,]
return(vtds_sub)
}
Expand Down
Loading

0 comments on commit 652bcb9

Please sign in to comment.