Nothing
# Processing Function for SVI #####
dep_process_svi <- function(.data, style, geography, year, survey,
keep_subscales, keep_components, return_percentiles,
multi_svi, debug){
## subscale creation
if ("warnings" %in% debug){
if (keep_components){
pri <- dep_process_svi_pri(.data, style = style, geography = geography,
year = year, survey = survey)
}
theme1 <- dep_process_svi_ses(.data, style = style, geography = geography,
year = year,survey = survey, keep_components = keep_components)
theme2 <- dep_process_svi_hhd(.data, style = style, geography = geography, year = year,
survey = survey, keep_components = keep_components)
theme3 <- dep_process_svi_msl(.data, style = style, geography = geography, year = year,
survey = survey, keep_components = keep_components)
theme4 <- dep_process_svi_htt(.data, style = style, geography = geography, year = year,
survey = survey, keep_components = keep_components)
} else if (!("warnings" %in% debug)){
if (keep_components){
pri <- suppressWarnings(dep_process_svi_pri(.data, style = style, geography = geography, year = year,
survey = survey))
}
theme1 <- suppressWarnings(dep_process_svi_ses(.data, style = style, geography = geography, year = year,
survey = survey, keep_components = keep_components))
theme2 <- suppressWarnings(dep_process_svi_hhd(.data, style = style, geography = geography, year = year,
survey = survey, keep_components = keep_components))
theme3 <- suppressWarnings(dep_process_svi_msl(.data, style = style, geography = geography, year = year,
survey = survey, keep_components = keep_components))
theme4 <- suppressWarnings(dep_process_svi_htt(.data, style = style, geography = geography, year = year,
survey = survey, keep_components = keep_components))
}
## combine subscales
if (keep_components){
out <- merge(x = pri, y = theme1, by = "GEOID", all.x = TRUE)
out <- merge(x = out, y = theme2, by = "GEOID", all.x = TRUE)
} else if (!keep_components){
out <- merge(x = theme1, y = theme2, by = "GEOID", all.x = TRUE)
}
out <- merge(x = out, y = theme3, by = "GEOID", all.x = TRUE)
out <- merge(x = out, y = theme4, by = "GEOID", all.x = TRUE)
## calculate svi
out$SPL_THEMES <- out$SPL_THEME1 + out$SPL_THEME2 + out$SPL_THEME3 + out$SPL_THEME4
## calculate svi percentile
out$SVI <- dep_percent_rank(out$SPL_THEMES)
if (return_percentiles){
out$SVI <- out$SVI*100
}
## format output
final_vars <- c("GEOID", "SVI", "SVI_SES", "SVI_HCD", "SVI_MSL", "SVI_HTT")
if (!keep_components){
if (!keep_subscales){
out <- subset(out, select = c("GEOID", "SVI"))
} else if (keep_subscales){
out <- subset(out, select = final_vars)
if (return_percentiles){
out$SVI_SES <- out$SVI_SES*100
out$SVI_HCD <- out$SVI_HCD*100
out$SVI_MSL <- out$SVI_MSL*100
out$SVI_HTT <- out$SVI_HTT*100
}
}
} else if (keep_components){
## store other variable names in vector
other_vars <- names(out)[!(names(out) %in% final_vars)]
## combine with final variable vector
final_vars <- c(final_vars, other_vars)
## subset
out <- subset(out, select = final_vars)
}
## create unique variable names
if (multi_svi){
## get year of style to create postfix
if (style != "svi20s"){
post <- paste0("_",substr(style, 4, 5))
} else if (style == "svi20s"){
post <- paste0("_",toupper(substr(style, 4, 6)))
}
## update columns that need to remain unique with postfix
names(out)[names(out) == "SVI"] <- paste0("SVI", post)
if (keep_subscales){
names(out)[names(out) == "SVI_SES"] <- paste0("SVI_SES", post)
names(out)[names(out) == "SVI_HTT"] <- paste0("SVI_HTT", post)
if (style %in% c("svi20", "svi20s")){
names(out)[names(out) == "SVI_HCD"] <- paste0("SVI_HOU", post)
names(out)[names(out) == "SVI_MSL"] <- paste0("SVI_REM", post)
} else if (style %in% c("svi10", "svi14")){
names(out)[names(out) == "SVI_HCD"] <- paste0("SVI_HCD", post)
names(out)[names(out) == "SVI_MSL"] <- paste0("SVI_MSL", post)
}
}
if (keep_components){
names(out)[names(out) == "SP_THEME1"] <- paste0("SP_THEME1", post)
names(out)[names(out) == "SP_THEME2"] <- paste0("SP_THEME2", post)
names(out)[names(out) == "SP_THEME3"] <- paste0("SP_THEME3", post)
names(out)[names(out) == "SP_THEME4"] <- paste0("SP_THEME4", post)
names(out)[names(out) == "SP_THEMES"] <- paste0("SP_THEMES", post)
}
} else if (!multi_svi){
if (style %in% c("svi20", "svi20s") & keep_subscales){
names(out)[names(out) == "SVI_HCD"] <- "SVI_HOU"
names(out)[names(out) == "SVI_MSL"] <- "SVI_REM"
}
}
## return output
return(out)
}
### svi, primary variables
dep_process_svi_pri <- function(.data, style, geography, year, survey){
## create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", pri"),
year = year, survey = survey)
varlist <- c("GEOID", varlist)
## subset
.data <- subset(.data, select = varlist)
## rename components
names(.data)[names(.data) == "S1101_C01_001E"] <- "E_HH"
names(.data)[names(.data) == "S1101_C01_001M"] <- "M_HH"
names(.data)[names(.data) == "DP04_0001E"] <- "E_HU"
names(.data)[names(.data) == "DP04_0001M"] <- "M_HU"
names(.data)[names(.data) == "S0101_C01_001E"] <- "E_TOTPOP"
names(.data)[names(.data) == "S0101_C01_001M"] <- "M_TOTPOP"
## update output order
.data <- subset(.data, select = c(GEOID, E_TOTPOP, M_TOTPOP,
E_HU, M_HU, E_HH, M_HH))
## return output
return(.data)
}
### svi, ses variables
dep_process_svi_ses <- function(.data, style, geography, year, survey, keep_components){
## create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", ses"),
year = year, survey = survey)
varlist <- c("GEOID", varlist)
## subset
out <- subset(.data, select = varlist)
## rename components
if (year < 2015){
names(out)[names(out) == "B15002_001E"] <- "D_NOHSDP"
names(out)[names(out) == "B15002_001M"] <- "DM_NOHSDP"
} else if (year >= 2015){
names(out)[names(out) == "S1501_C01_006E"] <- "D_NOHSDP"
names(out)[names(out) == "S1501_C01_006M"] <- "DM_NOHSDP"
}
names(out)[names(out) == "DP03_0003E"] <- "D_UNEMP"
names(out)[names(out) == "DP03_0003M"] <- "DM_UNEMP"
names(out)[names(out) == "DP03_0005E"] <- "E_UNEMP"
names(out)[names(out) == "DP03_0005M"] <- "M_UNEMP"
if (style %in% c("svi10", "svi14")){
names(out)[names(out) == "B17001_001E"] <- "D_POV"
names(out)[names(out) == "B17001_001M"] <- "DM_POV"
names(out)[names(out) == "B17001_002E"] <- "E_POV"
names(out)[names(out) == "B17001_002M"] <- "M_POV"
names(out)[names(out) == "B19301_001E"] <- "E_PCI"
names(out)[names(out) == "B19301_001M"] <- "M_PCI"
} else if (style %in% c("svi20", "svi20s")){
names(out)[names(out) == "S1701_C01_001E"] <- "D_POV150"
names(out)[names(out) == "S1701_C01_001M"] <- "DM_POV150"
names(out)[names(out) == "S2503_C01_001E"] <- "D_HBURD"
names(out)[names(out) == "S2503_C01_001M"] <- "DM_HBURD"
names(out)[names(out) == "S2701_C01_001E"] <- "D_UNINSUR"
names(out)[names(out) == "S2701_C01_001M"] <- "DM_UNINSUR"
if (year < 2015){
names(out)[names(out) == "S1701_C01_036E"] <- "E_POV150"
names(out)[names(out) == "S1701_C01_036M"] <- "M_POV150"
if (year == 2012){
names(out)[names(out) == "S2701_C02_001E"] <- "E_UNINSUR"
names(out)[names(out) == "S2701_C02_001M"] <- "M_UNINSUR"
} else if (year %in% c(2013, 2014)){
names(out)[names(out) == "S2701_C04_062E"] <- "E_UNINSUR"
names(out)[names(out) == "S2701_C04_062M"] <- "M_UNINSUR"
}
} else if (year >= 2015){
names(out)[names(out) == "S1701_C01_040E"] <- "E_POV150"
names(out)[names(out) == "S1701_C01_040M"] <- "M_POV150"
names(out)[names(out) == "S2701_C04_001E"] <- "E_UNINSUR"
names(out)[names(out) == "S2701_C04_001M"] <- "M_UNINSUR"
}
}
## calculate components
if (year < 2015){
### create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", edu"),
year = year, survey = survey)
varlist_subset <- c("GEOID", varlist)
### subset estimates
edu <- subset(.data, select = varlist_subset)
### pivot and rename
edu <- pivot_demos(edu, vars = varlist)
names(edu)[names(edu) == "estimate"] <- "E_NOHSDP"
names(edu)[names(edu) == "moe"] <- "M_NOHSDP"
### combine
out <- merge(x = out, y = edu, by = "GEOID", all.x = TRUE)
} else if (year >= 2015){
out$E_NOHSDP <- out$S1501_C01_007E+out$S1501_C01_008E
out$M_NOHSDP <- sqrt(out$S1501_C01_007M^2+out$S1501_C01_008M^2)
}
if (style %in% c("svi20", "svi20s")){
if (year < 2015){
out$E_HBURD <- out$S2503_C01_032E+out$S2503_C01_036E+out$S2503_C01_040E+out$S2503_C01_044E
out$M_HBURD <- sqrt(out$S2503_C01_032M^2+out$S2503_C01_036M^2+out$S2503_C01_040M^2+out$S2503_C01_044M^2)
} else if (year >= 2015){
out$E_HBURD <- out$S2503_C01_028E+out$S2503_C01_032E+out$S2503_C01_036E+out$S2503_C01_040E
out$M_HBURD <- sqrt(out$S2503_C01_028M^2+out$S2503_C01_032M^2+out$S2503_C01_036M^2+out$S2503_C01_040M^2)
}
}
## calculate metrics
out$EP_NOHSDP <- dep_safe_pct(out$E_NOHSDP, out$D_NOHSDP)
out$MP_NOHSDP <- dep_derived_moe(out$M_NOHSDP, out$EP_NOHSDP, out$DM_NOHSDP, out$DM_NOHSDP)
out$EP_UNEMP <- dep_safe_pct(out$E_UNEMP, out$D_UNEMP)
out$MP_UNEMP <- dep_derived_moe(out$M_UNEMP, out$EP_UNEMP, out$DM_UNEMP, out$DM_UNEMP)
if (style %in% c("svi10", "svi14")){
out$EP_POV <- dep_safe_pct(out$E_POV, out$D_POV)
out$MP_POV <- dep_derived_moe(out$M_POV, out$EP_POV, out$DM_POV, out$DM_POV)
} else if (style %in% c("svi20", "svi20s")){
out$EP_POV150 <- dep_safe_pct(out$E_POV150, out$D_POV150)
out$MP_POV150 <- dep_derived_moe(out$M_POV150, out$EP_POV150, out$DM_POV150, out$DM_POV150)
out$EP_UNINSUR <- dep_safe_pct(out$E_UNINSUR, out$D_UNINSUR)
out$MP_UNINSUR <- dep_derived_moe(out$M_UNINSUR, out$EP_UNINSUR, out$DM_UNINSUR, out$DM_UNINSUR)
if (year < 2017){
out$EP_HBURD <- out$E_HBURD
out$MP_HBURD <- out$M_HBURD
} else if (year >= 2017){
out$EP_HBURD <- dep_safe_pct(out$E_HBURD, out$D_HBURD)
out$MP_HBURD <- dep_derived_moe(out$M_HBURD, out$EP_HBURD, out$DM_HBURD, out$DM_HBURD)
}
}
## calculate percentiles
out$EPL_NOHSDP <- dep_percent_rank(out$EP_NOHSDP)
out$EPL_UNEMP <- dep_percent_rank(out$EP_UNEMP)
if (style %in% c("svi10", "svi14")){
out$EPL_POV <- dep_percent_rank(out$EP_POV)
out$EPL_PCI <- 1-dep_percent_rank(out$E_PCI)
} else if (style %in% c("svi20", "svi20s")){
out$EPL_POV150 <- dep_percent_rank(out$EP_POV150)
out$EPL_UNINSUR <- 1-dep_percent_rank(out$EP_UNINSUR)
out$EPL_HBURD <- 1-dep_percent_rank(out$EP_HBURD)
}
## calculate theme
if (style %in% c("svi10", "svi14")){
out$SPL_THEME1 <- out$EPL_POV + out$EPL_UNEMP + out$EPL_PCI + out$EPL_NOHSDP
} else if (style %in% c("svi20", "svi20s")){
out$SPL_THEME1 <- out$EPL_POV150 + out$EPL_UNEMP + out$EPL_NOHSDP + out$EPL_UNINSUR + out$EPL_HBURD
}
## calculate theme percentile
out$SVI_SES <- dep_percent_rank(out$SPL_THEME1)
## update output order
if (keep_components){
if (style %in% c("svi10", "svi14")){
out <- subset(out, select = c(GEOID,
D_POV, DM_POV, E_POV, M_POV, EP_POV, MP_POV, EPL_POV,
D_UNEMP, DM_UNEMP, E_UNEMP, M_UNEMP, EP_UNEMP, MP_UNEMP, EPL_UNEMP,
E_PCI, M_PCI, EPL_PCI,
D_NOHSDP, DM_NOHSDP, E_NOHSDP, M_NOHSDP, EP_NOHSDP, MP_NOHSDP, EPL_NOHSDP,
SPL_THEME1, SVI_SES))
} else if (style %in% c("svi20", "svi20s")){
if (year < 2017){
out <- subset(out, select = c(GEOID,
D_POV150, DM_POV150, E_POV150, M_POV150, EP_POV150, MP_POV150, EPL_POV150,
D_UNEMP, DM_UNEMP, E_UNEMP, M_UNEMP, EP_UNEMP, MP_UNEMP, EPL_UNEMP,
E_HBURD, M_HBURD, EPL_HBURD,
D_NOHSDP, DM_NOHSDP, E_NOHSDP, M_NOHSDP, EP_NOHSDP, MP_NOHSDP, EPL_NOHSDP,
D_UNINSUR, DM_UNINSUR, E_UNINSUR, M_UNINSUR, EP_UNINSUR, MP_UNINSUR, EPL_UNINSUR,
SPL_THEME1, SVI_SES))
} else if (year >= 2017){
out <- subset(out, select = c(GEOID,
D_POV150, DM_POV150, E_POV150, M_POV150, EP_POV150, MP_POV150, EPL_POV150,
D_UNEMP, DM_UNEMP, E_UNEMP, M_UNEMP, EP_UNEMP, MP_UNEMP, EPL_UNEMP,
E_HBURD, M_HBURD, EP_HBURD, MP_HBURD, EPL_HBURD,
D_NOHSDP, DM_NOHSDP, E_NOHSDP, M_NOHSDP, EP_NOHSDP, MP_NOHSDP, EPL_NOHSDP,
D_UNINSUR, DM_UNINSUR, E_UNINSUR, M_UNINSUR, EP_UNINSUR, MP_UNINSUR, EPL_UNINSUR,
SPL_THEME1, SVI_SES))
}
}
} else if (!keep_components){
out <- subset(out, select = c(GEOID, SPL_THEME1, SVI_SES))
}
## return output
return(out)
}
### svi, ses variables
dep_process_svi_hhd <- function(.data, style, geography, year, survey, keep_components){
## create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", hhd"),
year = year, survey = survey)
varlist <- c("GEOID", varlist)
## subset
out <- subset(.data, select = varlist)
## rename components
names(out)[names(out) == "S1101_C01_001E"] <- "D_SNGPNT"
names(out)[names(out) == "S1101_C01_001M"] <- "DM_SNGPNT"
names(out)[names(out) == "S0101_C01_001E"] <- "D_AGE"
names(out)[names(out) == "S0101_C01_001M"] <- "DM_AGE"
if (year >= 2017){
names(out)[names(out) == "S0101_C01_022E"] <- "E_AGE17"
names(out)[names(out) == "S0101_C01_022M"] <- "M_AGE17"
names(out)[names(out) == "S0101_C01_030E"] <- "E_AGE65"
names(out)[names(out) == "S0101_C01_030M"] <- "M_AGE65"
}
if (style %in% c("svi14", "svi20", "svi20s")){
names(out)[names(out) == "S2701_C01_001E"] <- "D_DISABL"
names(out)[names(out) == "S2701_C01_001M"] <- "DM_DISABL"
}
if (style %in% c("svi20", "svi20s")){
names(out)[names(out) == "B16004_001E"] <- "D_LIMENG"
names(out)[names(out) == "B16004_001M"] <- "DM_LIMENG"
}
## calculate components
if (style %in% c("svi10", "svi14", "svi20")){
out$E_SNGPNT <- out$B25115_009E+out$B25115_012E+out$B25115_022E+out$B25115_025E
out$M_SNGPNT <- sqrt(out$B25115_009M^2+out$B25115_012M^2+out$B25115_022M^2+out$B25115_025M^2)
} else if (style == "svi20s"){
out$E_SNGPNT <- out$B11012_010E+out$B11012_015E
out$M_SNGPNT <- sqrt(out$B11012_010M^2+out$B11012_015M^2)
}
if (year < 2017){
### create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", age_lt18"),
year = year, survey = survey)
varlist_subset <- c("GEOID", varlist)
### subset estimates
age_lt18 <- subset(.data, select = varlist_subset)
### pivot and rename
age_lt18 <- pivot_demos(age_lt18, vars = varlist)
names(age_lt18)[names(age_lt18) == "estimate"] <- "E_AGE17"
names(age_lt18)[names(age_lt18) == "moe"] <- "M_AGE17"
### create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", age_gt64"),
year = year, survey = survey)
varlist_subset <- c("GEOID", varlist)
### subset estimates
age_gt64 <- subset(.data, select = varlist_subset)
### pivot and rename
age_gt64 <- pivot_demos(age_gt64, vars = varlist)
names(age_gt64)[names(age_gt64) == "estimate"] <- "E_AGE65"
names(age_gt64)[names(age_gt64) == "moe"] <- "M_AGE65"
### combine
age <- merge(x = age_lt18, y = age_gt64, by = "GEOID", all.x = TRUE)
out <- merge(x = out, y = age, by = "GEOID", all.x = TRUE)
}
if (style %in% c("svi14", "svi20", "svi20s")){
### create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", dis"),
year = year, survey = survey)
varlist_subset <- c("GEOID", varlist)
### subset estimates
dis <- subset(.data, select = varlist_subset)
### pivot and rename
dis <- pivot_demos(dis, vars = varlist)
names(dis)[names(dis) == "estimate"] <- "E_DISABL"
names(dis)[names(dis) == "moe"] <- "M_DISABL"
### combine
out <- merge(x = out, y = dis, by = "GEOID", all.x = TRUE)
}
if (style %in% c("svi20", "svi20s")){
### create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", eng"),
year = year, survey = survey)
varlist_subset <- c("GEOID", varlist)
### subset estimates
eng <- subset(.data, select = varlist_subset)
### pivot and rename
eng <- pivot_demos(eng, vars = varlist)
names(eng)[names(eng) == "estimate"] <- "E_LIMENG"
names(eng)[names(eng) == "moe"] <- "M_LIMENG"
### combine
out <- merge(x = out, y = eng, by = "GEOID", all.x = TRUE)
}
## calculate metrics
out$EP_AGE17 <- dep_safe_pct(out$E_AGE17, out$D_AGE)
out$MP_AGE17 <- dep_derived_moe(out$M_AGE17, out$EP_AGE17, out$DM_AGE, out$DM_AGE)
out$EP_AGE65 <- dep_safe_pct(out$E_AGE65, out$D_AGE)
out$MP_AGE65 <- dep_derived_moe(out$M_AGE65, out$EP_AGE65, out$DM_AGE, out$DM_AGE)
out$EP_SNGPNT <- dep_safe_pct(out$E_SNGPNT, out$D_SNGPNT)
out$MP_SNGPNT <- dep_derived_moe(out$M_SNGPNT, out$EP_SNGPNT, out$DM_SNGPNT, out$DM_SNGPNT)
if (style %in% c("svi14", "svi20", "svi20s")){
out$EP_DISABL <- dep_safe_pct(out$E_DISABL, out$D_DISABL)
out$MP_DISABL <- dep_derived_moe(out$M_DISABL, out$EP_DISABL, out$DM_DISABL, out$DM_DISABL)
}
if (style %in% c("svi20", "svi20s")){
out$EP_LIMENG <- dep_safe_pct(out$E_LIMENG, out$D_LIMENG)
out$MP_LIMENG <- dep_derived_moe(out$M_LIMENG, out$EP_LIMENG, out$DM_LIMENG, out$DM_LIMENG)
}
## calculate percentiles
out$EPL_AGE17 <- dep_percent_rank(out$EP_AGE17)
out$EPL_AGE65 <- dep_percent_rank(out$EP_AGE65)
out$EPL_SNGPNT <- dep_percent_rank(out$EP_SNGPNT)
if (style %in% c("svi14", "svi20", "svi20s")){
out$EPL_DISABL <- dep_percent_rank(out$EP_DISABL)
}
if (style %in% c("svi20", "svi20s")){
out$EPL_LIMENG <- dep_percent_rank(out$EP_LIMENG)
}
## calculate theme
if (style == "svi10"){
out$SPL_THEME2 <- out$EPL_AGE17 + out$EPL_AGE65 + out$EPL_SNGPNT
} else if (style == "svi14"){
out$SPL_THEME2 <- out$EPL_AGE17 + out$EPL_AGE65 + out$EPL_DISABL + out$EPL_SNGPNT
} else if (style %in% c("svi20", "svi20s")){
out$SPL_THEME2 <- out$EPL_AGE17 + out$EPL_AGE65 + out$EPL_DISABL + out$EPL_SNGPNT + out$EPL_LIMENG
}
## calculate theme percentile
out$SVI_HCD <- dep_percent_rank(out$SPL_THEME2)
## update output order
if (keep_components){
if (style == "svi10"){
out <- subset(out, select = c(GEOID, E_AGE17, M_AGE17, EP_AGE17, MP_AGE17, EPL_AGE17,
E_AGE65, M_AGE65, EP_AGE65, MP_AGE65, EPL_AGE65,
E_SNGPNT, M_SNGPNT, EP_SNGPNT, MP_SNGPNT, EPL_SNGPNT,
SPL_THEME2, SVI_HCD))
} else if (style == "svi14"){
out <- subset(out, select = c(GEOID, E_AGE17, M_AGE17, EP_AGE17, MP_AGE17, EPL_AGE17,
E_AGE65, M_AGE65, EP_AGE65, MP_AGE65, EPL_AGE65,
D_DISABL, DM_DISABL, E_DISABL, M_DISABL, EP_DISABL, MP_DISABL, EPL_DISABL,
E_SNGPNT, M_SNGPNT, EP_SNGPNT, MP_SNGPNT, EPL_SNGPNT,
SPL_THEME2, SVI_HCD))
} else if (style %in% c("svi20", "svi20s")){
out <- subset(out, select = c(GEOID, E_AGE17, M_AGE17, EP_AGE17, MP_AGE17, EPL_AGE17,
E_AGE65, M_AGE65, EP_AGE65, MP_AGE65, EPL_AGE65,
E_DISABL, M_DISABL, EP_DISABL, MP_DISABL, EPL_DISABL,
E_SNGPNT, M_SNGPNT, EP_SNGPNT, MP_SNGPNT, EPL_SNGPNT,
D_LIMENG, DM_LIMENG, E_LIMENG, M_LIMENG, EP_LIMENG, MP_LIMENG, EPL_LIMENG,
SPL_THEME2, SVI_HCD))
}
} else if (!keep_components){
out <- subset(out, select = c(GEOID, SPL_THEME2, SVI_HCD))
}
## return output
return(out)
}
### svi, msl variables
dep_process_svi_msl <- function(.data, style, geography, year, survey, keep_components){
## create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", msl"),
year = year, survey = survey)
varlist <- c("GEOID", varlist)
## subset
out <- subset(.data, select = varlist)
## rename components
names(out)[names(out) == "S0101_C01_001E"] <- "D_MINRTY"
names(out)[names(out) == "S0101_C01_001M"] <- "DM_MINRTY"
if (style %in% c("svi10", "svi14")){
names(out)[names(out) == "B16004_001E"] <- "D_LIMENG"
names(out)[names(out) == "B16004_001M"] <- "DM_LIMENG"
}
### calculate components
out$E_MINRTY <- out$D_MINRTY-out$B01001H_001E
out$M_MINRTY <- sqrt(out$DM_MINRTY^2+out$B01001H_001M^2)
if (style %in% c("svi10", "svi14")){
### create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", eng"),
year = year, survey = survey)
varlist_subset <- c("GEOID", varlist)
### subset estimates
eng <- subset(.data, select = varlist_subset)
### pivot and rename
eng <- pivot_demos(eng, vars = varlist)
names(eng)[names(eng) == "estimate"] <- "E_LIMENG"
names(eng)[names(eng) == "moe"] <- "M_LIMENG"
### combine
out <- merge(x = out, y = eng, by = "GEOID", all.x = TRUE)
}
### calculate metrics
out$EP_MINRTY <- dep_safe_pct(out$E_MINRTY, out$D_MINRTY)
out$MP_MINRTY <- dep_derived_moe(out$M_MINRTY, out$EP_MINRTY, out$DM_MINRTY, out$DM_MINRTY)
if (style %in% c("svi10", "svi14")){
out$EP_LIMENG <- dep_safe_pct(out$E_LIMENG, out$D_LIMENG)
out$MP_LIMENG <- dep_derived_moe(out$M_LIMENG, out$EP_LIMENG, out$DM_LIMENG, out$DM_LIMENG)
}
## calculate percentiles
out$EPL_MINRTY <- dep_percent_rank(out$EP_MINRTY)
if (style %in% c("svi10", "svi14")){
out$EPL_LIMENG <- dep_percent_rank(out$EP_LIMENG)
}
### calculate theme
if (style %in% c("svi10", "svi14")){
out$SPL_THEME3 <- out$EPL_MINRTY + out$EPL_LIMENG
} else if (style %in% c("svi20", "svi20s")){
out$SPL_THEME3 <- out$EPL_MINRTY
}
## calculate theme percentile
if (style %in% c("svi10", "svi14")){
out$SVI_MSL <- dep_percent_rank(out$SPL_THEME3)
} else if (style %in% c("svi20", "svi20s")){
out$SVI_MSL <- out$SPL_THEME3
}
### update output order
if (keep_components){
if (style %in% c("svi10", "svi14")){
out <- subset(out, select = c(GEOID, E_MINRTY, M_MINRTY, EP_MINRTY, MP_MINRTY, EPL_MINRTY,
D_LIMENG, DM_LIMENG, E_LIMENG, M_LIMENG, EP_LIMENG, MP_LIMENG, EPL_LIMENG,
SPL_THEME3, SVI_MSL))
} else if (style %in% c("svi20", "svi20s")){
out <- subset(out, select = c(GEOID, E_MINRTY, M_MINRTY, EP_MINRTY, MP_MINRTY, EPL_MINRTY,
SPL_THEME3, SVI_MSL))
}
} else if (!keep_components){
out <- subset(out, select = c(GEOID, SPL_THEME3, SVI_MSL))
}
## return output
return(out)
}
### svi, htt variables
dep_process_svi_htt <- function(.data, style, geography, year, survey, keep_components){
## create variable list
varlist <- dep_expand_varlist(geography = geography, index = paste0(style, ", htt"),
year = year, survey = survey)
varlist <- c("GEOID", varlist)
## subset
.data <- subset(.data, select = varlist)
## rename components
names(.data)[names(.data) == "B26001_001E"] <- "E_GROUPQ"
names(.data)[names(.data) == "B26001_001M"] <- "M_GROUPQ"
names(.data)[names(.data) == "DP04_0002E"] <- "D_CROWD"
names(.data)[names(.data) == "DP04_0002M"] <- "DM_CROWD"
names(.data)[names(.data) == "DP04_0006E"] <- "D_HOUSE"
names(.data)[names(.data) == "DP04_0006M"] <- "DM_HOUSE"
names(.data)[names(.data) == "DP04_0014E"] <- "E_MOBILE"
names(.data)[names(.data) == "DP04_0014M"] <- "M_MOBILE"
if (year >= 2015){
names(.data)[names(.data) == "DP04_0057E"] <- "D_NOVEH"
names(.data)[names(.data) == "DP04_0057M"] <- "DM_NOVEH"
names(.data)[names(.data) == "DP04_0058E"] <- "E_NOVEH"
names(.data)[names(.data) == "DP04_0058M"] <- "M_NOVEH"
} else if (year < 2015){
names(.data)[names(.data) == "DP04_0056E"] <- "D_NOVEH"
names(.data)[names(.data) == "DP04_0056M"] <- "DM_NOVEH"
names(.data)[names(.data) == "DP04_0057E"] <- "E_NOVEH"
names(.data)[names(.data) == "DP04_0057M"] <- "M_NOVEH"
}
## calculate components
.data$E_MUNIT <- .data$DP04_0012E+.data$DP04_0013E
.data$M_MUNIT <- sqrt(.data$DP04_0012M^2+.data$DP04_0013M^2)
if (year >= 2015){
.data$E_CROWD <- .data$DP04_0078E+.data$DP04_0079E
.data$M_CROWD <- sqrt(.data$DP04_0078M^2+.data$DP04_0079M^2)
} else if (year < 2015){
.data$E_CROWD <- .data$DP04_0077E+.data$DP04_0078E
.data$M_CROWD <- sqrt(.data$DP04_0077M^2+.data$DP04_0078M^2)
}
## calculate metrics
.data$EP_MUNIT <- dep_safe_pct(.data$E_MUNIT, .data$D_HOUSE)
.data$MP_MUNIT <- dep_derived_moe(.data$M_MUNIT, .data$EP_MUNIT, .data$DM_HOUSE, .data$DM_HOUSE)
.data$EP_MOBILE <- dep_safe_pct(.data$E_MOBILE, .data$D_HOUSE)
.data$MP_MOBILE <- dep_derived_moe(.data$M_MOBILE, .data$EP_MOBILE, .data$DM_HOUSE, .data$DM_HOUSE)
.data$EP_CROWD <- dep_safe_pct(.data$E_CROWD, .data$D_CROWD)
.data$MP_CROWD <- dep_derived_moe(.data$M_CROWD, .data$EP_CROWD, .data$DM_CROWD, .data$DM_CROWD)
.data$EP_NOVEH <- dep_safe_pct(.data$E_NOVEH, .data$D_NOVEH)
.data$MP_NOVEH <- dep_derived_moe(.data$M_NOVEH, .data$EP_NOVEH, .data$DM_NOVEH, .data$DM_NOVEH)
.data$EP_GROUPQ <- dep_safe_pct(.data$E_GROUPQ, .data$S0101_C01_001E)
.data$MP_GROUPQ <- dep_derived_moe(.data$M_GROUPQ, .data$EP_GROUPQ, .data$S0101_C01_001M, .data$S0101_C01_001M)
## calculate percentiles
.data$EPL_MUNIT <- dep_percent_rank(.data$EP_MUNIT)
.data$EPL_MOBILE <- dep_percent_rank(.data$EP_MOBILE)
.data$EPL_CROWD <- dep_percent_rank(.data$EP_CROWD)
.data$EPL_NOVEH <- dep_percent_rank(.data$EP_NOVEH)
.data$EPL_GROUPQ <- dep_percent_rank(.data$EP_GROUPQ)
## calculate theme
.data$SPL_THEME4 <- .data$EPL_MUNIT + .data$EPL_MOBILE + .data$EPL_CROWD + .data$EPL_NOVEH + .data$EPL_GROUPQ
## calculate theme percentile
.data$SVI_HTT <- dep_percent_rank(.data$SPL_THEME4)
## update output order
if (keep_components){
.data <- subset(.data, select = c(GEOID, E_MUNIT, M_MUNIT, EP_MUNIT, MP_MUNIT, EPL_MUNIT,
E_MOBILE, M_MOBILE, EP_MOBILE, MP_MOBILE, EPL_MOBILE,
E_CROWD, M_CROWD, EP_CROWD, MP_CROWD, EPL_CROWD,
E_NOVEH, M_NOVEH, EP_NOVEH, MP_NOVEH, EPL_NOVEH,
E_GROUPQ, M_GROUPQ, EP_GROUPQ, MP_GROUPQ, EPL_GROUPQ,
SPL_THEME4, SVI_HTT))
} else if (!keep_components){
.data <- subset(.data, select = c(GEOID, SPL_THEME4, SVI_HTT))
}
## return output
return(.data)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.