Skip to content

Commit 69d093a

Browse files
chris-prenerchris-prener
committed
fail elegantly when tidycensus is offline
1 parent db88906 commit 69d093a

5 files changed

Lines changed: 178 additions & 113 deletions

File tree

‎R/zi_aggregate.R‎

Lines changed: 94 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -89,6 +89,10 @@ zi_aggregate <- function(.data, year, extensive = NULL, intensive = NULL,
8989
output = "tidy", zcta = NULL, key = NULL){
9090

9191
# evaluate inputs
92+
# if (is.null(.data)){
93+
# stop("The '.data' object provided is NULL. Please provide a dataframe.")
94+
# }
95+
9296
if (missing(year)){
9397
stop("The 'year' value is missing. Please provide a numeric value between 2010 and 2022.")
9498
}
@@ -192,7 +196,11 @@ zi_aggregate <- function(.data, year, extensive = NULL, intensive = NULL,
192196
weights <- zi_census_weights(year = year, key = key)
193197

194198
## aggregate
195-
out <- zi_census_intensive(.data, weights = weights, method = intensive_method)
199+
if (!is.null(weights)){
200+
out <- zi_census_intensive(.data, weights = weights, method = intensive_method)
201+
} else {
202+
out <- NULL
203+
}
196204

197205
} else if (extensive_id == TRUE & intensive_id == TRUE){
198206

@@ -203,13 +211,17 @@ zi_aggregate <- function(.data, year, extensive = NULL, intensive = NULL,
203211
## calculate weights
204212
weights <- zi_census_weights(year = year, key = key)
205213

206-
## aggregate
207-
extensive_df <- zi_census_extensive(extensive_df)
208-
intensive_df <- zi_census_intensive(intensive_df, weights = weights, method = intensive_method)
214+
if (!is.null(weights)){
215+
## aggregate
216+
extensive_df <- zi_census_extensive(extensive_df)
217+
intensive_df <- zi_census_intensive(intensive_df, weights = weights, method = intensive_method)
209218

210-
## combine
211-
out <- dplyr::bind_rows(extensive_df, intensive_df)
212-
out <- dplyr::arrange(out, ZCTA3, variable)
219+
## combine
220+
out <- dplyr::bind_rows(extensive_df, intensive_df)
221+
out <- dplyr::arrange(out, ZCTA3, variable)
222+
} else {
223+
out <- NULL
224+
}
213225

214226
}
215227

@@ -227,7 +239,11 @@ zi_aggregate <- function(.data, year, extensive = NULL, intensive = NULL,
227239
weights <- zi_acs_weights(year = year, survey = survey, key = key)
228240

229241
## aggregate
230-
out <- zi_acs_intensive(.data, weights = weights, method = intensive_method)
242+
if (!is.null(weights)){
243+
out <- zi_acs_intensive(.data, weights = weights, method = intensive_method)
244+
} else {
245+
out <- NULL
246+
}
231247

232248
} else if (extensive_id == TRUE & intensive_id == TRUE){
233249

@@ -238,43 +254,47 @@ zi_aggregate <- function(.data, year, extensive = NULL, intensive = NULL,
238254
## calculate weights
239255
weights <- zi_acs_weights(year = year, survey = survey, key = key)
240256

241-
## aggregate
242-
extensive_df <- zi_acs_extensive(extensive_df)
243-
intensive_df <- zi_acs_intensive(intensive_df, weights = weights, method = intensive_method)
244-
245-
## combine
246-
out <- dplyr::bind_rows(extensive_df, intensive_df)
247-
out <- dplyr::arrange(out, ZCTA3, variable)
248-
257+
if (!is.null(weights)){
258+
## aggregate
259+
extensive_df <- zi_acs_extensive(extensive_df)
260+
intensive_df <- zi_acs_intensive(intensive_df, weights = weights, method = intensive_method)
261+
262+
## combine
263+
out <- dplyr::bind_rows(extensive_df, intensive_df)
264+
out <- dplyr::arrange(out, ZCTA3, variable)
265+
} else {
266+
out <- NULL
267+
}
249268
}
250269

251270
}
252271

253-
# optionally subset
254-
255-
if (is.null(zcta) == FALSE){
256-
out <- dplyr::filter(out, ZCTA3 %in% zcta == TRUE)
257-
}
272+
if (!is.null(out)){
273+
# optionally subset
274+
if (is.null(zcta) == FALSE){
275+
out <- dplyr::filter(out, ZCTA3 %in% zcta == TRUE)
276+
}
258277

259-
# optionally pivot
260-
if (output == "wide"){
278+
# optionally pivot
279+
if (output == "wide"){
261280

262-
## prep names
263-
out <- dplyr::rename(out, "E" = "estimate", "M" = "moe")
281+
## prep names
282+
out <- dplyr::rename(out, "E" = "estimate", "M" = "moe")
264283

265-
## pivot
266-
out <- tidyr::pivot_wider(out, id_cols = "ZCTA3", names_from = "variable",
267-
names_glue = "{variable}{.value}",
268-
values_from = c("E", "M"))
284+
## pivot
285+
out <- tidyr::pivot_wider(out, id_cols = "ZCTA3", names_from = "variable",
286+
names_glue = "{variable}{.value}",
287+
values_from = c("E", "M"))
269288

270-
## re-order names alphabetically
271-
wide_names <- names(out)
272-
wide_names <- wide_names[wide_names != "ZCTA3"]
273-
wide_names <- c("ZCTA3", sort(wide_names))
289+
## re-order names alphabetically
290+
wide_names <- names(out)
291+
wide_names <- wide_names[wide_names != "ZCTA3"]
292+
wide_names <- c("ZCTA3", sort(wide_names))
274293

275-
## re-order columns alphabetically
276-
out <- dplyr::select(out, wide_names)
294+
## re-order columns alphabetically
295+
out <- dplyr::select(out, wide_names)
277296

297+
}
278298
}
279299

280300
# return output
@@ -332,32 +352,29 @@ zi_census_weights <- function(year, key){
332352
GEOID = NAME = ZCTA3 = total_pop = value = weight = NULL
333353

334354
## call get_decennial
335-
out <- suppressMessages(
336-
tidycensus::get_decennial(
337-
geography = "zcta",
338-
variables = "P001001",
339-
year = year,
340-
output = "tidy",
341-
key = key
342-
))
343-
344-
## prep data
345-
out <- dplyr::mutate(out, ZCTA3 = substr(GEOID, 1, 3), .before = GEOID)
346-
out <- dplyr::select(out, -NAME)
347-
out <- dplyr::arrange(out, ZCTA3)
355+
out <- zi_get_decennial(geography = "zcta", variables = "P001001",
356+
table = NULL, year = year, output = "tidy",
357+
survey = NULL, key = key)
348358

349-
## group by and sum
350-
totals <- dplyr::group_by(out, ZCTA3)
351-
totals <- dplyr::summarise(totals, total_pop = sum(value, na.rm = TRUE))
359+
if (!is.null(out)){
360+
## prep data
361+
out <- dplyr::mutate(out, ZCTA3 = substr(GEOID, 1, 3), .before = GEOID)
362+
out <- dplyr::select(out, -NAME)
363+
out <- dplyr::arrange(out, ZCTA3)
352364

353-
## join
354-
out <- dplyr::left_join(out, totals, by = "ZCTA3")
365+
## group by and sum
366+
totals <- dplyr::group_by(out, ZCTA3)
367+
totals <- dplyr::summarise(totals, total_pop = sum(value, na.rm = TRUE))
355368

356-
## calculate proportions
357-
out <- dplyr::mutate(out, weight = value/total_pop)
369+
## join
370+
out <- dplyr::left_join(out, totals, by = "ZCTA3")
358371

359-
## subset
360-
out <- dplyr::select(out, ZCTA3, weight)
372+
## calculate proportions
373+
out <- dplyr::mutate(out, weight = value/total_pop)
374+
375+
## subset
376+
out <- dplyr::select(out, ZCTA3, weight)
377+
}
361378

362379
## return output
363380
return(out)
@@ -424,33 +441,30 @@ zi_acs_weights <- function(year, survey, key){
424441
GEOID = NAME = ZCTA3 = total_pop = estimate = weight = NULL
425442

426443
## call get_acs
427-
out <- suppressMessages(
428-
tidycensus::get_acs(
429-
geography = "zcta",
430-
variables = "B01003_001",
431-
year = year, output = "tidy",
432-
survey = survey,
433-
key = key
434-
))
435-
436-
## prep data
437-
out <- dplyr::mutate(out, GEOID = stringr::word(NAME, 2))
438-
out <- dplyr::mutate(out, ZCTA3 = substr(GEOID, 1, 3), .before = GEOID)
439-
out <- dplyr::select(out, -NAME)
440-
out <- dplyr::arrange(out, ZCTA3)
444+
out <- zi_get_acs(geography = "zcta", variables = "B01003_001",
445+
table = NULL, year = year, output = "tidy",
446+
survey = survey, key = key)
441447

442-
## group by and sum
443-
totals <- dplyr::group_by(out, ZCTA3)
444-
totals <- dplyr::summarise(totals, total_pop = sum(estimate, na.rm = TRUE))
448+
if (!is.null(out)){
449+
## prep data
450+
out <- dplyr::mutate(out, GEOID = stringr::word(NAME, 2))
451+
out <- dplyr::mutate(out, ZCTA3 = substr(GEOID, 1, 3), .before = GEOID)
452+
out <- dplyr::select(out, -NAME)
453+
out <- dplyr::arrange(out, ZCTA3)
445454

446-
## join
447-
out <- dplyr::left_join(out, totals, by = "ZCTA3")
455+
## group by and sum
456+
totals <- dplyr::group_by(out, ZCTA3)
457+
totals <- dplyr::summarise(totals, total_pop = sum(estimate, na.rm = TRUE))
448458

449-
## calculate proportions
450-
out <- dplyr::mutate(out, weight = estimate/total_pop)
459+
## join
460+
out <- dplyr::left_join(out, totals, by = "ZCTA3")
451461

452-
## subset
453-
out <- dplyr::select(out, ZCTA3, weight)
462+
## calculate proportions
463+
out <- dplyr::mutate(out, weight = estimate/total_pop)
464+
465+
## subset
466+
out <- dplyr::select(out, ZCTA3, weight)
467+
}
454468

455469
## return output
456470
return(out)

‎R/zi_crosswalk.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -236,13 +236,13 @@ zi_crosswalk <- function(.data, input_var, zip_source = "UDS", source_var,
236236
dict <- zip_source
237237

238238
if (return == "id"){
239-
dict <- dplyr::select(dict, source_varQN, source_resultQN)
239+
dict <- dplyr::select(dict, dplyr::all_of(source_varQN), dplyr::all_of(source_resultQN))
240240

241241
source_new_result <- paste0("source_", source_resultQN)
242242
names(dict)[names(dict) == source_resultQN] <- source_new_result
243243

244244
} else if (return == "all"){
245-
dict <- dplyr::select(dict, source_varQN, source_resultQN, dplyr::everything())
245+
dict <- dplyr::select(dict, dplyr::all_of(source_varQN), dplyr::all_of(source_resultQN), dplyr::everything())
246246
}
247247
}
248248

‎R/zi_get_demographics.R‎

Lines changed: 18 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -109,29 +109,34 @@ zi_get_demographics <- function(year, variables = NULL,
109109
if (survey %in% c("sf1", "sf3")){
110110

111111
## call get_decennial
112-
out <- suppressMessages(tidycensus::get_decennial(geography = "zcta", variables = variables,
113-
table = table, year = year, output = output,
114-
sumfile = survey, key = key))
112+
out <- zi_get_decennial(geography = "zcta", variables = variables,
113+
table = table, year = year, output = output,
114+
survey = survey, key = key)
115115

116116
} else if (survey %in% c("acs1", "acs3", "acs5")){
117117

118118
## call get_acs
119-
out <- suppressMessages(tidycensus::get_acs(geography = "zcta", variables = variables,
120-
table = table, year = year, output = output,
121-
survey = survey, key = key))
119+
out <- zi_get_acs(geography = "zcta", variables = variables,
120+
table = table, year = year, output = output,
121+
survey = survey, key = key)
122122

123123
## prep data
124-
out <- dplyr::mutate(out, GEOID = stringr::word(NAME, 2))
124+
if (!is.null(out)){
125+
out <- dplyr::mutate(out, GEOID = stringr::word(NAME, 2))
126+
}
125127

126128
}
127129

128-
## remove additional cols and re-arrange
129-
out <- dplyr::select(out, -NAME)
130-
out <- dplyr::arrange(out, GEOID)
130+
# tidy if data are returned
131+
if(!is.null(out)){
132+
## remove additional cols and re-arrange
133+
out <- dplyr::select(out, -NAME)
134+
out <- dplyr::arrange(out, GEOID)
131135

132-
# optionally subset
133-
if (is.null(zcta) == FALSE){
134-
out <- dplyr::filter(out, GEOID %in% zcta == TRUE)
136+
## optionally subset
137+
if (is.null(zcta) == FALSE){
138+
out <- dplyr::filter(out, GEOID %in% zcta == TRUE)
139+
}
135140
}
136141

137142
# return output

‎R/zi_get_geometry.R‎

Lines changed: 0 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -579,23 +579,5 @@ zi_validate_starts <- function(x){
579579

580580
}
581581

582-
zi_get_tigris <- function(.f, year, state, cb){
583582

584-
## attempt to use tigris
585-
out <- try(
586-
suppressWarnings(
587-
do.call(what = eval(parse(text = paste0("tigris::", .f))), args = list(year = year, state = state, cb = cb))
588-
),
589-
silent = TRUE
590-
)
591-
592-
if (inherits(out, what = "try-error")){
593-
cli::cli_inform(message = c("x" = "Errors occurred while attempting to download data from the Census Bureau FTP Server. Returning {.code NULL} instead."))
594-
595-
out <- NULL
596-
}
597-
598-
return(out)
599-
600-
}
601583

‎R/zi_utils.R‎

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,67 @@
1+
zi_get_tigris <- function(.f, year, state, cb){
2+
3+
## attempt to use tigris
4+
out <- try(
5+
suppressWarnings(
6+
do.call(what = eval(parse(text = paste0("tigris::", .f))), args = list(year = year, state = state, cb = cb))
7+
),
8+
silent = TRUE
9+
)
10+
11+
if (inherits(out, what = "try-error")){
12+
cli::cli_inform(message = c("x" = "Errors occurred while attempting to download data from the Census Bureau FTP Server. Returning {.code NULL} instead."))
13+
14+
out <- NULL
15+
}
16+
17+
return(out)
18+
19+
}
20+
21+
zi_get_decennial <- function(geography, variables, table, year, output, survey, key){
22+
23+
## attempt to use tidycensus
24+
out <- try(
25+
suppressWarnings(suppressMessages(
26+
tidycensus::get_decennial(geography = geography, variables = variables,
27+
table = table, year = year, output = output,
28+
sumfile = survey, key = key)
29+
)),
30+
silent = TRUE
31+
)
32+
33+
if (inherits(out, what = "try-error")){
34+
cli::cli_inform(message = c("x" = "Errors occurred while attempting to download data from the Census Bureau API. Returning {.code NULL} instead."))
35+
36+
out <- NULL
37+
}
38+
39+
return(out)
40+
41+
}
42+
43+
zi_get_acs <- function(geography, variables, table, year, output, survey, key){
44+
45+
## attempt to use tidycensus
46+
out <- try(
47+
suppressWarnings(suppressMessages(
48+
tidycensus::get_acs(geography = geography, variables = variables,
49+
table = table, year = year, output = output,
50+
survey = survey, key = key)
51+
)),
52+
silent = TRUE
53+
)
54+
55+
if (inherits(out, what = "try-error")){
56+
cli::cli_inform(message = c("x" = "Errors occurred while attempting to download data from the Census Bureau API. Returning {.code NULL} instead."))
57+
58+
out <- NULL
59+
}
60+
61+
return(out)
62+
63+
}
64+
165
# these are all functions from the tigris package that are not exported
266
# https://github.com/walkerke/tigris/blob/master/R/utils.R
367
# used based on terms of the MIT License used by the package's author, Kyle Walker

0 commit comments

Comments
 (0)