From e14c17bf74bbe5bbdc0f59d366d482ab54a11abc Mon Sep 17 00:00:00 2001 From: Ian D Buller Date: Sat, 6 Jul 2024 13:15:49 -0400 Subject: [PATCH 1/7] Initial commit for branch "dev_hoover" (ndi v0.1.6.9000) * Added `hoover()` function to compute the aspatial racial/ethnic Delta (DEL) based on [Hoover (1941)](https://doi.org/10.1017/S0022050700052980) and Duncan et al. (1961; LC:60007089) --- R/hoover.R | 292 +++++++++++++++++++++++++++++++++++ R/utils.R | 16 ++ tests/testthat/test-hoover.R | 77 +++++++++ 3 files changed, 385 insertions(+) create mode 100644 R/hoover.R create mode 100644 tests/testthat/test-hoover.R diff --git a/R/hoover.R b/R/hoover.R new file mode 100644 index 0000000..e8afe1e --- /dev/null +++ b/R/hoover.R @@ -0,0 +1,292 @@ +#' Delta based on Hoover (1941) and Duncan et al. (1961) +#' +#' Compute the aspatial Delta (Hoover) of a selected racial/ethnic subgroup(s) and U.S. geographies. +#' +#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}. +#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}. +#' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. +#' @param subgroup Character string specifying the racial/ethnic subgroup(s). See Details for available choices. +#' @param omit_NAs Logical. If FALSE, will compute index for a larger geographical unit only if all of its smaller geographical units have values. The default is TRUE. +#' @param quiet Logical. If TRUE, will display messages about potential missing census information. The default is FALSE. +#' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics +#' +#' @details This function will compute the aspatial Delta (DEL) of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Hoover (1941) \doi{10.1017/S0022050700052980} and Duncan, Cuzzort, and Duncan (1961; LC:60007089). This function provides the computation of DEL for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). +#' +#' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: +#' \itemize{ +#' \item **B03002_002**: not Hispanic or Latino \code{'NHoL'} +#' \item **B03002_003**: not Hispanic or Latino, white alone \code{'NHoLW'} +#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{'NHoLA'} +#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +#' \item **B03002_012**: Hispanic or Latino \code{'HoL'} +#' \item **B03002_013**: Hispanic or Latino, white alone \code{'HoLW'} +#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{'HoLB'} +#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{'HoLA'} +#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} +#' } +#' +#' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. +#' +#' DEL is a measure of the proportion of members of one subgroup(s) residing in geographic units with above average density of members of the subgroup(s). The index provides the proportion of a subgroup population that would have to move across geographic units to achieve a uniform density. DEL can range in value from 0 to 1. +#' +#' Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the DEL value returned is NA. +#' +#' @return An object of class 'list'. This is a named list with the following components: +#' +#' \describe{ +#' \item{\code{del}}{An object of class 'tbl' for the GEOID, name, and DEL at specified larger census geographies.} +#' \item{\code{del_data}}{An object of class 'tbl' for the raw census values at specified smaller census geographies.} +#' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute DEL.} +#' } +#' +#' @import dplyr +#' @importFrom sf st_drop_geometry +#' @importFrom stats complete.cases +#' @importFrom tidycensus get_acs +#' @importFrom tidyr pivot_longer separate +#' @importFrom utils stack +#' @export +#' +#' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). +#' +#' @examples +#' \dontrun{ +#' # Wrapped in \dontrun{} because these examples require a Census API key. +#' +#' # Delta (a measure of concentration) of non-Hispanic Black vs. non-Hispanic white populations +#' ## of census tracts within Georgia, U.S.A., counties (2020) +#' hoover( +#' geo_large = 'county', +#' geo_small = 'tract', +#' state = 'GA', +#' year = 2020, +#' subgroup = 'NHoLB' +#' ) +#' +#' } +#' +hoover <- function(geo_large = 'county', + geo_small = 'tract', + year = 2020, + subgroup, + omit_NAs = TRUE, + quiet = FALSE, + ...) { + + # Check arguments + match.arg(geo_large, choices = c('state', 'county', 'tract')) + match.arg(geo_small, choices = c('county', 'tract', 'block group')) + stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward + match.arg( + subgroup, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) + + # Select census variables + vars <- c( + TotalPop = 'B03002_001', + NHoL = 'B03002_002', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + NHoLAIAN = 'B03002_005', + NHoLA = 'B03002_006', + NHoLNHOPI = 'B03002_007', + NHoLSOR = 'B03002_008', + NHoLTOMR = 'B03002_009', + NHoLTRiSOR = 'B03002_010', + NHoLTReSOR = 'B03002_011', + HoL = 'B03002_012', + HoLW = 'B03002_013', + HoLB = 'B03002_014', + HoLAIAN = 'B03002_015', + HoLA = 'B03002_016', + HoLNHOPI = 'B03002_017', + HoLSOR = 'B03002_018', + HoLTOMR = 'B03002_019', + HoLTRiSOR = 'B03002_020', + HoLTReSOR = 'B03002_021' + ) + + selected_vars <- vars[subgroup] + out_names <- c(names(selected_vars), 'ALAND') # save for output + in_subgroup <- paste(subgroup, 'E', sep = '') + + # Acquire DEL variables and sf geometries + del_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo_small, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + keep_geo_vars = TRUE, + ... + ) + )) + + # Format output + if (geo_small == 'county') { + del_data <- del_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('county', 'state'), sep = ',') + } + if (geo_small == 'tract') { + del_data <- del_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } + if (geo_small == 'block group') { + del_data <- del_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('block.group', 'tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate( + tract = gsub('[^0-9\\.]', '', tract), block.group = gsub('[^0-9\\.]', '', block.group) + ) + } + + # Grouping IDs for DEL computation + if (geo_large == 'tract') { + del_data <- del_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'county') { + del_data <- del_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'state') { + del_data <- del_data %>% + dplyr::mutate( + oid = .$STATEFP, + state = stringr::str_trim(state) + ) + } + + # Count of racial/ethnic subgroup populations + ## Count of racial/ethnic comparison subgroup population + if (length(in_subgroup) == 1) { + del_data <- del_data %>% + dplyr::mutate(subgroup = .[ , in_subgroup]) + } else { + del_data <- del_data %>% + dplyr::mutate(subgroup = rowSums(.[ , in_subgroup])) + } + + # Compute DEL + ## From Hoover (1961) https://10.1017/S0022050700052980 + ## 0.5\sum_{i=1}^{n}\left|\frac{x_{i}}{X}-\frac{a_{i}}{A}\right| + ## Where for k geographical units i: + ## X denotes the total number of subgroup population in study (reference) area + ## x_{i} denotes the number of subgroup population X in geographical unit i + ## A denotes the total land area in study (reference) area (sum of all a_{i} + ## a_{i} denotes the land area of geographical unit i + + ## Compute + DELtmp <- del_data %>% + split(., f = list(del_data$oid)) %>% + lapply(., FUN = del_fun, omit_NAs = omit_NAs) %>% + utils::stack(.) %>% + dplyr::mutate(DEL = values, oid = ind) %>% + dplyr::select(DEL, oid) + + # Warning for missingness of census characteristics + missingYN <- del_data[ , c(in_subgroup, 'ALAND')] + names(missingYN) <- out_names + missingYN <- missingYN %>% + tidyr::pivot_longer(cols = dplyr::everything(), names_to = 'variable', values_to = 'val') %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + } + + # Format output + if (geo_large == 'state') { + del <- del_data %>% + dplyr::left_join(DELtmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, DEL) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, DEL) %>% + .[.$GEOID != 'NANA', ] + } + if (geo_large == 'county') { + del <- del_data %>% + dplyr::left_join(DELtmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, county, DEL) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, county, DEL) %>% + .[.$GEOID != 'NANA', ] + } + if (geo_large == 'tract') { + del <- del_data %>% + dplyr::left_join(DELtmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, county, tract, DEL) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, county, tract, DEL) %>% + .[.$GEOID != 'NANA', ] + } + + del <- del %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + del_data <- del_data %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + out <- list(del = del, del_data = del_data, missing = missingYN) + + return(out) +} diff --git a/R/utils.R b/R/utils.R index a7e1553..94e39fd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -88,3 +88,19 @@ lexis_fun <- function(x, omit_NAs) { return(df) } } + +# Internal function for the aspatial Delta (Hoover 1941) +## Returns NA value if only one smaller geography in a larger geography +del_fun <- function(x, omit_NAs) { + xx <- x[ , c('subgroup', 'ALAND')] + if (omit_NAs == TRUE) { xx <- xx[stats::complete.cases(xx), ] } + if (nrow(x) < 2 || any(xx < 0) || any(is.na(xx))) { + NA + } else { + 0.5 * sum( + abs((xx$subgroup / sum(xx$subgroup, na.rm = TRUE)) - (xx$ALAND / sum(xx$ALAND, na.rm = TRUE)) + ), + na.rm = TRUE + ) + } +} diff --git a/tests/testthat/test-hoover.R b/tests/testthat/test-hoover.R new file mode 100644 index 0000000..994f7d2 --- /dev/null +++ b/tests/testthat/test-hoover.R @@ -0,0 +1,77 @@ +context('hoover') + +# --------------- # +# hoover testthat # +# --------------- # + +test_that('hoover throws error with invalid arguments', { + # Unavailable geography + expect_error(hoover( + geo_small = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) + expect_error( + hoover( + geo_large = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + ) + ) + + # Unavailable year + expect_error(hoover( + state = 'DC', + year = 2005, + subgroup = 'NHoLB', + quiet = TRUE + )) + + # Unavailable subgroup + expect_error(hoover( + state = 'DC', + year = 2020, + subgroup = 'terran', + quiet = TRUE + )) + + skip_if(Sys.getenv('CENSUS_API_KEY') == '') + + # Incorrect state + expect_error(hoover( + state = 'AB', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) + +}) + +test_that('hoover works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') + + expect_silent(hoover( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB') + )) + + expect_silent(hoover( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) + + expect_silent(hoover( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + quiet = TRUE + )) + +}) From 07c46288f685d327db34a765a552ec807527e34c Mon Sep 17 00:00:00 2001 From: Ian D Buller Date: Sat, 6 Jul 2024 13:20:49 -0400 Subject: [PATCH 2/7] :bug: Fixed bug in `bell()`, `bemanian_beyer()`, `duncan()`, `sudano()`, and `white()` * when a smaller geography contains n=0 total population, will assign a value of zero (0) in the internal calculation instead of NA --- NEWS.md | 25 +++++++++++++++++-------- R/utils.R | 33 ++++++++++++++++++++++++--------- 2 files changed, 41 insertions(+), 17 deletions(-) diff --git a/NEWS.md b/NEWS.md index db0146a..85e070f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,14 @@ # ndi (development version) +## ndi v0.1.6.9000 + +### New Features +* Added `hoover()` function to compute the aspatial racial/ethnic Delta (DEL) based on [Hoover (1941)](https://doi.org/10.1017/S0022050700052980) and Duncan et al. (1961; LC:60007089) +* Thank you for the feature suggestion, [Symielle Gaston](https://orcid.org/0000-0001-9495-1592) + +### Updates +* Fixed bug in `bell()`, `bemanian_beyer()`, `duncan()`, `sudano()`, and `white()` when a smaller geography contains n=0 total population, will assign a value of zero (0) in the internal calculation instead of NA + ## ndi v0.1.5 ### New Features @@ -9,7 +18,7 @@ * 'DescTools' is now Suggests to fix Rd cross-references NOTE * Fixed 'lost braces in \itemize' NOTE for `anthopolos()`, `atkinson()`, `bell()`, `bemanian_beyer()`, `bravo()`, `duncan()`, `krieger()`, `messer()`, `powell_wiley()`, `sudano()`, and `white()` functions * Fixed 'Moved Permanently' content by replacing the old URL with the new URL -* Fixed citation for Slotman _et al._ (2022) in CITATION +* Fixed citation for Slotman et al. (2022) in CITATION ## ndi v0.1.4 @@ -17,7 +26,7 @@ * Added `atkinson()` function to compute the aspatial income or racial/ethnic Atkinson Index (AI) based on [Atkinson (1970)](https://doi.org/10.1016/0022-0531(70)90039-6) for specified counties/tracts 2009 onward * Added `bell()` function to compute the aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0837156378) and [Bell (1954)](https://doi.org/10.2307/2574118) * Added `white()` function to compute the aspatial racial/ethnic Correlation Ratio (V) based on [Bell (1954)](https://doi.org/10.2307/2574118) and [White (1986)](https://doi.org/10.2307/3644339) -* Added `sudano()` function to compute the aspatial racial/ethnic Location Quotient (LQ) based on [Merton (1939)](https://doi.org/10.2307/2084686) and [Sudano _et al._ (2013)](https://doi.org/10.1016/j.healthplace.2012.09.015) +* Added `sudano()` function to compute the aspatial racial/ethnic Location Quotient (LQ) based on [Merton (1939)](https://doi.org/10.2307/2084686) and [Sudano et al. (2013)](https://doi.org/10.1016/j.healthplace.2012.09.015) * Added `bemanian_beyer()` function to compute the aspatial racial/ethnic Local Exposure and Isolation (LEx/Is) metric based on [Bemanian & Beyer (2017)](https://doi.org/10.1158/1055-9965.EPI-16-0926) ### Updates @@ -25,7 +34,7 @@ * Fixed bug in reverse dependency check failure for `anthopolos()` and `bravo()` functions removing `returnValue()` when data are not missing * Thank you, [Roger Bivand](https://github.com/rsbivand), for the catch. Relates to [ndi Issue #5](https://github.com/idblr/ndi/issues/5) * Updated `duncan()`, `gini()`, `krieger()`, `messer()`, and `powell_wiley()` for consistency in messaging when data are not missing -* Updated tests for `anthopolos()` and `bravo()` if `Sys.getenv("CENSUS_API_KEY") != ""` +* Updated tests for `anthopolos()` and `bravo()` if `Sys.getenv('CENSUS_API_KEY') != ''` * Added `omit_NAs` argument in `duncan()` function to choose if NA values will be included in its computation * In `duncan()` function, if any smaller geographic unit has zero counts the output for its larger geographic unit will be NA * Fixed bug in `duncan()` function for multiple `subgroup` and `subgroup_ref` selections @@ -41,7 +50,7 @@ * Added 'utils.R' file with internal `di_fun()` function for `duncan()` function ### Updates -* Fixed bug in `bravo()` function where ACS-5 data (2005-2009) are from the "B15002" question and "B06009" after +* Fixed bug in `bravo()` function where ACS-5 data (2005-2009) are from the 'B15002' question and 'B06009' after * Fixed bug in missingness warning for all metrics * `utils` is now Imports * Updated vignette and README with new features @@ -53,7 +62,7 @@ ## ndi v0.1.2 ### New Features -* Added `krieger()` function to compute the Index of Concentration at the Extremes (ICE) based on [Feldman _et al._ (2015)](https://doi.org/10.1136/jech-2015-205728) and [Krieger _et al._ (2016)](https://doi.org/10.2105/AJPH.2015.302955) for specified counties/tracts 2009 onward +* Added `krieger()` function to compute the Index of Concentration at the Extremes (ICE) based on [Feldman et al. (2015)](https://doi.org/10.1136/jech-2015-205728) and [Krieger et al. (2016)](https://doi.org/10.2105/AJPH.2015.302955) for specified counties/tracts 2009 onward * Thank you for the feature suggestion, [David Berrigan](https://orcid.org/0000-0002-5333-179X) * Added `df` argument for the `messer()` and `powell_wiley()` functions to specify a pre-formatted data set input for the NDI computation * Added `round_output` argument for the `messer()` and `powell_wiley()` functions to provide raw output as the default and rounded output as optional. @@ -64,7 +73,7 @@ * Fixed bug in `powell_wiley()` function where the internal PCA will now run properly if only one factor has an eigenvalue above 1 * Optimized the code to calculate missingness in all functions * Thank you for the suggested bug fixes, [Jacob Englert](https://github.com/jacobenglert) -* Fixed bug in `powell_wiley()` function where "PctNoPhone" before 2015 is "DP04_0074PE" and "DP04_0075PE" after +* Fixed bug in `powell_wiley()` function where 'PctNoPhone' before 2015 is 'DP04_0074PE' and 'DP04_0075PE' after * Thank you for alerting this issue, [Jessica Gleason](https://orcid.org/0000-0001-9877-7931) * Relaxed `year` argument in functions to include any year after 2009 or 2010 for the indices * Cleaned-up output formatting in functions @@ -79,8 +88,8 @@ ## ndi v0.1.1 ### New Features -* Added `anthopolos()` function to compute the Racial Isolation Index (RI) based on based on [Anthopolos _et al._ (2011)](https://doi.org/10.1016/j.sste.2011.06.002) for specified counties/tracts 2009 onward -* Added `bravo()` function to compute the Educational Isolation Index (EI) based on based on [Bravo _et al._ (2021)](https://doi.org/10.3390/ijerph18179384) for specified counties/tracts 2009 onward +* Added `anthopolos()` function to compute the Racial Isolation Index (RI) based on based on [Anthopolos et al. (2011)](https://doi.org/10.1016/j.sste.2011.06.002) for specified counties/tracts 2009 onward +* Added `bravo()` function to compute the Educational Isolation Index (EI) based on based on [Bravo et al. (2021)](https://doi.org/10.3390/ijerph18179384) for specified counties/tracts 2009 onward * Added `gini()` function to retrieve the Gini Index based on [Gini (1921)](https://doi.org/10.2307/2223319) for specified counties/tracts 2009 onward * Thank you for the feature suggestions, [Jessica Madrigal](https://orcid.org/0000-0001-5303-5109) diff --git a/R/utils.R b/R/utils.R index 94e39fd..5a37b7d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,12 +1,17 @@ # Internal function for the Dissimilarity Index (Duncan & Duncan 1955) ## Returns NA value if only one smaller geography in a larger geography di_fun <- function(x, omit_NAs) { - xx <- x[ , c("subgroup", "subgroup_ref")] + xx <- x[ , c('subgroup', 'subgroup_ref')] if (omit_NAs == TRUE) { xx <- xx[stats::complete.cases(xx), ] } if (nrow(x) < 2 || any(xx < 0) || any(is.na(xx))) { NA } else { - 1/2 * sum(abs(xx$subgroup / sum(xx$subgroup, na.rm = TRUE) - xx$subgroup_ref / sum(xx$subgroup_ref, na.rm = TRUE))) + 0.5 * sum( + abs( + xx$subgroup / sum(xx$subgroup, na.rm = TRUE) - + xx$subgroup_ref / sum(xx$subgroup_ref, na.rm = TRUE) + ), + na.rm = TRUE) } } @@ -34,24 +39,30 @@ ai_fun <- function(x, epsilon, omit_NAs) { # Internal function for the aspatial Racial Isolation Index (Bell 1954) ## Returns NA value if only one smaller geography in a larger geography ii_fun <- function(x, omit_NAs) { - xx <- x[ , c("TotalPopE", "subgroup", "subgroup_ixn")] + xx <- x[ , c('TotalPopE', 'subgroup', 'subgroup_ixn')] if (omit_NAs == TRUE) { xx <- xx[stats::complete.cases(xx), ] } if (nrow(x) < 2 || any(xx < 0) || any(is.na(xx))) { NA } else { - sum((xx$subgroup / sum(xx$subgroup, na.rm = TRUE)) * (xx$subgroup_ixn / xx$TotalPopE)) + sum( + (xx$subgroup / sum(xx$subgroup, na.rm = TRUE)) * (xx$subgroup_ixn / xx$TotalPopE), + na.rm = TRUE + ) } } # Internal function for the aspatial Correlation Ratio (White 1986) ## Returns NA value if only one smaller geography in a larger geography v_fun <- function(x, omit_NAs) { - xx <- x[ , c("TotalPopE", "subgroup")] + xx <- x[ , c('TotalPopE', 'subgroup')] if (omit_NAs == TRUE) { xx <- xx[stats::complete.cases(xx), ] } if (nrow(x) < 2 || any(xx < 0) || any(is.na(xx))) { NA } else { - xxx <- sum((xx$subgroup / sum(xx$subgroup, na.rm = TRUE)) * (xx$subgroup / xx$TotalPopE)) + xxx <- sum( + (xx$subgroup / sum(xx$subgroup, na.rm = TRUE)) * (xx$subgroup / xx$TotalPopE), + na.rm = TRUE + ) px <- sum(xx$subgroup, na.rm = TRUE) / sum(xx$TotalPopE, na.rm = TRUE) (xxx - px) / (1 - px) } @@ -60,12 +71,14 @@ v_fun <- function(x, omit_NAs) { # Internal function for the aspatial Location Quotient (Sudano et al. 2013) ## Returns NA value if only one smaller geography in a larger geography lq_fun <- function(x, omit_NAs) { - xx <- x[ , c("TotalPopE", "subgroup", "GEOID")] + xx <- x[ , c('TotalPopE', 'subgroup', 'GEOID')] if (omit_NAs == TRUE) { xx <- xx[stats::complete.cases(xx), ] } if (nrow(x) < 2 || any(xx < 0) || any(is.na(xx))) { NA } else { - LQ <- (xx$subgroup / xx$TotalPopE) / (sum(xx$subgroup, na.rm = TRUE) / sum(xx$TotalPopE, na.rm = TRUE)) + p_im <- xx$subgroup / xx$TotalPopE + if (anyNA(p_im)) { p_im[is.na(p_im), ] <- 0 } + LQ <- p_im / (sum(xx$subgroup, na.rm = TRUE) / sum(xx$TotalPopE, na.rm = TRUE)) df <- data.frame(LQ = LQ, GEOID = xx$GEOID) return(df) } @@ -74,13 +87,15 @@ lq_fun <- function(x, omit_NAs) { # Internal function for the aspatial Local Exposure & Isolation (Bemanian & Beyer 2017) metric ## Returns NA value if only one smaller geography in a larger geography lexis_fun <- function(x, omit_NAs) { - xx <- x[ , c("TotalPopE", "subgroup", "subgroup_ixn", "GEOID")] + xx <- x[ , c('TotalPopE', 'subgroup', 'subgroup_ixn', 'GEOID')] if (omit_NAs == TRUE) { xx <- xx[stats::complete.cases(xx), ] } if (nrow(x) < 2 || any(xx < 0) || any(is.na(xx))) { NA } else { p_im <- xx$subgroup / xx$TotalPopE + if (anyNA(p_im)) { p_im[is.na(p_im), ] <- 0 } p_in <- xx$subgroup_ixn / xx$TotalPopE + if (anyNA(p_in)) { p_in[is.na(p_in), ] <- 0 } P_m <- sum(xx$subgroup, na.rm = TRUE) / sum(xx$TotalPopE, na.rm = TRUE) P_n <- sum(xx$subgroup_ixn, na.rm = TRUE) / sum(xx$TotalPopE, na.rm = TRUE) LExIs <- car::logit(p_im * p_in) - car::logit(P_m * P_n) From f0346d943ef8a09660f0aca6b52c73ad42886ccc Mon Sep 17 00:00:00 2001 From: Ian D Buller Date: Sat, 6 Jul 2024 13:22:56 -0400 Subject: [PATCH 3/7] :truck: * Replaced 'package.R' with 'ndi-package.R' * 'package.R' deprecated --- NEWS.md | 1 + R/ndi-package.R | 64 +++++++++++++++++++++++++++++++++++++++++++++++++ R/package.R | 63 ------------------------------------------------ 3 files changed, 65 insertions(+), 63 deletions(-) create mode 100644 R/ndi-package.R delete mode 100644 R/package.R diff --git a/NEWS.md b/NEWS.md index 85e070f..e08d78a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,7 @@ ### Updates * Fixed bug in `bell()`, `bemanian_beyer()`, `duncan()`, `sudano()`, and `white()` when a smaller geography contains n=0 total population, will assign a value of zero (0) in the internal calculation instead of NA +* 'package.R' deprecated. Replaced with 'ndi-package.R'. ## ndi v0.1.5 diff --git a/R/ndi-package.R b/R/ndi-package.R new file mode 100644 index 0000000..efc4dc6 --- /dev/null +++ b/R/ndi-package.R @@ -0,0 +1,64 @@ +#' The ndi Package: Neighborhood Deprivation Indices +#' +#' Computes various metrics of socio-economic deprivation and disparity in the United States based on information available from the U.S. Census Bureau. +#' +#' @details The 'ndi' package computes various metrics of socio-economic deprivation and disparity in the United States. Some metrics are considered "spatial" because they consider the values of neighboring (i.e., adjacent) census geographies in their computation, while other metrics are "aspatial" because they only consider the value within each census geography. Two types of aspatial neighborhood deprivation indices (NDI) are available: (1) based on Messer et al. (2006) \doi{10.1007/s11524-006-9094-x} and (2) based on Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} and Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002} who use variables chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x}. Both are a decomposition of multiple demographic characteristics from the U.S. Census Bureau American Community Survey 5-year estimates (ACS-5; 2006-2010 onward). Using data from the ACS-5 (2005-2009 onward), the package can also compute the (1) spatial Racial Isolation Index (RI) based on Anthopolos et al. (2011) \doi{10.1016/j.sste.2011.06.002}, (2) spatial Educational Isolation Index (EI) based on Bravo et al. (2021) \doi{10.3390/ijerph18179384}, (3) aspatial Index of Concentration at the Extremes (ICE) based on Feldman et al. (2015) \doi{10.1136/jech-2015-205728} and Krieger et al. (2016) \doi{10.2105/AJPH.2015.302955}, (4) aspatial racial/ethnic Dissimilarity Index based on Duncan & Duncan (1955) \doi{10.2307/2088328}, (5) aspatial income or racial/ethnic Atkinson Index based on Atkinson (1970) \doi{10.1016/0022-0531(70)90039-6}, (6) aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954) \doi{10.2307/2574118}, (7) aspatial racial/ethnic Correlation Ratio based on Bell (1954) \doi{10.2307/2574118} and White (1986) \doi{10.2307/3644339}, (8) aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) \doi{10.2307/2084686} and Sudano et al. (2013) \doi{10.1016/j.healthplace.2012.09.015}, (9) aspatial racial/ethnic Local Exposure and Isolation metric based on Bemanian & Beyer (2017) , and (10) aspatial racial/ethnic Delta based on Hoover (1941) and Duncan et al. (1961; LC:60007089). Also using data from the ACS-5 (2005-2009 onward), the package can retrieve the aspatial Gini Index based on Gini (1921) \doi{10.2307/2223319}. +#' +#' Key content of the 'ndi' package include:\cr +#' +#' \bold{Metrics of Socio-Economic Deprivation and Disparity} +#' +#' \code{\link{anthopolos}} Computes the spatial Racial Isolation Index (RI) based on Anthopolos (2011) \doi{10.1016/j.sste.2011.06.002}. +#' +#' \code{\link{atkinson}} Computes the aspatial income or racial/ethnic Atkinson Index (AI) based on Atkinson (1970) \doi{10.1016/0022-0531(70)90039-6}. +#' +#' \code{\link{bell}} Computes the aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954) \doi{10.2307/2574118}. +#' +#' \code{\link{bemanian_beyer}} Computes the aspatial racial/ethnic Local Exposure and Isolation (LEx/Is) metric based on Bemanian & Beyer (2017) \doi{10.1158/1055-9965.EPI-16-0926}. +#' +#' \code{\link{bravo}} Computes the spatial Educational Isolation Index (EI) based on Bravo (2021) \doi{10.3390/ijerph18179384}. +#' +#' \code{\link{duncan}} Computes the aspatial racial/ethnic Dissimilarity Index (DI) based on Duncan & Duncan (1955) \doi{10.2307/2088328}. +#' +#' \code{\link{gini}} Retrieves the aspatial Gini Index based on Gini (1921) \doi{10.2307/2223319}. +#' +#' \code{\link{hoover}} Computes the aspatial racial/ethnic Delta (DEL) based on Hoover (1941) \doi{doi:10.1017/S0022050700052980} and Duncan et al. (1961; LC:60007089). +#' +#' \code{\link{krieger}} Computes the aspatial Index of Concentration at the Extremes based on Feldman et al. (2015) \doi{10.1136/jech-2015-205728} and Krieger et al. (2016) \doi{10.2105/AJPH.2015.302955}. +#' +#' \code{\link{messer}} Computes the aspatial Neighborhood Deprivation Index (NDI) based on Messer et al. (2006) \doi{10.1007/s11524-006-9094-x}. +#' +#' \code{\link{powell_wiley}} Computes the aspatial Neighborhood Deprivation Index (NDI) based on Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} and Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002} who use variables chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x}. +#' +#' \code{\link{sudano}} Computes the aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) \doi{10.2307/2084686} and Sudano et al. (2013) \doi{10.1016/j.healthplace.2012.09.015}. +#' +#' \code{\link{white}} Computes the aspatial racial/ethnic Correlation Ratio (V) based on Bell (1954) \doi{10.2307/2574118} and White (1986) \doi{10.2307/3644339}. +#' +#' \bold{Pre-formatted U.S. Census Data} +#' +#' \code{\link{DCtracts2020}} A sample dataset containing information about U.S. Census American Community Survey 5-year estimate data for the District of Columbia census tracts (2020). The data are obtained from the \code{\link[tidycensus]{get_acs}} function and formatted for the \code{\link{messer}} and \code{\link{powell_wiley}} functions input. +#' +#' @name ndi-package +#' @aliases ndi-package ndi +#' +#' @section Dependencies: The 'ndi' package relies heavily upon \code{\link{tidycensus}} to retrieve data from the U.S. Census Bureau American Community Survey five-year estimates and the \code{\link{psych}} for computing the neighborhood deprivation indices. The \code{\link{messer}} function builds upon code developed by Hruska et al. (2022) \doi{10.17605/OSF.IO/M2SAV} by fictionalizing, adding the percent of households earning <$30,000 per year to the NDI computation, and providing the option for computing the ACS-5 2006-2010 NDI values. There is no code companion to compute NDI included in Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} or Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002}, but the package author worked directly with the Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002} authors to replicate their SAS code in R. The spatial metrics RI and EI rely on the \code{\link{sf}} and \code{\link{Matrix}} packages to compute the geospatial adjacency matrix between census geographies. Internal function to calculate AI is based on \code{\link[DescTools]{Atkinson}} function. There is no code companion to compute RI, EI, DI, II, V, LQ, or LEx/Is included in Anthopolos et al. (2011) \doi{10.1016/j.sste.2011.06.002}, Bravo et al. (2021) \doi{10.3390/ijerph18179384}, Duncan & Duncan (1955) \doi{10.2307/2088328}, Bell (1954) \doi{10.2307/2574118}, White (1986) \doi{10.2307/3644339}, Sudano et al. (2013) \doi{10.1016/j.healthplace.2012.09.015}, or Bemanian & Beyer (2017) \doi{10.1158/1055-9965.EPI-16-0926}, respectively. +#' +#' @author Ian D. Buller\cr \emph{Social & Scientific Systems, Inc., a DLH Corporation Holding Company, Bethesda, Maryland, USA (current); Occupational and Environmental Epidemiology Branch, Division of Cancer Epidemiology and Genetics, National Cancer Institute, National Institutes of Health, Rockville, Maryland, USA (original).} \cr +#' +#' Maintainer: I.D.B. \email{ian.buller@@alumni.emory.edu} +#' +#' @keywords internal +'_PACKAGE' + +#' @import dplyr +#' @importFrom car logit +#' @importFrom MASS ginv +#' @importFrom Matrix sparseMatrix +#' @importFrom psych alpha principal +#' @importFrom sf st_drop_geometry st_geometry st_intersects +#' @importFrom stats complete.cases cor cov2cor loadings median na.omit promax quantile sd setNames +#' @importFrom stringr str_trim +#' @importFrom tidycensus get_acs +#' @importFrom tidyr pivot_longer separate +#' @importFrom utils stack +NULL diff --git a/R/package.R b/R/package.R deleted file mode 100644 index 6113eef..0000000 --- a/R/package.R +++ /dev/null @@ -1,63 +0,0 @@ -#' The ndi Package: Neighborhood Deprivation Indices -#' -#' Computes various metrics of socio-economic deprivation and disparity in the United States based on information available from the U.S. Census Bureau. -#' -#' @details The 'ndi' package computes various metrics of socio-economic deprivation and disparity in the United States. Some metrics are considered "spatial" because they consider the values of neighboring (i.e., adjacent) census geographies in their computation, while other metrics are "aspatial" because they only consider the value within each census geography. Two types of aspatial neighborhood deprivation indices (NDI) are available: (1) based on Messer _et al._ (2006) \doi{10.1007/s11524-006-9094-x} and (2) based on Andrews _et al._ (2020) \doi{10.1080/17445647.2020.1750066} and Slotman _et al._ (2022) \doi{10.1016/j.dib.2022.108002} who use variables chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x}. Both are a decomposition of multiple demographic characteristics from the U.S. Census Bureau American Community Survey 5-year estimates (ACS-5; 2006-2010 onward). Using data from the ACS-5 (2005-2009 onward), the package can also compute the (1) spatial Racial Isolation Index (RI) based on Anthopolos _et al._ (2011) \doi{10.1016/j.sste.2011.06.002}, (2) spatial Educational Isolation Index (EI) based on Bravo _et al._ (2021) \doi{10.3390/ijerph18179384}, (3) aspatial Index of Concentration at the Extremes (ICE) based on Feldman _et al._ (2015) \doi{10.1136/jech-2015-205728} and Krieger _et al._ (2016) \doi{10.2105/AJPH.2015.302955}, (4) aspatial racial/ethnic Dissimilarity Index based on Duncan & Duncan (1955) \doi{10.2307/2088328}, (5) aspatial income or racial/ethnic Atkinson Index based on Atkinson (1970) \doi{10.1016/0022-0531(70)90039-6}, (6) aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954) \doi{10.2307/2574118}, (7) aspatial racial/ethnic Correlation Ratio based on Bell (1954) \doi{10.2307/2574118} and White (1986) \doi{10.2307/3644339}, and (8) aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) \doi{10.2307/2084686} and Sudano _et al._ (2013) \doi{10.1016/j.healthplace.2012.09.015}. Also using data from the ACS-5 (2005-2009 onward), the package can retrieve the aspatial Gini Index based on Gini (1921) \doi{10.2307/2223319}. -#' -#' Key content of the 'ndi' package include:\cr -#' -#' \bold{Metrics of Socio-Economic Deprivation and Disparity} -#' -#' \code{\link{anthopolos}} Computes the spatial Racial Isolation Index (RI) based on Anthopolos (2011) \doi{10.1016/j.sste.2011.06.002}. -#' -#' \code{\link{atkinson}} Computes the aspatial income or racial/ethnic Atkinson Index (AI) based on Atkinson (1970) \doi{10.1016/0022-0531(70)90039-6}. -#' -#' \code{\link{bell}} Computes the aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954) \doi{10.2307/2574118}. -#' -#' \code{\link{bemanian_beyer}} Computes the aspatial racial/ethnic Local Exposure and Isolation (LEx/Is) metric based on Bemanian & Beyer (2017) \doi{10.1158/1055-9965.EPI-16-0926}. -#' -#' \code{\link{bravo}} Computes the spatial Educational Isolation Index (EI) based on Bravo (2021) \doi{10.3390/ijerph18179384}. -#' -#' \code{\link{duncan}} Computes the aspatial racial/ethnic Dissimilarity Index (DI) based on Duncan & Duncan (1955) \doi{10.2307/2088328}. -#' -#' \code{\link{gini}} Retrieves the aspatial Gini Index based on Gini (1921) \doi{10.2307/2223319}. -#' -#' \code{\link{krieger}} Computes the aspatial Index of Concentration at the Extremes based on Feldman _et al._ (2015) \doi{10.1136/jech-2015-205728} and Krieger _et al._ (2016) \doi{10.2105/AJPH.2015.302955}. -#' -#' \code{\link{messer}} Computes the aspatial Neighborhood Deprivation Index (NDI) based on Messer _et al._ (2006) \doi{10.1007/s11524-006-9094-x}. -#' -#' \code{\link{powell_wiley}} Computes the aspatial Neighborhood Deprivation Index (NDI) based on Andrews _et al._ (2020) \doi{10.1080/17445647.2020.1750066} and Slotman _et al._ (2022) \doi{10.1016/j.dib.2022.108002} who use variables chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x}. -#' -#' \code{\link{sudano}} Computes the aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) \doi{10.2307/2084686} and Sudano _et al._ (2013) \doi{10.1016/j.healthplace.2012.09.015}. -#' -#' \code{\link{white}} Computes the aspatial racial/ethnic Correlation Ratio (V) based on Bell (1954) \doi{10.2307/2574118} and White (1986) \doi{10.2307/3644339}. -#' -#' \bold{Pre-formatted U.S. Census Data} -#' -#' \code{\link{DCtracts2020}} A sample dataset containing information about U.S. Census American Community Survey 5-year estimate data for the District of Columbia census tracts (2020). The data are obtained from the \code{\link[tidycensus]{get_acs}} function and formatted for the \code{\link{messer}} and \code{\link{powell_wiley}} functions input. -#' -#' @name ndi-package -#' @aliases ndi-package ndi -#' @docType package -#' -#' @section Dependencies: The 'ndi' package relies heavily upon \code{\link{tidycensus}} to retrieve data from the U.S. Census Bureau American Community Survey five-year estimates and the \code{\link{psych}} for computing the neighborhood deprivation indices. The \code{\link{messer}} function builds upon code developed by Hruska _et al._ (2022) \doi{10.17605/OSF.IO/M2SAV} by fictionalizing, adding the percent of households earning <$30,000 per year to the NDI computation, and providing the option for computing the ACS-5 2006-2010 NDI values. There is no code companion to compute NDI included in Andrews _et al._ (2020) \doi{10.1080/17445647.2020.1750066} or Slotman _et al._ (2022) \doi{10.1016/j.dib.2022.108002}, but the package author worked directly with the Slotman _et al._ (2022) \doi{10.1016/j.dib.2022.108002} authors to replicate their SAS code in R. The spatial metrics RI and EI rely on the \code{\link{sf}} and \code{\link{Matrix}} packages to compute the geospatial adjacency matrix between census geographies. Internal function to calculate AI is based on \code{\link[DescTools]{Atkinson}} function. There is no code companion to compute RI, EI, DI, II, V, LQ, or LEx/Is included in Anthopolos _et al._ (2011) \doi{10.1016/j.sste.2011.06.002}, Bravo _et al._ (2021) \doi{10.3390/ijerph18179384}, Duncan & Duncan (1955) \doi{10.2307/2088328}, Bell (1954) \doi{10.2307/2574118}, White (1986) \doi{10.2307/3644339}, Sudano _et al._ (2013) \doi{10.1016/j.healthplace.2012.09.015}, or Bemanian & Beyer (2017) \doi{10.1158/1055-9965.EPI-16-0926}, respectively. -#' -#' @author Ian D. Buller\cr \emph{Social & Scientific Systems, Inc., a division of DLH Corporation, Silver Spring, Maryland, USA (current); Occupational and Environmental Epidemiology Branch, Division of Cancer Epidemiology and Genetics, National Cancer Institute, National Institutes of Health, Rockville, Maryland, USA (original).} \cr -#' -#' Maintainer: I.D.B. \email{ian.buller@@alumni.emory.edu} -#' -#' @keywords package -NULL - -#' @import dplyr -#' @importFrom car logit -#' @importFrom MASS ginv -#' @importFrom Matrix sparseMatrix -#' @importFrom psych alpha principal -#' @importFrom sf st_drop_geometry st_geometry st_intersects -#' @importFrom stats complete.cases cor cov2cor loadings median na.omit promax quantile sd setNames -#' @importFrom stringr str_trim -#' @importFrom tidycensus get_acs -#' @importFrom tidyr pivot_longer separate -#' @importFrom utils stack -NULL From 4f60480fb156b3b23eedfe3f81ae843508949180 Mon Sep 17 00:00:00 2001 From: Ian D Buller Date: Sat, 6 Jul 2024 13:27:58 -0400 Subject: [PATCH 4/7] :art: Re-formatted code and documentation throughout * For consistent readability * Updated documentation about value range of V (White) from `{0 to 1}` to `{-Inf to Inf}` --- NEWS.md | 2 + R/DCtracts2020.R | 2 +- R/anthopolos.R | 397 ++++++++------- R/atkinson.R | 489 ++++++++++--------- R/bell.R | 521 +++++++++++--------- R/bemanian_beyer.R | 502 +++++++++++-------- R/bravo.R | 472 +++++++++++------- R/duncan.R | 518 +++++++++++--------- R/gini.R | 102 ++-- R/globals.R | 296 ++++++++++-- R/krieger.R | 693 +++++++++++++++++---------- R/messer.R | 399 +++++++++------ R/powell_wiley.R | 683 +++++++++++++++----------- R/sudano.R | 300 +++++++----- R/white.R | 275 ++++++----- R/zzz.R | 2 +- README.md | 470 ++++++++++-------- data-raw/get_DCtracts2020.R | 281 +++++++---- dev/hex_ndi.R | 82 ++-- inst/CITATION | 624 ++++++++++++------------ man/anthopolos.Rd | 68 +-- man/atkinson.Rd | 63 +-- man/bell.Rd | 60 +-- man/bemanian_beyer.Rd | 60 +-- man/bravo.Rd | 40 +- man/duncan.Rd | 60 +-- man/figures/del.png | Bin 0 -> 378401 bytes man/gini.Rd | 14 +- man/hoover.Rd | 96 ++++ man/krieger.Rd | 16 +- man/messer.Rd | 16 +- man/ndi-package.Rd | 28 +- man/powell_wiley.Rd | 20 +- man/sudano.Rd | 63 +-- man/white.Rd | 57 ++- tests/testthat.R | 2 +- tests/testthat/test-anthopolos.R | 71 ++- tests/testthat/test-atkinson.R | 98 ++-- tests/testthat/test-bell.R | 108 +++-- tests/testthat/test-bemanian_beyer.R | 118 +++-- tests/testthat/test-bravo.R | 71 ++- tests/testthat/test-duncan.R | 118 +++-- tests/testthat/test-gini.R | 54 ++- tests/testthat/test-krieger.R | 49 +- tests/testthat/test-messer.R | 79 ++- tests/testthat/test-powell_wiley.R | 81 +++- tests/testthat/test-sudano.R | 89 ++-- tests/testthat/test-white.R | 89 ++-- 48 files changed, 5338 insertions(+), 3460 deletions(-) create mode 100644 man/figures/del.png create mode 100644 man/hoover.Rd diff --git a/NEWS.md b/NEWS.md index e08d78a..b2f1942 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,8 @@ ### Updates * Fixed bug in `bell()`, `bemanian_beyer()`, `duncan()`, `sudano()`, and `white()` when a smaller geography contains n=0 total population, will assign a value of zero (0) in the internal calculation instead of NA * 'package.R' deprecated. Replaced with 'ndi-package.R'. +* Re-formatted code and documentation throughout for consistent readability +* Updated documentation about value range of V (White) from `{0 to 1}` to `{-Inf to Inf}` ## ndi v0.1.5 diff --git a/R/DCtracts2020.R b/R/DCtracts2020.R index d085901..1e466bf 100644 --- a/R/DCtracts2020.R +++ b/R/DCtracts2020.R @@ -32,4 +32,4 @@ #' head(DCtracts2020) #' #' @source \url{https://github.com/idblr/ndi/blob/master/README.md} -"DCtracts2020" +'DCtracts2020' diff --git a/R/anthopolos.R b/R/anthopolos.R index fe301a1..5b7c95a 100644 --- a/R/anthopolos.R +++ b/R/anthopolos.R @@ -1,50 +1,50 @@ -#' Racial Isolation Index based on Anthopolos _et al._ (2011) -#' +#' Racial Isolation Index based on Anthopolos et al. (2011) +#' #' Compute the spatial Racial Isolation Index (Anthopolos) of selected subgroup(s). #' -#' @param geo Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}. +#' @param geo Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param subgroup Character string specifying the racial/ethnic subgroup(s). See Details for available choices. #' @param quiet Logical. If TRUE, will display messages about potential missing census information. The default is FALSE. #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' -#' @details This function will compute the spatial Racial Isolation Index (RI) of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Anthopolos _et al._ (2011) \doi{10.1016/j.sste.2011.06.002} who originally designed the metric for the racial isolation of non-Hispanic Black individuals. This function provides the computation of RI for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). -#' +#' @details This function will compute the spatial Racial Isolation Index (RI) of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Anthopolos et al. (2011) \doi{10.1016/j.sste.2011.06.002} who originally designed the metric for the racial isolation of non-Hispanic Black individuals. This function provides the computation of RI for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). +#' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the geospatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: #' \itemize{ -#' \item **B03002_002**: not Hispanic or Latino \code{"NHoL"} -#' \item **B03002_003**: not Hispanic or Latino, white alone\code{"NHoLW"} -#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{"NHoLA"} -#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -#' \item **B03002_012**: Hispanic or Latino \code{"HoL"} -#' \item **B03002_013**: Hispanic or Latino, white alone \code{"HoLW"} -#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{"HoLB"} -#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{"HoLA"} -#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +#' \item **B03002_002**: not Hispanic or Latino \code{'NHoL'} +#' \item **B03002_003**: not Hispanic or Latino, white alone\code{'NHoLW'} +#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{'NHoLA'} +#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +#' \item **B03002_012**: Hispanic or Latino \code{'HoL'} +#' \item **B03002_013**: Hispanic or Latino, white alone \code{'HoLW'} +#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{'HoLB'} +#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{'HoLA'} +#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} #' } -#' +#' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. NOTE: Current version does not correct for edge effects (e.g., census geographies along the specified spatial extent border, coastline, or U.S.-Mexico / U.S.-Canada border) may have few neighboring census geographies, and RI values in these census geographies may be unstable. A stop-gap solution for the former source of edge effect is to compute the RI for neighboring census geographies (i.e., the states bordering a study area of interest) and then use the estimates of the study area of interest. -#' +#' #' A census geography (and its neighbors) that has nearly all of its population who identify with the specified race/ethnicity subgroup(s) (e.g., non-Hispanic or Latino, Black or African American alone) will have an RI value close to 1. In contrast, a census geography (and its neighbors) that has nearly none of its population who identify with the specified race/ethnicity subgroup(s) (e.g., not non-Hispanic or Latino, Black or African American alone) will have an RI value close to 0. -#' +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{ri}}{An object of class 'tbl' for the GEOID, name, RI, and raw census values of specified census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute RI.} #' } -#' +#' #' @import dplyr #' @importFrom Matrix sparseMatrix #' @importFrom sf st_drop_geometry st_geometry st_intersects @@ -52,161 +52,206 @@ #' @importFrom tidycensus get_acs #' @importFrom tidyr pivot_longer separate #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Tract-level metric (2020) -#' anthopolos(geo = "tract", state = "GA", -#' year = 2020, subgroup = c("NHoLB", "HoLB")) -#' +#' anthopolos( +#' geo = 'tract', +#' state = 'GA', +#' year = 2020, +#' subgroup = c('NHoLB', 'HoLB') +#' ) +#' #' # County-level metric (2020) -#' anthopolos(geo = "county", state = "GA", -#' year = 2020, subgroup = c("NHoLB", "HoLB")) -#' +#' anthopolos( +#' geo = 'county', +#' state = 'GA', +#' year = 2020, +#' subgroup = c('NHoLB', 'HoLB') +#' ) +#' #' } -#' -anthopolos <- function(geo = "tract", year = 2020, subgroup, quiet = FALSE, ...) { - - # Check arguments - match.arg(geo, choices = c("county", "tract")) - stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - match.arg(subgroup, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) - - # Select census variables - vars <- c(TotalPop = "B03002_001", - NHoL = "B03002_002", - NHoLW = "B03002_003", - NHoLB = "B03002_004", - NHoLAIAN = "B03002_005", - NHoLA = "B03002_006", - NHoLNHOPI = "B03002_007", - NHoLSOR = "B03002_008", - NHoLTOMR = "B03002_009", - NHoLTRiSOR = "B03002_010", - NHoLTReSOR = "B03002_011", - HoL = "B03002_012", - HoLW = "B03002_013", - HoLB = "B03002_014", - HoLAIAN = "B03002_015", - HoLA = "B03002_016", - HoLNHOPI = "B03002_017", - HoLSOR = "B03002_018", - HoLTOMR = "B03002_019", - HoLTRiSOR = "B03002_020", - HoLTReSOR = "B03002_021") - - selected_vars <- vars[c("TotalPop", subgroup)] - out_names <- names(selected_vars) # save for output - prefix <- "subgroup" - suffix <- seq(1:length(subgroup)) - names(selected_vars) <- c("TotalPop", paste(prefix, suffix, sep = "")) - in_names <- paste(names(selected_vars), "E", sep = "") - - # Acquire RI variables and sf geometries - ri_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo, - year = year, - output = "wide", - variables = selected_vars, - geometry = TRUE, ...))) - +#' +anthopolos <- function(geo = 'tract', + year = 2020, + subgroup, + quiet = FALSE, + ...) { - if (geo == "tract") { + # Check arguments + match.arg(geo, choices = c('county', 'tract')) + stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward + match.arg( + subgroup, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) + + # Select census variables + vars <- c( + TotalPop = 'B03002_001', + NHoL = 'B03002_002', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + NHoLAIAN = 'B03002_005', + NHoLA = 'B03002_006', + NHoLNHOPI = 'B03002_007', + NHoLSOR = 'B03002_008', + NHoLTOMR = 'B03002_009', + NHoLTRiSOR = 'B03002_010', + NHoLTReSOR = 'B03002_011', + HoL = 'B03002_012', + HoLW = 'B03002_013', + HoLB = 'B03002_014', + HoLAIAN = 'B03002_015', + HoLA = 'B03002_016', + HoLNHOPI = 'B03002_017', + HoLSOR = 'B03002_018', + HoLTOMR = 'B03002_019', + HoLTRiSOR = 'B03002_020', + HoLTReSOR = 'B03002_021' + ) + + selected_vars <- vars[c('TotalPop', subgroup)] + out_names <- names(selected_vars) # save for output + prefix <- 'subgroup' + suffix <- seq(1:length(subgroup)) + names(selected_vars) <- c('TotalPop', paste(prefix, suffix, sep = '')) + in_names <- paste(names(selected_vars), 'E', sep = '') + + # Acquire RI variables and sf geometries + ri_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + ... + ) + )) + + if (geo == 'tract') { + ri_data <- ri_data %>% + tidyr::separate(NAME, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } else { + ri_data <- ri_data %>% + tidyr::separate(NAME, into = c('county', 'state'), sep = ',') + } + ri_data <- ri_data %>% - tidyr::separate(NAME, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]","", tract)) - } else { - ri_data <- ri_data %>% tidyr::separate(NAME, into = c("county", "state"), sep = ",") - } - - ri_data <- ri_data %>% - dplyr::mutate(subgroup = rowSums(sf::st_drop_geometry(ri_data[ , in_names[-1]]))) - - # Compute RI - ## From Anthopolos et al. (2011) https://doi.org/10.1016/j.sste.2011.06.002 - ## RI_{im} = (Sigma_{j∈∂_{i}} w_{ij} * T_{jm}) / (Sigma_{j∈∂_{i}} w_{ij} * T_{j}) - ## Where: - ## ∂_{i} denotes the set of index units i and its neighbors - ## Given M mutually exclusive racial/ethnic subgroups, m indexes the subgroups of M - ## T_{i} denotes the total population in region i (TotalPop) - ## T_{im} denotes the population of the selected subgroup(s) (subgroup1, ...) - ## w_{ij} denotes a nXn first-order adjacency matrix, where n is the number of census geometries in the study area - ### and the entries of w_{ij} are set to 1 if a boundary is shared by region i and region j and zero otherwise - ### Entries of the main diagonal (since i∈∂_{i}, w_{ij} = w_{ii} when j = i) of w_{ij} are set to 1.5 - ### such that the weight of the index unit, i, is larger than the weights assigned to adjacent tracts - - ## Geospatial adjacency matrix (wij) - tmp <- sf::st_intersects(sf::st_geometry(ri_data), sparse = TRUE) - names(tmp) <- as.character(seq_len(nrow(ri_data))) - tmpL <- length(tmp) - tmpcounts <- unlist(Map(length, tmp)) - tmpi <- rep(1:tmpL, tmpcounts) - tmpj <- unlist(tmp) - wij <- Matrix::sparseMatrix(i = tmpi, j = tmpj, x = 1, dims = c(tmpL, tmpL)) - diag(wij) <- 1.5 - - ## Compute - ri_data <- sf::st_drop_geometry(ri_data) # drop geometries (can join back later) - RIim <- list() - for (i in 1:dim(wij)[1]){ - RIim[[i]] <- sum(as.matrix(wij[i, ])*ri_data[ , "subgroup"]) / sum(as.matrix(wij[i, ])*ri_data[, "TotalPopE"]) - } - ri_data$RI <- unlist(RIim) - - # Warning for missingness of census characteristics - missingYN <- ri_data[ , in_names] - names(missingYN) <- out_names - missingYN <- missingYN %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% - dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) - - if (quiet == FALSE) { - # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + dplyr::mutate(subgroup = rowSums(sf::st_drop_geometry(ri_data[, in_names[-1]]))) + + # Compute RI + ## From Anthopolos et al. (2011) https://doi.org/10.1016/j.sste.2011.06.002 + ## RI_{im} = (Sigma_{j∈∂_{i}} w_{ij} * T_{jm}) / (Sigma_{j∈∂_{i}} w_{ij} * T_{j}) + ## Where: + ## ∂_{i} denotes the set of index units i and its neighbors + ## Given M mutually exclusive racial/ethnic subgroups, m indexes the subgroups of M + ## T_{i} denotes the total population in region i (TotalPop) + ## T_{im} denotes the population of the selected subgroup(s) (subgroup1, ...) + ## w_{ij} denotes a nXn first-order adjacency matrix, where n is the number of census geometries in the study area + ### and the entries of w_{ij} are set to 1 if a boundary is shared by region i and region j and zero otherwise + ### Entries of the main diagonal (since i∈∂_{i}, w_{ij} = w_{ii} when j = i) of w_{ij} are set to 1.5 + ### such that the weight of the index unit, i, is larger than the weights assigned to adjacent tracts + + ## Geospatial adjacency matrix (wij) + tmp <- ri_data %>% + sf::st_geometry() %>% + sf::st_intersects(sparse = TRUE) + names(tmp) <- as.character(seq_len(nrow(ri_data))) + tmpL <- length(tmp) + tmpcounts <- unlist(Map(length, tmp)) + tmpi <- rep(1:tmpL, tmpcounts) + tmpj <- unlist(tmp) + wij <- Matrix::sparseMatrix( + i = tmpi, + j = tmpj, + x = 1, + dims = c(tmpL, tmpL) + ) + diag(wij) <- 1.5 + + ## Compute + ri_data <- ri_data %>% + sf::st_drop_geometry() # drop geometries (can join back later) + RIim <- list() + for (i in 1:dim(wij)[1]) { + RIim[[i]] <- sum(as.matrix(wij[i,]) * ri_data[, 'subgroup']) / + sum(as.matrix(wij[i,]) * ri_data[, 'TotalPopE']) } + ri_data$RI <- unlist(RIim) + + # Warning for missingness of census characteristics + missingYN <- ri_data[, in_names] + names(missingYN) <- out_names + missingYN <- missingYN %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + } + + # Format output + if (geo == 'tract') { + ri <- ri_data %>% + dplyr::select(c('GEOID', 'state', 'county', 'tract', 'RI', dplyr::all_of(in_names))) + names(ri) <- c('GEOID', 'state', 'county', 'tract', 'RI', out_names) + } else { + ri <- ri_data %>% + dplyr::select(c('GEOID', 'state', 'county', 'RI', dplyr::all_of(in_names))) + names(ri) <- c('GEOID', 'state', 'county', 'RI', out_names) + } + + ri <- ri %>% + dplyr::mutate( + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + out <- list(ri = ri, missing = missingYN) + + return(out) } - - # Format output - if (geo == "tract") { - ri <- ri_data %>% - dplyr::select(c("GEOID", - "state", - "county", - "tract", - "RI", - dplyr::all_of(in_names))) - names(ri) <- c("GEOID", "state", "county", "tract", "RI", out_names) - } else { - ri <- ri_data %>% - dplyr::select(c("GEOID", - "state", - "county", - "RI", - dplyr::all_of(in_names))) - names(ri) <- c("GEOID", "state", "county", "RI", out_names) - } - - ri <- ri %>% - dplyr::mutate(state = stringr::str_trim(state), - county = stringr::str_trim(county)) %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - out <- list(ri = ri, - missing = missingYN) - - return(out) -} diff --git a/R/atkinson.R b/R/atkinson.R index 6185ec6..6e6f4ca 100644 --- a/R/atkinson.R +++ b/R/atkinson.R @@ -1,9 +1,9 @@ -#' Atkinson Index based on Atkinson (1970) -#' +#' Atkinson Index based on Atkinson (1970) +#' #' Compute the aspatial Atkinson Index of income or selected racial/ethnic subgroup(s) and U.S. geographies. #' -#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}. -#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}. +#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}. +#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param subgroup Character string specifying the income or racial/ethnic subgroup(s) as the comparison population. See Details for available choices. #' @param epsilon Numerical. Shape parameter that denotes the aversion to inequality. Value must be between 0 and 1.0 (the default is 0.5). @@ -12,47 +12,47 @@ #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' #' @details This function will compute the aspatial Atkinson Index (AI) of income or selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Atkinson (1970) \doi{10.1016/0022-0531(70)90039-6}. This function provides the computation of AI for median household income and any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). -#' -#' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. When \code{subgroup = "MedHHInc"}, the metric will be computed for median household income ("B19013_001"). The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: +#' +#' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. When \code{subgroup = 'MedHHInc'}, the metric will be computed for median household income ('B19013_001'). The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: #' \itemize{ -#' \item **B03002_002**: not Hispanic or Latino \code{"NHoL"} -#' \item **B03002_003**: not Hispanic or Latino, white alone \code{"NHoLW"} -#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{"NHoLA"} -#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -#' \item **B03002_012**: Hispanic or Latino \code{"HoL"} -#' \item **B03002_013**: Hispanic or Latino, white alone \code{"HoLW"} -#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{"HoLB"} -#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{"HoLA"} -#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +#' \item **B03002_002**: not Hispanic or Latino \code{'NHoL'} +#' \item **B03002_003**: not Hispanic or Latino, white alone \code{'NHoLW'} +#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{'NHoLA'} +#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +#' \item **B03002_012**: Hispanic or Latino \code{'HoL'} +#' \item **B03002_013**: Hispanic or Latino, white alone \code{'HoLW'} +#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{'HoLB'} +#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{'HoLA'} +#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} #' } #' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -#' +#' #' AI is a measure of the evenness of residential inequality (e.g., racial/ethnic segregation) when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. The AI metric can range in value from 0 to 1 with smaller values indicating lower levels of inequality (e.g., less segregation). -#' -#' The \code{epsilon} argument that determines how to weight the increments to inequality contributed by different proportions of the Lorenz curve. A user must explicitly decide how heavily to weight smaller geographical units at different points on the Lorenz curve (i.e., whether the index should take greater account of differences among areas of over- or under-representation). The \code{epsilon} argument must have values between 0 and 1.0. For \code{0 <= epsilon < 0.5} or less "inequality-averse," smaller geographical units with a subgroup proportion smaller than the subgroup proportion of the larger geographical unit contribute more to inequality ("over-representation"). For \code{0.5 < epsilon <= 1.0} or more "inequality-averse," smaller geographical units with a subgroup proportion larger than the subgroup proportion of the larger geographical unit contribute more to inequality ("under-representation"). If \code{epsilon = 0.5} (the default), units of over- and under-representation contribute equally to the index. See Section 2.3 of Saint-Jacques _et al._ (2020) \doi{10.48550/arXiv.2002.05819} for one method to select \code{epsilon}. -#' -#' Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the AI value returned is NA. -#' +#' +#' The \code{epsilon} argument that determines how to weight the increments to inequality contributed by different proportions of the Lorenz curve. A user must explicitly decide how heavily to weight smaller geographical units at different points on the Lorenz curve (i.e., whether the index should take greater account of differences among areas of over- or under-representation). The \code{epsilon} argument must have values between 0 and 1.0. For \code{0 <= epsilon < 0.5} or less 'inequality-averse,' smaller geographical units with a subgroup proportion smaller than the subgroup proportion of the larger geographical unit contribute more to inequality ('over-representation'). For \code{0.5 < epsilon <= 1.0} or more 'inequality-averse,' smaller geographical units with a subgroup proportion larger than the subgroup proportion of the larger geographical unit contribute more to inequality ('under-representation'). If \code{epsilon = 0.5} (the default), units of over- and under-representation contribute equally to the index. See Section 2.3 of Saint-Jacques et al. (2020) \doi{10.48550/arXiv.2002.05819} for one method to select \code{epsilon}. +#' +#' Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the AI value returned is NA. +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{ai}}{An object of class 'tbl' for the GEOID, name, and AI at specified larger census geographies.} #' \item{\code{ai_data}}{An object of class 'tbl' for the raw census values at specified smaller census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute AI.} #' } -#' +#' #' @import dplyr #' @importFrom sf st_drop_geometry #' @importFrom stats na.omit @@ -60,195 +60,254 @@ #' @importFrom tidyr pivot_longer separate #' @importFrom utils stack #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Atkinson Index of non-Hispanic Black populations #' ## of census tracts within Georgia, U.S.A., counties (2020) -#' atkinson(geo_large = "county", geo_small = "tract", state = "GA", -#' year = 2020, subgroup = "NHoLB") -#' +#' atkinson( +#' geo_large = 'county', +#' geo_small = 'tract', +#' state = 'GA', +#' year = 2020, +#' subgroup = 'NHoLB' +#' ) +#' #' } -#' -atkinson <- function(geo_large = "county", geo_small = "tract", year = 2020, subgroup, epsilon = 0.5, omit_NAs = TRUE, quiet = FALSE, ...) { - - # Check arguments - match.arg(geo_large, choices = c("state", "county", "tract")) - match.arg(geo_small, choices = c("county", "tract", "block group")) - stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - match.arg(subgroup, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR", "MedHHInc")) - stopifnot(is.numeric(epsilon), epsilon >= 0 , epsilon <= 1) # values between 0 and 1 - - # Select census variables - vars <- c(NHoL = "B03002_002", - NHoLW = "B03002_003", - NHoLB = "B03002_004", - NHoLAIAN = "B03002_005", - NHoLA = "B03002_006", - NHoLNHOPI = "B03002_007", - NHoLSOR = "B03002_008", - NHoLTOMR = "B03002_009", - NHoLTRiSOR = "B03002_010", - NHoLTReSOR = "B03002_011", - HoL = "B03002_012", - HoLW = "B03002_013", - HoLB = "B03002_014", - HoLAIAN = "B03002_015", - HoLA = "B03002_016", - HoLNHOPI = "B03002_017", - HoLSOR = "B03002_018", - HoLTOMR = "B03002_019", - HoLTRiSOR = "B03002_020", - HoLTReSOR = "B03002_021", - MedHHInc = "B19013_001") - - selected_vars <- vars[subgroup] - out_names <- names(selected_vars) # save for output - in_subgroup <- paste(subgroup, "E", sep = "") - - # Acquire AI variables and sf geometries - ai_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo_small, - year = year, - output = "wide", - variables = selected_vars, - geometry = TRUE, - keep_geo_vars = TRUE, ...))) - - # Format output - if (geo_small == "county") { - ai_data <- sf::st_drop_geometry(ai_data) %>% - tidyr::separate(NAME.y, into = c("county", "state"), sep = ",") - } - if (geo_small == "tract") { - ai_data <- sf::st_drop_geometry(ai_data) %>% - tidyr::separate(NAME.y, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract)) - } - if (geo_small == "block group") { - ai_data <- sf::st_drop_geometry(ai_data) %>% - tidyr::separate(NAME.y, into = c("block.group", "tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract), - block.group = gsub("[^0-9\\.]", "", block.group)) - } +#' +atkinson <- function(geo_large = 'county', + geo_small = 'tract', + year = 2020, + subgroup, + epsilon = 0.5, + omit_NAs = TRUE, + quiet = FALSE, + ...) { - # Grouping IDs for AI computation - if (geo_large == "tract") { - ai_data <- ai_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) - } - if (geo_large == "county") { - ai_data <- ai_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) - } - if (geo_large == "state") { - ai_data <- ai_data %>% - dplyr::mutate(oid = .$STATEFP, - state = stringr::str_trim(state)) - } - - # Count of racial/ethnic subgroup populations - ## Count of racial/ethnic subgroup population - if (length(in_subgroup) == 1) { - ai_data <- ai_data %>% - dplyr::mutate(subgroup = .[ , in_subgroup]) - } else { - ai_data <- ai_data %>% - dplyr::mutate(subgroup = rowSums(.[ , in_subgroup])) - } - - # Compute AI - ## From Atkinson (1970) https://doi.org/10.1016/0022-0531(70)90039-6 - ## A_{\epsilon}(x_{1},...,x_{n}) = \begin{Bmatrix} - ## 1 - (\frac{1}{n}\sum_{i=1}^{n}x_{i}^{1-\epsilon})^{1/(1-\epsilon)}/(\frac{1}{n}\sum_{i=1}^{n}x_{i}) & \mathrm{if\:} \epsilon \neq 1 \\ - ## 1 - (\prod_{i=1}^{n}x_{i})^{1/n}/(\frac{1}{n}\sum_{i=1}^{n}x_{i}) & \mathrm{if\:} \epsilon = 1 \\ - ## \end{Bmatrix} - ## Where the Atkinson index (A) is defined for a population subgroup count (x) of a given smaller geographical unit (i) for n smaller geographical units - ## and an inequality-aversion parameter (epsilon) - ## If denoting the Hölder mean (based on `Atkinson()` function in 'DescTools' package) by - ## M_{p}(x_{1},...,x_{n}) = \begin{Bmatrix} - ## (\frac{1}{n}\sum_{i=1}^{n}x_{i}^{p})^{1/p} & \mathrm{if\:} p \neq 0 \\ - ## (\prod_{i=1}^{n}x_{i})^{1/n} & \mathrm{if\:} p = 0 \\ - ## \end{Bmatrix} - ## then AI is - ## A_{\epsilon}(x_{1},...,x_{n}) = 1 - \frac{M_{1-\epsilon}(x_{1},...,x_{n})}{M_{1}(x_{1},...,x_{n})} - - ## Compute - AItmp <- ai_data %>% - split(., f = list(ai_data$oid)) %>% - lapply(., FUN = ai_fun, epsilon = epsilon, omit_NAs = omit_NAs) %>% - utils::stack(.) %>% - dplyr::mutate(AI = values, - oid = ind) %>% - dplyr::select(AI, oid) - - # Warning for missingness of census characteristics - missingYN <- as.data.frame(ai_data[ , in_subgroup]) - names(missingYN) <- out_names - missingYN <- missingYN %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% - dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) - - if (quiet == FALSE) { - # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + # Check arguments + match.arg(geo_large, choices = c('state', 'county', 'tract')) + match.arg(geo_small, choices = c('county', 'tract', 'block group')) + stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward + match.arg( + subgroup, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR', + 'MedHHInc' + ) + ) + stopifnot(is.numeric(epsilon), epsilon >= 0 , epsilon <= 1) # values between 0 and 1 + + # Select census variables + vars <- c( + NHoL = 'B03002_002', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + NHoLAIAN = 'B03002_005', + NHoLA = 'B03002_006', + NHoLNHOPI = 'B03002_007', + NHoLSOR = 'B03002_008', + NHoLTOMR = 'B03002_009', + NHoLTRiSOR = 'B03002_010', + NHoLTReSOR = 'B03002_011', + HoL = 'B03002_012', + HoLW = 'B03002_013', + HoLB = 'B03002_014', + HoLAIAN = 'B03002_015', + HoLA = 'B03002_016', + HoLNHOPI = 'B03002_017', + HoLSOR = 'B03002_018', + HoLTOMR = 'B03002_019', + HoLTRiSOR = 'B03002_020', + HoLTReSOR = 'B03002_021', + MedHHInc = 'B19013_001' + ) + + selected_vars <- vars[subgroup] + out_names <- names(selected_vars) # save for output + in_subgroup <- paste(subgroup, 'E', sep = '') + + # Acquire AI variables and sf geometries + ai_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo_small, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + keep_geo_vars = TRUE, + ... + ) + )) + + # Format output + if (geo_small == 'county') { + ai_data <- ai_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('county', 'state'), sep = ',') } + if (geo_small == 'tract') { + ai_data <- ai_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } + if (geo_small == 'block group') { + ai_data <- ai_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('block.group', 'tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate( + tract = gsub('[^0-9\\.]', '', tract), + block.group = gsub('[^0-9\\.]', '', block.group) + ) + } + + # Grouping IDs for AI computation + if (geo_large == 'tract') { + ai_data <- ai_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'county') { + ai_data <- ai_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'state') { + ai_data <- ai_data %>% + dplyr::mutate( + oid = .$STATEFP, + state = stringr::str_trim(state) + ) + } + + # Count of racial/ethnic subgroup populations + ## Count of racial/ethnic subgroup population + if (length(in_subgroup) == 1) { + ai_data <- ai_data %>% + dplyr::mutate(subgroup = .[, in_subgroup]) + } else { + ai_data <- ai_data %>% + dplyr::mutate(subgroup = rowSums(.[, in_subgroup])) + } + + # Compute AI + ## From Atkinson (1970) https://doi.org/10.1016/0022-0531(70)90039-6 + ## A_{\epsilon}(x_{1},...,x_{n}) = \begin{Bmatrix} + ## 1 - (\frac{1}{n}\sum_{i=1}^{n}x_{i}^{1-\epsilon})^{1/(1-\epsilon)}/(\frac{1}{n}\sum_{i=1}^{n}x_{i}) & \mathrm{if\:} \epsilon \neq 1 \\ + ## 1 - (\prod_{i=1}^{n}x_{i})^{1/n}/(\frac{1}{n}\sum_{i=1}^{n}x_{i}) & \mathrm{if\:} \epsilon = 1 \\ + ## \end{Bmatrix} + ## Where the Atkinson index (A) is defined for a population subgroup count (x) of a given smaller geographical unit (i) for n smaller geographical units + ## and an inequality-aversion parameter (epsilon) + ## If denoting the Hölder mean (based on `Atkinson()` function in 'DescTools' package) by + ## M_{p}(x_{1},...,x_{n}) = \begin{Bmatrix} + ## (\frac{1}{n}\sum_{i=1}^{n}x_{i}^{p})^{1/p} & \mathrm{if\:} p \neq 0 \\ + ## (\prod_{i=1}^{n}x_{i})^{1/n} & \mathrm{if\:} p = 0 \\ + ## \end{Bmatrix} + ## then AI is + ## A_{\epsilon}(x_{1},...,x_{n}) = 1 - \frac{M_{1-\epsilon}(x_{1},...,x_{n})}{M_{1}(x_{1},...,x_{n})} + + ## Compute + AItmp <- ai_data %>% + split(., f = list(ai_data$oid)) %>% + lapply(., FUN = ai_fun, epsilon = epsilon, omit_NAs = omit_NAs) %>% + utils::stack(.) %>% + dplyr::mutate( + AI = values, + oid = ind + ) %>% + dplyr::select(AI, oid) + + # Warning for missingness of census characteristics + missingYN <- as.data.frame(ai_data[, in_subgroup]) + names(missingYN) <- out_names + missingYN <- missingYN %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + } + + # Format output + if (geo_large == 'state') { + ai <- ai_data %>% + dplyr::left_join(AItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, AI) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, AI) %>% + .[.$GEOID != 'NANA',] + } + if (geo_large == 'county') { + ai <- ai_data %>% + dplyr::left_join(AItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, county, AI) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, county, AI) %>% + .[.$GEOID != 'NANA',] + } + if (geo_large == 'tract') { + ai <- ai_data %>% + dplyr::left_join(AItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, county, tract, AI) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, county, tract, AI) %>% + .[.$GEOID != 'NANA',] + } + + ai <- ai %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + ai_data <- ai_data %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + out <- list(ai = ai, ai_data = ai_data, missing = missingYN) + + return(out) } - - # Format output - if (geo_large == "state") { - ai <- merge(ai_data, AItmp) %>% - dplyr::select(oid, state, AI) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, AI) %>% - .[.$GEOID != "NANA", ] - } - if (geo_large == "county") { - ai <- merge(ai_data, AItmp) %>% - dplyr::select(oid, state, county, AI) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, county, AI) %>% - .[.$GEOID != "NANA", ] - } - if (geo_large == "tract") { - ai <- merge(ai_data, AItmp) %>% - dplyr::select(oid, state, county, tract, AI) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, county, tract, AI) %>% - .[.$GEOID != "NANA", ] - } - - ai <- ai %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - ai_data <- ai_data %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - out <- list(ai = ai, - ai_data = ai_data, - missing = missingYN) - - return(out) -} diff --git a/R/bell.R b/R/bell.R index 29d7e36..22b4cfe 100644 --- a/R/bell.R +++ b/R/bell.R @@ -1,9 +1,9 @@ -#' Isolation Index based on Shevky & Williams (1949) and Bell (1954) -#' +#' Isolation Index based on Shevky & Williams (1949) and Bell (1954) +#' #' Compute the aspatial Isolation Index (Bell) of a selected racial/ethnic subgroup(s) and U.S. geographies. #' -#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}. -#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}. +#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}. +#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param subgroup Character string specifying the racial/ethnic subgroup(s). See Details for available choices. #' @param subgroup_ixn Character string specifying the racial/ethnic subgroup(s) as the interaction population. If the same as \code{subgroup}, will compute the simple isolation of the group. See Details for available choices. @@ -12,45 +12,45 @@ #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' #' @details This function will compute the aspatial Isolation Index (II) of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954) \doi{10.2307/2574118}. This function provides the computation of II for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). -#' +#' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: #' \itemize{ -#' \item **B03002_002**: not Hispanic or Latino \code{"NHoL"} -#' \item **B03002_003**: not Hispanic or Latino, white alone \code{"NHoLW"} -#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{"NHoLA"} -#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -#' \item **B03002_012**: Hispanic or Latino \code{"HoL"} -#' \item **B03002_013**: Hispanic or Latino, white alone \code{"HoLW"} -#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{"HoLB"} -#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{"HoLA"} -#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +#' \item **B03002_002**: not Hispanic or Latino \code{'NHoL'} +#' \item **B03002_003**: not Hispanic or Latino, white alone \code{'NHoLW'} +#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{'NHoLA'} +#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +#' \item **B03002_012**: Hispanic or Latino \code{'HoL'} +#' \item **B03002_013**: Hispanic or Latino, white alone \code{'HoLW'} +#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{'HoLB'} +#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{'HoLA'} +#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} #' } -#' +#' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -#' +#' #' II is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation). II can range in value from 0 to 1. -#' -#' Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the II value returned is NA. -#' +#' +#' Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the II value returned is NA. +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{ii}}{An object of class 'tbl' for the GEOID, name, and II at specified larger census geographies.} #' \item{\code{ii_data}}{An object of class 'tbl' for the raw census values at specified smaller census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute II.} #' } -#' +#' #' @import dplyr #' @importFrom sf st_drop_geometry #' @importFrom stats complete.cases @@ -58,202 +58,283 @@ #' @importFrom tidyr pivot_longer separate #' @importFrom utils stack #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Isolation of non-Hispanic Black vs. non-Hispanic white populations #' ## of census tracts within Georgia, U.S.A., counties (2020) -#' bell(geo_large = "county", geo_small = "tract", state = "GA", -#' year = 2020, subgroup = "NHoLB", subgroup_ixn = "NHoLW") -#' +#' bell( +#' geo_large = 'county', +#' geo_small = 'tract', +#' state = 'GA', +#' year = 2020, +#' subgroup = 'NHoLB', +#' subgroup_ixn = 'NHoLW' +#' ) +#' #' } -#' -bell <- function(geo_large = "county", geo_small = "tract", year = 2020, subgroup, subgroup_ixn, omit_NAs = TRUE, quiet = FALSE, ...) { - - # Check arguments - match.arg(geo_large, choices = c("state", "county", "tract")) - match.arg(geo_small, choices = c("county", "tract", "block group")) - stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - match.arg(subgroup, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) - match.arg(subgroup_ixn, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) - - # Select census variables - vars <- c(TotalPop = "B03002_001", - NHoL = "B03002_002", - NHoLW = "B03002_003", - NHoLB = "B03002_004", - NHoLAIAN = "B03002_005", - NHoLA = "B03002_006", - NHoLNHOPI = "B03002_007", - NHoLSOR = "B03002_008", - NHoLTOMR = "B03002_009", - NHoLTRiSOR = "B03002_010", - NHoLTReSOR = "B03002_011", - HoL = "B03002_012", - HoLW = "B03002_013", - HoLB = "B03002_014", - HoLAIAN = "B03002_015", - HoLA = "B03002_016", - HoLNHOPI = "B03002_017", - HoLSOR = "B03002_018", - HoLTOMR = "B03002_019", - HoLTRiSOR = "B03002_020", - HoLTReSOR = "B03002_021") - - selected_vars <- vars[c("TotalPop", subgroup, subgroup_ixn)] - out_names <- names(selected_vars) # save for output - in_subgroup <- paste(subgroup, "E", sep = "") - in_subgroup_ixn <- paste(subgroup_ixn, "E", sep = "") - - # Acquire II variables and sf geometries - ii_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo_small, - year = year, - output = "wide", - variables = selected_vars, - geometry = TRUE, - keep_geo_vars = TRUE, ...))) - - # Format output - if (geo_small == "county") { - ii_data <- sf::st_drop_geometry(ii_data) %>% - tidyr::separate(NAME.y, into = c("county", "state"), sep = ",") - } - if (geo_small == "tract") { - ii_data <- sf::st_drop_geometry(ii_data) %>% - tidyr::separate(NAME.y, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract)) - } - if (geo_small == "block group") { - ii_data <- sf::st_drop_geometry(ii_data) %>% - tidyr::separate(NAME.y, into = c("block.group", "tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract), - block.group = gsub("[^0-9\\.]", "", block.group)) - } - - # Grouping IDs for II computation - if (geo_large == "tract") { - ii_data <- ii_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) - } - if (geo_large == "county") { - ii_data <- ii_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) - } - if (geo_large == "state") { - ii_data <- ii_data %>% - dplyr::mutate(oid = .$STATEFP, - state = stringr::str_trim(state)) - } - - # Count of racial/ethnic subgroup populations - ## Count of racial/ethnic comparison subgroup population - if (length(in_subgroup) == 1) { - ii_data <- ii_data %>% - dplyr::mutate(subgroup = .[ , in_subgroup]) - } else { - ii_data <- ii_data %>% - dplyr::mutate(subgroup = rowSums(.[ , in_subgroup])) - } - ## Count of racial/ethnic interaction subgroup population - if (length(in_subgroup_ixn) == 1) { - ii_data <- ii_data %>% - dplyr::mutate(subgroup_ixn = .[ , in_subgroup_ixn]) - } else { - ii_data <- ii_data %>% - dplyr::mutate(subgroup_ixn = rowSums(.[ , in_subgroup_ixn])) - } - - # Compute II - ## From Bell (1954) https://doi.org/10.2307/2574118 - ## _{x}P_{y}^* = \sum_{i=1}^{k} \left ( \frac{x_{i}}{X}\right )\left ( \frac{y_{i}}{n_{i}}\right ) - ## Where for k geographical units i: - ## X denotes the total number of subgroup population in study (reference) area - ## x_{i} denotes the number of subgroup population X in geographical unit i - ## y_{i} denotes the number of subgroup population Y in geographical unit i - ## n_{i} denotes the total population of geographical unit i - ## If x_{i} = y_{i}, then computes the average isolation experienced by members of subgroup population X - - ## Compute - IItmp <- ii_data %>% - split(., f = list(ii_data$oid)) %>% - lapply(., FUN = ii_fun, omit_NAs = omit_NAs) %>% - utils::stack(.) %>% - dplyr::mutate(II = values, - oid = ind) %>% - dplyr::select(II, oid) - - # Warning for missingness of census characteristics - missingYN <- ii_data[ , c("TotalPopE", in_subgroup, in_subgroup_ixn)] - names(missingYN) <- out_names - missingYN <- missingYN %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% - dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) +#' +bell <- function(geo_large = 'county', + geo_small = 'tract', + year = 2020, + subgroup, + subgroup_ixn, + omit_NAs = TRUE, + quiet = FALSE, + ...) { - if (quiet == FALSE) { - # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + # Check arguments + match.arg(geo_large, choices = c('state', 'county', 'tract')) + match.arg(geo_small, choices = c('county', 'tract', 'block group')) + stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward + match.arg( + subgroup, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) + match.arg( + subgroup_ixn, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) + + # Select census variables + vars <- c( + TotalPop = 'B03002_001', + NHoL = 'B03002_002', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + NHoLAIAN = 'B03002_005', + NHoLA = 'B03002_006', + NHoLNHOPI = 'B03002_007', + NHoLSOR = 'B03002_008', + NHoLTOMR = 'B03002_009', + NHoLTRiSOR = 'B03002_010', + NHoLTReSOR = 'B03002_011', + HoL = 'B03002_012', + HoLW = 'B03002_013', + HoLB = 'B03002_014', + HoLAIAN = 'B03002_015', + HoLA = 'B03002_016', + HoLNHOPI = 'B03002_017', + HoLSOR = 'B03002_018', + HoLTOMR = 'B03002_019', + HoLTRiSOR = 'B03002_020', + HoLTReSOR = 'B03002_021' + ) + + selected_vars <- vars[c('TotalPop', subgroup, subgroup_ixn)] + out_names <- names(selected_vars) # save for output + in_subgroup <- paste(subgroup, 'E', sep = '') + in_subgroup_ixn <- paste(subgroup_ixn, 'E', sep = '') + + # Acquire II variables and sf geometries + ii_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo_small, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + keep_geo_vars = TRUE, + ... + ) + )) + + + # Format output + if (geo_small == 'county') { + ii_data <- ii_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('county', 'state'), sep = ',') } + if (geo_small == 'tract') { + ii_data <- ii_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } + if (geo_small == 'block group') { + ii_data <- ii_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('block.group', 'tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate( + tract = gsub('[^0-9\\.]', '', tract), + block.group = gsub('[^0-9\\.]', '', block.group) + ) + } + + # Grouping IDs for II computation + if (geo_large == 'tract') { + ii_data <- ii_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'county') { + ii_data <- ii_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'state') { + ii_data <- ii_data %>% + dplyr::mutate( + oid = .$STATEFP, + state = stringr::str_trim(state) + ) + } + + # Count of racial/ethnic subgroup populations + ## Count of racial/ethnic comparison subgroup population + if (length(in_subgroup) == 1) { + ii_data <- ii_data %>% + dplyr::mutate(subgroup = .[, in_subgroup]) + } else { + ii_data <- ii_data %>% + dplyr::mutate(subgroup = rowSums(.[, in_subgroup])) + } + ## Count of racial/ethnic interaction subgroup population + if (length(in_subgroup_ixn) == 1) { + ii_data <- ii_data %>% + dplyr::mutate(subgroup_ixn = .[, in_subgroup_ixn]) + } else { + ii_data <- ii_data %>% + dplyr::mutate(subgroup_ixn = rowSums(.[, in_subgroup_ixn])) + } + + # Compute II + ## From Bell (1954) https://doi.org/10.2307/2574118 + ## _{x}P_{y}^* = \sum_{i=1}^{k} \left ( \frac{x_{i}}{X}\right )\left ( \frac{y_{i}}{n_{i}}\right ) + ## Where for k geographical units i: + ## X denotes the total number of subgroup population in study (reference) area + ## x_{i} denotes the number of subgroup population X in geographical unit i + ## y_{i} denotes the number of subgroup population Y in geographical unit i + ## n_{i} denotes the total population of geographical unit i + ## If x_{i} = y_{i}, then computes the average isolation experienced by members of subgroup population X + + ## Compute + IItmp <- ii_data %>% + split(., f = list(ii_data$oid)) %>% + lapply(., FUN = ii_fun, omit_NAs = omit_NAs) %>% + utils::stack(.) %>% + dplyr::mutate( + II = values, + oid = ind + ) %>% + dplyr::select(II, oid) + + # Warning for missingness of census characteristics + missingYN <- ii_data[, c('TotalPopE', in_subgroup, in_subgroup_ixn)] + names(missingYN) <- out_names + missingYN <- missingYN %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + } + + # Format output + if (geo_large == 'state') { + ii <- ii_data %>% + dplyr::left_join(IItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, II) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, II) %>% + .[.$GEOID != 'NANA',] + } + if (geo_large == 'county') { + ii <- ii_data %>% + dplyr::left_join(IItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, county, II) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, county, II) %>% + .[.$GEOID != 'NANA',] + } + if (geo_large == 'tract') { + ii <- ii_data %>% + dplyr::left_join(IItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, county, tract, II) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, county, tract, II) %>% + .[.$GEOID != 'NANA',] + } + + ii <- ii %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + ii_data <- ii_data %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + out <- list(ii = ii, ii_data = ii_data, missing = missingYN) + + return(out) } - - # Format output - if (geo_large == "state") { - ii <- merge(ii_data, IItmp) %>% - dplyr::select(oid, state, II) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, II) %>% - .[.$GEOID != "NANA", ] - } - if (geo_large == "county") { - ii <- merge(ii_data, IItmp) %>% - dplyr::select(oid, state, county, II) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, county, II) %>% - .[.$GEOID != "NANA", ] - } - if (geo_large == "tract") { - ii <- merge(ii_data, IItmp) %>% - dplyr::select(oid, state, county, tract, II) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, county, tract, II) %>% - .[.$GEOID != "NANA", ] - } - - ii <- ii %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - ii_data <- ii_data %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - out <- list(ii = ii, - ii_data = ii_data, - missing = missingYN) - - return(out) -} diff --git a/R/bemanian_beyer.R b/R/bemanian_beyer.R index b97ee28..fc3b080 100644 --- a/R/bemanian_beyer.R +++ b/R/bemanian_beyer.R @@ -1,9 +1,9 @@ #' Local Exposure and Isolation metric based on Bemanian & Beyer (2017) -#' +#' #' Compute the aspatial Local Exposure and Isolation (Bemanian & Beyer) metric of a selected racial/ethnic subgroup(s) and U.S. geographies. #' -#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}. -#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}. +#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}. +#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param subgroup Character string specifying the racial/ethnic subgroup(s). See Details for available choices. #' @param subgroup_ixn Character string specifying the racial/ethnic subgroup(s) as the interaction population. If the same as \code{subgroup}, will compute the simple isolation of the group. See Details for available choices. @@ -12,47 +12,47 @@ #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' #' @details This function will compute the aspatial Local Exposure and Isolation (LEx/Is) metric of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Bemanian & Beyer (2017) \doi{10.1158/1055-9965.EPI-16-0926}. This function provides the computation of LEx/Is for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). -#' +#' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: #' \itemize{ -#' \item **B03002_002**: not Hispanic or Latino \code{"NHoL"} -#' \item **B03002_003**: not Hispanic or Latino, white alone \code{"NHoLW"} -#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{"NHoLA"} -#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -#' \item **B03002_012**: Hispanic or Latino \code{"HoL"} -#' \item **B03002_013**: Hispanic or Latino, white alone \code{"HoLW"} -#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{"HoLB"} -#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{"HoLA"} -#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +#' \item **B03002_002**: not Hispanic or Latino \code{'NHoL'} +#' \item **B03002_003**: not Hispanic or Latino, white alone \code{'NHoLW'} +#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{'NHoLA'} +#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +#' \item **B03002_012**: Hispanic or Latino \code{'HoL'} +#' \item **B03002_013**: Hispanic or Latino, white alone \code{'HoLW'} +#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{'HoLB'} +#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{'HoLA'} +#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} #' } -#' +#' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -#' +#' #' LEx/Is is a measure of the probability that two individuals living within a specific smaller geography (e.g., census tract) of either different (i.e., exposure) or the same (i.e., isolation) racial/ethnic subgroup(s) will interact, assuming that individuals within a smaller geography are randomly mixed. LEx/Is is standardized with a logit transformation and centered against an expected case that all races/ethnicities are evenly distributed across a larger geography. (Note: will adjust data by 0.025 if probabilities are zero, one, or undefined. The output will include a warning if adjusted. See \code{\link[car]{logit}} for additional details.) -#' +#' #' LEx/Is can range from negative infinity to infinity. If LEx/Is is zero then the estimated probability of the interaction between two people of the given subgroup(s) within a smaller geography is equal to the expected probability if the subgroup(s) were perfectly mixed in the larger geography. If LEx/Is is greater than zero then the interaction is more likely to occur within the smaller geography than in the larger geography, and if LEx/Is is less than zero then the interaction is less likely to occur within the smaller geography than in the larger geography. Note: the exponentiation of each LEx/Is metric results in the odds ratio of the specific exposure or isolation of interest in a smaller geography relative to the larger geography. -#' -#' Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the LEx/Is value returned is NA. -#' +#' +#' Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the LEx/Is value returned is NA. +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{lexis}}{An object of class 'tbl' for the GEOID, name, and LEx/Is at specified smaller census geographies.} #' \item{\code{lexis_data}}{An object of class 'tbl' for the raw census values at specified smaller census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute LEx/Is.} #' } -#' +#' #' @import dplyr #' @importFrom car logit #' @importFrom sf st_drop_geometry @@ -61,196 +61,272 @@ #' @importFrom tidyr pivot_longer separate #' @importFrom utils stack #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Isolation of non-Hispanic Black vs. non-Hispanic white populations #' ## of census tracts within Georgia, U.S.A., counties (2020) -#' bemanian_beyer(geo_large = "county", geo_small = "tract", state = "GA", -#' year = 2020, subgroup = "NHoLB", subgroup_ixn = "NHoLW") -#' +#' bemanian_beyer( +#' geo_large = 'county', +#' geo_small = 'tract', +#' state = 'GA', +#' year = 2020, +#' subgroup = 'NHoLB', +#' subgroup_ixn = 'NHoLW' +#' ) +#' #' } -#' -bemanian_beyer <- function(geo_large = "county", geo_small = "tract", year = 2020, subgroup, subgroup_ixn, omit_NAs = TRUE, quiet = FALSE, ...) { - - # Check arguments - match.arg(geo_large, choices = c("state", "county", "tract")) - match.arg(geo_small, choices = c("county", "tract", "block group")) - stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - match.arg(subgroup, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) - match.arg(subgroup_ixn, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) - - # Select census variables - vars <- c(TotalPop = "B03002_001", - NHoL = "B03002_002", - NHoLW = "B03002_003", - NHoLB = "B03002_004", - NHoLAIAN = "B03002_005", - NHoLA = "B03002_006", - NHoLNHOPI = "B03002_007", - NHoLSOR = "B03002_008", - NHoLTOMR = "B03002_009", - NHoLTRiSOR = "B03002_010", - NHoLTReSOR = "B03002_011", - HoL = "B03002_012", - HoLW = "B03002_013", - HoLB = "B03002_014", - HoLAIAN = "B03002_015", - HoLA = "B03002_016", - HoLNHOPI = "B03002_017", - HoLSOR = "B03002_018", - HoLTOMR = "B03002_019", - HoLTRiSOR = "B03002_020", - HoLTReSOR = "B03002_021") - - selected_vars <- vars[c("TotalPop", subgroup, subgroup_ixn)] - out_names <- names(selected_vars) # save for output - in_subgroup <- paste(subgroup, "E", sep = "") - in_subgroup_ixn <- paste(subgroup_ixn, "E", sep = "") - - # Acquire LEx/Is variables and sf geometries - lexis_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo_small, - year = year, - output = "wide", - variables = selected_vars, - geometry = TRUE, - keep_geo_vars = TRUE, ...))) - - # Format output - if (geo_small == "county") { - lexis_data <- sf::st_drop_geometry(lexis_data) %>% - tidyr::separate(NAME.y, into = c("county", "state"), sep = ",") - } - if (geo_small == "tract") { - lexis_data <- sf::st_drop_geometry(lexis_data) %>% - tidyr::separate(NAME.y, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract)) - } - if (geo_small == "block group") { - lexis_data <- sf::st_drop_geometry(lexis_data) %>% - tidyr::separate(NAME.y, into = c("block.group", "tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract), - block.group = gsub("[^0-9\\.]", "", block.group)) - } - - # Grouping IDs for LEx/Is computation - if (geo_large == "tract") { - lexis_data <- lexis_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) - } - if (geo_large == "county") { - lexis_data <- lexis_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) - } - if (geo_large == "state") { - lexis_data <- lexis_data %>% - dplyr::mutate(oid = .$STATEFP, - state = stringr::str_trim(state)) - } - - # Count of racial/ethnic subgroup populations - ## Count of racial/ethnic comparison subgroup population - if (length(in_subgroup) == 1) { - lexis_data <- lexis_data %>% - dplyr::mutate(subgroup = .[ , in_subgroup]) - } else { - lexis_data <- lexis_data %>% - dplyr::mutate(subgroup = rowSums(.[ , in_subgroup])) - } - ## Count of racial/ethnic interaction subgroup population - if (length(in_subgroup_ixn) == 1) { - lexis_data <- lexis_data %>% - dplyr::mutate(subgroup_ixn = .[ , in_subgroup_ixn]) - } else { - lexis_data <- lexis_data %>% - dplyr::mutate(subgroup_ixn = rowSums(.[ , in_subgroup_ixn])) - } - - # Compute LEx/Is - ## From Bemanian & Beyer (2017) https://doi.org/10.1158/1055-9965.EPI-16-0926 - ## E^*_{m,n}(i) = log\left(\frac{p_{im} \times p_{in}}{1 - p_{im} \times p_{in}}\right) - log\left(\frac{P_{m} \times P_{n}}{1 - P_{m} \times P_{n}}\right) - ## Where for smaller geographical unit i: - ## p_{im} denotes the number of subgroup population m in smaller geographical unit i - ## p_{in} denotes the number of subgroup population n in smaller geographical unit i - ## P_{m} denotes the number of subgroup population m in larger geographical unit within which the smaller geographic unit i is located - ## P_{n} denotes the number of subgroup population n in larger geographical unit within which the smaller geographic unit i is located - ## If m \ne n, then computes the exposure of members of subgroup populations m and n - ## If m = n, then computes the simple isolation experienced by members of subgroup population m - - ## Compute - LExIstmp <- lexis_data %>% - split(., f = list(lexis_data$oid)) %>% - lapply(., FUN = lexis_fun, omit_NAs = omit_NAs) %>% - do.call("rbind", .) - - # Warning for missingness of census characteristics - missingYN <- lexis_data[ , c("TotalPopE", in_subgroup, in_subgroup_ixn)] - names(missingYN) <- out_names - missingYN <- missingYN %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% - dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) +#' +bemanian_beyer <- function(geo_large = 'county', + geo_small = 'tract', + year = 2020, + subgroup, + subgroup_ixn, + omit_NAs = TRUE, + quiet = FALSE, + ...) { - if (quiet == FALSE) { - # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + # Check arguments + match.arg(geo_large, choices = c('state', 'county', 'tract')) + match.arg(geo_small, choices = c('county', 'tract', 'block group')) + stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward + match.arg( + subgroup, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) + match.arg( + subgroup_ixn, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) + + # Select census variables + vars <- c( + TotalPop = 'B03002_001', + NHoL = 'B03002_002', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + NHoLAIAN = 'B03002_005', + NHoLA = 'B03002_006', + NHoLNHOPI = 'B03002_007', + NHoLSOR = 'B03002_008', + NHoLTOMR = 'B03002_009', + NHoLTRiSOR = 'B03002_010', + NHoLTReSOR = 'B03002_011', + HoL = 'B03002_012', + HoLW = 'B03002_013', + HoLB = 'B03002_014', + HoLAIAN = 'B03002_015', + HoLA = 'B03002_016', + HoLNHOPI = 'B03002_017', + HoLSOR = 'B03002_018', + HoLTOMR = 'B03002_019', + HoLTRiSOR = 'B03002_020', + HoLTReSOR = 'B03002_021' + ) + + selected_vars <- vars[c('TotalPop', subgroup, subgroup_ixn)] + out_names <- names(selected_vars) # save for output + in_subgroup <- paste(subgroup, 'E', sep = '') + in_subgroup_ixn <- paste(subgroup_ixn, 'E', sep = '') + + # Acquire LEx/Is variables and sf geometries + lexis_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo_small, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + keep_geo_vars = TRUE, + ... + ) + )) + + # Format output + if (geo_small == 'county') { + lexis_data <- lexis_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('county', 'state'), sep = ',') } - } - - # Format output - lexis <- merge(lexis_data, LExIstmp) - - if (geo_small == "state") { - lexis <- lexis %>% - dplyr::select(GEOID, state, LExIs) - } - if (geo_small == "county") { - lexis <- lexis %>% - dplyr::select(GEOID, state, county, LExIs) - } - if (geo_small == "tract") { - lexis <- lexis %>% - dplyr::select(GEOID, state, county, tract, LExIs) - } - if (geo_small == "block group") { + if (geo_small == 'tract') { + lexis_data <- lexis_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } + if (geo_small == 'block group') { + lexis_data <- lexis_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('block.group', 'tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate( + tract = gsub('[^0-9\\.]', '', tract), + block.group = gsub('[^0-9\\.]', '', block.group) + ) + } + + # Grouping IDs for LEx/Is computation + if (geo_large == 'tract') { + lexis_data <- lexis_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'county') { + lexis_data <- lexis_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'state') { + lexis_data <- lexis_data %>% + dplyr::mutate( + oid = .$STATEFP, + state = stringr::str_trim(state) + ) + } + + # Count of racial/ethnic subgroup populations + ## Count of racial/ethnic comparison subgroup population + if (length(in_subgroup) == 1) { + lexis_data <- lexis_data %>% + dplyr::mutate(subgroup = .[, in_subgroup]) + } else { + lexis_data <- lexis_data %>% + dplyr::mutate(subgroup = rowSums(.[, in_subgroup])) + } + ## Count of racial/ethnic interaction subgroup population + if (length(in_subgroup_ixn) == 1) { + lexis_data <- lexis_data %>% + dplyr::mutate(subgroup_ixn = .[, in_subgroup_ixn]) + } else { + lexis_data <- lexis_data %>% + dplyr::mutate(subgroup_ixn = rowSums(.[, in_subgroup_ixn])) + } + + # Compute LEx/Is + ## From Bemanian & Beyer (2017) https://doi.org/10.1158/1055-9965.EPI-16-0926 + ## E^*_{m,n}(i) = log\left(\frac{p_{im} \times p_{in}}{1 - p_{im} \times p_{in}}\right) - log\left(\frac{P_{m} \times P_{n}}{1 - P_{m} \times P_{n}}\right) + ## Where for smaller geographical unit i: + ## p_{im} denotes the number of subgroup population m in smaller geographical unit i + ## p_{in} denotes the number of subgroup population n in smaller geographical unit i + ## P_{m} denotes the number of subgroup population m in larger geographical unit within which the smaller geographic unit i is located + ## P_{n} denotes the number of subgroup population n in larger geographical unit within which the smaller geographic unit i is located + ## If m \ne n, then computes the exposure of members of subgroup populations m and n + ## If m = n, then computes the simple isolation experienced by members of subgroup population m + + ## Compute + LExIstmp <- lexis_data %>% + split(., f = list(lexis_data$oid)) %>% + lapply(., FUN = lexis_fun, omit_NAs = omit_NAs) %>% + do.call('rbind', .) + + # Warning for missingness of census characteristics + missingYN <- lexis_data[, c('TotalPopE', in_subgroup, in_subgroup_ixn)] + names(missingYN) <- out_names + missingYN <- missingYN %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + } + + # Format output + lexis <- lexis_data %>% + dplyr::left_join(LExIstmp, by = dplyr::join_by(GEOID)) + + if (geo_small == 'state') { + lexis <- lexis %>% + dplyr::select(GEOID, state, LExIs) + } + if (geo_small == 'county') { + lexis <- lexis %>% + dplyr::select(GEOID, state, county, LExIs) + } + if (geo_small == 'tract') { + lexis <- lexis %>% + dplyr::select(GEOID, state, county, tract, LExIs) + } + if (geo_small == 'block group') { + lexis <- lexis %>% + dplyr::select(GEOID, state, county, tract, block.group, LExIs) + } + lexis <- lexis %>% - dplyr::select(GEOID, state, county, tract, block.group, LExIs) + unique(.) %>% + .[.$GEOID != 'NANA',] %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + lexis_data <- lexis_data %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + out <- list(lexis = lexis, lexis_data = lexis_data, missing = missingYN) + + return(out) } - - lexis <- lexis %>% - unique(.) %>% - .[.$GEOID != "NANA", ] %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - lexis_data <- lexis_data %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - out <- list(lexis = lexis, - lexis_data = lexis_data, - missing = missingYN) - - return(out) -} diff --git a/R/bravo.R b/R/bravo.R index b1a424f..46abceb 100644 --- a/R/bravo.R +++ b/R/bravo.R @@ -1,36 +1,36 @@ -#' Educational Isolation Index based on Bravo _et al._ (2021) -#' +#' Educational Isolation Index based on Bravo et al. (2021) +#' #' Compute the spatial Educational Isolation Index (Bravo) of selected educational attainment category(ies). #' -#' @param geo Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}. +#' @param geo Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param subgroup Character string specifying the educational attainment category(ies). See Details for available choices. #' @param quiet Logical. If TRUE, will display messages about potential missing census information. The default is FALSE. #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' -#' @details This function will compute the spatial Educational Isolation Index (EI) of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Bravo _et al._ (2021) \doi{10.3390/ijerph18179384} who originally designed the metric for the educational isolation of individual without a college degree. This function provides the computation of EI for any of the U.S. Census Bureau educational attainment levels. -#' -#' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the geospatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The five educational attainment levels (U.S. Census Bureau definitions) are: +#' @details This function will compute the spatial Educational Isolation Index (EI) of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Bravo et al. (2021) \doi{10.3390/ijerph18179384} who originally designed the metric for the educational isolation of individual without a college degree. This function provides the computation of EI for any of the U.S. Census Bureau educational attainment levels. +#' +#' The function uses the \code{\link[tidycensus]{get_acs}} to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the geospatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The five educational attainment levels (U.S. Census Bureau definitions) are: #' \itemize{ -#' \item **B06009_002**: Less than high school graduate \code{"LtHS"} -#' \item **B06009_003**: High school graduate (includes equivalency) \code{"HSGiE"} -#' \item **B06009_004**: Some college or associate's degree \code{"SCoAD"} -#' \item **B06009_005**: Bachelor's degree \code{"BD"} -#' \item **B06009_006**: Graduate or professional degree \code{"GoPD"} +#' \item **B06009_002**: Less than high school graduate \code{'LtHS'} +#' \item **B06009_003**: High school graduate (includes equivalency) \code{'HSGiE'} +#' \item **B06009_004**: Some college or associate's degree \code{'SCoAD'} +#' \item **B06009_005**: Bachelor's degree \code{'BD'} +#' \item **B06009_006**: Graduate or professional degree \code{'GoPD'} #' } #' Note: If \code{year = 2009}, then the ACS-5 data (2005-2009) are from the **B15002** question. -#' +#' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. NOTE: Current version does not correct for edge effects (e.g., census geographies along the specified spatial extent border, coastline, or U.S.-Mexico / U.S.-Canada border) may have few neighboring census geographies, and EI values in these census geographies may be unstable. A stop-gap solution for the former source of edge effect is to compute the EI for neighboring census geographies (i.e., the states bordering a study area of interest) and then use the estimates of the study area of interest. -#' +#' #' A census geography (and its neighbors) that has nearly all of its population with the specified educational attainment category (e.g., a Bachelor's degree or more) will have an EI value close to 1. In contrast, a census geography (and its neighbors) that is nearly none of its population with the specified educational attainment category (e.g., less than a Bachelor's degree) will have an EI value close to 0. -#' +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{ei}}{An object of class 'tbl' for the GEOID, name, EI, and raw census values of specified census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute EI.} #' } -#' +#' #' @import dplyr #' @importFrom Matrix sparseMatrix #' @importFrom sf st_drop_geometry st_geometry st_intersects @@ -39,182 +39,290 @@ #' @importFrom tidycensus get_acs #' @importFrom tidyr pivot_longer separate #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Tract-level metric (2020) -#' bravo(geo = "tract", state = "GA", -#' year = 2020, subgroup = c("LtHS", "HSGiE")) -#' +#' bravo( +#' geo = 'tract', +#' state = 'GA', +#' year = 2020, +#' subgroup = c('LtHS', 'HSGiE') +#' ) +#' #' # County-level metric (2020) -#' bravo(geo = "county", state = "GA", -#' year = 2020, subgroup = c("LtHS", "HSGiE")) -#' +#' bravo( +#' geo = 'county', +#' state = 'GA', +#' year = 2020, +#' subgroup = c('LtHS', 'HSGiE') +#' ) +#' #' } -#' -bravo <- function(geo = "tract", year = 2020, subgroup, quiet = FALSE, ...) { - - # Check arguments - match.arg(geo, choices = c("county", "tract")) - stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - match.arg(subgroup, several.ok = TRUE, - choices = c("LtHS", "HSGiE", "SCoAD", "BD", "GoPD")) - - # Select census variables - vars <- c(TotalPop = "B06009_001", - LtHS = "B06009_002", - HSGiE = "B06009_003", - SCoAD = "B06009_004", - BD = "B06009_005", - GoPD = "B06009_006") - - selected_vars <- vars[c("TotalPop", subgroup)] +#' +bravo <- function(geo = 'tract', + year = 2020, + subgroup, + quiet = FALSE, + ...) { - if (year == 2009) { - vars <- matrix(c("TotalPop", "TotalPop", "B15002_001", - "LtHS", "mNSC", "B15002_003", - "LtHS", "mNt4G", "B15002_004", - "LtHS", "m5t6G", "B15002_005", - "LtHS", "m7t8G", "B15002_006", - "LtHS", "m9G", "B15002_007", - "LtHS", "m10G", "B15002_008", - "LtHS", "m11G", "B15002_009", - "LtHS", "m12GND", "B15002_010", - "HSGiE", "mHSGGEDoA", "B15002_011", - "SCoAD", "mSClt1Y", "B15002_012", - "SCoAD", "mSC1oMYND", "B15002_013", - "SCoAD", "mAD", "B15002_014", - "BD", "mBD", "B15002_015", - "GoPD", "mMD", "B15002_016", - "GoPD", "mPSD", "B15002_017", - "GoPD", "mDD", "B15002_018", - "LtHS", "fNSC", "B15002_020", - "LtHS", "fNt4G", "B15002_021", - "LtHS", "f5t6G", "B15002_022", - "LtHS", "f7t8G", "B15002_023", - "LtHS", "f9G", "B15002_024", - "LtHS", "f10G", "B15002_025", - "LtHS", "f11G", "B15002_026", - "LtHS", "f12GND", "B15002_027", - "HSGiE", "fHSGGEDoA", "B15002_028", - "SCoAD", "fSClt1Y", "B15002_029", - "SCoAD", "fSC1oMYND", "B15002_030", - "SCoAD", "fAD", "B15002_031", - "BD", "fBD", "B15002_032", - "GoPD", "fMD", "B15002_033", - "GoPD", "fPSD", "B15002_034", - "GoPD", "fDD", "B15002_035"), nrow = 33, ncol = 3, byrow = TRUE) + # Check arguments + match.arg(geo, choices = c('county', 'tract')) + stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward + match.arg( + subgroup, + several.ok = TRUE, + choices = c('LtHS', 'HSGiE', 'SCoAD', 'BD', 'GoPD') + ) + + # Select census variables + vars <- c( + TotalPop = 'B06009_001', + LtHS = 'B06009_002', + HSGiE = 'B06009_003', + SCoAD = 'B06009_004', + BD = 'B06009_005', + GoPD = 'B06009_006' + ) + + selected_vars <- vars[c('TotalPop', subgroup)] + + if (year == 2009) { + vars <- matrix( + c( + 'TotalPop', + 'TotalPop', + 'B15002_001', + 'LtHS', + 'mNSC', + 'B15002_003', + 'LtHS', + 'mNt4G', + 'B15002_004', + 'LtHS', + 'm5t6G', + 'B15002_005', + 'LtHS', + 'm7t8G', + 'B15002_006', + 'LtHS', + 'm9G', + 'B15002_007', + 'LtHS', + 'm10G', + 'B15002_008', + 'LtHS', + 'm11G', + 'B15002_009', + 'LtHS', + 'm12GND', + 'B15002_010', + 'HSGiE', + 'mHSGGEDoA', + 'B15002_011', + 'SCoAD', + 'mSClt1Y', + 'B15002_012', + 'SCoAD', + 'mSC1oMYND', + 'B15002_013', + 'SCoAD', + 'mAD', + 'B15002_014', + 'BD', + 'mBD', + 'B15002_015', + 'GoPD', + 'mMD', + 'B15002_016', + 'GoPD', + 'mPSD', + 'B15002_017', + 'GoPD', + 'mDD', + 'B15002_018', + 'LtHS', + 'fNSC', + 'B15002_020', + 'LtHS', + 'fNt4G', + 'B15002_021', + 'LtHS', + 'f5t6G', + 'B15002_022', + 'LtHS', + 'f7t8G', + 'B15002_023', + 'LtHS', + 'f9G', + 'B15002_024', + 'LtHS', + 'f10G', + 'B15002_025', + 'LtHS', + 'f11G', + 'B15002_026', + 'LtHS', + 'f12GND', + 'B15002_027', + 'HSGiE', + 'fHSGGEDoA', + 'B15002_028', + 'SCoAD', + 'fSClt1Y', + 'B15002_029', + 'SCoAD', + 'fSC1oMYND', + 'B15002_030', + 'SCoAD', + 'fAD', + 'B15002_031', + 'BD', + 'fBD', + 'B15002_032', + 'GoPD', + 'fMD', + 'B15002_033', + 'GoPD', + 'fPSD', + 'B15002_034', + 'GoPD', + 'fDD', + 'B15002_035' + ), + nrow = 33, + ncol = 3, + byrow = TRUE + ) + + selected_vars <- stats::setNames( + vars[vars[, 1] %in% c('TotalPop', subgroup) , 3], + vars[vars[, 1] %in% c('TotalPop', subgroup) , 2] + ) + } + + out_names <- names(selected_vars) # save for output + prefix <- 'subgroup' + suffix <- seq(1:length(selected_vars[-1])) + names(selected_vars) <- c('TotalPop', paste(prefix, suffix, sep = '')) + in_names <- paste(names(selected_vars), 'E', sep = '') + + # Acquire EI variables and sf geometries + ei_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + ... + ) + )) + + if (geo == 'tract') { + ei_data <- ei_data %>% + tidyr::separate(NAME, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } else { + ei_data <- ei_data %>% + tidyr::separate(NAME, into = c('county', 'state'), sep = ',') + } - selected_vars <- stats::setNames(vars[ vars[ , 1] %in% c("TotalPop", subgroup) , 3], - vars[ vars[ , 1] %in% c("TotalPop", subgroup) , 2]) - } - - out_names <- names(selected_vars) # save for output - prefix <- "subgroup" - suffix <- seq(1:length(selected_vars[-1])) - names(selected_vars) <- c("TotalPop", paste(prefix, suffix, sep = "")) - in_names <- paste(names(selected_vars), "E", sep = "") - - # Acquire EI variables and sf geometries - ei_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo, - year = year, - output = "wide", - variables = selected_vars, - geometry = TRUE, ...))) - - if (geo == "tract") { ei_data <- ei_data %>% - tidyr::separate(NAME, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]","", tract)) - } else { - ei_data <- ei_data %>% tidyr::separate(NAME, into = c("county", "state"), sep = ",") - } - - ei_data <- ei_data %>% - dplyr::mutate(subgroup = rowSums(sf::st_drop_geometry(ei_data[ , in_names[-1]]))) - - # Compute EI - ## From Bravo et al. (2021) https://doi.org/10.3390/ijerph18179384 - ## EI_{im} = (Sigma_{j∈∂_{i}} w_{ij} * T_{jm}) / (Sigma_{j∈∂_{i}} w_{ij} * T_{j}) - ## Where: - ## ∂_{i} denotes the set of index units i and its neighbors - ## Given M mutually exclusive subgroups of educational attainment categories, m indexes the subgroups of M - ## T_{i} denotes the total population in region i (TotalPop) - ## T_{im} denotes the population of the selected subgroup(s) (subgroup1, ...) - ## w_{ij} denotes a nXn first-order adjacency matrix, where n is the number of census geometries in the study area - ### and the entries of w_{ij} are set to 1 if a boundary is shared by region i and region j and zero otherwise - ### Entries of the main diagonal (since i∈∂_{i}, w_{ij} = w_{ii} when j = i) of w_{ij} are set to 1.5 - ### such that the weight of the index unit, i, is larger than the weights assigned to adjacent tracts - - ## Geospatial adjacency matrix (wij) - tmp <- sf::st_intersects(sf::st_geometry(ei_data), sparse = TRUE) - names(tmp) <- as.character(seq_len(nrow(ei_data))) - tmpL <- length(tmp) - tmpcounts <- unlist(Map(length, tmp)) - tmpi <- rep(1:tmpL, tmpcounts) - tmpj <- unlist(tmp) - wij <- Matrix::sparseMatrix(i = tmpi, j = tmpj, x = 1, dims = c(tmpL, tmpL)) - diag(wij) <- 1.5 - - ## Compute - ei_data <- sf::st_drop_geometry(ei_data) # drop geometries (can join back later) - EIim <- list() - for (i in 1:dim(wij)[1]){ - EIim[[i]] <- sum(as.matrix(wij[i, ])*ei_data[ , "subgroup"]) / sum(as.matrix(wij[i, ])*ei_data[, "TotalPopE"]) - } - ei_data$EI <- unlist(EIim) - - # Warning for missingness of census characteristics - missingYN <- ei_data[ , in_names] - names(missingYN) <- out_names - missingYN <- missingYN %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% - dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) - - if (quiet == FALSE) { - # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + dplyr::mutate(subgroup = rowSums(sf::st_drop_geometry(ei_data[, in_names[-1]]))) + + # Compute EI + ## From Bravo et al. (2021) https://doi.org/10.3390/ijerph18179384 + ## EI_{im} = (Sigma_{j∈∂_{i}} w_{ij} * T_{jm}) / (Sigma_{j∈∂_{i}} w_{ij} * T_{j}) + ## Where: + ## ∂_{i} denotes the set of index units i and its neighbors + ## Given M mutually exclusive subgroups of educational attainment categories, m indexes the subgroups of M + ## T_{i} denotes the total population in region i (TotalPop) + ## T_{im} denotes the population of the selected subgroup(s) (subgroup1, ...) + ## w_{ij} denotes a nXn first-order adjacency matrix, where n is the number of census geometries in the study area + ### and the entries of w_{ij} are set to 1 if a boundary is shared by region i and region j and zero otherwise + ### Entries of the main diagonal (since i∈∂_{i}, w_{ij} = w_{ii} when j = i) of w_{ij} are set to 1.5 + ### such that the weight of the index unit, i, is larger than the weights assigned to adjacent tracts + + ## Geospatial adjacency matrix (wij) + tmp <- sf::st_intersects(sf::st_geometry(ei_data), sparse = TRUE) + names(tmp) <- as.character(seq_len(nrow(ei_data))) + tmpL <- length(tmp) + tmpcounts <- unlist(Map(length, tmp)) + tmpi <- rep(1:tmpL, tmpcounts) + tmpj <- unlist(tmp) + wij <- Matrix::sparseMatrix( + i = tmpi, + j = tmpj, + x = 1, + dims = c(tmpL, tmpL) + ) + diag(wij) <- 1.5 + + ## Compute + ei_data <- ei_data %>% + sf::st_drop_geometry() # drop geometries (can join back later) + EIim <- list() + for (i in 1:dim(wij)[1]) { + EIim[[i]] <- sum(as.matrix(wij[i,]) * ei_data[, 'subgroup']) / + sum(as.matrix(wij[i,]) * ei_data[, 'TotalPopE']) } + ei_data$EI <- unlist(EIim) + + # Warning for missingness of census characteristics + missingYN <- ei_data[, in_names] + names(missingYN) <- out_names + missingYN <- missingYN %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + } + + # Format output + if (geo == 'tract') { + ei <- ei_data %>% + dplyr::select(c( + 'GEOID', + 'state', + 'county', + 'tract', + 'EI', + dplyr::all_of(in_names) + )) + names(ei) <- c('GEOID', 'state', 'county', 'tract', 'EI', out_names) + } else { + ei <- ei_data %>% + dplyr::select(c('GEOID', 'state', 'county', 'EI', dplyr::all_of(in_names))) + names(ei) <- c('GEOID', 'state', 'county', 'EI', out_names) + } + + ei <- ei %>% + dplyr::mutate( + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + out <- list(ei = ei, missing = missingYN) + + return(out) } - - # Format output - if (geo == "tract") { - ei <- ei_data %>% - dplyr::select(c("GEOID", - "state", - "county", - "tract", - "EI", - dplyr::all_of(in_names))) - names(ei) <- c("GEOID", "state", "county", "tract", "EI", out_names) - } else { - ei <- ei_data %>% - dplyr::select(c("GEOID", - "state", - "county", - "EI", - dplyr::all_of(in_names))) - names(ei) <- c("GEOID", "state", "county", "EI", out_names) - } - - ei <- ei %>% - dplyr::mutate(state = stringr::str_trim(state), - county = stringr::str_trim(county)) %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - out <- list(ei = ei, - missing = missingYN) - - return(out) -} diff --git a/R/duncan.R b/R/duncan.R index 8215a26..8305b92 100644 --- a/R/duncan.R +++ b/R/duncan.R @@ -1,9 +1,9 @@ -#' Dissimilarity Index based on Duncan & Duncan (1955) -#' +#' Dissimilarity Index based on Duncan & Duncan (1955) +#' #' Compute the aspatial Dissimilarity Index (Duncan & Duncan) of selected racial/ethnic subgroup(s) and U.S. geographies #' -#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}. -#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}. +#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}. +#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param subgroup Character string specifying the racial/ethnic subgroup(s) as the comparison population. See Details for available choices. #' @param subgroup_ref Character string specifying the racial/ethnic subgroup(s) as the reference population. See Details for available choices. @@ -12,45 +12,45 @@ #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' #' @details This function will compute the aspatial Dissimilarity Index (DI) of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Duncan & Duncan (1955) \doi{10.2307/2088328}. This function provides the computation of DI for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). -#' +#' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: #' \itemize{ -#' \item **B03002_002**: not Hispanic or Latino \code{"NHoL"} -#' \item **B03002_003**: not Hispanic or Latino, white alone \code{"NHoLW"} -#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{"NHoLA"} -#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -#' \item **B03002_012**: Hispanic or Latino \code{"HoL"} -#' \item **B03002_013**: Hispanic or Latino, white alone \code{"HoLW"} -#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{"HoLB"} -#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{"HoLA"} -#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +#' \item **B03002_002**: not Hispanic or Latino \code{'NHoL'} +#' \item **B03002_003**: not Hispanic or Latino, white alone \code{'NHoLW'} +#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{'NHoLA'} +#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +#' \item **B03002_012**: Hispanic or Latino \code{'HoL'} +#' \item **B03002_013**: Hispanic or Latino, white alone \code{'HoLW'} +#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{'HoLB'} +#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{'HoLA'} +#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} #' } -#' +#' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -#' +#' #' DI is a measure of the evenness of racial/ethnic residential segregation when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. DI can range in value from 0 to 1 and represents the proportion of racial/ethnic subgroup members that would have to change their area of residence to achieve an even distribution within the larger geographical area under conditions of maximum segregation. -#' -#' Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the DI value returned is NA. -#' +#' +#' Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the DI value returned is NA. +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{di}}{An object of class 'tbl' for the GEOID, name, and DI at specified larger census geographies.} #' \item{\code{di_data}}{An object of class 'tbl' for the raw census values at specified smaller census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute DI.} #' } -#' +#' #' @import dplyr #' @importFrom sf st_drop_geometry #' @importFrom stats complete.cases @@ -58,201 +58,281 @@ #' @importFrom tidyr pivot_longer separate #' @importFrom utils stack #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Dissimilarity Index of non-Hispanic Black vs. non-Hispanic white populations #' ## of census tracts within Georgia, U.S.A., counties (2020) -#' duncan(geo_large = "county", geo_small = "tract", state = "GA", -#' year = 2020, subgroup = "NHoLB", subgroup_ref = "NHoLW") -#' +#' duncan( +#' geo_large = 'county', +#' geo_small = 'tract', +#' state = 'GA', +#' year = 2020, +#' subgroup = 'NHoLB', +#' subgroup_ref = 'NHoLW' +#' ) +#' #' } -#' -duncan <- function(geo_large = "county", geo_small = "tract", year = 2020, subgroup, subgroup_ref, omit_NAs = TRUE, quiet = FALSE, ...) { - - # Check arguments - match.arg(geo_large, choices = c("state", "county", "tract")) - match.arg(geo_small, choices = c("county", "tract", "block group")) - stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - match.arg(subgroup, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) - match.arg(subgroup_ref, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) - - # Select census variables - vars <- c(NHoL = "B03002_002", - NHoLW = "B03002_003", - NHoLB = "B03002_004", - NHoLAIAN = "B03002_005", - NHoLA = "B03002_006", - NHoLNHOPI = "B03002_007", - NHoLSOR = "B03002_008", - NHoLTOMR = "B03002_009", - NHoLTRiSOR = "B03002_010", - NHoLTReSOR = "B03002_011", - HoL = "B03002_012", - HoLW = "B03002_013", - HoLB = "B03002_014", - HoLAIAN = "B03002_015", - HoLA = "B03002_016", - HoLNHOPI = "B03002_017", - HoLSOR = "B03002_018", - HoLTOMR = "B03002_019", - HoLTRiSOR = "B03002_020", - HoLTReSOR = "B03002_021") - - selected_vars <- vars[c(subgroup, subgroup_ref)] - out_names <- names(selected_vars) # save for output - in_subgroup <- paste(subgroup, "E", sep = "") - in_subgroup_ref <- paste(subgroup_ref, "E", sep = "") - - # Acquire DI variables and sf geometries - di_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo_small, - year = year, - output = "wide", - variables = selected_vars, - geometry = TRUE, - keep_geo_vars = TRUE, ...))) - - # Format output - if (geo_small == "county") { - di_data <- sf::st_drop_geometry(di_data) %>% - tidyr::separate(NAME.y, into = c("county", "state"), sep = ",") - } - if (geo_small == "tract") { - di_data <- sf::st_drop_geometry(di_data) %>% - tidyr::separate(NAME.y, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract)) - } - if (geo_small == "block group") { - di_data <- sf::st_drop_geometry(di_data) %>% - tidyr::separate(NAME.y, into = c("block.group", "tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract), - block.group = gsub("[^0-9\\.]", "", block.group)) - } +#' +duncan <- function(geo_large = 'county', + geo_small = 'tract', + year = 2020, + subgroup, + subgroup_ref, + omit_NAs = TRUE, + quiet = FALSE, + ...) { - # Grouping IDs for DI computation - if (geo_large == "tract") { - di_data <- di_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) - } - if (geo_large == "county") { - di_data <- di_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) - } - if (geo_large == "state") { - di_data <- di_data %>% - dplyr::mutate(oid = .$STATEFP, - state = stringr::str_trim(state)) - } - - # Count of racial/ethnic subgroup populations - ## Count of racial/ethnic comparison subgroup population - if (length(in_subgroup) == 1) { - di_data <- di_data %>% - dplyr::mutate(subgroup = .[ , in_subgroup]) - } else { - di_data <- di_data %>% - dplyr::mutate(subgroup = rowSums(.[ , in_subgroup])) - } - ## Count of racial/ethnic reference subgroup population - if (length(in_subgroup_ref) == 1) { - di_data <- di_data %>% - dplyr::mutate(subgroup_ref = .[ , in_subgroup_ref]) - } else { - di_data <- di_data %>% - dplyr::mutate(subgroup_ref = rowSums(.[ , in_subgroup_ref])) - } - - # Compute DI - ## From Duncan & Duncan (1955) https://doi.org/10.2307/2088328 - ## D_{jt} = 1/2 \sum_{i=1}^{k} | \frac{x_{ijt}}{X_{jt}}-\frac{y_{ijt}}{Y_{jt}}| - ## Where for k smaller geographies: - ## D_{jt} denotes the DI of larger geography j at time t - ## x_{ijt} denotes the racial/ethnic subgroup population of smaller geography i within larger geography j at time t - ## X_{jt} denotes the racial/ethnic subgroup population of larger geography j at time t - ## y_{ijt} denotes the racial/ethnic referent subgroup population of smaller geography i within larger geography j at time t - ## Y_{jt} denotes the racial/ethnic referent subgroup population of larger geography j at time t - - ## Compute - DItmp <- di_data %>% - split(., f = list(di_data$oid)) %>% - lapply(., FUN = di_fun, omit_NAs = omit_NAs) %>% - utils::stack(.) %>% - dplyr::mutate(DI = values, - oid = ind) %>% - dplyr::select(DI, oid) - - # Warning for missingness of census characteristics - missingYN <- di_data[ , c(in_subgroup, in_subgroup_ref)] - names(missingYN) <- out_names - missingYN <- missingYN %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% - dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) - - if (quiet == FALSE) { - # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + # Check arguments + match.arg(geo_large, choices = c('state', 'county', 'tract')) + match.arg(geo_small, choices = c('county', 'tract', 'block group')) + stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward + match.arg( + subgroup, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) + match.arg( + subgroup_ref, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) + + # Select census variables + vars <- c( + NHoL = 'B03002_002', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + NHoLAIAN = 'B03002_005', + NHoLA = 'B03002_006', + NHoLNHOPI = 'B03002_007', + NHoLSOR = 'B03002_008', + NHoLTOMR = 'B03002_009', + NHoLTRiSOR = 'B03002_010', + NHoLTReSOR = 'B03002_011', + HoL = 'B03002_012', + HoLW = 'B03002_013', + HoLB = 'B03002_014', + HoLAIAN = 'B03002_015', + HoLA = 'B03002_016', + HoLNHOPI = 'B03002_017', + HoLSOR = 'B03002_018', + HoLTOMR = 'B03002_019', + HoLTRiSOR = 'B03002_020', + HoLTReSOR = 'B03002_021' + ) + + selected_vars <- vars[c(subgroup, subgroup_ref)] + out_names <- names(selected_vars) # save for output + in_subgroup <- paste(subgroup, 'E', sep = '') + in_subgroup_ref <- paste(subgroup_ref, 'E', sep = '') + + # Acquire DI variables and sf geometries + di_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo_small, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + keep_geo_vars = TRUE, + ... + ) + )) + + # Format output + if (geo_small == 'county') { + di_data <- di_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('county', 'state'), sep = ',') } + if (geo_small == 'tract') { + di_data <- di_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } + if (geo_small == 'block group') { + di_data <- di_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('block.group', 'tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate( + tract = gsub('[^0-9\\.]', '', tract), + block.group = gsub('[^0-9\\.]', '', block.group) + ) + } + + # Grouping IDs for DI computation + if (geo_large == 'tract') { + di_data <- di_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'county') { + di_data <- di_data %>% + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) + } + if (geo_large == 'state') { + di_data <- di_data %>% + dplyr::mutate( + oid = .$STATEFP, + state = stringr::str_trim(state) + ) + } + + # Count of racial/ethnic subgroup populations + ## Count of racial/ethnic comparison subgroup population + if (length(in_subgroup) == 1) { + di_data <- di_data %>% + dplyr::mutate(subgroup = .[, in_subgroup]) + } else { + di_data <- di_data %>% + dplyr::mutate(subgroup = rowSums(.[, in_subgroup])) + } + ## Count of racial/ethnic reference subgroup population + if (length(in_subgroup_ref) == 1) { + di_data <- di_data %>% + dplyr::mutate(subgroup_ref = .[, in_subgroup_ref]) + } else { + di_data <- di_data %>% + dplyr::mutate(subgroup_ref = rowSums(.[, in_subgroup_ref])) + } + + # Compute DI + ## From Duncan & Duncan (1955) https://doi.org/10.2307/2088328 + ## D_{jt} = 1/2 \sum_{i=1}^{k} | \frac{x_{ijt}}{X_{jt}}-\frac{y_{ijt}}{Y_{jt}}| + ## Where for k smaller geographies: + ## D_{jt} denotes the DI of larger geography j at time t + ## x_{ijt} denotes the racial/ethnic subgroup population of smaller geography i within larger geography j at time t + ## X_{jt} denotes the racial/ethnic subgroup population of larger geography j at time t + ## y_{ijt} denotes the racial/ethnic referent subgroup population of smaller geography i within larger geography j at time t + ## Y_{jt} denotes the racial/ethnic referent subgroup population of larger geography j at time t + + ## Compute + DItmp <- di_data %>% + split(., f = list(di_data$oid)) %>% + lapply(., FUN = di_fun, omit_NAs = omit_NAs) %>% + utils::stack(.) %>% + dplyr::mutate( + DI = values, + oid = ind + ) %>% + dplyr::select(DI, oid) + + # Warning for missingness of census characteristics + missingYN <- di_data[, c(in_subgroup, in_subgroup_ref)] + names(missingYN) <- out_names + missingYN <- missingYN %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + } + + # Format output + if (geo_large == 'state') { + di <- di_data %>% + dplyr::left_join(DItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, DI) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, DI) %>% + .[.$GEOID != 'NANA',] + } + if (geo_large == 'county') { + di <- di_data %>% + dplyr::left_join(DItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, county, DI) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, county, DI) %>% + .[.$GEOID != 'NANA',] + } + if (geo_large == 'tract') { + di <- di_data %>% + dplyr::left_join(DItmp, by = dplyr::join_by(oid)) %>% + dplyr::select(oid, state, county, tract, DI) %>% + unique(.) %>% + dplyr::mutate(GEOID = oid) %>% + dplyr::select(GEOID, state, county, tract, DI) %>% + .[.$GEOID != 'NANA',] + } + + di <- di %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + di_data <- di_data %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + out <- list(di = di, di_data = di_data, missing = missingYN) + + return(out) } - - # Format output - if (geo_large == "state") { - di <- merge(di_data, DItmp) %>% - dplyr::select(oid, state, DI) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, DI) %>% - .[.$GEOID != "NANA", ] - } - if (geo_large == "county") { - di <- merge(di_data, DItmp) %>% - dplyr::select(oid, state, county, DI) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, county, DI) %>% - .[.$GEOID != "NANA", ] - } - if (geo_large == "tract") { - di <- merge(di_data, DItmp) %>% - dplyr::select(oid, state, county, tract, DI) %>% - unique(.) %>% - dplyr::mutate(GEOID = oid) %>% - dplyr::select(GEOID, state, county, tract, DI) %>% - .[.$GEOID != "NANA", ] - } - - di <- di %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - di_data <- di_data %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - out <- list(di = di, - di_data = di_data, - missing = missingYN) - - return(out) -} diff --git a/R/gini.R b/R/gini.R index 4268a57..09da8a2 100644 --- a/R/gini.R +++ b/R/gini.R @@ -1,107 +1,121 @@ -#' Gini Index based on Gini (1921) -#' +#' Gini Index based on Gini (1921) +#' #' Retrieve the aspatial Gini Index of income inequality. #' -#' @param geo Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}. +#' @param geo Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param quiet Logical. If TRUE, will display messages about potential missing census information #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' #' @details This function will retrieve the aspatial Gini Index of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Gini (1921) \doi{10.2307/2223319}. -#' +#' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey estimates of the Gini Index for income inequality (ACS: B19083). The estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. -#' +#' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -#' -#' According to the U.S. Census Bureau \url{https://www.census.gov/topics/income-poverty/income-inequality/about/metrics/gini-index.html}: "The Gini Index is a summary measure of income inequality. The Gini coefficient incorporates the detailed shares data into a single statistic, which summarizes the dispersion of income across the entire income distribution. The Gini coefficient ranges from 0, indicating perfect equality (where everyone receives an equal share), to 1, perfect inequality (where only one recipient or group of recipients receives all the income). The Gini is based on the difference between the Lorenz curve (the observed cumulative income distribution) and the notion of a perfectly equal income distribution." -#' +#' +#' According to the U.S. Census Bureau \url{https://www.census.gov/topics/income-poverty/income-inequality/about/metrics/gini-index.html}: 'The Gini Index is a summary measure of income inequality. The Gini coefficient incorporates the detailed shares data into a single statistic, which summarizes the dispersion of income across the entire income distribution. The Gini coefficient ranges from 0, indicating perfect equality (where everyone receives an equal share), to 1, perfect inequality (where only one recipient or group of recipients receives all the income). The Gini is based on the difference between the Lorenz curve (the observed cumulative income distribution) and the notion of a perfectly equal income distribution.' +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{gini}}{An object of class 'tbl' for the GEOID, name, and Gini index of specified census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for the Gini index.} #' } -#' +#' #' @import dplyr #' @importFrom stringr str_trim #' @importFrom tidycensus get_acs #' @importFrom tidyr pivot_longer separate #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Tract-level metric (2020) -#' gini(geo = "tract", state = "GA", year = 2020) -#' +#' gini(geo = 'tract', state = 'GA', year = 2020) +#' #' # County-level metric (2020) -#' gini(geo = "county", state = "GA", year = 2020) -#' +#' gini(geo = 'county', state = 'GA', year = 2020) +#' #' } -#' -gini <- function(geo = "tract", year = 2020, quiet = FALSE, ...) { +#' +gini <- function(geo = 'tract', + year = 2020, + quiet = FALSE, + ...) { # Check arguments - match.arg(geo, choices = c("county", "tract")) + match.arg(geo, choices = c('county', 'tract')) stopifnot(is.numeric(year), year >= 2009) # the gini variable is available before and after 2009 but constrained for consistency with out indices (for now) # Select census variable - vars <- c(gini = "B19083_001") + vars <- c(gini = 'B19083_001') # Acquire Gini Index - gini_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo, - year = year, - output = "wide", - variables = vars, ...))) - - if (geo == "tract") { + gini_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo, + year = year, + output = 'wide', + variables = vars, + ... + ) + )) + + if (geo == 'tract') { gini_data <- gini_data %>% - tidyr::separate(NAME, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]","", tract)) + tidyr::separate(NAME, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) } else { - gini_data <- gini_data %>% tidyr::separate(NAME, into = c("county", "state"), sep = ",") + gini_data <- gini_data %>% + tidyr::separate(NAME, into = c('county', 'state'), sep = ',') } gini_data <- gini_data %>% - dplyr::mutate(gini = giniE) + dplyr::mutate(gini = giniE) # Warning for missingness of census characteristics missingYN <- gini_data %>% dplyr::select(gini) %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) if (quiet == FALSE) { # Warning for missing census data if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + message('Warning: Missing census data') } } - if (geo == "tract") { + if (geo == 'tract') { gini <- gini_data %>% dplyr::select(GEOID, state, county, tract, gini) } else { gini <- gini_data %>% - dplyr::select(GEOID, state, county, gini) + dplyr::select(GEOID, state, county, gini) } gini <- gini %>% - dplyr::mutate(state = stringr::str_trim(state), - county = stringr::str_trim(county)) %>% + dplyr::mutate( + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) %>% dplyr::arrange(GEOID) %>% - dplyr::as_tibble() + dplyr::as_tibble() - out <- list(gini = gini, - missing = missingYN) + out <- list(gini = gini, missing = missingYN) return(out) } diff --git a/R/globals.R b/R/globals.R index b2aeb06..43ec440 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,43 +1,253 @@ -globalVariables(c("CWD", "EDU", "EMP", "FHH", "GEOID", "MedHHInc", "MedHHIncE", "MedHomeVal", "MedHomeValE", "NAME", - "NDI", "OCC", "PC1", "POV", "PUB", "PctCrwdHH_denE", "PctCrwdHH_num1E", "PctCrwdHH_num2E", - "PctCrwdHH_num3E", "PctCrwdHH_num4E", "PctCrwdHH_num5E", "PctCrwdHH_num6E", - "PctEducBchPlus", "PctEducHSPlus", "PctEducLTBch", "PctEducLTBchZ", "PctEducLTHS", - "PctEducLTHSZ", "PctEducLessThanHS_denE", "PctEducLessThanHS_numE", - "PctEduc_den25upE", "PctEduc_num25upADE", "PctEduc_num25upBDE", - "PctEduc_num25upGDE", "PctEduc_num25upHSE", "PctEduc_num25upSCE", - "PctFamBelowPov", "PctFamBelowPovE", "PctFamBelowPovZ", "PctFemHeadKids", - "PctFemHeadKidsZ", "PctFemHeadKids_denE", "PctFemHeadKids_num1E", - "PctFemHeadKids_num2E", "PctHHPov_denE", "PctHHPov_numE", "PctHHUnder30K_denE", - "PctHHUnder30K_num1E", "PctHHUnder30K_num2E", "PctHHUnder30K_num3E", - "PctHHUnder30K_num4E", "PctHHUnder30K_num5E", "PctMenMgmtBusScArti_denE", - "PctMenMgmtBusScArti_num1E", "PctMenMgmtBusScArti_num2E", "PctMgmtBusScArti", - "PctMgmtBusScArti_denE", "PctMgmtBusScArti_numE", "PctNComPlmb", "PctNComPlmbE", - "PctNComPlmbZ", "PctNoIDR", "PctNoIDRZ", "PctNoPhone", "PctNoPhoneE", "PctNoPhoneZ", - "PctNotOwnerOcc", "PctNotOwnerOccZ", "PctOwnerOcc", "PctOwnerOccE", "PctPubAsst", - "PctPubAsstZ", "PctPubAsst_denE", "PctPubAsst_numE", "PctRecvIDR", - "PctRecvIDR_denE", "PctRecvIDR_numE", "PctUnemp_1619FE", "PctUnemp_1619ME", - "PctUnemp_2021FE", "PctUnemp_2021ME", "PctUnemp_2224FE", "PctUnemp_2224ME", - "PctUnemp_2529FE", "PctUnemp_2529ME", "PctUnemp_4554FE", "PctUnemp_4554ME", - "PctUnemp_5559FE", "PctUnemp_5559ME", "PctUnemp_6061FE", "PctUnemp_6061ME", - "PctUnemp_6264FE", "PctUnemp_6264ME", "PctUnemp_6569FE", "PctUnemp_6569ME", - "PctUnemp_7074FE", "PctUnemp_7074ME", "PctUnemp_75upME", "PctUnemp_denE", - "PctUnemp_numE", "PctUnempl", "PctUnemplE", "PctUnemplZ", "PctWorkClass", - "PctWorkClassZ", "TotalPop", "TotalPopulationE", "U30", "county", "logMedHHInc", - "logMedHomeVal", "percent", "state", "total", "tract", "val", "variable", "giniE", - "A_edu", "A_inc", "A_wbinc", "A_wpcinc", "B100125i", "B100125iE", "B100125nhw", - "B100125nhwE", "B1015bih", "B1015bihE", "B1015i", "B1015iE", "B1015nhw", "B1015nhwE", - "B125150i", "B125150iE", "B125150nhw", "B125150nhwE", "B150200hw", "B150200i", - "B150200iE", "B150200nhw", "B150200nhwE", "B1520bih", "B1520bihE", "B1520i", "B1520iE", - "B1520nhw", "B1520nhwE", "B2025bih", "B2025bihE", "B2025i", "B2025iE", "B2025nhw", - "B2025nhwE", "B2530bih", "B2530bihE", "B2530i", "B2530iE", "B2530nhw", "B2530nhwE", - "ICE_edu", "ICE_inc", "ICE_rewb", "ICE_wbinc", "ICE_wpcinc", "NHoLB", "NHoLBE", "NHoLW", - "NHoLWE", "O200i", "O200iE", "O200nhw", "O200nhwE", "O25F10G", "O25F10GE", "O25F11G", - "O25F11GE", "O25F12GND", "O25F12GNDE", "O25F5t6G", "O25F5t6GE", "O25F7t8G", "O25F7t8GE", - "O25F9G", "O25F9GE", "O25FBD", "O25FBDE", "O25FDD", "O25FDDE", "O25FMD", "O25FMDE", "O25FNSC", - "O25FNSCE", "O25FNt4G", "O25FNt4GE", "O25FPSD", "O25FPSDE", "O25M10G", "O25M10GE", "O25M11G", - "O25M11GE", "O25M12GND", "O25M12GNDE", "O25M5t6G", "O25M5t6GE", "O25M7t8G", "O25M7t8GE", - "O25M9G", "O25M9GE", "O25MBD", "O25MBDE", "O25MDD", "O25MDDE", "O25MMD", "O25MMDE", "O25MNSC", - "O25MNSCE", "O25MNt4G", "O25MNt4GE", "O25MPSD", "O25MPSDE", "P_edu", "P_inc", "P_wbinc", - "P_wpcinc", "TotalPop_edu", "TotalPop_inc", "TotalPop_re", "TotalPopeduE", - "TotalPopiE", "TotalPopreE", "U10bih", "U10bihE", "U10i", "U10iE", "U10nhw", "U10nhwE", "NAME.y", - ".", "values", "ind", "oid", "block.group", "DI", "AI", "II", "V", "LQ", "LExIs")) +globalVariables( + c( + 'CWD', + 'EDU', + 'EMP', + 'FHH', + 'GEOID', + 'MedHHInc', + 'MedHHIncE', + 'MedHomeVal', + 'MedHomeValE', + 'NAME', + 'NDI', + 'OCC', + 'PC1', + 'POV', + 'PUB', + 'PctCrwdHH_denE', + 'PctCrwdHH_num1E', + 'PctCrwdHH_num2E', + 'PctCrwdHH_num3E', + 'PctCrwdHH_num4E', + 'PctCrwdHH_num5E', + 'PctCrwdHH_num6E', + 'PctEducBchPlus', + 'PctEducHSPlus', + 'PctEducLTBch', + 'PctEducLTBchZ', + 'PctEducLTHS', + 'PctEducLTHSZ', + 'PctEducLessThanHS_denE', + 'PctEducLessThanHS_numE', + 'PctEduc_den25upE', + 'PctEduc_num25upADE', + 'PctEduc_num25upBDE', + 'PctEduc_num25upGDE', + 'PctEduc_num25upHSE', + 'PctEduc_num25upSCE', + 'PctFamBelowPov', + 'PctFamBelowPovE', + 'PctFamBelowPovZ', + 'PctFemHeadKids', + 'PctFemHeadKidsZ', + 'PctFemHeadKids_denE', + 'PctFemHeadKids_num1E', + 'PctFemHeadKids_num2E', + 'PctHHPov_denE', + 'PctHHPov_numE', + 'PctHHUnder30K_denE', + 'PctHHUnder30K_num1E', + 'PctHHUnder30K_num2E', + 'PctHHUnder30K_num3E', + 'PctHHUnder30K_num4E', + 'PctHHUnder30K_num5E', + 'PctMenMgmtBusScArti_denE', + 'PctMenMgmtBusScArti_num1E', + 'PctMenMgmtBusScArti_num2E', + 'PctMgmtBusScArti', + 'PctMgmtBusScArti_denE', + 'PctMgmtBusScArti_numE', + 'PctNComPlmb', + 'PctNComPlmbE', + 'PctNComPlmbZ', + 'PctNoIDR', + 'PctNoIDRZ', + 'PctNoPhone', + 'PctNoPhoneE', + 'PctNoPhoneZ', + 'PctNotOwnerOcc', + 'PctNotOwnerOccZ', + 'PctOwnerOcc', + 'PctOwnerOccE', + 'PctPubAsst', + 'PctPubAsstZ', + 'PctPubAsst_denE', + 'PctPubAsst_numE', + 'PctRecvIDR', + 'PctRecvIDR_denE', + 'PctRecvIDR_numE', + 'PctUnemp_1619FE', + 'PctUnemp_1619ME', + 'PctUnemp_2021FE', + 'PctUnemp_2021ME', + 'PctUnemp_2224FE', + 'PctUnemp_2224ME', + 'PctUnemp_2529FE', + 'PctUnemp_2529ME', + 'PctUnemp_4554FE', + 'PctUnemp_4554ME', + 'PctUnemp_5559FE', + 'PctUnemp_5559ME', + 'PctUnemp_6061FE', + 'PctUnemp_6061ME', + 'PctUnemp_6264FE', + 'PctUnemp_6264ME', + 'PctUnemp_6569FE', + 'PctUnemp_6569ME', + 'PctUnemp_7074FE', + 'PctUnemp_7074ME', + 'PctUnemp_75upME', + 'PctUnemp_denE', + 'PctUnemp_numE', + 'PctUnempl', + 'PctUnemplE', + 'PctUnemplZ', + 'PctWorkClass', + 'PctWorkClassZ', + 'TotalPop', + 'TotalPopulationE', + 'U30', + 'county', + 'logMedHHInc', + 'logMedHomeVal', + 'percent', + 'state', + 'total', + 'tract', + 'val', + 'variable', + 'giniE', + 'A_edu', + 'A_inc', + 'A_wbinc', + 'A_wpcinc', + 'B100125i', + 'B100125iE', + 'B100125nhw', + 'B100125nhwE', + 'B1015bih', + 'B1015bihE', + 'B1015i', + 'B1015iE', + 'B1015nhw', + 'B1015nhwE', + 'B125150i', + 'B125150iE', + 'B125150nhw', + 'B125150nhwE', + 'B150200hw', + 'B150200i', + 'B150200iE', + 'B150200nhw', + 'B150200nhwE', + 'B1520bih', + 'B1520bihE', + 'B1520i', + 'B1520iE', + 'B1520nhw', + 'B1520nhwE', + 'B2025bih', + 'B2025bihE', + 'B2025i', + 'B2025iE', + 'B2025nhw', + 'B2025nhwE', + 'B2530bih', + 'B2530bihE', + 'B2530i', + 'B2530iE', + 'B2530nhw', + 'B2530nhwE', + 'ICE_edu', + 'ICE_inc', + 'ICE_rewb', + 'ICE_wbinc', + 'ICE_wpcinc', + 'NHoLB', + 'NHoLBE', + 'NHoLW', + 'NHoLWE', + 'O200i', + 'O200iE', + 'O200nhw', + 'O200nhwE', + 'O25F10G', + 'O25F10GE', + 'O25F11G', + 'O25F11GE', + 'O25F12GND', + 'O25F12GNDE', + 'O25F5t6G', + 'O25F5t6GE', + 'O25F7t8G', + 'O25F7t8GE', + 'O25F9G', + 'O25F9GE', + 'O25FBD', + 'O25FBDE', + 'O25FDD', + 'O25FDDE', + 'O25FMD', + 'O25FMDE', + 'O25FNSC', + 'O25FNSCE', + 'O25FNt4G', + 'O25FNt4GE', + 'O25FPSD', + 'O25FPSDE', + 'O25M10G', + 'O25M10GE', + 'O25M11G', + 'O25M11GE', + 'O25M12GND', + 'O25M12GNDE', + 'O25M5t6G', + 'O25M5t6GE', + 'O25M7t8G', + 'O25M7t8GE', + 'O25M9G', + 'O25M9GE', + 'O25MBD', + 'O25MBDE', + 'O25MDD', + 'O25MDDE', + 'O25MMD', + 'O25MMDE', + 'O25MNSC', + 'O25MNSCE', + 'O25MNt4G', + 'O25MNt4GE', + 'O25MPSD', + 'O25MPSDE', + 'P_edu', + 'P_inc', + 'P_wbinc', + 'P_wpcinc', + 'TotalPop_edu', + 'TotalPop_inc', + 'TotalPop_re', + 'TotalPopeduE', + 'TotalPopiE', + 'TotalPopreE', + 'U10bih', + 'U10bihE', + 'U10i', + 'U10iE', + 'U10nhw', + 'U10nhwE', + 'NAME.y', + '.', + 'values', + 'ind', + 'oid', + 'block.group', + 'DI', + 'AI', + 'II', + 'V', + 'LQ', + 'LExIs', + 'DEL' + ) +) diff --git a/R/krieger.R b/R/krieger.R index 6bcdd06..73f0987 100644 --- a/R/krieger.R +++ b/R/krieger.R @@ -1,22 +1,22 @@ -#' Index of Concentration at the Extremes based on Feldman _et al._ (2015) and Krieger _et al._ (2016) -#' +#' Index of Concentration at the Extremes based on Feldman et al. (2015) and Krieger et al. (2016) +#' #' Compute the aspatial Index of Concentration at the Extremes (Krieger). #' -#' @param geo Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}. +#' @param geo Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param quiet Logical. If TRUE, will display messages about potential missing census information. The default is FALSE. #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' -#' @details This function will compute three aspatial Index of Concentration at the Extremes (ICE) of U.S. census tracts or counties for a specified geographical extent (e.g., entire U.S. or a single state) based on Feldman _et al._ (2015) \doi{10.1136/jech-2015-205728} and Krieger _et al._ (2016) \doi{10.2105/AJPH.2015.302955}. The authors expanded the metric designed by Massey in a chapter of Booth & Crouter (2001) \doi{10.4324/9781410600141} who initially designed the metric for residential segregation. This function computes five ICE metrics: -#' -#' \itemize{ +#' @details This function will compute three aspatial Index of Concentration at the Extremes (ICE) of U.S. census tracts or counties for a specified geographical extent (e.g., entire U.S. or a single state) based on Feldman et al. (2015) \doi{10.1136/jech-2015-205728} and Krieger et al. (2016) \doi{10.2105/AJPH.2015.302955}. The authors expanded the metric designed by Massey in a chapter of Booth & Crouter (2001) \doi{10.4324/9781410600141} who initially designed the metric for residential segregation. This function computes five ICE metrics: +#' +#' \itemize{ #' \item **Income**: 80th income percentile vs. 20th income percentile #' \item **Education**: less than high school vs. four-year college degree or more #' \item **Race/Ethnicity**: white non-Hispanic vs. black non-Hispanic #' \item **Income and race/ethnicity combined**: white non-Hispanic in 80th income percentile vs. black alone (including Hispanic) in 20th income percentile #' \item **Income and race/ethnicity combined**: white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile #' } -#' +#' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the geospatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The ACS-5 groups used in the computation of the five ICE metrics are: #' \itemize{ #' \item **B03002**: HISPANIC OR LATINO ORIGIN BY RACE @@ -25,280 +25,453 @@ #' \item **B19001B**: HOUSEHOLD INCOME IN THE PAST 12 MONTHS (IN 20XX INFLATION-ADJUSTED DOLLARS) (BLACK OR AFRICAN AMERICAN ALONE HOUSEHOLDER) #' \item **B19001H**: HOUSEHOLD INCOME IN THE PAST 12 MONTHS (IN 20XX INFLATION-ADJUSTED DOLLARS) (WHITE ALONE, NOT HISPANIC OR LATINO HOUSEHOLDER) #' } -#' +#' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -#' +#' #' ICE metrics can range in value from -1 (most deprived) to 1 (most privileged). A value of 0 can thus represent two possibilities: (1) none of the residents are in the most privileged or most deprived categories, or (2) an equal number of persons are in the most privileged and most deprived categories, and in both cases indicates that the area is not dominated by extreme concentrations of either of the two groups. -#' +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{ice}}{An object of class 'tbl' for the GEOID, name, ICE metrics, and raw census values of specified census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute the ICEs.} #' } -#' +#' #' @import dplyr #' @importFrom stringr str_trim #' @importFrom tidycensus get_acs #' @importFrom tidyr pivot_longer separate #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Tract-level metric (2020) -#' krieger(geo = "tract", state = "GA", year = 2020) -#' +#' krieger(geo = 'tract', state = 'GA', year = 2020) +#' #' # County-level metric (2020) -#' krieger(geo = "county", state = "GA", year = 2020) -#' +#' krieger(geo = 'county', state = 'GA', year = 2020) +#' #' } -#' -krieger <- function(geo = "tract", year = 2020, quiet = FALSE, ...) { - - # Check arguments - match.arg(geo, choices = c("county", "tract")) - stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - - # Select census variables - vars <- c(TotalPopi = "B19001_001", - TotalPopedu = "B15002_001", - TotalPopre = "B03002_001", - U10i = "B19001_002", - B1015i = "B19001_003", - B1520i = "B19001_004", - B2025i = "B19001_005", - B2530i = "B19001_006", - B100125i = "B19001_014", - B125150i = "B19001_015", - B150200i = "B19001_016", - O200i = "B19001_017", - O25MNSC = "B15002_003", - O25FNSC = "B15002_020", - O25MNt4G = "B15002_004", - O25FNt4G = "B15002_021", - O25M5t6G = "B15002_005", - O25F5t6G = "B15002_022", - O25M7t8G = "B15002_006", - O25F7t8G = "B15002_023", - O25M9G = "B15002_007", - O25F9G = "B15002_024", - O25M10G = "B15002_008", - O25F10G = "B15002_025", - O25M11G = "B15002_009", - O25F11G = "B15002_026", - O25M12GND = "B15002_010", - O25F12GND = "B15002_027", - O25MBD = "B15002_015", - O25FBD = "B15002_032", - O25MMD = "B15002_016", - O25FMD = "B15002_033", - O25MPSD = "B15002_017", - O25FPSD = "B15002_034", - O25MDD = "B15002_018", - O25FDD = "B15002_035", - NHoLW = "B03002_003", - NHoLB = "B03002_004", - U10nhw = "B19001H_002", - B1015nhw = "B19001H_003", - B1520nhw = "B19001H_004", - B2025nhw = "B19001H_005", - B2530nhw = "B19001H_006", - B100125nhw = "B19001H_014", - B125150nhw = "B19001H_015", - B150200nhw = "B19001H_016", - O200nhw = "B19001H_017", - U10bih = "B19001B_002", - B1015bih = "B19001B_003", - B1520bih = "B19001B_004", - B2025bih = "B19001B_005", - B2530bih = "B19001B_006") +#' +krieger <- function(geo = 'tract', + year = 2020, + quiet = FALSE, + ...) { - # Acquire ICE variables - ice_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo, - year = year, - output = "wide", - variables = vars, ...))) - - if (geo == "tract") { + # Check arguments + match.arg(geo, choices = c('county', 'tract')) + stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward + + # Select census variables + vars <- c( + TotalPopi = 'B19001_001', + TotalPopedu = 'B15002_001', + TotalPopre = 'B03002_001', + U10i = 'B19001_002', + B1015i = 'B19001_003', + B1520i = 'B19001_004', + B2025i = 'B19001_005', + B2530i = 'B19001_006', + B100125i = 'B19001_014', + B125150i = 'B19001_015', + B150200i = 'B19001_016', + O200i = 'B19001_017', + O25MNSC = 'B15002_003', + O25FNSC = 'B15002_020', + O25MNt4G = 'B15002_004', + O25FNt4G = 'B15002_021', + O25M5t6G = 'B15002_005', + O25F5t6G = 'B15002_022', + O25M7t8G = 'B15002_006', + O25F7t8G = 'B15002_023', + O25M9G = 'B15002_007', + O25F9G = 'B15002_024', + O25M10G = 'B15002_008', + O25F10G = 'B15002_025', + O25M11G = 'B15002_009', + O25F11G = 'B15002_026', + O25M12GND = 'B15002_010', + O25F12GND = 'B15002_027', + O25MBD = 'B15002_015', + O25FBD = 'B15002_032', + O25MMD = 'B15002_016', + O25FMD = 'B15002_033', + O25MPSD = 'B15002_017', + O25FPSD = 'B15002_034', + O25MDD = 'B15002_018', + O25FDD = 'B15002_035', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + U10nhw = 'B19001H_002', + B1015nhw = 'B19001H_003', + B1520nhw = 'B19001H_004', + B2025nhw = 'B19001H_005', + B2530nhw = 'B19001H_006', + B100125nhw = 'B19001H_014', + B125150nhw = 'B19001H_015', + B150200nhw = 'B19001H_016', + O200nhw = 'B19001H_017', + U10bih = 'B19001B_002', + B1015bih = 'B19001B_003', + B1520bih = 'B19001B_004', + B2025bih = 'B19001B_005', + B2530bih = 'B19001B_006' + ) + + # Acquire ICE variables + ice_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo, + year = year, + output = 'wide', + variables = vars, + ... + ) + )) + + + if (geo == 'tract') { + ice_data <- ice_data %>% + tidyr::separate(NAME, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } else { + ice_data <- ice_data %>% + tidyr::separate(NAME, into = c('county', 'state'), sep = ',') + } + ice_data <- ice_data %>% - tidyr::separate(NAME, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]","", tract)) - } else { - ice_data <- ice_data %>% tidyr::separate(NAME, into = c("county", "state"), sep = ",") - } - - ice_data <- ice_data %>% - dplyr::mutate(TotalPop_inc = TotalPopiE, - TotalPop_edu = TotalPopeduE, - TotalPop_re = TotalPopreE, - U10i = U10iE, - B1015i = B1015iE, - B1520i = B1520iE, - B2025i = B2025iE, - B2530i = B2530iE, - B100125i = B100125iE, - B125150i = B125150iE, - B150200i = B150200iE, - O200i = O200iE, - O25MNSC = O25MNSCE, - O25FNSC = O25FNSCE, - O25MNt4G = O25MNt4GE, - O25FNt4G = O25FNt4GE, - O25M5t6G = O25M5t6GE, - O25F5t6G = O25F5t6GE, - O25M7t8G = O25M7t8GE, - O25F7t8G = O25F7t8GE, - O25M9G = O25M9GE, - O25F9G = O25F9GE, - O25M10G = O25M10GE, - O25F10G = O25F10GE, - O25M11G = O25M11GE, - O25F11G = O25F11GE, - O25M12GND = O25M12GNDE, - O25F12GND = O25F12GNDE, - O25MBD = O25MBDE, - O25FBD = O25FBDE, - O25MMD = O25MMDE, - O25FMD = O25FMDE, - O25MPSD = O25MPSDE, - O25FPSD = O25FPSDE, - O25MDD = O25MDDE, - O25FDD = O25FDDE, - NHoLW = NHoLWE, - NHoLB = NHoLBE, - U10nhw = U10nhwE, - B1015nhw = B1015nhwE, - B1520nhw = B1520nhwE, - B2025nhw = B2025nhwE, - B2530nhw = B2530nhwE, - B100125nhw = B100125nhwE, - B125150nhw = B125150nhwE, - B150200nhw = B150200nhwE, - O200nhw = O200nhwE, - U10bih = U10bihE, - B1015bih = B1015bihE, - B1520bih = B1520bihE, - B2025bih = B2025bihE, - B2530bih = B2530bihE) - - # Sum educational attainment categories - # A_{edu} = Less than high school / 12 year / GED - # P_{edu} = Four-year college degree or more - ice_data <- ice_data %>% - dplyr::mutate(A_edu = O25MBD + O25FBD + O25MMD + O25FMD + O25MPSD + - O25FPSD + O25MDD + O25FDD, - P_edu = O25MNSC + O25FNSC + O25MNt4G + O25FNt4G + - O25M5t6G + O25F5t6G + O25M7t8G + O25F7t8G + - O25M9G + O25F9G + O25M10G + O25F10G + - O25M11G + O25F11G + O25M12GND + O25F12GND) - - # Sum income percentile counts - ## A_income (A_{inc}) is the 80th income percentile - ## P_income (P_{inc}) is the 20th income percentile - ## Add "Total, $25,000 to $34,999" for years 2016 and after - ## Remove "Total, $100,000 to $124,999" for years 2016 and after - ## According to U.S. Census Bureau Table A-4a - ## "Selected Measures of Household Income Dispersion: 1967 to 2020" - if (year < 2016) { - ice_data <- ice_data %>% - dplyr::mutate(A_inc = B100125i + B125150i + B150200i + O200i, - P_inc = U10i + B1015i + B1520i + B2025i, - A_wbinc = B100125nhw + B125150nhw + B150200nhw + O200nhw, - P_wbinc = U10bih + B1015bih + B1520bih + B2025bih, - A_wpcinc = B100125nhw + B125150nhw + B150200nhw + O200nhw, - P_wpcinc = U10nhw + B1015nhw + B1520nhw + B2025nhw) - } else { - ice_data <- ice_data %>% - dplyr::mutate(A_inc = B125150i + B150200i + O200i, - P_inc = U10i + B1015i + B1520i + B2025i + B2530i, - A_wbinc = B125150nhw + B150200nhw + O200nhw, - P_wbinc = U10bih + B1015bih + B1520bih + B2025bih + B2530bih, - A_wpcinc = B125150nhw + B150200nhw + O200nhw, - P_wpcinc = U10nhw + B1015nhw + B1520nhw + B2025nhw + B2530nhw) - } - - # Compute ICEs - ## From Kreiger et al. (2016) https://doi.org/10.2105%2FAJPH.2015.302955 - ## ICE_{i} = (A_{i} - P_{i}) / T_{i} - ## Where: - ## A_{i} denotes the count within the lowest extreme (e.g., households in 20th income percentile) - ## P_{i} denotes the count within the highest extreme (e.g., households in 80th income percentile) - ## T_{i} denotes the total population in region i (TotalPop) - - ice_data <- ice_data %>% - dplyr::mutate(ICE_inc = (A_inc - P_inc) / TotalPop_inc, - ICE_edu = (A_edu - P_edu) / TotalPop_edu, - ICE_rewb = (NHoLW - NHoLB) / TotalPop_re, - ICE_wbinc = (A_wbinc - P_wbinc) / TotalPop_inc, - ICE_wpcinc = (A_wpcinc - P_wpcinc) / TotalPop_inc) - - # Warning for missingness of census characteristics - missingYN <- ice_data %>% - dplyr::select(U10i, B1015i, B1520i, B2025i, B2530i, B100125i, B125150i, - B150200i, O200i, O25MNSC, O25FNSC,O25MNt4G, O25FNt4G, - O25M5t6G, O25F5t6G, O25M7t8G, O25F7t8G, O25M9G, O25F9G, - O25M10G, O25F10G, O25M11G, O25F11G, O25M12GND, O25F12GND, - O25MBD, O25FBD, O25MMD, O25FMD, O25MPSD, O25FPSD, O25MDD, - O25FDD, NHoLW, NHoLB, U10nhw, B1015nhw, B1520nhw, - B2025nhw, B2530nhw, B100125nhw, B125150nhw, - B150200nhw, O200nhw, U10bih, B1015bih, B1520bih, B2025bih, - B2530bih, TotalPop_inc, TotalPop_edu, TotalPop_re) %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% - dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) - - if (quiet == FALSE) { - # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + dplyr::mutate( + TotalPop_inc = TotalPopiE, + TotalPop_edu = TotalPopeduE, + TotalPop_re = TotalPopreE, + U10i = U10iE, + B1015i = B1015iE, + B1520i = B1520iE, + B2025i = B2025iE, + B2530i = B2530iE, + B100125i = B100125iE, + B125150i = B125150iE, + B150200i = B150200iE, + O200i = O200iE, + O25MNSC = O25MNSCE, + O25FNSC = O25FNSCE, + O25MNt4G = O25MNt4GE, + O25FNt4G = O25FNt4GE, + O25M5t6G = O25M5t6GE, + O25F5t6G = O25F5t6GE, + O25M7t8G = O25M7t8GE, + O25F7t8G = O25F7t8GE, + O25M9G = O25M9GE, + O25F9G = O25F9GE, + O25M10G = O25M10GE, + O25F10G = O25F10GE, + O25M11G = O25M11GE, + O25F11G = O25F11GE, + O25M12GND = O25M12GNDE, + O25F12GND = O25F12GNDE, + O25MBD = O25MBDE, + O25FBD = O25FBDE, + O25MMD = O25MMDE, + O25FMD = O25FMDE, + O25MPSD = O25MPSDE, + O25FPSD = O25FPSDE, + O25MDD = O25MDDE, + O25FDD = O25FDDE, + NHoLW = NHoLWE, + NHoLB = NHoLBE, + U10nhw = U10nhwE, + B1015nhw = B1015nhwE, + B1520nhw = B1520nhwE, + B2025nhw = B2025nhwE, + B2530nhw = B2530nhwE, + B100125nhw = B100125nhwE, + B125150nhw = B125150nhwE, + B150200nhw = B150200nhwE, + O200nhw = O200nhwE, + U10bih = U10bihE, + B1015bih = B1015bihE, + B1520bih = B1520bihE, + B2025bih = B2025bihE, + B2530bih = B2530bihE + ) + + # Sum educational attainment categories + # A_{edu} = Less than high school / 12 year / GED + # P_{edu} = Four-year college degree or more + ice_data <- ice_data %>% + dplyr::mutate( + A_edu = O25MBD + O25FBD + O25MMD + O25FMD + O25MPSD + O25FPSD + O25MDD + O25FDD, + P_edu = O25MNSC + O25FNSC + O25MNt4G + O25FNt4G + O25M5t6G + O25F5t6G + O25M7t8G + + O25F7t8G + O25M9G + O25F9G + O25M10G + O25F10G + O25M11G + O25F11G + O25M12GND + + O25F12GND + ) + + # Sum income percentile counts + ## A_income (A_{inc}) is the 80th income percentile + ## P_income (P_{inc}) is the 20th income percentile + ## Add 'Total, $25,000 to $34,999' for years 2016 and after + ## Remove 'Total, $100,000 to $124,999' for years 2016 and after + ## According to U.S. Census Bureau Table A-4a + ## 'Selected Measures of Household Income Dispersion: 1967 to 2020' + if (year < 2016) { + ice_data <- ice_data %>% + dplyr::mutate( + A_inc = B100125i + B125150i + B150200i + O200i, + P_inc = U10i + B1015i + B1520i + B2025i, + A_wbinc = B100125nhw + B125150nhw + B150200nhw + O200nhw, + P_wbinc = U10bih + B1015bih + B1520bih + B2025bih, + A_wpcinc = B100125nhw + B125150nhw + B150200nhw + O200nhw, + P_wpcinc = U10nhw + B1015nhw + B1520nhw + B2025nhw + ) + } else { + ice_data <- ice_data %>% + dplyr::mutate( + A_inc = B125150i + B150200i + O200i, + P_inc = U10i + B1015i + B1520i + B2025i + B2530i, + A_wbinc = B125150nhw + B150200nhw + O200nhw, + P_wbinc = U10bih + B1015bih + B1520bih + B2025bih + B2530bih, + A_wpcinc = B125150nhw + B150200nhw + O200nhw, + P_wpcinc = U10nhw + B1015nhw + B1520nhw + B2025nhw + B2530nhw + ) } + + # Compute ICEs + ## From Kreiger et al. (2016) https://doi.org/10.2105%2FAJPH.2015.302955 + ## ICE_{i} = (A_{i} - P_{i}) / T_{i} + ## Where: + ## A_{i} denotes the count within the lowest extreme (e.g., households in 20th income percentile) + ## P_{i} denotes the count within the highest extreme (e.g., households in 80th income percentile) + ## T_{i} denotes the total population in region i (TotalPop) + + ice_data <- ice_data %>% + dplyr::mutate( + ICE_inc = (A_inc - P_inc) / TotalPop_inc, + ICE_edu = (A_edu - P_edu) / TotalPop_edu, + ICE_rewb = (NHoLW - NHoLB) / TotalPop_re, + ICE_wbinc = (A_wbinc - P_wbinc) / TotalPop_inc, + ICE_wpcinc = (A_wpcinc - P_wpcinc) / TotalPop_inc + ) + + # Warning for missingness of census characteristics + missingYN <- ice_data %>% + dplyr::select( + U10i, + B1015i, + B1520i, + B2025i, + B2530i, + B100125i, + B125150i, + B150200i, + O200i, + O25MNSC, + O25FNSC, + O25MNt4G, + O25FNt4G, + O25M5t6G, + O25F5t6G, + O25M7t8G, + O25F7t8G, + O25M9G, + O25F9G, + O25M10G, + O25F10G, + O25M11G, + O25F11G, + O25M12GND, + O25F12GND, + O25MBD, + O25FBD, + O25MMD, + O25FMD, + O25MPSD, + O25FPSD, + O25MDD, + O25FDD, + NHoLW, + NHoLB, + U10nhw, + B1015nhw, + B1520nhw, + B2025nhw, + B2530nhw, + B100125nhw, + B125150nhw, + B150200nhw, + O200nhw, + U10bih, + B1015bih, + B1520bih, + B2025bih, + B2530bih, + TotalPop_inc, + TotalPop_edu, + TotalPop_re + ) %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + } + + # Format output + if (geo == 'tract') { + ice <- ice_data %>% + dplyr::select( + GEOID, + state, + county, + tract, + ICE_inc, + ICE_edu, + ICE_rewb, + ICE_wbinc, + ICE_wpcinc, + U10i, + B1015i, + B1520i, + B2025i, + B2530i, + B100125i, + B125150i, + B150200i, + O200i, + O25MNSC, + O25FNSC, + O25MNt4G, + O25FNt4G, + O25M5t6G, + O25F5t6G, + O25M7t8G, + O25F7t8G, + O25M9G, + O25F9G, + O25M10G, + O25F10G, + O25M11G, + O25F11G, + O25M12GND, + O25F12GND, + O25MBD, + O25FBD, + O25MMD, + O25FMD, + O25MPSD, + O25FPSD, + O25MDD, + O25FDD, + NHoLW, + NHoLB, + U10nhw, + B1015nhw, + B1520nhw, + B2025nhw, + B2530nhw, + B100125nhw, + B125150nhw, + B150200nhw, + O200nhw, + U10bih, + B1015bih, + B1520bih, + B2025bih, + B2530bih, + TotalPop_inc, + TotalPop_edu, + TotalPop_re + ) + } else { + ice <- ice_data %>% + dplyr::select( + GEOID, + state, + county, + ICE_inc, + ICE_edu, + ICE_rewb, + ICE_wbinc, + ICE_wpcinc, + U10i, + B1015i, + B1520i, + B2025i, + B2530i, + B100125i, + B125150i, + B150200i, + O200i, + O25MNSC, + O25FNSC, + O25MNt4G, + O25FNt4G, + O25M5t6G, + O25F5t6G, + O25M7t8G, + O25F7t8G, + O25M9G, + O25F9G, + O25M10G, + O25F10G, + O25M11G, + O25F11G, + O25M12GND, + O25F12GND, + O25MBD, + O25FBD, + O25MMD, + O25FMD, + O25MPSD, + O25FPSD, + O25MDD, + O25FDD, + NHoLW, + NHoLB, + U10nhw, + B1015nhw, + B1520nhw, + B2025nhw, + B2530nhw, + B100125nhw, + B125150nhw, + B150200nhw, + O200nhw, + U10bih, + B1015bih, + B1520bih, + B2025bih, + B2530bih, + TotalPop_inc, + TotalPop_edu, + TotalPop_re + ) + } + + ice <- ice %>% + dplyr::mutate( + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + out <- list(ice = ice, missing = missingYN) + + return(out) } - - # Format output - if (geo == "tract") { - ice <- ice_data %>% - dplyr::select(GEOID, state, county, tract, - ICE_inc, ICE_edu, ICE_rewb, ICE_wbinc, ICE_wpcinc, - U10i, B1015i, B1520i, B2025i, B2530i, B100125i, B125150i, - B150200i, O200i, O25MNSC, O25FNSC,O25MNt4G, O25FNt4G, - O25M5t6G, O25F5t6G, O25M7t8G, O25F7t8G, O25M9G, O25F9G, - O25M10G, O25F10G, O25M11G, O25F11G, O25M12GND, O25F12GND, - O25MBD, O25FBD, O25MMD, O25FMD, O25MPSD, O25FPSD, O25MDD, - O25FDD, NHoLW, NHoLB, U10nhw, B1015nhw, B1520nhw, - B2025nhw, B2530nhw, B100125nhw, B125150nhw, - B150200nhw, O200nhw, U10bih, B1015bih, B1520bih, B2025bih, - B2530bih, TotalPop_inc, TotalPop_edu, TotalPop_re) - } else { - ice <- ice_data %>% - dplyr::select(GEOID, state, county, - ICE_inc, ICE_edu, ICE_rewb, ICE_wbinc, ICE_wpcinc, - U10i, B1015i, B1520i, B2025i, B2530i, B100125i, B125150i, - B150200i, O200i, O25MNSC, O25FNSC,O25MNt4G, O25FNt4G, - O25M5t6G, O25F5t6G, O25M7t8G, O25F7t8G, O25M9G, O25F9G, - O25M10G, O25F10G, O25M11G, O25F11G, O25M12GND, O25F12GND, - O25MBD, O25FBD, O25MMD, O25FMD, O25MPSD, O25FPSD, O25MDD, - O25FDD, NHoLW, NHoLB, U10nhw, B1015nhw, B1520nhw, - B2025nhw, B2530nhw, B100125nhw, B125150nhw, - B150200nhw, O200nhw, U10bih, B1015bih, B1520bih, B2025bih, - B2530bih, TotalPop_inc, TotalPop_edu, TotalPop_re) - } - - ice <- ice %>% - dplyr::mutate(state = stringr::str_trim(state), - county = stringr::str_trim(county)) %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() - - out <- list(ice = ice, - missing = missingYN) - - return(out) -} diff --git a/R/messer.R b/R/messer.R index 01b71a5..614ffdd 100644 --- a/R/messer.R +++ b/R/messer.R @@ -1,8 +1,8 @@ -#' Neighborhood Deprivation Index based on Messer _et al._ (2006) +#' Neighborhood Deprivation Index based on Messer et al. (2006) #' #' Compute the aspatial Neighborhood Deprivation Index (Messer). #' -#' @param geo Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}. +#' @param geo Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2010 onward are currently available. #' @param imp Logical. If TRUE, will impute missing census characteristics within the internal \code{\link[psych]{principal}}. If FALSE (the default), will not impute. #' @param quiet Logical. If TRUE, will display messages about potential missing census information and the proportion of variance explained by principal component analysis. The default is FALSE. @@ -10,7 +10,7 @@ #' @param df Optional. Pass a pre-formatted \code{'dataframe'} or \code{'tibble'} with the desired variables through the function. Bypasses the data obtained by \code{\link[tidycensus]{get_acs}}. The default is NULL. See Details below. #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' -#' @details This function will compute the aspatial Neighborhood Deprivation Index (NDI) of U.S. census tracts or counties for a specified geographical referent (e.g., US-standardized) based on Messer _et al._ (2006) \doi{10.1007/s11524-006-9094-x}. +#' @details This function will compute the aspatial Neighborhood Deprivation Index (NDI) of U.S. census tracts or counties for a specified geographical referent (e.g., US-standardized) based on Messer et al. (2006) \doi{10.1007/s11524-006-9094-x}. #' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for computation involving a principal component analysis with the \code{\link[psych]{principal}} function. The yearly estimates are available for 2010 and after when all census characteristics became available. The eight characteristics are: #' \itemize{ @@ -27,11 +27,11 @@ #' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify the referent for standardizing the NDI (Messer) values. For example, if all U.S. states are specified for the \code{state} argument, then the output would be a U.S.-standardized index. #' -#' The continuous NDI (Messer) values are z-transformed, i.e., "standardized," and the categorical NDI (Messer) values are quartiles of the standardized continuous NDI (Messer) values. +#' The continuous NDI (Messer) values are z-transformed, i.e., 'standardized,' and the categorical NDI (Messer) values are quartiles of the standardized continuous NDI (Messer) values. #' #' Check if the proportion of variance explained by the first principal component is high (more than 0.5). #' -#' Users can bypass \code{\link[tidycensus]{get_acs}} by specifying a pre-formatted data frame or tibble using the \code{df} argument. This function will compute an index using the first component of a principal component analysis (PCA) with a Varimax rotation (the default for \code{\link[psych]{principal}}) and only one factor (note: PCA set-up not unspecified in Messer _et al._ (2006)). The recommended structure of the data frame or tibble is an ID (e.g., GEOID) in the first feature (column), followed by the variables of interest (in any order) and no additional information (e.g., omit state or county names from the \code{df} argument input). +#' Users can bypass \code{\link[tidycensus]{get_acs}} by specifying a pre-formatted data frame or tibble using the \code{df} argument. This function will compute an index using the first component of a principal component analysis (PCA) with a Varimax rotation (the default for \code{\link[psych]{principal}}) and only one factor (note: PCA set-up not unspecified in Messer et al. (2006)). The recommended structure of the data frame or tibble is an ID (e.g., GEOID) in the first feature (column), followed by the variables of interest (in any order) and no additional information (e.g., omit state or county names from the \code{df} argument input). #' #' @return An object of class 'list'. This is a named list with the following components: #' @@ -59,232 +59,333 @@ #' # Wrapped in \dontrun{} because these examples require a Census API key. #' #' # Tract-level metric (2020) -#' messer(geo = "tract", state = "GA", year = 2020) +#' messer(geo = 'tract', state = 'GA', year = 2020) #' #' # Impute NDI for tracts (2020) with missing census information (median values) -#' messer(state = "tract", "GA", year = 2020, imp = TRUE) +#' messer(state = 'tract', 'GA', year = 2020, imp = TRUE) #' #' # County-level metric (2020) -#' messer(geo = "county", state = "GA", year = 2020) +#' messer(geo = 'county', state = 'GA', year = 2020) #' #' } #' -messer <- function(geo = "tract", year = 2020, imp = FALSE, quiet = FALSE, round_output = FALSE, df = NULL, ...) { +messer <- function(geo = 'tract', + year = 2020, + imp = FALSE, + quiet = FALSE, + round_output = FALSE, + df = NULL, + ...) { # Check arguments - if (!is.null(df) & !inherits(df, c("tbl_df", "tbl", "data.frame"))) { stop("'df' must be class 'data.frame' or 'tbl'") } + if (!is.null(df) & + !inherits(df, c('tbl_df', 'tbl', 'data.frame'))) { + stop("df' must be class 'data.frame' or 'tbl'") + } if (is.null(df)) { - # Check additional arguments - match.arg(geo, choices = c("county", "tract")) + match.arg(geo, choices = c('county', 'tract')) stopifnot(is.numeric(year), year >= 2010) # all variables available 2010 onward # Select census variables - vars <- c(PctMenMgmtBusScArti_num1 = "C24030_018", PctMenMgmtBusScArti_num2 = "C24030_019", - PctMenMgmtBusScArti_den = "C24030_002", - PctCrwdHH_num1 = "B25014_005", PctCrwdHH_num2 = "B25014_006", - PctCrwdHH_num3 = "B25014_007", PctCrwdHH_num4 = "B25014_011", - PctCrwdHH_num5 = "B25014_012", PctCrwdHH_num6 = "B25014_013", - PctCrwdHH_den = "B25014_001", - PctHHPov_num = "B17017_002", PctHHPov_den = "B17017_001", - PctFemHeadKids_num1 = "B25115_012", PctFemHeadKids_num2 = "B25115_025", - PctFemHeadKids_den = "B25115_001", - PctPubAsst_num = "B19058_002", PctPubAsst_den = "B19058_001", - PctHHUnder30K_num1 = "B19001_002", PctHHUnder30K_num2 = "B19001_003", - PctHHUnder30K_num3 = "B19001_004", PctHHUnder30K_num4 = "B19001_005", - PctHHUnder30K_num5 = "B19001_006", PctHHUnder30K_den = "B19001_001", - PctEducLessThanHS_num = "B06009_002", PctEducLessThanHS_den = "B06009_001", - PctUnemp_num = "B23025_005", PctUnemp_den = "B23025_003") + vars <- + c( + PctMenMgmtBusScArti_num1 = 'C24030_018', + PctMenMgmtBusScArti_num2 = 'C24030_019', + PctMenMgmtBusScArti_den = 'C24030_002', + PctCrwdHH_num1 = 'B25014_005', + PctCrwdHH_num2 = 'B25014_006', + PctCrwdHH_num3 = 'B25014_007', + PctCrwdHH_num4 = 'B25014_011', + PctCrwdHH_num5 = 'B25014_012', + PctCrwdHH_num6 = 'B25014_013', + PctCrwdHH_den = 'B25014_001', + PctHHPov_num = 'B17017_002', + PctHHPov_den = 'B17017_001', + PctFemHeadKids_num1 = 'B25115_012', + PctFemHeadKids_num2 = 'B25115_025', + PctFemHeadKids_den = 'B25115_001', + PctPubAsst_num = 'B19058_002', + PctPubAsst_den = 'B19058_001', + PctHHUnder30K_num1 = 'B19001_002', + PctHHUnder30K_num2 = 'B19001_003', + PctHHUnder30K_num3 = 'B19001_004', + PctHHUnder30K_num4 = 'B19001_005', + PctHHUnder30K_num5 = 'B19001_006', + PctHHUnder30K_den = 'B19001_001', + PctEducLessThanHS_num = 'B06009_002', + PctEducLessThanHS_den = 'B06009_001', + PctUnemp_num = 'B23025_005', + PctUnemp_den = 'B23025_003' + ) if (year == 2010) { # Select census variables - vars <- c(vars[-c(26,27)], PctUnemp_den = "B23001_001", - PctUnemp_1619M = "B23001_008", PctUnemp_2021M = "B23001_015", - PctUnemp_2224M = "B23001_022", PctUnemp_2529M = "B23001_029", - PctUnemp_3034M = "B23001_036", PctUnemp_3544M = "B23001_043", - PctUnemp_4554M = "B23001_050", PctUnemp_5559M = "B23001_057", - PctUnemp_6061M = "B23001_064", PctUnemp_6264M = "B23001_071", - PctUnemp_6569M = "B23001_076", PctUnemp_7074M = "B23001_081", - PctUnemp_75upM = "B23001_086", PctUnemp_1619F = "B23001_094", - PctUnemp_2021F = "B23001_101", PctUnemp_2224F = "B23001_108", - PctUnemp_2529F = "B23001_115", PctUnemp_3034F = "B23001_122", - PctUnemp_3544F = "B23001_129", PctUnemp_4554F = "B23001_136", - PctUnemp_5559F = "B23001_143", PctUnemp_6061F = "B23001_150", - PctUnemp_6264F = "B23001_157", PctUnemp_6569F = "B23001_162", - PctUnemp_7074F = "B23001_167", PctUnemp_75upF = "B23001_172") + vars <- c( + vars[-c(26, 27)], + PctUnemp_den = 'B23001_001', + PctUnemp_1619M = 'B23001_008', + PctUnemp_2021M = 'B23001_015', + PctUnemp_2224M = 'B23001_022', + PctUnemp_2529M = 'B23001_029', + PctUnemp_3034M = 'B23001_036', + PctUnemp_3544M = 'B23001_043', + PctUnemp_4554M = 'B23001_050', + PctUnemp_5559M = 'B23001_057', + PctUnemp_6061M = 'B23001_064', + PctUnemp_6264M = 'B23001_071', + PctUnemp_6569M = 'B23001_076', + PctUnemp_7074M = 'B23001_081', + PctUnemp_75upM = 'B23001_086', + PctUnemp_1619F = 'B23001_094', + PctUnemp_2021F = 'B23001_101', + PctUnemp_2224F = 'B23001_108', + PctUnemp_2529F = 'B23001_115', + PctUnemp_3034F = 'B23001_122', + PctUnemp_3544F = 'B23001_129', + PctUnemp_4554F = 'B23001_136', + PctUnemp_5559F = 'B23001_143', + PctUnemp_6061F = 'B23001_150', + PctUnemp_6264F = 'B23001_157', + PctUnemp_6569F = 'B23001_162', + PctUnemp_7074F = 'B23001_167', + PctUnemp_75upF = 'B23001_172' + ) # Acquire NDI variables - ndi_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo, - year = year, - output = "wide", - variables = vars, ...))) + ndi_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo, + year = year, + output = 'wide', + variables = vars, + ... + ) + )) - if (geo == "tract") { + if (geo == 'tract') { ndi_data <- ndi_data %>% - tidyr::separate(NAME, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]","", tract)) + tidyr::separate(NAME, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) } else { - ndi_data <- ndi_data %>% tidyr::separate(NAME, into = c("county", "state"), sep = ",") + ndi_data <- + ndi_data %>% tidyr::separate(NAME, into = c('county', 'state'), sep = ',') } ndi_data <- ndi_data %>% - dplyr::mutate(OCC = (PctMenMgmtBusScArti_num1E + PctMenMgmtBusScArti_num2E) / PctMenMgmtBusScArti_denE, - CWD = (PctCrwdHH_num1E + PctCrwdHH_num2E + PctCrwdHH_num3E + - PctCrwdHH_num4E + PctCrwdHH_num5E + PctCrwdHH_num6E) / PctCrwdHH_denE, - POV = PctHHPov_numE / PctHHPov_denE, - FHH = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE, - PUB = PctPubAsst_numE / PctPubAsst_denE, - U30 = (PctHHUnder30K_num1E + PctHHUnder30K_num2E + PctHHUnder30K_num3E + - PctHHUnder30K_num4E + PctHHUnder30K_num5E) / PctHHUnder30K_denE, - EDU = PctEducLessThanHS_numE / PctEducLessThanHS_denE, - EMP = (PctUnemp_1619ME + PctUnemp_2021ME + - PctUnemp_2224ME + PctUnemp_2529ME + - PctUnemp_4554ME + PctUnemp_5559ME + - PctUnemp_6061ME + PctUnemp_6264ME + - PctUnemp_6569ME + PctUnemp_7074ME + - PctUnemp_75upME + PctUnemp_1619FE + - PctUnemp_2021FE + PctUnemp_2224FE + - PctUnemp_2529FE + PctUnemp_4554FE + - PctUnemp_5559FE + PctUnemp_6061FE + - PctUnemp_6264FE + PctUnemp_6569FE + - PctUnemp_7074FE + PctUnemp_75upME) / PctUnemp_denE) + dplyr::mutate( + OCC = (PctMenMgmtBusScArti_num1E + PctMenMgmtBusScArti_num2E) / PctMenMgmtBusScArti_denE, + CWD = ( + PctCrwdHH_num1E + PctCrwdHH_num2E + PctCrwdHH_num3E + PctCrwdHH_num4E + + PctCrwdHH_num5E + PctCrwdHH_num6E + ) / PctCrwdHH_denE, + POV = PctHHPov_numE / PctHHPov_denE, + FHH = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE, + PUB = PctPubAsst_numE / PctPubAsst_denE, + U30 = ( + PctHHUnder30K_num1E + PctHHUnder30K_num2E + PctHHUnder30K_num3E + PctHHUnder30K_num4E + + PctHHUnder30K_num5E + ) / PctHHUnder30K_denE, + EDU = PctEducLessThanHS_numE / PctEducLessThanHS_denE, + EMP = ( + PctUnemp_1619ME + PctUnemp_2021ME + + PctUnemp_2224ME + PctUnemp_2529ME + + PctUnemp_4554ME + PctUnemp_5559ME + + PctUnemp_6061ME + PctUnemp_6264ME + + PctUnemp_6569ME + PctUnemp_7074ME + + PctUnemp_75upME + PctUnemp_1619FE + + PctUnemp_2021FE + PctUnemp_2224FE + + PctUnemp_2529FE + PctUnemp_4554FE + + PctUnemp_5559FE + PctUnemp_6061FE + + PctUnemp_6264FE + PctUnemp_6569FE + + PctUnemp_7074FE + PctUnemp_75upME + ) / PctUnemp_denE + ) } else { # Acquire NDI variables - ndi_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo, - year = year, - output = "wide", - variables = vars, ...))) - - if (geo == "tract") { + ndi_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo, + year = year, + output = 'wide', + variables = vars, + ... + ) + )) + + if (geo == 'tract') { ndi_data <- ndi_data %>% - tidyr::separate(NAME, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]","", tract)) + tidyr::separate(NAME, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) } else { - ndi_data <- ndi_data %>% tidyr::separate(NAME, into = c("county", "state"), sep = ",") + ndi_data <- + ndi_data %>% tidyr::separate(NAME, into = c('county', 'state'), sep = ',') } ndi_data <- ndi_data %>% - dplyr::mutate(OCC = (PctMenMgmtBusScArti_num1E + PctMenMgmtBusScArti_num2E) / PctMenMgmtBusScArti_denE, - CWD = (PctCrwdHH_num1E + PctCrwdHH_num2E + PctCrwdHH_num3E + - PctCrwdHH_num4E + PctCrwdHH_num5E + PctCrwdHH_num6E) / PctCrwdHH_denE, - POV = PctHHPov_numE / PctHHPov_denE, - FHH = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE, - PUB = PctPubAsst_numE / PctPubAsst_denE, - U30 = (PctHHUnder30K_num1E + PctHHUnder30K_num2E + PctHHUnder30K_num3E + - PctHHUnder30K_num4E + PctHHUnder30K_num5E) / PctHHUnder30K_denE, - EDU = PctEducLessThanHS_numE / PctEducLessThanHS_denE, - EMP = PctUnemp_numE / PctUnemp_denE) + dplyr::mutate( + OCC = (PctMenMgmtBusScArti_num1E + PctMenMgmtBusScArti_num2E) / PctMenMgmtBusScArti_denE, + CWD = ( + PctCrwdHH_num1E + PctCrwdHH_num2E + PctCrwdHH_num3E + PctCrwdHH_num4E + + PctCrwdHH_num5E + PctCrwdHH_num6E + ) / PctCrwdHH_denE, + POV = PctHHPov_numE / PctHHPov_denE, + FHH = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE, + PUB = PctPubAsst_numE / PctPubAsst_denE, + U30 = ( + PctHHUnder30K_num1E + PctHHUnder30K_num2E + PctHHUnder30K_num3E + PctHHUnder30K_num4E + + PctHHUnder30K_num5E + ) / PctHHUnder30K_denE, + EDU = PctEducLessThanHS_numE / PctEducLessThanHS_denE, + EMP = PctUnemp_numE / PctUnemp_denE + ) } # Generate NDI - ndi_data_pca <- ndi_data %>% + ndi_data_pca <- ndi_data %>% dplyr::select(OCC, CWD, POV, FHH, PUB, U30, EDU, EMP) } else { - # If inputing pre-formatted data: + # If inputing pre-formatted data: ndi_data <- dplyr::as_tibble(df) - ndi_data_pca <- df[ , -1] # omits the first feature (column) typically an ID (e.g., GEOID or FIPS) + # omit the first feature (column) typically an ID (e.g., GEOID or FIPS) + ndi_data_pca <- df[,-1] } # Replace infinite values as zero (typically because denominator is zero) - ndi_data_pca <- do.call(data.frame, - lapply(ndi_data_pca, - function(x) replace(x, is.infinite(x), 0))) + ndi_data_pca <- do.call( + data.frame, + lapply(ndi_data_pca, function(x) replace(x, is.infinite(x), 0)) + ) # Run principal component analysis - pca <- psych::principal(ndi_data_pca, - nfactors = 1, - n.obs = nrow(ndi_data_pca), - covar = FALSE, - scores = TRUE, - missing = imp) + pca <- psych::principal( + ndi_data_pca, + nfactors = 1, + n.obs = nrow(ndi_data_pca), + covar = FALSE, + scores = TRUE, + missing = imp + ) # Warning for missingness of census characteristics missingYN <- ndi_data_pca %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) if (quiet == FALSE) { # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') } # Warning for proportion of variance explained by PC1 if (pca$Vaccounted[2] < 0.50) { - message("Warning: The proportion of variance explained by PC1 is less than 0.50.") + message('Warning: The proportion of variance explained by PC1 is less than 0.50.') } } # NDI quartiles NDIQuart <- data.frame(PC1 = pca$scores) %>% - dplyr::mutate(NDI = PC1 / pca$value[1]^2, - NDIQuart = cut(NDI, - breaks = stats::quantile(NDI, - probs = c(0, 0.25, 0.50, 0.75, 1), - na.rm = TRUE), - labels = c("1-Least deprivation", "2-BelowAvg deprivation", - "3-AboveAvg deprivation", "4-Most deprivation"), - include.lowest = TRUE), - NDIQuart = factor(replace(as.character(NDIQuart), - is.na(NDIQuart), - "9-NDI not avail"), - c(levels(NDIQuart), "9-NDI not avail"))) %>% + dplyr::mutate( + NDI = PC1 / pca$value[1] ^ 2, + NDIQuart = cut( + NDI, + breaks = stats::quantile(NDI, probs = c(0, 0.25, 0.50, 0.75, 1), na.rm = TRUE), + labels = c( + '1-Least deprivation', + '2-BelowAvg deprivation', + '3-AboveAvg deprivation', + '4-Most deprivation' + ), + include.lowest = TRUE + ), + NDIQuart = factor( + replace(as.character(NDIQuart), is.na(NDIQuart), '9-NDI not avail'), + c(levels(NDIQuart), '9-NDI not avail') + ) + ) %>% dplyr::select(NDI, NDIQuart) if (is.null(df)) { # Format output if (round_output == TRUE) { ndi <- cbind(ndi_data, NDIQuart) %>% - dplyr::mutate(OCC = round(OCC, digits = 1), - CWD = round(CWD, digits = 1), - POV = round(POV, digits = 1), - FHH = round(FHH, digits = 1), - PUB = round(PUB, digits = 1), - U30 = round(U30, digits = 1), - EDU = round(EDU, digits = 1), - EMP = round(EMP, digits = 1), - NDI = round(NDI, digits = 4)) + dplyr::mutate( + OCC = round(OCC, digits = 1), + CWD = round(CWD, digits = 1), + POV = round(POV, digits = 1), + FHH = round(FHH, digits = 1), + PUB = round(PUB, digits = 1), + U30 = round(U30, digits = 1), + EDU = round(EDU, digits = 1), + EMP = round(EMP, digits = 1), + NDI = round(NDI, digits = 4) + ) } else { ndi <- cbind(ndi_data, NDIQuart) } - if (geo == "tract") { + if (geo == 'tract') { ndi <- ndi %>% - dplyr::select(GEOID, - state, - county, - tract, - NDI, NDIQuart, - OCC, CWD, POV, FHH, PUB, U30, EDU, EMP) + dplyr::select( + GEOID, + state, + county, + tract, + NDI, + NDIQuart, + OCC, + CWD, + POV, + FHH, + PUB, + U30, + EDU, + EMP + ) } else { ndi <- ndi %>% - dplyr::select(GEOID, - state, - county, - NDI, NDIQuart, - OCC, CWD, POV, FHH, PUB, U30, EDU, EMP) + dplyr::select( + GEOID, + state, + county, + NDI, + NDIQuart, + OCC, + CWD, + POV, + FHH, + PUB, + U30, + EDU, + EMP + ) } ndi <- ndi %>% - dplyr::mutate(state = stringr::str_trim(state), - county = stringr::str_trim(county)) %>% + dplyr::mutate( + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) %>% dplyr::arrange(GEOID) %>% dplyr::as_tibble() } else { - ndi <- cbind(df[ , 1], NDIQuart, df[ , 2:ncol(df)]) - ndi <- dplyr::as_tibble(ndi[order(ndi[ , 1]), ]) + ndi <- cbind(df[, 1], NDIQuart, df[, 2:ncol(df)]) + ndi <- dplyr::as_tibble(ndi[order(ndi[, 1]),]) } - out <- list(ndi = ndi, - pca = pca, - missing = missingYN) + out <- list(ndi = ndi, pca = pca, missing = missingYN) return(out) } diff --git a/R/powell_wiley.R b/R/powell_wiley.R index d765dc5..07acd46 100644 --- a/R/powell_wiley.R +++ b/R/powell_wiley.R @@ -1,17 +1,17 @@ -#' Neighborhood Deprivation Index based on Andrews _et al._ (2020) and Slotman _et al._ (2022) -#' +#' Neighborhood Deprivation Index based on Andrews et al. (2020) and Slotman et al. (2022) +#' #' Compute the aspatial Neighborhood Deprivation Index (Powell-Wiley). #' -#' @param geo Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}. +#' @param geo Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2010 onward are currently available. -#' @param imp Logical. If TRUE, will impute missing census characteristics within the internal \code{\link[psych]{principal}} using median values of variables. If FALSE (the default), will not impute. +#' @param imp Logical. If TRUE, will impute missing census characteristics within the internal \code{\link[psych]{principal}} using median values of variables. If FALSE (the default), will not impute. #' @param quiet Logical. If TRUE, will display messages about potential missing census information, standardized Cronbach's alpha, and proportion of variance explained by principal component analysis. The default is FALSE. #' @param round_output Logical. If TRUE, will round the output of raw census and NDI values from the \code{\link[tidycensus]{get_acs}} at one and four significant digits, respectively. The default is FALSE. #' @param df Optional. Pass a pre-formatted \code{'dataframe'} or \code{'tibble'} with the desired variables through the function. Bypasses the data obtained by \code{\link[tidycensus]{get_acs}}. The default is NULL. See Details below. #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' -#' @details This function will compute the aspatial Neighborhood Deprivation Index (NDI) of U.S. census tracts or counties for a specified geographical referent (e.g., US-standardized) based on Andrews _et al._ (2020) \doi{10.1080/17445647.2020.1750066} and Slotman _et al._ (2022) \doi{10.1016/j.dib.2022.108002}. -#' +#' @details This function will compute the aspatial Neighborhood Deprivation Index (NDI) of U.S. census tracts or counties for a specified geographical referent (e.g., US-standardized) based on Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} and Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002}. +#' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for computation involving a factor analysis with the \code{\link[psych]{principal}} function. The yearly estimates are available in 2010 and after when all census characteristics became available. The thirteen characteristics chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x} are: #' \itemize{ #' \item **MedHHInc (B19013)**: median household income (dollars) @@ -28,25 +28,25 @@ #' \item **PctFamBelowPov (S1702)**: percent of families with incomes below the poverty level #' \item **PctUnempl (S2301)**: percent unemployed #' } -#' -#' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify the referent for standardizing the NDI (Powell-Wiley) values. For example, if all U.S. states are specified for the \code{state} argument, then the output would be a U.S.-standardized index. Please note: the NDI (Powell-Wiley) values will not exactly match (but will highly correlate with) those found in Andrews _et al._ (2020) \doi{10.1080/17445647.2020.1750066} and Slotman _et al._ (2022) \doi{10.1016/j.dib.2022.108002} because the two studies used a different statistical platform (i.e., SPSS and SAS, respectively) that intrinsically calculate the principal component analysis differently from R. -#' -#' The categorical NDI (Powell-Wiley) values are population-weighted quintiles of the continuous NDI (Powell-Wiley) values. -#' +#' +#' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify the referent for standardizing the NDI (Powell-Wiley) values. For example, if all U.S. states are specified for the \code{state} argument, then the output would be a U.S.-standardized index. Please note: the NDI (Powell-Wiley) values will not exactly match (but will highly correlate with) those found in Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} and Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002} because the two studies used a different statistical platform (i.e., SPSS and SAS, respectively) that intrinsically calculate the principal component analysis differently from R. +#' +#' The categorical NDI (Powell-Wiley) values are population-weighted quintiles of the continuous NDI (Powell-Wiley) values. +#' #' Check if the proportion of variance explained by the first principal component is high (more than 0.5). -#' +#' #' Users can bypass \code{\link[tidycensus]{get_acs}} by specifying a pre-formatted data frame or tibble using the \code{df} argument. This function will compute an index using the first component of a principal component analysis (PCA) with a Promax (oblique) rotation and a minimum Eigenvalue of 1, omitting variables with absolute loading score < 0.4. The recommended structure of the data frame or tibble is an ID (e.g., GEOID) in the first feature (column), an estimate of the total population in the second feature (column), followed by the variables of interest (in any order) and no additional information (e.g., omit state or county names from the \code{df} argument input). -#' +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{ndi}}{An object of class 'tbl' for the GEOID, name, NDI continuous, NDI quintiles, and raw census values of specified census geographies.} #' \item{\code{pca}}{An object of class 'principal', returns the output of \code{\link[psych]{principal}} used to compute the NDI values.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute NDI.} #' \item{\code{cronbach}}{An object of class 'character' or 'numeric' for the results of the Cronbach's alpha calculation. If only one factor is computed, a message is returned. If more than one factor is computed, Cronbach's alpha is calculated and should check that it is >0.7 for respectable internal consistency between factors.} #' } -#' -#' @import dplyr +#' +#' @import dplyr #' @importFrom MASS ginv #' @importFrom psych alpha principal #' @importFrom stats complete.cases cor cov2cor loadings median promax quantile sd @@ -54,310 +54,417 @@ #' @importFrom tidycensus get_acs #' @importFrom tidyr pivot_longer separate #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic referent selection (i.e., \code{state} and \code{county}). #' #' @examples -#' +#' #' powell_wiley(df = DCtracts2020[ , -c(3:10)]) -#' +#' #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Tract-level metric (2020) -#' powell_wiley(geo = "tract", state = "GA", year = 2020) +#' powell_wiley(geo = 'tract', state = 'GA', year = 2020) #' #' # Impute NDI for tracts (2020) with missing census information (median values) -#' powell_wiley(state = "tract", "GA", year = 2020, imp = TRUE) -#' +#' powell_wiley(state = 'tract', 'GA', year = 2020, imp = TRUE) +#' #' # County-level metric (2020) -#' powell_wiley(geo = "county", state = "GA", year = 2020) -#' +#' powell_wiley(geo = 'county', state = 'GA', year = 2020) +#' #' } -#' -powell_wiley <- function(geo = "tract", year = 2020, imp = FALSE, quiet = FALSE, round_output = FALSE, df = NULL, ...) { - - # Check arguments - if (!is.null(df) & !inherits(df, c("tbl_df", "tbl", "data.frame"))) { stop("'df' must be class 'data.frame' or 'tbl'") } +#' +powell_wiley <- function(geo = 'tract', + year = 2020, + imp = FALSE, + quiet = FALSE, + round_output = FALSE, + df = NULL, + ...) { - if (is.null(df)) { - - # Check additional arguments - match.arg(geo, choices = c("county", "tract")) - stopifnot(is.numeric(year), year >= 2010) # all variables available 2010 onward - - # Select census variables - vars <- c(MedHHInc = "B19013_001", - PctRecvIDR_num = "B19054_002", PctRecvIDR_den = "B19054_001", - PctPubAsst_num = "B19058_002", PctPubAsst_den = "B19058_001", - MedHomeVal = "B25077_001", - PctMgmtBusScArti_num = "C24060_002", PctMgmtBusScArti_den = "C24060_001", - PctFemHeadKids_num1 = "B11005_007", PctFemHeadKids_num2 = "B11005_010", - PctFemHeadKids_den = "B11005_001", - PctOwnerOcc = "DP04_0046P", - PctNoPhone = "DP04_0075P", - PctNComPlmb = "DP04_0073P", - PctEduc_num25upHS = "S1501_C01_009", - PctEduc_num25upSC = "S1501_C01_010", - PctEduc_num25upAD = "S1501_C01_011", - PctEduc_num25upBD = "S1501_C01_012", - PctEduc_num25upGD = "S1501_C01_013", - PctEduc_den25up = "S1501_C01_006", - PctFamBelowPov = "S1702_C02_001", - PctUnempl = "S2301_C04_001", - TotalPopulation = "B01001_001") - - # Updated census variable definition(s) - if (year < 2015){ vars <- c(vars[-13], PctNoPhone = "DP04_0074P") } - - # Acquire NDI variables - ndi_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo, - year = year, - output = "wide", - variables = vars, ...))) + # Check arguments + if (!is.null(df) & + !inherits(df, c('tbl_df', 'tbl', 'data.frame'))) { + stop("'df' must be class 'data.frame' or 'tbl'") + } - if (geo == "tract") { + if (is.null(df)) { + # Check additional arguments + match.arg(geo, choices = c('county', 'tract')) + stopifnot(is.numeric(year), year >= 2010) # all variables available 2010 onward + + # Select census variables + vars <- c( + MedHHInc = 'B19013_001', + PctRecvIDR_num = 'B19054_002', + PctRecvIDR_den = 'B19054_001', + PctPubAsst_num = 'B19058_002', + PctPubAsst_den = 'B19058_001', + MedHomeVal = 'B25077_001', + PctMgmtBusScArti_num = 'C24060_002', + PctMgmtBusScArti_den = 'C24060_001', + PctFemHeadKids_num1 = 'B11005_007', + PctFemHeadKids_num2 = 'B11005_010', + PctFemHeadKids_den = 'B11005_001', + PctOwnerOcc = 'DP04_0046P', + PctNoPhone = 'DP04_0075P', + PctNComPlmb = 'DP04_0073P', + PctEduc_num25upHS = 'S1501_C01_009', + PctEduc_num25upSC = 'S1501_C01_010', + PctEduc_num25upAD = 'S1501_C01_011', + PctEduc_num25upBD = 'S1501_C01_012', + PctEduc_num25upGD = 'S1501_C01_013', + PctEduc_den25up = 'S1501_C01_006', + PctFamBelowPov = 'S1702_C02_001', + PctUnempl = 'S2301_C04_001', + TotalPopulation = 'B01001_001' + ) + + # Updated census variable definition(s) + if (year < 2015) { + vars <- c(vars[-13], PctNoPhone = 'DP04_0074P') + } + + # Acquire NDI variables + ndi_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo, + year = year, + output = 'wide', + variables = vars, + ... + ) + )) + + + if (geo == 'tract') { + ndi_data <- ndi_data %>% + tidyr::separate(NAME, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } else { + ndi_data <- ndi_data %>% + tidyr::separate(NAME, into = c('county', 'state'), sep = ',') + } + ndi_data <- ndi_data %>% - tidyr::separate(NAME, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]","", tract)) + dplyr::mutate( + MedHHInc = MedHHIncE, + PctRecvIDR = PctRecvIDR_numE / PctRecvIDR_denE * 100, + PctPubAsst = PctPubAsst_numE / PctPubAsst_denE * 100, + MedHomeVal = MedHomeValE, + PctMgmtBusScArti = PctMgmtBusScArti_numE / PctMgmtBusScArti_denE * 100, + PctFemHeadKids = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / + PctFemHeadKids_denE * 100, + PctOwnerOcc = PctOwnerOccE, + PctNoPhone = PctNoPhoneE, + PctNComPlmb = PctNComPlmbE, + PctEducHSPlus = ( + PctEduc_num25upHSE + PctEduc_num25upSCE + PctEduc_num25upADE + PctEduc_num25upBDE + + PctEduc_num25upGDE + ) / PctEduc_den25upE * 100, + PctEducBchPlus = (PctEduc_num25upBDE + PctEduc_num25upGDE) / PctEduc_den25upE * 100, + PctFamBelowPov = PctFamBelowPovE, + PctUnempl = PctUnemplE, + TotalPop = TotalPopulationE + ) %>% + # Log transform median household income and median home value + # Reverse code percentages so that higher values represent more deprivation + # Round percentages to 1 decimal place + dplyr::mutate( + logMedHHInc = log(MedHHInc), + logMedHomeVal = log(MedHomeVal), + PctNoIDR = 100 - PctRecvIDR, + PctWorkClass = 100 - PctMgmtBusScArti, + PctNotOwnerOcc = 100 - PctOwnerOcc, + PctEducLTHS = 100 - PctEducHSPlus, + PctEducLTBch = 100 - PctEducBchPlus + ) %>% + # Z-standardize the percentages + dplyr::mutate( + PctNoIDRZ = scale(PctNoIDR), + PctPubAsstZ = scale(PctPubAsst), + PctWorkClassZ = scale(PctWorkClass), + PctFemHeadKidsZ = scale(PctFemHeadKids), + PctNotOwnerOccZ = scale(PctNotOwnerOcc), + PctNoPhoneZ = scale(PctNoPhone), + PctNComPlmbZ = scale(PctNComPlmb), + PctEducLTHSZ = scale(PctEducLTHS), + PctEducLTBchZ = scale(PctEducLTBch), + PctFamBelowPovZ = scale(PctFamBelowPov), + PctUnemplZ = scale(PctUnempl) + ) + + # generate NDI + ndi_data_pca <- ndi_data %>% + dplyr::select( + logMedHHInc, + PctNoIDRZ, + PctPubAsstZ, + logMedHomeVal, + PctWorkClassZ, + PctFemHeadKidsZ, + PctNotOwnerOccZ, + PctNoPhoneZ, + PctNComPlmbZ, + PctEducLTHSZ, + PctEducLTBchZ, + PctFamBelowPovZ, + PctUnemplZ + ) } else { - ndi_data <- ndi_data %>% tidyr::separate(NAME, into = c("county", "state"), sep = ",") + # If inputing pre-formatted data: + ## rename first and second features (columns) with name to match above + colnames(df)[1:2] <- c('GEOID', 'TotalPop') + ndi_data <- dplyr::as_tibble(df) + ## omit the first two features (columns) typically an ID (e.g., GEOID or FIPS) and TotalPop + ndi_data_pca <- ndi_data[,-c(1:2)] } + # Run a factor analysis using Promax (oblique) rotation and a minimum Eigenvalue of 1 + nfa <- eigen(stats::cor(ndi_data_pca, use = 'complete.obs')) + nfa <- sum(nfa$values > 1) # count of factors with a minimum Eigenvalue of 1 + fit <- psych::principal(ndi_data_pca, nfactors = nfa, rotate = 'none') + fit_rotate <- stats::promax(stats::loadings(fit), m = 3) - ndi_data <- ndi_data %>% - dplyr::mutate(MedHHInc = MedHHIncE, - PctRecvIDR = PctRecvIDR_numE / PctRecvIDR_denE * 100, - PctPubAsst = PctPubAsst_numE / PctPubAsst_denE * 100, - MedHomeVal = MedHomeValE, - PctMgmtBusScArti = PctMgmtBusScArti_numE / PctMgmtBusScArti_denE * 100, - PctFemHeadKids = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE * 100, - PctOwnerOcc = PctOwnerOccE, - PctNoPhone = PctNoPhoneE, - PctNComPlmb = PctNComPlmbE, - PctEducHSPlus = (PctEduc_num25upHSE + PctEduc_num25upSCE + PctEduc_num25upADE + - PctEduc_num25upBDE + PctEduc_num25upGDE) / PctEduc_den25upE * 100, - PctEducBchPlus = (PctEduc_num25upBDE + PctEduc_num25upGDE) / PctEduc_den25upE * 100, - PctFamBelowPov = PctFamBelowPovE, - PctUnempl = PctUnemplE, - TotalPop = TotalPopulationE) %>% - # Log transform median household income and median home value - # Reverse code percentages so that higher values represent more deprivation - # Round percentages to 1 decimal place - dplyr::mutate(logMedHHInc = log(MedHHInc), - logMedHomeVal = log(MedHomeVal), - PctNoIDR = 100 - PctRecvIDR, - PctWorkClass = 100 - PctMgmtBusScArti, - PctNotOwnerOcc = 100 - PctOwnerOcc, - PctEducLTHS = 100 - PctEducHSPlus, - PctEducLTBch = 100 - PctEducBchPlus) %>% - # Z-standardize the percentages - dplyr::mutate(PctNoIDRZ = scale(PctNoIDR), - PctPubAsstZ = scale(PctPubAsst), - PctWorkClassZ = scale(PctWorkClass), - PctFemHeadKidsZ = scale(PctFemHeadKids), - PctNotOwnerOccZ = scale(PctNotOwnerOcc), - PctNoPhoneZ = scale(PctNoPhone), - PctNComPlmbZ = scale(PctNComPlmb), - PctEducLTHSZ = scale(PctEducLTHS), - PctEducLTBchZ = scale(PctEducLTBch), - PctFamBelowPovZ = scale(PctFamBelowPov), - PctUnemplZ = scale(PctUnempl)) + # Calculate the factors using only variables with an absolute loading score > 0.4 for the first factor + ## If number of factors > 2, use structure matrix, else pattern matrix + if (nfa > 1) { + P_mat <- matrix(stats::loadings(fit_rotate), nrow = 13, ncol = nfa) + + # Structure matrix (S_mat) from under-the-hood of the psych::principal() function + rot.mat <- fit_rotate$rotmat # rotation matrix + ui <- solve(rot.mat) + Phi <- cov2cor(ui %*% t(ui)) # interfactor correlation + S_mat <- P_mat %*% Phi # pattern matrix multiplied by interfactor correlation + + } else { + P_mat <- matrix(fit_rotate, nrow = 13, ncol = 1) + Phi <- 1 + S_mat <- P_mat + } - # generate NDI - ndi_data_pca <- ndi_data %>% - dplyr::select(logMedHHInc, PctNoIDRZ, PctPubAsstZ, logMedHomeVal, PctWorkClassZ, - PctFemHeadKidsZ, PctNotOwnerOccZ, PctNoPhoneZ, PctNComPlmbZ, PctEducLTHSZ, - PctEducLTBchZ, PctFamBelowPovZ, PctUnemplZ) - } else { - # If inputing pre-formatted data: - colnames(df)[1:2] <- c("GEOID", "TotalPop") # rename first and second features (columns) with name to match above - ndi_data <- dplyr::as_tibble(df) - ndi_data_pca <- ndi_data[ , -c(1:2)] # omits the first two features (columns) typically an ID (e.g., GEOID or FIPS) and TotalPop - } - # Run a factor analysis using Promax (oblique) rotation and a minimum Eigenvalue of 1 - nfa <- eigen(stats::cor(ndi_data_pca, use = "complete.obs")) - nfa <- sum(nfa$values > 1) # count of factors with a minimum Eigenvalue of 1 - fit <- psych::principal(ndi_data_pca, - nfactors = nfa, - rotate = "none") - fit_rotate <- stats::promax(stats::loadings(fit), m = 3) - - # Calculate the factors using only variables with an absolute loading score > 0.4 for the first factor - ## If number of factors > 2, use structure matrix, else pattern matrix - if (nfa > 1) { - P_mat <- matrix(stats::loadings(fit_rotate), nrow = 13, ncol = nfa) + ## Variable correlation matrix (R_mat) + R_mat <- as.matrix(cor(ndi_data_pca[complete.cases(ndi_data_pca),])) - # Structure matrix (S_mat) from under-the-hood of the psych::principal() function - rot.mat <- fit_rotate$rotmat # rotation matrix - ui <- solve(rot.mat) - Phi <- cov2cor(ui %*% t(ui)) # interfactor correlation - S_mat <- P_mat %*% Phi # pattern matrix multiplied by interfactor correlation + ## standardized score coefficients or weight matrix (B_mat) + B_mat <- solve(R_mat, S_mat) - } else { - P_mat <- matrix(fit_rotate, nrow = 13, ncol = 1) - Phi <- 1 - S_mat <- P_mat - } - - ## Variable correlation matrix (R_mat) - R_mat <- as.matrix(cor(ndi_data_pca[complete.cases(ndi_data_pca), ])) - - ## standardized score coefficients or weight matrix (B_mat) - B_mat <- solve(R_mat, S_mat) - - # Additional PCA Information - fit_rotate$rotation <- "promax" - fit_rotate$Phi <- Phi - fit_rotate$Structure <- S_mat - - if (nfa > 1) { - fit_rotate$communality <- rowSums(P_mat^2) - } else { - fit_rotate$communality <- P_mat^2 - } - fit_rotate$uniqueness <- diag(R_mat) - fit_rotate$communality - - if (nfa > 1) { - vx <- colSums(P_mat^2) - } else { - vx <- sum(P_mat^2) - } - - vtotal <- sum(fit_rotate$communality + fit_rotate$uniqueness) - vx <- diag(Phi %*% t(P_mat) %*% P_mat) - names(vx) <- colnames(loadings) - varex <- rbind(`SS loadings` = vx) - varex <- rbind(varex, `Proportion Var` = vx/vtotal) - if (nfa > 1) { - varex <- rbind(varex, `Cumulative Var` = cumsum(vx/vtotal)) - varex <- rbind(varex, `Proportion Explained` = vx/sum(vx)) - varex <- rbind(varex, `Cumulative Proportion` = cumsum(vx/sum(vx))) - } - fit_rotate$Vaccounted <- varex - - if (imp == TRUE) { - ndi_data_scrs <- as.matrix(ndi_data_pca) - miss <- which(is.na(ndi_data_scrs), arr.ind = TRUE) - item.med <- apply(ndi_data_scrs, 2, stats::median, na.rm = TRUE) - ndi_data_scrs[miss] <- item.med[miss[, 2]] - } else { - ndi_data_scrs <- ndi_data_pca - } - - scrs <- as.matrix(scale(ndi_data_scrs[complete.cases(ndi_data_scrs), abs(S_mat[ , 1]) > 0.4 ])) %*% B_mat[abs(S_mat[ , 1]) > 0.4, 1] - - ndi_data_NA <- ndi_data[complete.cases(ndi_data_scrs), ] - ndi_data_NA$NDI <- c(scrs) - - ndi_data_NDI <- dplyr::left_join(ndi_data[ , c("GEOID", "TotalPop")], ndi_data_NA[ , c("GEOID", "NDI")], by = "GEOID") - - # Calculate Cronbach's alpha correlation coefficient among the factors and verify values are above 0.7. - if (nfa == 1) { - crnbch <- "Only one factor with minimum Eigenvalue of 1. Cannot calculate Cronbach's alpha." - } else { - cronbach <- suppressMessages(psych::alpha(ndi_data_pca[ , abs(S_mat[ , 1]) > 0.4 ], check.keys = TRUE, na.rm = TRUE, warnings = FALSE)) - crnbch <- cronbach$total$std.alpha - } - - # Warning for missingness of census characteristics - missingYN <- ndi_data_pca %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% - dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) - - if (quiet == FALSE) { + # Additional PCA Information + fit_rotate$rotation <- 'promax' + fit_rotate$Phi <- Phi + fit_rotate$Structure <- S_mat - # Warning for missing census data - if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + if (nfa > 1) { + fit_rotate$communality <- rowSums(P_mat ^ 2) + } else { + fit_rotate$communality <- P_mat ^ 2 } + fit_rotate$uniqueness <- diag(R_mat) - fit_rotate$communality - # Warning for Cronbach's alpha < 0.7 - if (cronbach$total$std.alpha < 0.7) { - message("Warning: Cronbach's alpha correlation coefficient among the factors is less than 0.7.") + if (nfa > 1) { + vx <- colSums(P_mat ^ 2) + } else { + vx <- sum(P_mat ^ 2) } - # Warning for proportion of variance explained by FA1 - if (fit_rotate$Vaccounted[2] < 0.50) { - message("Warning: The proportion of variance explained by PC1 is less than 0.50.") + vtotal <- sum(fit_rotate$communality + fit_rotate$uniqueness) + vx <- diag(Phi %*% t(P_mat) %*% P_mat) + names(vx) <- colnames(loadings) + varex <- rbind(`SS loadings` = vx) + varex <- rbind(varex, `Proportion Var` = vx / vtotal) + if (nfa > 1) { + varex <- rbind(varex, `Cumulative Var` = cumsum(vx / vtotal)) + varex <- rbind(varex, `Proportion Explained` = vx / sum(vx)) + varex <- rbind(varex, `Cumulative Proportion` = cumsum(vx / sum(vx))) } - } - - # NDI quintiles weighted by tract population - NDIQuint <- ndi_data_NDI %>% - dplyr::mutate(NDIQuint = cut(NDI*log(TotalPop), - breaks = stats::quantile(NDI*log(TotalPop), - probs = c(0, 0.2, 0.4, 0.6, 0.8, 1), - na.rm = TRUE), - labels = c("1-Least deprivation", "2-BelowAvg deprivation", - "3-Average deprivation","4-AboveAvg deprivation", - "5-Most deprivation"), - include.lowest = TRUE), - NDIQuint = factor(replace(as.character(NDIQuint), - is.na(NDIQuint) | is.infinite(NDIQuint), - "9-NDI not avail"), - c(levels(NDIQuint), "9-NDI not avail"))) %>% - dplyr::select(NDI, NDIQuint) - - if (is.null(df)) { - # Format output - if (round_output == TRUE) { - ndi <- cbind(ndi_data, NDIQuint) %>% - dplyr::mutate(PctRecvIDR = round(PctRecvIDR, digits = 1), - PctPubAsst = round(PctPubAsst, digits = 1), - PctMgmtBusScArti = round(PctMgmtBusScArti, digits = 1), - PctFemHeadKids = round(PctFemHeadKids, digits = 1), - PctOwnerOcc = round(PctOwnerOcc, digits = 1), - PctNoPhone = round(PctNoPhone, digits = 1), - PctNComPlmb = round(PctNComPlmb, digits = 1), - PctEducHSPlus = round(PctEducHSPlus, digits = 1), - PctEducBchPlus = round(PctEducBchPlus, digits = 1), - PctFamBelowPov = round(PctFamBelowPov, digits = 1), - PctUnempl = round(PctUnempl, digits = 1)) + fit_rotate$Vaccounted <- varex + + if (imp == TRUE) { + ndi_data_scrs <- as.matrix(ndi_data_pca) + miss <- which(is.na(ndi_data_scrs), arr.ind = TRUE) + item.med <- apply(ndi_data_scrs, 2, stats::median, na.rm = TRUE) + ndi_data_scrs[miss] <- item.med[miss[, 2]] } else { - ndi <- cbind(ndi_data, NDIQuint) + ndi_data_scrs <- ndi_data_pca } - if (geo == "tract") { - ndi <- ndi %>% - dplyr::select(GEOID, - state, - county, - tract, - NDI, NDIQuint, - MedHHInc, PctRecvIDR, PctPubAsst, MedHomeVal, PctMgmtBusScArti, - PctFemHeadKids,PctOwnerOcc, PctNoPhone, PctNComPlmb, PctEducHSPlus, - PctEducBchPlus, PctFamBelowPov, PctUnempl, TotalPop) + scrs <- as.matrix( + scale(ndi_data_scrs[complete.cases(ndi_data_scrs), abs(S_mat[, 1]) > 0.4]) + ) %*% B_mat[abs(S_mat[, 1]) > 0.4, 1] + + ndi_data_NA <- ndi_data[complete.cases(ndi_data_scrs),] + ndi_data_NA$NDI <- c(scrs) + + ndi_data_NDI <- ndi_data[, c('GEOID', 'TotalPop')] %>% + dplyr::left_join(ndi_data_NA[, c('GEOID', 'NDI')], by = dplyr::join_by(GEOID)) + + # Calculate Cronbach's alpha correlation coefficient among the factors and verify values are above 0.7. + if (nfa == 1) { + crnbch <- + "Only one factor with minimum Eigenvalue of 1. Cannot calculate Cronbach's alpha." } else { + cronbach <- suppressMessages(psych::alpha( + ndi_data_pca[, abs(S_mat[, 1]) > 0.4], + check.keys = TRUE, + na.rm = TRUE, + warnings = FALSE + )) + crnbch <- cronbach$total$std.alpha + } + + # Warning for missingness of census characteristics + missingYN <- ndi_data_pca %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% + dplyr::group_by(variable) %>% + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) + + if (quiet == FALSE) { + # Warning for missing census data + if (sum(missingYN$n_missing) > 0) { + message('Warning: Missing census data') + } + + # Warning for Cronbach's alpha < 0.7 + if (cronbach$total$std.alpha < 0.7) { + message( + "Warning: Cronbach's alpha correlation coefficient among the factors is less than 0.7." + ) + } + + # Warning for proportion of variance explained by FA1 + if (fit_rotate$Vaccounted[2] < 0.50) { + message('Warning: The proportion of variance explained by PC1 is less than 0.50.') + } + } + + # NDI quintiles weighted by tract population + NDIQuint <- ndi_data_NDI %>% + dplyr::mutate( + NDIQuint = cut( + NDI * log(TotalPop), + breaks = stats::quantile( + NDI * log(TotalPop), + probs = c(0, 0.2, 0.4, 0.6, 0.8, 1), + na.rm = TRUE + ), + labels = c( + '1-Least deprivation', + '2-BelowAvg deprivation', + '3-Average deprivation', + '4-AboveAvg deprivation', + '5-Most deprivation' + ), + include.lowest = TRUE + ), + NDIQuint = factor( + replace( + as.character(NDIQuint), + is.na(NDIQuint) | + is.infinite(NDIQuint), + '9-NDI not avail' + ), + c(levels(NDIQuint), '9-NDI not avail') + ) + ) %>% + dplyr::select(NDI, NDIQuint) + + if (is.null(df)) { + # Format output + if (round_output == TRUE) { + ndi <- cbind(ndi_data, NDIQuint) %>% + dplyr::mutate( + PctRecvIDR = round(PctRecvIDR, digits = 1), + PctPubAsst = round(PctPubAsst, digits = 1), + PctMgmtBusScArti = round(PctMgmtBusScArti, digits = 1), + PctFemHeadKids = round(PctFemHeadKids, digits = 1), + PctOwnerOcc = round(PctOwnerOcc, digits = 1), + PctNoPhone = round(PctNoPhone, digits = 1), + PctNComPlmb = round(PctNComPlmb, digits = 1), + PctEducHSPlus = round(PctEducHSPlus, digits = 1), + PctEducBchPlus = round(PctEducBchPlus, digits = 1), + PctFamBelowPov = round(PctFamBelowPov, digits = 1), + PctUnempl = round(PctUnempl, digits = 1) + ) + } else { + ndi <- cbind(ndi_data, NDIQuint) + } + + if (geo == 'tract') { + ndi <- ndi %>% + dplyr::select( + GEOID, + state, + county, + tract, + NDI, + NDIQuint, + MedHHInc, + PctRecvIDR, + PctPubAsst, + MedHomeVal, + PctMgmtBusScArti, + PctFemHeadKids, + PctOwnerOcc, + PctNoPhone, + PctNComPlmb, + PctEducHSPlus, + PctEducBchPlus, + PctFamBelowPov, + PctUnempl, + TotalPop + ) + } else { + ndi <- ndi %>% + dplyr::select( + GEOID, + state, + county, + NDI, + NDIQuint, + MedHHInc, + PctRecvIDR, + PctPubAsst, + MedHomeVal, + PctMgmtBusScArti, + PctFemHeadKids, + PctOwnerOcc, + PctNoPhone, + PctNComPlmb, + PctEducHSPlus, + PctEducBchPlus, + PctFamBelowPov, + PctUnempl, + TotalPop + ) + } + ndi <- ndi %>% - dplyr::select(GEOID, - state, - county, - NDI, NDIQuint, - MedHHInc, PctRecvIDR, PctPubAsst, MedHomeVal, PctMgmtBusScArti, - PctFemHeadKids,PctOwnerOcc, PctNoPhone, PctNComPlmb, PctEducHSPlus, - PctEducBchPlus, PctFamBelowPov, PctUnempl, TotalPop) + dplyr::mutate( + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) %>% + dplyr::arrange(GEOID) %>% + dplyr::as_tibble() + + } else { + ndi <- cbind(df[, 1], NDIQuint, df[, 2:ncol(df)]) + ndi <- dplyr::as_tibble(ndi[order(ndi[, 1]),]) } - ndi <- ndi %>% - dplyr::mutate(state = stringr::str_trim(state), - county = stringr::str_trim(county)) %>% - dplyr::arrange(GEOID) %>% - dplyr::as_tibble() + out <- list( + ndi = ndi, + pca = fit_rotate, + missing = missingYN, + cronbach = crnbch + ) - } else { - ndi <- cbind(df[ , 1], NDIQuint, df[ , 2:ncol(df)]) - ndi <- dplyr::as_tibble(ndi[order(ndi[ , 1]), ]) + return(out) } - - out <- list(ndi = ndi, - pca = fit_rotate, - missing = missingYN, - cronbach = crnbch) - - return(out) -} diff --git a/R/sudano.R b/R/sudano.R index cb1afca..5155ccc 100644 --- a/R/sudano.R +++ b/R/sudano.R @@ -1,55 +1,55 @@ -#' Location Quotient (LQ) based on Merton (1938) and Sudano _et al._ (2013) -#' +#' Location Quotient (LQ) based on Merton (1938) and Sudano et al. (2013) +#' #' Compute the aspatial Location Quotient (Sudano) of a selected racial/ethnic subgroup(s) and U.S. geographies. #' -#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}. -#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}. +#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}. +#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param subgroup Character string specifying the racial/ethnic subgroup(s). See Details for available choices. #' @param omit_NAs Logical. If FALSE, will compute index for a larger geographical unit only if all of its smaller geographical units have values. The default is TRUE. #' @param quiet Logical. If TRUE, will display messages about potential missing census information. The default is FALSE. #' @param ... Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics #' -#' @details This function will compute the aspatial Location Quotient (LQ) of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Merton (1939) \doi{10.2307/2084686} and Sudano _et al._ (2013) \doi{10.1016/j.healthplace.2012.09.015}. This function provides the computation of LQ for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). -#' +#' @details This function will compute the aspatial Location Quotient (LQ) of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Merton (1939) \doi{10.2307/2084686} and Sudano et al. (2013) \doi{10.1016/j.healthplace.2012.09.015}. This function provides the computation of LQ for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). +#' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: #' \itemize{ -#' \item **B03002_002**: not Hispanic or Latino \code{"NHoL"} -#' \item **B03002_003**: not Hispanic or Latino, white alone \code{"NHoLW"} -#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{"NHoLA"} -#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -#' \item **B03002_012**: Hispanic or Latino \code{"HoL"} -#' \item **B03002_013**: Hispanic or Latino, white alone \code{"HoLW"} -#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{"HoLB"} -#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{"HoLA"} -#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +#' \item **B03002_002**: not Hispanic or Latino \code{'NHoL'} +#' \item **B03002_003**: not Hispanic or Latino, white alone \code{'NHoLW'} +#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{'NHoLA'} +#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +#' \item **B03002_012**: Hispanic or Latino \code{'HoL'} +#' \item **B03002_013**: Hispanic or Latino, white alone \code{'HoLW'} +#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{'HoLB'} +#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{'HoLA'} +#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} #' } -#' +#' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -#' +#' #' LQ is some measure of relative racial homogeneity of each smaller geography within a larger geography. LQ can range in value from 0 to infinity because it is ratio of two proportions in which the numerator is the proportion of subgroup population in a smaller geography and the denominator is the proportion of subgroup population in its larger geography. For example, a smaller geography with an LQ of 5 means that the proportion of the subgroup population living in the smaller geography is five times the proportion of the subgroup population in its larger geography. -#' -#' Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the LQ value returned is NA. -#' +#' +#' Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the LQ value returned is NA. +#' #' @return An object of class 'list'. This is a named list with the following components: -#' +#' #' \describe{ #' \item{\code{lq}}{An object of class 'tbl' for the GEOID, name, and LQ at specified smaller census geographies.} #' \item{\code{lq_data}}{An object of class 'tbl' for the raw census values at specified smaller census geographies.} #' \item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute LQ.} #' } -#' +#' #' @import dplyr #' @importFrom sf st_drop_geometry #' @importFrom stats complete.cases @@ -57,111 +57,162 @@ #' @importFrom tidyr pivot_longer separate #' @importFrom utils stack #' @export -#' +#' #' @seealso \code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). #' #' @examples #' \dontrun{ #' # Wrapped in \dontrun{} because these examples require a Census API key. -#' +#' #' # Isolation of non-Hispanic Black populations #' ## of census tracts within Georgia, U.S.A., counties (2020) -#' sudano(geo_large = "state", geo_small = "county", state = "GA", -#' year = 2020, subgroup = "NHoLB") -#' +#' sudano( +#' geo_large = 'state', +#' geo_small = 'county', +#' state = 'GA', +#' year = 2020, +#' subgroup = 'NHoLB' +#' ) +#' #' } -#' -sudano <- function(geo_large = "county", geo_small = "tract", year = 2020, subgroup, omit_NAs = TRUE, quiet = FALSE, ...) { +#' +sudano <- function(geo_large = 'county', + geo_small = 'tract', + year = 2020, + subgroup, + omit_NAs = TRUE, + quiet = FALSE, + ...) { # Check arguments - match.arg(geo_large, choices = c("state", "county", "tract")) - match.arg(geo_small, choices = c("county", "tract", "block group")) + match.arg(geo_large, choices = c('state', 'county', 'tract')) + match.arg(geo_small, choices = c('county', 'tract', 'block group')) stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - match.arg(subgroup, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) + match.arg( + subgroup, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) # Select census variables - vars <- c(TotalPop = "B03002_001", - NHoL = "B03002_002", - NHoLW = "B03002_003", - NHoLB = "B03002_004", - NHoLAIAN = "B03002_005", - NHoLA = "B03002_006", - NHoLNHOPI = "B03002_007", - NHoLSOR = "B03002_008", - NHoLTOMR = "B03002_009", - NHoLTRiSOR = "B03002_010", - NHoLTReSOR = "B03002_011", - HoL = "B03002_012", - HoLW = "B03002_013", - HoLB = "B03002_014", - HoLAIAN = "B03002_015", - HoLA = "B03002_016", - HoLNHOPI = "B03002_017", - HoLSOR = "B03002_018", - HoLTOMR = "B03002_019", - HoLTRiSOR = "B03002_020", - HoLTReSOR = "B03002_021") - - selected_vars <- vars[c("TotalPop", subgroup)] + vars <- c( + TotalPop = 'B03002_001', + NHoL = 'B03002_002', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + NHoLAIAN = 'B03002_005', + NHoLA = 'B03002_006', + NHoLNHOPI = 'B03002_007', + NHoLSOR = 'B03002_008', + NHoLTOMR = 'B03002_009', + NHoLTRiSOR = 'B03002_010', + NHoLTReSOR = 'B03002_011', + HoL = 'B03002_012', + HoLW = 'B03002_013', + HoLB = 'B03002_014', + HoLAIAN = 'B03002_015', + HoLA = 'B03002_016', + HoLNHOPI = 'B03002_017', + HoLSOR = 'B03002_018', + HoLTOMR = 'B03002_019', + HoLTRiSOR = 'B03002_020', + HoLTReSOR = 'B03002_021' + ) + + selected_vars <- vars[c('TotalPop', subgroup)] out_names <- names(selected_vars) # save for output - in_subgroup <- paste(subgroup, "E", sep = "") + in_subgroup <- paste(subgroup, 'E', sep = '') # Acquire LQ variables and sf geometries - lq_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo_small, - year = year, - output = "wide", - variables = selected_vars, - geometry = TRUE, - keep_geo_vars = TRUE, ...))) + lq_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo_small, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + keep_geo_vars = TRUE, + ... + ) + )) + # Format output - if (geo_small == "county") { - lq_data <- sf::st_drop_geometry(lq_data) %>% - tidyr::separate(NAME.y, into = c("county", "state"), sep = ",") + if (geo_small == 'county') { + lq_data <- lq_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('county', 'state'), sep = ',') + } + if (geo_small == 'tract') { + lq_data <- lq_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) + } + if (geo_small == 'block group') { + lq_data <- lq_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('block.group', 'tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate( + tract = gsub('[^0-9\\.]', '', tract), + block.group = gsub('[^0-9\\.]', '', block.group) + ) } - if (geo_small == "tract") { - lq_data <- sf::st_drop_geometry(lq_data) %>% - tidyr::separate(NAME.y, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract)) - } - if (geo_small == "block group") { - lq_data <- sf::st_drop_geometry(lq_data) %>% - tidyr::separate(NAME.y, into = c("block.group", "tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract), - block.group = gsub("[^0-9\\.]", "", block.group)) - } # Grouping IDs for R computation - if (geo_large == "tract") { + if (geo_large == 'tract') { lq_data <- lq_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) } - if (geo_large == "county") { + if (geo_large == 'county') { lq_data <- lq_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) } - if (geo_large == "state") { + if (geo_large == 'state') { lq_data <- lq_data %>% - dplyr::mutate(oid = .$STATEFP, - state = stringr::str_trim(state)) + dplyr::mutate( + oid = .$STATEFP, + state = stringr::str_trim(state) + ) } # Count of racial/ethnic subgroup populations ## Count of racial/ethnic comparison subgroup population if (length(in_subgroup) == 1) { lq_data <- lq_data %>% - dplyr::mutate(subgroup = .[ , in_subgroup]) + dplyr::mutate(subgroup = .[, in_subgroup]) } else { lq_data <- lq_data %>% - dplyr::mutate(subgroup = rowSums(.[ , in_subgroup])) + dplyr::mutate(subgroup = rowSums(.[, in_subgroup])) } # Compute LQ @@ -174,60 +225,63 @@ sudano <- function(geo_large = "county", geo_small = "tract", year = 2020, subgr LQtmp <- lq_data %>% split(., f = list(lq_data$oid)) %>% lapply(., FUN = lq_fun, omit_NAs = omit_NAs) %>% - do.call("rbind", .) + do.call('rbind', .) # Warning for missingness of census characteristics - missingYN <- lq_data[ , c("TotalPopE", in_subgroup)] + missingYN <- lq_data[, c('TotalPopE', in_subgroup)] names(missingYN) <- out_names missingYN <- missingYN %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) if (quiet == FALSE) { # Warning for missing census data if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + message('Warning: Missing census data') } } # Format output - lq <- merge(lq_data, LQtmp) + lq <- lq_data %>% + dplyr::left_join(LQtmp, by = dplyr::join_by(GEOID)) - if (geo_small == "state") { + if (geo_small == 'state') { lq <- lq %>% dplyr::select(GEOID, state, LQ) } - if (geo_small == "county") { + if (geo_small == 'county') { lq <- lq %>% dplyr::select(GEOID, state, county, LQ) } - if (geo_small == "tract") { + if (geo_small == 'tract') { lq <- lq %>% dplyr::select(GEOID, state, county, tract, LQ) } - if (geo_small == "block group") { + if (geo_small == 'block group') { lq <- lq %>% dplyr::select(GEOID, state, county, tract, block.group, LQ) } lq <- lq %>% unique(.) %>% - .[.$GEOID != "NANA", ] %>% + .[.$GEOID != 'NANA',] %>% dplyr::arrange(GEOID) %>% dplyr::as_tibble() lq_data <- lq_data %>% dplyr::arrange(GEOID) %>% - dplyr::as_tibble() + dplyr::as_tibble() - out <- list(lq = lq, - lq_data = lq_data, - missing = missingYN) + out <- list(lq = lq, lq_data = lq_data, missing = missingYN) return(out) } diff --git a/R/white.R b/R/white.R index b5a3505..04f4208 100644 --- a/R/white.R +++ b/R/white.R @@ -2,8 +2,8 @@ #' #' Compute the aspatial Correlation Ratio (White) of a selected racial/ethnic subgroup(s) and U.S. geographies. #' -#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}. -#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}. +#' @param geo_large Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}. +#' @param geo_small Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}. #' @param year Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available. #' @param subgroup Character string specifying the racial/ethnic subgroup(s). See Details for available choices. #' @param omit_NAs Logical. If FALSE, will compute index for a larger geographical unit only if all of its smaller geographical units have values. The default is TRUE. @@ -14,33 +14,33 @@ #' #' The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: #' \itemize{ -#' \item **B03002_002**: not Hispanic or Latino \code{"NHoL"} -#' \item **B03002_003**: not Hispanic or Latino, white alone \code{"NHoLW"} -#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{"NHoLA"} -#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -#' \item **B03002_012**: Hispanic or Latino \code{"HoL"} -#' \item **B03002_013**: Hispanic or Latino, white alone \code{"HoLW"} -#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{"HoLB"} -#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{"HoLA"} -#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +#' \item **B03002_002**: not Hispanic or Latino \code{'NHoL'} +#' \item **B03002_003**: not Hispanic or Latino, white alone \code{'NHoLW'} +#' \item **B03002_004**: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +#' \item **B03002_005**: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +#' \item **B03002_006**: not Hispanic or Latino, Asian alone \code{'NHoLA'} +#' \item **B03002_007**: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +#' \item **B03002_008**: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +#' \item **B03002_009**: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +#' \item **B03002_010**: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +#' \item **B03002_011**: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +#' \item **B03002_012**: Hispanic or Latino \code{'HoL'} +#' \item **B03002_013**: Hispanic or Latino, white alone \code{'HoLW'} +#' \item **B03002_014**: Hispanic or Latino, Black or African American alone \code{'HoLB'} +#' \item **B03002_015**: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +#' \item **B03002_016**: Hispanic or Latino, Asian alone \code{'HoLA'} +#' \item **B03002_017**: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +#' \item **B03002_018**: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +#' \item **B03002_019**: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +#' \item **B03002_020**: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +#' \item **B03002_021**: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} #' } #' #' Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. #' -#' V removes the asymmetry from the Isolation Index (Bell) by controlling for the effect of population composition. The Isolation Index (Bell) is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation). V can range in value from 0 to 1. +#' V removes the asymmetry from the Isolation Index (Bell) by controlling for the effect of population composition. The Isolation Index (Bell) is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation). V can range in value from -Inf to Inf. #' -#' Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the V value returned is NA. +#' Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the V value returned is NA. #' #' @return An object of class 'list'. This is a named list with the following components: #' @@ -66,102 +66,149 @@ #' #' # Isolation of non-Hispanic Black populations #' ## of census tracts within Georgia, U.S.A., counties (2020) -#' white(geo_large = "county", geo_small = "tract", state = "GA", -#' year = 2020, subgroup = "NHoLB") +#' white( +#' geo_large = 'county', +#' geo_small = 'tract', +#' state = 'GA', +#' year = 2020, +#' subgroup = 'NHoLB' +#' ) #' #' } #' -white <- function(geo_large = "county", geo_small = "tract", year = 2020, subgroup, omit_NAs = TRUE, quiet = FALSE, ...) { +white <- function(geo_large = 'county', + geo_small = 'tract', + year = 2020, + subgroup, + omit_NAs = TRUE, + quiet = FALSE, + ...) { # Check arguments - match.arg(geo_large, choices = c("state", "county", "tract")) - match.arg(geo_small, choices = c("county", "tract", "block group")) + match.arg(geo_large, choices = c('state', 'county', 'tract')) + match.arg(geo_small, choices = c('county', 'tract', 'block group')) stopifnot(is.numeric(year), year >= 2009) # all variables available 2009 onward - match.arg(subgroup, several.ok = TRUE, - choices = c("NHoL", "NHoLW", "NHoLB", "NHoLAIAN", "NHoLA", "NHoLNHOPI", - "NHoLSOR", "NHoLTOMR", "NHoLTRiSOR", "NHoLTReSOR", - "HoL", "HoLW", "HoLB", "HoLAIAN", "HoLA", "HoLNHOPI", - "HoLSOR", "HoLTOMR", "HoLTRiSOR", "HoLTReSOR")) + match.arg( + subgroup, + several.ok = TRUE, + choices = c( + 'NHoL', + 'NHoLW', + 'NHoLB', + 'NHoLAIAN', + 'NHoLA', + 'NHoLNHOPI', + 'NHoLSOR', + 'NHoLTOMR', + 'NHoLTRiSOR', + 'NHoLTReSOR', + 'HoL', + 'HoLW', + 'HoLB', + 'HoLAIAN', + 'HoLA', + 'HoLNHOPI', + 'HoLSOR', + 'HoLTOMR', + 'HoLTRiSOR', + 'HoLTReSOR' + ) + ) # Select census variables - vars <- c(TotalPop = "B03002_001", - NHoL = "B03002_002", - NHoLW = "B03002_003", - NHoLB = "B03002_004", - NHoLAIAN = "B03002_005", - NHoLA = "B03002_006", - NHoLNHOPI = "B03002_007", - NHoLSOR = "B03002_008", - NHoLTOMR = "B03002_009", - NHoLTRiSOR = "B03002_010", - NHoLTReSOR = "B03002_011", - HoL = "B03002_012", - HoLW = "B03002_013", - HoLB = "B03002_014", - HoLAIAN = "B03002_015", - HoLA = "B03002_016", - HoLNHOPI = "B03002_017", - HoLSOR = "B03002_018", - HoLTOMR = "B03002_019", - HoLTRiSOR = "B03002_020", - HoLTReSOR = "B03002_021") - - selected_vars <- vars[c("TotalPop", subgroup)] + vars <- c( + TotalPop = 'B03002_001', + NHoL = 'B03002_002', + NHoLW = 'B03002_003', + NHoLB = 'B03002_004', + NHoLAIAN = 'B03002_005', + NHoLA = 'B03002_006', + NHoLNHOPI = 'B03002_007', + NHoLSOR = 'B03002_008', + NHoLTOMR = 'B03002_009', + NHoLTRiSOR = 'B03002_010', + NHoLTReSOR = 'B03002_011', + HoL = 'B03002_012', + HoLW = 'B03002_013', + HoLB = 'B03002_014', + HoLAIAN = 'B03002_015', + HoLA = 'B03002_016', + HoLNHOPI = 'B03002_017', + HoLSOR = 'B03002_018', + HoLTOMR = 'B03002_019', + HoLTRiSOR = 'B03002_020', + HoLTReSOR = 'B03002_021' + ) + + selected_vars <- vars[c('TotalPop', subgroup)] out_names <- names(selected_vars) # save for output - in_subgroup <- paste(subgroup, "E", sep = "") + in_subgroup <- paste(subgroup, 'E', sep = '') # Acquire V variables and sf geometries - v_data <- suppressMessages(suppressWarnings(tidycensus::get_acs(geography = geo_small, - year = year, - output = "wide", - variables = selected_vars, - geometry = TRUE, - keep_geo_vars = TRUE, ...))) + v_data <- suppressMessages(suppressWarnings( + tidycensus::get_acs( + geography = geo_small, + year = year, + output = 'wide', + variables = selected_vars, + geometry = TRUE, + keep_geo_vars = TRUE, + ... + ) + )) + # Format output - if (geo_small == "county") { - v_data <- sf::st_drop_geometry(v_data) %>% - tidyr::separate(NAME.y, into = c("county", "state"), sep = ",") + if (geo_small == 'county') { + v_data <- v_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('county', 'state'), sep = ',') } - if (geo_small == "tract") { - v_data <- sf::st_drop_geometry(v_data) %>% - tidyr::separate(NAME.y, into = c("tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract)) + if (geo_small == 'tract') { + v_data <- v_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate(tract = gsub('[^0-9\\.]', '', tract)) } - if (geo_small == "block group") { - v_data <- sf::st_drop_geometry(v_data) %>% - tidyr::separate(NAME.y, into = c("block.group", "tract", "county", "state"), sep = ",") %>% - dplyr::mutate(tract = gsub("[^0-9\\.]", "", tract), - block.group = gsub("[^0-9\\.]", "", block.group)) + if (geo_small == 'block group') { + v_data <- v_data %>% + sf::st_drop_geometry() %>% + tidyr::separate(NAME.y, into = c('block.group', 'tract', 'county', 'state'), sep = ',') %>% + dplyr::mutate( + tract = gsub('[^0-9\\.]', '', tract), block.group = gsub('[^0-9\\.]', '', block.group) + ) } # Grouping IDs for R computation - if (geo_large == "tract") { + if (geo_large == 'tract') { v_data <- v_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, .$TRACTCE, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) } - if (geo_large == "county") { + if (geo_large == 'county') { v_data <- v_data %>% - dplyr::mutate(oid = paste(.$STATEFP, .$COUNTYFP, sep = ""), - state = stringr::str_trim(state), - county = stringr::str_trim(county)) + dplyr::mutate( + oid = paste(.$STATEFP, .$COUNTYFP, sep = ''), + state = stringr::str_trim(state), + county = stringr::str_trim(county) + ) } - if (geo_large == "state") { + if (geo_large == 'state') { v_data <- v_data %>% - dplyr::mutate(oid = .$STATEFP, - state = stringr::str_trim(state)) + dplyr::mutate(oid = .$STATEFP, state = stringr::str_trim(state)) } # Count of racial/ethnic subgroup populations ## Count of racial/ethnic comparison subgroup population if (length(in_subgroup) == 1) { v_data <- v_data %>% - dplyr::mutate(subgroup = .[ , in_subgroup]) + dplyr::mutate(subgroup = .[, in_subgroup]) } else { v_data <- v_data %>% - dplyr::mutate(subgroup = rowSums(.[ , in_subgroup])) + dplyr::mutate(subgroup = rowSums(.[, in_subgroup])) } # Compute V or \mathit{Eta}^{2} @@ -176,53 +223,59 @@ white <- function(geo_large = "county", geo_small = "tract", year = 2020, subgro split(., f = list(v_data$oid)) %>% lapply(., FUN = v_fun, omit_NAs = omit_NAs) %>% utils::stack(.) %>% - dplyr::mutate(V = values, - oid = ind) %>% + dplyr::mutate(V = values, oid = ind) %>% dplyr::select(V, oid) # Warning for missingness of census characteristics - missingYN <- v_data[ , c("TotalPopE", in_subgroup)] + missingYN <- v_data[, c('TotalPopE', in_subgroup)] names(missingYN) <- out_names missingYN <- missingYN %>% - tidyr::pivot_longer(cols = dplyr::everything(), - names_to = "variable", - values_to = "val") %>% + tidyr::pivot_longer( + cols = dplyr::everything(), + names_to = 'variable', + values_to = 'val' + ) %>% dplyr::group_by(variable) %>% - dplyr::summarise(total = dplyr::n(), - n_missing = sum(is.na(val)), - percent_missing = paste0(round(mean(is.na(val)) * 100, 2), " %")) + dplyr::summarise( + total = dplyr::n(), + n_missing = sum(is.na(val)), + percent_missing = paste0(round(mean(is.na(val)) * 100, 2), ' %') + ) if (quiet == FALSE) { # Warning for missing census data if (sum(missingYN$n_missing) > 0) { - message("Warning: Missing census data") + message('Warning: Missing census data') } } # Format output - if (geo_large == "state") { - v <- merge(v_data, Vtmp) %>% + if (geo_large == 'state') { + v <- v_data %>% + dplyr::left_join(Vtmp, by = dplyr::join_by(oid)) %>% dplyr::select(oid, state, V) %>% unique(.) %>% dplyr::mutate(GEOID = oid) %>% dplyr::select(GEOID, state, V) %>% - .[.$GEOID != "NANA", ] + .[.$GEOID != 'NANA',] } - if (geo_large == "county") { - v <- merge(v_data, Vtmp) %>% + if (geo_large == 'county') { + v <- v_data %>% + dplyr::left_join(Vtmp, by = dplyr::join_by(oid)) %>% dplyr::select(oid, state, county, V) %>% unique(.) %>% dplyr::mutate(GEOID = oid) %>% dplyr::select(GEOID, state, county, V) %>% - .[.$GEOID != "NANA", ] + .[.$GEOID != 'NANA',] } - if (geo_large == "tract") { - v <- merge(v_data, Vtmp) %>% + if (geo_large == 'tract') { + v <- v_data %>% + dplyr::left_join(Vtmp, by = dplyr::join_by(oid)) %>% dplyr::select(oid, state, county, tract, V) %>% unique(.) %>% dplyr::mutate(GEOID = oid) %>% dplyr::select(GEOID, state, county, tract, V) %>% - .[.$GEOID != "NANA", ] + .[.$GEOID != 'NANA',] } v <- v %>% @@ -231,11 +284,9 @@ white <- function(geo_large = "county", geo_small = "tract", year = 2020, subgro v_data <- v_data %>% dplyr::arrange(GEOID) %>% - dplyr::as_tibble() + dplyr::as_tibble() - out <- list(v = v, - v_data = v_data, - missing = missingYN) + out <- list(v = v, v_data = v_data, missing = missingYN) return(out) } diff --git a/R/zzz.R b/R/zzz.R index e8d7e4a..1579f24 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,3 +1,3 @@ .onAttach <- function(...) { - packageStartupMessage(paste("\nWelcome to {ndi} version ", utils::packageDescription("ndi")$Version, "\n> help(\"ndi\") # for documentation\n> citation(\"ndi\") # for how to cite\n", sep = ""), appendLF = TRUE) + packageStartupMessage(paste('\nWelcome to {ndi} version ', utils::packageDescription('ndi')$Version, '\n> help(\'ndi\') # for documentation\n> citation(\'ndi\') # for how to cite\n', sep = ''), appendLF = TRUE) } diff --git a/README.md b/README.md index d220950..93f3f51 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -ndi: Neighborhood Deprivation Indices +ndi: Neighborhood Deprivation Indices =================================================== @@ -12,78 +12,93 @@ ndi: Neighborhood Deprivation Indices -**Date repository last updated**: January 23, 2024 +**Date repository last updated**: July 06, 2024 ### Overview -The `ndi` package is a suite of `R` functions to compute various metrics of socio-economic deprivation and disparity in the United States. Some metrics are considered "spatial" because they consider the values of neighboring (i.e., adjacent) census geographies in their computation, while other metrics are "aspatial" because they only consider the value within each census geography. Two types of aspatial NDI are available: (1) based on [Messer _et al._ (2006)](https://doi.org/10.1007/s11524-006-9094-x) and (2) based on [Andrews _et al._ (2020)](https://doi.org/10.1080/17445647.2020.1750066) and [Slotman _et al._ (2022)](https://doi.org/10.1016/j.dib.2022.108002) who use variables chosen by [Roux and Mair (2010)](https://doi.org/10.1111/j.1749-6632.2009.05333.x). Both are a decomposition of various demographic characteristics from the U.S. Census Bureau American Community Survey 5-year estimates (ACS-5; 2006-2010 onward) pulled by the [tidycensus](https://CRAN.R-project.org/package=tidycensus) package. Using data from the ACS-5 (2005-2009 onward), the `ndi` package can also compute the (1) spatial Racial Isolation Index (RI) based on [Anthopolos _et al._ (2011)](https://doi.org/10.1016/j.sste.2011.06.002), (2) spatial Educational Isolation Index (EI) based on [Bravo _et al._ (2021)](https://doi.org/10.3390/ijerph18179384), (3) aspatial Index of Concentration at the Extremes (ICE) based on [Feldman _et al._ (2015)](https://doi.org/10.1136/jech-2015-205728) and [Krieger _et al._ (2016)](https://doi.org/10.2105/AJPH.2015.302955), (4) aspatial racial/ethnic Dissimilarity Index (DI) based on [Duncan & Duncan (1955)](https://doi.org/10.2307/2088328), (5) aspatial income or racial/ethnic Atkinson Index (DI) based on [Atkinson (1970)](https://doi.org/10.1016/0022-0531(70)90039-6), (6) aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and [Bell (1954)](https://doi.org/10.2307/2574118), (7) aspatial racial/ethnic Correlation Ratio based on [Bell (1954)](https://doi.org/10.2307/2574118) and [White (1986)](https://doi.org/10.2307/3644339), (8) aspatial racial/ethnic Location Quotient based on [Merton (1939)](https://doi.org/10.2307/2084686) and [Sudano _et al._ (2013)](https://doi.org/10.1016/j.healthplace.2012.09.015), and (9) aspatial racial/ethnic Local Exposure and Isolation metric based on [Bemanian & Beyer (2017)](https://doi.org/10.1158/1055-9965.EPI-16-0926). Also using data from the ACS-5 (2005-2009 onward), the `ndi` package can retrieve the aspatial Gini Index based on [Gini (1921)](https://doi.org/10.2307/2223319). +The `ndi` package is a suite of `R` functions to compute various metrics of socio-economic deprivation and disparity in the United States. Some metrics are considered 'spatial' because they consider the values of neighboring (i.e., adjacent) census geographies in their computation, while other metrics are 'aspatial' because they only consider the value within each census geography. Two types of aspatial NDI are available: (1) based on [Messer et al. (2006)](https://doi.org/10.1007/s11524-006-9094-x) and (2) based on [Andrews et al. (2020)](https://doi.org/10.1080/17445647.2020.1750066) and [Slotman et al. (2022)](https://doi.org/10.1016/j.dib.2022.108002) who use variables chosen by [Roux and Mair (2010)](https://doi.org/10.1111/j.1749-6632.2009.05333.x). Both are a decomposition of various demographic characteristics from the U.S. Census Bureau American Community Survey 5-year estimates (ACS-5; 2006-2010 onward) pulled by the [tidycensus](https://CRAN.R-project.org/package=tidycensus) package. Using data from the ACS-5 (2005-2009 onward), the `ndi` package can also compute the (1) spatial Racial Isolation Index (RI) based on [Anthopolos et al. (2011)](https://doi.org/10.1016/j.sste.2011.06.002), (2) spatial Educational Isolation Index (EI) based on [Bravo et al. (2021)](https://doi.org/10.3390/ijerph18179384), (3) aspatial Index of Concentration at the Extremes (ICE) based on [Feldman et al. (2015)](https://doi.org/10.1136/jech-2015-205728) and [Krieger et al. (2016)](https://doi.org/10.2105/AJPH.2015.302955), (4) aspatial racial/ethnic Dissimilarity Index (DI) based on [Duncan & Duncan (1955)](https://doi.org/10.2307/2088328), (5) aspatial income or racial/ethnic Atkinson Index (DI) based on [Atkinson (1970)](https://doi.org/10.1016/0022-0531(70)90039-6), (6) aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and [Bell (1954)](https://doi.org/10.2307/2574118), (7) aspatial racial/ethnic Correlation Ratio based on [Bell (1954)](https://doi.org/10.2307/2574118) and [White (1986)](https://doi.org/10.2307/3644339), (8) aspatial racial/ethnic Location Quotient based on [Merton (1939)](https://doi.org/10.2307/2084686) and [Sudano et al. (2013)](https://doi.org/10.1016/j.healthplace.2012.09.015), (9) aspatial racial/ethnic Local Exposure and Isolation metric based on [Bemanian & Beyer (2017)](https://doi.org/10.1158/1055-9965.EPI-16-0926), and (10) aspatial racial/ethnic Delta based on [Hoover (1941)](https://doi.org/10.1017/S0022050700052980) and Duncan et al. (1961; LC:60007089). Also using data from the ACS-5 (2005-2009 onward), the `ndi` package can retrieve the aspatial Gini Index based on [Gini (1921)](https://doi.org/10.2307/2223319). ### Installation To install the release version from CRAN: - install.packages("ndi") + install.packages('ndi') To install the development version from GitHub: - devtools::install_github("idblr/ndi") + devtools::install_github('idblr/ndi') ### Available functions --++ - + + - + + - + + - + + - + + - + + - + - + + + + + + - + + - + + - + + - + + - + -
Function Description
anthopolosCompute the spatial Racial Isolation Index (RI) based on Anthopolos _et al._ (2011)Compute the spatial Racial Isolation Index (RI) based on Anthopolos et al. (2011)
atkinsonCompute the aspatial Atkinson Index (AI) based on Atkinson (1970)Compute the aspatial Atkinson Index (AI) based on Atkinson (1970)
bellCompute the aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954)Compute the aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954)
bemanian_beyerCompute the aspatial racial/ethnic Local Exposure and Isolation (LEx/Is) metric based on Bemanian & Beyer (2017)Compute the aspatial racial/ethnic Local Exposure and Isolation (LEx/Is) metric based on Bemanian & Beyer (2017)
bravoCompute the spatial Educational Isolation Index (EI) based on Bravo _et al._ (2021)Compute the spatial Educational Isolation Index (EI) based on Bravo et al. (2021)
duncanCompute the aspatial racial/ethnic Dissimilarity Index (DI) based on Duncan & Duncan (1955)Compute the aspatial racial/ethnic Dissimilarity Index (DI) based on Duncan & Duncan (1955)
giniRetrieve the aspatial Gini Index based on Gini (1921)Retrieve the aspatial Gini Index based on Gini (1921)
hooverCompute the aspatial racial/ethnic Delta (DEL) based on Hoover (1941) and Duncan et al. (1961; LC:60007089).
kriegerCompute the aspatial Index of Concentration at the Extremes (ICE) based on Feldman _et al._ (2015) and Krieger _et al._ (2016)Compute the aspatial Index of Concentration at the Extremes (ICE) based on Feldman et al. (2015) and Krieger et al. (2016)
messerCompute the aspatial Neighborhood Deprivation Index (NDI) based on Messer _et al._ (2006)Compute the aspatial Neighborhood Deprivation Index (NDI) based on Messer et al. (2006)
powell_wileyCompute the aspatial Neighborhood Deprivation Index (NDI) based on Andrews _et al._ (2020) and Slotman _et al._ (2022) with variables chosen by Roux and Mair (2010)Compute the aspatial Neighborhood Deprivation Index (NDI) based on Andrews et al. (2020) and Slotman et al. (2022) with variables chosen by Roux and Mair (2010)
sudanoCompute the aspatial racial/ethnic Location Quotient (LQ) based on Merton (1938) and Sudano _et al._ (2013)Compute the aspatial racial/ethnic Location Quotient (LQ) based on Merton (1938) and Sudano et al. (2013)
whiteCompute the aspatial racial/ethnic Correlation Ratio (V) based on Bell (1954) and White (1986)Compute the aspatial racial/ethnic Correlation Ratio (V) based on Bell (1954) and White (1986)
+
The repository also includes the code to create the project hexagon sticker. -

+

### Available sample dataset @@ -91,44 +106,49 @@ The repository also includes the code to create the project hexagon sticker. --++ - + + - + -
Data Description
DCtracts2020A sample data set containing information about U.S. Census American Community Survey 5-year estimate data for the District of Columbia census tracts (2020). The data are obtained from the tidycensus package and formatted for the messer() and powell_wiley() functions input.A sample data set containing information about U.S. Census American Community Survey 5-year estimate data for the District of Columbia census tracts (2020). The data are obtained from the tidycensus package and formatted for the messer() and powell_wiley() functions input.
+
### Author -* **Ian D. Buller** - *Social & Scientific Systems, Inc., a division of DLH Corporation, Silver Spring, Maryland (current)* - *Occupational and Environmental Epidemiology Branch, Division of Cancer Epidemiology and Genetics, National Cancer Institute, National Institutes of Health, Rockville, Maryland (original)* - [GitHub](https://github.com/idblr) - [ORCID](https://orcid.org/0000-0001-9477-8582) +* **Ian D. Buller** - *Social & Scientific Systems, Inc., a DLH Corporation Holding Company, Bethesda, Maryland (current)* - *Occupational and Environmental Epidemiology Branch, Division of Cancer Epidemiology and Genetics, National Cancer Institute, National Institutes of Health, Rockville, Maryland (original)* - [GitHub](https://github.com/idblr) - [ORCID](https://orcid.org/0000-0001-9477-8582) See also the list of [contributors](https://github.com/idblr/ndi/graphs/contributors) who participated in this package, including: * **Jacob Englert** - *Biostatistics and Bioinformatics Doctoral Program, Laney Graduate School, Emory University, Atlanta, Georgia* - [GitHub](https://github.com/jacobenglert) +* **Jessica Gleason** - *Epidemiology Branch, Division of Population Health Research, Eunice Kennedy Shriver National Institute of Child Health and Human Development, National Institutes of Health, Bethesda, Maryland* - [ORCID](https://orcid.org/0000-0001-9877-7931) + * **Chris Prener** - *Real World Evidence Center of Excellence, Pfizer, Inc.* - [GitHub](https://github.com/chris-prener) - [ORCID](https://orcid.org/0000-0002-4310-9888) -* **Jessica Gleason** - *Epidemiology Branch, Division of Population Health Research, Eunice Kennedy Shriver National Institute of Child Health and Human Development, National Institutes of Health, Bethesda, Maryland* - [ORCID](https://orcid.org/0000-0001-9877-7931) +* **Davis Vaughan** - *Posit* - [GitHub](https://github.com/DavisVaughan) - [ORCID](https://orcid.org/0000-0003-4777-038X) Thank you to those who suggested additional metrics, including: -* **Jessica Madrigal** - *Occupational and Environmental Epidemiology Branch, Division of Cancer Epidemiology and Genetics, National Cancer Institute, National Institutes of Health, Rockville, Maryland* - [ORCID](https://orcid.org/0000-0001-5303-5109) - * **David Berrigan** - *Behavioral Research Program, Division of Cancer Control and Population Sciences, National Cancer Institute, National Institutes of Health, Rockville, Maryland* - [ORCID](https://orcid.org/0000-0002-5333-179X) +* **Symielle Gaston** - *Social and Environmental Determinants of Health Equity Group, Epidemiology Branch, National Institute of Environmental Health Sciences, National Institutes of Health, Research Triangle Park, North Carolina* - [ORCID](https://orcid.org/0000-0001-9495-1592) + +* **Jessica Madrigal** - *Occupational and Environmental Epidemiology Branch, Division of Cancer Epidemiology and Genetics, National Cancer Institute, National Institutes of Health, Rockville, Maryland* - [ORCID](https://orcid.org/0000-0001-5303-5109) + ### Getting Started * Step 1: Obtain a unique access key from the U.S. Census Bureau. Follow [this link](http://api.census.gov/data/key_signup.html) to obtain one. -* Step 2: Specify your access key in the `anthopolos()`, `atkinson()`, `bell()`, `bemanian_beyer()`, `bravo()`, `duncan()`, `gini()`, `krieger()`, `messer()`, `powell_wiley()`, `sudano()`, or `white()` functions using the internal `key` argument or by using the `census_api_key()` function from the `tidycensus` package before running the `anthopolos()`, `atkinson()`, `bell()`, `bemanian_beyer()`, `bravo()`, `duncan()`, `gini()`, `krieger()`, `messer()`, `powell_wiley()`, `sudano()`, or `white()` functions (see an example below). +* Step 2: Specify your access key in the `anthopolos()`, `atkinson()`, `bell()`, `bemanian_beyer()`, `bravo()`, `duncan()`, `gini()`, `hoover()`, `krieger()`, `messer()`, `powell_wiley()`, `sudano()`, or `white()` functions using the internal `key` argument or by using the `census_api_key()` function from the `tidycensus` package before running the `anthopolos()`, `atkinson()`, `bell()`, `bemanian_beyer()`, `bravo()`, `duncan()`, `gini()`, `hoover()`, `krieger()`, `messer()`, `powell_wiley()`, `sudano()`, or `white()` functions (see an example below). ### Usage @@ -139,8 +159,8 @@ Thank you to those who suggested additional metrics, including: library(ndi) library(ggplot2) -library(sf) # dependency fo the "ndi" package -library(tidycensus) # a dependency for the "ndi" package +library(sf) # dependency fo the 'ndi' package +library(tidycensus) # a dependency for the 'ndi' package library(tigris) # -------- # @@ -149,14 +169,14 @@ library(tigris) ## Access Key for census data download ### Obtain one at http://api.census.gov/data/key_signup.html -tidycensus::census_api_key("...") # INSERT YOUR OWN KEY FROM U.S. CENSUS API +tidycensus::census_api_key('...') # INSERT YOUR OWN KEY FROM U.S. CENSUS API # ---------------------- # # Calculate NDI (Messer) # # ---------------------- # # Compute the NDI (Messer) values (2016-2020 5-year ACS) for Washington, D.C. census tracts -messer2020DC <- messer(state = "DC", year = 2020) +messer2020DC <- messer(state = 'DC', year = 2020) # ------------------------------ # # Outputs from messer() function # @@ -175,11 +195,11 @@ messer2020DC$missing # Visualize the messer() function output # # -------------------------------------- # -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the NDI (Messer) values to the census tract geometry -DC2020messer <- dplyr::left_join(tract2020DC, messer2020DC$ndi, by = "GEOID") +DC2020messer <- dplyr::left_join(tract2020DC, messer2020DC$ndi, by = 'GEOID') # Visualize the NDI (Messer) values (2016-2020 5-year ACS) for Washington, D.C. census tracts @@ -187,32 +207,32 @@ DC2020messer <- dplyr::left_join(tract2020DC, messer2020DC$ndi, by = "GEOID") ggplot2::ggplot() + ggplot2::geom_sf(data = DC2020messer, ggplot2::aes(fill = NDI), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Neighborhood Deprivation Index\nContinuous (Messer, non-imputed)", - subtitle = "Washington, D.C. tracts as the referent") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Neighborhood Deprivation Index\nContinuous (Messer, non-imputed)', + subtitle = 'Washington, D.C. tracts as the referent') ## Categorical Index (Quartiles) -### Rename "9-NDI not avail" level as NA for plotting +### Rename '9-NDI not avail' level as NA for plotting DC2020messer$NDIQuartNA <- factor(replace(as.character(DC2020messer$NDIQuart), - DC2020messer$NDIQuart == "9-NDI not avail", + DC2020messer$NDIQuart == '9-NDI not avail', NA), c(levels(DC2020messer$NDIQuart)[-5], NA)) ggplot2::ggplot() + ggplot2::geom_sf(data = DC2020messer, ggplot2::aes(fill = NDIQuartNA), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey50") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index\nQuartiles (Messer, non-imputed)", - subtitle = "Washington, D.C. tracts as the referent") + na.value = 'grey50') + + ggplot2::labs(fill = 'Index (Categorical)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggplot2::ggtitle('Neighborhood Deprivation Index\nQuartiles (Messer, non-imputed)', + subtitle = 'Washington, D.C. tracts as the referent') ``` ![](man/figures/messer1.png) ![](man/figures/messer2.png) @@ -223,8 +243,8 @@ ggplot2::ggplot() + # ---------------------------- # # Compute the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for Washington, D.C. census tracts -powell_wiley2020DC <- powell_wiley(state = "DC", year = 2020) -powell_wiley2020DCi <- powell_wiley(state = "DC", year = 2020, imp = TRUE) # impute missing values +powell_wiley2020DC <- powell_wiley(state = 'DC', year = 2020) +powell_wiley2020DCi <- powell_wiley(state = 'DC', year = 2020, imp = TRUE) # impute missing values # ------------------------------------ # # Outputs from powell_wiley() function # @@ -243,12 +263,12 @@ powell_wiley2020DC$missing # Visualize the powell_wiley() function output # # -------------------------------------------- # -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the NDI (powell_wiley) values to the census tract geometry -DC2020powell_wiley <- dplyr::left_join(tract2020DC, powell_wiley2020DC$ndi, by = "GEOID") -DC2020powell_wiley <- dplyr::left_join(DC2020powell_wiley, powell_wiley2020DCi$ndi, by = "GEOID") +DC2020powell_wiley <- dplyr::left_join(tract2020DC, powell_wiley2020DC$ndi, by = 'GEOID') +DC2020powell_wiley <- dplyr::left_join(DC2020powell_wiley, powell_wiley2020DCi$ndi, by = 'GEOID') # Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for Washington, D.C. census tracts @@ -256,32 +276,32 @@ DC2020powell_wiley <- dplyr::left_join(DC2020powell_wiley, powell_wiley2020DCi$n ggplot2::ggplot() + ggplot2::geom_sf(data = DC2020powell_wiley, ggplot2::aes(fill = NDI.x), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Neighborhood Deprivation Index\nContinuous (Powell-Wiley, non-imputed)", - subtitle = "Washington, D.C. tracts as the referent") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Neighborhood Deprivation Index\nContinuous (Powell-Wiley, non-imputed)', + subtitle = 'Washington, D.C. tracts as the referent') ## Non-imputed missing tracts (Categorical quintiles) -### Rename "9-NDI not avail" level as NA for plotting +### Rename '9-NDI not avail' level as NA for plotting DC2020powell_wiley$NDIQuintNA.x <- factor(replace(as.character(DC2020powell_wiley$NDIQuint.x), - DC2020powell_wiley$NDIQuint.x == "9-NDI not avail", + DC2020powell_wiley$NDIQuint.x == '9-NDI not avail', NA), c(levels(DC2020powell_wiley$NDIQuint.x)[-6], NA)) ggplot2::ggplot() + ggplot2::geom_sf(data = DC2020powell_wiley, ggplot2::aes(fill = NDIQuintNA.x), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey50") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, non-imputed)", - subtitle = "Washington, D.C. tracts as the referent") + na.value = 'grey50') + + ggplot2::labs(fill = 'Index (Categorical)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, non-imputed)', + subtitle = 'Washington, D.C. tracts as the referent') ``` ![](man/figures/powell_wiley1.png) @@ -292,32 +312,32 @@ ggplot2::ggplot() + ggplot2::ggplot() + ggplot2::geom_sf(data = DC2020powell_wiley, ggplot2::aes(fill = NDI.y), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Neighborhood Deprivation Index\nContinuous (Powell-Wiley, imputed)", - subtitle = "Washington, D.C. tracts as the referent") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Neighborhood Deprivation Index\nContinuous (Powell-Wiley, imputed)', + subtitle = 'Washington, D.C. tracts as the referent') ## Imputed missing tracts (Categorical quintiles) -### Rename "9-NDI not avail" level as NA for plotting +### Rename '9-NDI not avail' level as NA for plotting DC2020powell_wiley$NDIQuintNA.y <- factor(replace(as.character(DC2020powell_wiley$NDIQuint.y), - DC2020powell_wiley$NDIQuint.y == "9-NDI not avail", + DC2020powell_wiley$NDIQuint.y == '9-NDI not avail', NA), c(levels(DC2020powell_wiley$NDIQuint.y)[-6], NA)) ggplot2::ggplot() + ggplot2::geom_sf(data = DC2020powell_wiley, ggplot2::aes(fill = NDIQuintNA.y), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey50") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, imputed)", - subtitle = "Washington, D.C. tracts as the referent") + na.value = 'grey50') + + ggplot2::labs(fill = 'Index (Categorical)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, imputed)', + subtitle = 'Washington, D.C. tracts as the referent') ``` ![](man/figures/powell_wiley3.png) @@ -329,10 +349,10 @@ ggplot2::ggplot() + # --------------------------- # # Merge the two NDI metrics (Messer and Powell-Wiley, imputed) -ndi2020DC <- dplyr::left_join(messer2020DC$ndi, powell_wiley2020DCi$ndi, by = "GEOID", suffix = c(".messer", ".powell_wiley")) +ndi2020DC <- dplyr::left_join(messer2020DC$ndi, powell_wiley2020DCi$ndi, by = 'GEOID', suffix = c('.messer', '.powell_wiley')) # Check the correlation the two NDI metrics (Messer and Powell-Wiley, imputed) as continuous values -cor(ndi2020DC$NDI.messer, ndi2020DC$NDI.powell_wiley, use = "complete.obs") # Pearsons r = 0.975 +cor(ndi2020DC$NDI.messer, ndi2020DC$NDI.powell_wiley, use = 'complete.obs') # Pearsons r = 0.975 # Check the similarity of the two NDI metrics (Messer and Powell-Wiley, imputed) as quartiles table(ndi2020DC$NDIQuart, ndi2020DC$NDIQuint) @@ -344,24 +364,24 @@ table(ndi2020DC$NDIQuart, ndi2020DC$NDIQuint) # ---------------------------- # # Gini Index based on Gini (1921) from the ACS-5 -gini2020DC <- gini(state = "DC", year = 2020) +gini2020DC <- gini(state = 'DC', year = 2020) -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the Gini Index values to the census tract geometry -gini2020DC <- dplyr::left_join(tract2020DC, gini2020DC$gini, by = "GEOID") +gini2020DC <- dplyr::left_join(tract2020DC, gini2020DC$gini, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = gini2020DC, ggplot2::aes(fill = gini), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Gini Index\nGrey color denotes no data", - subtitle = "Washington, D.C. tracts") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Gini Index\nGrey color denotes no data', + subtitle = 'Washington, D.C. tracts') ``` ![](man/figures/gini.png) @@ -373,24 +393,24 @@ ggplot2::ggplot() + # Racial Isolation Index based on Anthopolos et al. (2011) ## Selected subgroup: Not Hispanic or Latino, Black or African American alone -ri2020DC <- anthopolos(state = "DC", year = 2020, subgroup = "NHoLB") +ri2020DC <- anthopolos(state = 'DC', year = 2020, subgroup = 'NHoLB') -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the RI (Anthopolos) values to the census tract geometry -ri2020DC <- dplyr::left_join(tract2020DC, ri2020DC$ri, by = "GEOID") +ri2020DC <- dplyr::left_join(tract2020DC, ri2020DC$ri, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = ri2020DC, ggplot2::aes(fill = RI), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Racial Isolation Index\nNot Hispanic or Latino, Black or African American alone (Anthopolos)", - subtitle = "Washington, D.C. tracts (not corrected for edge effects)") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Racial Isolation Index\nNot Hispanic or Latino, Black or African American alone (Anthopolos)', + subtitle = 'Washington, D.C. tracts (not corrected for edge effects)') ``` ![](man/figures/ri.png) @@ -402,24 +422,24 @@ ggplot2::ggplot() + # Educational Isolation Index based on Bravo et al. (2021) ## Selected subgroup: without four-year college degree -ei2020DC <- bravo(state = "DC", year = 2020, subgroup = c("LtHS", "HSGiE", "SCoAD")) +ei2020DC <- bravo(state = 'DC', year = 2020, subgroup = c('LtHS', 'HSGiE', 'SCoAD')) -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the EI (Bravo) values to the census tract geometry -ei2020DC <- dplyr::left_join(tract2020DC, ei2020DC$ei, by = "GEOID") +ei2020DC <- dplyr::left_join(tract2020DC, ei2020DC$ei, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = ei2020DC, ggplot2::aes(fill = EI), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Educational Isolation Index\nWithout a four-year college degree (Bravo)", - subtitle = "Washington, D.C. tracts (not corrected for edge effects)") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Educational Isolation Index\nWithout a four-year college degree (Bravo)', + subtitle = 'Washington, D.C. tracts (not corrected for edge effects)') ``` ![](man/figures/ei.png) @@ -431,25 +451,25 @@ ggplot2::ggplot() + # Five Indices of Concentration at the Extremes based on Feldman et al. (2015) and Krieger et al. (2016) -ice2020DC <- krieger(state = "DC", year = 2020) +ice2020DC <- krieger(state = 'DC', year = 2020) -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the ICEs (Krieger) values to the census tract geometry -ice2020DC <- dplyr::left_join(tract2020DC, ice2020DC$ice, by = "GEOID") +ice2020DC <- dplyr::left_join(tract2020DC, ice2020DC$ice, by = 'GEOID') # Plot ICE for Income ggplot2::ggplot() + ggplot2::geom_sf(data = ice2020DC, ggplot2::aes(fill = ICE_inc), - color = "white") + + color = 'white') + ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1,1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome (Krieger)", - subtitle = "80th income percentile vs. 20th income percentile") + ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1,1)) + + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Index of Concentration at the Extremes\nIncome (Krieger)', + subtitle = '80th income percentile vs. 20th income percentile') ``` ![](man/figures/ice1.png) @@ -459,13 +479,13 @@ ggplot2::ggplot() + ggplot2::ggplot() + ggplot2::geom_sf(data = ice2020DC, ggplot2::aes(fill = ICE_edu), - color = "white") + + color = 'white') + ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1,1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nEducation (Krieger)", - subtitle = "less than high school vs. four-year college degree or more") + ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1,1)) + + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Index of Concentration at the Extremes\nEducation (Krieger)', + subtitle = 'less than high school vs. four-year college degree or more') ``` ![](man/figures/ice2.png) @@ -475,13 +495,13 @@ ggplot2::ggplot() + ggplot2::ggplot() + ggplot2::geom_sf(data = ice2020DC, ggplot2::aes(fill = ICE_rewb), - color = "white") + + color = 'white') + ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nRace/Ethnicity (Krieger)", - subtitle = "white non-Hispanic vs. black non-Hispanic") + ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1, 1)) + + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Index of Concentration at the Extremes\nRace/Ethnicity (Krieger)', + subtitle = 'white non-Hispanic vs. black non-Hispanic') ``` ![](man/figures/ice3.png) @@ -492,13 +512,13 @@ ggplot2::ggplot() + ggplot2::ggplot() + ggplot2::geom_sf(data = ice2020DC, ggplot2::aes(fill = ICE_wbinc), - color = "white") + + color = 'white') + ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome and race/ethnicity combined (Krieger)", - subtitle = "white non-Hispanic in 80th income percentile vs. black (incl. Hispanic) in 20th inc. percentile") + ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1, 1)) + + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Index of Concentration at the Extremes\nIncome and race/ethnicity combined (Krieger)', + subtitle = 'white non-Hispanic in 80th income percentile vs. black (incl. Hispanic) in 20th inc. percentile') ``` ![](man/figures/ice4.png) @@ -509,13 +529,13 @@ ggplot2::ggplot() + ggplot2::ggplot() + ggplot2::geom_sf(data = ice2020DC, ggplot2::aes(fill = ICE_wpcinc), - color = "white") + + color = 'white') + ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome and race/ethnicity combined (Krieger)", - subtitle = "white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile") + ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1, 1)) + + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Index of Concentration at the Extremes\nIncome and race/ethnicity combined (Krieger)', + subtitle = 'white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile') ``` ![](man/figures/ice5.png) @@ -530,25 +550,25 @@ ggplot2::ggplot() + ## Selected subgroup reference: Not Hispanic or Latino, white alone ## Selected large geography: census tract ## Selected small geography: census block group -di2020DC <- duncan(geo_large = "tract", geo_small = "block group", state = "DC", - year = 2020, subgroup = "NHoLB", subgroup_ref = "NHoLW") +di2020DC <- duncan(geo_large = 'tract', geo_small = 'block group', state = 'DC', + year = 2020, subgroup = 'NHoLB', subgroup_ref = 'NHoLW') -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the DI (Duncan & Duncan) values to the census tract geometry -di2020DC <- dplyr::left_join(tract2020DC, di2020DC$di, by = "GEOID") +di2020DC <- dplyr::left_join(tract2020DC, di2020DC$di, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = di2020DC, ggplot2::aes(fill = DI), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Dissimilarity Index (Duncan & Duncan)\nWashington, D.C. census block groups to tracts", - subtitle = "Black non-Hispanic vs. white non-Hispanic") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ + ggplot2::ggtitle('Dissimilarity Index (Duncan & Duncan)\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic vs. white non-Hispanic') ``` ![](man/figures/di.png) @@ -563,25 +583,25 @@ ggplot2::ggplot() + ## Selected large geography: census tract ## Selected small geography: census block group ## Default epsilon (0.5 or over- and under-representation contribute equally) -ai2020DC <- atkinson(geo_large = "tract", geo_small = "block group", state = "DC", - year = 2020, subgroup = "NHoLB") +ai2020DC <- atkinson(geo_large = 'tract', geo_small = 'block group', state = 'DC', + year = 2020, subgroup = 'NHoLB') -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the AI (Atkinson) values to the census tract geometry -ai2020DC <- dplyr::left_join(tract2020DC, ai2020DC$ai, by = "GEOID") +ai2020DC <- dplyr::left_join(tract2020DC, ai2020DC$ai, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = ai2020DC, ggplot2::aes(fill = AI), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Atkinson Index (Atkinson)\nWashington, D.C. census block groups to tracts", - subtitle = expression(paste("Black non-Hispanic (", epsilon, " = 0.5)"))) + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggplot2::ggtitle('Atkinson Index (Atkinson)\nWashington, D.C. census block groups to tracts', + subtitle = expression(paste('Black non-Hispanic (', epsilon, ' = 0.5)'))) ``` ![](man/figures/ai.png) @@ -596,25 +616,25 @@ ggplot2::ggplot() + ## Selected interaction subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: census tract ## Selected small geography: census block group -ii2020DC <- bell(geo_large = "tract", geo_small = "block group", state = "DC", - year = 2020, subgroup = "NHoLB", subgroup_ixn = "NHoLW") +ii2020DC <- bell(geo_large = 'tract', geo_small = 'block group', state = 'DC', + year = 2020, subgroup = 'NHoLB', subgroup_ixn = 'NHoLW') -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the II (Bell) values to the census tract geometry -ii2020DC <- dplyr::left_join(tract2020DC, ii2020DC$ii, by = "GEOID") +ii2020DC <- dplyr::left_join(tract2020DC, ii2020DC$ii, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = ii2020DC, ggplot2::aes(fill = II), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Isolation Index (Bell)\nWashington, D.C. census block groups to tracts", - subtitle = "Black non-Hispanic vs. white non-Hispanic") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggplot2::ggtitle('Isolation Index (Bell)\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic vs. white non-Hispanic') ``` ![](man/figures/ii.png) @@ -628,25 +648,25 @@ ggplot2::ggplot() + ## Selected subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: census tract ## Selected small geography: census block group -v2020DC <- white(geo_large = "tract", geo_small = "block group", state = "DC", - year = 2020, subgroup = "NHoLB") +v2020DC <- white(geo_large = 'tract', geo_small = 'block group', state = 'DC', + year = 2020, subgroup = 'NHoLB') -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the V (White) values to the census tract geometry -v2020DC <- dplyr::left_join(tract2020DC, v2020DC$v, by = "GEOID") +v2020DC <- dplyr::left_join(tract2020DC, v2020DC$v, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = v2020DC, ggplot2::aes(fill = V), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Correlation Ratio (White)\nWashington, D.C. census block groups to tracts", - subtitle = "Black non-Hispanic") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggplot2::ggtitle('Correlation Ratio (White)\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic') ``` ![](man/figures/v.png) @@ -660,25 +680,25 @@ ggplot2::ggplot() + ## Selected subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: state ## Selected small geography: census tract -lq2020DC <- sudano(geo_large = "state", geo_small = "tract", state = "DC", - year = 2020, subgroup = "NHoLB") +lq2020DC <- sudano(geo_large = 'state', geo_small = 'tract', state = 'DC', + year = 2020, subgroup = 'NHoLB') -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the LQ (Sudano) values to the census tract geometry -lq2020DC <- dplyr::left_join(tract2020DC, lq2020DC$lq, by = "GEOID") +lq2020DC <- dplyr::left_join(tract2020DC, lq2020DC$lq, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = lq2020DC, ggplot2::aes(fill = LQ), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle('Location Quotient (Sudano)\nWashington, D.C. census tracts vs. "state"', - subtitle = "Black non-Hispanic") + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggplot2::ggtitle('Location Quotient (Sudano)\nWashington, D.C. census tracts vs. 'state'', + subtitle = 'Black non-Hispanic') ``` ![](man/figures/lq.png) @@ -693,40 +713,72 @@ ggplot2::ggplot() + ## Selected interaction subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: state ## Selected small geography: census tract -lexis2020DC <- bemanian_beyer(geo_large = "state", geo_small = "tract", state = "DC", - year = 2020, subgroup = "NHoLB", subgroup_ixn = "NHoLW") +lexis2020DC <- bemanian_beyer(geo_large = 'state', geo_small = 'tract', state = 'DC', + year = 2020, subgroup = 'NHoLB', subgroup_ixn = 'NHoLW') -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) # Join the LEx/Is (Bemanian & Beyer) values to the census tract geometry -lexis2020DC <- dplyr::left_join(tract2020DC, lexis2020DC$lexis, by = "GEOID") +lexis2020DC <- dplyr::left_join(tract2020DC, lexis2020DC$lexis, by = 'GEOID') ggplot2::ggplot() + ggplot2::geom_sf(data = lexis2020DC, ggplot2::aes(fill = LExIs), - color = "white") + + color = 'white') + ggplot2::theme_bw() + ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates') + ggplot2::ggtitle('Local Exposure and Isolation (Bemanian & Beyer) metric\nWashington, D.C. census block groups to tracts', - subtitle = "Black non-Hispanic vs. white non-Hispanic") + subtitle = 'Black non-Hispanic vs. white non-Hispanic') ``` ![](man/figures/lexis.png) +```r +# --------------------------------------------- # +# Compute aspatial racial/ethnic Delta (Hoover) # +# --------------------------------------------- # + +# Delta based on Hoover (1941) and Duncan et al. (1961) +## Selected subgroup: Not Hispanic or Latino, Black or African American alone +## Selected large geography: census tract +## Selected small geography: census block group +del2020DC <- hoover(geo_large = 'tract', geo_small = 'block group', state = 'DC', + year = 2020, subgroup = 'NHoLB') + +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) + +# Join the DEL (Hoover) values to the census tract geometry +del2020DC <- dplyr::left_join(tract2020DC, del2020DC$del, by = 'GEOID') + +ggplot2::ggplot() + + ggplot2::geom_sf(data = del2020DC, + ggplot2::aes(fill = DEL), + color = 'white') + + ggplot2::theme_bw() + + ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + + ggplot2::labs(fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggplot2::ggtitle('Delta (Hoover)\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic') +``` + +![](man/figures/del.png) + ### Funding -This package was originally developed while the author was a postdoctoral fellow supported by the [Cancer Prevention Fellowship Program](https://cpfp.cancer.gov) at the [National Cancer Institute](https://www.cancer.gov). Any modifications since December 05, 2022 were made while the author was an employee of Social & Scientific Systems, Inc., a division of [DLH Corporation](https://www.dlhcorp.com). +This package was originally developed while the author was a postdoctoral fellow supported by the [Cancer Prevention Fellowship Program](https://cpfp.cancer.gov) at the [National Cancer Institute](https://www.cancer.gov). Any modifications since December 05, 2022 were made while the author was an employee of Social & Scientific Systems, Inc., a [DLH Corporation](https://www.dlhcorp.com) Holding Company. ### Acknowledgments -The `messer()` function functionalizes the code found in [Hruska _et al._ (2022)](https://doi.org/10.1016/j.janxdis.2022.102529) available on an [OSF repository](https://doi.org/10.17605/OSF.IO/M2SAV), but with percent with income less than $30K added to the computation based on [Messer _et al._ (2006)](https://doi.org/10.1007/s11524-006-9094-x). The `messer()` function also allows for the computation of NDI (Messer) for each year between 2010-2020 (when the U.S. census characteristics are available to date). There was no code companion to compute NDI (Powell-Wiley) included in [Andrews _et al._ (2020)](https://doi.org/10.1080/17445647.2020.1750066) or [Slotman _et al._ (2022)](https://doi.org/10.1016/j.dib.2022.108002), but the package author worked directly with the latter manuscript authors to replicate their `SAS` code in `R` for the `powell_wiley()` function. Please note: the NDI (Powell-Wiley) values will not exactly match (but will highly correlate with) those found in [Andrews _et al._ (2020)](https://doi.org/10.1080/17445647.2020.1750066) and [Slotman _et al._ (2022)](https://doi.org/10.1016/j.dib.2022.108002) because the two studies used a different statistical platform (i.e., `SPSS` and `SAS`, respectively) that intrinsically calculate the principal component analysis differently from `R`. The internal function to calculate the Atkinson Index is based on the `Atkinson()` function in the [DescTools](https://cran.r-project.org/package=DescTools) package. +The `messer()` function functionalizes the code found in [Hruska et al. (2022)](https://doi.org/10.1016/j.janxdis.2022.102529) available on an [OSF repository](https://doi.org/10.17605/OSF.IO/M2SAV), but with percent with income less than $30K added to the computation based on [Messer et al. (2006)](https://doi.org/10.1007/s11524-006-9094-x). The `messer()` function also allows for the computation of NDI (Messer) for each year between 2010-2020 (when the U.S. census characteristics are available to date). There was no code companion to compute NDI (Powell-Wiley) included in [Andrews et al. (2020)](https://doi.org/10.1080/17445647.2020.1750066) or [Slotman et al. (2022)](https://doi.org/10.1016/j.dib.2022.108002), but the package author worked directly with the latter manuscript authors to replicate their `SAS` code in `R` for the `powell_wiley()` function. Please note: the NDI (Powell-Wiley) values will not exactly match (but will highly correlate with) those found in [Andrews et al. (2020)](https://doi.org/10.1080/17445647.2020.1750066) and [Slotman et al. (2022)](https://doi.org/10.1016/j.dib.2022.108002) because the two studies used a different statistical platform (i.e., `SPSS` and `SAS`, respectively) that intrinsically calculate the principal component analysis differently from `R`. The internal function to calculate the Atkinson Index is based on the `Atkinson()` function in the [DescTools](https://cran.r-project.org/package=DescTools) package. When citing this package for publication, please follow: - citation("ndi") + citation('ndi') ### Questions? Feedback? diff --git a/data-raw/get_DCtracts2020.R b/data-raw/get_DCtracts2020.R index cc25284..bb881c1 100644 --- a/data-raw/get_DCtracts2020.R +++ b/data-raw/get_DCtracts2020.R @@ -1,147 +1,216 @@ -# code to prepare `DCtracts2020` +# ----------------------------------------------------------------------------------------------- # +# Code to prepare `DCtracts2020` +# ----------------------------------------------------------------------------------------------- # +# +# Created by: Ian Buller, Ph.D., M.A. (GitHub: @idblr) +# Created on: 2022-07-23 +# +# Recently modified by: @idblr +# Recently modified on: 2024-07-06 +# +# Notes: +# A) 2024-07-06 (@idblr): Re-formatted +# ----------------------------------------------------------------------------------------------- # # ------------------ # -# Necessary packages # +# NECESSARY PACKAGES # # ------------------ # -library(dplyr) -library(tidycensus) -library(usethis) +loadedPackages <- c('dplyr', 'tidycensus', 'usethis') +suppressMessages(invisible(lapply(loadedPackages, library, character.only = TRUE))) # -------- # -# Settings # +# SETTINGS # # -------- # ## Access Key for census data download ### Obtain one at http://api.census.gov/data/key_signup.html -tidycensus::census_api_key("...") # INSERT YOUR OWN KEY FROM U.S. CENSUS API +census_api_key('...') # INSERT YOUR OWN KEY FROM U.S. CENSUS API # ---------------- # -# Data preparation # +# DATA PREPARATION # # ---------------- # # U.S. Census Bureau American Community Survey (ACS) 5-year variables ## For NDI (Messer) ### ACS-5 variables -messer_vars <- c(PctMenMgmtBusScArti_num1 = "C24030_018", PctMenMgmtBusScArti_num2 = "C24030_019", - PctMenMgmtBusScArti_den = "C24030_002", - PctCrwdHH_num1 = "B25014_005", PctCrwdHH_num2 = "B25014_006", - PctCrwdHH_num3 = "B25014_007", PctCrwdHH_num4 = "B25014_011", - PctCrwdHH_num5 = "B25014_012", PctCrwdHH_num6 = "B25014_013", - PctCrwdHH_den = "B25014_001", - PctHHPov_num = "B17017_002", PctHHPov_den = "B17017_001", - PctFemHeadKids_num1 = "B25115_012", PctFemHeadKids_num2 = "B25115_025", - PctFemHeadKids_den = "B25115_001", - PctPubAsst_num = "B19058_002", PctPubAsst_den = "B19058_001", - PctHHUnder30K_num1 = "B19001_002", PctHHUnder30K_num2 = "B19001_003", - PctHHUnder30K_num3 = "B19001_004", PctHHUnder30K_num4 = "B19001_005", - PctHHUnder30K_num5 = "B19001_006", PctHHUnder30K_den = "B19001_001", - PctEducLessThanHS_num = "B06009_002", PctEducLessThanHS_den = "B06009_001", - PctUnemp_num = "B23025_005", PctUnemp_den = "B23025_003") +messer_vars <- c( + PctMenMgmtBusScArti_num1 = 'C24030_018', + PctMenMgmtBusScArti_num2 = 'C24030_019', + PctMenMgmtBusScArti_den = 'C24030_002', + PctCrwdHH_num1 = 'B25014_005', + PctCrwdHH_num2 = 'B25014_006', + PctCrwdHH_num3 = 'B25014_007', + PctCrwdHH_num4 = 'B25014_011', + PctCrwdHH_num5 = 'B25014_012', + PctCrwdHH_num6 = 'B25014_013', + PctCrwdHH_den = 'B25014_001', + PctHHPov_num = 'B17017_002', + PctHHPov_den = 'B17017_001', + PctFemHeadKids_num1 = 'B25115_012', + PctFemHeadKids_num2 = 'B25115_025', + PctFemHeadKids_den = 'B25115_001', + PctPubAsst_num = 'B19058_002', + PctPubAsst_den = 'B19058_001', + PctHHUnder30K_num1 = 'B19001_002', + PctHHUnder30K_num2 = 'B19001_003', + PctHHUnder30K_num3 = 'B19001_004', + PctHHUnder30K_num4 = 'B19001_005', + PctHHUnder30K_num5 = 'B19001_006', + PctHHUnder30K_den = 'B19001_001', + PctEducLessThanHS_num = 'B06009_002', + PctEducLessThanHS_den = 'B06009_001', + PctUnemp_num = 'B23025_005', + PctUnemp_den = 'B23025_003' +) ### Obtain ACS-5 data for DC tracts in 2020 -DCtracts2020messer <- tidycensus::get_acs(geography = "tract", - year = 2020, - output = "wide", - variables = messer_vars, - state = "DC") +DCtracts2020messer <- get_acs( + geography = 'tract', + year = 2020, + output = 'wide', + variables = messer_vars, + state = 'DC' +) ### Format ACS-5 data for NDI (Messer) of DC tracts in 2020 DCtracts2020messer <- DCtracts2020messer[ , -2] # omit NAME feature (column) DCtracts2020messer <- DCtracts2020messer %>% - dplyr::mutate(OCC = (PctMenMgmtBusScArti_num1E + PctMenMgmtBusScArti_num2E) / PctMenMgmtBusScArti_denE, - CWD = (PctCrwdHH_num1E + PctCrwdHH_num2E + PctCrwdHH_num3E + - PctCrwdHH_num4E + PctCrwdHH_num5E + PctCrwdHH_num6E) / PctCrwdHH_denE, - POV = PctHHPov_numE / PctHHPov_denE, - FHH = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE, - PUB = PctPubAsst_numE / PctPubAsst_denE, - U30 = (PctHHUnder30K_num1E + PctHHUnder30K_num2E + PctHHUnder30K_num3E + - PctHHUnder30K_num4E + PctHHUnder30K_num5E) / PctHHUnder30K_denE, - EDU = PctEducLessThanHS_numE / PctEducLessThanHS_denE, - EMP = PctUnemp_numE / PctUnemp_denE) + mutate( + OCC = (PctMenMgmtBusScArti_num1E + PctMenMgmtBusScArti_num2E) / PctMenMgmtBusScArti_denE, + CWD = ( + PctCrwdHH_num1E + PctCrwdHH_num2E + PctCrwdHH_num3E + + PctCrwdHH_num4E + PctCrwdHH_num5E + PctCrwdHH_num6E + ) / PctCrwdHH_denE, + POV = PctHHPov_numE / PctHHPov_denE, + FHH = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE, + PUB = PctPubAsst_numE / PctPubAsst_denE, + U30 = ( + PctHHUnder30K_num1E + PctHHUnder30K_num2E + PctHHUnder30K_num3E + + PctHHUnder30K_num4E + PctHHUnder30K_num5E + ) / PctHHUnder30K_denE, + EDU = PctEducLessThanHS_numE / PctEducLessThanHS_denE, + EMP = PctUnemp_numE / PctUnemp_denE + ) ### Clean-up and format DCtracts2020messer <- DCtracts2020messer %>% - dplyr::select(GEOID, OCC, CWD, POV, FHH, PUB, U30, EDU, EMP) + select(GEOID, OCC, CWD, POV, FHH, PUB, U30, EDU, EMP) ## For NDI (Powell-Wiley) ### ACS-5 variables -powell_wiley_vars <- c(MedHHInc = "B19013_001", - PctRecvIDR_num = "B19054_002", PctRecvIDR_den = "B19054_001", - PctPubAsst_num = "B19058_002", PctPubAsst_den = "B19058_001", - MedHomeVal = "B25077_001", - PctMgmtBusScArti_num = "C24060_002", PctMgmtBusScArti_den = "C24060_001", - PctFemHeadKids_num1 = "B11005_007", PctFemHeadKids_num2 = "B11005_010", - PctFemHeadKids_den = "B11005_001", - PctOwnerOcc = "DP04_0046P", - PctNoPhone = "DP04_0075P", - PctNComPlmb = "DP04_0073P", - PctEduc_num25upHS = "S1501_C01_009", - PctEduc_num25upSC = "S1501_C01_010", - PctEduc_num25upAD = "S1501_C01_011", - PctEduc_num25upBD = "S1501_C01_012", - PctEduc_num25upGD = "S1501_C01_013", - PctEduc_den25up = "S1501_C01_006", - PctFamBelowPov = "S1702_C02_001", - PctUnempl = "S2301_C04_001", - TotalPopulation = "B01001_001") +powell_wiley_vars <- c( + MedHHInc = 'B19013_001', + PctRecvIDR_num = 'B19054_002', + PctRecvIDR_den = 'B19054_001', + PctPubAsst_num = 'B19058_002', + PctPubAsst_den = 'B19058_001', + MedHomeVal = 'B25077_001', + PctMgmtBusScArti_num = 'C24060_002', + PctMgmtBusScArti_den = 'C24060_001', + PctFemHeadKids_num1 = 'B11005_007', + PctFemHeadKids_num2 = 'B11005_010', + PctFemHeadKids_den = 'B11005_001', + PctOwnerOcc = 'DP04_0046P', + PctNoPhone = 'DP04_0075P', + PctNComPlmb = 'DP04_0073P', + PctEduc_num25upHS = 'S1501_C01_009', + PctEduc_num25upSC = 'S1501_C01_010', + PctEduc_num25upAD = 'S1501_C01_011', + PctEduc_num25upBD = 'S1501_C01_012', + PctEduc_num25upGD = 'S1501_C01_013', + PctEduc_den25up = 'S1501_C01_006', + PctFamBelowPov = 'S1702_C02_001', + PctUnempl = 'S2301_C04_001', + TotalPopulation = 'B01001_001' +) ### Obtain ACS-5 data for DC tracts in 2020 -DCtracts2020pw <- tidycensus::get_acs(geography = "tract", - year = 2020, - output = "wide", - variables = powell_wiley_vars, - state = "DC") +DCtracts2020pw <- get_acs( + geography = 'tract', + year = 2020, + output = 'wide', + variables = powell_wiley_vars, + state = 'DC' +) ### Format ACS-5 data for NDI (Powell-Wiley) of DC tracts in 2020 -DCtracts2020pw <- DCtracts2020pw[ , -2] # omit NAME feature (column) +DCtracts2020pw <- DCtracts2020pw[,-2] # omit NAME feature (column) DCtracts2020pw <- DCtracts2020pw %>% - dplyr::mutate(MedHHInc = MedHHIncE, - PctRecvIDR = PctRecvIDR_numE / PctRecvIDR_denE * 100, - PctPubAsst = PctPubAsst_numE / PctPubAsst_denE * 100, - MedHomeVal = MedHomeValE, - PctMgmtBusScArti = PctMgmtBusScArti_numE / PctMgmtBusScArti_denE * 100, - PctFemHeadKids = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE * 100, - PctOwnerOcc = PctOwnerOccE, - PctNoPhone = PctNoPhoneE, - PctNComPlmb = PctNComPlmbE, - PctEducHSPlus = (PctEduc_num25upHSE + PctEduc_num25upSCE + PctEduc_num25upADE + - PctEduc_num25upBDE + PctEduc_num25upGDE) / PctEduc_den25upE * 100, - PctEducBchPlus = (PctEduc_num25upBDE + PctEduc_num25upGDE) / PctEduc_den25upE * 100, - PctFamBelowPov = PctFamBelowPovE, - PctUnempl = PctUnemplE, - TotalPop = TotalPopulationE) %>% + mutate( + MedHHInc = MedHHIncE, + PctRecvIDR = PctRecvIDR_numE / PctRecvIDR_denE * 100, + PctPubAsst = PctPubAsst_numE / PctPubAsst_denE * 100, + MedHomeVal = MedHomeValE, + PctMgmtBusScArti = PctMgmtBusScArti_numE / PctMgmtBusScArti_denE * 100, + PctFemHeadKids = (PctFemHeadKids_num1E + PctFemHeadKids_num2E) / PctFemHeadKids_denE * 100, + PctOwnerOcc = PctOwnerOccE, + PctNoPhone = PctNoPhoneE, + PctNComPlmb = PctNComPlmbE, + PctEducHSPlus = ( + PctEduc_num25upHSE + PctEduc_num25upSCE + PctEduc_num25upADE + + PctEduc_num25upBDE + PctEduc_num25upGDE + ) / PctEduc_den25upE * 100, + PctEducBchPlus = (PctEduc_num25upBDE + PctEduc_num25upGDE) / PctEduc_den25upE * 100, + PctFamBelowPov = PctFamBelowPovE, + PctUnempl = PctUnemplE, + TotalPop = TotalPopulationE + ) %>% # Log transform median household income and median home value - # Reverse code percentages so that higher values represent more deprivation + # Reverse code percentages so that higher values represent more deprivation # Round percentages to 1 decimal place - dplyr::mutate(logMedHHInc = log(MedHHInc), - logMedHomeVal = log(MedHomeVal), - PctNoIDR = 100 - PctRecvIDR, - PctWorkClass = 100 - PctMgmtBusScArti, - PctNotOwnerOcc = 100 - PctOwnerOcc, - PctEducLTHS = 100 - PctEducHSPlus, - PctEducLTBch = 100 - PctEducBchPlus) %>% + mutate( + logMedHHInc = log(MedHHInc), + logMedHomeVal = log(MedHomeVal), + PctNoIDR = 100 - PctRecvIDR, + PctWorkClass = 100 - PctMgmtBusScArti, + PctNotOwnerOcc = 100 - PctOwnerOcc, + PctEducLTHS = 100 - PctEducHSPlus, + PctEducLTBch = 100 - PctEducBchPlus + ) %>% # Z-standardize the percentages - dplyr::mutate(PctNoIDRZ = scale(PctNoIDR), - PctPubAsstZ = scale(PctPubAsst), - PctWorkClassZ = scale(PctWorkClass), - PctFemHeadKidsZ = scale(PctFemHeadKids), - PctNotOwnerOccZ = scale(PctNotOwnerOcc), - PctNoPhoneZ = scale(PctNoPhone), - PctNComPlmbZ = scale(PctNComPlmb), - PctEducLTHSZ = scale(PctEducLTHS), - PctEducLTBchZ = scale(PctEducLTBch), - PctFamBelowPovZ = scale(PctFamBelowPov), - PctUnemplZ = scale(PctUnempl)) + mutate( + PctNoIDRZ = scale(PctNoIDR), + PctPubAsstZ = scale(PctPubAsst), + PctWorkClassZ = scale(PctWorkClass), + PctFemHeadKidsZ = scale(PctFemHeadKids), + PctNotOwnerOccZ = scale(PctNotOwnerOcc), + PctNoPhoneZ = scale(PctNoPhone), + PctNComPlmbZ = scale(PctNComPlmb), + PctEducLTHSZ = scale(PctEducLTHS), + PctEducLTBchZ = scale(PctEducLTBch), + PctFamBelowPovZ = scale(PctFamBelowPov), + PctUnemplZ = scale(PctUnempl) + ) ### Clean-up and format DCtracts2020pw <- DCtracts2020pw %>% - dplyr::select(GEOID, TotalPop, logMedHHInc, PctNoIDRZ, PctPubAsstZ, logMedHomeVal, PctWorkClassZ, - PctFemHeadKidsZ, PctNotOwnerOccZ, PctNoPhoneZ, PctNComPlmbZ, PctEducLTHSZ, - PctEducLTBchZ, PctFamBelowPovZ, PctUnemplZ) + select( + GEOID, + TotalPop, + logMedHHInc, + PctNoIDRZ, + PctPubAsstZ, + logMedHomeVal, + PctWorkClassZ, + PctFemHeadKidsZ, + PctNotOwnerOccZ, + PctNoPhoneZ, + PctNComPlmbZ, + PctEducLTHSZ, + PctEducLTBchZ, + PctFamBelowPovZ, + PctUnemplZ + ) -# Combine -DCtracts2020 <- dplyr::left_join(DCtracts2020messer, DCtracts2020pw, by = "GEOID") -DCtracts2020 <- DCtracts2020[ , c(1, 10, 2:9, 11:ncol(DCtracts2020))] # reorder so TotalPop is second feature (column) +# Combine +DCtracts2020 <- left_join(DCtracts2020messer, DCtracts2020pw, by = 'GEOID') +# reorder so TotalPop is second feature (column) +DCtracts2020 <- DCtracts2020[, c(1, 10, 2:9, 11:ncol(DCtracts2020))] -# Export -usethis::use_data(DCtracts2020, overwrite = TRUE) +# ---------------- # +# DATA EXPORTATION # +# ---------------- # + +use_data(DCtracts2020, overwrite = TRUE) + +# ----------------------------------------- END OF CODE ----------------------------------------- # diff --git a/dev/hex_ndi.R b/dev/hex_ndi.R index 192285a..58ee32d 100644 --- a/dev/hex_ndi.R +++ b/dev/hex_ndi.R @@ -1,72 +1,70 @@ -# ------------------------------------------------------------------------------ # -# Hexsticker for the GitHub Repository idblr/ndi -# ------------------------------------------------------------------------------ # +# ----------------------------------------------------------------------------------------------- # +# Hexagon sticker for the GitHub Repository idblr/ndi +# ----------------------------------------------------------------------------------------------- # # # Created by: Ian Buller, Ph.D., M.A. (GitHub: @idblr) -# Created on: July 23, 2022 +# Created on: 2022-07-23 # # Recently modified by: @idblr -# Recently modified on: August 04, 2022 +# Recently modified on: 2024-07-06 # # Notes: -# A) Uses the "hexSticker" package +# A) Uses the 'hexSticker' package # B) Subplot from an example computation of tract-level NDI (Messer) for Washington, D.C. (2020) # C) Hexsticker for the GitHub Repository https://github.com/idblr/ndi -# ------------------------------------------------------------------------------ # +# ----------------------------------------------------------------------------------------------- # -############ +# -------- # # PACKAGES # -############ +# -------- # -loadedPackages <- c("hexSticker", "ndi") +loadedPackages <- c('ggplot2', 'hexSticker', 'ndi', 'tidycensus', 'tigris') suppressMessages(invisible(lapply(loadedPackages, library, character.only = TRUE))) -############ +# -------- # # SETTINGS # -############ +# -------- # ## Access Key for census data download ### Obtain one at http://api.census.gov/data/key_signup.html -tidycensus::census_api_key("...") # INSERT YOUR OWN KEY FROM U.S. CENSUS API +census_api_key('...') # INSERT YOUR OWN KEY FROM U.S. CENSUS API -###################### +# ------------------ # # SUBPLOT GENERATION # -###################### +# ------------------ # # NDI 2020 -messer2020DC <- ndi::messer(state = "DC", year = 2020, imp = TRUE) +messer2020DC <- messer(state = 'DC', year = 2020, imp = TRUE) # Tracts 2020 -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join -DC2020messer <- merge(tract2020DC, messer2020DC$ndi, by = "GEOID") +DC2020messer <- merge(tract2020DC, messer2020DC$ndi, by = 'GEOID') # Plot of tract-level NDI (Messer) for Washington, D.C. (2020) -dcp <- ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020messer, - ggplot2::aes(fill = NDI), - color = NA, - show.legend = FALSE) + - ggplot2::theme_void() + - ggplot2::theme(axis.text = ggplot2::element_blank()) + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "", - caption = "")+ - ggplot2::ggtitle("", subtitle = "") +dcp <- ggplot() + + geom_sf(data = DC2020messer, aes(fill = NDI), color = NA, show.legend = FALSE) + + theme_void() + + theme(axis.text = element_blank()) + + scale_fill_viridis_c() + + labs(fill = '', caption = '')+ + ggtitle('', subtitle = '') -##################### -# CREATE HEXSTICKER # -##################### +# ---------------------- # +# CREATE HEXAGON STICKER # +# ---------------------- # -s <- hexSticker::sticker(subplot = dcp, - package = "ndi", - p_size = 75, p_x = 0.55, p_y = 0.75, p_color = "#FDE724", # title - s_x = 1.15, s_y = 1.05, s_width = 2.1, s_height = 2.1, # symbol - h_fill = "#695488", # inside - h_color = "#440C54", # outline - dpi = 1000, # resolution - filename = "man/figures/ndi.png", - white_around_sticker = F) +s <-sticker( + subplot = dcp, + package = 'ndi', + p_size = 75, p_x = 0.55, p_y = 0.75, p_color = '#FDE724', # title + s_x = 1.15, s_y = 1.05, s_width = 2.1, s_height = 2.1, # symbol + h_fill = '#695488', # inside + h_color = '#440C54', # outline + dpi = 1000, # resolution + filename = file.path('man', 'figures', 'ndi.png'), + white_around_sticker = FALSE +) -# -------------------------------- END OF CODE --------------------------------- # +# ----------------------------------------- END OF CODE ----------------------------------------- # diff --git a/inst/CITATION b/inst/CITATION index 8a32f7c..76fb190 100755 --- a/inst/CITATION +++ b/inst/CITATION @@ -1,385 +1,421 @@ -bibentry(bibtype = "manual", - title = "ndi: Neighborhood Deprivation Indices", - author = c(as.person("Ian D. Buller")), - publisher = "The Comprehensive R Archive Network", - year = "2024", - number = "0.1.5", - doi = "10.5281/zenodo.6989030", - url = "https://cran.r-project.org/package=ndi", +bibentry(bibtype = 'manual', + title = 'ndi: Neighborhood Deprivation Indices', + author = c(as.person('Ian D. Buller')), + publisher = 'The Comprehensive R Archive Network', + year = '2024', + number = '0.1.6.9000.', + doi = '10.5281/zenodo.6989030', + url = 'https://cran.r-project.org/package=ndi', textVersion = - paste("Ian D. Buller (2024).", - "ndi: Neighborhood Deprivation Indices.", - "The Comprehensive R Archive Network.", - "v0.1.5.", - "DOI:10.5281/zenodo.6989030", - "Accessed by: https://cran.r-project.org/package=ndi"), + paste('Ian D. Buller (2024).', + 'ndi: Neighborhood Deprivation Indices.', + 'The Comprehensive R Archive Network.', + 'v0.1.6.9000.', + 'DOI:10.5281/zenodo.6989030', + 'Accessed by: https://cran.r-project.org/package=ndi'), - header = "To cite ndi in publications, please use the following and include the version number and DOI:" + header = 'To cite ndi in publications, please use the following and include the version number and DOI:' ) -bibentry(bibtype = "Article", - title = "A spatial measure of neighborhood level racial isolation applied to low birthweight, preterm birth, and birthweight in North Carolina", - author = c(as.person("Rebecca Anthopolos"), - as.person("Sherman A. James"), - as.person("Alan E. Gelfand"), - as.person("Marie Lynn Miranda")), - journal = "Spatial and Spatio-temporal Epidemiology", - year = "2011", - volume = "2", - number = "4", - pages = "235--246", - doi = "10.1016/j.sste.2011.06.002", +bibentry(bibtype = 'Article', + title = 'A spatial measure of neighborhood level racial isolation applied to low birthweight, preterm birth, and birthweight in North Carolina', + author = c(as.person('Rebecca Anthopolos'), + as.person('Sherman A. James'), + as.person('Alan E. Gelfand'), + as.person('Marie Lynn Miranda')), + journal = 'Spatial and Spatio-temporal Epidemiology', + year = '2011', + volume = '2', + number = '4', + pages = '235--246', + doi = '10.1016/j.sste.2011.06.002', textVersion = - paste("Rebecca Anthopolos, Sherman A. James, Alan E. Gelfand, Marie Lynn Miranda (2011).", - "A spatial measure of neighborhood level racial isolation applied to low birthweight, preterm birth, and birthweight in North Carolina.", - "Spatial and Spatio-temporal Epidemiology, 2(4), 235-246.", - "DOI:10.1016/j.sste.2011.06.002"), + paste('Rebecca Anthopolos, Sherman A. James, Alan E. Gelfand, Marie Lynn Miranda (2011).', + 'A spatial measure of neighborhood level racial isolation applied to low birthweight, preterm birth, and birthweight in North Carolina.', + 'Spatial and Spatio-temporal Epidemiology, 2(4), 235-246.', + 'DOI:10.1016/j.sste.2011.06.002'), - header = "If you computed RI (Anthopolos) values, please also cite:" + header = 'If you computed RI (Anthopolos) values, please also cite:' ) -bibentry(bibtype = "Article", - title = "On the measurement of inequality", - author = c(as.person("Anthony B. Atkinson")), - journal = "Journal of economic theory", - year = "1970", - volume = "2", - number = "3", - pages = "244--263", - doi = "10.1016/0022-0531(70)90039-6", +bibentry(bibtype = 'Article', + title = 'On the measurement of inequality', + author = c(as.person('Anthony B. Atkinson')), + journal = 'Journal of economic theory', + year = '1970', + volume = '2', + number = '3', + pages = '244--263', + doi = '10.1016/0022-0531(70)90039-6', textVersion = - paste("Anthony B. Atkinson (1970).", - "On the measurement of inequality.", - "Journal of economic theory, 2(3), 244-263.", - "DOI:10.1016/0022-0531(70)90039-6"), + paste('Anthony B. Atkinson (1970).', + 'On the measurement of inequality.', + 'Journal of economic theory, 2(3), 244-263.', + 'DOI:10.1016/0022-0531(70)90039-6'), - header = "If you computed AI (Atkinson) values, please also cite:" + header = 'If you computed AI (Atkinson) values, please also cite:' ) -bibentry(bibtype = "Book", - title = "The Social Areas of Los Angeles: Analysis and Typology", - author = c(as.person("Eshref Shevky"), - as.person("Marilyn Williams")), - year = "1949", - edition = "1st edition", - city = "Los Angeles", - publisher = "John Randolph Haynes and Dora Haynes Foundation", - isbn = "978-0-837-15637-8", +bibentry(bibtype = 'Book', + title = 'The Social Areas of Los Angeles: Analysis and Typology', + author = c(as.person('Eshref Shevky'), + as.person('Marilyn Williams')), + year = '1949', + edition = '1st edition', + city = 'Los Angeles', + publisher = 'John Randolph Haynes and Dora Haynes Foundation', + isbn = '978-0-837-15637-8', textVersion = - paste("Eshref Shevky, Marilyn Williams (1949).", - "The Social Areas of Los Angeles: Analysis and Typology.", - "1st Ed.", - "Los Angeles:John Randolph Haynes and Dora Haynes Foundation.", - "ISBN-13:978-0-837-15637-8"), + paste('Eshref Shevky, Marilyn Williams (1949).', + 'The Social Areas of Los Angeles: Analysis and Typology.', + '1st Ed.', + 'Los Angeles:John Randolph Haynes and Dora Haynes Foundation.', + 'ISBN-13:978-0-837-15637-8'), - header = "If you computed II (Bell) values, please also cite (1):" + header = 'If you computed II (Bell) values, please also cite (1):' ) -bibentry(bibtype = "Article", - title = "A Probability Model for the Measurement of Ecological Segregation", - author = c(as.person("Wendell Bell")), - journal = "Social Forces", - year = "1954", - volume = "32", - issue = "4", - pages = "357--364", - doi = "10.2307/2574118", +bibentry(bibtype = 'Article', + title = 'A Probability Model for the Measurement of Ecological Segregation', + author = c(as.person('Wendell Bell')), + journal = 'Social Forces', + year = '1954', + volume = '32', + issue = '4', + pages = '357--364', + doi = '10.2307/2574118', textVersion = - paste("Wendell Bell (1954).", - "A Probability Model for the Measurement of Ecological Segregation.", - "Social Forces, 32(4), 357-364.", - "DOI:10.2307/2574118"), + paste('Wendell Bell (1954).', + 'A Probability Model for the Measurement of Ecological Segregation.', + 'Social Forces, 32(4), 357-364.', + 'DOI:10.2307/2574118'), - header = "And (2):" + header = 'And (2):' ) -bibentry(bibtype = "Article", - title = "Measures Matter: The Local Exposure/Isolation (LEx/Is) Metrics and Relationships between Local-Level Segregation and Breast Cancer Survival", - author = c(as.person("Amin Bemanian"), - as.person("Kirsten M.M. Beyer")), - journal = "Cancer Epidemiology, Biomarkers & Prevention", - year = "2017", - volume = "26", - issue = "4", - pages = "516--524", - doi = "10.1158/1055-9965.EPI-16-0926", +bibentry(bibtype = 'Article', + title = 'Measures Matter: The Local Exposure/Isolation (LEx/Is) Metrics and Relationships between Local-Level Segregation and Breast Cancer Survival', + author = c(as.person('Amin Bemanian'), + as.person('Kirsten M.M. Beyer')), + journal = 'Cancer Epidemiology, Biomarkers & Prevention', + year = '2017', + volume = '26', + issue = '4', + pages = '516--524', + doi = '10.1158/1055-9965.EPI-16-0926', textVersion = - paste("Amin Bemanian, Kirsten M.M. Beyer (2017).", - "Measures Matter: The Local Exposure/Isolation (LEx/Is) Metrics and Relationships between Local-Level Segregation and Breast Cancer Survival.", - "Cancer Epidemiology, Biomarkers & Prevention, 26(4), 516-524.", - "DOI:10.1158/1055-9965.EPI-16-0926"), + paste('Amin Bemanian, Kirsten M.M. Beyer (2017).', + 'Measures Matter: The Local Exposure/Isolation (LEx/Is) Metrics and Relationships between Local-Level Segregation and Breast Cancer Survival.', + 'Cancer Epidemiology, Biomarkers & Prevention, 26(4), 516-524.', + 'DOI:10.1158/1055-9965.EPI-16-0926'), - header = "If you computed LEx/Is (Bemanian & Beyer) values, please also cite:" + header = 'If you computed LEx/Is (Bemanian & Beyer) values, please also cite:' ) -bibentry(bibtype = "Article", - title = "Assessing Disparity Using Measures of Racial and Educational Isolation", - author = c(as.person("Mercedes A. Bravo"), - as.person("Man Chong Leong"), - as.person("Alan E. Gelfand"), - as.person("Marie Lynn Miranda")), - journal = "International Journal of Environmental Research and Public Health", - year = "2021", - volume = "18", - number = "17", - pages = "9384", - doi = "10.3390/ijerph18179384", +bibentry(bibtype = 'Article', + title = 'Assessing Disparity Using Measures of Racial and Educational Isolation', + author = c(as.person('Mercedes A. Bravo'), + as.person('Man Chong Leong'), + as.person('Alan E. Gelfand'), + as.person('Marie Lynn Miranda')), + journal = 'International Journal of Environmental Research and Public Health', + year = '2021', + volume = '18', + number = '17', + pages = '9384', + doi = '10.3390/ijerph18179384', textVersion = - paste("Mercedes A. Bravo, Man Chong Leong, Alan E. Gelfand, Marie Lynn Miranda (2021).", - "Assessing Disparity Using Measures of Racial and Educational Isolation.", - "International Journal of Environmental Research and Public Health, 18(17), 9384.", - "DOI:10.3390/ijerph18179384"), + paste('Mercedes A. Bravo, Man Chong Leong, Alan E. Gelfand, Marie Lynn Miranda (2021).', + 'Assessing Disparity Using Measures of Racial and Educational Isolation.', + 'International Journal of Environmental Research and Public Health, 18(17), 9384.', + 'DOI:10.3390/ijerph18179384'), - header = "If you computed EI (Bravo) values, please also cite:" + header = 'If you computed EI (Bravo) values, please also cite:' ) -bibentry(bibtype = "Article", - title = "A Methodological Analysis of Segregation Indexes", - author = c(as.person("Otis D. Duncan"), - as.person("Beverly Duncan")), - journal = "American Sociological Review", - year = "1955", - volume = "20", - number = "2", - pages = "210--217", - doi = "10.2307/2088328", +bibentry(bibtype = 'Article', + title = 'A Methodological Analysis of Segregation Indexes', + author = c(as.person('Otis D. Duncan'), + as.person('Beverly Duncan')), + journal = 'American Sociological Review', + year = '1955', + volume = '20', + number = '2', + pages = '210--217', + doi = '10.2307/2088328', textVersion = - paste("Otis D. Duncan, Beverly Duncan (1955).", - "A Methodological Analysis of Segregation Indexes.", - "American Sociological Review, 20(2), 210-217.", - "DOI:10.2307/2088328"), + paste('Otis D. Duncan, Beverly Duncan (1955).', + 'A Methodological Analysis of Segregation Indexes.', + 'American Sociological Review, 20(2), 210-217.', + 'DOI:10.2307/2088328'), - header = "If you computed DI (Duncan & Duncan) values, please also cite:" + header = 'If you computed DI (Duncan & Duncan) values, please also cite:' ) -bibentry(bibtype = "Article", - title = "Measurement of Inequality of Incomes", - author = c(as.person("Corrado Gini")), - journal = "The Economic Journal", - year = "1921", - volume = "31", - number = "121", - pages = "124--126", - doi = "10.2307/2223319", +bibentry(bibtype = 'Article', + title = 'Measurement of Inequality of Incomes', + author = c(as.person('Corrado Gini')), + journal = 'The Economic Journal', + year = '1921', + volume = '31', + number = '121', + pages = '124--126', + doi = '10.2307/2223319', textVersion = - paste("Corrado Gini (1921).", - "Measurement of Inequality of Incomes.", - "The Economic Journal, 31(121), 124-126.", - "DOI:10.2307/2223319"), + paste('Corrado Gini (1921).', + 'Measurement of Inequality of Incomes.', + 'The Economic Journal, 31(121), 124-126.', + 'DOI:10.2307/2223319'), - header = "If you retrieved Gini Index values, please also cite:" + header = 'If you retrieved Gini Index values, please also cite:' ) -bibentry(bibtype = "Article", - title = "Spatial social polarisation: using the Index of Concentration at the Extremes jointly for income and race/ethnicity to analyse risk of hypertension", - author = c(as.person("Justin M. Feldman"), - as.person("Pamela D. Waterman"), - as.person("Brent A. Coull"), - as.person("Nancy Krieger")), - journal = "Journal of Epidemiology and Community Health", - year = "2015", - volume = "69", - issue = "12", - pages = "1199--207", - doi = "10.1136/jech-2015-205728", +bibentry(bibtype = 'Article', + title = 'Spatial social polarisation: using the Index of Concentration at the Extremes jointly for income and race/ethnicity to analyse risk of hypertension', + author = c(as.person('Justin M. Feldman'), + as.person('Pamela D. Waterman'), + as.person('Brent A. Coull'), + as.person('Nancy Krieger')), + journal = 'Journal of Epidemiology and Community Health', + year = '2015', + volume = '69', + issue = '12', + pages = '1199--207', + doi = '10.1136/jech-2015-205728', textVersion = - paste("Justin M. Feldman, Pamela D. Waterman, Brent A. Coull, Nancy Krieger (2015).", - "Spatial social polarisation: using the Index of Concentration at the Extremes jointly for income and race/ethnicity to analyse risk of hypertension.", - "Journal of Epidemiology and Community Health, 69(12), 1199-207.", - "DOI:10.1136/jech-2015-205728"), + paste('Justin M. Feldman, Pamela D. Waterman, Brent A. Coull, Nancy Krieger (2015).', + 'Spatial social polarisation: using the Index of Concentration at the Extremes jointly for income and race/ethnicity to analyse risk of hypertension.', + 'Journal of Epidemiology and Community Health, 69(12), 1199-207.', + 'DOI:10.1136/jech-2015-205728'), - header = "If you computed ICE (Krieger) values, please also cite (1):" + header = 'If you computed ICE (Krieger) values, please also cite (1):' ) -bibentry(bibtype = "Article", - title = "Public Health Monitoring of Privilege and Deprivation With the Index of Concentration at the Extremes", - author = c(as.person("Nancy Krieger"), - as.person("Pamela D. Waterman"), - as.person("Jasmina Spasojevic"), - as.person("Wenhui Li"), - as.person("Wenhui Li"), - as.person("Gretchen Van Wye")), - journal = "American Journal of Public Health ", - year = "2016", - volume = "106", - issue = "2", - pages = "256--263", - doi = "10.2105/AJPH.2015.302955", +bibentry(bibtype = 'Article', + title = 'Public Health Monitoring of Privilege and Deprivation With the Index of Concentration at the Extremes', + author = c(as.person('Nancy Krieger'), + as.person('Pamela D. Waterman'), + as.person('Jasmina Spasojevic'), + as.person('Wenhui Li'), + as.person('Wenhui Li'), + as.person('Gretchen Van Wye')), + journal = 'American Journal of Public Health ', + year = '2016', + volume = '106', + issue = '2', + pages = '256--263', + doi = '10.2105/AJPH.2015.302955', textVersion = - paste("Beth A. Slotman, David G Stinchcomb, Tiffany M. Powell-Wiley, Danielle M. Ostendorf, Brian E. Saelens, Amy A. Gorin, Shannon N. Zenk, David Berrigan (2016).", - "Public Health Monitoring of Privilege and Deprivation With the Index of Concentration at the Extremes.", - "American Journal of Public Health, 106(2), 256-263.", - "DOI:10.2105/AJPH.2015.302955"), + paste('Beth A. Slotman, David G Stinchcomb, Tiffany M. Powell-Wiley, Danielle M. Ostendorf, Brian E. Saelens, Amy A. Gorin, Shannon N. Zenk, David Berrigan (2016).', + 'Public Health Monitoring of Privilege and Deprivation With the Index of Concentration at the Extremes.', + 'American Journal of Public Health, 106(2), 256-263.', + 'DOI:10.2105/AJPH.2015.302955'), - header = "And (2):" + header = 'And (2):' ) -bibentry(bibtype = "Article", - title = "The development of a standardized neighborhood deprivation index", - author = c(as.person("Lynne C. Messer"), - as.person("Barbara A. Laraia"), - as.person("Jay S. Kaufman"), - as.person("Janet Eyster"), - as.person("Claudia Holzman"), - as.person("Jennifer Culhane"), - as.person("Irma Elo"), - as.person("Jessica Burke"), +bibentry(bibtype = 'Article', + title = 'The development of a standardized neighborhood deprivation index', + author = c(as.person('Lynne C. Messer'), + as.person('Barbara A. Laraia'), + as.person('Jay S. Kaufman'), + as.person('Janet Eyster'), + as.person('Claudia Holzman'), + as.person('Jennifer Culhane'), + as.person('Irma Elo'), + as.person('Jessica Burke'), as.person("Patricia O'Campo")), - journal = "Journal of Urban Health", - year = "2006", - volume = "83", - number = "6", - pages = "1041--1062", - doi = "10.1007/s11524-006-9094-x", + journal = 'Journal of Urban Health', + year = '2006', + volume = '83', + number = '6', + pages = '1041--1062', + doi = '10.1007/s11524-006-9094-x', textVersion = paste("Lynne C. Messer, Barbara A. Laraia, Jay S. Kaufman, Janet Eyster, Claudia Holzman, Jennifer Culhane, Irma Elo, Jessica Burke, Patricia O'Campo (2006).", - "The development of a standardized neighborhood deprivation index.", - "Journal of Urban Health, 83(6), 1041-1062.", - "DOI:10.1007/s11524-006-9094-x"), + 'The development of a standardized neighborhood deprivation index.', + 'Journal of Urban Health, 83(6), 1041-1062.', + 'DOI:10.1007/s11524-006-9094-x'), - header = "If you computed NDI (Messer) values, please also cite:" + header = 'If you computed NDI (Messer) values, please also cite:' ) -bibentry(bibtype = "Article", - title = "Geospatial analysis of neighborhood deprivation index (NDI) for the United States by county", - author = c(as.person("Marcus A. Andrews"), - as.person("Kosuke Tomura"), - as.person("Sophie E. Claudel"), - as.person("Samantha Xu"), - as.person("Joniqua N. Ceasar"), - as.person("Billy S. Collins"), - as.person("Steven Langerman"), - as.person("Valerie M. Mitchell"), - as.person("Yvonne Baumer"), - as.person("Tiffany M. Powell-Wiley")), - journal = "Journal of Maps", - year = "2020", - volume = "16", - issue = "1", - pages = "101--112", - doi = "10.1080/17445647.2020.1750066", +bibentry(bibtype = 'Article', + title = 'Geospatial analysis of neighborhood deprivation index (NDI) for the United States by county', + author = c(as.person('Marcus A. Andrews'), + as.person('Kosuke Tomura'), + as.person('Sophie E. Claudel'), + as.person('Samantha Xu'), + as.person('Joniqua N. Ceasar'), + as.person('Billy S. Collins'), + as.person('Steven Langerman'), + as.person('Valerie M. Mitchell'), + as.person('Yvonne Baumer'), + as.person('Tiffany M. Powell-Wiley')), + journal = 'Journal of Maps', + year = '2020', + volume = '16', + issue = '1', + pages = '101--112', + doi = '10.1080/17445647.2020.1750066', textVersion = - paste("Marcus A. Andrews, Kosuke Tomura, Sophie E. Claudel, Samantha Xu, Joniqua N. Ceasar, Billy S. Collins, Steven Langerman, Valerie M. Mitchell, Yvonne Baumer, Tiffany M. Powell-Wiley (2022).", - "Geospatial analysis of neighborhood deprivation index (NDI) for the United States by county.", - "Journal of Maps, 16(1), 101-112.", - "DOI:10.1080/17445647.2020.1750066"), + paste('Marcus A. Andrews, Kosuke Tomura, Sophie E. Claudel, Samantha Xu, Joniqua N. Ceasar, Billy S. Collins, Steven Langerman, Valerie M. Mitchell, Yvonne Baumer, Tiffany M. Powell-Wiley (2022).', + 'Geospatial analysis of neighborhood deprivation index (NDI) for the United States by county.', + 'Journal of Maps, 16(1), 101-112.', + 'DOI:10.1080/17445647.2020.1750066'), - header = "If you computed NDI (Powell-Wiley) values, please also cite (1):" + header = 'If you computed NDI (Powell-Wiley) values, please also cite (1):' ) -bibentry(bibtype = "Article", - title = "Environmental data and methods from the Accumulating Data to Optimally Predict Obesity Treatment (ADOPT) core measures environmental working group", - author = c(as.person("Beth A. Slotman"), - as.person("David G Stinchcomb"), - as.person("Tiffany M. Powell-Wiley"), - as.person("Danielle M. Ostendorf"), - as.person("Brian E. Saelens"), - as.person("Amy A. Gorin"), - as.person("Shannon N. Zenk"), - as.person("David Berrigan")), - journal = "Data in Brief", - year = "2022", - volume = "41", - pages = "108002", - doi = "10.1016/j.dib.2022.108002", +bibentry(bibtype = 'Article', + title = 'Environmental data and methods from the Accumulating Data to Optimally Predict Obesity Treatment (ADOPT) core measures environmental working group', + author = c(as.person('Beth A. Slotman'), + as.person('David G Stinchcomb'), + as.person('Tiffany M. Powell-Wiley'), + as.person('Danielle M. Ostendorf'), + as.person('Brian E. Saelens'), + as.person('Amy A. Gorin'), + as.person('Shannon N. Zenk'), + as.person('David Berrigan')), + journal = 'Data in Brief', + year = '2022', + volume = '41', + pages = '108002', + doi = '10.1016/j.dib.2022.108002', textVersion = - paste("Beth A. Slotman, David G Stinchcomb, Tiffany M. Powell-Wiley, Danielle M. Ostendorf, Brian E. Saelens, Amy A. Gorin, Shannon N. Zenk, David Berrigan (2022).", - "Environmental data and methods from the Accumulating Data to Optimally Predict Obesity Treatment (ADOPT) core measures environmental working group.", - "Data in Brief, 41, 108002.", - "DOI:10.1016/j.dib.2022.108002"), + paste('Beth A. Slotman, David G Stinchcomb, Tiffany M. Powell-Wiley, Danielle M. Ostendorf, Brian E. Saelens, Amy A. Gorin, Shannon N. Zenk, David Berrigan (2022).', + 'Environmental data and methods from the Accumulating Data to Optimally Predict Obesity Treatment (ADOPT) core measures environmental working group.', + 'Data in Brief, 41, 108002.', + 'DOI:10.1016/j.dib.2022.108002'), - header = "And (2):" + header = 'And (2):' ) -bibentry(bibtype = "Article", - title = "Social Structure and Anomie", - author = c(as.person("Robert K. Merton")), - journal = "American Sociological Review", - year = "1938", - volume = "3", - number = "5", - pages = "672--682", - doi = "10.2307/2084686 ", +bibentry(bibtype = 'Article', + title = 'Social Structure and Anomie', + author = c(as.person('Robert K. Merton')), + journal = 'American Sociological Review', + year = '1938', + volume = '3', + number = '5', + pages = '672--682', + doi = '10.2307/2084686 ', textVersion = - paste("Robert K. Merton (1938).", - "Social Structure and Anomie.", - "American Sociological Review, 3(5), 672-682.", - "DOI:10.2307/2084686 "), + paste('Robert K. Merton (1938).', + 'Social Structure and Anomie.', + 'American Sociological Review, 3(5), 672-682.', + 'DOI:10.2307/2084686 '), - header = "If you computed LQ (Sudano) values, please also cite (1):" + header = 'If you computed LQ (Sudano) values, please also cite (1):' ) -bibentry(bibtype = "Article", - title = "Neighborhood racial residential segregation and changes in health or death among older adults", - author = c(as.person("Joseph J. Sudano"), - as.person("Adam Perzynski"), - as.person("David W. Wong"), - as.person("Natalie Colabianchi"), - as.person("David Litaker")), - journal = "Health & Place", - year = "2013", - volume = "19", - pages = "80--88", - doi = "10.1016/j.healthplace.2012.09.015", +bibentry(bibtype = 'Article', + title = 'Neighborhood racial residential segregation and changes in health or death among older adults', + author = c(as.person('Joseph J. Sudano'), + as.person('Adam Perzynski'), + as.person('David W. Wong'), + as.person('Natalie Colabianchi'), + as.person('David Litaker')), + journal = 'Health & Place', + year = '2013', + volume = '19', + pages = '80--88', + doi = '10.1016/j.healthplace.2012.09.015', textVersion = - paste("Joseph J. Sudano, Adam Perzynski, David W. Wong, Natalie Colabianchi, David Litaker (2013).", - "Neighborhood racial residential segregation and changes in health or death among older adults.", - "Health & Place, 19, 80-88.", - "DOI:10.1016/j.healthplace.2012.09.015"), + paste('Joseph J. Sudano, Adam Perzynski, David W. Wong, Natalie Colabianchi, David Litaker (2013).', + 'Neighborhood racial residential segregation and changes in health or death among older adults.', + 'Health & Place, 19, 80-88.', + 'DOI:10.1016/j.healthplace.2012.09.015'), - header = "And (2):" + header = 'And (2):' ) -bibentry(bibtype = "Article", - title = "A Probability Model for the Measurement of Ecological Segregation", - author = c(as.person("Wendell Bell")), - journal = "Social Forces", - year = "1954", - volume = "32", - issue = "4", - pages = "357--364", - doi = "10.2307/2574118", +bibentry(bibtype = 'Article', + title = 'A Probability Model for the Measurement of Ecological Segregation', + author = c(as.person('Wendell Bell')), + journal = 'Social Forces', + year = '1954', + volume = '32', + issue = '4', + pages = '357--364', + doi = '10.2307/2574118', textVersion = - paste("Wendell Bell (1954).", - "A Probability Model for the Measurement of Ecological Segregation.", - "Social Forces, 32(4), 357-364.", - "DOI:10.2307/2574118"), + paste('Wendell Bell (1954).', + 'A Probability Model for the Measurement of Ecological Segregation.', + 'Social Forces, 32(4), 357-364.', + 'DOI:10.2307/2574118'), - header = "If you computed V (White) values, please also cite (1):" + header = 'If you computed V (White) values, please also cite (1):' ) -bibentry(bibtype = "Article", - title = "Segregation and Diversity Measures in Population Distribution", - author = c(as.person("Michael J. White")), - journal = "Population Index", - year = "1986", - volume = "52", - issue = "2", - pages = "198--221", - doi = "10.2307/3644339", +bibentry(bibtype = 'Article', + title = 'Segregation and Diversity Measures in Population Distribution', + author = c(as.person('Michael J. White')), + journal = 'Population Index', + year = '1986', + volume = '52', + issue = '2', + pages = '198--221', + doi = '10.2307/3644339', textVersion = - paste("Michael J. White (1986).", - "Segregation and Diversity Measures in Population Distribution.", - "Population Index, 52(2), 198-221.", - "DOI:10.2307/3644339"), + paste('Michael J. White (1986).', + 'Segregation and Diversity Measures in Population Distribution.', + 'Population Index, 52(2), 198-221.', + 'DOI:10.2307/3644339'), - header = "And (2):" + header = 'And (2):' +) + +bibentry(bibtype = 'Article', + title = 'Interstate Redistribution of Population, 1850-1940', + author = c(as.person('Edgar M. Hoover')), + journal = 'Journal of Economic History', + year = '1941', + volume = '1', + pages = '199--205', + doi = '10.2307/2223319', + + textVersion = + paste('Edgar M. Hoover (1941).', + 'Interstate Redistribution of Population, 1850-1940.', + 'Journal of Economic History, 1, 199-205.', + 'DOI:10.2307/2223319'), + + header = 'If you computed DEL (Hoover) values, please also cite (1):' +) + +bibentry(bibtype = 'Book', + title = 'Statistical Geography: Problems in Analyzing Area Data', + author = c(as.person('Otis D. Duncan'), + as.person('Ray P. Cuzzort'), + as.person('Beverly Duncan')), + year = '1961', + publisher = 'Free Press', + lc = '60007089', + + textVersion = + paste('Otis D. Duncan, Ray P. Cuzzort, & Beverly Duncan (1961).', + 'Statistical Geography: Problems in Analyzing Area Data.', + 'Free Press', + 'LC:60007089'), + + header = 'And (2):' ) diff --git a/man/anthopolos.Rd b/man/anthopolos.Rd index 26043dd..98d55e7 100644 --- a/man/anthopolos.Rd +++ b/man/anthopolos.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/anthopolos.R \name{anthopolos} \alias{anthopolos} -\title{Racial Isolation Index based on Anthopolos \emph{et al.} (2011)} +\title{Racial Isolation Index based on Anthopolos et al. (2011)} \usage{ anthopolos(geo = "tract", year = 2020, subgroup, quiet = FALSE, ...) } \arguments{ -\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}.} +\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -29,30 +29,30 @@ An object of class 'list'. This is a named list with the following components: Compute the spatial Racial Isolation Index (Anthopolos) of selected subgroup(s). } \details{ -This function will compute the spatial Racial Isolation Index (RI) of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Anthopolos \emph{et al.} (2011) \doi{10.1016/j.sste.2011.06.002} who originally designed the metric for the racial isolation of non-Hispanic Black individuals. This function provides the computation of RI for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). +This function will compute the spatial Racial Isolation Index (RI) of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Anthopolos et al. (2011) \doi{10.1016/j.sste.2011.06.002} who originally designed the metric for the racial isolation of non-Hispanic Black individuals. This function provides the computation of RI for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the geospatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: \itemize{ -\item \strong{B03002_002}: not Hispanic or Latino \code{"NHoL"} -\item \strong{B03002_003}: not Hispanic or Latino, white alone\code{"NHoLW"} -\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{"NHoLA"} -\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -\item \strong{B03002_012}: Hispanic or Latino \code{"HoL"} -\item \strong{B03002_013}: Hispanic or Latino, white alone \code{"HoLW"} -\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{"HoLB"} -\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{"HoLA"} -\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +\item \strong{B03002_002}: not Hispanic or Latino \code{'NHoL'} +\item \strong{B03002_003}: not Hispanic or Latino, white alone\code{'NHoLW'} +\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{'NHoLA'} +\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +\item \strong{B03002_012}: Hispanic or Latino \code{'HoL'} +\item \strong{B03002_013}: Hispanic or Latino, white alone \code{'HoLW'} +\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{'HoLB'} +\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{'HoLA'} +\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} } Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. NOTE: Current version does not correct for edge effects (e.g., census geographies along the specified spatial extent border, coastline, or U.S.-Mexico / U.S.-Canada border) may have few neighboring census geographies, and RI values in these census geographies may be unstable. A stop-gap solution for the former source of edge effect is to compute the RI for neighboring census geographies (i.e., the states bordering a study area of interest) and then use the estimates of the study area of interest. @@ -62,15 +62,23 @@ A census geography (and its neighbors) that has nearly all of its population who \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Tract-level metric (2020) - anthopolos(geo = "tract", state = "GA", - year = 2020, subgroup = c("NHoLB", "HoLB")) - + anthopolos( + geo = 'tract', + state = 'GA', + year = 2020, + subgroup = c('NHoLB', 'HoLB') + ) + # County-level metric (2020) - anthopolos(geo = "county", state = "GA", - year = 2020, subgroup = c("NHoLB", "HoLB")) - + anthopolos( + geo = 'county', + state = 'GA', + year = 2020, + subgroup = c('NHoLB', 'HoLB') + ) + } } diff --git a/man/atkinson.Rd b/man/atkinson.Rd index 6950807..9d1f376 100644 --- a/man/atkinson.Rd +++ b/man/atkinson.Rd @@ -16,9 +16,9 @@ atkinson( ) } \arguments{ -\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}.} +\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}.} -\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}.} +\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -47,47 +47,52 @@ Compute the aspatial Atkinson Index of income or selected racial/ethnic subgroup \details{ This function will compute the aspatial Atkinson Index (AI) of income or selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Atkinson (1970) \doi{10.1016/0022-0531(70)90039-6}. This function provides the computation of AI for median household income and any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). -The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. When \code{subgroup = "MedHHInc"}, the metric will be computed for median household income ("B19013_001"). The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: +The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. When \code{subgroup = 'MedHHInc'}, the metric will be computed for median household income ('B19013_001'). The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: \itemize{ -\item \strong{B03002_002}: not Hispanic or Latino \code{"NHoL"} -\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{"NHoLW"} -\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{"NHoLA"} -\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -\item \strong{B03002_012}: Hispanic or Latino \code{"HoL"} -\item \strong{B03002_013}: Hispanic or Latino, white alone \code{"HoLW"} -\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{"HoLB"} -\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{"HoLA"} -\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +\item \strong{B03002_002}: not Hispanic or Latino \code{'NHoL'} +\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{'NHoLW'} +\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{'NHoLA'} +\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +\item \strong{B03002_012}: Hispanic or Latino \code{'HoL'} +\item \strong{B03002_013}: Hispanic or Latino, white alone \code{'HoLW'} +\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{'HoLB'} +\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{'HoLA'} +\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} } Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. AI is a measure of the evenness of residential inequality (e.g., racial/ethnic segregation) when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. The AI metric can range in value from 0 to 1 with smaller values indicating lower levels of inequality (e.g., less segregation). -The \code{epsilon} argument that determines how to weight the increments to inequality contributed by different proportions of the Lorenz curve. A user must explicitly decide how heavily to weight smaller geographical units at different points on the Lorenz curve (i.e., whether the index should take greater account of differences among areas of over- or under-representation). The \code{epsilon} argument must have values between 0 and 1.0. For \code{0 <= epsilon < 0.5} or less "inequality-averse," smaller geographical units with a subgroup proportion smaller than the subgroup proportion of the larger geographical unit contribute more to inequality ("over-representation"). For \code{0.5 < epsilon <= 1.0} or more "inequality-averse," smaller geographical units with a subgroup proportion larger than the subgroup proportion of the larger geographical unit contribute more to inequality ("under-representation"). If \code{epsilon = 0.5} (the default), units of over- and under-representation contribute equally to the index. See Section 2.3 of Saint-Jacques \emph{et al.} (2020) \doi{10.48550/arXiv.2002.05819} for one method to select \code{epsilon}. +The \code{epsilon} argument that determines how to weight the increments to inequality contributed by different proportions of the Lorenz curve. A user must explicitly decide how heavily to weight smaller geographical units at different points on the Lorenz curve (i.e., whether the index should take greater account of differences among areas of over- or under-representation). The \code{epsilon} argument must have values between 0 and 1.0. For \code{0 <= epsilon < 0.5} or less 'inequality-averse,' smaller geographical units with a subgroup proportion smaller than the subgroup proportion of the larger geographical unit contribute more to inequality ('over-representation'). For \code{0.5 < epsilon <= 1.0} or more 'inequality-averse,' smaller geographical units with a subgroup proportion larger than the subgroup proportion of the larger geographical unit contribute more to inequality ('under-representation'). If \code{epsilon = 0.5} (the default), units of over- and under-representation contribute equally to the index. See Section 2.3 of Saint-Jacques et al. (2020) \doi{10.48550/arXiv.2002.05819} for one method to select \code{epsilon}. -Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the AI value returned is NA. +Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the AI value returned is NA. } \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Atkinson Index of non-Hispanic Black populations ## of census tracts within Georgia, U.S.A., counties (2020) - atkinson(geo_large = "county", geo_small = "tract", state = "GA", - year = 2020, subgroup = "NHoLB") - + atkinson( + geo_large = 'county', + geo_small = 'tract', + state = 'GA', + year = 2020, + subgroup = 'NHoLB' + ) + } } diff --git a/man/bell.Rd b/man/bell.Rd index a0743a4..58ee254 100644 --- a/man/bell.Rd +++ b/man/bell.Rd @@ -16,9 +16,9 @@ bell( ) } \arguments{ -\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}.} +\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}.} -\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}.} +\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -49,43 +49,49 @@ This function will compute the aspatial Isolation Index (II) of selected racial/ The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: \itemize{ -\item \strong{B03002_002}: not Hispanic or Latino \code{"NHoL"} -\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{"NHoLW"} -\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{"NHoLA"} -\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -\item \strong{B03002_012}: Hispanic or Latino \code{"HoL"} -\item \strong{B03002_013}: Hispanic or Latino, white alone \code{"HoLW"} -\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{"HoLB"} -\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{"HoLA"} -\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +\item \strong{B03002_002}: not Hispanic or Latino \code{'NHoL'} +\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{'NHoLW'} +\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{'NHoLA'} +\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +\item \strong{B03002_012}: Hispanic or Latino \code{'HoL'} +\item \strong{B03002_013}: Hispanic or Latino, white alone \code{'HoLW'} +\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{'HoLB'} +\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{'HoLA'} +\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} } Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. II is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation). II can range in value from 0 to 1. -Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the II value returned is NA. +Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the II value returned is NA. } \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Isolation of non-Hispanic Black vs. non-Hispanic white populations ## of census tracts within Georgia, U.S.A., counties (2020) - bell(geo_large = "county", geo_small = "tract", state = "GA", - year = 2020, subgroup = "NHoLB", subgroup_ixn = "NHoLW") - + bell( + geo_large = 'county', + geo_small = 'tract', + state = 'GA', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW' + ) + } } diff --git a/man/bemanian_beyer.Rd b/man/bemanian_beyer.Rd index 69bebf6..cf2a1c0 100644 --- a/man/bemanian_beyer.Rd +++ b/man/bemanian_beyer.Rd @@ -16,9 +16,9 @@ bemanian_beyer( ) } \arguments{ -\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}.} +\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}.} -\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}.} +\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -49,26 +49,26 @@ This function will compute the aspatial Local Exposure and Isolation (LEx/Is) me The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: \itemize{ -\item \strong{B03002_002}: not Hispanic or Latino \code{"NHoL"} -\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{"NHoLW"} -\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{"NHoLA"} -\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -\item \strong{B03002_012}: Hispanic or Latino \code{"HoL"} -\item \strong{B03002_013}: Hispanic or Latino, white alone \code{"HoLW"} -\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{"HoLB"} -\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{"HoLA"} -\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +\item \strong{B03002_002}: not Hispanic or Latino \code{'NHoL'} +\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{'NHoLW'} +\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{'NHoLA'} +\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +\item \strong{B03002_012}: Hispanic or Latino \code{'HoL'} +\item \strong{B03002_013}: Hispanic or Latino, white alone \code{'HoLW'} +\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{'HoLB'} +\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{'HoLA'} +\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} } Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. @@ -77,17 +77,23 @@ LEx/Is is a measure of the probability that two individuals living within a spec LEx/Is can range from negative infinity to infinity. If LEx/Is is zero then the estimated probability of the interaction between two people of the given subgroup(s) within a smaller geography is equal to the expected probability if the subgroup(s) were perfectly mixed in the larger geography. If LEx/Is is greater than zero then the interaction is more likely to occur within the smaller geography than in the larger geography, and if LEx/Is is less than zero then the interaction is less likely to occur within the smaller geography than in the larger geography. Note: the exponentiation of each LEx/Is metric results in the odds ratio of the specific exposure or isolation of interest in a smaller geography relative to the larger geography. -Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the LEx/Is value returned is NA. +Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the LEx/Is value returned is NA. } \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Isolation of non-Hispanic Black vs. non-Hispanic white populations ## of census tracts within Georgia, U.S.A., counties (2020) - bemanian_beyer(geo_large = "county", geo_small = "tract", state = "GA", - year = 2020, subgroup = "NHoLB", subgroup_ixn = "NHoLW") - + bemanian_beyer( + geo_large = 'county', + geo_small = 'tract', + state = 'GA', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW' + ) + } } diff --git a/man/bravo.Rd b/man/bravo.Rd index 53727d9..396390a 100644 --- a/man/bravo.Rd +++ b/man/bravo.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/bravo.R \name{bravo} \alias{bravo} -\title{Educational Isolation Index based on Bravo \emph{et al.} (2021)} +\title{Educational Isolation Index based on Bravo et al. (2021)} \usage{ bravo(geo = "tract", year = 2020, subgroup, quiet = FALSE, ...) } \arguments{ -\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}.} +\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -29,15 +29,15 @@ An object of class 'list'. This is a named list with the following components: Compute the spatial Educational Isolation Index (Bravo) of selected educational attainment category(ies). } \details{ -This function will compute the spatial Educational Isolation Index (EI) of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Bravo \emph{et al.} (2021) \doi{10.3390/ijerph18179384} who originally designed the metric for the educational isolation of individual without a college degree. This function provides the computation of EI for any of the U.S. Census Bureau educational attainment levels. +This function will compute the spatial Educational Isolation Index (EI) of U.S. census tracts or counties for a specified geographical extent (e.g., the entire U.S. or a single state) based on Bravo et al. (2021) \doi{10.3390/ijerph18179384} who originally designed the metric for the educational isolation of individual without a college degree. This function provides the computation of EI for any of the U.S. Census Bureau educational attainment levels. -The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the geospatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The five educational attainment levels (U.S. Census Bureau definitions) are: +The function uses the \code{\link[tidycensus]{get_acs}} to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the geospatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The five educational attainment levels (U.S. Census Bureau definitions) are: \itemize{ -\item \strong{B06009_002}: Less than high school graduate \code{"LtHS"} -\item \strong{B06009_003}: High school graduate (includes equivalency) \code{"HSGiE"} -\item \strong{B06009_004}: Some college or associate's degree \code{"SCoAD"} -\item \strong{B06009_005}: Bachelor's degree \code{"BD"} -\item \strong{B06009_006}: Graduate or professional degree \code{"GoPD"} +\item \strong{B06009_002}: Less than high school graduate \code{'LtHS'} +\item \strong{B06009_003}: High school graduate (includes equivalency) \code{'HSGiE'} +\item \strong{B06009_004}: Some college or associate's degree \code{'SCoAD'} +\item \strong{B06009_005}: Bachelor's degree \code{'BD'} +\item \strong{B06009_006}: Graduate or professional degree \code{'GoPD'} } Note: If \code{year = 2009}, then the ACS-5 data (2005-2009) are from the \strong{B15002} question. @@ -48,15 +48,23 @@ A census geography (and its neighbors) that has nearly all of its population wit \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Tract-level metric (2020) - bravo(geo = "tract", state = "GA", - year = 2020, subgroup = c("LtHS", "HSGiE")) - + bravo( + geo = 'tract', + state = 'GA', + year = 2020, + subgroup = c('LtHS', 'HSGiE') + ) + # County-level metric (2020) - bravo(geo = "county", state = "GA", - year = 2020, subgroup = c("LtHS", "HSGiE")) - + bravo( + geo = 'county', + state = 'GA', + year = 2020, + subgroup = c('LtHS', 'HSGiE') + ) + } } diff --git a/man/duncan.Rd b/man/duncan.Rd index b626abd..0c19fc5 100644 --- a/man/duncan.Rd +++ b/man/duncan.Rd @@ -16,9 +16,9 @@ duncan( ) } \arguments{ -\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}.} +\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}.} -\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}.} +\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -49,43 +49,49 @@ This function will compute the aspatial Dissimilarity Index (DI) of selected rac The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: \itemize{ -\item \strong{B03002_002}: not Hispanic or Latino \code{"NHoL"} -\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{"NHoLW"} -\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{"NHoLA"} -\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -\item \strong{B03002_012}: Hispanic or Latino \code{"HoL"} -\item \strong{B03002_013}: Hispanic or Latino, white alone \code{"HoLW"} -\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{"HoLB"} -\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{"HoLA"} -\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +\item \strong{B03002_002}: not Hispanic or Latino \code{'NHoL'} +\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{'NHoLW'} +\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{'NHoLA'} +\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +\item \strong{B03002_012}: Hispanic or Latino \code{'HoL'} +\item \strong{B03002_013}: Hispanic or Latino, white alone \code{'HoLW'} +\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{'HoLB'} +\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{'HoLA'} +\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} } Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. DI is a measure of the evenness of racial/ethnic residential segregation when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. DI can range in value from 0 to 1 and represents the proportion of racial/ethnic subgroup members that would have to change their area of residence to achieve an even distribution within the larger geographical area under conditions of maximum segregation. -Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the DI value returned is NA. +Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the DI value returned is NA. } \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Dissimilarity Index of non-Hispanic Black vs. non-Hispanic white populations ## of census tracts within Georgia, U.S.A., counties (2020) - duncan(geo_large = "county", geo_small = "tract", state = "GA", - year = 2020, subgroup = "NHoLB", subgroup_ref = "NHoLW") - + duncan( + geo_large = 'county', + geo_small = 'tract', + state = 'GA', + year = 2020, + subgroup = 'NHoLB', + subgroup_ref = 'NHoLW' + ) + } } diff --git a/man/figures/del.png b/man/figures/del.png new file mode 100644 index 0000000000000000000000000000000000000000..02ef68370cc72af31d3b6986313967fee519b238 GIT binary patch literal 378401 zcmdqJcRbep8$PU^(IlZFB}!H#*(D`=gseyz*?X@_q#>K^5!pK;p(xpsy(1$lvbX2B zy1(7u@9+8Jc|CtTe?8ZI->+`ubA7J&`+T40aUREUexAt5i0vVvAt53n+9Q5lRDpeFdL*i<|iGYufSh(Dwg+Nu)x-%=ABBeu$If-SR(QQ+iYr|Ie3M zrxj)X=ga$7V=V~_^7q9;5=8#@|MBN-`J{;d`I6|F$p3%d`uT;s70)}%F7olUrryjn z>B`@>Yj1>*%Swt;s!YU1zmO39NwaC;7qo&B6%m1fI+I>3{og;jhfQ^*sph7nFi(;R zuT5_&R4pqnuT#C%m2Xn@jgynJ_RJm@b~ZMd*{+sMtz^>+ac->bFmB{HN< zP*A;fie5o0MxkZx%X7B2w%FVJZOc?e`GZz*X1~5u1BrB4Y8~2qI+fH_NIy4({7pgWJ=J6WEFHpN5p*EH_H=oA6 zzIyfQ+0&=jylHGkznv;PYSZ=iPHyuF+}e7!z;3E{>Gu!yeB)4G-`kTa&jX^OHipB^ zUeF0^>KnP!TuxW^p%qlS!F7O&>f)VGyN$%QbC)knc5#zuXJ_-<{d!}{@%MsqO$ehj zMkXev)2Dxio0VkS9)Eb6;^`^L;5Q~+3oG;EtuH>a;8zC69=Wd1-wc(~>#>h{eXljG zqs)VpyUA*}Hal;l&pK*dR@CWkplB35o~eX)<4ntE}nuheqr zscn9OWJqvuFs|43P0TR(<;$1z<8A8vBvyhhE7tW9ykVo~?p9d;>h5^=`%+!bozG9F zN;fqV6p~xUEPhnrm$Z_)|Bd{n7|X4-+}dT2w97q-tCAIxO}h(zk0wTI7CQz-lse86 zHlX3rAFc23Sb?)x9x?|2e{$4DNG>H7R0cWW3!bHcH7sp-=`yA!<*Huk@G{+~G z+S2q|`iH-k^KXws?hnFJWg_{;Thp7Q4pUN^_P)n5{JqGfJ;(`JFZ@o5W!x$XjTq^smTpMYi%UvM%E;s^3uI>1gs@v(aV#h-TwYyO$3l$iHAK}(Z?5)jR#g6*m~N*L z4w9zPF@D>*`T1h2k-a=j%*=+LpB@qku4`xzw)@pxXf-nM;|CWPS4~Y#pZyPSgze&Z zo7vKI|CTLVaKiLFzvLK4^4XkkVh(z`R{7=2V-{g{_RP!fJ6EdDu(QibNW61iw!Cv^ zV10Gb%F3#yy87tRqhoEEeYkLaB>&=M*IS&PjEoGuooNjt(Qft94bj5U;{jh51f3RG z7#W8<^RTVABxPl9G6(IUIX}I)xQ~Q{=KMW5ywcTPM}Mkic^?;7R#)e3G~QHT@gpsb zB~*&hd~$Sjw70ic!xHgi)SA{`#ooGi6W8BM%_+*&6LyHu~=zhC?CVB1vjV$=ury?>Yg0|#08 zR;n}S&j)sUAWC#)44f7w=p|=oW;hEfUy1pMh=?rN8T0VG#m77wB;lTLjMws!2FJN` zeyi8hl}QC&kdTmAQ$_^`U(l_lc;NBK({lr7vy3P5QfO%CpxUpVA|{<=?;||^lIdEd zy%AIbf`V1wa58kv{R#>$y0Z#IL`1Y^YGulue(o)nRwlgkeVe7<>f#isk9JFn(qPU$ zI-%x}8{Nk?kR7@eqN1W$YLpcf$*4Fk>1TiZ_;ICL_07ElA<~uFq<=rrrId5*a^;Sla)-gKc+N zT_DzAIB_BlnZa%C_u~S;iO#%d;kGt5lkM5B3WlC#6cj8?zU|w)cdv|u#6W|prsl@- zNHmXGuK+#$M`n+Pa2_A2U%kcZx2X*CR*I%de)!{*n<78g8!JprOC(r+jk&Djy~6;3 zxkAYhE)k!QkPshFm8bdl{_X1sNrH3VzI}xnGWqhAwY3x95}w)0Bq%J`^G{JZOGrw{ z$SlmvJoWLJ>MqPR=$8&VFV1Cwlbf@ejG|?4Z*N|OmF(ZOUALwFU2MDt-x&JW_o{vlV3J*1UneCYdBpA?9Zg3;@kYOa)?JYFiKhLf zOPAJH=1ECOxvS`0m*`noq^@VGzBTP(W@aAn=X-qm?T5XY3duqnOF!D%RU)H1ySii} zF3R`iG&3(u^=%G?Xp!tY^!IaVTHWK_qRbdlvu)e9Dqg-XpY&912R=P%cJB;kRo__X zGVAE*XlZFN%u|b%V_;&+RLL&u?TxB=C3kx3)~%LSR?=S5i~(0SHcM8<&d$6-k-mBm zxmeP5rH-dhj+=bjPBO12PpWEaQq$5DQ*oJhad9WOxCm!dI{ZRHt7Nf{*$W)48P&BU z`B$HqRY^QNJUWARZES2X$wb&MOoU1#D5SPvH^jxox%BJfgOL-MH?5q{kc89>Nd~j@ z`|IlJK6&y)q+}E+q-qc+HHj>^quGh zUAuO<)L>yytD+^b={G8A{>5Y)bZ70(?%?(Sg00T$jI>U zSS`z~e*8=)zav-wNO!)HlG5M>YEB(5TiQ`u`$)ly#{}%Z-fr(KSzl1k@jcA0`BHB8 z-@Sbw^%X@wQ@18qhm)P%r&>-?@w|ThQA-&eoxyJjl9Lk?)|4uln#GbKYss=FzpC9tI~JG?EPiNJg4|&tdA1&p^%7k zcXzh5i-bo;_B`0Ot5U{*l11eb<%t6eZe2&)J33gkO1i%*aE4AiV=p;AqJ!`_*bvI4 zUtpl6rR5^~*5soYor@@=-9&r;_;^jJm%Dp8mbU5~ZGDtrYOXqmIO%3v>BeX2RK*l5 zz--8Shgm(-u(6}!D z>SqPy=|O=sbIUTu>*2$#4}NTU>8{(+=elZw0*+vwTU?A5b}Io2^xfg&>|DvftCmys z^w~3%#KJ*_L(mAr~IhmuM4sTdg;9!YJ?HOUI- z0%`f*dQ=z5A2PO3UB>_3-Tlhy!lXxFW;$}FjzZe7(BGS#=1bC@BqE{$fQ^@8JQ=X~ ztLJ2NmTcJhWT2_7l2IJmTX{7t6crWmgF3HfjzSF~<93c5_hSz>`zzPqYQT>n9$Oyr3GLOKijSjO*+NUUn5zm}|&8XO*e z+lYT5)`xwBwPx2UVF&=AWC~DZ;zdcM)U&aRaK^+{?^zY%{D4NZaq zmQit+YPwn;XJHcXgLITY$KdA>wp-O&ycRQq;+zJGlP`*jiZU~&5TEC({Qdpc)|_)P z5eRKdOFw)HtBF0e5gYu5&8H)Gn6_s<2w#|<{@I>=l5nR2ycwRv&d$zv?%w5Y8X6kH z`Bc1e`tMQ`MSe{uSLu6pn7uN-sE9vQNn;+1KyQtfh`+sAT9E{uj&L-=!vVe;%;cOG?3q9|c&NaeZy=IZaF9 zyLVwyCCF5AUYLvRJqrR_A64wTXgorUFN4+wBtdPud z_UsRTT3XtQz1@?OlhTa2IXMM8xA;@m`_&9ZyKV6DEG^>?RYgTn<(v183OT=&LboRG zWJB58pKNjRc}te|6;4$RjkNXje>3hILUZEdsPz6;k*$vZ(dw7lRC#K3^J;e=4h-Cp zRF(-042-yFF;Kd>J_T4cJ3Gsouem3sl;yz{D|K4#?R+2au z>>V8Zs=j?wIB@f(lG3R=1_GK`q$;LpbP_V5oTr$Xt8dpm%68d9e0h(Cw(+wq&tl)v ze&Y!|zt73ZiBsIwLY$N-?_T3WWBFLY_A8E#j@Pd33}FzxpL(S0k(t@UmM?J zZRJV*UGCP^j)~W)N~y{KNQF8wGB2{d1!#qwuQOJeoHgjD(AOV1bK|wSc#eJ|^0ME& zEPzPM&FgiY{pca87_OD?{Ch(WK+?2Y&yTf4L>#rOuk<^aEO6_cHGKd8Lx=zi7vlON zN~$CuFK@!@*KF$fX?V}ID?)Pa3Rx^ht{eb2rvltI*WWJdN-&&0jg#l(ahXXriUBQr z6y@278HAI0ld7t!51nwU)aJ@~X7?JSbeJ6X{`j!G@*CSKF7orMpFQ~ZZjw}SJId%P zCOUGfcnR%adlr3AI(Avd5~;H6W~@STXTAx)_0O*!q=!v=-p$vBa>WVEjbz(RX>u0o z)=(Nco4F)q^N3Q@5iqol|5#MzYcdplsftgZc57V_7LJ}stLo?ob#&AER(9s{<;yyr zS03*@NA^k~Ip3_WzHV)8w!y*kVUjApvxEc*&m<0Ju6xGc0KT6N%1fmV4GvlhvHIni z8uq;09cVkN0JDRGf`~Of|Nil%si_HfyxwEiSBH8G0Kn+8Pl`2ZDs&1>TP4H1N`#oA zB1LGtqXVb(>~LMxAUc#<_8TWoUVDB#KwDe8ELGq3SGPDLGL&gm*%`}1=Rd71nrgCg z1_lP-SB3$%gbi~2j%n`p5V^dd)Kco^Hro1c-N>X;l(}!yU0~sEc;OuAl9Ve)yx-Z3 zzc|A4LNcYraHgN#CnY7tVRqQhN;zFkS0Rh6oTEAB(+cyx>YAD=2JV8lLfEZd94g+# zH*cCNiENV8-?H&K&JNXt)ZsSKiL}u8zClC3N-bRp1Av5$EZTyMkFXx>l!3 z8>EF@*Oq`bP?>)W&;4wCB_6;i@T{wHFZ=cmcj|Huv*P*S_|$(_^(Ha8@NYO3rEbF9 zWcQ1U1v}0N4*_j41^}S(+fT=Q%&UzS-UJcTef03*5cCxRB6?Jw7S`4b0Xuf=;LBZJ zTJo)W^k}>LsgR(cJ+uNZ!;pH7b?(3Oljh0E%}q^75j~@94XlK_V;TXuRsP+a6g7;n zmX@r?TkHHijArNN7#;^+beLf%G-FrI`E;8&KdYSdvaS8+d)|}(=J5~PP?>py zf`YI^zdG~AUF$?H*BxNJah( zaJRFwV+tr;n|W4mjIz!c0H8ED6~J`zWO+k_k7H#Ghm^SZ6LIZtNv;V=eyqmT=o_|f z+g2E_mi`MJnO^PA$S5Hf8Y(LL`7tHSVW3rOTO9_2enLM}A?=2P*PVGLq{d@zPM4Jb z{r-`LXdsBXqkm5tk&l{ZF3~iffznv+99X;*f0FLev zUd#C3TE8~sg2>U-S2Z+5pEvMNO-+?zJR;<5kB)-M6Q`rzZDW>>OdiJno#c7ot|4G7x($~j1a8&ui% z@83b>@Et!M?e6oc{PRF`{1-3o zKJ#%5i=^Z9;=_jzVA;frul-#pdtCx0H$U4TyouDn$X?>Mxj{_MNL8y`WII_&7ikn%JDKZuc!-ymWJe zpF5g{{NdvkJ9~EtNy(~qp|$BN$!-5OP?-m<$G0mtfyYF3qvs~4K|Lr!Nd#NrtyVKP z+5`Y5yGP$-E8zoGKM+}{nFF8Uw~fX~QAz1@Ma4C29D2^rpZ&PWkMUU-U`w7JI=gcZ zjVPN)F{xP&(w=1#szO>?8byN2lQ#xUj3-Yb=xNIiTUb~WBD5avAWc)hI20f&6gyl{ zR76Uh^YCuZvEJh;4XOR*k0t+SJA$wsX}7TiXokUi%z-L0{K#iBhFF~fzbg{OzBth_ zi|`{HEtP$SAuOsQLO+>$ik(8jgKLJ+(PDp0O-*0qzpb#W?tUjg05@!HNmXQR__W5(vS>6)gY?!;l|a4?Mu1@t zxaCBw-E%Ce4`gP+D7ri}gQRH`e*;OA`e!R~{LtWFbIj#!W@b}h%x!*tr9XYTvZ0}& zs;Vl2)BWMY42{AWtT*XlHjNTz-gD>90h=HPH#RnQbrpfgL%Ba9U~i6a{=7m-1Ns$r zm8;+I!pjQ>^p2$^Cr`wsJ9kb5Sz+JNjYwa=e$jF6o`^^pf=~0kegDs&?P%@L|LoYl zeGdFJ0f>H)2AyGJXUBf}^j8LSU7&o;^!4@i+7Xe+^-~Co^HpFIUoO1q@ds7fWmbCZ z;6bzxmczB7I01NdcWZcvG{%dQ)6qq5tgr5)IggTI%4kd{PC7#9RMpBH43Sss!iRk`WzG2iQm3Bg+L~cT-vUHFe3659jq8 zqK0;6+gVsR{2uVo4Kw=tYah;T>*3q-eq{w~_geZ$-5ZGnghU{LIDT=|O&4u_Qt02m zOLRAOX!{2vdPYXiBRTDTAauQtw0iF{%y|D^AcOP_6H_ACg&6vOIZ7&0Rwg1%(kq^1 z{hs&1x;ZXQ#}Y0){)NtM@O4|7s(aYKx)#S4H5sD!Y#?R{ShQ{q44f187=$yoJU~#f zhs{pM!(L|0r7IF}S7if%Lb%V@-)ZdMnfY<+4!%*`@+=OWVPLx17V()s@Gz+qX)mbuU4E{PQwo zcoRWn@BPNK#}PXcHVUwfGf%j|8eoL;+~j2CNBOLGbN`p)<|O<=@#&yyd@7@zpMEtZ zHXtI>jvZ(wTV7r^d;i;0&#~Nd4?^~hslea2k$Xj0n%u73li{3u~4iY@86DT#Hp*~~}lzZR_WWLGf z65>So+Vt+k!n|LQw*Sj@{HtqnIb(V1~cCfzDpKtt@!ESjLe%g5(`isJC$ zBT5fhy?lI_O3Tnu&?{Hr`izo7j&n&Wr^-{cE1pw#K8}@n@!|!Nv{6_7Bv^I8kP^d| z6mlk+!J#45bN0cy~Zq03dTnkALYQz~fHs#Y4*f!7touCkri3J1%)bb4T z+%{cOD-y&tZJfk~fFJSj8!pnnB&@qrj;LI8EPi5&_+x}rz?$eO4GF{qlXSe9N z=Li_z!0_4W{wu=5!u_WpJ1O71d4mhFYoJIE1pzFPq@$Bl(YtpfTHUt3;SY5?XykLG zwN)3s#$Le^88yB3&byl|9w?Eppq+H%|4E2UQb!isMdxe|s`~*MAX`6blQOrov|L%7+H7#!xRI_bdEf|wBirz&iPWAw>U{0T@y0}Pmxi|Qo(IJo zP=!s|t)-l=HS5- z@%w{yeU9;8s~-jF@4KTv=m0r+uIsv^k=XCCmk0v1zj-6METEq$NIv(uZASX}S)gG9 zlX_2I{hhUefx&2-mK&?QJ*XoHCn$H#Yv@2&RkC7Ge1O#WX8?xKU~B@A4X&Z=@EA7V z!^b)3fz)+dZcnjya;&!Gt|J7)!6i|o&RCFi=mVz_d(sLC3cC9GPL7Twstc$9-E-~P zcTwCL=D%7_f4}@7h@3zy7mdw#lxCU`eg zNeG>uKeHjuf^t>hCP&H!WR%0-nrA%~Pz4o|oSK?|Shj523A)Cd4m`d$)wwuSrntxd zW?9Bd(2XB0_B#1UF)}ieXqbay?6$ssy%LD3a1dCQEsK8%3KS==#enDoBR3c8(Qh87 z-p|(ax4zh|c>uZ~I#Y<-*q8*Nl`p~@IKK2NG;Nt$vd3lsn%`TG9+a)ye&+b`@5stf z_!#wHP;4pcVyvbJ|FbQdpP#4Wl@3b}2pA$WF%oaoDiy!S?fE%Qd=-i}}NCr*^zrU!b36=K*Q zr|*2f_$eZU_5%@w6Z($k|GXbg z+(ER}79cM~8K-)SYoeodRV_a}K`U^N5m}|I?)kH4XW7|D*hhdTbY{@}A3DfNbp0}8 zz&cou!3YBBHEkHMjwV8f^Z4=mDZ9@};OHiA{7fn#Sb+Y#J}?`q@)IR#_d1TVasuOg z22%Sy*icu;diwNtf9NNTQe;Oj`ql>f`hI{{l*?5K`&Re&mxw*M1QC6$iksCl0JWPTDp@#w_1cyp> z(fqc#c@{W(d0hq21sk|;0#*xQ*Mdz%U$wQViHn2796B~yXmcy8A6jdm;~qSCpfQ8Q z3T*#+=F^uiR>GmVxmMcR^o#OWuYN`wfK=y-b2c|;U8vCu6*)@KX)lyP1SP)9)qey% z^*RJiI0_`Cq@-kI^i=afI3dToF80{%BBT0Hymu4$6M#;V3lZ71YagxosVo-tM44lC z=UeD~@QRE)7E)VNWArsP~+Tp?t$Ql?2Z0}f`URZHMsvq zoCi-#-54a+f5`CyUbG2kmD4zKRT2~m;TW*2uMRp}$6|%JK?0k4KPv;yn9p|N-tcAS zr#Skz3e5YFc+ihXNlG?Fh@(;ObDph(vBA;7fx3&6MOb)~U^ra6QrDRpR=Q(;ubzyCJw#aS@$RZ;t3B3Og)M#wP_{hkY z+}KYmI}-TkDsSvB=fECyw-Fdq9Giv+-dW`SoSdB3(&4t_ttQw>&;*Nfa})V%*w`3pU(@9F=v5<^H*p)YPhVri&L}3U4A53Tna34h%y- zg)aDtB<*)MMSpd^(-we(=f5Iy-0o4@};Y56@j#s)Oqfw{PpX* z-5#J50DgouW2a>9hhMA%qjSiJIvbxpiPCTJogX4APgBdQ=4_<#80(lofo7?JcK~eR z3not#vwMbl%b{64q5>XcEZw#4B9(bQS0W3jJXK+&%04%{f4uWcp?Uw-5D=09x*foq zIc8G+B}JSTZkI>*3Xbg*&kX{FB(ZQN#RN3~Ih*3(HY0EM&Q{aA412oPdX(b$9bQy1 z9p!QpGrA>BNKnRfAnNWZ(wza+6$q_L)FTKX%Z&*ALLZt7#+5gAFE2nnCOCg=VJ|DZ z*LdQA+mVZwg#zfdHdmFElu#>0>_Zn87GQ7KCHtT=i2U>C&w%_C3ijx2xi~rJf{fLM zK7nN_vK~F5Gl>PlaTw^+pn(O;+|KT>g5LG(ULvu+8I}Wtj8E6&k2j{Gqhp^Q2{7Fz zA=+L21YN@zDWr^VwYzytIz=gej*lDZJ;=WjD`&pmNenX<*~Zv*crFZEnEQ7Co}$^E z-F0UE7wfN4#j$GQM%j%rgPSt2M!-6!b)5=uM$oPQnh8&%Y%D|eUXuPG^2ht=URO6e zh-q^k$aFb6W?*Jx!!7%)1*ud1ndEO$wH(V6LPAlcdV%D$w5A+8Q;#<1+a5V-&^|no z@vW!I=%qv1xe>cJ11*Ho`C$PVjH44GPL)hBQWQW<3>Q3k^I#JT2N4ccvVAU#w=%j` zAXg#PSEc&a0 z0|SvGMe`imMgU!4OdQ<&QRi)KN$`8n#RB;Gu0CIQSp~rVdvP(5)@!<^p#lD)PH+-V zQ^iaSr4&c9UQbU?`_>E%_RXVld$2EOp4V!aEYw-|S_lZP-?OvuCLJ!RWG`J)P*Fi8 zppPupM7L?z>+o3MBTZmL#Kh3hAv!w3oj-WyRpg}p-J1DC_|pq~d@H~qX(=fO{g<0$ zh3l%SfZEM!wKC%qqxW~PEm3*U`khiCvzc{&)Cma3`ZU_3eaWynE69)9Me6fS= zq5nIp5gBuH4u>EEuqG&aBC#M-;zVMPbFpg_a4<2ApyIUL3_G;XP`$*vU)!>s=Gx?+ zee|*{J7?nF-u%x#QmPi&Za1Wr-j#E7vTg2S^XXPtHU<;XZ4D-Z0d2gwx8CP)-BMKzjfyJKtD_mK6GHU5u#P7m-X@MyMM}wX(QU)oknkEq{)A&7rbl%ReN#-X z&Runx=8Rk6<1{MdvpKpo=Z$2=#R+@Sa`tTnYVn*2Td;1lpwsIf-WFH~tg*))BC*T# zs2yBR3&t)-9wgcwA2X>#&7BsV8Td>($)mEqz7Ed~LCCFZxT&TV78rQmYFKKL15&6q z4&|8#e~H-hb#&5S%ND%-lr-T5jtJ z>z<=%p5G8C;Ler{$i-`LJP}CzR4fvls@G*?G_&vQurW-*d4u#-B6q5%_^NQEM5m?5 z(|}TQ#TsG-z&V*{p<5~{Ny@3H`O3=5_Vxt}s*AuTD

tdKmaT485G>b{8(d@fggk z5A?Csl_WO4Xu&TtESz=jRWj%j{X`{CC(_jw*DeN>j$CWwQ~YMHi7_JmiY>9 zV{VAyamYk(agnVjC~iw?c-`iLuH@JLY)L&le@3Yaln=m~!vKoIChRrIS5aiGU2n|z zSiqEG@0ec)jMJQSKy}!xbp16~VoCKA?00ZTh|vi6#C^MW$8e5Mc=fec6XRIDtfzf9 zGcyBDOmz57Zf+AbQ%#OxUKmaLd)QV`SoydTU%wtZTA~zKO`NADJ%7enUw;u&$#_k4 zXlMucY0gp&HXzED`ZJ?D1H*m>k$0;=4in$BeFj?S_sc4s?y!?R{BMsDOMdqOT+HaG+3K231P9n^WRazHa zg2Z?%?%r`FB^EYze!-tJ-bboA!h?JE-T3#NleLY*ch=f*l!xAnMclT|fn=lx3c1UGJT!bsLp;N2G zS-iNx^;b7vVHrGAn3QyVmD>As5V_*4L!pN2>Viqsb(P@sq@?ND*^?n~ zZTi|?5a)?$7R`)^iQ4PD(4jvZ2t%T%NjuO#*U2}0llp8s`TaL0avSXP4S~B`!k9TZ z{Yx(;D2RI>dgHWc8p)f`Rh)1!QeyFuVjK<&-&v+5bw(wyHhFR@G#)gbT+8D^zMyhuUt;oCVhL( z-_xY?7jsXfz}b()kGb{S+bdrXjOVv&z|y_;diwN)S)`57rT7hxvG*2^ zxA{jCw8>K^`={b>^mL9H=eZ1gBIcBJbuIaLrw{Fr<$=hL_cj*+Sl)f~Pv$8k7{Mk5 zUMtA}7JX^Y8+W?g+t(LeYrDQ;<9_OfTRD{!{TK62 z2?>cx5*cWAk*uuo|Hldf!ic!u8>5cUU~8lH^qpkvITIN4J?4Ai!l_fIa&Af?j}zMKxAVPAMK)Uy(MIu9+s^oB$CRCo=qdt8x!Un5*2q;N?AG zkHsU(pK$x7wPkzUJD-@HX{`m0^UORZW@fV77utSy=A8{~=2hv2VWi5kvXzRgJd0%& z1@}Z@|^nQajBE& zLVPn*92^~G!Y@cyKK%9Tmty7@$hTYtfhtF`7~`(F#CtMvQ`&qwM|LAsnbnHq4PUS> z0iV?`qe0%oHiR;#Q+1FnS?+Yf$V(hx&{jIb)6?ekeh{)2Q!`5j{Gs&{Jdl(WMvM9F zqly$4s0e_6&#(ow)WxHDYUzSsAMW>$61ggT+P=Hgt(2f)nO9?CK`ra{gO5AB@AMl* z|6>?io>f^oar(^UUWYd=$v5;tU=K#18NT6QJRLLqyL#=Ri0w`BsXOW z3QzEXq~vD9JXp2f9%fa|5#?_nKwmO}9}2!b=f|B*e2-d$Bp$ts)-7Py!}`O?Nn45` z=v^Jv@pL?wh3-rwIF5Gp1t2iL4~!rP&yzZn&7?l)X*wNjC)zI$pKCYN)Ve%j z3mmf2ZHBbg)GusoY>Jt>-%Ku%?k^ttwAkk+OG%J*tR$S^Lzyi#Tp@LD=K1E(J_fYZ zjoJz1=(alf7Abb1ckAmH7O!NU5d6?Nd}0~Fri;M?*33QQT?ZrAJYK2EJjam5_lE%g z42L5)b)VYOx_3!`yOH#B*N)VY&PA|mDGQ24>euD3yG*{)yh?Y$_~l3cQ|miaN%JG@ z(UZf~1)lHl{uzj>C;xHZ0~MMvb_sE{*9@7KNH=k)Zw&jCmy4X zBzT{SK|8bYns#4wxmpaitlL^mtrO6{O7`s8vsG>>P_Vdp^+;-RbQD&DOgyy_z!Q^` zg*s4+A3y#QqUGwa`0G}X#3^M4tnDHHbXdrBayst=-n_Gs6L%+tQ-PvXJz6P}y!D^3(?R zQG4d=SdtxUqEzS!^N)Lv@qrR z7V~RI6V$)S}x`+jq&|wby=;-`sH(N|7b3$;Fw?DYfh5ywg&Qp z`m=1{=*Y*L2wH8Wn);&o@zCc`6atzhV+4kFD=H{hf_lQyGNclWG;GU|-qVq;kgS}k zIXONKDkYL&T>uXYCBM1!fmJ}M<8{epmO*1bGUTR$4=Q|<%39Z}b&sT4g z0eC9z($b5g{qAUQPnCCZp5l_z@$LRzIQEXe2X=&7+u89XzCmCrSQ$F9?wzmJLE5Ne z@tqL#Y#eKT7_GrJ)tY`Jq_(n>!=C1U7Hv7n4?o*SMm9(|`QRNYGGzY5rbj*!md#{m z&^y+~j?MVfEY6eUmd)xjIMJ_YO#)g(ATKuaAI-Own|0E4z5I$zVJo!_li36Ey`^D! zf6Bhf4s^1jI%blv)G#pxh|iQd5|l$8)3nS82*bXal63sG&({JcI^*PDU4zN}0IfFQ zyo`(tWC&2hWo2d8d}t@pUg0%0ReG;64k1B$Mh62Ye49sL_;BB~PbNyB5X=lT4hpiUV!QQ@>X4^b5V=Hx|MO4fQ2l1&QHgxrW(sQmQ!_(x&X2M$>L9=O`rrn_tu z{gG9#|5;4@^Um4in}TnSyzFegT=zq1Wk;RBhq}^$w;zbV#Dx8WnN&y#i$|CynVTE* z2Twhic;LW+?(>_+U13&QTl%em$o5|YHT$ajjc@BZ3Lyw=(67!Qy)eHL#$!fHL2({q zPV6O110d@=WzUl3ynXBA?S1V0z5TLLadB}Fp8?7VvqQ)N#peAFaaNUfdF5>}Iz4vPl|27~IAegk+xMn# z-~Jrq-VBdYh4g*AqRizSaOrnaDHiFOwg8-M3*!9SWJ^m{c z%qy4ayI-EW3%&0XYtu}dkozJTWyx-d>W&Uod%dy3T-%;}>0`|Tnh9E8AE|3tObw>n zm-ROX9@~eq{XvZYdQLi-o+|nR5LaM1L=tk8*OI}FchHNV!lCqs89;*odVDYh#5)83 zgN2PvB&V)~qGI4jyQ>~={p>6)`9S=_T~b-XImhd~G>sl6oX1RNkAC%)rwjYbp5)o4 zjO@R=`QqskS>Ou4e)AQ zKt>s16~q!e*dO|H8a5;@oQiZRnLPT>5+ptIqOh9@7U-W&I>1khCAgpWzQm{HgELs- z@2|lYzEV!*ZbA*$xiHgsUk1bv1HqTwB!!%6rOQc1zJGsA=A-{HglhQ>?~@f3{e;?_ zOh2E$ zM(F{}fuG8dFs$Ij+yK5>mez)i)y_`4_&1lB`e3lEngEG=~N0DetSrcIf$U%+x58+>_w1$QK?9e zT2?qW@9rOVJ8Wo{hT*fi+j=}2dI#67nWq~QZ5NeAR2Bzi1q}zq=Cgkd59>9*ix={E z>MHjW!#z=G7dXh8Pz}KB`_Xx0vhx%3maf7D3l_Hnfxo_TrEIzw{(yhtzHn(>Z)36N z+jHQ|)Q2D4r3ml&10>RRz<&1*7g$+ZG8Z>ZYDr2uZ8}Wgo8prIj-tbbECwFwo#5jO z3+J^NQ;Z~qD7}x0b;2oeb- zdjZ$Af~>4*P+m}<+DwZ#`XAHLC>htmy(8Kx0xwZp(&xfq&f)*Vfy-VE|Bx>nuzT-i zu@qVSxMo=oAYIFz4MEb*0y7ZCq>fMD)5Km>y_EchYNY zGhB|=Xl(~W|6FYl1{|Glw}-ZWY5nz6^KBOu0mhn_oeNF>4~%_SP0T^MytxT2fvg-F zrf+018OB?$^MXn2o(npAGf?7GO%9m(sV zj^fSyYc|I&Sy)*ef$D%k3b^~hG+lDVML+F{{at;M|C`cjik)9Nhmu+hQ_ga5p^E!e zfx~=7$+SyOo62*IaA{F-8QN5f^E^<5l#$xhg}VIA2wRD5j6t zj~qP6X+Qn_>N84{zLH2I+13Qf!<_r(Ies0w-8>rT=ylS3P~R|y!b)XgaPw#5$p^fE zhP(=rfd5iI@80?cI9wRBhzH@{QrLtyyZZiTdwrhI$@!~a?>vs04nB<;%%hWO;6$$N zd0m(7$N#Qv?83Eg{0^iM=Azms|4C>{1V5liEA_n%QoqbCtr@q}zY`Ur{OZg=z=W+w zW7QPeR`y-7NK%~G5Gm7+oU7kyl7G$Q^-0`d4npq3CsNPR5r>2XTFfL%3YHeo3?7aw zcP6x|!;DZrbrkIR=itkE_0E)oVCT`{WMsUyl!KC?bC?ABX@%|689t1-?pzbH{_6$6 zAnsrULXF$FT`sUJSx*5uktfk-3Clh9eSNWX)5OxC0yAqzLgS-+XOdD9lP367w_WLChmHmzQ@r@t~jMOHqeR4)1WGy z=2uFuR!A}%lMau-73uVVbOR3VtyT)_q~lI+B=)w{b4Yx6N-Y!b6?@l}8WmApWU*v;2L;9#Qt#4%J26)&7N!VmUzNukdm@qItse4dd6qD_n03ih8yYCg@viWyVY1L7E)$#1{kelSuddG9kIC$iwG92T4B>MUwj zj~+iJO%q>%d8CSAzFXtC_@4r_70rEPOG}XC@ZcbedVX!v!MW@Yc?~KGTH8#pt+vE4j9>T~rUW!>_&Lces{A{^G-)JN*9yGwT)f4G92QgW>PdB4Y5w ztuS8R=W69DG^kHFiq9koQ!RZ8%|9Kse)-{o*o013$=i8l5SA1Fldj;47ZCR%B#Aky zY1^n%jXH94(LodpqK8P<^s!++eOl$MY2*hbIUB{5DAhNxO~OZ`!Fl%Vvz5a6GtA6t z@Hz56Hq_WhR{lSh^&)yMdD%q_fum6{65+-EfpumWf#Vpu{l~QL&$Th`f%M0Q5qZFM z2A#`e*=H8BUZZCoJo3>n&k^jO2noc2xRsi?YsA5UqKP+BHZACV903}PrZ1=LiCV*a z4ccB~4s~!lIywv?xH$cMYu2TI_=D{rhvL*|Oxm;hL0(=v6c?}~!==K1<;3a6*hH=< zuqD*Bu;%1q=74Q*P_x)_hQEWZ zg6CDk-3Yc7^g0Y+vX}zO7o9gbfe@uBW}kF z6L7-r^O(dld`rh|7z&Y;D!q_M80ZZ?QS`;e%IZdH%Sv!u zukp;>91AP!kgBAktR&uTQ4L1rT-Y2(3nZdUFM97@lEG?} zNGyD3!f$vElykuHccI|oytlpUZcA^I&Ns2G+&Y!M80d4aNl|1@dA83RJj$~p@t0tu zJylMy8G@IOWuJXQ&Xkk|Tc7AqtXc*K89628>#62=Mdsv^bSh6?+liNd7xK_ON~ zpvZMP#Pk2vSPa0w2HaHe)JC^Q>JsV^FxP33=XCu=vsNI+ba8gDm46Q||jVfJ5M3Eij$=BG!BLIF;= z@=r(Jy54{RQGGus!OU)W_5_9~r33@zlNDi%8F4TGbZq6TX)_h;16IaKhItGVa0WAI z#`W~{2v!%uz@^o@qM{J!DIv=wH!&d{9uRP4av!W&SW#)XJdDp_CLXFSj3r~^w;m^2 z4uE!39L9q?U^W>C{{y3e{AmiEVQk9b!-tvO@GKPYIGA)l&#j3Qi?(MKJpG$pVjZwn z)l;#^@m{_fHx>JwIH~#xWVxe_L%0Y`(gb%Y>?=Ud(zX(pI^LQ^`_3y!qIV=#WkzS` z_&n)1Y7i{yDkCRw&hht5@F0%`g`Jzd;gs?F2~+|$fRpnZ*of*sBweh;J10pCz62RZ8em13 z$3RIqVzg92;hT@}#&u=uJky>qXM*6DUo%05m)@Lc0}heC1pv0FD^!5)O=Alb7gQoz9y0TQMejCPt@w2L0(l0CU@sidE?2Oo@Lo!@zX)>7#Lyto7 z3<7rZ;^v2C(W}_On|_q^9$O=c0;p(f&Jhkx@gS$~XRrGeA5ygap z?UnuRFq6!C+)`AGpKXzM2UsYdt$*EI^!8`sjbL4Gn(oTapHK1dgd9z}qBZnLw2?$q zNd^xM>P#Y<>b9+0E7#y(5!mHne(=^Rgs9u6Hg+Uj zoJ+c~Up6zU6Z6C$YZ9Pv|3|-sQkFb5sG6NwRPC(N|fgJP(^Kh{9@covl6dpqKonIJ+hug;ASCQ^V%O3mTzNZXz$=dZHMLp}() zHPV5?Dewhqw`6eU|p9$tHjQI~;mvX`7Fx_7M`5 zK~ZWm64ijFhxf`c6YYO`epPrD58T^qm}*H4F}TWY(izB-h+`lUj7L9!ARD}XXvK8y z|UOrW-!95_##%|8X=u}YsmeY$s; zFucBT9rl6L+z)8t#?%LqoS>c$u8&e-W)3M21nO_M%(nNIchKMybd;$1fFzOUF2A%i zHBCD&wPNtI(e;6R-0>ZJaDUfpCSE5Pb2JyNpsCR}q+>eP;YYUh0j`>8P7Wv`!dw)X((^rnzqwK@A0AqzNU2+MFM}u@ ztP9h%bb475$xYfgt<~DJh}#KkJFW`PSw}sD2`2f$DaiaXsJ4lG-}?1~+{5n9|2f(Y zc6lEn-+QXu)FyWo8~^o3n7NP|{E?r5$Q@62iHwNA5Mv=PpP0}70XzzZsqgB+B^D*d z05G@)05&jiBfc;eLzqzl?ml|#m^yqwAo1_tzmLZGtx=l{V}OMup4HOY(^DK1b18s~ zlr$Vx*Al%>AWvW#u;O^KLmR|)=*|RVFD#MOI-Ihy4d@dVMw|5U#4BuSx)SMQjCwo| z4~H1HPDxAaieYBqjir-dZ3G2xF$Mq)%un^XVHOc$+E-(fvB^ekoN$a_ zHUqbahgo5!(LhK-N~-y7B`)^=ZumyPdrs>LmXN^GE-aXWqCzwG@ZrNhCZY%yx+kw* z0ZVKY;CWOC5)c)yQ&OtGpMYKn55~OLfs>V2dMRNxeLW)E^JsaEZ=Zs+1S|R z>eV40I*<*}JUoMuAMvav@=KK>YdRJsw`>&d1ieZ=%s)E{*4o{ ziXw{Bfyjb>*7T2k5(7t-jg9h8=OtW74z0)RAAm?d0(=6uX>A=fujOD*kzHLW$#v^V zuE*A;G4YRS6S4mUyC%$J&!0C>EOUm|wza)Q?ZmU#Mth3hmh4@h%l`ET&r9v@YM)6c z3256t{^)Mm&g{rk!o1IYX}@f>%x7DPR20O;i8~TzF!6?=NP}W?ZUUt%GLN^UwqXsB_|UsxvyuQHT3=8Q-QSnt(uqe$ zRo$$SjpR!ZymSt4N<{QtVp?-2k&3E?#ktVI(YJ$n{;A#Ee;XJZ2Q6ruw_DG8G zfDVjQLQANtt;LjLb1hoO>bg2Xj2^=hjMGuMhFoOUk`nYeE>9ZOCam=!%65Rwj`*1rBe`Ha%?Mf}peD?I+Ke@4+p@qGL6zYW z_u=I~(^i>B-UpBp-3b$L$Wcg!3Kb?Vxenck@UW1m`g=Hw=J5QszQ8ogqq6_(?1$|b zDkKu6q@h^>i6bktEP8zyy@j5>enaT&X13kP?{ht?bYB{z4ys-^zACS7z?$3{qI{-P zT`8qA_3&qc0udBcQb{S1ZcqVfk!}O&PH8rv5(3iF2-4jhf^;d} zozmTK=6R8QzVrY5JBMpu`$B!+C+?V8GqYyhBSs@c(J zu=hueCt5?3+`>OEs=l^r#r^)OUkFX#@B?jpKsgq@;RaO{5Ev?hU|$|n`eXh(d+nGm z(EH0v|Bm5LM$H#pN%v{vXy9rz+3Ce{CK@j%jYG7WS-w30dGmbwv&o9#iHhJK=>}5) zh15`W=J3{wuH!&*MEX9&#q)+(%%&Q^aqP@@3fKN8P9^!tcKCRD`jd&&y!rbt zXan~nobQSTJ&d>fui;Z$fc+c`(o3VurrYr>v2$9R+4V;jB)PyVRvs*uGL)^lBqk<; z{Sjj*M|$x&1fdnO*io(*6Dn!U}ftutT7i^8ZtLCXnX#bFmUMm2on zp={EN#Y&{vfcb8;F1m<+V9nDfPXh5EV+*z29>^ixBo_^&Ra*CE8v%tW14YF?rgCd( zT!fkr9v;MtzJZ=6WE{aiftuU`#8C7a6=|cPzoQL4ECH%oQs|HhE%s zS-r$!9yp2n2M3u-xijEz~x=H@yA8=N{kSwTw=nw^!6a%iIa=Sw4 zni4I9iqEJH^T5j>a%tQkYzW?^MEoIhgS3xET-gR$M$3g@x*Bki z`P@hM2zhK}?;r*GJ&rQ)y8YXYTL50l2sYU3=)8`A92_jhHX_}SEoFGn~-oAH1`10 zs`8oG-I8~P&Zcf)vHtYH=_v*Kn+dZPEQL8u#>@;DDgjV&|1wK>E40RdLk-xXG+wmx zZjjy8B6MIpZC$Opj4fG3Do!B-PY$9<(a{=UPNr1iZOeI?nY)IEd9cnWeE$wvyBEcw z%hS_H9}$2YAz@)?K01P&9i$lmZWKh)God!W)8f2T>^!jFFKMz|V>xs{jcu z##dEn%^E{qv5>;7k1&$b*3?8goncco(SXZU%F%3uWcAxOZ@>*fnUA)a@*%86B(s0( z3JpJaE$D93WeuNhg+eh{ze7O1@ZD0V%tL;bmMsa&nTD%uW!OMB1|G%17gp=XjG zw^rN%dVnA@G>mVDED@9C3#)fwX%w9XlEBe#;VfFp8CkV7HC2L65Ga{1YBAqMV##JB zV4C$~&dtthb9BL`&)sGWZ{<5V%$?Q&9A;wiy8Wk_It6KI<^|F9$PkS%R3f0Wg{Y$TPshrGWCBhkER7lz0B#XJ(ZPk{s&BWJB1AU z>o`yx-~}+)l+{z?0c~*8Mmb(yV)piBLEkV5*ki73LH6q1(icC!@uj8oO@Lt%l1~A6 zRjt!onVIEGj~EyiYl%`oY!no&`J`!C(o}MR-#vC0L~5yrFJcizfFZa9F|f~|RWhRo$FMj_gxas7ydrjLf6W(_$=9CCdJr(mL&rRnMQPfxHqsCp*wCZv7#Iz@ zzh5cAatPXn1)oDm2hGw(Nc%TnNsjAs(1ik?fF>L&^!e)A3H=ciP)>oygGfp3qa^K# z+1XyO-v-w67M#s`5cubAheG>l$M(*SaZg%kkU7K;nLvaw<6>d4go2X~P1-9DAD`fR zAUOdq0!BCxVmHX#LCclG`savEaFU4XkghS98wlepi;o}&04VI;pI4*$KmDIpD%GF8 zm5JG&S`?n35-ejn%AX1iS0%wl3$C$;!%l{H}?+)1xVbflsUDE9eA6 zD~EW%jP^T@5FdXW#hi#?(D_;G5nh10go%j>n7eRh-SrMJ2BrB>>d>!{`UBd4w!XP>=wLb&>)byj-~>n2&5HxZ!xGNGRsa0 zPr>2<}W`)`RE!)`HIr)>CnPzcAa19i`0G=X@;=?8wX|Pd{4mc8TeuIcN zB#s)mxYy}D%A_3aF7eOnMNAR0vf0OgdI6CugfU%?(Od* z(jTFiND6+PC3A-8!EQkTv*p3kgxB$!pt#T>wRDs*jZ#vr= zu3g+)(d$nB$uZZb2>&!}dqHwTvg+SWTL%cX5+%a7ksZUgSpg0Ye52#xT0J)wjVGe& z0~#_m@EJ%pfRYPBPy#X8;J2O7E=ingXJZ3%!QK9jDvI0YO{h4A%MAhoZjjqukXe}e zH#|HX;7t%_aKL)Ahf6#xdg>*JKL^Z&Ams$`1V|Rm;n2C2q*|OajO0-qGn5ckLeE(fmXlGqA<>4z<$Ff1X(#7Z*TpI^8MV(ESd^fz}uZ9zFyd>!CzZU*Mw9N2>!2 zJ)t;8;~>T3qEgtXHuuN^p!Zx{U-x@L0>Dgj80T#@lZoQlsOI+Z;M`^CnHj8$vv+U^ zGJ&ox-a(W5(H}xvXH+YHX_v1pL9JOG%9Bvx0-czAdma{+ty8HWz6%0L%K3jlmvscJ z52Pw*_O)M4M!$jhIWVXSQX{#MM06*;?(z1Hxjh^cZ%*+tzrYWdz88&n8us7v1f^w{ ztp^))m>ogn7qV2!MJBH$t<|9GgAr;yVDyyl)IS!?I$+30puho_qv9DCpv5c~c0Cxn zL2G+ZPd+3tdW0WXu(UFqqb(V2&wG`|Jw-kp;`nYbPP3c4NP!<&MZo@qGz}~RW#ZPl zPX@HaZyGoW1Il5LF^{weZO^bk3qS;JN;@;P1AO@!Kc? zt~JnZ&aSA+oZc^o_Mx2ei!__IM^G<=;^#w*YA#rXuz`S3pnd~A?l+>I4v*hwZI;NL zDx2)zAz$IHDkvoMa0%!JgT)jAH_*qSFB@q|BVf$A0=im&kb%9E3q>MWz)|d`Z=eDI z*syIAZv;FlK$_{zbFdFPgUz9|L%jr`UU4~Rk|p-8uSpcaP)2a8GkOLd6{5{19MnfF9WdL#V+w{X6(EF(eVrqJUFr zoe0z_9Ubmrl{p*~m`U}3un~C2o&%NR4!%LTz)_o7!gxY#?AH!?zkzI6`^x_JFM9QUR}(xv>!MEs|h#tfXijzD+%;S%WGDe)b^ zf(){P>zb#_16L^oSb0)LUa`ABE)nbO9$0)(&m@MtQ_dY++`t7=fDkeRKqJDWPK`nO z)xiQVLIEW!>rpfALluyWsOTslIuEZ<*Q74uFXTgzYyff&HD;N^nb_S)CTB~W1D5!8 zC@*O^Yz5`?r>n3{Qyvz-q;SMWN3;<3v06Y#5)>taS|Qt-<^UPgxCjSu+X%%=HxC#` z&82(LcafW|C2+&V)ir4L8iX=XQ_w%i_IYc=@E*PZmFI#E8-PN9C7VDMpNCLU>BsM! zcVgwoKt_yU(U&(cNDFEU_T>UhUM<=VLK&K+Q3bSQWY6|$9Jjg^Ama(nY8iHBSMgs@ zHRgsvIi?6<2;fZ{_y`>_;aA9iEj^G;SMG*rz$m#$}KdC?;ddF$k z69o^V0w^~Jil{2hL2kD|M;Jbtu^zq&gq#pMm7eV!$Q6`Bzt+1AkYfT~-p8d+T+hMw zA&B^0E_g#Ah&2sJ;MM~4gufQEA%|3U=!he!e41i5T!bbZ_IiP8^^Xqdv4O757z3>^ zFX{joK)|H$)b6PGe}_#4nSWs$a*$_~AuiQ;kRm<%*PuJ&n01$+;l6@+i4%ZdPcONM zsFW0<>u)mt1T+p3%E8`dDCegvX#1@<_rOl$;_j?ibUr;yVL^v)LOCWY{X7NZ(m z5YTdM`1mT3S_9;ipe+cxenD>n3dj)bHj#p|3aG?HY`q2$0s>i<@KH!(eus}jnh4@A zV3Gyv`$GzxWg$?PlV=(g3zr8Hu{NQ={3=xYXE#lOy7}v|_b#Le43EE` z)U101K-4l25Ay0}usjTGR$NFR?F7;t$ueJ;pgNIqtq-!xhXf-KW*ZzRo;U)M`7=KL zdQy8AQrBUvGvW^v9VsB?at%TRO9C1vKC3dJ#pBk8gk~i#*PYIcV%2M9%B1fwYXBkO zO>NkFy1Tbv-XZT(&`}Q^o)DElLJJhz_En6_-gsd1Q08vGO@Be35@jL_|&$_1Kuv3s3Fl1Y#TfD+6c z67w6yiv}q}unz7k=-tDd>6sZ;VCq2JIop*E&b!{1xKI^`3rAS>f39sAczkvU-Gu=q zFM#e9WE#O#mqP&poKoAYGjLF%AHA*yPYps#mH_j?08k`|TtLEU4I<+ONGE`^N*kri7X-k7bT}W% zoG4vU_tH*3^iavrj8r%wPil} za0LKoIdBc3-4@i+O<^CviqzE941@p+@}D49qX(D}%Jzo7R<>|$Xx{ts8G!rVw-OZ8#@(Q!0HaJZe#oTzS zOnLe%8d}W5>i-gp|Mz~6Bok5YJ-Y>(=Z&bdOeY#z%KiVxen**Nw2Q8!5T!3X94iB_ zO(xRcwIITCuGNI+pSGvCg7N8{5RFHEtVI(f=zTE8ou=yht|<`ezQ1Fs(41K@D8H1# zb_G2!^@WG1QRV-Z58e4-E%ekbpz-q@#{6$JV^2!TSE-QO1_2@sxZP)PUDq$V4)rW- z!Da(@9z!LDlD!WZgn%AGi-Df=xbNU^gyN))@IZg&na54kUqP*&B0$6lDXjsWf6&%B zmX?%MAhf>`Jb8074I^VV)Mf|dFQENGA4fNs{_{sU`;B0FsxuSlt;3l%0fV;X6|nfv zE+0IO{+cv~l!1Yv*~BI5#;-3B!o6chvM+`_{L(Ya%NcGskS~S+9dul}3dqo$nacGij4e*GCb3FQyw5OmT4oWW+5;;jX+!qtYjHzB|(-9u$T(KC{W6S*{UZb0_`yf zS(B2Ipi}_1w3~K{b<;lK>ULtEH5!Lm$^KdMsMGyWjr4-Hs35Z$R%;6rcF?c1#2!J)*%Vmva0{Rs-)?;&Gl#>L8tR5zgH z2fX2J^LCyPUHjaA+Cp$@$oXa9ZD#iq0-v5eoC)hgi3JNVwGcW9iBLS0OW7RI&x8(L z;So4f06BjFmb^LVA((0?+r;~egIFwhFfhAy00aZDfZ4bS8QP5(U&%xuw<8~W0eBfe zDLB~QZwim4lKlE;9NMR>_zr=F3v&aS2#|;GfY?_7fF?k62$5sEYY>5grNBo06qrhMJR`Nu28tXDtafi4K(^EuiBeXOw1x~B#hS3u=P z7XTvD9ae)rKwGz41_(m{vLb?O zBp3i%GGTLre_eXN3!)w90{B1~i_iq^eh0`30MbWj86a13(^wNuSBnSW0G;uJ?VGHp zIUqDN6Cyosj%+}7Amt)(XI*h25$QmZVMG<+Zvo$5af#`i zhvxCl6girA*cZyxPk?}qoUJo*2mmQsm-7Kk;iY>nB!|F94SoQ231P&5Sqx%>h+MP2 zMo=13W7z0F9=rXTw?JYS5)6pZv(;gLb12{;so5wlQUqtHX0FB}Sh6|YpM0{FiXYQ8&-1Mr+6Wm%5ppJ$lsNHh$ ztXY_OGQa_|N!U$7alg$Jpx%H)w2lkug=U=1(Az@77AO*IKq^HE6UcY6*KWWC>bGSO z*qI#wYTM>ih0qdWQx_6QrcyJA`scx+DgrmA)cWr-X?-3lg8T)*FY`ZV^83zA=I`0R z^)3MUf*n#ifZZB=u{DFDqKx`S%@iPx8cG7R0Qd?H!H7y?hvbI0FYa@H3wXU^!*}tX zu#y_Rfr8z)whBb*Q5O>6Pt3ze`I8}P{Sc|c%D(kb_C?R-_7o_2hz>A94k8W9{A~2c z4!gegP%8lU%q$N2>cIR2mjVNMS_qOP>7U1zm+9HaL|$TM({ph2Yd&sVf^_gyS3209 zP|v*PaiCxR0e%HEopXaAKNjyU!reoV((3A0$ZsUPrw9Ov*EFz$E+p=;4O3@zeP@^F z2PPAcdV(DqJP7oL*9qmKe_rib2+9Ws2#`}y44938mV2=@2uIS`I2RTc4&4xx7J0Dl zR78Ri4NZs;c0gi0vvXcFn05~$^`o_VVnC{e>Q(@Z0~;d|LJ_d47mohh1FWGTiSpi5 zo)GZ^fmQ=pKZhG9kopIeNh%q(X)On+qLGPk(2*13;U(q;u{=zZdHfj)k4ix8pGnAr z?$N+3(&$gkaPk@$RR@)nd|AkpK@k920cCEuLCnLf*Y(^n_i|M2_8OR)cjs)B+UjiKw0S7O&er^PG|Os;$h0F-id2G7{llg}@4(jY|B3c7^zQg5~4z*5F1r5)1^kENt~3pa0$3x&*2` z!GoYv3A`qy11QH@Lnzmj5P?1=%AqFNY(W#498W9UHaortz&#tRYU2{z3Y>_Y_qD(4 z&pA%_2BNbC>ix{Ht-<)L2cQGX3sj8ePGyF3w!vFw9xC!17%W1i1gviSB3NZ^ZhK(a zxsZSrY-CW@c%l6IAnu~5R5RuE4V(AJ5Ohj;7(&6~^`t21v7Y|uNV@7qiUv|)6A+{s zfKO(EARiV0*jh+{!|_Cp@NTq7WMl^9NC;{ne+N+nM2<_~v=qQfLyi~<4-ki7xcq`e z0Hr{vFkQV({lT(H??ykb_iGWG=hbHCJnV^#@DK_e*bqqawrXuaTm;cmbadl?vcxYw zXi_IHidC(W4jYi~F!mARO|C5>W|AzCmw~ zJVz5`=7Tq&`LV$pwh7HJY*7jxSqhz|lW{9jsb#YE6$>!5@LKTHoLG~Hc4p6LEy%`! zXH4u}5DTR8t5=pzicd_u=PgtWc-Ip$5D4_sdW0`d5rE)R){EO{1f<9^u#WNa^71|r zx-f)uLL}ex^Cl1iA*ydWp*M`Ud>-wEjt;RThRYblk6;uaCve5Z z1ez4Vv8J)HLBau1(T7JP=6?U^@#B}cwNNoB2ABl?K7pI93*f|b6qv!h>F=V20D~0g z6Nb!g9XpkLX|GwD4pLCp1>gcM6kPyRXA#-yjjS0faO7#$5RT`PU~oqIIQ@K}qLthK zIAUxC{nr-=_pebF5uLjZZ>#bV2NwLtYZqN_O2UR55S5UStG>)Z%Zz_*og!BNjbC~a zcN|tZBx+>`0P*)9ua_uhzkz8+ju7Zk)5=wHTz!(**}qF8Jxy^8Z$U27H1G6p)4(tc zO0d4h?1l-~`o;zqI9O3p&wc|;IBAj3vFt(H8DMrUXK%(aw=Ew5*#sjMUc*;$kZfu2 zhCEXL*F31SG%|i96Ooq>2xh_(xS{T_CC5c%Bn*SQ-XiHj5&-}To^aXMsS6$iV?_ zv>re}5ugiEIwlX^**4vSSBeF`3Yhbd!OElU@SHz>@xV)h&C#?3NrAbolgx+j{5%jQ z?ZP-9IuM&tA4&t*3h`4xZx7VpZT$WKiwUR%@0Orc6%iFhkKvM;nYm8CXj$X{=bC;d z;CN{SWreP9vuE={!bdKj}193!G#1D>XwKaopKf6J2;pZ0Q%vt(NVrmdMJp2?{8iL zy8t##>N4MFp-F#oF&HUIW3V!XN{FqrLh8ZrSE(lV&qiduM(%?-K<-M=@_>w)3&|qX zJ|U?LxturPB7k__7R_h;2!F~5MgY1EO)Xnh;hc>Hz$3!ILBXhoT@POcKFCv0=LgC< zkP2uVfc5|dwcMy-1J>qLr3NVl&2>;KCj?G`4;xs{Y~b+1s)S7gDHi2<*#U}&TU>k!%b-wL^;m&O4%t32KUDm5B8Hynr9U+Lro?UerFVA-`Gs}dSqE#H-@ zu#y<<=s)}7rr;W^Gsw%o@b>_m59hm70=LSBN<6U>SQRNi(^=O75j*H7f)sS14pL2- zheVYtW+4~Ie#1SwB@tmMH04IhqK#EikhdIyyQQ78X!^1u0>Kcm;zBU4m03 zWKSV87R;dG2)eZpsHqp5)xLTp3#2DlqJRORC#66#vDy5!ZTWF-JMThAd@~FlL>w^s z%Mew=mjST@8+in}=DvLzR0EF(^l{6n2JE2rvm-#Ay)F7PUR+lkfczl9dMMN;q{W_7 zgiu_X0;h9f3$h8nQK7%6sDFs*P4pk#-TAV~FHr^+*wZX`z0FF&>YSwmASwPg_D?;z z_ZZC+j3QMo=)c(le+mx$90xCa8~rr|dGPk#d7Nm@DY9YzJ6PuzVn3T9G+Dv_|2wi; zPRF5(LPS{s`6C({GiqRD$tiId8L`fYi#i{XG)I!KKQQhnBnP-(jYWU*RqZJuKz$|V zI+Ci3xhZnKk38wHHe!vT=J+Er(e)vC~fqb-Nc9C{pYv zCj8Ge!iTqr93L#ui`;ZkAc*9!3n7_vKaFXq?qk3&&Tj$xW8JG*SDiAXabPv%J=&OR zjivJcdnH`dl`e^jvR=DW@c7R}xvJgrFy2;8ktIcd(uWk(?VJlx7m6d}mLQxUHk%er z^FD${W2Jp1r>FPvY3ixj410iN4>8wvMb^hiNf~=5qvn$u8U~+!{K)MPHWTyrQcNVs zr?z)iUr)r4{wOr!Ypcmt$l%3if4^7r$-^r1bQst#Bg61YduN&Q+B#OTH3Mn;0}$Dm zD*a*8!g~5l8>riDTP$o({x~LuI%n%FJJ#gQOIVkS4K{2~4|s*$SIr@~&ZMPh(CUkn_RGTX@w|(_NG}%u-rn~z}Wlw%hPM&`tl+J6r=t)?A zT8ck?KdT#-Ya_qLQ*YvQF7le$mgo*i-LqQZV1RhC-vQNrf);ZQdH63Hv-gd$h_fGZ z^pC}?wQ8A~{Tf|hbDOttdB%_0gZw{)kqx*`ez@uF?3XGd!$e?vTf~2+ZE&ML=P4i; zd(^l(y8rvcd#w&9i7#v`8d_-&#+zF$s?mkip0}^ z)C$WC*Lmp@xzyhTvzRs zDfXV#4fYF(wLjUs#gm4nx3KsveO^uQ83DOyDQ4PwnfrGM>aYT|)oaKl`RU0-I_53J zjxp5Areb8sadJLk;Z)wcX+QnveEQW>b60@MZ1*%Y{yh9};QG`@Pfg6{=FOL|4&1q& zgcqKmp3qqWbvd6Y%{M&}!>PRyze<8tp{(bNpU*k5NOyLvV${Ox4}9~{hRwi(u`ZKU(}JsK_`+r8mqS;5aKYL(*=NBITiC;{6N(@iXWsSj$se_!I& zb=1ei{n4dy>!teg>{c$M>)U9}&nFPqrE@t>g!OzleL4bc2$-E)TC_}I$zgs}?+4usJ z!uYD|Pe9_EJo=xQ;uITh(QHe6CenY$gI_B{8JXh)j={Q4hDu$ISsFjV^G*Kj8ZDXeO(Y1YKkEpm~foaYH*v&(jdl?4s|vD8}Fg31MO#hB5Z!@v_>~^|L^ma%Y9|j zpGh$Mzgx1PK80(8tP@;aSUT75-n8GCc>tGV7xC9>8!3MMwn$Q#7d7|Jb;ztzmArWy zjd}N`*{o4n&xfRE{%#zVOX|7XWP7KZ8@SwHzuimh*c`t&tseEEr(cy0BD=hSx2&?) zYr1~AWtgAAe&Cmed}JJ$98*&fWxUvPA~zj1>`BsWKNAbq? zUn?I&f$VipH<)Q5A0=Q`f3qZQ(;42E$<u3;}NMfh18Yb$wJ`f;l_CtW#r=zMLVti5~29G@kdL|DGjtO70det0`{(ZEn z->9*7J1tG43-p!G+W%r0Y|-++9Bwdb+GcS3e8tMMzw`7I^|F0)Teif}h^B#)vDa7L zx0DN1+yQE(?cuExN!Tl5{`}mhv+9cYtrtmQyop-!i**oF z*Vex4U#}s<*|VNA*({1?g`5>7Y9TleqptV-x&Qax1w1<5ti|@4A*n*IxcZFGcS_qd zA8**8=I@mTYGy7XmaGJ3BSX~^OvRNT9Lh}ZGCjbnU#1_+Ok3Gsx!rXc70+XD`>XedWHwn& z&s(HW4=4wWMuU8B7f~6)pOJ%qY>4S zW3FRWSRR=6s0Ab%9a;8ZiuhL?mMwjiCWd-OvW7ag^^W@CtCKI6uyFpGaOZzeCS2Qk z#j)D@smsc+SVMA6PvwJ(qh%@AAAK2y!%9rHP+N-AvVqK%qd_%%`(VfX(C2hRkRx*+ zF_1p!dui_yU(1pLoB%btGNQkH)aMqWC#T4KlAC!@=#(wQVfoN)@rP@o>!*)H<@Ykr z1`Q1vH1^D|3s{%1uG<{;C2R!;_+NA2jdYrt3%W@@bkd!^w{n$F<5A`)AD@A8%J-1C z1vgrHdfnAuUk3YID^5@AqD8jR*mrsj55mU=f=`~LEPZm1U9It5;5~f5UDuk3gVU*= zA~zm>&Ny>#VbJ5>;eou2rJ0$DB0W;OLw1|hU$@wdc{~2Dtcb8wft=dwy<3No(MINU$(DwD%2fH8qlZHFYn2bH_LfFdhEqzEvW8UK`COzaOVV@ zIQp^XoTsjgUC%46Q&(ih4<_HalLODjuInpHvhJNdg4y-yKEJo}3tQELOB#E<^{v1k z@0~spQX4V0IA{xqEWN+8SiJg(J|v#@3mXD9D>WD`MSYc7Xmr$0gTgjRFw^Gg~=V`Q5x%L*dx+a4lf!Aw%HaL@t}c$7{RfNy39{3v(9RoVSi= z=R5Phjb@hFlgs~IMpTWr4551KfZNL4Is3b7T$Y3aG zzmHMv=#zzo<#aUqc1WNmKC69qt=P^Pc1Wy=1PB%(IQMPNl+O^Y`NhEH?7rK# zx*l-3*7x6gAs2|POn-Y{n>*}JGz1Pn&#ham^YeAT-}Xjv--`RY6?9N|tJR?2R%^c{ z(*L^y&?vWO$D=6>9*5VCK&kBY<|U}0D=WzMX=;9T#4lV11buc}6f}7eP9S73U}jrq zKq*S0`Rx<^oAZZ8^<#Tj zZgZoH$4SxMjTqq-8&hBZKRwBtgAo-hDIuLDvDI~8zN51kH(%uabrUgn65zZ&2aIV@83@@;5Sl#{PpxV_x&$)algqPwmZafdOc|`Pu-L4v zd*9TmI@oiI1+8}+?IhS8SZ&>=9XRRzgELTmnUY)t7;&s(9T{0-E0x=xWEfMZ(yntX z%Cde62=Mq4R3Ch3nuSJ=6G}#T50EV*qiKN!y?jf)D#wbJg!-XX)!uEm2$R3z-OKWR}6+cziSF ztw_!4j(H}w!;AFI4Ua7U^u1dAnqg!_udFcjOq@bG>R2@JdvfYd#(Fzf3UpLOp85u;{TkVlC+gN}c$=DU9xUc<4&pRfxXb)mdLJ0~c{= zG$>HLpyKb=e-G<8djtIxEXVvpKtt6rDuBD{#CIcS{cBG?yO*0=m((#29MY968R^NC zxMRD_VVq9W5!FbgrTpQkznhH;=1IlUS4qm}=%;g5?S*UxE|{~ut2^n+4gj+v#Psxp zGAlNWMr>8n2h4M|w{5B3dMHX7V^Yw>au^UqpciMv`r^n2doC%7~49n~lOc$fzPB8P{mf)Msu?4fd*N?+4 z2$)!#Hzz-B7|EK~-^t}gB}Zab5i?qaIi)$#tHi}-#G4LRr~{)Ye{4C_-A%rl=u~kO zoY^z2!|!NT{b1GvI#uKjq%IxhhwPmer9NCk_V6C0z&f=S`*OBEL#ON`uiM05D|MnJ zDL>y`JN~2=uA}BN@L33|EJU@c>DDUu?lS658_igwEIBR(vR0?O$V6OX!Z{5GM+ff% z&f{0k-JS|WjPu>yR=(rm(x9H{q$XNEj&Y-<#>@R5Yi9p(wZ3vTl(fiDHgIu-V(d?^ zEOE61C_Y!9uP_BeK`yeJXRObV`9?V;j%d=UC!%2*z90N{)=9ZQ?S`V$KWM8?i^JCM zWxEIJ#;v7nALQMz4WUn>@^oPql*PRo{Pxm?=4=uP&*#`bE@C9f3d|#N;|%AXh>?8v zQ%_tzI%1rg%|;W^(rVXq+$pAKz+lqnnHl3KidI?xj6sD-1y4prcA(u?d2H0Z?@hVY zHnC=ACgFKsyPaZcIu!oMDWCfAzQA!IFURY`8U8N3%8cLar-9C@eIN`C?#H9GRd-`~ zqah2?71~;X5H@9Z_rh*&dHr*el6~oX7FJ_SOx&tg{F zv!uP*_L2bqTE}kNL-|z0<{ql@+@iqph@xr!#mYW=vH`75p^D+(V{czX;GEW1wI`A2 z`$C*C{>o34aQOz)yh zM%7bkB-}y^qew}?B&;wv@X58+rsn13vx|058y!=#=4@O!pMCzSx}(k8Uq(7zSWbi{eqAFcCtk2+245`=7a%qfp@SEDv(VgsVYtM%L>xr9fv99+hDeWCR za~j6yQi)HB`g97|ss88J>2$&r(+k=!F$@%*#EvL=1|5WVD;LZKWc{kj)yAP$7wzEk z!Ca)IyyB4FN$jKUeqeGK%Z+n%I$&>Kz<`-tg{c|C^TH(9Eb+i-d;19g<8>ROpCOUw z&mR@6un(SWTnJ0Brr=?pnsOWV5L+YmQTeLRjORd&@_?$&kOgrLXADn2f02&cVmD_* zUL|APe+s%5TbpoH|6=dCgh#g3>RM%1Jg zHF)r@`QyKFTb#u8NJjU1T8*9U2%{0tU8TD2!H|?b6{~mWHS~z9dETyF#MwQPRz_xxydwbAL zL}mZF;upVAYmLskUb9ZnqO1Ag3i)iC{mF;f6&X3hj=*#t+qQ(zUDsN5N%l=x2k~xQ z*7Yq?txcA@O{jIijy?@*>f{06=uqOxp-kfBCgw!N{RcI8EqgIQz+lX#UOCw*thCR> zBq-aI+|hsyN^tu&`&xaWmiP)#1Ral`bd;`0MOVJ6OtD>a_o&Q{rZw#XGvO{Gy1=V- zywyUWO^b=#iXR)<=Bp>`>#gN{;dr+!C00m`mX4MUpFBMe9K`+cdM2EkC*%0fl$DpY zkMP7J%H%qk1p`BKtxk60?u5L}DCJEF&s8?OKd~?w2n#QRBC(Ro*70RYVf!}fRfHnGJtbAKC3hvQddH2FWVaZIDRv zaJ?KuF`OQOQkK(aQ{8jjZMN47cfH4HQ1NC6S0Bk4|5`taG0ak z`Mu_?_w|c{E3`x{dbu9%z8lS#v5TYpHeeBDi|Eq#p+Z1sl~}Nf@AF$)4yEkcE8bHp zt&k8=?Agk{c>^t%ik)^T3z4<1N_1_=_M#3gUhxTaqW;&b05ypFamaTwKev=2-?i8) zfv4{1nEoUdtI--eTE~(^seQyOp!3r{+X`GkNnf@=Xs9iQioA ziOM;PG2JNz@8^7OlDllSO(ZX#&vsC?W0AL&JU)1f7ggG%ON!jqISTd0RCIJZo$9%7 zbtydg<)-`A6g4!Wg$G!=xV#c`V2oQ^JouVhT2EdLRVOJ@RH5oC7EfW0RymV(Ie2W_ zE6jqzcf9oeY%bkjfA*>FicI#^TC>S1H%up@<~AlrcE{hz&6hJq@1oumaUJi&0|OU{ zc(m(lSKBBd4iP+6mjoS+##v|q+PCPCDIrpNb#_Ri3 z8r+qVOmmL#yW*Z@osnEOkg#st7)!Oj-TpS3X8;gXCEHSr;?%P3Sd@Ga2a9n4!^8em=hHQwhL8%TFgK0zGX zS4qihT*U%0u3Wu-?eb*|%x$b|n^!Sbw>CCF+m*_5qN-BhAoQ|CCqcoRZ*HH^+lW?$ z`frl%*P+Jf{Vk(ca5wX{wfX4nD03cil@*fOp8h#EZ4G=bd!1Pd?^Mji6N^vV-u0hV z@Q7DLdbKa0?>ZiAHCwZ$*oSBKGXG|l=wy~FU+Xue?>I#_ z#WpTrck)t+&dbyeUt&wl)s1oj^P^O3nv#mGRadN$Z*P%P0nnU7Vvv{CHtp@O-3|?Z z!ZfaFV>1)wFf%lo)>Gvu#b&4s1P!Cg)}j1Yl*WQTs-H9bOwxA>5>u-l^At$37z9AkB zdqoTMyMu?qmZ{Gqcc%n3h-*H2Q`R45jcDdTHPqtQY@~8QQmO*k|9C_dg-qxQW@2NZ z6J8-1d2{lwSGxsKXKwu@;Q*UsqJApu1p*$eVQ?n4vn3zc)b)Rt$d%g%OeeQfYER$U z@|on6yDxgwvG5LVR>DsoJEM@4#W-Uv(S_jbDk@{K)VsEW%?AN>E1`a1!9i$mG}-W_qoipHd@CJ6blK=QxjC9<7!byh;qdr-#H|-VPi`tXl5+KAA>A zM#E0OqaCLZkdKel$kxKXn*n#SFeh>sX9d*6vV|~ctn}MS3JFDx2$T)Sl3$9lGd=VO zP!Rig$%!|nv-bg5^>5!tz8z~kd)B8=!wG%vEdv%hHQ#b=>rIn+849mrUFWo-wffl* zbi(SRBA0JmsZwq=Y>KCiGBNKj16btGHd}jX)?Q)$_^~d<&=YV8!kPU5omyI1hOLdg z=VeCs+QqPT_y3&K`&RM8F}s|gdzP~z-m?3SYtv`)B{um}E|$tpy?pPxx!W^1&2n-F zj$H#msXm?!qf)2F;RWtKA0dQR(rp^g|8!d$X=zoA2(0pL6BqT(?=kB4Mz3yd&2LLC zi11nK{)+MUvB4FbKT)dZ(i5&r)Y{&)$@USkSUW0h$G_I(^5GIF9#u|zu}B=eUWCRX zOqwfyv7;YiX=|Tt?)@BzZf$J>6Cj-O5P(c){$Q7z+vmG1_v=npZGC--uXgLcunH*z zl@e*Tb{)s1h0v4~G4x^Xt|YCa6hG=@j@;SB;?_c)u+JyDH50X$=Ha^VgZT^$BNb*_ zq}bd>e;ES(1x%O}G7>8GXMT#v6bu*?Bu1AU6zUEu7pBZk2=x2r>F*BEU=0}j860hI zY-B37FfPAy?eV5}y`bjA&(^)YnL($xgvNFpwpNWSU&m7jNQFQ^U+WnI`xVEH99X~H zHBfsszScy4XT5f|{WJdYlf4F$UW4Hnfq1}VznBfjHoNg~UaI9LAMCDlVufH_=60ND z>M@kQ;E&;^^U!>dHPwSz<0$)3JR+?2u~bQLEk& zXZoNR!^p~_KtBkH)O_MunVn^F7(S*Gj*Bb_x%cqS-A&O!kT~={F?~Bea6uwKx3lns z^=)FTyO03NRZ`tWZgGjrk~72jWY0$3ibEI7TEivA8!*+N&mN2(QiQKkOWq;xl$25X%KatlL<%ykt~4d1uELYcnA_I7^cP(p$BfFb z=si=FkX+%>O|I#+c9PJOD=D>#2hgeEG^n)Mt<^fhWYZ)sD4ldV)gOcqANagpN_C#i zgtYb9+Kuq|!AoacfP3Nlf9~OA)+S!Mu&0nAJ21Xb*_q$%+Pc!v$X34AN-Jl%yH50K zYLM`jVCZAZ)VPmz?ctRxvzNn*MLmnucwl;nI6y+tUn7i$EK13~Vw`!M|&8!lx0=YgDWZe_Z ztonUDj%Ij#m(KRmzpiRN#q{@s9&+YH6y-`!tMd@|GN+Gr-C`8c#Z>K=LBF(Xy|NqQ z{`p?zk8!%{j(4BxKC21;9b9x|a49(~cGqWJ@j}I!acX}Ro3Gt}`5SQkLs_c5>0h%B z_SXUwR{BjRV&j6hXf>>Cs@r?Dhxc)`+kSGrJqn`n^|@Ov zy~?P+S)PAT;07tXVcyN@Ge`)fD#*!MmzA?@Xu0evu=nOwBJjQI$P%`~OJe7)+9ny7 zSiZ!a?j5yCNSx)gjGLzM5f86Wlg9mnnu#hy6z*^?KcK%xRPggn_BE@j2t!+0@O!#AZLNz*s0{y{e2YdPRdw z2fry2M4MQbZa>2!DhSl7zSqY$rjh-`4^xVJ@26U1bY;6yg3 za=JFF3Z?ka;zT-_cZio=KhYPz*Faqom8mF7rWBSj?y)@CA5@{n!0nVR3*LO$J5{lPQuy!bd(7pLV}Ai zA68?JyL+vo;oe%+r4j5la#!rqWx{*5Qf2800|Hr11|AB}u9Gb-XUL?!0nO8vy{p^v zK|g?|j9;`m5wBT}vZiQ5h_|jJ*FwfCIB zKW#6uF)*~JS)jA4fQ$h%j=Q&nUv&`9{rj;VA;-6EV;r|WcGG;1 zpKgoDS6QKTxBZ`7vNFmIr zNKtu;hn3axa5?8{PafC{o!XUMC&Ug6_l0|qH)DFA=$@}dUwrdM=Gk}E;+q#7!GpM4 z%c~AYzfY3Y`2{dAoHe?GtGSZXoT6eydt-g$uMfVDT%;T>A}EG=%=|;`<4!f9g?*Wa z`?F}NE-v?ajO&>1;~bbI0@fyn%cs0J&C{hcPM_Qv1C|0m-nP~o2$OLr46QcmlTETe z5v4r1&t)A&Gk0%kBddIM>L;5q-_pWc#r!{WdsjtlwTttUn0oi^S=)8;<_J+asu(83 zK&JMGBTNyAu#)bBD6&Z{(U2=(G?+Z@FlWilc4 zM9`=4{_tl|WGVLwm(?GOA?>4?I}(4tACG*WJ{G=D1p&g=!ske4oZV80W}AbrOGvhP z`bZWvHp6S_Iy$A}ak9~Hv;yLV4c2loU$7<2sw|4rq&#r5~ zg$db^D`6C#vEm1o^=TY-n{EHFZFO92#TD$&-iS!>$jtmE-`c>n?4G8cZUA2I{(X>M zyhCu4U~FaOZDobXvy#fr65~o6VPCbqjr(D}s*7DGLBfYe_CS?$SWZy$3FoqTxSZ>_ zQF*isqq zNuefh4GcDt+>$#C3oc(NHC89u?)D_)YV$mFw5a9^q{cqnb=ac2J;>0>t%bQ=$zikp zNBd~jiOK)esg+$t>`L)s>rXJ(P~(6NUzCY8>IB`Yudv|^_txy0@3RRBp&cFK$@2+$ z%rbgm9CX8hVei`ZH-5OM7H7B1E^zN|NWQJRkfCh3xbttHx~bWl_aQzPU0;vKI(T@5 z+G?9R<4|U7FI0{#_%U2SUlo=?-f{Kz;XM+xDi63bhPU2bFx9}txj)^F)huYfrwA-n9h5dY@ zi#nXD4*ed?!Fm9YuJY){J+v{}ZLNt!k8oWI6C66Cl#Sz3L&463h;S2Dra!FVmrI95 zxZqDodV0NuM2=}kkrRZJlpn2^lBk+KhnAX|eTK*X{u-7~2_EiAVH9D(`pmQVSAV%5MnVQ{0cUCj5B|d+!y_=6 zyd-e!_~RU#Bz@?ogCeVFhk3j0vM}C-C=KSwf{Z1g1H^dnVec#xf1m~Qa>YuYC?AgMVrNe8E_ha4RKlk-|2mx^qei;ZF9SUM66M}qv#D8~P#0O;8Jr7IppaKdLl>ds5ZFlWr z4MV`_fe@?A9RUN+jbu<%vJEpbaITmJ|qT=Yf z3L>S9pFt6Q$-i+7{ufbS9Tw&Dy^RGbNQi=ffPj=BNH-|02uL?bcXz8G-AI?xjdU+4 z-MKWobT8et?<{`4@6YS`gUdhmnVDzi%sKbD&$-q28dBG2JUp<7cwFy!s-(qD-#b0C zg4=Sw+DK%RuT7$o&_~D8{9HN_c7PqknV!U}AHO(5R55p<|Fa74*9h4%#~( zF!p*g`Ou>>G6xguP~{0VRrTi)nh$p|1ZNu}`?6)O43q5bYBO3S^w6=@O)CH8oZhma zqC}f7LS&@MMVjj4FKnE59IZ#n#AY?k`@`k*%NW(%I)>hzy)qPineip#x4*OJFu1U* zE_W-<*ZaGcvw>Ea#SZNu_KgE$^9I~CZ{L_aR(D)WGb}H-1YBj9JFK>xLwwUe=-xWfb1do7le-*@w{nbZX&P4R(BBqOgm-S zs+X3N$ZMLEQ3x&RqwOpwM5nF}e-2%DLol0cw(C*DVZg&I(WPT!8FuSW8BT3w@4M8b z;z;d`n4FzK;P6g|v25~xhh!JZ2dtC=xPSlXD{t}Jz^Tyq!SFU{y*FnuTVLsV_Wc6$FxIoH zUPVi7C6k{l(_sA*UROh7G(K}xUA=`%XYHErYmJQLOUlP4uCy4K5B5evnLCQkZ6~~8+xxp?md5-0AB)2=jM<(oCFE@5MHW3sV$2sC zVMny@;wj-vUCS|ziZO0D z>+x$m@+}G1g>Ga3hq{g?zGJffz(EfCY78B-5;PDoZ zki&$$7~X&D!i^gIv>vO*MVO|?sp6I;1ZJj`^LpYnC3(YinACi5DCj4eSV>v-S`9};q3I86_1VHKm36Wr19N~&E;J|bFA*b`~RRam*?P+HWv{|$3mzGNd>fi=QY@? zJeM5kHUHG4m!y1@@&t?NxXT~$RIZBFqBLK*vD_uI`K`B@oRzlBj7E;xY&Qxe!z3hi zPW|=B)Fmz-%_MLVAZWHD5S}l~TUsLoKxk{Q6)Vd8sH+rWl_tX%m6` z(WQl1<#vm_&m7w`7TKW=3Q&n3b6cJtD;0$E*jzP%c0;0RFjC#1Zjdb z-n4jf+yysj&s0=m*oN&)+1L^Wote}9?vvcKF_}A9Va!EL;9JJp*UBqQ6 zXvwagT=6|XvGCJyM~BU}$3mFas;EK7w!Kcc_H2`ig!ITi8`gY<3Zkx+v>~nE{|kqcc!*M;T_o-Jtw6Y}jDy=waz5CAp1SY#lnPR8CnK^)m){M%4A z-n}6DxGbOXupgMm44U{DAgL*Q{ylz^g5nkqdjTTi^I+QuX%ag6dCCVNaAgAr6NiA9 zjFFOOviey7V!a(p>!;~d53?Z9fM0CT!V03?ALp4U7$YSYGL61E{1+vr+)VJDRqFbP z?!kbjO|Sl1+a`9f6ew&s2c{Y<|%6T>MSoMx?v@GZ_B4=5NI|n{(xo+ z+IS=8=FlXH9;no@#36!Q#J{t zI8Xf_>TUn^WLw$(^^Zj1jDr78$tP>u$y!##bY$%267ydfGrt6_%qv{hurZi0d;xc4Ou(o_70>=i)^g-dO1!Mwz)O|M6ec-^5;0 z^YmoZZx~#v1dA;}RT4?CWX_o2fB_L;lKAn`aC09jky3h7;_-70WsbNEj8?t*9bn&8 zJGk&E%MRvT%iG+nM~LU=-}S4K_aAgggwv;6NKIHM6#;WcAg!cT9(lFYdbIR$+#;tW z<6?leEk`L&KHIRTu3r_oLQ5+uI%2RjKr(L0zaBDsgVczjTpe7zuFmcYgU*H?6@}#L zw!m^*bf0~Ym+qgwjZOG`3tnOB7;H8fgF4)8?^Im^0$x&s++eGi*R@e?K*MpjNPmrX z7i6g^B{>4_eN+$lTHD-akEPL2hbNK}4HMYFz=6T?*hG7}FNo zqaOo0SD^lEBle(Ahs%i;l(c@|63nAq)xyV*S-@!_NT2OyA`e4RuNXh7*b4XStxt^D zE+aK&oMND~texyaK#Pga);kbl73)LM(Ff6o;OFVkso5Dj%>dfj3iY}$O#xGw5((29 z^Rg2jv8vu;NnpI=&m`!%lBlo$@Av&tzprR#b_}MVCFP*SMnO5m@}8$QyUwv2AmH6G z7wK~x>nCJTZ{;2sQqHHUHY$VC7S1)!BR3Z;4T9M|26{x^rO zs5!_i9QA@Vl5R-N>)CE%f>D9J#BOuypvm28+?ZCV-Dn~2wNSF^J(T%5+|$ra;Y8yG-L4jum20@cPy*TDDZ4iz`AKp}V~cCT3$Gbrq%pRJ9XM5b0Dz z6pV1<6_{1TGkm}Gt@ZLQI20nsc9eWQB!Eqkz@ytZX<#~;ZgsR_NLn_x11MNfnE*}M zuI)*0s}E*jB7gra6beOY5CfM&hsdh7Y~L7Pz-5(7N%s3B&Lgm&W=9M0C@5E12S9?~ zzOB8fSF1(_D?Bf6G?ae61*WN) zK{HVH!ewpd2YdBth>e+>%m+6oz-l@_dbN>q51FBuhnw*l>E;E9TR}OGsYOIz_C0zi z-1w2Sd`hph%6$5#UYop_jx;@rVWP4)>~@qEm!i+;c9Ri*`xQ9kUsT>`6uO=fG%8#+ zN!RxWfNN)FYe^imVOm_&59kZj#jc8;C~^ESWWCTse#l#4P^r#U#9v6)-9avx&;7y| zPz*%m#%rJ0H=cYsb3KD`=RQZRj04KtwWUp36loRB>~|q8y<}fEme0H~U-yz80XaXN zLyTaXAIh&cgC#9wLcri(yYoaQuQ7?lb4dFWm|dz!*_9oD9dvYQfAZ9pKDrAq9dCJw z$v*X@DBW4b458sNvq71?pA&#@@?~Lb|9dOp6t?SGq^`y|>7)C*q?0F;;*JdKq#pol zW8hg@vRa*@WOO@V^nD}QHj`Hp)w5^XB+Z;Ci^G2(xbB8A6b&^)oNT{Tg2E86Y?+jO zF|}@OnY-NS$+(dt#>J1GHFSc6hukD;ZeO@SV&IG3ro4kN+zKC99Q(2ZiQ_aj%Nb%Z zIXB2bF09r{wI1;U*j>In<)V;JGTbAfc9eg#WMtN;&kv#ZMu76oGjz}Ek2b%(e~kkR zLizaFT0A(2VW~CyXTPcQ^Z&)iUogQ3db{T^zf}pDr8P2Iy55UvD|gP$G8iwEuX0;v zJ{TtInE4DebmuRKZPq_Ceu*bQ1)rAL;#ZxS=ROu&==gq0$Me=_MFUCw%N zeJK_^S?99i1ZL>Wa5?f8gEg_J)Hd(eudgQ@MZcU0BxiY_K0>FaSuJyxX>sa{UIS-T z>8Ra$M`#0jBvIbAzm^e7=2;;(ulyzfvFz(J-KXU~5Ps?vv&J5M11>aRfSBzG*Q$)p z)mCHIBy#%WM3Hub5Ld@Uu2oyW@ULQ=W9J?&GJGp1I~>qs_i45+UvxSh^tfopC1@_`dW&~Sl4;u4s1R*vWl*Pk3^XOU4~oX zb3{{kNqCzDl&=#xa`mJ4npBQNh3p~L;f2TN9AV8JBS1G^UH#!cKW4?va=aS)U+BY+ zT2v3wlmNuZ^^ck7i_+TV4*fFaU2aG%jv!Y5F*%ETHwqe_H-jZ-cPar-3IQ5yzot~- z=9y;)##OWx1*^9kiu2X$F*eTtDFS&r$w@-3s0t$y3Zzd*`FcQa%Dd?2 zvGk`}~Bg%;`DziFb!l|Ez%Xyx@OdnY$w#_byt^#GVKth9`etyfvh6 zoR&J%TFreak~Rr)@u48i$imUAN<&_W$5Zgv`>Sra_ko?$@#`?p%SBvxQ~2>!oLUp| z02&eT<>7LRr^h2fbe}&zFSp6ZFUS*V0D7Lp=MC@6aEtXPYY+i;g@}7zRCgW>GUW&- zdZW~->pC`^9dh!^?dn_rdQ$FM&9egJ!c7xTxoeXL*%S6RkH4Tbt)^OSjE17DOY=0! zDjV}T&Heo;o1O5`CGzTWU4z`U%rr-0C-IGWK|U}26e1B~a}xiKd8{_0fq@HJK|<=+ zX2zywX;c6;C`~9*E^jlcy574}Flol7VQCb6g#osOwuS3BpO(hODKW_4FLpP}KsyB= z@$rcRHdaDoa%XQR;I($XX5bd^xZY#NtirN%lRb*lar?a8&{%yyAdMg0wXkLP7cvwc z&5412DzK-jZ@hC8E5dxhCCEP!d9{jh60bc798W!F8pNzuooj&~GFQkJSdJ8sQ-U)`^~%JDwi=o2!wL_&p{45pl|V;Jx`9j_qo z%}<^j=EwRBsX!3t4sl%M#|L`}g8IgPU|YqnlUirG1fkCM0t2<^&u^vx zoo^fx5xjzWZMsqPrd3sf@t5$=emnt|c|UZ;V-cY(r6fw;0L#`)_-$|7)l>-A36NTH zPOcj@-`L-Qd!1K~lkFcJC9qm1EmGCRmXuI%w<7CUcm}#dMPv+wcp?*{ikxvz9M?53 zdjmJ&mp@y64)8g;JFCm|zutDm$BXWIypnIr0VpHSE2rQC)ypD|n&nie@jbCV4;Q|N z_T=xMS!2{9uYpBQmuXGqx1(o&x!c9*%=;!jsX&f;;X7@jy5+{)dtX}?&AUKcljmg@@sp5=PTKf%S*Hy}|EGs^Ykzi>_^8b07EpHy#kT)8R}6NP!@ zeWwz3Me}(l{%FhM4ITd276dm<{zukvN+^QGG_Ot1v-IGK9D)qUc)YOyVvRt_kEqN4 zFf&i4X+Brf<#)hK1(}%-B}_tDIYvNo!El#w;QSo6Ae&E94sAPND^#8))OpQka~j3K zh1z;w^iYU2e=iJ?vFN`)A0+7G~{7c-8&`2-K#U@lPt8nT{~#@Ql? z4^SHoR#8N`KcrzvTK1E#K&9YP0YRL^IQFM}JP-Rk{xTBNmRv?P*}4iO-2@s1J!dG) z>$Jb`Q*#UzFST!wipnM)7>oGFU=c(X_IemwD`FWKFFSf~^XWrsEvM1bJPs$MxH zC@HD`e$ynB5#73K-Oakd9=s{(csmb}g)bcwwP#Dakn+MA{CGDxo^Bt>H@Kbp;)$OWEI}@pKoMZ;sKTdNU~WW{{bJ z8D_z@o+73qvqST;LiBgOS$;mRXO12PHP3-hoVZ5sSWar)MM|{>a=PauO+kQfof*w> zni^vjGeo`47p@b#v90l>6(`;k-_U)vR+( zvVQ*eNO`>-=lk`sbuL9e{=E=--OZB7%RlDwxhdy41foz00EWET!*%91Hx-J^)bMOab<4hiiUkpI#_96^C}a}QwQbw4!_loNC}qAP-Ezp0qqB<7t8jirp#cLTPUFUWo@M;~9DRH^Nz)rX_-L_Z z3p2WtT|0pc0N3a!p~B|Ar+ynLVzP<$Uiz2sSm@sUxka#gNu}w+l=4#R*^r#=9l`kY zd^3RQ@d~<*>v$d2u5K5pmM%eSDtuqgwufjiR{f!hMNGMCm!OsjZLSs-0?b;f*)Ju1 zwYQYH=&hWz(Be1uPp9*&6I#i9?XaZ(CS>iPFr6+V)*@84#||cLych*1Z30QDi8`e# zU6E9Kn0Q#F9&{e?E*b8sT;{$TctNhBGqWRriZ{iEHt$?}uWqrne+}Cf5^6ZXQi2L1 z_FSepA6=ii<;hc6Ltw%q72xaT>+|E4s#}6^9bQYT4hMxoV0gBu;T2hGI-X9yJ4hJ^ z9-Dd%Xc|0GRp&^p6hklu?zFzce`p6R43h&zw^I^#4; z4I|ZxHZ*oVzJK3WOr(6#=th1oa{Fp}$QaWkvS$JcveFX~ zt0Y{-^3^imvBNn^RV{VA%H?-VxKxWa;^2i7kl=qw3M)cz2x>?#?1vqDutSJ9f{gxJ zP0q{`lvke3a`^ZJca@uZd&B<-q{=@zbDLk;OyFUfK9ScmJK4jOFSpwf6nkRnj$q8~42c>I|Bs8xI-_Xz(P1oETXS3gi6ine{XmhyyMNSfju5i`K z^mnmvzJk_BrEH_O;S2M9yV`3gH-6*miykOx6*iPtKO=~f$g^kM6r$A#+$Hcy6FDdW zSYX^cS>&AFRCY7GnYzW0tDK;P_eVF;aZP+RzZ+nGe)j%cV>b^grHZX7OZct9Z||RN z8eU~Ghlev_U5xNKN`$Ei2+$%ozb84mV!1E7xmDX@Mh%yfz|{=5*2V=EG!j!RJvI^a zu4gOtJ?x&1PAUWEs-BTNC(iFdE(WiwyWe?(3HJGKbef~lOyA#dM{@T zkfq)^xn2zF+;t@xws&xU{v6buSk7GfRuuX@dKG%v&9)+&nY9X;y&{b6vhx-_h%;~8 zHoWr12TqQG@ya^slDEr({Q+Tp#RKdI0g#9qQ}Z7%wdqp_D`N2RQEVG*c#4En<*fh<2=o9XXw{l1TFJM(o4bD z1=BTWfKs{C|LUBk))Nq`X5nd8rK%d@Rc?^;;I^i;Pfu*G-&$Ps1|C*uu39O)C3CJ- zF!(Od>}Xn$KSkIQw~?|;U;${_xzMC4aUfRkFPv=_LJ{h&OcS%|%3M~$0^ud2C${sG z(JC^ejn4@lpGpRw^8&1oc6w$q*D7nNH(5@q3RqLomn;I)8~J%FVRjr$h$iyB3Uy0M zhN>OaBcjH|ns4RE+VZqyNvS@k4W>5j>QvdYvkR*kH(q)ksU5~@qw+i|iK3~RW%hsB zoJ%U;x(p^{n+BybURq8su@ubA`}77ISrA5AF$)zsNBq5ygL!_KA|Yllk$g0HM$@=B zGZz^Cl3DY^#*lecU$&rj?V^56>L6cO2j&Ct;!aTDf?@7qUF1K_1tNKPxK;sRFJPuNY3k8^QztL|{$m?Ldqj^4_m$UePE5Kv0Zu{{W2OBkt~ZRvQA#19k2YEY{9 z&|vm8%*mCaa^3Pvj2kgf`kC{g5$wMoH0P zT4P@4q=lZ(Z#)K1i0~5FEt8-d?6ylpAk-21UnNYxhbTNv2QA z4%gYF0ejRWzsh6<8}BSL*gj2yPji(v5hj;0Q#sme%iy$@vh3}$?Z_k%){aG7Ckm|~ zG;i4dTuabDA&j>?zi%l%E97-}C3IxHFE-A*<5W1Dr`CE0+=X|~2-0K|rvY{(V^?A) zZ0|(7$W5ARu3T=_wzR1xr9w8uC-pTi{}_Q|K4!(A_m6UC!whi)9yzmNQ=jQdW@tH$ zr9&F9iwF5FT7p|P5=VBCc+^qF?#;8?l=9h%YZoPzW1@b&+HuBZYox2*bTUXy2tH!g zUAJ|d0pr+xqjJhRL8<50k1K3Ve#+l7=9Tce3{fp<_5$gm$MQuVBrAoQUUWpI7<~ND zFZ;1y_5&*o%_^-Hmv(io5r)xk`(q)W+!s)126QZkcLZSzm5|>li=WZwP|Iy^edG@LL#{$hrEE_5xB?*b=^wy@6hYT&_t8< z>_Y>6Jv%RXc`v;(7J42bdgzaIGb>N1tfWaqwpo5osJJtJN#is`v@2qfwnRK7bevBL zun~@DCmi#$1U!u%3abP#jdBRal_GB&1 z+TjudO1gQpny6BsNJB%9ScTSudRqP>ZFhdUPUO|e6hz_V>Va`P$acT#Hj8|>tWz?Z zWu$5;JrYaC$KkT)j4!@%FM^pPReLSFw_>T_D9XWQfCJCMDMFZc<$T zGJN!xPO8aq<(7+X@|xf|Yi-+r~hZ$sM1|I>_0s`;j0qImfxjSgkOl z-X|=?t19pO?s5n^d~~MaWR)rKgJj*A#_<0Bn1onKc+m9$VL=R&qjhC>=&RTgQn_ql zmq7VH@0Pz&Qu%bl)#~2+cautUF4p$4$r0sbu*zgTD}j4l!7*(4N>e^zeULQy+0|!7 zg1`4=v;B#fYl$o^pdm*+^)D~m2jxF#iP@oKP1*{TIjJ?k2BLQ64G+_X)SZoG*&mAO zJ)P|wtD(VfZrnjgW`VTvky9A2A2Eg?&3b>vd0_eFZJvl}y$A4&kiwI_FCER*x?@`c z@4j9mUDv-NIZq9?)_0hVbzTil1BcS1(P@0+7l)#BlK1I^ia96Yd9{*-x|@ai`9cO# zNO$7J@K3$74w5lTM~R|WS$|35fF9O*z1R{6i(f4&Dz@jX^_J5lt-}c%Ho5}mBHp(B zjPJY0*Lw@kbgH4h5ofHgkL`-xH5#V&TzsU0Mac3KN6|>M^X5NWc8Efmne?n_Xu`EC zO;(%$!W?^AKwn>#Y%#gruaageXy2vXxCn}GwJnu?X}TO%ZZ;Jnc+cnryC!*d`m`RWI0WB$bT2C? zIY^fOY1-**I|4n@e{3WbFS@nK~#kz4o_y~P@HKv}qH3$5ca`M?951&6a16oSV9hsTg%iOj} zLTBgoO7Grzz1A4L%GBMFqiup%eZ207J9`BQR|2tWH|e7w3JSLRi!HG@g%Qo@T^u#> z#nIV|oNX90CEl-JMVq4yCF(J5%RMp7cmza>zdSzOyXdJqTsvLqkXu%B8y5uFDW7l%oa%(LSa;^BUt z;wi)lM(5_6pExR}HY@9u9~KvyZHx+Fcuf={6Mk*-@L+}~tGX=tUgbd0MGg|7>ZAE` zwTd<2e?Bp@rdxDHfJD&-OzkKSSurTuD=zgxUcC3rH`JriH+Ht^{^F8!qRD`BUEEDL^Q9VoiQK2NdIqJ{UVtOR`FHhEm00^9z&L{j`~6bLdobIs}I&u_y>D3>n1 zd44jZ&}bAIAW!Y{2)%{8>Bo~ex4lEC-^p0M8r8xk9m5Xmu@Y0h>ABpOPojigE>vWiRawqqqtcW;M-gX z&g{XA>#OP)`^~gq7H8)SINLDy>y9)oo}=O%P$evVnJ0x%k0j?>6IeOq;)zY((B**V z&Q^jGkd!SmQF@Yta8ItTZ^>F-K{P(8KanrI%DEO4tfcH71*@b2K`l{Tob6DfJal_P%&y85zkYm*c6xJF6#FJPCWuaI=d_8KU*t;tM`{?J`z7+Hmbj_lX{# z3um|Om^~{U34(Y~#izh&o_PGX{AB0`r`jb$-M}cS^Jv5wvIFMXA!f^ogO=9lb%>oV z|MbaI%n8hI6ZP#Ap^YzDXlPvZy9XTbqo27mzYj^Idvy$ZYpPuLf;7{)#>@TU@|s&e zr1ZtiEG+WO3l`U0cCz*Sh1yKCd)9VLwg=9n6h5y%?SAL@BBjnPSDY0;?> zNd##MQ964&_n@!N_lG7J=4}ymZedAmxya5hKW`z>4^R5KnWn22LC@RTI!|qNtUJN* zbHjoDdsanS@SW2=5z}{E{%;@V&UA0wyTBnFFGG$DKY10p;`M&=DvDK7@)p{|=E?5; z64CD&CFL1ODMjuigeRO#6dAW+S7r~T&COnIVwUyDFP2-2X9`L(4HA^7swUlfTltIT z8@m*t>$si6L+1&{p9+1cE*b6tSm_lyACJO`xL&o!uKgMo#T_= z-lv!yF{1HOKU-~6aGnSg!}#&xXiq4^h>5Js12z{95&CQOCS|&sco;5QEbm>5PNW%KePzmwLwzF|~ebxvW!^4M(>I=-rERa;tMbfWMrY;w|H z4do`)X}^#AC93WmJmxrM6%xI7FRNsxI6s9!`ojeK!?61~!K3AV@ll601Xs9#-C1wg zSNIm1qGG&LzMqzF#3MM_B*F1@Yw1_r`D%t&o0DOZalW@qdS{3+Q{QC(4Ty%o-23`iou{mIW(7 z?0KWIq9L(HLK58P1ff#Nszap)CW@m2MbUCX_%2%;qLna^{ zlwz!sFf~|?-78v*;uNm0VIq%IG^hleFUQv2H;#L7t{Zt^Q~d1vYl6f?!*adc&N#%P zc(h@7_~G2y+FX|@M5d32EGct3<|yDc8t#49CS+Y_*U(1S5MGqJn!1OKo3NFeN57Bn zjG4fUT8VrYP)e_KJU&nJ)v>!vgcN3kzA!;VDu@@|j2oq*l%k@9*jzB7fBfNP5VOj2 z6X=vzdjqaJMo(0f5g&Qm=VR-pXRHn88rG}t-XWMJW{mlgv%%+bH~;f<@UsvaXhI=i zGxyfg@->kQR;^P5aicugsLqW1 zq6=no6YfaJkk4%{mRa>3=D%A1(_$+T2J^_$mi76@#~4q(v}AG*P06rQ!bzLo{)Ie^ zoQcq-$;N=ta}RIDoMU!fK|U`T*@4dZP{fR`EYOavkp^CRxvX^V0i9nkLvtw>%cw zJvD0os+1--Mwz1X4z})(T}afTT%KKXBe6sL)Lb{dd8I`~u5ZIOHswU<3;h}}34(gAdZj0d*03v|>(!jGsqXXJM4sBxD;yUlQ@rU;iVm@P*kWMG=(D|{c z>#Ho0E50fkU!c_qq&Ovul!Y9zDV8>%1-=m|xoM%V{|=B@@f#lSC-2+Nj3U?6-#kd| z+3Kr>vH_ZhXALQ^dONYB{u0sJ|u z^WI!?Vbr4kVt*Q>W6eX{^-lbu(Ft=>|M7$MXQS0AUDUL9Z^I79-KEoJl6saq4a$I! z#me%sz|K;~Ss)M-((}6g?;;sxL0K|#lMyx_@6Th_FbnnkzE2TYx(*(uB2w`IVr~yJAeE)bRh$CU=8zqK zCKhRT-e9S!B{bGM*fc>P{A3ttdQ3FFmV9Y;dC~#c=Nl>UOJYG0iQ$w(5z)wuBCc=}Ky90>zb8 z;$bKd@-RpHat2H$>i+mt?u)XXW{+?G9C|~(1q@Ow-(ZupIgSLML_xmYtSl$z;~bn0 z2q%Myn@uy}1u}T?F0nt_?mdsH442}lZ$T+=vTIL7*E@W-&?NkYvFx_tYIJ5zT+Ilb z_2uQ(`A@{^_Vb?EK4d0^Y)H%Kyg&_|SLj%VOz!dyEs!Q&{ef5Kps{ z$$6RaVy*4S`6En|>gCZ;*675mW=i4vI-j?^=U*9gk6cjpZ-s9SSI^e)PzYe0Rhup{ z#=Vl=3BM2b%uCPA#xu{J>Ay4>J6CFIB3Xl-Pb^GUh)1hv;U}e#lcoJoo+^B0joq8F zVqxeiR6AEcfOAzZjW70fBQ2Uo@zuHb(iKVMNnh{xtMh71qR~=~pDLeAs=hW(bsKbR zun;xv)JDaP6hcJn92e~tM$dfCPfX1pcRj#y_D@i7W5cos`d2{ImqYJ+K)`)rNlD53 z|L08vmhQv=Lpel=W~N^5vAP#up^1pxUCZS0aX)^v-8pZgx=v+{#x5JAMOiZ+|SQ$hYQ|8`)qBjYf4cZ*E#9=kh#*P z|7}pZo}M0YT*6>bNXScHEMoTi2l)S-&tFC@?8hH)g*)%(nfBH5{aqYJZvT;2R3fw& zs+M&RAB>!3N^a=Wvv8|izu3M0l|plT1oxzn$yO{S4SVpyclV6un9#~r+toJJYI|nj zW0wx+cD>w)&x#kjwgts)wC^9=mTmb-x4@H)?(~bJwH_Z&mn@%(=Ll5D!Hr&bHDl(TE(v^oUr$vkN)tZ_X=-3;$thpI+)d!uWU#Z&f zDl3m_)kd6lSmQko6c&>G#_>e#^_7DjgR_L6?iV!vDZ8B1Q{+fEXb$1L!slp0M0&DM zLC3hiGg0S^V;%FsaZgVnn7>%3N#;H%`)j)d&IHPW=DNNqZF~&u=i?6?jTRlH8aS!j z*xoN+m4cO^KM+o|wM)vKR>AthU4=mQ(XX3-5j}) zP8_SQ`F+0CH7$YD&hEiMMaW(u)lr=4s1((8i@d?CavUqyB2iW5#Ch3dHIJ#swo9F zJaXo;x;$mHFU=@^A+b)w^&W=REZbkA zr>_f(l*8`d`w7u)gJKL^1X+(-36gN;Py|n$L6>Ch>E%{^{bS;@KI4E{XFu)HTSc)1EjuS5#LIx?1r5S+phSeQ^5=kVoBc zS_b06KtAo$ldNbntp9vVJxo*tw)V7BX@jep43c!TdvDdZ<0YQ(Io9E#P2$1M1gW{~ zt>)f{w+;3uS?pN1(8$tyoL;mG7p0$Ab2q*?JeVGr?|m(rW*tACUfFo8z+P0F7U6C) zo+V3YnKo$N#;4#_Toilz)5ED6VxrgN>_20Q9G#51U|K5L9@z=CxY|IK`@n>~cb0Eb z$kThF($*Yuy7j5GQqfPB*TL>$;UX`m#PfP~pq$sq$$Wttt7{UveKh$8tHq=Cvv~$# zmt^;yFJTCc4JIZnVx9_n29@dV?(T{T_7r9^Qc}4S^h9Gap5BDR^5a$T6!+A?_S4*=6*49>BVZTQtepe~~1(P)S zJaA|*@P=P1tHbgJkCnKhxIUgSw#C7tGl86GY zYZK<_(zTwcyEG_)D_I4m2O|bbtNPy-c7r3R?mNOqhqh9+f>}x~t z@}9;dYA92g4t2w7zgwExR%+|(4@G)Lmd9cd4GvAuc5#*zP73yAXK--aFPJ{@Ki^&D zAs90%Rf(qRhq=Q{Qw59BBILAnn+LTQdWJ+0eSHd1`z^pd4HERBsf=iZTu2=lqQ^5KxJh#k9jePK2~gE%m@o<&|9MMarmNEEyu zIVTf9c3Jzwl32~ZusFOW=EX#Kk0{1@pP(LDQhEGZs(RAsv z5{Vdm@!!lAFB`7Z2d+$Rw?u>!T6pd?9;8Bw(Qp$YEprF8eLLnYQh8I;b1gRq2m}f( z<}ySnZ=vNvd6RgCaBF#%o3`qB%{SV!q@2hFo~tNO*`v(<-dwbb^7h2VaRAF#3&a{Y zZv$TL+!RYm)YFrJZ;|SCQ(Q-N+Rpz`QUY>SBi78WtD7spo#h&G!KgF z6il=iPcW4&k_Q&;aS)K?Ncr7wZ1h3}FhW%y6dX`(rG=Lc!eEra_+X?Bh-)20; ztE#S^q|&qG_h75-+mze)Qx_@fAP%@+({O5yWGhB&6n;1hR;@ej#dga70v}0}4na?k z)7#pg;Z9#Yr-`_qC60MqtYF{K8T~wUR`G12iSz~rVY!3?Nml9mpkwC$eLk97HiCtG$*6w|d!j*bfF zTkcHVc{|{=ec*qj_e`E4dNoEF-sR@92lMHrF^D?sp3=lZ<0p$lyqy@Qsu_t_`%|HQ zFuxVbETG0`lm4?#9BJF=8_;oK`j-v>kVu>K^oDIH8N_t^!W0{iMR3@htjp{)cn0dZCcxUpY!rOTnCE-LFi| zc)#j)4z0CvNgQh(!g85ok=fA`AtTw)`Au&PUMlW6RfoqJ)#3~!gtBY1FcEp$>B@}& zd#MY~l$j|fyXwm7ipn>e3$u2xh*V;~yuxTfx>w=SJ@qbJjb++7BtJus_Lc@?kH@m^ zJzWPPd>wyTH82Wr#(L3jZwd;jYRMso4=V4_$_MGVE(G^mrtrRFoRiR$sdJ)VS0ZP4 zQl`VRXRQga0{}(Cj%M+y^i2ib?z%YcIV;dT0W#ahEFtyIJCB9iL9>zn1+fv4EhsZ{ zC1TiUG1M-?lcmI~hH$aiPoHnBKQSMew|TZA=Ho3rb=7(~ykJ&MP<6%YB1U7p?%|1z zam<)BHIyOdC^p+MGQN`e)GS=#iQ$gLY*lo_z3CFqCpx=U!1<9A$C3XF%om{C)^4&!5!;w6|G`<)o4af95}7u43N> z?WP9G1hE!jjqd*kT>NjYMP)K|pBH~Mu%<}Ei*lpIUmAXQu;O$2khXh=%b~Im@7!^u zHXM?|%l7iqYS#m@aQnHI1Z}2c@KMO6bu^MsoOfu1CB@!LgQvF*G-BXZl)|C4O#fS5 zZk!ZmWhGMu9uEtM0<7`$f zG$#nWnfL0Nk5>qT8Grlgn>8Zj+Ji zm*Y!bmQ4HU2W;rz0Y|ij=6HS$!SkhUIm#a@V&D0{lIG;xIFjd8#5w(#IsA|aV zr|;eIrNAkdA~%ZD#ty#+{Lxh?#IT-88=}SUQSVZ9>|{FLU8}{gN`I%0)pzv6(@E-> zYPN?=FsT8k+^^o~!d_9nSO^H?y{^_(d%wG+lvvxj`JUcs-U#=~A>rgm=~%6Eu|g8@bYiB`Zz&V(F`g13ekG2 zQ405QM<`J+`oR4Ms(U^3DU2riOb;&%s*1i(`m{C-z*KcKs9m%CNB$pIUjbBQ*R_2k zN|%CwG%6gVkp@8pLFw-9lI}(&q)WQHySt>jyQHMM>)*W3^S)&JOL*cmHh8PM4`ENN~fpJ=h8!&6F#%)Uy|8QE#Ph zV)mwvTG1~$OOCGIi4bAzTx-@Ub_H`dZV!qX#8oRFYw8)mK|=PWgbr>d5(e~9GP37K z!#G#WWd>U{yiH|3$)VcKW z^nCokL^}ZY0aG9e=WgSfy^~c`$_s9P!51V5qa&U-A3hqsulgFyORx3%Y`2!hQT!lz zz*KFwz(4k;-KMhQ-Ni61Y6&9~+wHMqoL*QaC0hFFk+YQ1dFn_xDOdH>h27c7?w{$x zysY3RAOC_3{{lTp*nTj~i+bEfN={8!-BQ=ePFEOLtjP*7y8^YNZbro*bG7L5fIV&N zUE50&ZdAT6ZB4=IAQ=gfQ%@O8R{uRc^5=F4&a)X)gE+MNSD^aFunpoX5pkr8caS7C zBWDVHByQ>pnJX+l3{u`cJKDjJ=x8J;ItkSA9w5{U@&|7IZu{Y3zj7$b%4Ic)#Qzj= zv(`=WSm5nbzE2$_R@%J{v4lyi{})q z&neDR2NvNWjHuC`-WoMLiQRe>hNg+c0Xy(cbFv}x{PH}vzI4lZ+AC^>G<_AX>4dP_ z!Xc^AEwLivRHJY4yM5++eN%%LL-l1J4Q`7+3vDkO1Wukg>o*LnShSuke(@VL?cs8P z1ILy+?d$d!tsAe>qD9h~69cNXmbkdMV@>Ep2L&bNGd@bu=>M^-AyNe)W# zDN!?Hx-#{9i`@b9C^H`G95>>3cxbyhDXbc_Q_||`*HXBYer;=t%5hC2p70VH3eZo7 z;~fj+1|8Q9UofwBUAdJ=zt~(od}o9(XK~oSHc@TYh{F*wak;|d)q7x4Pk+T z)_;EcW)|t2oA0l!wJ%$M$>>%!I0BZ52N!Kw3ywEu-76Br>4{`fz5RWCu_Sc=kbX$4 z#1DSyUf^BsVc*^kG{tI{lPvT7w^O$0Ma9W4*~`Yt3VMe;fRy0OAGi!w(m~0^f(*=C8aty;Q^X^2jdC#W=LmDcpR8FuhZL3l z{A^3(gR+0IK+#G_58H{44hQ+QDO+hT$CLSepPEvvsLipqthL|g)&7mdkIRD9YSxeZ z@3U!HJt99@3|CRE02oamAw|U^K0w6LM7ODsXV$`j$lI(^rvy%OJGj$rs>DJ6%Ti9< z8*~XK3yy=^9WXs+_kuFNa3-5D{kNL<&E9T8l9|%Q@^8(ISYDF2daIcsyMlPXqn;*L z6Q4{acWc7Vo`FXY!JX+iMtrq~bY^FCVn$kC@Amu+D7*SFV4A4wxtycQ%1zWcb8&Jg z^L$}XJ@MqrL4ZnXe(rvV^(03to*d8dZ&DfDTM*9J8p+7Spxm6TGB-4&f{22Ieo@P! zY2owXdoy|(0^WO=akcx$y~Fk3O7H-zPb1jrtlLzTh&K+WM~kWC$G_CaLuPS1x%x|% ze#WJGWC=j*?8q(#m@eAxI=AJFM{&a>8mULi@5P>6s=QOHlKs&IW@^@~Z^6oJlwBQs z@iV%|ebhue`bWKg*pz#Rw z-PHB96%@#l^U^6`Q^SF1;LHg7jo(bkrs_vGufj;WH-&HzBBF>IT{bp#1_9JZE6UB8 zQc$FwQGhMb5_Z`FSzI1vP)0gFdGZ9E2)_?&J^a>y{`dPKDG!FwcnxWo!VRMdj*oT; z9qvCn{I@Bn%??5$*X2-Ze~!xTRT366gc2P^I`w-rZx zS{?nmLG;Mo9Vp^{Rlh_m$h3DOv^zF_HoJ_^V8Sf|Q8DD0b#<%Kccz)5J}<~opgJX* zTy%1-!8F=`75>KkW$t?dAWtZ& z*Y$e0%CTM$_a!DFTfWBqow4%q-rmY&SeXr>0l%uqz}3=ZI03?cYb)e-nh(cMV_8#g zp{K=r9v`1CsQtARgt|!FZuT0%;%1P_Q1Q^Sz)NZ0jzqYI`s=LYZD)oK%&m@VU_ap% zH$y4$PpPuf3dm!mHP<_SXKTF+@4!KIpqs+_tk30kn~8tpe3x^mb9Q=!PhuI_q24yU zLlUQAGfPGg z<7i8LV7ID?XY*DKrafY%gtq=kwI}Y?HNwf+vIPg)XgmzIKkueBLI}@aclDLau_1d) z;MPT6oVagUveUgzS%rd0(Sa*ne)y}8=1%@D?NSlKX9kL#C>ZDY$aC zn>Tz&{fuuTY6agw z?Gev}11 zy!`{y9{#NWpTP$mR27qwE@fJ)sw^ zUF$f-+NY+x(8-IJGy!icJC~CT zf_FDp&IY*mzfPBCR92p4I8Pl+-I+U33AEIXcN*ss zI?Z0^h4sos%4;)Qr-&L?zae1Al+1?nU|`wpLH2w5Tkr~TAB~V{EGad6gdg`3{^JDw3$7i$V`%@)p_4PMT^2FlU`a3(bx{WgMYq{4NxmQmqVVM&6M3} z9NRa7ftdlmv|%x9X1<^4>hw8L8+RslSAL}W2*GF$8RP2P>*hL?;zB*ae%xK+`v27e zR2PLGBnnA0RFyvi;<wCa zQS11B_y`H(w;&R$gtYRZzx*$JZDLgujUr1b4EQ;pE*pHr0eWu&0wk zH;vnVi3D6ma&kh=UHaNI5iCIDk*UU+VhtkHGXG7}g~QI>ygxnB{nDUDRCQ%>H*H~b zt=;1BTWn7u5%O6sQ@96FK>K)b9)g=->NR0u8wV}Qq0BCD=QkK>}Pk9@sz0 zv2uhBomc;aF*N7_Dd>O6k#fhaf@SSZH`JR)WH1EJr0V~jyt;Bf@8~ixiv^b*SL1kx z?A^{-a`fMvTWEb0Fw@Uz$e1qnu#<4@QGJbcW}YTLtTkKwHI=ih6zDd*RNL*yB;v;U z7X@j>h5G88X+(~G-tII%wF zXmxi}X_AO{?Ah{mkxP}-eEy!TQy%FL4K%tQ1imD zbdiE1g|MFW7jZ+@KXskUANEO1eJ~IAS0_hCr1SeN89jAzqF@_Q>8nwhIKOlwWrvEU z`~$G2Y$%0aD$o&*yN{#`!6XvvozLlg+LY=YO2WfswDfkr7ihJQQ%X|co|Cz679OA< zcOpAp2*drOuuA`Y5e82_<^seP%~kg2Fxkc%-oJcCYjb(;zhXKS`2^3NRlyp{ZVf9w znR$?rauX!56wAa3m3@zOwR(9cFE5}}5asU*!u{~MH7V)-@-_w(72HvZ`{FGUjS4Ch zGPVhB*${w(MvDu!PQyE*kuTT_GZyL+3Kp}WBdea4DQcK3u;Po%+x-tH>IGJ<6<+-p z!*C6?&J`9V%T}av1#1ej;JCG?Z!8Q@hrF>Ja@m>8t9p&H1}pLcv0a%K*M57Ve_?^Q zsNQLLqPSF9XmpZ2AnwKG{?5BfEx7+VaVO6rb|A!k4EN~6EzZ5c*G+$}AMbMnDI8a} zwszqouWLB>)!Ehx3O@Vgq1j8Ah$@>Ii8Y9bI7da=QFsZ?ucd9eE!rJ6L=^QSA-lZg zTsAhy2+4aJt}eUsJr>S%?UQN6Q`6ov^OfnrS$=7T#e)@O*C;XQgPlGyzLFImzX`tg zyM<))4j_CR`bdn3esT=NM!2Zuhsxb`6EsdNL{mSdT-jY6wERGX z|DZ3_{>RjZW?PS|DMWp~ug~52^F`*96)(!f-~U3Q7j!Nq->{4^kg!m)1BI3q{Qqcd zenU}a-I&3QyP`j}F+S|AlUbOtdYzXpE%A}pORK9SdR3s!c~FDxDDM8&EZViOsM1IuI6wO@C|Xb_+@98|?y3q%RHLiG<;aanTAl zxpZ;r<2BAkRuNl1N@-;xG*MsQOTS_@)JrU!8=!VD*%l{`&KpZTl&XKQB1m{MC;iGj@ zC(}`j?US0-hn)D7=)k=x>4^su4>$B-q#qH8lTQX_CLTf5y*BRdPAmCwEFG$3KZEMs zccsI$3cH2^1lu^clnB?Y(9>l{aB=x6(+r<&CDl9^K^?A^n!h?fJ+!c1x@Q$nD^({* zh{OZWcTG0f{Nnr1UpwR)W>HkK1TuH0Zm{j;IPM@bb;ggcn-$RiA=Ai-+oE0|k&g;O zR37h{i--n-zMi~9W2DixcN??q`7lX8yO4O&vWG2UM>>);5_?6M!+Fc?fKGz#a5p6e zuNo@gT&3z@+ToD`x677LFQqI)I#tOEy>8dGO1%WG^|8m1c0(}F~=5!zNx_ z%wQppUA1bS~$|aKxr&_nSz_y{PQ}C7TLC&WNwJcEE$LmOKiv@j z@SmM7wMbQLHsHqn7fdpLivSWgY+SjpdiukkX3k}vdIGAn_3)6J*#MX7nIj9DH7%uY zYW9=;AeQE}DLI8#BEEx6*hlWM?-8Is^srLmrz6}YHO01scmO_Xah^}~j?(?^RH2s2 zzrKqmCj@ClO;a3}zZ*&Z!$3=W9#cXibFU9}X>PFBX zC}Gj@`J;gG^Sd#uc}#)=g>I->vkHgQUyKrR{myO0(SL7$`|n4sB{XKJC)zA zMTpy>!`xsct({c`O-~VHbCab+VVFC+Gp)&5RWsdMR{hJQf>IsAqBp4Ad z3Gb0n@nZHH3kg3n)O?M3v(7?-Tq7W2N7V6O!Pghq!5R@?*Xs=V4OiCW@#*j(#*vDHTIqd1}6Q>e7s_N|^GC*<~`GRI058QvD|wJCYhO zaGjjQ4#IJpXJ{nfa(^@;-r$@Lg~#`L6v)D&TzhS6FkN~C($q2?upCCVC! zTt=F*=n`P30^!`rJVP27TFs(>N%TrdH;zF6J!U|=+1h%x>qdnD|5V`P&2EoSIFZKa zRz}^m*}BqE6m+|JgLUjCLiRb~*R|MDj(cNjKLn1J0kbDnsC>o8wZ7PUo_2Z+*Ht@sU+;R`xD4-LwP(j( z71?&7w%TApCOGE;{ z0W=w66q3D0+PO;|DMzrRjHWa6ZAw`{&X(!i+Uw{qCPh+YOtfMxKZL+hFEu&#@GkZ&ewd-vYcs#LS) ziw~^NIsdy$Z(1LWB~1_-L%Y4))gT>v$Fd}V{4UGAL0wIvyD&eh!pgqfr1AQcZk`w- zE2>o%7@aIFb8y+4V&|K}K-u(&D7egBjGE?DS_~A@IG!fmd3^YrbcVh_^|RgAEZOYI zeC?)`aCtdB9{f?!uNi)Tsf`KQ{Xh`x#)3sS%T>ZqQ2ezevRL`W|2C`W0sD}z2zX$% zy0~tfr}up2SC1l}S@ld|uQx=ue#iFUaQp3P?L^o=L)9AUDA1y6%_pQ6w;dls-KQ?IF+y*H z2qUl|3tGw-(3LmKY{}G2rTDoY3S6=(wGj22%Hp?#Z*wqbEmJyHjyOooRfihm6!esK zRl+A2(TX_g>WHj%<34EBnYJZFo$;C>;A`333(!t1$so&0*bI z>~vLKki>4+?ipfDgLhMDv(=aEfm<2umdotdi}#hs^S^orN%-YnPR|ggmmjE-CtxIj zwBoun2yKI4;Av~m%vAZi&@V%(o!Y=qkp%>1Fq>+ee6gZA+!=lR-AQ9!`=v&@F*lqq z4M_WHFGueivG&`2T3T6UtPD?*&QUL;j%O4c9ulH~<>5d(#DSUr5QC!44{n+GXaAb^ zn&)zPY1N(91jtyWNBwlIBAPz?ujzaraA9)?w2VHYy}6!wf|M$gdv6LsPW`(L*GU|<+pn>*dg7d0=Ih}QO|a{xyc(*C?Pl*Jx_hV) zR`TMp{KPmpKZ1Ub9}(Ez+LWtB3EUIHw0`xWcN5o5!7iq|VdrOpf*B%uJs1UQk%3$8 zN8yf$3vo=zKPDA?=;cNJ$74Dnlgz@Ac@DkDf>5$=UqrQ9n-$~!uv>pz93KDk%Rp{! zR0ZfDtfr7SD)kZ9zQ3(pHKVaC3E3EP`zDS^{ljdWFU_J zSfE8g#=FAO(m_%7c5O>%=7$lc-+K*PG-$?wQ!H*Q&zT+gvG|!P;ATLy)UWZzoA^q`RIfA_-MbKTa7g;q^`o@ z=@l)hL#NDH;}xf4=d_&kK!^9fa)HBy&i3k6PeN|r1{p|q$-R8KIH&sCjtqi?DbS%u zDad%k#x$@g;n(+{EvSUMHoR<%kJpPE0iSa=3>UK_K=IV^G9u57i`A~jI|kJ*vF?|w z3XEAX`@boOPHPb`>wXDc%Rk=f7Iw_oP%^ql1c*0Y5fzr3jy$gOKR(+uIIWYYX#G{C zu}6fy(9yVVT`*MrS=brRIu9A3<4HiV?wLYDZ-`y^!HtA5^=LC|ob6**i!OtsdSTE|(2FJ#v^iC&kOe z@~DU#Fwo_>MZIw(!IcA(V-TPjCvNxqwb$G#)~-D6|Hhr}|6~V>bMzATOn1qZ8PDoi zfZxnNQ|BZ|7#p2*ovHsQ7#5F(a>-IKY#4hoKU`^Bt8#IWvx3%qIQDDumRlm4-C@Px zI?f7N7pe@B|BupG@p$vwm2z4g-3-S=Zml4sssaFn^4j{ZGGbJ!U*MWINgN8S!*+eX zlA15NlvuZ?K~tiy-{SpexehD^KfVSlHgogs1J&K`(izM3>swk@zK*{ zv%Ow6#(ZIH9yIYtiaLw`?ic&(d)VsD!@IooZAPqF&-1{TvI;#3(yByWvj&&BUE03b zMlv{v4+%I4a!*E2c_Y~XZ~!)yrJdII? zbb<7+F-3uNj+}c_#<+0B`r!m4xqE{ni%va1o&?_)>yqPBp?M=u&rm}&&27q!r+`9cf5OYfNpf#aYW>p-2tNO;O|V1Umu#WkuM*SOHi$% zk~XZNdP)%C92U^FLz+gWcW0BMiS#lTdD0)R8$WcJpG-z#@s)2rMo*I-AwW-)G8r>g zE=ZN5R?d*6d2XD+m+>nH2PHx^SGFtStuG&?T+h~;v@f4DEPSkY+e9}^IY%~C_l|Qr zS-`|cgCRdacyQj0ldW85)+~{Zhsaa~^l8}@znG{Xh79p3)2jJYWI<&!OijKU-*PXP zyief!hy4k#{?3=xjvUiQn9umAd$+c>)5~L}a>k6uR~Q%`mI$RnI!B&*45dc+jlvs} zTZuPOIl6B%RCB|6al)Kxgg-LhlTg4x5cw;3c^7s%SXJt<)_dA~r}H#;lcuC~&EWsW z+o8n=5tg=w;BMQX`EBl4_B6)o(_J^Nx(ICJz;z%r+!@+CUU+dhx`C(^kZyV{57gxp zo?phP>D!l&YP8`7`=mcf;hb*Gwwwx6+~(gh#0Wo+h~jP@H5m&?zTKACq_RtQewB&& z7bxhcrCdsE*k?=L&03!+1oByGJ%>2BlzDhtmnB#6DU%_5<$< zM8|gnkjCIQw}ra`HRTzlDwEBz!i-UqhFiD~DbiUuzbH4N3`J;!jkl&q7*CJ{z9}|W z;rQnFc}8ldWGL#s!BsX|j726Tt$K^?$T@3rZ}t*8wJkkKzv<1|7mOE4HsZnkIW-jv z?;%?FwdW@{tweAoY7aqDlEFB6TpSuzxri z0zZSfEUvYDTzERZhKjdAN5IX!dT@3;V|LLsReofpRDWd4*L6=f{gF_kifH1#uTfTA z`~_6cTQL}YIA8Gwk-kdEG^o7X)#0JTF2Fmq*ATsbsN7qAwA@cVXY=#8IIzGJ5Pwi& zgvk|pGJ3jE5l73{HzY8>Y_ElJ)ufBdE6{|Gb&YkL_q$Shi9P|TKub8HQEW|Em@Nf` z$aP9YjNzB8%3BwnnK~{`Wu?asRVW8$8Mm?#pE7svbi1^k2g&39;J&_aE-!v|A7O>% zPutFC22Y^=^bvIi7c7lq%W5R1t>n}@meo|x1Opnu8)z~6*_yhgM@p>NpyNtc+EcYbAOJP(4_Ewfy&1-Q;jn=@s0ts zJ5k3LrfyOz$u#*=oSvTd_T0oL@Wak{8{U`t=8-3?99EMSB*CzbBuM?lYvTItI0iGs z=n1lZ{eA~w`9FCC7tDxOFp-U894N@2$I4RR82?3*r-vdNtmvxy+Ot(@FVWmz!Z=~d zG3B686+S*Gtaop0H)gT2h_r5zO#=(G_q-5!%Gc+0gBLFelOYNc;UbDkza8pd&^I(l zN?ZWLE;*)R{gVjfEpOeWXShC;e+EHFPxS@xF(W8`1E z#ik|3#r;cxi9ULO5cxT>W3EJ1dBR3E@CZnTh}vbuh|QtdzrjL|;-TqNa1K|x=Dj&a zFv8cr3+4B&`BSC9u$%PO^-n9g!CkdkpHAR?TqYgi+RDDVx^&s*cH7s^BO<{AgR}OY z-fb3^v|&R*d-VZ3FgJ|atEZ3ew;hgHE8}lfDu+u)_ioV9;<&axK*J8_(e_QeKpAcC z)bzlezy)>OjN70Bj&J32IUi(N3T5JIUFqYM9=`e@AK!+<>lqw z+}u8X{5W50>ujV6eq*NI@mPf6unqHlx#{d#&JQ6Wq0d1?LSkYSB_+rh7$ooA>c5>0C*^Vabz0Z-)G3oIVrQjVjiQvg65bKP z8(#oSR{Zo@Z~V*Zp1L@j9WJZfGk*10h9x6HE>qt?`uqacJ^^e$f0S)w6(^2Uk~z*R zmwGLFKY~_fCmD991!(Y+0M5`JEqi zMRWeWh9e_ii;Ho-1yRGw{X~q*k4q8~{tHHi++&x+uz~1D!{t!G(eZNS)!N#c!60aX zI?K<guX-aBy{XC6_0k0p<}nGEzLe^cEXk`MuFV`HCrcGCE5}P3`t{Qo}%B zpO;r!O6uv0hnJC&QH^%HpLhaS!_qQXZvru$o_qWK1=pJk%iU}6Bknhcoxa#GHnX|E zOG^iJXxh|uX^5tg#{FAV^V71w_iI~AG&4S_h+6d5A zpxGL5Z?NCkmda6u;E@!gW*0?GhV&f;xAvzd9x8Q7CxP=m1p(_Bt_Vxyr!+wwQKmC* zo{pdf8r)AIFNODMcj#yB*ROT@+*DC*?G5k-_Pee3n+N)wCH?9R1~`fB%(>0GGCnh+ zC!nCXHMkFkY@0P$o9GNOG{w$656A9ko0BfK*na$->~7{tLQohWnO_~%GO!xXmoNhr z5tHMWB>}sNA5tV=w6WLr3}v&dN4kW)&K90j<`EL@e~#xkW@k8DypZO(iZb`DbFK2& za(`wlFHM90+lvQDY=1AFZ|C_!y}O#hIKFr1ugSl;R^LNI<+}Ph?cTN>Dt z^e&+d3kz$!yD~A=Z*6bS0J?yMg@wL2?GlH(o6Dz9pC;9*Qik_OGx5j86qlA71I3A? zBv#U(!GiVW(HezFr0kN?z{$ypP&lO#Gtkk$r+Rq(>|9~`MyFPLGLj)eF}J)qnzg2e z0|CphTkm^;it2B>J(0lcdes&B%Ju5x4K+3OWm>Y46F6@+6r>ycKTU;&8*UC4k-d_L z1Nv&unPF2HKP<21UP9&Qhs>*~iH)}27JG6%|J4En?dPXtAHvXh{I6Yhw)tx2iX2}h zB_klH6SxkPNASmQbJaU0;GRvgR_eU*71}A=So;Yjr&Q6*euE&YHR`lWd4-RCJA0V= z+6q&9gu!r{4nECRYVB(wEeoejq!YI@TRCwZXPXmay#cRv(!wU`xTfmbQ)_hWqiyto zP>t>)d9(*vP+xvI-^=H18JcX2&p%SWw|w5&@sc^R{w`%}bQmGMYjt+J zD43Xt9^-imq#PE_GgsKhhn1$YlsG7G&2w`uV2uL_+4b4TsQhXjkJks^-=jfA8cn>m zTVu`N;Cr7>wR)jO2vb0y=^T7rVLB`CykRm~XgXVo4%zKYNfoK{kdh_^?*q{&Dk>^m z^T^22Pzt}^BJOmZJp)9mRQh{x5EBBf5NM;Zh=~)xIAUz^Q+# zQDSR`y4=?Q9Tg5Jb`$WU?godQ@x*ype6^nGy=L6_RtO~0O4F%IsFHT5NwtyXsirf~RI(LFke3##na^_DAw z?(XiU7#^>?fj6R4EcS3bUTXQVW^7;sjG40H1J>`e-Ps>t`t~9x3yTey>(LkY{^pzCR+2PrDvY!l1H_xCyD81M}SrkgGS@c z;Tmw?ec!UOvf|=qJ7M6GF=n;sG2;q06-nyY%wW>@14I&u@21C3vC(mFZg075{sP^I zmlycr?&2|JCjsJVD(dqW2jx|hI*)SQIjID{o4K`|1tAgK; zH{B3j1r3$C)4=DiZK@b_RSyvO#ajG{hKsy@jk2UF%JLBl9_H2}kA?&xeZM&CWSXdq zl-T<{S9=n$YthqFjS5?+vbC}*=zbt)P-31z`NoRH#9!K(NWW7oiYl<*9L|aPWnNc) z{rZNAXZh(RJv{VBBSZ9W-SS0aoN%ag0)AJXxxC;n$_LN9Q!i2MX)e0)fg zg!tb~K=S>zYCpE$#C0iiqa%!RI%=4z60XPuK30gp(2tO&TA#=-HKGUe-nWpSv*wQy zDn>?zjvnJbVQAcc!9C)oQ0eDj66^K8=>})^eP)4k6tC2aOVWDfyou`x#3Jz2x-}kx zX~2}Uf=o?Kd-0+E>7Zo$9yKW##Y0P?p03Z7Mo3CsSBgnaBtRa zp?plo@zP_g0}VvZw1{vuB#3n<@a6WI#+oN`m2H^N8l;(0xB3{$=eABjz@MNGp#>8L zWK(LdujrzBk@uvXDBEl-`#Gdzq!%gbY8?Me`(ymK^D4!-ohtFz>GFue8Vd`ndD(*3 zVZ6V;zqR!dWMyql3KH1Ewfmc6%u%cyyWN?fpddX}*_WY=h^JfQG|Mc!NrOZ~ECmgo zDUwu2M@P}zA+Il2yTd`xt$5Q4v}BJ z?2yq*XY>R=71v!9u~FAfJN=o2SNwlsE%D3}G&@!jx$W4mrd2B2-jKcm*AA@x1cB!}~a7l#4dfA%+e)ax;Oa2{)QyTf9b4c6D!-HrxyI)i|r(J?R9fmUX)h*M<-!Ih$` z)(-CyD{Dsc6pG9i>XnWzkxKSlj@ss#@B&=whAxuD3(F&f&E>zZfagLw(BCXZH% z2kb`e!#DrL_?VIC$jv3iFST&zWM0?#^1H{&AFp8$8H2`K=iz0X|H?aMd0aRWXEdq& zdIkrZfaL%|QcUMPxBVUwKK?~_`0ed2I3bm0^R)p10l)!0Si=wOx%v4hS|#bi1>qT% z4>mR|VxvjD#;ah`TyO<5H9p9~wJJ#2;yS0*H)~FCH-6!a&PPkV0LPajJHk?sKw=zr ze*wk=$|CQ)h6x7XljHhVm_K{WWclYe=&_BGJYQO0X9IDR)a_z39`Ye#<=+JFBx3`WEt;xHT{%e=*TXl8o)^l&Bkeb1Uz zpdhpR-3{=7#wM)P=0HYxzQ2g)3$DO3ovXG4@>e~E7nh0-4i1OIbEGCC>0qz}%WX>% z#7C;bD*=Ko2hl)Vesup}8x_I5YYseMdZko_eLB#UA3O8Z6U$sZSzBIHu&;My z&-y)Sv?JImD-P=X2YtwvDL5yRpu-l%z5zDkX~Q^!a)6%u?ZRU$Gdxv8K<=4Kh&#h& z#1i`lbk!7BR8R<&dLn{}4Z}bp3v94QmvU!kN4fIr3mlx^Xr;I)Ud#pqbLB?ZGWn8% z`uh4QDJgx29f5=~e>^bLGco{zQNCVBH!Q)95kewo9sj@fs*rSNjUXMFuOM9j#Wx$sBS*lFiU1NtG z?Q`85%(*pPe*kPGh%4dYGC+iWBvTl#8HQa8>ZDV4n~C13PHe}ORn!@~Y$wD;~9UXWG z%(76ewK1xxeBBZ7qV1htOiT=?$wWSI47(y=mf5FIeTh7TP`Q#1rl8#U_M|yT)PXr8 zVcebkRCad01~`(r6Abitqp+7Q+t}DRv)Tjx#HWs`jGwtM8X6kjBvO@-(yeZFigv5c zFzR*n6BWpiNKvDzikP#)qya%(h;POCZ@Mk-nQe;d-ei5K#Pj(JX6lytAGH|9d9vBK zL5nSRv~o(~cI41l!9J+akr`0KXhp%Dw`9LO+(4g=@#%c^Yi0}s%{WSmq!<{z(;b_b zX3OzeQPwe|qQQnHIzmyrCK9TjJ_GLwJty8VsHr>zBRM(Ra@*3@_+b>(ig#>rf)KE-t!*#goYted_xOc+m%) zGeC_mUgb!obpUWZnXd#70j`8uzt6(L;^6R5iaG+!KNOAV0PX5;nVA_>tD*K%96j(G zb-=+w4=I$Gn614%!#=SvBLI|$m?U3bKMNE*243PJmT42y8G~D$t<3nZzgcs{`#tu{ z67K2i}85&8DvKs>(YW_a;!MM_d>{?W*>z<%k`eEg2-ZUM@X?dVEtZ_!>z3Hg6g z?rd?hY|QIK-k9mi`Q)5=d5MK?u(UA=Y5no&X@;>2#eY3M(dux=`!PmTiq}lPge)wr zftW|KM-Cz@X7t;fdoB|VLx4~lgABwO-8ifp8ltX4mNK0SdE_Ie;3(g{tF&g)ePb8~Z`^N*R~>0>5fqX1N!zFS{kGwbPF zIaF0s8yy*e$S5cTs=ARgYp_QbH{1R3?Dyu302lUT?|4+=eS}NvbeRFjgzp3YVhy0zH_U96IuF;I@%s1A07W;Rayv3Uqn&K{- z=Fb9pNHO;%%%*EiCo}2yDn=IdfcuRYuQZV{QR$76SeUE1`3};G>N%pP5C_L}DKQe& zsxX8V9cQuT$ta-#v?U>t8W)t@O`$UVgm2rhNbY$dsHrxKoGv;wfK#*WlnJB^UzwEh8ht4ik~|=O?6; ztq!WvQQ$~H7}E>V(bo10t``>-)y0U9j|VIC-X0MEZAx?Us9um*^;Fa*C4t4c)*nnH z#>ekkvl0qBIXg>y=XeBA6dxZSv;>loz8K(ws3sF$%oLw8^%q&LbbuZx{UG3HXxaYk z3dmN(#Koy7Dz5gR;=R9+$!;Fxch%|;FW=rN3a<-{CsHo@Hp-o15hcZDGm;A3xe|+E zeY!_h15k&0H2V$IB|K=r9pc9v+KSxO`y9?gP3&xTjB1q{T0%XMw$sFa;`nk%1%My6 zduKvO&<2V6vW$kG%1@}jw3LnA+f1!iPsap#=bx2Yr00#lp!aFV|A!mmyVAtzMurTh zic`)wU>o=D=Ux5%dKfOQt|Ha(WJnAQ4C@>W3`O;M#}4%a3EV}>6 zm6QRA5VgPK&xN^PotV)mnO3d2f;G+pTSUiE1MKX}mEzLAk3gn$)l)PVa|1tZq3$I3QB!k<9g7H({@oWv@h$~Cgw?4hd#&S99gD*qgiT#8B{G3W4Wo*{ln!%rDN}#NT}mtx(cUMB8-2uEkrRUZX7z0b6N`+K24_mr zH+1h7mV(M56+qYTG#%sov)kndQHRh_X+!YcOD(U6K+a+{&K4|RJ#Z*|-DMh4jQ)c| zfG}#*8C(+1eGQ1bhv;`G^o$e?kC{2)KWssmLB9o?8fn2PHVS}hUrCyd5=?Xt#LvS& z?I87&qJDo(I0@z`NB>|moxyQ;2Y@yPKJ<&Mq~t+OuNPlRrAWltvxMXG^ZlvATkm-= z@G9mh9@2{dzBJ`CL;F;!gxwFhUUf|SQ1YZg0gZL|Q|!8Gb}MmutULWVfX%LXZvZyC z?XX*pITFlelIi*dHRDBFS+&Yualx&w|Kw0TBgK-UmW4Dsble{)=}F?4<_wyny3aeL z%bL_)IFD79y;&}|pT0CNJ2IJ4;^HcMFZRiYw%|hZaRfG6s3M#FoBtN|a=FkB{SSeQ z(`a;YJl~st#zn^Cb`#CHbbNVsb~bZv!hS;WOh{O`XM^7Tcs)>+9ucCCQaM}wq^`aI zaFZvW7MPt2lL+b7-55yF33~rUd}?-9MX6yQ*A;-=K|0H=u{Z0@ot-{Ljp;BA_gmIc zTj2tEz?-VOqms)Kjeepnpn_GBMXX8Y2G$Lm!!^IpcJtaF>gu%p>q!qnmd#sHd&^BV zVXcp8L?P`D@^}1abLFedMS>mh%^`5RfMpqlHmQ_ zZN+Yia0W3&1BgPw@M%=WqnTo&;n^fSPE%7igDX~#KL+44edk1k=lwv~~Lq;M$YsR*X3Pi)P5?P$jZl-0GYf`(=$Mmj2A zqHove$6x08guO1=9=>IfxmGW^6Xbwg{vS_Q9ToM~wFeL>L6negq`O-{Kw7%HbELaO zK)Sm@S{jB9>F%zfySw>*e)ryY)~w}PEdQBv&aP+g{X85EbOyX{`wq|(2Q4NR93DGh z_?Wz1ZqFix2vea|v9{v5Y)J!1v5Yb-+47-F*6%>Nz2w^W_P&&FAGA_NpO;17|t5G*?2h+lz#Q~;>*pKe8go5EMh6P~>Mtx+A4sAtZeGMLB&0414j)j)*n zrt&_J{Pf9}Gul52<|kH&WN$|gv7pH0B~H1m+_rO`p1$0rRBf_^TqcjbEx3psdXrVahG(U*(F`zh6DB40}m)GjIy<=};H%sdx6M zMs`=d?&0EsGb&Eg|4Di7CLP%vF{uCF{Pov7oOKNzAD@?KatR{tZy*rBR0}-YtJkP_ zKt&MTygh$ z?fDY@tpT6Ydi6qxfT?KQJjnu^`0c>9eFN0%hR|V08mQPB?DK$7$H~bFym6puxZnV^ z1I=x1pU--`x9owOm(T0ou~w4-J9K9_b!T-IkaeYt{z67hK5fb2p!w-j`%p3)-L-_8 zE>P!ro^J-rd}JH4FXWZRMlK*0N~XYsZEqWAX?gNAyS;fi9*44f=I|o#%>dPzDBo+y z$-0mJY`neBT;HP8-2ZzJ*Y%_f!^t|m6R6geSY3I(qn9Un$dUTx&t9$z@YZ;<(Z)8Z z_Z41CX3MYfuQcFlVr>t%?bT8{2X~jdssLMJOtaU9d^3{<|$n+xIEp5ikvBC#PkI4SqE^BkAu){qYAHA+JoPV0w|!ZBlvp36Prr=bW07 zf(#N969bHq!TWn%-3?IthP*AICfC!00=?g-)6TcZ0RaB}w#Rn1RLiA11Zx4JOzhz7 z{0x*G0H~N66$Jt{G&BIoH?4OE&|Q%T!!f8hdhhqC;@esW5dQE?d6aDgja={_Fj|#d`O~4e^R=-f-0(_wNC4L~RyuZC$;+(0V&^pwUW689;*Q z;&KDP7%o63VtKix!-L(=&kq1d+W@BpfJz%18(a1bp`oE|Z9WBZ>CMf}QY|(BK*R;) zAH>AOL`2W$TZ5OEj)Ivd8yk~=>jNqsz>-76R1AQbi9dh-5L1BBCy-L|k-l@|-q{bw zm(YfbKX`M9F>t%s_O|;eJ++4Qg=5g<(ZALpq*mVVwd?=WdIhKD&hLS#*HaQ0ezMd) zNm*KPn&{zjiI>qz=yhf-5~>PEQ4RF7V!}!4qWreFmo3qD>m(n~`Fm7~(Nsk}MSofUF5_xfD4FbR`B?T23)MPU_Pma+U7A0e;Pm@$- zD6|)x0y#guF7&#PqhGA_?09(Wy77N()|roh|NmT=RN3}5p`W>_=}a+TF{PR+hd_wq z7x?=bbeiS@+LOav&^XVCPb7$_e?J_?`X-yJtKR?)d3&9zZ)+l6pT8IL;DHd=3l6xh z1-#GgghCg=D}qu|wp*&;82NHprj9qnx=s#E+d38CrxkzAL>8X$_DPf5UjTKUY+ZKj z4AaeV7@8%~M8VcEYJol551@Vc?v?P=Md32pFT0DVo@WLDppgU0vS=jHJ3p7~xXX3P zT%ohUh%#*@b0SdJRTb7%X732HI)7jx$eRVqioU zWN>Q*nACok;IqbKa2(EM%49{A$haf(g8Ejds4kxs(p(96+FXJly2n@PhfvckpL2qc z{BpoXrZ}@+POpPr-psmudHro;{ep$9(Zge!d+YA}zgYlNzNpa{DJ+zPAi!YyMiKsJ zFgU=N5U{5uovq4ryR&q4`(rfybhv1;&P?WQ>Exm2LbX{#rU2?*7tp`}js4Q-tV$c& zvfnNz>R5~N;dhTxGddCOdj-YvXD`o_{G{| zaR?1H^+X|!gS4OAu_`WW(RXm!O$uB~3|2o(yU5Gm)~*?OPEZXJ&I+UXQE*8nAH$=` zV-^G^TaU9GuRpkElb}{}W4bSy1o57&lT)24o)(*42x4%R)zj)U_rF((_Lq++o>7Y| z*>2rfM%5W<=S%#6)7q@6;{k6;f4kd__h5YLzA{{FR2sR=FvGV}3o9$IN)!{#-DdU% zAJ?V5>7~tZZHbOR%RL}9^V=WlvpCHDSaHW4dr@isyWX%Y_h^iPSXJXs~N6Z32zi(p{dXC zfIE5N%noyM03=AIMEgyo0%SBOqIY&ej_|b*`gwFknQtEN0mV?pLoj`cSj~Us=DD}Mn`){Z50cXM|YSYwXsz0(>V=!(cCBC z7)VrTRq#*~l@vuJO0#W0w*UzVxcpD)C;{scu29&IIriQK$Vx_SI1dkujJKiK+`Wo_ z%KsL)G5+qmjTMZ8UbRox-*&%bB$fz1dG7X#6LQysyG}uBiJ1#BTIZ*uF6%NauQk#G zmfZv!r7xVbpEvDe?qy1F*@#^J+=%iJoZm>ijX{>N=kMI1Z*Ud#oKXHA=q-E^Cq?eX znM@%maI`RqiP~=OoMR^)nRVSN_TFvo_<%l8fk1edoC^j3uHr5RL&&RV0XaeYu}y_V zhbqUfxCyZgu)eQXoX9lNDH#(>5WkZ&P~>r@yiwu_?p6dW>Rm{ZXoQrsC_P12Ot{1R_4d zm=6S$`Z*RUpxcW-oegFq2?D@CDrS41f6y^SYwd>C)0Am(BEvD-u5|ua&m*zsWL%fN zxv0@}HcLyj8}X5T_zoMDJmB^-YIdzJ>Cl4GxZ41lanFS3eWb8#d&8k6LD09=+0Y&( z&g@x1wGSP~K)|ywv1#=j{%RWNM!9AB0rry@Q{n)$m=%+i5(G%!RO5@Ad_m6BFNDa6 zF1`Y_x6DdXW?qvpN|q@%cuallFFs{D(n`#P^Q|j58|h+{`>4dIiF>U*d$jx?Nc9!V z+XN7;N(;_V1AWI#&*@&M zP2U_ks#v&?_f&-)Zr@5lBuv&~JEw}#L%H_uO#sGk6DrsRR}PCK%6I*8$1T7(M&QlU zP}_MGiWlB&I&-Pj)=7`D+?1V5@nb2iD5)CkCsYr*zil}?nAkMt&s(4I-*SQKKRlFe zPAXdtm&DPd1s(Fy&w&*7w1itf7k%Zj{2DqqEvz{L+O(g}!RpNv`=8v9k=hZbBf3c5 z`~EGANFqLrt729z4aZ|>=V-buFv`+^M!+AEek8_3$6^CY`k3x~ z6Q5&(7>Y)YD_%~pV|AbtDC@yj^*&;N*`75(o3X&aO9BE%Ll+=Y>$-Jj#w1l__wO^T zM2Y=N`FO@C&HZZL z8JkCaBM-&q*7MyiDSkF?U&hZ~5VLg%8j%qf!wIl7$==6Z*do7y9sU_!%&g?I(35?? z)F8CxmPEGm`xcy4(}LQz>iRk+%&~qc7XGD){1J-*fA=0#G3KLHpbN7?A-ojn zb<>|B0{kuncj8Pg)2BjR)O0IT?4KN%D!t3b&KJ_yAJUQYC+C9!@^b8Q-gjq@g#V*& z5&Y+u-7wR*b@_?*cfjf_e|tD;64GrF1`UCEf7NN>>nvki=(u4gQYAEUINCEpq1^&x=x5UiF1RNo;7AOpj5@P~m4xTgHuVBr&=C%xBq z?FFypqA14M`gXb=Sq{Xnf1em_WMmXNtlHk?&_3{c@&{XztA?`>9(hipb z`971Eh(H^fW_2gnT|JW20el=&>Z)p*ib%){klXkN{K}SZ2e!4R31gGzT#xQ=63Yu| zq==={g55cGE^$$1!>{%^SDFyCTFi@!FyJ(~vIlgge^pNsxY7(DB0k@q)nv~y!ugw6QHP{(7{_Yn9bc%F zM16e;S^kl~7gpn0hMTxqbr;E!UmDvUM@Pl~bO7^7Tf9tH%??rvd4Fm+X@B0O2wIIY zKG|-i`VgVR)*O_YtE1_?Hnm*PSo(4>bMOLv)kgFbm~R0ExwO1C#j!6^WK?RLcBo+H z>RPp1R-^{RmW1x8$)b-w{p(bT|E{7xUEk;Q@wL1AV>MeAZV~YZe$sP2i*Ic z7jFtbsHfvcJ^GeYioj0Nf{}ws2mON#IL#vV6iKSixro6}QY!Y3o`*pBiA}8nFe2$aD%{aS&i{uOM6#=bt?B$f_ci+GjCr5m(hR4~N z;8DXj@tgbGh#td zVr??|7_nwqjHHXll*R)N&dxrWL2^X%sVwY8Kjk05&Ti}WRA(=E4(-)Hb1A6C;qHlmPEmiCAB+tM7XkDV4c%t37!-*$wROcxZ3!+IH>Q792pbUs zuWjbDJ@iY^+k91tR%DknUK&dbz<{<2>kqP)viIwgAkZQG@F+cAouzqQBO0W?0Y3Jb zd)#5;*yD^?E_)2wCmsaS3r8BavJQNQ9}f!xYIlIN;X9y)dS3g#^srvpGm2cKZ%WL> z*xO-WIil;E5t3n5)$79*3{GdqpVGeYiEY<=!g=B*71JdZb2Vu{e@vN%@BhNWK6ZC~ zxh$cEkh4+;ivTLrJoy?IdxNbD%s#{bS)_=y@p}+p-Ja`_bg#A8>$UXZGI<;31Gt!! zLn91K&MvAt!?oBg$NKILz#cZbYR9T-xE6PyvGzfgAkt_G3ya~ps>&KjZ3U#VqK2~$ z_*T4E*Gx{;IvZxVg+*y?;E4o}Y@oRE3(k(uqk-kI#NpDz{{R-{x*znK~T|0U`#)6f?m(V@@nF_REypCKZX=^5KzPw zLx6lL-RnL~q?GftQBq_r(dW_0vZFqswt2P&r|!I8w@A}q6{q-@C|3rjm2wd5{borb z!2AClZj?+Mp5tJQ;k36Kfx1>#yZ|Tu)F)#|n}xd~UEV8`7i^@6T0z!Nnp_o3XeEcE z-+;{Onn@Ruv;AfsP{`XS@=9s*%y7(0v%vqzvoj4VGe_NWO9(CUUYOsS@qqoWDrH;tQii&xXC*Qey^V#xTCzEo4+) z8ckV$dBAG?&j-N5I%0Zvq9{Pk!|%#??KswLG}?Aqk-Nq%G+N8#gicb6MnR~(gK@FI zVz8ox^CQtpv72b;=;6OfgV!4%X;6`Hfwme^vi<3c`O@Oj)PfA~{O;TWNA;a-4;cD(L9j8wOGOM$8Y3or4}zmqZ?QPk^{s;J4?w7QYSN zw@K)Y7Ar(>^t0J&Y+Uk*hmLD4r(fXc%|wvTDXmP8b*~mT;i0H$ZJzoKWt50n77J7r z&wltNbOgSdc?x~;z@8+qrDh@pEN@29U=6(tsGLBV)M&S8k1UXr_uDYyS^{exa`XoM zt>n|@&dU|^l?PND-K5a9@pzBIAM(8FK#&*=SxtA}X9T&QTOr*NjQN{b&0j{SPihm% zH@tMx&o8=|=JEP|H|gB2M)h3nPt{ayN{7f?6~UqfX70~jvyjINq`zpH zOH?y5lRNen{F!jh+hDbR1S<)ajCrSMI;Bqnkk8szDhhac(mRqyju**S1Wqa-WJ0-E zxo~F{0z!XbS4d+jYTw!eS7ijYz1d%fR!U^8J$PxTBWb!=z5$)N%gKS-8_Za+nobps zmkx=JT=|a|#1NeDW7eLkeDV|ZbcmS}d*z`(I}|>gaC~I6S0#y#Xx`yy0+oEx*>dPV z4QLfB02(NCcZ*Bozn~aQMhes}J-&O$r0NN`_*y-qM|zPc^!#8#BrPAGQZLSk7TUU> z^R+0sZN{|B>9;F?uwuWncHlKF-G!v4rNb<*POCN1^C$+SbDS?v@#(au1d=V=O0aAJ z&1ZAhDN)KyaKhs@$=?=eB`lo{keT&6`haHL_SFw%lposlA*nRwu0XqIWcGKuKPreq zOs$z`uB}ZEb$?yRQ_}^GiYiU}&_|$lY@mmqmFGfCu>l3|%}0*5Qx(euJ;H+58H~Yp zdjQ%+!$khR<#GT1u0F-wK1W08=AHkdIr~)IhI3)uKF7rk(>!yP&IcdJ#y|O5;XUmQ zxi>)ag%uscyU|6{FraSwwS=blMb9S`6Irm=+N&hkCe3p`qVF;Zpgj`5LbTomXhKSj zHUdGP-gi~x1ChHs!s{KdaWZtc0!Uer@XZhuSTv6AqPMpHK6fEU?C6kM)ofGUNFX9~ z=Qv=?pPX}h+O{TWalZ*Gq6-AI&&2oAwuR`v<2}?fqSmmudnL?%IwH(-Lh6!6)XqO=D8)dwM6M7lXg8hrn&#d}omxwBbF>2dYDPecT`% z!E81lkk8bHj>5E$E(RQZqU{)&vEO@Kc?HAg!ylUvg8~9HAcF!BZ1uWTo&HJZDqqt9 zewi^NFHcs;PQ;Ww8R<2Alcn&fme3TlSn9 zo^OqhTP3)k{LMMzlhy+V*nCI5vn(Mz-9Ox`6p#PeES8{>DK>K@vQ)cy7h^p)W*Lvi<8~(8 zyJsYK*BOm7F0gnA$E{Ye#q4ezcaf^*WT9sH0}R+u(MQYWd@GiV_suz+4etXJl+&-1 zR9-Mb(~DJGRHe8w9!5JP>;Yo-ux%p%ME0upy1@8FTx1=JF#1-CYzOam6710<6Emy3 zLxab8a+lf@wGxg4Y{Fl&%#n{&1y9X1r`{(v7%FRG_qsq1$*hbm!=G+ z*rZ3MpvKBwXnCR+htZh4b&wGvK#_iSkv$LhF;JJ=J~e-!QVoZSNIb2^BVSF%JfF@r!h(*XjuJ&hSq-Gw{-V)-mW|@R$-M^2v z-kbIDI*rjR)o8m#mlf?T`(NTT22@2~r$59;^H3hvN53WIe&SrW8(BO_xyn3TTwECP z^jX3JawBJLv&#n`E zImype157X=CG6`HAqd9UWif_Yq>y`2tOs6CUSIvktF$25-Db-bL5NXN-0d#A1eKN$ z_ydNN+^uVa48fvb&MthckCKn&cEbN34T2fNb;D1kwEe$vvtPknQ9Czvf9hQF! zl~+^Jqv4u=r==9zQ0|~(n;`Ho4toM2m-bFWeHcgl4?+PSAIkZai#W2w`K`3@3-6i~ zqDxeQbot2<4QB>Ofog(evF&ZHh5JmS!m+MNiWbm|WSnP729Gqkt{cojXMv3u<>a9s zNZ4||+Qo5$@qll+gUwh|t8=LU^jCzV%WMmyXqXOLIUDwx@3KpX(?Xdy9GXzg37vhO zmOOsK(JbFz_N|WavK&Z$XoEYtRxK+QDl>& zHyF6omm~X*gPPIw{PC~&2}F&ybJ@rL&Qbg|s`!?Xkql3I8EfQZq@JU&IUbiAI`(3w zn@uL(dIb8S2=K5O>L#&6;jF05kXmDHlw@N!{Mp zwR+yRd!?ax_bHVL_CEaJx2nZ<*i!L@0q8e5BCL!7>>mW+F@Su7z=WMl!^(1-2cnE^{>F@L zVFfTLoM2$`I6gilP85CB2)P?WsVCs{ZfQ}CTq)Lmz!gbML5NYv{fgkf!7A1t`&Cx{ zUu$EM5{1@wS+bP}oJp{5#N!0+w)K)HM8H6Y+c`-#=5~0$C9sz8u;Uipv>cQ$tfioo(^RyY&q$r`c}W0Q;GpB z#4VvjHtUMrEX&w!zhY*qgyHwp*uCylmNRZ0W^LDu3v7HDjRow!;MGW5#RFbmwx;9h z)5F9$^hINWw(BG|@%Hr$)XOf}2{p9IPIALJU`tZwHV6-7{6Q+CMHWN-^bvL$z*7~; zGF#z6LSQ3#Iri()Ny;v@qOVW&hu<0)e^KujoJ8o}?F47Q{>#K+vF1%IqB7j{_=qGC zv5l2{{SgiHOX{2o`p71kc3`Sw<1R%86_5#t4X@hwGtpxE^vJXo@@Lu0v(a3heTi=lAZrcR;IF zOZ`YO6s^g4$e^Y=J!RVIt(LT$LRq>99o`G|x7q)oEI*!!|CYvzF##RG32b3wRTBQR zH6Hw|WP23B(D#kCZgJVo4@<4x`7=HKa$bYHPJwl{>tcUuUPklDIXMVtoc+s-9d2&l zP#Bd(QNql&-epN2NEgG&{bl%Jjj7azA@L-oXXE8X&gBz+`5N?c!o08{w@#%+0Yl}J zb7K@m|9wW_%8>~z)k=#L%V{I%YZ5u{WoQ4ptAcX;hNG+8SNME`<7^%o;kOq3`IS!+ zL20h_f;C{2EDO-L%4*Vfib*-*rgPSe*X9$=fS$0j)KUp%c;NY!Gi4Yz;as(quY_np z+VAhN57IAocap%?imub)#GXVW>YIPN=LCO$KCdDQN-r@_0z)(qM|k47+aaG6E&*>i z>JWQ)tLo#TYtB@`qO2}nknJ#BB(R{!{xp1zVZtMHxXl(IML1ERprfVb)oYrTv>wb- z?OsjzQ@HebyFBepwi!m91ziyHNs+>&`#2={mGI;9M)H)4iA}R@$WO)Abe!@ZyO^NU zQ#MC4Dn11Kl>7@eb1rh>GgN(U>7`^h5AS_Msjs+=Z3mJrzd>{31 zS*$nNH0~Gs6)051`?Spe`ap!gF##)Dmm1IK);vLd$eE;(N}=Bjy6huFw=yvFSRUoZ zn7}a~@e`gPMw=xEKT(vZ>G{w`JUM?>5mVdkJOzY9^i?*L%C=2bW@yyG5n?kju}L+S zKq#ibh5%NinHC6gF`u8$B>Cx<+OsfQ{O*o>%~33qMEt&IM#kDh0$)lLSCmC|$p5ys z6GEWw01Ki{$#A;aZGJGY5QEPxd&$dZ&s{_a;4CB4>;9nE1=}8Fmp+H~OA*MYVSLTV z%^+}hHPNCAb8|@&;uNj!XJs*UIW+ErDH}WgoBi_!x~$p7BuW%SE}Q0oUjR>urDi{i z)*xQH3dqP7tr>`w|2GSu0E-4T3*teww#27rCTA&jU~6+9;en4Sr7BN+D$bN&$})HV zWaJ~Q>y$PpJbnq4CxUCQq5K;Fvwk$>qzeHAhPM9x5AwScRk1$N>JZ~|uyt>qOV5&V zzVS^5`JdIl9UCJftD?A)Hx1@Uyr@V-SIcTZj^Tyw%toHzW|ps9b9jb}r$4-Edu6E_ zKvq$rfW$7#h4vee_J~(hCxHhE{#BsP)CZf*m%E^gDL_XTOJeaSFk764&wL`Gv;F@y z;=2EeBE=?BCWP_XQ?yh7jFy+uViv6)p6f$Rh(!I%c>JBvl^Pf4fjmElVG99&nv{&% zC)WldyM!-T3Sc&Rx8~N?@GI$610 z{Lks~5jC3^oZ*MVJ9rzmt__>gzam$Dox+|-sPrSGBnWZa3ljDNy!R#Y?hYwC~0kh1vqn?S!L>6 z@@ei9iRGRh4vBD1BmlJmAV-bb`>Q(lk-q#3?{QzWF{xFx3~J+w`F zxeF5Pe`7RzuK_p9sv=V4xD-t;c_#vaEBbx@{9PWdh3a}H|HF>t_auDgLhzG*%MTL* zU`3^%4ZQ1E)xl=<(t3*y5`WDxX=0q8`-zbc7YoQXr@G<(PPTfc%z$?{Xx~e1M=k;+ zLa#rgZ@okq(vuxGzwV4k*QcdApU`+FUH@=64UtDl)@-=mYokm{ph_I_`IeTyhXp5! z&pXYo?s`u`AF~`OzkSwFx{zv_6Tmsp;wFJ`ASeI}q>F==go(1|W-%Lx(Sd&W{Zk^f!=hLsn z^nSvg)-$vEh76$guh4qBzrN;uGy3Du2U~d3ac5;%va0cMN~_9(UKqWp?vXCO4;b=_ z?{6t#YOm-=I{A1EI=xm2`J?)XBa9w96aLCKeVl7Lk5V6;-y1+FjyP1GDsc^2#kJ)Q z5(Hoec;9kyCw<_xu|VEklE1E7v+rM2Bcn7F@P-04+D;E!0ouy{2(shVbRZV!#Zt&y z=Rg`jxw#Fj_Y96u3F$qa{tV0!cl{xEb@Z~c=UZ(=h zh2V~&vt{1F>V7FF3CWQI(-r9oLp5(~w?7=JWW^na(oGhw5oe^!V{UO4nzR|}7fOzf zH(c+B2j+OD)&mNh@VEwBpBW@lSC-+}fs0DnxYrHM--CMddc6Pd*{P(Edc%k#?nS9* zC%JB_Ys+oE%+vu}^5ZjZ01A)Q4exl(V#2_}HfUgwLK zWs*HhO1{gJV?utRUoP)Njop*NKX|jTNCn{amB3pN=i3x@#fUUINY0s_TzcL8Rqxh$aPk!|~?NgsI zCQW>7L_oK(36Q=>^d48^+2;-1e->-&_yW3GmX#+weo-u_et4N2Z<6N95}L>sValP9a%!uJ$#an{RqGYBTlL5l#&j za5y^&J}~-YN$4s0vW?XQ{~*V|+Xn!z_WOCAec>{M;d?!3zlu!1ErtBUg4 znR8Ef^NQfe6o8L&_B8n9_P%xQ%ew2j+h&)@hDV^{?H}fU+;TS*u^0BMwvshP`xakg ze4&mO#P6}|yx+7xe;3ZY)qzy+(fy6BGIPb_X;-x-p!RMvJoin-Qt!R@^75Z)K?w7O zg{_$7)D$MijrUyhLoX(tQ`@$;LA5w%(a!G+k}D~CrKMmGGt(Z6**q4Y3{S1ZLjDr6 z2_j+M!S%NIC}ekea_~wRXOS2Mkh>=KxFLip&v(N-E)8)?-elC|)xc|-M^{PAZc|qmJh7$dX&TFeaa5SZsgLbkxi|c?;mbCA%^*E>`2joBmjL&Txw&V znVA>2&2z(p0HpX;p6bB+KrVD_oV_`gEiW|Y{fSij=-qiR4e!8YJEm|?<3--)W`L7w z5)Xx{)32xEcDfQ=uMKiJNQZk$nRcF)jD_?XDzUdvQoaMN+#9~1)Q};o_XitCqBqFY zdL7Z^S7&WUP1Dul>FEEgb2Bx3IqMV-$?0to(AH;S?zDgVo(IXylhZGMPrm#J-0w6J zZ}wIYLZ;>3JKAlq*lbb$c7McBL&@Y`S(6bImN_1@M>1^8g8*;L$^n`~#-RoT7i1^# z)rg?AqzNR5^z#2$_!Na|gImzolAMqIT-V1<3c7zB(dnW{X;R&6OEt^!v6k0-%EPwp zO3NLVYrGZG{hKLSx9m4K92-y6MFJH|kJh01rJu=P! zWzX@Kf;k^{jJ?HTI+)NWgAy_HVe?-P*8lsk7G0z?Jdk4Nsf8);ci0|@YVH?Rwx=Q5 z067edcaH~4cCgzJ+LS-g;k~1AFY^>{@Rc`)6Nykt6in&u>5r7DqxxtO^sYrcIaA)y zXjGi#>4I=A4ZEvxoy6pk?k)$lY~(!wCDIeyN#*KU^dL zqSL)vub#$jVvWR)8M;~}s-NLqi63saz#q{nLzcZ8G(BjVk~$4;h-Z@b=!Xq>wmyX? zOzmB26UF*$OtQC_TooO)W&XLF`^QglWLzz)hJB?IhTFZoue&~yZ`K)b#GYimr@NKP zb6hXdb4E>vGIaS2H%p%U78=V^#`k!)Vf3zRmM!qSAx$(9YzpO^p1YVv*!XyTz%SSw zo7m!S2R`|A;zU|-@=S$#b6l2pVl#!ag7mgoR^bv_H-TZBh{Mt!dn6;BjGwi5@~;Ga$l~|tW%d11Pf%IoWBnWO;{<>yno=wIN%rR3d-Sx(@c++u zzZ&V=!IDaUhKq84dh|jli)S}eq>izS$B=uj^5|Q92czrL%x1EZ;#G@^oG&WS9p@b# zEiCvx*?xXxGG9xqlrogo%HM10{`IRA+xU;Tm`i0lDe;yu?4$NhQd`+WVUq9Cb)RfHaNAHkFEM=D>g+;rMek$fZ z>bjL4JG5#wE%LK3yiMyMK>S5TI!W{9Dp-kKw(YX#>+gS!`BM3>i&`H8xrey#wEv;& z?v^pDG?Y?gJDVzBL>NW6wqHIyp5jt_(b1S~cP#8ZcX0AFlhKRi1k5>=fePZqsgz6k z!A2mvAk5*W#NZ*I{^5EVm9Dex=S#EAZQ|PSA03egC(9<+-P6cOVh*X8p1GJ9Zkn9Q z3M7FU@4C@_XSf$>k}6ywxxIwUuZ}GhLl}ML`2|W6ZB=XhweW4w;76xz?pL|f zyPVISx3R>gEoYPTN*|~Wbq-sfA4I>4Sr4~b=D7cg9D4@>$X<5V*I6BR#}pI{ygFf5 zmfb0e#zdOPX=@upH3CG*7Ep<%w=Sb8@;BHM;Jr(t`=?(CtM^6M+Z@PEvI|@c8>s&) zExy}d!R;4i!lL|fh3^}6YsJq!dQ+2-*<;O+G;inWz@&!kGF^OV>h<=1TWHC?Oog0u zCE|JsuIQciNHkrY%;?r zUcNK8ylwPy%a!F}=@eG+!!uR90Lvb0Z%4zk3G0w{-_NX9NSH5`6l*jV%o?ELY z+>jizHV%S=e@P?+V6dsst4P=Z?rdTLUe8M3HHHnd*OCfMz0a-1Cqs<3e)uctyx`&1 zv?@!$uB@e?eT+6{s7z(2p@c*!<6~)c@L*B985z z&bQmXyJpY)>ZD|g8*b{XZGf4zx%cvU#lWYP&E&ZejthBEw$U*5wvo4$4Z(73ZM&!`Y0 z_*w?xE)fXLdFK1^cjT3Ve*f>N$H*&_(0tKhnGdzcFMA~-GKPnZcn7O33_3>0yJ=tr z!NbkLEeiBi z8*ka5&5&4Pf;tfBZsM;@6HonoRU*gOa8puteO#_t`CFA9BNYGm1r{VFU$nU|@uJAT zo~T)LcfwREo|vdBqf`@ASA8cahFLlpV;xcC{n2`s^0ZS33UG?9)dCiP;a$pmYOV2# zG+v6>-A7ck6WCe==#R=(i|&8C?(%u+Sv}RC>^2XKwcr6Un@Y*&`?Du(5vJ7x``Pou zetRTu7i&qKJIi|!zgM(xeEcU7U_lGTKxB!`x5(O)k02C^Pw#Y0Fq?Ow34-kCY}@g) z4H0s2v;NrQ27zMl9laUn)M(Yb>Xv0t(~q^hnC0XZavNPLFy@ln_FnG!7)zzdtakQi zI-#DZZX=spssnhQuuE{F&BKtw@iUuxP}cNr6597L@!W}o&4k6dQ|nj!7YxNSm2)5O zlE=oE4aWT<8$6F8%|9Hr=JVCpTM^ClK(}B!SP<}N_X@e@*-5$a%CIw>{so_ed;6+8#+P1$k5IvqX(e&`I7>- z4Q4Bwi79e3@nkf!mJbwq3;dX9tGB&y?RBCONj3@sVm7jpWT0&yfo|(iJVGdTD8`Gc zX=DCoJ{BB|0D?2?Vu)q@wXF|bu3@Ey-l6;G@a$G#y`$JYZm!-7=}|iW8cR14T!VJ& zKg`3xBz>81>rPuz)85rzadlb3!y{R-(H7@g>QH`0$JW7qKet+QAOR@UT^2~F#f;0Kl?9ANX^YZrxOlm*LQ z3|(&&$Fg%Htv(}JLA(D;AeM)b1z-^h^w<|#jZ_%b=L1&!M~4|FW8>DL$8AnZWz#j0 z$c~QK$uu0FlNGO(Bk(!K5r8uC*YYQ+0s}`@6Mv9Mo=gt07TkhxFG>p3L-48G2 zBz#=1hISn!Y-|ny&jCOZp;-#CiaLpoG(GX&3HYY>mW{#_R@AIu9K(YdKUb2zn1EWX z5TnT;)5%FazFoE-HD#Mw9LfSFMpprimM@kDR+xp^b8n z`kp=>Fh0w{blaoMl`aK4-=FreiYXW6Qap}4kZCRHx~>Gv(7ZbQ*C$YtLJU5QUl#k@ zwY75C84P8SC*zuOOHQmT8<{tu*G6ET-7YdQD$v#52pZzRIK241JtQ9w^jUgJ)Rnj3 z;Eh+zRkXxp1qRq+rc3ZB&fSBxHR(!9EDC{dX|Y;Ktv>5b2!^ZudU8yv>MIZ_;nNT# zM?8=1evgCdZP08&%a_T^CN<||N5pF{K@kb_&%kSsliC9KC4dFi+}vD`%iZxmyUy>L>nwF}`KVFHM_VXR1o>Ga1?;>OAU!G`7lVO9o+ddbCio@N0&>D`GR` zLmMX5?flsU+=CSPZBr|Ra5_1h!s&frk)D!*;@4R8j{LY6;>}Jp*-6S zA~mXHk11x@-h}tmuj3$R9nOpWVPnar1LVBdpdTWFlfoH>FW1tTvZD{K1T(;f=05ZKjQ5)AK zj9FGNwrY|=Hx;)x!$oe9e~##rf3r3+omDcb=w!vY{?beUQ|nA=Z)WhUrguqg^(W>U z9rJQd7z5j5TQbtb?$(#=*Ll3vn-OcXL9qz#Jd1jzk9x_EtRQrko5kmOHuqBj7wAV2 zNc~mf;QMbHB8<}QCP?*%9^i@}1PQ*q*!IWIJIlSN*6^N-JrUgbe)%*h6O$B0vljgW zi|di5<({jqy*k=N2p~L-{!cR^xibly%C8_dSU;`f>}zpVr;43GB=(q`KTX6N^glzd z{Y@{Ycl!fopE(EM@jLy@P(VORB5J3p-SqTJ>)&Y_`WJG#> z8%S>aFo|@lXVwkcW?I5YsZ9mxgqatkP&>;~#tml^Q%MzZNfXol^pJ)72fh#jPLKIC zmLr1RIQA}1jtV>qSvT%K24@ZQFhP{7m48ou5SzcO+3rQav#h-*!R*6Y+jV<~nuMps zQ&p#DDvI(Mokf|8kQHAXh7rOBZ8& zVr0>=q3L#!6-g0d|3}qVxK*__Z!Zu#5lYPDlr-wDCodzo)%v#Ft-|GH0;^`|sO zWtasVCDwY4>`9i*klbF%a6VHHG8*T7ma~WrqQDby@AI8Z! zJIpfwwdgxTs(#6z{t@hMDe4zqze683RHQRT;JuQ|x+s-gm&?H6k(`%-@zlkJJxmk` z4%>4zr_*J9sn1MPz`<=tM@QkSbt+EQD|8Y!s|H&Zog2k*Xd?(B7wT!oH_3w(I_~iQ z(=1e|KIJu%C`H^Ll%H|hhkz+Y5LtO)j7jvW%zeG-(Ja9o4_iH#JxG-($gZBTIS=`0 zCZ`MB;bHCwsfFU*uh5q0SngfW8^|0G)ttJWtcK#mjphl&vZd4tN4O+wTBhLHRwdW4 z8499neUo`Js8(1JRXgk*mB~@K*USIF7m_fMU!JqmJb?_n9%qg+Y?YGgQs|1~JNX%$ zPgxd~PU&b#aY|!ow5tbp4)7<>oV~kG3LG=-nH!@8x&eaS6Syd+#hW)I0rfZ+&l^pjmwIC(AqmOMXnz zf44yc|HcQAF?pRXOEsUYUp^iH0)Juzr~raFqX^8j({^uP4Cf;Mrv;E|Sr0rk`lI!z z=XMzv3NUO({{XDE?Qlnje;*r<&8!sI@PdnBrsMQE34oXT&uN>+&SXH0dhk>5)H5|- zp;rRyZMf)IrMX%ey#+pQ2(-8uoZ~NeiKY+fjeJcLWV(w0;D&_io3|qY9F6qLvF)x% zKa0x;DgJ@a2H)NJT0ZL8gX7A9T=9y79tDtYrXZoZM>d>*PA-5e`({CE=rs|$u0}lZ zQm?Uqx$_*e7^m^`^^V$tH|883SOB!cP8;%4*W>yYUg#S?n!vT0E3}MTG3x_kt_c?Z zYptRLjG+PQyBbi6sKuE$U`Ho$96axs6sw7XaE3e9jbb`aE6p)gc?4-B(Y&X)9NXzu zcrQgrZ;8ouQV921PmlCtKAw<+0~-*WI02H^GKR)#+u$3um-bk~cV23#l^CG||Hk*P z`Q9KxmJE840Q`J0GvGV8`u$@?CzIr)9{%&Oxgb0`r47g|(u13!$tJO7hPs1#nEyfA z1FHCWIxR)84Sxn#%JDYFYp zSDdM-6AN-IQIn9xpM5So5_qmP#zMeQg^Vk6fj(%L)F$7o!9h@*5?aJBSH2&kMx;H{ zaeW0&5hKFJHZYwX`GPEmvRd7m0Uw8ULK>rjC~qpd3;UYFZAI`esgi^BcLl7?3qE`O z8J{k+K{>pOT-mnPQ5W*YBnrLAf=|&#z^GM?%Tl)J0*l%Eb|OgR#N4T5VU^Vou%{C#)Xjo?o-|q>5B0I2#r>s3wLCxe z(ROvii&|nyiKfCGe|4_kF*(lt&iQSil%_UQ(q*;hK zGEnKzPcMyY${$^^207nyw)l|#r z&T-sXeZLnKtZTjlx^bEvnSWnSZF^v5=<9V^g;J)Cl?KYIIXPKn|IcLm)lO%QR+ z03lDKA+zOQ_eK%H%ON(Vtc}F}&Jeu8tteb`agX<@z3)fMK8~uqJ8ex-2432y7?HSl z5Q@l{a{8bO4X=}pgUl@P#O&~TcsZ_ywc`6lUuqNn{y*U?xCFq|%jx3;_a!ML#Q5!2qCicgl7mX3~&29Yd@X&l29hNrtLP>0LGgkSrq)X}&A7(Ks3 zM1ztzBhFf5x&8xbsz@Lp*87y*OJ_O2`}r9vz%sN+T?p4)=YGqSjLg~+lO)k=iJxVB z6J#u4fEsAAGs=^^#|ti#P<0%Nz=OeiwhFq)w)qu>rk;!rOSB!9j_swM7ft zm9l+v4ry>z@-}f-If^cY3o6@nE>~-Jzy=mY{j3Yk%;OusUX@fVM<~tc)NsP8yzvX= z(`BR*Wsub-Nb)H>z^)zisDefQQlQwulLx128lF4;Na9JjYod4fxz0N9j|c18dcr

z$Y9PC;)=dM170VVcoRa*6w9*!JiZR~Zs~V;q}c^Ja=f zzf^zKmap{X|L?YcG46(HzVKq$6q7`Bev9Zq49F{tF%q=F^T@e6J8!oGN9uma9Z~OB_prXa_Z8ore*I6Lh6Io+m)TQRRIGWnhjjIW?X89;F?LUds^b z{jQ}(x4V~b7VbX^dJr;4F4T235UX{|?0P6rM3JSc63F4*X@HJ|tp6#FtZWVMT(_5b zv8FycGiTbn&K=@x^-%^Zc%N{AndUQe%&lQ~1P{Vv1Qrqj239CCc;RhnNCXN;s*xd_ zv&t4SSR&vnVCqFP6ClJZ9)#!sMus=>Q@9n_z|~J^$j?oyX|2QiA^I_jrbd^RaUN*E z1imb+R8W%|^A)%|iu+kVB5J$9nrNolaeY5u$+>zF`zeHu)^vnYrmWn%aIYYHqC zKhIo1Nrd@UO4mb^z`3L=$>X*k5Pc+Adfsn7l$TrDs-3=VPT=B-j*abIw_%qNncYBx zXQb*)I@ICd)Glc#PFViijkoAonhgE#GNhc~m`1D83|E{GHlaK#BpV8>(% zH4|$`Hk`~6-5<&sO5F&qShgm->;jhvIF;l&Q#nrz4{h^z7B0Yh<=$t+q5X~H3)LLo zKKF2N|D}#hkh9y24tVWat4Jd9L$gLBgjDpwp49>V?<2oZ%#)qi<~sQFXZ~7$)Fj9p zj+7gGD9jR#6f%W+|DuA36XD{10y{1TM(|mr3=Iu25Ev~?EW!91leHg*CoRoUGXFn$ysER(ag#~?!N_2%%_(zDx4G3h%E6=Cvtr>f~md&2ptB;dN&l;E9)IjwxgL~ zwT^zxN8Book^fM7p=-50P*4^+9Z^o*yIf;<_M} zuYLMpc~J^or0zM!3$XrsblEyFKD5mX2J{G}o=uyM3lu{LvaZJrhQzR)n%^7l7_jn# zj$y;YNrRUwIAHg>S2r9FN-H0w@(LhGhnK1i)ZRddUCfEZ7;Iv_yFV|I!@O5n`BARg z%Y$FJqe!D{YnTl#?gD8_mwqved3({lJ|w-E`yYlo zg%$hK1d+tluHj~*Cs8I>vbmvB`oc|OkEoxccW&E>v__ieVQp|du=Xoa73!h%x!uhs zB?^D@rW_)&xf71X8c5d|Fz6w}rtl=5Nd^R%teqVi%6Q8rM<{h@PnX-{x7fw_y?-Gc zg)_-OfN&oaz=ld4m=84554DmiHFYxB{%m#cVIctG&RXKClp1w%B$Gb%GZ^P#_e9By zvxv)p&o2IX=H%|_$%!(}#P4r|Af6qjG0&K@vib5oTn?goFfx5+$u}de{o|jcfkzGW z!(S!H#^-L%H?VnNo;x2|U0^@ur>zo)#_CvqQ$_?aufhf{gdT+idNzE0h;9((KX5u}|Mm$^|6=TQOon^HF=hT87qyJ& zPp)}wp>$;@HlTRgY&X}2O;O026{vPj0F4m*UVgVx^ylwWrJU~lVkrYve-~fsZPP{y zGX-K~v9~0k%e;edh2SrSfGj%moXmIQx;3Ww1n3XTQ!|iyU9#DOks(*=IRE={5>GD| zl5)Wl=ISTNFpaD#!SV)EXxvO}ypk4F)<)+ILNPG>h zSNTedPt=?DIh&o!kngGz+;V^B8;DEx;+O|fo72# zj4>7QIK~MFW4RcK_h$km*p&42Vd*(b7rdbNj9ZpyAGzo{cM(q;v%<3mx?D6kJx#m) z)F^rMwNqXHp%fFgRa{ZSesj*}^lOG!iiw1Wc#0>3ZsTD9+JHDwo7CO^-0QU|HK-YR zK2|T0I2bek;pNv|`|-RNv_kMhit}JSR2S*Jcm>=4N?O0RX@XUbFP(vxwkdkwMp5vu zf3OT~i#?Y_EO|NDG<0~Fzc~14QreL58lc=!nJxKfuV=49yVy}Ka$uA&kz>Et*~dow zQfHtPNAt?KS4I8~eMy^qpwmbX^ExQZK zuX_fJiD5py^_Mj5lGI}*b|pGJnj0(T{~}e{^83eQ0+P`hmDttYDcv7CoHn9?K}t}pC^6cxabg+-K7oucuf zFqZ4&8TYT46S40Y+;0X&GDgB{q3);77r`kru3CRboKvNW%WyDzY$rB6iYD^63=28n z0IYVfEbVk%lVFEcp?ce;q4AS=CQH|z`qK4K1NKgT`k;~vNL!jsJ#X-uUCs`5*5Hd*z6X670> zrEl`6z#ENO@SR|)62*iIO<%$bIt)H6s!Xmh;WUK(n^EYUKV8O1eX&1np7YXpJh%0EtK&o2%9Yive5^=9j506pKNt}&lEikiiu?rS!!n07nL(L9>m7hVno_mZ`*T0R_1I&j0!L22IA z-OP-bU+4P{1Px4K#mZAqlLD(a2^OlaxaJC zUPu-kv`w(&!B)b4w}hS!75JM(yK*F$#l)#mUn3s>ie_YX(Eey@%W|@xC*@(ZFi0Y% zAel?YMg|WqY&#hGchx$^JnpjlB(|D+fc5wn5fdL{QjF7UxaLjU)Djb^CwF}HJfWC~ znE!R?fJ0PDLh1LtJfAF2tO5`7>mU-1*&h2HX8m|w8CVajh-rQYTDddf4EP5Jmyh`J zf!N@GiCGsPhq{Bkl=t(6GWytjxaMhC#a&eNyVU!B*F-zglz*ih6M?OEfKP##h5PZy z*ttmqbXqBA9K;9tU%%IX9sGHE{oL~60L$bTbIH8fKHnD0&ljLX8JTMGq|9=jkdf{N z7S`c$K4RsXwqI!5Es1EB`!jInf5Hxd#iL4`(bM?Q*5C?})ok>=kq$cY27|~5OlCY` z8Dl0>NBxO|4=*b*_`1d`GZM{3*k`RMl(H@EA$Gfy%MF%LO1+(xJFf27vH?Qzg1p}h zcvH%?XDIh3>(rI-jY(!x8h0YTEbC2SBmg+nd^l(k6y$kp7Ey?a%j}5B7L9J7XQq%+ zMci$o)~LJRiw|U-zPIl%O17-E#!<-90j$nhy8D;d;1~SG8g5X-R!%s8qnQ&NxX*=h zTCh)dA9o`ZCP@!^VMTePl;C=#hWh$Xp9&7|L>wG0z;U*97v)j$3l@Z-2>kMs%5%*~ zz;9|6U}`7(O7y zY*)7b-Ewo0@l&y`{8C?)hzV$!rTWwAj<*QXKF|NWH45q-NCW z`K5VtM;q$-+jZX1VDlF%n_;&s+nSp>A;5i}YqESu#oMYoM{(ZuW@NX-)ZlhK9l1sk zORje&K_WJaoUb*bl;+?-3bE(M4g!;;)uH2gF2U!V97uy@lyte~B2gHSih7dF#yQAk`CP7JVVD*5bZUzMI1rbFX9@hgMWYk)W zQSbg)Yg78+>LbmU5ZS4(H|{+UvRsR0`zT1XVo}+;bx6ccJU<*LryQvKqJ+m)GV|85 z!!0x1{DZ4Yxm?%yqDSRv%VlRueVV*cqx!?&-qt#he7gYIQMhIn{-pZ`g3+iZ?u7#E>47 z-3089+pF5>Og;~(ck0af({1Z(ckpI}>Qk|t{L(CPM|2Y?{2p2Bp7nx142u`xKX#c{Ck!>rtTiRh zTovaEey1cu>>=(qEMlrRN)Mj;hK85hqlPDa52l{neRkL{%{GyM7#Eu_sKT%{m7pk} zIr>dY<&)X`|MKvO=bj!yTib#9>x)?ha=(S&-HATa$PagUrLN|YYuL9B35X0c_s___ z3MD&myqmoDl@7vr5DFg?Ad;$%I-kA^2~z6AUCfTm7}|*B3uSmaqAX2j5OO$b{AF=~ z`hj;4OrS*9ddmL>c2)B7qqW+S-o}TXV&b|B)NrS%rvQN2&rLIo9rCRu6TAb1+2PjN z?$+7d$0N!FC|+h@QesuCXT20%S#@qD4YujV>__r}(BdXf*C3ZN2%#oy~#h_^k?C{@{>gy2UB)w#|p1Tu_%lZ3O`|0 zA)V`6D?i>_oa%w0{hOTY<@>oBDK2`#M+*&g61n;6gh>3#gT=^ENjA(;Tb#%+pC|i^`&xx=~7#dh-3g<~GE>A-1_+iZm~rz09+VnF^L( zS{CM*lW`f%goio$K$MnNJ6QBoA{GnzpLDWW{sc83^e_@ ziao=@^}-un7vCZt{GySaIM8{oa}Dm@={V$^UU6@02UaF<6`hw?3fq?n+hcrZ2b0;R zkTmgS@Z?*%8`PT6Fbq4*uJ;i}86R78N}%-+qnlj;Gc#x4H+hXisg723-dtu7RBKS8 zDFqSGDo7f2bc(9yrz*uk!Jh$#i4BAl$%3{F2Po)Qz-c#{|Ktv`NnMEcZ`VF2TF@Vg zE7VSg7rcNM=oT)@wjf*2ZZo9lG~Af4g-t%5-ggzjvi-t>lxbs))m$J$5#~KL^#!*+ zpjeFplVZxO64VfYL$KvP!3r%_w%^NrqNfKb4vUn~$}f%L!|4|hw42N82v4T|q$KHT zjAk2@Y>2tMp7r#oGC}))5V1K`{f$e6tn+%rS_M<`U;oL1QBgSJzE+UJL9dlpW?;VI zG>s47DV5Tr9~5D+a}l*roW8Z4pjSKJu_f_P<8|I%*Pj*JrTN+wolp?LMewZN*8!Ew zZk>G8I_}$76*XCf$&S|k!9q(hZ-o@%v>!1hfmsPFZrk60t%Ga+KdnP25x7v>`_*fl zn|>F=%&&USfcGO&kyxIw)DnH~KYxgUYn~uN)8vbtu#~iGVjON+HcwH_`d*?8eD9e- zkdF<3BPN}DL~0KxmWIoKUWD!uuIy}g>CE#8%Bnh1knwVH@>1Wsq=+AH&3Kn3@&HlP zndC1m_@!eORLAVitgMQYlanRMKfe4z`nIOJy1KTuc5ZcV&&?BF1RNJ{VzL7c93MB? zFlGB6?E-ETv!5GV;9~D!!s}odZjm*V&H-x^lj1>7ONrthuhl%=>RixL!w3Zb=frip+H1NxOfk6<1=T&uQc3W3x$YLDDXnyRKw41TTffUN0Xz8Oc0AUI;;w%fEzuDa>4 z_=T!YFRLbEbh^s}bbHjdLZByJyDAu?o@R}X$ktSs*@5$#kAf;I?${_id_F7&_aA^% zE)EV3Vc6x8h;hQi*G$2T`iuhfQpZzpugb**A)A>pSVu51G5Pi_TnxRFJ35Vn(Mk_< zwH=Ae6;Ao08%f|t*|@mGrz^7sqQxSQ5KHg>GJtImf(&ISfKZndR>`xUghB_lwFY-vd88%od9(d+w zA0v(#t7B}87mVjz@ivN5Z$u9dGSpSuJ0MxclZ$=Zu~xQ}~} zZw$~iTKb^}+Z>1aKRr1`MKV%S4c4o^@;!ZTBL8KomL`ISKX&MUT%wA?%@TSLGKk~U z{Cg^730aEAt&l~WqBtzV_f}TNNyZYD{=2ZE z+{p(CjJ8v#WscGe53a~i@+zMw)c({C z!D}|~FUGp74W7ktj0*Dp}y03M9HmT@;2ALwu1}`yZroU?*JKT`RH-@&rY#_ z2ykLJ>ZTVhdF10XV&0}E+i>nG$~Fqm_c=2}rN9FY)RfYg-EGW+mY6nI>^m0usSf_M zu*$uPAT>^!iQuJ!(HUV^PL8(!J($?oP$<;E&~VqzfS@^Ja@W?@_Tz^SzQHaBV`+l6 zboa#ALG2sG`MtYwua5L=YH$HFD-psaMe*Tm%ZKCpgh`ZB*MF2qrIH{&yQQs=HzOpL zPl_uyF9mX!@Lu_%M(Mk1MZsK-f9K`}2pVWBIfgSqy;gYdSn9yy)%Xccy6dlp`+jPA z_a<2R#`eA=e8sKKNusW+D{{uZ^8@P4tYoJ#uWJfD zFcx2J${o~xf@Fofy@fM0(3>5SSQi_a5tQ7u5M$ZO+Gh-Sy&B&KPnbC?7yDa`k)UBl z;K~j`6XA5tiP3l0#W?GE#L&a#gI#!Fd0v3`!Q5gle776NVmnwP=MQBdl%KftjlY>m z{;u3gnJk@Qwq|$CyH&@po>d&jdsX)EUWxWnc!kokV-s`vYPLl#Ncam#M3}1tZ!w>q z%weOE(NQ@$IqFX-yyWC<%&Q5q{GcYneFzEiq#Ojj-#hlJVI6g%l;OQ*#^9Ma#TCKINA z+ilb=HeXJsy7#l2Ic_hQ^q7fvuj|?3l=36ZZA+Tvfgl8LziHg3(N)v!OQ+;;Tc3!E z%K>Wg@yhoBy-`wMFiem8UWFukn}poNS6( zB3-H0ck(IZRzgY1wW_nm-z{&r{3O=AcVpuJY;J#_U8b}!(4;%JjObEYk(6W?&-Rul?6$!tyPY$Nfm*1D;O zU#(!4g8=w&xI8h$!j;=|!Jxg8*xzJn?Zx!UXOP=1UJVC3D(*}4ltAkaJr`U(CMW5` z_OTu&YuXgKuwB=GR0rHc5U0?^aV!-h6&>!@dAUGS#WaXzeW1dpqhM&G2HW927iY(& z<|k%@*eCg`Uhk@{zsS5@(QtnIrxHOm>T%o$73$#$@$wZHn4nBz-ZNR`CYnTR2XG;K zU)x=kAN|S^M}`(I!^$rY^Dp&?Qah|hvh>kk+|Tt)=7!rcrxIy%Wl`csxbiF!fnuy9 ziId<(d8wkwXU+FzG+W&|)TO%ArO)vf9OpaGkI>G~&so*1zkpj@v9T*nCkxdMi+5wo z`pdQiX3Eb2WL~hl$L7~eH-EF;E98iH#k+32CVDllNk#wvqL=kk^wOv>*U_VfLb*7KiVSVh0F2ZecB{J z@o!^2`hI$-dB$bB9*KP0K_Mc8S!=k|*|}Is<6^j&=G;jFZu7R{`5NVB&H zx-o0BS|{XD>xAxOkp=#7!7sFVwH#X`+@y&yXgw@BabCN(DJ=Icq{^uJ&Ch=86~lo@LZ>_3+EQm z=LRKd%66$O#UyKECwHv+V}Mu*JFAI#B;D?o$z#XLHj9+$IOInc*dS$kCPs28EnOa1 zDczAyT7g%#isz{Srzd@y#ob|fM`B_OA;WC$D;N~~m*luUDsi1b1~ zE0)Gh_x{AbNcZ1Ty$UW^(MEVG4be+$YGmcH4%$@U<_3jicy-E|Bvwl3k1GRj78bm} z{H(jWdBMRodwPw&V6H)4)EgCLC`Jt`L>S(kgkPB*RLzqk*WBHKx}x1{+9u+s9?8^* zUU}P%u&ayl;ftSTh%2LN9xA6Cu@PLHxxp;*T|3-RQe~A9gC958@dpg5E&CM<-z7s}Dnx&+A^hbIkd48;wYmb3!6w6C7fb z$%(@IMKU~A@|(4)y}MtU*?jfebIVej%J?y9;&0wN2zq3zjr=@A!yLqdt+U!lcgF}+49n7Yf;7L$t?@w0}v`sccwUrKf*vax=_X{z3|87vJ4418{Ogcv<0to zKV>Xy1!^Y-`FR-r46E6A3rAi>rNi6FUS^2{JCvhW%28gz|XyCoL@=D91{VYTazm+cplMrn*+XmY0@b7?B`FWCrrKk2#%+F}7JU`qF zm7z&eAz2Z&PQq#Y-j!nEzAg5hEI8lyGmNXX`3f_p*>bC)q+l{q_>Jenk;LVDHhB0( z3N!7Io;L?whP?ara}CKswjtaF-_KN>O^eth%U4U;pk$uUkAI#YKtRWL|Ft9IUltQ*5B8Zuh6an&MNqkg|# zHM;O_wDX(MZEqv8a7}@j*jmr0fWFb`Mme=qylbgA<)dJg#@i>+voA!ZFP1Q)#Z3e; z_;1W=pZ2sUX;}4Te7la6i*xhX z#t3;*jrF$Z%DL?}=v-P1r(c;b+-kD{cXt~^CRvrG)p>G{Xa@@eP=7>#2H$_)P8K%O zIc4bE4M-~ z-t*Xg{)+hcpj!uuUZpZ7H2D&-9XXC?rdb4{bte8IS?~@xQ~ff0tbGY&sjP!Vi+#N_ zdB<7Ea(4hUUw*=MYNif!=rtUSdR@OaU3}xr+Y!O$q4RTbiGw)OCrW?3p+e@uC26j2 zBurE7wrO#ZLH^G_Y^V-4HpSOnvQa8*G8moQoVMP1Yx|~)v)~P$wI>~yAc)mLV( zWz`xW&VT5b?hz2O=}j12Xs?O&`q)ETFGpSDy0ud!wOL4tMRTwB*Ot!x&d0n8^RCD2 zFL|2iPTNH_#_Z}-`8~Ixvk!NwGDB-|c-UP;#B{vY)Nqt3@}zU{eLBT?YKW$ZlemW} z5)ikt=9AJ^DcvtW^%Y}#1?-ZINVW8_77USBQ&W?ZTiw{$_#YX~K3fZb+nlG&V#v_J zjSn?no&nMpU@u;Y`nAeBQB$QwJG2TV%jln?@H?M&q%m+pW_qBZ* ziw>@jFy4mC?8O2(+-#}e&TgD~M_vvsz@Ln>s-2!v(sh-HKpJD`fP#sn3~MP9FB!kE zbYXDNfzeE0QYL&W7pr)G`Zl#l6m#ymNT>c90!7K+Jl$X^9%l_!v zfDKY~1n>P_E{5A;={^UeKu>hLB%<3pI6=O!WuVx^cF+4zrcs4^xq{UfTjtPF`7b#K zq<9XmmM9=SM~;g=dB!=QT?aK~&a`juN6YeqyNKgHS1mPQcJESjws2r;VFL$B4Z!%y zAK?Og*Hz1g){*7Ly`F0C0|yThb8*e~_nZI2KAR2Ldw*&0+Wvuo0LRA09sb*rqVx^Y z^@s3~t|Q-}j)4JT(zPn|V|YM>g2bDIHp$ZK*05Kzt>>Q(w^D?s2oN4258@fQ54ztY z*1S)4EmN!Atus9zLEj@iuTwsI)c;-I&26!gA0K;nvmE0#=xuzcuG_alIEi!$IH|{r zgAN~zTy&3|ol2+fpe7o=o9U$MkEIqdxTYLz0OrQL^WnICuTm54o2`n~(`kCTdGUxC zwLcuMQy;);p|-|s)dnb)zO!fBhHZjrg-kGgRpW|aDoL`I7Ds5i&M-@~vg@|``mzaY z>mn8r#Z;kpEKCa~m=betMZqW#lB9JgdKD~ zaY-K>&-(RS(Oik$<2_>6&KjmrJUGxXw>1)@KT25x1qjBZxB;8KT|bL3<52t*Xn^}u z+tEcq!GT{Xsz=E-HAl}m6>#+-Ekv{pC%{bbOJd#l%kU7!oVLr;+}nC?b>>OIkz~^CXo6zB@hySR5onoScG# zUh+AeVvkzmQa1_TJ^T=8l73f3Y$IP&dZ4NRHyRL3HPy13t;x(mb8)eb7;4UaxrmtA zuK)0`eZd~nq&K%b1$_Mm=6U(MF)$BSh9UPw_9AJGdNK1{cTnXa>2B!u2p7H|bHJT3 ztYRd}Jmqk4lN8S5F2u9%#LEN|a#J!!dCJ`hhAU{rB9-z7lZzmV*}2+~vB-C!QhOYB z_txmjHQRI1Yd?valHh4)wb{Ajq3_K{gg$SkXah%0)A>X<{)#Z$b345<6_<=kxsN3< zIos%-U84jxPwVvb^e^O*HO`P%K5XK@uA#6iL>J(5#T69=#mk?sUpYCNB0XZ_9VA=6 zo}Qx?nsaYTOPiA$W|7*alFe448Z)VohK*5T;nql!n)BZhHJ`3tgrfoo#SqDz2+)M{juY$4cl@+n#| zYm8FwlZtmKe|pqJca}YqwS7aixT*$KZhrK)5H2b3YSIHQg{o&C(24jag{ZZT(d`hu zPN|%m4jQbo4=jFB6%`mP1oGtb#qANd{X1L4AMVKo`3o1_^XhAO+?zwa?<7>s9n|$@ z`HBjuDS{L0HZ4K?(Gs&O_G4fGgA2_4FN5e)A2kXpw~*pPmfLV1W(=W0A(WgK8#0!K zo_{|YCp@etqngj$zHmgl(wRPMC$ePM33ka{S!I7zuh&t`ru%Ul+ZW%cXB#4K(YA}% zyMUalRnJmjDL6Z!4mLw-U23>B8an-HElyl9$8AvY8)fqjGFMg#yJi`}Lsrximje$E zd1%s|60oM@-OUyH4DVG6ZCMLzUM@BCU_k>soKM3ZJ>+E-4p;W~4))FFK>zj|!V~08 zL6MLlo$=br3H%h} zWMKcPu-LStSP9}_2T{Ue?#ijzNHVU{I@e;y`);iVchIvr z0*@kn|3}F5fmNEEilMEF#q5GX7`*|c>!Vpe=ezZpMv>2n3qO9u1_j22jv_23anE;j z=jNv_1}@MyT3csCj4>qVT-X1SZn{X>rm&%_wZA>J?oGXMYPH(4N9uLy1jh{66y&jN z>~Dey^wg2fy~IrTl2_Zc$wPml)SOH~cp=EFCNpUkSTdvk4td!cg}Xmq5V1h;%$q>O za16IhQs1r;Kell}tL)`Ke2@2pY<#iytb=1vnvu(S%&DXyqaR3Wxgu7_t}BqIirpTH zmbH*J6@im-UG^5bC%ZxO-%A+bM0)fR_yAT$ev4*&kv8!w9n5hboX=&{Ow8T#EFZK zPb{sW!N87`?&M>(5>ov{Pe+4=C5~wmoi!w>35|;C5tqOaI%bCZT-~+E`zVTtG!A2N3C3|9F=x^Ju`(g8@9(z8D`5|Fp=r3Qs+#NnU*$(6Kg7eB6 za=Qz*NQ1daagy6XP&@hJU4QpRJ?D%#IrGjDl~pHwgB62~BQ73D+WsqxtX;OEM4B(} zt9Ii%VCtNUQ+t#2%Kn}M2OSTn#)>X}n1aov(@VY*>!C}kC3o9RYQfIg`sbt(a``Da ze~h`4{zecBR1luG+w!oGH?3PDrf$lbue-N8s84Ing@^z1n9`s`A!BB|%UWf9sqk&H zd!~}}o!)vabe(~1eyzI#hwofXA!mj9XUMOg)B^DOq)1$QZ_=)KPk8VeUd`B0HM{Lf(BlpSR`8!{Qv$+%WzAbKm zlCp3P&x!U>V$9r$E6rPfXZLLKQir;pm==No6ztPdHC3p>a@RebU!0awV$}cH0133$ zczAf=CgujqEx&Fg{7%<1%Lz*-JXZ?-YsVzjEUGT7fLDtK1cE|uzb)U&`{anG|Hd;G zuW)&F3NBHT({h}$hVU8=H%s$)TjTfAP^#Fjb$Cxk({@V@&?S_DCqBpTR(7L_5kUMj zjpXOpyQrkkJG>|i7`V2IOL0U*g>r991pMR}-*z?Wgu=|P1swSn-NRA^H{VabzaEUt zmG{0l;A7TS=d1cnle_i(ue*SV{PX?&`xqZIy`}PAM2n*MyBbamtcXDUH)?dDS6WRq zK`-tsZ|Hhj!9@YBrE>bR?akrl?4DdletZLS&SKVFI2x}>13ppoz&Kr22Wte}uJ0ox z=y0_?1`-#0LvWzv@}?P{AG~@_pbOF;8SXa`G&}WoZ?P>E41$Y1;^LV61`mWH)&fh^ zcMXlj6#l#dCYM;;T+@VNU@Iwa(qC8>?pMgGkejb~ z9uXnOqAzt-S>yf91O9(b0wMSPlj-6NsMj$zxw&oz z@t0FVd>L65lgUQ}AcFL9#!gK36A?SCH!z?fmay85cSQNYr9$;@um%yk*Tb%mjiQBh zE-Wj9r%EM;MRu`@*$@(&YfC--rN?)kqs!$jQd_7G)?3u}k9CaAQJ?y&_=sKrZ&XkErFU?|FC!>r7GAG;7EuuyYBYw6zt+1({8XV>m@}pn2q!G2(?yI| zqZM}0jFZsGCnX(xv&OhN7AHyEGLv!xI&Zho$U1Wj>R6HM3gd%tMoPt=a#HQzYv7VM zNonbelM`HKn8f5lT8yFrIMn0qWnn`-=9}xYLk?J_!#yQG>KB3Eq$-OM7}zm$WO$vo zEOzi-b@UMvzKdPgvP9W3V*OMp^$@q&xfUZR=938%zm$FU>t;L?_QveT5;x9O%=fIK9#-ChG+?ietr^Y5A6N}^db6=m9 zeCC+ZBbQeJH1j7XgC)bi8Abu>R4k~ki`~vj8sCqmMc;=dYp~4}dyjoWjn%%59z8Lr zw2fmadsSpOd=1<4G}|xs53o(eoUe-(xo1ekHQJIV^WE*v%x_$6?Yo|f>+(6teVa-` zFK5+14K)jF+K$j+f+KDo`7xuv8vy?c6J>Z>jQI7{%?&)@t8I!+5I^O(9^hW})c_tS z$EEEo(3F>Uy5%CQEwyTEW5Dl3({hDeZO+#klJ{h-W67vsXj0N;=&}AAzOFIlK_BpO zy_LcM@A4=>()ge|D*xGBof+O#(`G6cDuHygdA;pqf5c+4N(!4 zqz4JB#n4dH@lXBr2NH{d9lMPNnyM`g%waQU#%xZKb**(4JB>@(>P_#)3o0yc2Y%eE zv41ERG!sr~@VZ>=Ef(J!ZZzeW{(C#R(N-76>l8)0pmlwaaf1HN4j<@~loEWKaf@#L zdYL^{YHQ(dXX)eObdy|l0hPwkXNI}fbm|w?;<;#x9_vHkyk5WZl)F)YUDMFjqAc54 zZG_B`j}ot0y`PJvB;{|WwSv!y)lMi*J33WxHX5_2gLm&LO2R}4Y1g_goBOejSV@#= z%bS_w(MTJrU=k|GGeEui#g>#jVx~k8Pv0-FD}b6h-{7Fjplr6n6zA<**_1aFFTu6& zXFLxns<34%sd#d`=u#659FsSY5G=#V~`55HS43) zGTn`)^&P0LQp#dYhryw>>It2uwR~Y0iq|pOC1S>)+!eCb8Et2CPdF!6l2c5}qaSnAe{as5QbrmRCn^S0%qb@4 zmxO&=^qPnMp&WBGh8={5g#{cN2MQ4-^2rAFYnIpa7jvSELJ0WiMdY8sjlKGm<=grk zZBjlf>Kz2TVQVU*yNVC>dpy&+`1wSnqs*L#^lKOA$(}Bp=)q3m|4^`?%+m>nK{zY@ z-;gczx*KeL{sbjwnO(%cW<8s=oUPrj#vdLTaTsRX#WvCiD8m zd-_|V81gxLnDCYIR5Z3&BT_s?Pqqz{RbPhBRA)dVNeXP{cCiUdYPpA~yN43qt9p|P z?SM_)wo*2Yw|-~Llm7PZVCQz^Rl!e0KAL)`$K~6>M$aCvZ60O($hXG(t^qp%zQl#x zA^XDxKhT>F%kK7TX@pwiH19MYev(KgNkp{GOMJ`U+?VT$BGUXA`Kghpu}~WnwGqvQ+SQnW@xJ+UVxpg@|uU60Ltf3q8dJPl(fqwQ(9ZP8&3~jV6uL*tTso4cgddW81df*tYHO z>fZZ)-Y-Xv^<({8C+0cFm}8C!FLAZlPsP+`aB*;EY5!LBlFEws=f8;@Q6v8VY&P%5 z?YC6Euui{9k5ehL=UGc?xvG$x?yh`7|(0j zW)Tw7+Zl>8bL6q|eCYcC`&?5iwT^D1OANW7zPKn7SG~&~!rM`7zLsRIXtWQe(12_T zxfYxA*u_}`rqWJFDn#31YYfr5=jAJT7|BzCD1+~5&LU>`oGBxX+jEJM$HPSgaLAqw}Hz7$xFrX&=ZT z5YD3LsSzM?5LcZZyay^&552e(&N!FH-+Rtym@cbYM2li&!BquO*?YRS#E*x`xRPuS z{JL@C1z$n{tta#~EP7ZJeJ-?gB%_OY4oc?MU`GDjwG|Ca=(VFkaK9Jv)B)Q0yB;QPfp8if^I+>jJc_`)A2}#`!I> zc^{1Lx=qMN=^d!k9Z1eSB7c*#kJdJ|rDy6Fgy|((fJ3Koe6jbJA53-=e{d(+W3zCw zet;ZKHs&hPog1L7dNpBdZFA56@ZR73GP$)M4v+{3a<(c)K0qu+R$#7Ndn3M(hDfW1zW^E!EcfY^VUY^-6p)+{*-4j0hE)`x~)%gps#7fpwSM2eWe##_O3SE>N$Rla{3JDNT z$D*B$&HW;xG9FYey;SfMkurgX5HQ?%2B&MaJoiU_>I=g^+}a|cje6oX>++j66}72(LD2e#$r z<5w3J+|JfI(8#4h4OE2K_97Mm-X7a?M@~4GoDu0Zgik2XHQld;BFT?|jdC0vdJORv zcx_H&%&qN5igq{oIgfS1ON#k_SO~?O{@IPCjlovce+(^siM|^C8N`=?$`mK>i<|hJ z{n*Rtv7xGa^}J+UVv$^YIORTgjt0KJoN3v{PV?u1>7gUY_-$rKYxMnD_x#~I-n+el z4Q6!gDK|5EfwMYFL&fa-EW3!U)63L_gj6=N}1F!)8fnTqKpHWB+ zv0UfW8xrbd-fKT^TzjB}^RKgWNy`H$7;#oF_x&wHV?_>qWp4iU_nZ+ViE0XVCyK)j z$_$(8{?ewiA0r5Hbl&5sx?I{h2^TbGGfL?CtYe3MXWGO50e-MYe`nZZ&w6^#IjRFT zy`*_3C-fwpu!Szbe(PlvuRLlR}H45o!&)5YOfp z)=`J8&*U08S+piMlxGS3AQP;+7!fO|r@j#U^RgTxZ@#C6?NR!e(^Ptl zrHx>AN;3woCb6M_B3>~q5CtQ~Yu0*u60+*)2hUB51|RX(V^n7n``q69pHXP()i-k^ zG^qGhRoA$MM}nn@1PgAV&am?U49w`=?I%f2>Apf09-TqGrv|;N zRy5=j9&!4k-VYvU&Lxv(;VrJVj62h_yoh8lY|c*aUs}!Gw3H@hNc%ooH!~Xi1Yr%v z-oxRF^*+MF^$+J9(#k=;NTPQoYE;!#)G{)1*r=JLQTkO+I8CrBOCO7z!8ah!;QbQxZ{qMr z=r46){)&)}eYu(CXeOw?XG2M(BzD`KnlxiGcc7(RH(%eNbjtY^Jt&<{Q`KXCaE(l0 zGugi}33eCyI_1M0X($kUqBU-E`3==$y!;~Vb>d`>P`t=toXDQ(*P3EUT_Y$xQ5>i4s_dVm-Ot-lV%x2qV%T)2zWy}_-pUy91=1z39E6%!o7=2!#wqUsf@VWdMlduYEa0hp9j`SOdlM$%+r40uTIQ#uJm?x z#ElsyYc$|`uJ=mh9N3>uV(cg|L;XEMiS=yDEl*_7Y|i#5)GNFVM55Ktb(^=P3bJW( zT3(r_2ogL7KV9J&7a~ahp8LznBuBqHW&-C_Ym58t+eMK@npQj zj|UyKsz28S+Go%*RdC=*AI_A3IwVu(B&Dntm%W=f=tspMamUjE$w9|++cWdMryW$!Yc|;T&hAP61d42CEQ=zwV6-^v63v(=p=y%lnE608CScv#xrSE*Y#(pF51ut-B zXyZCNqv5nfwl_qs9lujT%#@-W38xwuh`>~>tiQ4Fa;5Z@dUZ*HfZb|p>90;0#^=Lx zv3oWQ^&(A=h>r4pJ&K-b5rhe|z-_&a^hsC?pR!39%*e>28XA)e?*OswLXtN4ZDpd5$kL+vSJUL zvI!CC`rwcho0FJT;@?u@|AS^#P3L7bv-4%;MjxgYf$#C|YCE6NHP*bO8p@XSWW@h& zZ#0cJT1d@pL6v6dNy_&7UHCS+b(&}KP`s8Rc39{`>DbwP%hxFGikGLG(;FrINN{#< zBB`=TUmiC{BzEc>Aalm*Z*nXHKLupC4ZwmOla+=;m^5ni*a(6WOPtp>$48n$m6Xgd z!;*v0K0Z1!F)5$PDWmw0Q#dBr|6Jz9W)0KKfdtQ?$JRo7!%qNts~UXFy;$F+#3&9u+Z#!FSmQYMw3_Ei!6LE6ep{( znCM;BEd567)?6X^3BCsDY}dUZVO}-q%!B&KgZhP~Q(4H2^q^8MmRVaXMKdm)a)4S< zBJU2lhMqxrFlNzf&fE4@D(k@-t72d9P>UE+qFjqCX&AIe`|am^+htZamj9np=|ublPTvizqah*sTXw7lLW!ntLxB+6Nv zWg>lbw>Nj%b!90>G`rGA8ZD0RqGF1se>1Aq)-yMhvvZQ4nyQh_c5i_)fY#bhv986? zy+!Vg$*RrW^th+GE-_c}&8br;utO;U#hrtp^heX|pNKeK!9&8Cki_PU*HV@|Izn&R z7M~)&9@fOV{p6YDWHXk9SpB*sc8@Z*L-gG^c9(hBV`}-0&(i#HW8F9F^Ri7Ao+xyK z#NUg}?0g3dSj}gO6^oQWLno5{KxOUXq;pYI+gNuqL$V#fCof%JFdXnb|gio zB9X5Qe=0i>D?s-fY$6qsmedFZtAlKMGk~G5YW#b{A7yLRaHV5{`hem-PrX}iTVtUiTZIe0kfDOa*NzYZ&cKY_X z)DM5eWtXsq%1&WhwL%j0%hND*A#Qg`Tl@fhm8&kl*j0-W>C*iURP8G=M&1+CC>i;1 zOv@*Nr5rDyY`j;nL?N%&=;c;k4YA^2G1abMi&3-d#{5f>u-sl;f8JfDT=Qx31P`@7w%Cc4g2vngP+8H4QcTj z->zKm!gx&;4EeTyw9xpq z^WFgfGgRg@Dvs|sig2mQ1sT^ZI43zz5BILmOZm-fd>I#;qZ9UgS{Sync0#j#ok%?;RVAdqC{?b7$d8WHD#*$1?UkAYRftIf>eLKByotv452- zl?)~qab4>XB=;L$!$AdHaQ4E}P3|Ikv;cbpT+!`SV;+4Qx|!m(a2at4*~ooTM|ON1 z1uI^g<9Y|KKBw)u*!{-3UlyNT#oqDTs&OR{jpXIe!Hi5D@wuC!b z@GDsLF&?_fFsU=V)Opv@Xk#fM-{9MK6&d2~Y%B{6m%FuG_~%~7CpVWx%oAGW*3>gf zD(8vBp;W4`8GQ-Ljg1|I#6Omn{@`ghxJNdM^w7$(4VOJ>8Yo?> zRoL>$hD&D5 z+2MWeHYQknXf-&^S%^*itStL6weiNpO^fBw>p%SFhNLJ>)UOWSH}2d-6~ks8GcdyD z$(7yO!!PpM@SmnOA%NA0b1A9t5S-DB3EJ#cj(De{3mJncRX&!~4c!wBt;lkB+j{ZL z8TEue*5R zU!C-ll8HXLWC#yuVI8l}#o}2QVg?@ziiIiZ;`+r&>>?G&q6SxaKSu^lsgpG2)80Gr2vp+9nCNqse@R;Vpcu1W;b7VXx%D1|qSE54z7ub>-*vDVb$qHjau>>}|hdt5Q=n1qC}r(>v*h z7Z;m^0+Co*S%HYus5-M9ZEJ#Fd6!#|^?KEjVY07p0uZkaf7sG9H{DbDZ*$dPNXb#QT0|gLxiB2j7zy4F zC?_p4+hM67TQ6*_O%*B5#J{=1n(RD7Rgr1N1%!uHO3I+%89t(|YA9146ZX{=j1 z--Lw{kgnP2eHlpBCd_{-pQk_!sI7wUp|5v48=X15jh!xp%#^D*+E_{U%yUX*&f87W z4wtVa3)|%8Rn{OG7|ORWemW#4=pRDoduDL#e)7U2a9>1zr1;f6qxudo?fESfp6-2s z!x^@CKCA)dA<8?p;%ltm``(7bLtfrq9*s46KySRnMZ-LJjFg^PZNu|G@FSYow%EMC zcbgamiUh?yrGuX?eT8Vz`En8(NyEi>jl8p#lFNLMkTNn2&Zho6TjmymfEmDVvd|v2 zO+y>^Vwqtn46+&Ld(T7U1l9XE%m#K?&U}42Els0`OJ2t{O?~N#Pm0(yhyoUkuHHi< zkNRo>!?5P+)U*4Vg1JhNKy*+3%GBZw+=tt?H%_!O*f4hf2g9k#eWkqWOnGfpC8Vih zv-!-8-8aOc;`)|jee@w0^UGokiGa>nuGfN7YCJW?FeR03dHLDZRY-XFTY#KA4+)>M zzM_lJVKCS$T42p?~KHV_2meKViO!wk?T(G{jRd6Tsenmmy@ngJg2 zYf)=0S3LbE*tQVLG)()}BCRq&A#+ePG-ZO*;<(IV+~ zW{Wwz(M=9}lP1fPKar6qm6EN6MDhB-Xk1wR>Han+pD?iO(eZS+Rlbq8Ul*~~v(z#*WK1q;+MZ>pTv z6Y@~8@|>O&WjB>YZ!%sW)Km#|o!<*_-k4(Klm2vFlwS3|AD|!_Q2k=s&_i1*NM1E# zno|d~&)NY1-s7cs=ofWj5K;2JUXA)2cUV3LO71Vv&u#9er3y37U(dmjP2+MvtgU6` zbLd*a8yYqie^M*}d<@Oxa*WpOrTo@$ZMP) zZL+oqy$v;UHyEQ?#m{uyO``TRIKo40>d^La~5XjduQi&k_l+wdnVn>qEB1Jz3}2oWv7=&P%)z` z94x|XzY|c_7)=(QB~&ksX}6tsAG1t7JY2lZj$L8Z=LCzRR2T6CfYQ;IC#5vn8_H63MAylmZYq~kL1zfPZX-7qzb(CiHB8Pk56B5 zjpO&QQQ;!yX_IGKji3#skd*!jPr3ual!>2yu?5aI5iwrifEOxWCfJ&()Fpv&rUV^( zGHA8_`2#W{D3D7z>@9|%#iORu<0BIwfm$RJ(L0(PK}7Dgq(mHU4uQO>-DlQp&0P`f z08(QtS}vPwMY&pCp~<2Rx%odeqTmavUJg==-xeekUpf# zjg0#usd_1YDqY*!fd-NL$0~e(xNqC({lA$Yp?S@69*zi=ud%cc*(<v)9z&$tHE`DwlEL~W?7>XKM?RG9Ak_j>DwJtg$v~%_zjJu?_e6N z8_W0lgRj9?B*m+AQs^Rpp0oV*9a6A3B zKaKd=)K+^ssZuaw@vEN6Z2zS(HSsffRDW(MPg0Dc$=-i3B0{Y_zmDa7_71e_J)tzW z_1@>!Be9Od{^s2gOPsR(>+6u8(O_jkPn+#5eWo!sjzp<#E|Iom!Fn^R`Edi=%j*@< zHd0t-eL5sT6t*H9%~Ob5z2>&fTVmF91xZ>7Kv6H*f|AYxy?r!KEmMktHN~6w+ii*~ zt5psjnd*yi7C?t#|9OGs1ohx>oycN(yhTyymO{I3#q)lB;E_(zZ1CaHyFb9X*7N~T zRv+p_-7oKPm!MjX*FWtMt%9jRuEwz(xFBoL`4;#;EkJd*_K=wyx|5-WDjosK!E}3v zk;Ty3vNs=t1G}Qoz?HvT4k{oi$(NYYZreOGKJ&@w7L!v2!Y5nO_FyOYC+^r~FyFm& zY(yL~fRt9-7r8lRbm>$BCD@WAmamV5)?G06)-udNx>xNNc;vzY_+=hR+Z6Y8$N7oIOAV`IK< zP0bK2a~o&m{TLsw`0sTRLHr9B+UgVL)sxN;@W137g@t~e>R)tie9Og!!x;w$#l=N? zyn+a6F?9H&EEuiuN(1k#)~SO;ENxB&9`(!L*zijV3($GGvf`xeF_@gkiyq$6D5&QQ z)i41CNX%+xl;p*!{!jwq=;Go^MI;FB>aXWvf;k)x*8_X2NY$yWRyVyr>#w+5Ke(T? zmr2v4(dTQTL?2MXIdgTCo(487sO4^<#( zlBiIjH)<6{V(e(K*mM4`RAsOYW9tU?1~@<|>yq;-8tPN(|jTB9{-XkM||QToau z&y7!Zd5aFF9_t+q)~+6n(+$XX_dhk`IGqk}J`I0-Yy7<^P}*IDX5n5RTWJKe;9$l< z0&p;(2Vgm)Y0GP5P0ZYGkD2h@-$4*Gi+y-r1T*jB;IV$J1p8LpKkHi?=g*7GdXuIx zODz?FUE216aIQ<_75iP@%UKf&#}dNP+qQddVb0~i~Xwojo)8jGT6(&9b+ZN}B5KZ}LvBZ~w6i^EA{WTCIx#8`(DTX*YG3VgT>c zzakAsjE5dH0bWdlZRnQZcOK1IF6@Ql z(O7_NKS$inM;w-|#yKu1iKjnYf{rq_mB7iVa3|T!9Ho`(+`r0Dd#d#V2)i>b`aOi_JKX%{`~m5 z+G|85m*+>(ka7MDKlV#`lPXwXilCP`QWhDDu2SHEx7*5c$f z4w=m`dC4=9*=3@18SCRT`iN^`&XcC4GadGKT~4FWe|4e}jR+%P(i091=ds5wCG^L4 zm0XMn)INhk{3qTwh_`&6Nh&&b^FJgxpSS86EMS-zPkUPLrnchQqWNYfS$_`ci1LMm zd#ThI$@U&?q$Ov0;fJrmivGamsFhCk$58sq(I^*e zQ`Tq{ysXKaC0-oA4dub#LArwjZZv)_c|Ca5WGUw}J8P5GSZ>Xm3pau6s**dt=afk` z)y~O^+fCmaDTvXQ5Z9zM)4iW&()aup@Wj^VX^F)65c>!?07>>PVH>6+4P$MTBkF5x zgcblGsz1tM7>fx|h(&<767cEX3mLybTwHu?en0)Z-ZG80v-j%$RU0NW4k!73kxhMS zqY?rCy#dKK1YmXu)*n>h06Z%x1?e?*UVVX8tLLOm_Bc?Gw9|j>PKT((50+e@A883z zLjyK1TyTjuYs*hhjbp4NP3GTF1PrEQHn z&S$ZR)CKbc5)YSWGN|hp2C21|rw>t)eX~b`u?)c8*cuii6$73S%{lw5)oLp~8bYV* zC8ioRaPrB4wy}0r9(ytjt_Nb@))VWW3aGE!ZXw zIDkn(eoDD*Erd^T)ZdLmEv{_%Rrg!oKJc}Xt$o?+uOQWGjcm$aY9;}aIs7A#+t+qFSHrD?E z{TFDEwaJDMP! zyTh;&nfGP5y{?a35d2%of2KuCjd$YrPMvD{qpaNmpdU@DyC-?D==ee?yk$Si534v^ zY!<)qDy_qFi?Uz2O^Ajl^2VI-V5X36yoAYYDEcEXDm+YcQV(%ja?#)Tf7DS zfoPhV{|C|L8%&C=`2hBceTd8)oxq9wtz1lM+`4(XKfxk>rp!2C8{x$Hh4-cdPUy`` zI5TIcNZy3W>%%7*6Dy;RU!jFBFE01Puwed^;s>B4Czn0S1qh-L$>$ruDJls_osyRD zdU)RYzJKm>=61d-WoR1(Nx|DTNG~ibR%iQ@srrtBU2CvM0c(7fjNF0l6Olc9kNc?b z0l_2}lmJ-{)}8yD>bnsMxO@r@RIE6)cO(8z9-buRc8qWsj5$6%nI79}mKp9-ggDMw z>n_7n*{kGMBSZ8aR6WR%B&urEHI<^VXaL}UuLsai$=E^kor|q{E}Pp>;UJD-iGe*A z&ClF#q&&al_}E_yyJ+ycq_=Q#N>w3lfNSxWg)4R4RGI>@JG+5dIIxWfN)&XMqN z&E*AJoBPMVD<~C`99k@du9V`}A>xc%&!#0I>&OM~JVQWk;cTCdIiXVuPpb>}Z!{%x z#9>O55j2By9Yr=~&fnIB@#U}B$BPWZA1~D}K$5Se*Gij_Vla`XlmKgnN?|7wiek&y zg&(5h;uSwT*;JZ+nAuy&`79K8$+4lgf8hEUcam~rKUVJki^6}>j11o#2C;ALhu$Ym z`aR}ltoyGXZmn&BnwM!E@lLB51|7eT^sx9uGx7P>9XUziy?&DPZ_QD^lAQ=**755m z_|<*O+`QYF=}J;>iY9S2*lh5m`pB$6;zkj;>9{Txh05{4AJDN9@WdChp-O*!=3NTu zn?db<847nw4UdsO=bPbd_cd?yUjLj4&DJE#?XEBEW(B<+E0=h&c-=QUcCgw$Qo8d= z_+OSc1jT9(KULu4q2?#s*pA3p1K2ny0VnawW^!Gc(-*?T^aj8VQ*OD|Tvm{yCKZe7+m)-& zZGd)vUir{wdEXn-=Y5T- z=u9MrQhQE|UnlaF%3*7zcGT^N^;90k95~DUE-XQl?kd59q702Z8JUJ-OY03D+G-8e zcuuYdOVxCb=B~nSa-~hN+jaPA;1^?=o7eyf=jm`1$$){ZHpjQLlrxhp@oC>gTMmHe z&*If4DEsaZ#NsK@R!6us^UB^7w$I(4QZFN~dEB2ro(%}wv!_ScCR_RRjxri8i_96R z?IqazQ@oz-d}rIJjJ7i~OJ43t9H$9v1XTQSW!l;s;}^W(d7g zHJ&%A|4nGWrhW%egIq;GoR(yY?%wCZ9Vy!l|0^y892$?Sue8yskj@S@Tdxc@L}9vb z(MDH>rcM1E(TZT$!$h@$P_g8uB3fwAEw;q7)+@dZG*%a9PS^sn1r9u$6y@7fCiTLZ ze{56Dh`ypi>eI30Xa7)61KNFHQxWj{<0&u>Fshu*Sr*Pq1Y0cq0+4p22dT&%tPh1F zvUw@VqZr}EE-WRO#Yw>A9w5#Us(r2Tk|YCME-kLAy-HB19iD0F5qzEwXS3h~iZL;M zB7#9phy9`Bg(p<4Ytx=SRbA7S&4$y%aN_4csx2OT+lvLrmnakV{f0$5MSzFb;;3Ou z4LEJOGMPx4}C15&ugp{!hN=V)}*Q z?yb9oiHDb)T6z{lLY^prEKSKad)DjRu%Z^~kWXThpE6q0Cre}(TSovQ+QJ7OuofxDhX$K^(18CWBmQgwOq5?^RI(4GG6BVO5@sq6NB!ReLMIV2I#+dr5T?&1ipac> zj%$PP77*P1u?Z!%mj$}~Dj08JRI!sekg+6&`xy^pj1B%8j^PH%^}fwx#OG+?lxlFZ!5;H+HaTqUgPRub^_w%VlKBT z$?u#pt#vvEyNQqsktEcs-j3?s%aklL(G&_*tSK&u2{~zkrg3#L!aF?|0VS^h zq)f0GuVQ_>RY5H72ekF%M999y&o?d3HO+!o3IopK z7#XPeHk}@T_=?ayD0Xc&o0@+g&ca ziw@WAWr+9^J$vXQDdVUlh<(=#D(u8GgkAK7z0zNUa!3RY=s1XJVu!NrSX;<~&O)YI zZ#Gq!dqX#oM^C3%9<}ss@ZLIPzY<~zBnqXe5@BhEV*v-+02v$5UltK)~XMB`}XMFLF<9_b@Xe`<` zWCaW5ax|I}5TRz^qqRt)3g1S|XSsR4sOG!JSWY@tiHRpoUfo@IdOMIEM9)`tvqAt8 zTM*26kdzCYreM2ef`jL9H!a{3K^xQ3QxIcDg$uvjG~*$zWyFA=H*si~m*FqvUZ1F* z(`Rgb=M{cJSBUe&NZRA89OYXexG+2wWkKzTo%ObfR7g@K#9U?rhGxNWW5)hBYs}~$ zY}Q~`y?wu4EhJE$!8U}<6Cz!5BL}Vp(*J}yfAp`LMU{6#x;@L5OSmWNKlS2QPrtuZ42P883wS}2CUZErgk!(_p_&5iCHsO7>^G z!Xu<`%P)Wk@X4&(@@vVXQG^eI@6H&jK>O`02b?jptx)Ve5EDan&SZ!yZ}zFmfcxUB;in&k^vQ< z%POs8Rx(Nvc2JO(VF!g&kTRW5d%1iq@?6%4x&K9VJeVpmbsmN@% z;C>-;qnMZ@@e9!Y=ui>`iU!8!U!@XflRGlfTVCDPIyH9*n+te0$IOw!x*ifir(uiV zGbUbhZk$gKOwY>_;A+(EZ*5|mdF}k0hYExc{v}r8r7j3Nb+KnZtb?jRyTfE5TT%)o zywS|aPla_qi%4I?1t4t^xDsq`v`PuQDPr>nvy&J_Ww^N5%%7KYFxM~UsO6*oBvAWH z&U*Nq99seH-G88f7@QIi&j@KQGc9->5C8}X;{zaenklK00WyNy>cIPfMQ2V0^hX{r zvk?Htc24?gMV8im%c|-8qS4X?FmS`fwLGk(CFyI0Mp zC!6ra)#4JS^y4p!i@{IMY2*iwVd6DAk0W^mU;Zz8w)p&wo`xQ1mkhj~VEN#>0CuEs zm&@MJ--~s|-2JxjV9H;^>MlPL0q0n*ce$#7?fU(Cpq{W8fPy-svdUJ7p>~Y~ji8q< z&twDPkVY=R4TmmHs!D71<(`8Pzud%webLJ{%%ZarDT z0yafiQ`}vy{lTI;F9KwKFow~zd<1zw5R6`($?92miFVT!(gaF(t^BPB&GIWZ@f6CN z8Hl)@qp2aX#yPcI1FX=;XB|m3t&t_=f|=n(y8~jJuVMejP~^WcR6$(5DMCkANJ#XX zC+HS)k6w`meJ$O*W9W+FXWdT5$FBUEF{$q}KSKa!zO3>_zsM;^hNSdV2sMRZ~ z->|$B@9Dat_1pZU8~du?^M=>a3dZ|@urK7;VU*+`ZUIB#%3Eun9n2#{cVlWTzJM-6 z9+y--TPyZ{DXO}Vs zAwokHV30i^v+Bz>_bEr)89;+jIfu9!O^x|*er+gO3hXNp8BLlm(uMT>lP2EMxv;TzoMNl95W{(fWU^_G`irvo+(~pImOaHIuO)p z_(Sb}REt$_YT$k}%?X_r9zeEkhVX&8VRi3A3VSe}*@R}I8^&&PHAxqPXU*&K+bv6Q1Kw?|&*n-1H-3M! zTL=Mjn^2QQ;*s=du-)klH@%JYV{I5W0iZG1bnQGyT#(zX_XU-|Sr)?uekm*2k36;2 zxT3E{dXzvfR4x96IqyLt(MWo2x~V_4#|Q$n80&KvEB{U;z2ve~V5?AxMf1MtrwbBDV_tT2EM(<$l?0;C>+1y*(+#Ba6v9S=`q?xsP zb=yes=aV=(t_NlN$I)nvH8{ggb`U@m6WniKZXCxTuIdMaYi0R1e@~z@U-WzX?x`JHHZgzgL=tfh)%ps1h zH=sOm__!+Yr+>4$OjT|vH~;23YU&ET;r0u(ek1cQq>Lh%fA!Jb#j@<*iDJjQX>QbB zTFjwYmm(hQRxFiE_1o5@%^$B$>WwV5_S;x5o>Ei19;@xktC#?ip-EP}Dd>(L)xK@JTXMfqM(BLHY!esNGUW4)4q&g_JxJo<0(?evU7?#E z{oVchpq+3g?PRkW@qc%<&eh(2EA_{Tfds-wD5uO69}Z49FbfoQY7;^EN|Y)9FwkUu zh9x(EwlhW+#d5Ya?1C-DZ_+Fy;}NZ94J{tW4S9X;CVJ!G1{vL9vV-YSIF)SgII@phfP*65`4Q8{f=6A8NT9^qAh9nIMelS2Y8Me`V6Q&`V9^M{HK z-447k_xJJ9u(67&&GH6GaJ+-g278!pS(qIO-!RUsbEK*{RlHgOMvzNe>4zV>bI~DB z{^~Mn7G}Q3dK-7O^FK6uIs;7`qT^4e4iK+qve>ZmO1aB*9OB7pWO={;6VET+3$BCl ze6;_kR=DAqgd=Qck#n$z*vET_GKF4o3#N;vs~S1DA=+G zM#V(a9jH)pa^8(JQp(Vio#^3*_pSJktjnzj?4;(D;?tF#jFAa#9tS%We25PoYBH-R z;f73gxP>kA=;-T+z^wEN!?Rr8bRKWNq-TVy(d@R+;h0B@fs2dAcvvK47`F?f0eXIfi2(xcYCTdBV=;)i;U`PB-n6J!Rme;GQ9SC;< zF+mZp^WWX}$^!y~W9I?P3@y2lM6^{D>hicMr}N zo0RY}n=s9Eu$2mCEosAPY_Yf+IN6(m@bLVRqy^m>v_Ega3OjMX0R`*pcJmgr(LH*M z2_bA<0k=%p2xc|nB}(SZIH}TD*w~-X>4ywrZq1iDMpZWefV0K+eg*#5t`(Xe20m4V zG&>S*9`co)txFtDYP~`DAZJ*@9%64n5z_E$vwhXVcZb=3b9!G{1b>i0;}FF37Iqoy zab}yWvDF4m$IJ=HIqiFDQUuWgkxm+&p0hDW9%p{(ZqzSiET_6Xsmwt02<-aX<#76U zW?aEJIbYfjNW@R7z_uJPheI5|NTZOz0tg~C3!I5+i|RUM4H_iCkMHRk+$YzFWpvkM z>#LgSUtOLt#K8)!(N?TSgF)RW|0PDoX`RhtLAPsHBa&%_`?6_ESdtu*{H576a;x2z z(!=HvbW^M4Y*9sC`e8HOOH{l9l`dk)8TjO{PshBzDD_6C{KEIzV=SINQ}yH&2_*M} z@`!f1+hDq6MZ9%(>dwaoUGMMVpc5{)gw>>p#iD4n!oU}7!xgmEsJzz34rp*=ce`(D ztPj@Y!P8vop*;zUbcCG4!xW1`p0x8`@M7e6gdD3NH7w-2(Vp`-Fj~c|@Ko>aZMefX zV|z(&juBIKn!Hxv{{{Q455Zxp9mI?e#OCBUZk&Efzqyc3@vNZ+W_5y`>JTk zatZ39gotGf3T$a7uGMCF>vzzX|39L>I;zU8`}z=qbcZwo(hbt3v`BY@boZe_N)hRf z0|L_BaYzB_?(Xhx_#Wwda~^uDNPP{<1EhfYOy+odSSi2)V$v zsg4GV(DDfLifZP3nj@8XAa(wBmC`UJDz$u$+!x)KzKx6E(NMjkd@R0(Cp$GDKUk(F z!uy^QFpfs~xYnZO=%(+|{42++1;XxRx>dDMSVCXEEh7ktbHY1~Xtw+#eW2rW)>ko) z<4deurdAUF2-W-CPx5>%96tLe(*XlXk=+3nq#xG{BTBuZ?pNSs=^8T7giX%F9y`dT zDiF};9ft-gQ;B{gNQksH7C1rvEKDD-wl=F@s`~7)Ggdp! z<3%%ZTkNVE;MH?G6icf&>ssTVLQ98IbiBvIRb3%wpC(|F9FWCgRm~|R;#^;>^(mzJ z8L;e8&$;vad!oK^vRsEYdDF*D6zoGKmxdFJROa*_@u7!rl+#%RGw`lW{Wt2 zoeeo0t$okxuv-;&-s~QyYpC-3j+Vx76s5Ai1mI^^i>00jB-eo5(trC1Gf|O&(&?DA zKbDaYIi5)DF5S%Q?6A3Cx4TycB2yVVZCHy8-qkd>q7h?1h}bjwTClgV^~yfWg`?3r zkPz^pmv5!KNhTe*w=5CtQKy#XQ1hztW4jA5!KXP2|Xl0cK&oXeP?wVy_@L@n{ae{ z)s19bmf@us%nkRa2}Hqj4yUoOZH^~@e6ACg9{!hwaE7k!dJOy}QqVm{0 zNa65WrfR1xeh?we=k#LUI<(d`=tJigi|rUjNBQQmy?jHeJeV)e(WM3v)U5vu3?2n< zqU8#II{tw-D4sofa%=Vw;8`Ny5oOtmjy-!GE@^xo(XRv6AKgO@?m`ChAd)zMbncjH znu5OwmyjRn&}l^IR9F2X8pbxeWXRZ=5X9g7*E5A230Iy%I>!j)jc;!ver#}DT(!6* z4^sRc{kgeTdZ5BjKSc)2Y!B7BnUE&@k|I^f%har{0OsR*ZBO`f{U%nYAnriXk3)jcCj#1QV=myB?Zlv6k zeJw}c{H;rWyo_13MWi0k6Uw!sstkM!tk>qyHv#Tw>X+N{chz6Uekk6`=>_pgBcxb^D5dSbv2M~qK$%*Ufi7Taya^}<)UgEoL zY5N=#J>V{z0Y&-{PLM@jSr`6#7*QdPNbByh4H z)03{jwchN~wtk?G3tfkg(k1I&($bXP9fi>uJs7_Oodjil#R1_RGTW`@FiDn9{hTo& zzU|zDOUy&Fns*krmi>b?-is7k*PqJ6a_3~**L=Yc*@OP`1i?Sm{7B>E>FiHshGZFk z`H_oab=l0M{=r+T@zytiz4hSp2FpGcz-5Dwcc{&vx!sVhT%(Rn{}}*$uU#BdMk_8S z+?egnTcvvw-=AEcI=UFL>qmG*#?&ABDaTh)*pCvS!LocCG~O!|;%m|!uKW$cRBwHN zaFcXDX8TythzCufU7(*koVwxjpCmt9&Kl$^=f>lj_xylLO^ogR%=TM8rDhy9Cg_Z% zCTY0Z`8z&f3CQLmE(}OTPQ0+bB6Lh5gzq~MN?;l`_g~Y~G+}*K;yT7nd=V~xX z^yg3V^FgyZC!n(UZiS0HftKbTp0BS%o4R!B!I?3`XRc{)JxGhL?|GtDw#6R)0XP5| zLVbl>R=2D_F8Kp{b`Sd#FiM5=HnC>EVl9dO30DC#s`X~?(?^!JlKfiyt&-N3&f{_O zL$;*NgkvowsOE@dy53Y($e_%#MIZEQe9wN-JsqMyl4Cz^CJYm=eWDk~5Ah###63Ox zLAQf*X)s*%8?^G~039TMw3dV)y^8kXAdN^%}xnaMpLi!_Y2q&jCtcm zhORGpO989k-_wOFeS-pNK%GjxZt%WHkj%*``oQUU?g|4cxPW_{Vp7N+1=RhW!nA>F zbFd#4wwZ`2PaWX>1G|rkm)u+Aj3hYIZ2u&ce)g)#&mP^SWtoMd^R&2EXmmDm7^#U>^2tkp(qx?^z#_O2k+tM&AvBCJoIW0a-)(P7SZ`6*!?&&A%q@r1y1pW>4m3rSqbk(51k-REeBi&MB%ZzmGVpVZqJfTb`95P8g_JC$}e z+Q68n2e)oa?;@JnA2yz!JufqOfXQ1@Jm1#m4s)mE%CM-D)fhf8(ho(&|L*7B zf%`CGk!sOu)hsrmSVCOLr!5(5bX^a?wQTDG#&+-9ZRsaMZ|eQ0pZoVrSFSY1&dskP zguS~#(P6DUe4;xCR1U^#&v*HImw(@CX+4F-Y!9DRaw3aljI?woxpmh*p1&RZ@s3$7 zBQ=r}w6VE4s@F3ww;B}I`Sp(j(8un3|K&Nzjh!$gC-)Npv&hql47ys_G)dsx6!}Ey z*CE3Pv)LuY0&?G{ItIyrq~@#FNE@`5e|G+Z7X|z;mr~7yBf7##KKQ81wGrjkeZ^m) zPzbl9TqMtqeyFbT3OAvBtJ32G^k70TSXX8;rFJH)mqhNib55-J&w{Soz?-RVhV#%# zM8F@Ly3}L4-nI28aVtU9xu$r+yA>0dMcIDMBILVY_v763(b}ix=Hy~z#-9et$n|!f zX9j56{X?K8GPXf*)Vo&hR5XgEuT&^pdB2xhhY9a^J{F6A_(dQnh}>QI(oGW;)p_HT zTM`cBy;N1uF3S7*Fvy!FvVY4-)8-vqH#>4`oNRRpmzGjvF?I8AUOn|R7RFwd_}%co zvdqf)%8e)zrN)%Zt3fjQj=MJ^*ii0*OSQ-?QXeaBM-(Ez)8qTD3444m6cSxSxd{-9M}Mi}$!kqjl!z4)hAb5TP8q6?ju=Y&i{|d5#8cPUG=X?p$xo*Ge4LS!d}tIYeC{4niIe=aKx1rlnOKM(6C^}%tml))zFt-9`mu?phOky-{b(T- zvG5_MtMinu!dytB^>xL!jJDn``JOM8r+%~_k!upVOdK=^e(w*HiS#ta#@(Ix*0!H~ zm7#296&xv+Fj?GELee8noAyYY4M*c*p*bR@54s6>1_czw%x)%HQ34*x$m z!v3>#gobW%Lp$GFM3(MwxWR?O3N63m&8eD)PVVcu$;V%n#7~y{FoBY&((-%BCwY2{ zg)=m(*X8!>N6>vzZ6DY3E9LYcIdYs8f!6n}$E(6zZ*?dtiJxrifM3Ik4xKmA#7=26 zkg4!GZhn;FVi?jgem>u0ZFzOKAYiEuA=Y_oVDIkzE;lT z%va@q7fXrlq#)wyb~3b{$QLBbtYKZqSGoBaw?*Hi#}p*$#cOnyB`xf>Tbh2#z7FjI zUxry8VZ|`@PZM4eWsBL46rg#=i{)`x#3Mk)eyQwnn|hXfD5D>@o}uAIKQQ6t9iji}gev z_)o%a;q1~I@}i3JpG5)J%Pxmghl%}57Xsyo%1REvN)J=R9E+q|%6qZl-u#poZa6W4 zMayHYFMJypPjj8R6Mm3nj;y2HV?PoiBby6N+vC9QT)31%im_Q{3-~`sA^QrhM)bZ9rYf6LM;H+k91MBbx$0Fh)7MJif?VFrDX$&6m<>|j@Ou-2Dd&10z15VES}N)#=^O#A+1RT6kq787(8?2cUwd{`_>CK2MFCgrJgm5e@^ z$Tp9|)zYVrE4gT@#{^LuW0^9lV~E8F3@^8w(b@iOb7TLSeyO*d_@g;2nu6mzjMFJ> z+&OIQ{0H#KaVD#p;`BEyDLsNAl~}Je=HWzNQq^|ZRl`@f_V8hJaNDUMebUB=g)D+F zBAJLzix|Mg<{I}5Wr~a}7JsuSuZ&xwDQao-7posD)vd$Xe}2v1oWrh&A%U-{dra%mKY1X+=EiCmUcl(|COk3(EZ;4Um z_UQZlNZaC_6D|mNuc;cpbRvi6iO|HA^n1qzEE6M^8r?T?<-dSH?-OSWrPlHFh=V4s z){zbwDw$+pBQ*H6cAg~emCo;5J;GxB4Q3^ZW93TTv_w~W8_yrK>$9L!BWX9c{8o)u zqwtDJ&bZ*(cXO&e`sicUciCU7GH-@pcWTPrVbhfdzK-BHvVXiQro z$a8%8-6sA6r<+@bWQi3F5=QB};e$G9CGC>_fnehnjVP#c=4f2qsIJy}-sR2&ls&`< z8bJerrZ;(;i3Cu5>IcjK^>fDPggfOt>pC(BNR z@>BFq^C`%Sw>CPhwUlRfx&*Qwg@OdpzYT7bC+XtH4jMbjJvTK1qf;xjABZ*GSea7PU(TE;;{L2cj177^-;cx$s4k>{DXN}p~cu}vCzWbirm5ACp7fN>G zUm#n2irL7j@SELP!c=p3H)P1}q#yV2)E(O6Fx>NcxW_?3gOyf;HO~yPChhdQQnh4! zr?d2`jE5&94}ZZcDrdCmSau8_Y1IzbFDM*Su%_=Wqx}Q}ES! z9D0xJ+1u&`Yh^QUH^W3&N#zTj(8_|l5MV{!JjJ-D0me9tCmaLyd}0q3g((Fx3TFCw_YG}R z^3BQKP+7lO2HcdOs3w1%YTA$o-pOR=qsgP0G|7pDPvzakMs99?q zDlPT?bvqjq_vaKB0ij(te$Wc<*8VyP-YG}^$pvPhP+7gW$GQ64;P2|+0&i$&`Y>3C zNvIuTRhx_c)({Va4;!$E*XKDXbrrl-ca=hAg^X3!=EQ_P7A7jJ@S=mL=7vn!-jKDh zw20XWiyaAz*|mrrEq%4amdfl@(&U+dKGQk^xgD`7vYOl1155Sxk~}S$UaigAVy(vg zhc%={ub&n^TW#Tc@EKae=cIZEdV-MOd=lhMRbu8zBW4kn;_pEocE^)IdjFO#r56jI z;5F#F@Y<9NbM0w9bYh^}y^#?)w;o(RYwUaC1c$&&lkT(7|2AEYb4AiEnu zs#f8H1#z-8pcD7BAFW~bzf6wEsTP~lKr21HUVfz_8rsdH0=e7UDFgFrO?Fm(?*c2< zRmT9zVuz($_jQ17`7XRn3?x-@To2`6jT9vvV070PCF+Ymwkf|F>s=GB=O_au+&%$C z*Kt8DI?^C6(;r&-nX^C?LhH{N67XWVIiJSIau6dIU_gk7>56TGL-eJ8%r5t=MXXhc z!j+2{R2Vl4Ig%@@>x+N?s{SpipQiD4ke;E3fq_|Fb(O;;RXs}?!!KUpLC9LVRg1W= zd^*&~kPDkyhUg+>z`P-O*a^li)iLT=kSNl#OIcWuK0Fu@T;E&JS;w@D?jt78D)P z1S@}xF|^;RmB&@yzx+Vf9Wki9Z>3M=I}TH6CGrKr=XgC33Y8!F6a8iW{paub(;SWZ z{X1FSvlYzS3O21#8G7P`C3jk*xbhntsyq2Vg0bK;RT&xKzVe6XO zAugk5I2dH+8vCoGmM9xLKyHuVL4T2mIHLe$uaF9xTsguz#WS{VNc*fdQE0 zAPz!9o3u*_lh#=ozh7JO@f-|IJfLDogI>vl``s%wEsI6b8(@GYezF`*tXkvoGsG*| z)$0CC!tDY1VhWgz!G?{{ES5J~#cSWHY)IZKec*SiAoA-N3h^GV78Cm7@RQr_}e+>4NoNGK{02$Ss*prxGrZ=Z%g}K?Gqr zw&P*Yf>u^1HyA{W8`wxtB2l=ALd_KlD}#RkBF9&7*mKh`*i%O>)t1M2e{6=U;boG% zw%~&|v}>X|qQ3|4-g4U=MelCFt9e){8O>_h?F=Xi8w{OZqN; z+SgBl5bwYR?|{X}fW^neLo6$58pF#lY_iFgo>_?R8Nsz*2CP- zVhX)kkR+N+=UdKB9Mub}oz+Piodn{~&X!ErFwq4CP^-d=N>S8gS)&6FLvV7Ns;n}F zCBAemyY06i(t0ugEPPyo?~im&Za z4)wFNR;6W!SuBxL1yD7?ten-De|qLmHc+&hB@&SrWbx`w%Y+pe5&@?V>i88SJLlQp zip8|r2)zQ){p;IR;q(%&eng92VH~+YPn1ggh;&4BGTSrtU5C|2^5@c9Lg~{S&K*n7kX6}8r-aym9^!o63q`#QauS98zbaVU`z|O zg)s|9M$XAWF+21;PjEBxZG2F$9@Kpm$`vX1*P&IheG)r*ekl_@8_U+oHxsX; z>S}A&noRb7npWP)Kc(t4ufXOKg*N&M!2-0eQRX44rs_~_1oRn7ut^pA{d|DDjYGI|iGa*ViNwJQrDKKe+|43R>K3j@ROp*y zhQ5l!RX5e5Z@>{w7P6e}@s~d4zR$C{S?{^x&J(%O?`Ykd@UlQb?U2{=ZE_fN46l8t zK%THuw&wE8^tZO}=2qbqv)yk+^*{nmOgQ{;ioCpxD?NlxOj@Cd3@(FLGrAMJRxm85 zDG`cYSAg^_?c~DQWB&@M>C!%qC{R>$5{24^YSbOnXH6xsqZeEHl8sN!rf0-3Ln@tG zmn0>jDq$4826d3PuPe>N2(bqxr2ZkUD`a@z4v-uWjz0e&`^@`dt9Fcwh6%3gbf;3 zTDH(pZra`5D4694_5E=y-d@2!Zsknu)^BiD&M;yQhrgY_i*?o@@zmfD`0j6(Z?Y;u__TplMW<~+K_}azWCoC+r;|CCXWzA|ElGE%)#R=r+b9om|+|?p}d6*k&})X@wfinspfP@yFj{gT@NTc!7>N z0H9UJ+`>y<_99umWWfkZXaT#-fgPp_THJp{{>&S)J#pC1dmX*eqBY!3Zun}H&Wdc3 zZDzLw-ix5YkqcHv0bMm=C`8sFME>?rROvth4RB--0HLva+sqXI9qqRE1`H!5#~2ET zOxRl*OnGdAOq;gY3G!dRN#yjh6&B{CTPPCM=67yivNu2ElA`@+a+t};c&*#UZu57< zt%IMtu!3L!c-AFHv+ZOZRD_PDC9?lmI`vmR&LI?L6YaE_Rm+GhXr&c1yj6h;f-*7t z+Xnyx&WKG!3^Ht{rR_;^!LkA#)kY4b=U}ppJ|RQq5n$;^vPwW`ZN9RtAt`4(1xj1d0Q{ikE!11 zeraqVWtZ63B0*4`WL#h`L;!nB_t)02p&l&`R(A%fg^0FYUOJCj)u;=g5$gxz$g^Yt z7a5dw@OY+(T`Wq+P5%v-*r{W~hKD6oa|BPQqDuOyfYeC^p}i@}=NtEIVdjOesh zDaJWgGr67SV{Z+3x-qtJ2t%|wen)|OE8 zC8ta;6~R-{O_1*gd0IkH!$H zozkwxlcWVRJ4eYt$MFa8M(YX|V-2tD=$;|^OlZ_~fzn{#kN83(Vz3We2HT=d4JYl& zWG_;gC|H|JsL^p}45wAYkJ5 zIi}5U<@VLtuE;?$zq!U0N|A5!eUG5*@V?L&y#i$wkw4(cIv+i23lv`9NgMYUYGZlc zpoTyowl0Ss|A}0;JDC7d89;$U?Jh5~#z3mQ&H*+v2a6R5t{bCNI5~sz<=+A8ys7aVfNkN!f-#EF?YX!hga z@a%l^)vXhXpl(jmpV0g3<8h!kGGpTgbvw+JOXe_a1BHrbDO$aM^07Qg;!Z5h(QJvt ziJ1N+*Q|R>W2%??kgP|6a^?gKrtphOL|Mce4WwR;>^#?rTyAqDxy1S3lUE?TpomX~ ztHlMbk{)L?E(FGSY4zx?X;d`~hqW2kz|M9(MR)9GJCG>FGf>c0@r&Wv#2L`<6HULxXkMZuA{{=F!fLN* znwX3Kl&V0oZIE`Q% z5}E%U@rvz?&)ucj-v1kH8003`h$0$A)ET;e;&ZU0#go8r!2pz4!t2_E2HIPT#iQ#l z*cNLvAuIe(hA6Az;fE1M{2~>04#1Jl8{|YpOM~``HXSHl09GTD-*A9(^M0ok*`oK* zLL^Q3_TU09Wv*6`e9^Pn%o*)<|MDcD)GTuITYu|FN5_!*(0??+WW9Tyz{>pUyw)|# zU4%(R9hSSYB-T`3J}AWND;`E#Pj7E#9V!n`-Fw@)o7>yu5LA&*%rkx$SIOs*s#c`U z!D48>?Vge3JdmCN);IGdvloV5Xtp!*IH3OnFND2nX$Q5pYR9?CXvVEMifwQN@pb~L(X}u~icX9u!fpwOnJ)+y= zK@i-R)!cQQ6!RGcG9()F`^`K*3@B$lm%c05aNibE*a^$|qGJ+3HsLUpcZ+TyFRIMS z0z@l(e8~w?-E75<>wnRRxG+P-LBFPn71EmhR(2q?y{uLb*1KHN58kxIGP z9UPgoI`qplZ!gZj63Bla0Wn*dC&Yw?VZDVe*Au$O5ySfz1b@DR94i|=a95t3sjcE zp!&J9-q1p`jHHI^c498{cE^LIMLFwv2XnR)$?%WB%&3!-HAlU(S(0Sw$2XJzz1dNOIv__>7YS+HLP1aTdHl1UygrRBev4((idFLM zr+p;Q;R~lReb6MWIhe~D5f~QRGyd^l^_>}qLnbL=H~V?`SjkXvaNR~ipG-{gS6hg~ z!T~gNP$U!q#F!SMS5#Z3XriI2YQm;@G?0*(sBwRFC?qJzhD!DN>>(%b9(}p-zHKii z_4(ud;PDlmP}%lHjgA?5DZvqRZ@wiq;gFfG;>Rsbf_O~%U7Kl4&?jdh`l$zQv2Zz*99nJ1-EwUM*agT|WE~G?ZeQgfFt*$+Rfi6ktN_Hl zRGDHXNv-4bU3>F`P}=)p!X~R{iSoN-oUsLLh&rnim&SI6T}B&VD@adFyp#; z-)@Fy@_{CZGzz>ht-9@^R7|MB3RV^sb3G)Pbcx?psVeB1Wf!3+uD zK5EibGae2j9TcG3fOas21wsgLz(KKfY_WEI564^{N%-avPMr@;K$wyQbhHRH|JwbB zjfsV&RIAD?7hN7XXKSPa>V>h)5S5_4GFo)3Cr1A^o?aMow!QTxFrZ0yO8)Tqa!iPR zc8cS^J7$WcNe-4T%lXTHH5E<57t)A~T9oH`%1Li_bifaQIUhp4U4#5Do!zuO_K6$o z??17TRGp>Ev+DPN+B)>b!IbKmz{_d;=jFf(rsaBHA!$AiAjMErshq?8X`a!=-^@!y z@IK#NDG&l^#`hwpC#8&=OW%4;SQhyy=@vd^j>+pZ9ZykxI=Cv;;~$tGk8bZ=7D;O} zr2erfo2*O2s@5;7R;jFZ`1+VaWE!L)mHL_%Bx*V`?_BTAB9%EcrWdxUX-GWUB>@k@ zc~|QZ*{7!h8y4U`^C*9J>s(5E1T6=;$ar@CP46~&d}&c z2Wl!ma>&ZpR8lR*47=q8HKO7z_0T>*NMZatOz+_v&R^-K`}Y&fox;C-$9efq(s5-k zoRKPXj#mIQG{CIt-;X^p4KUO9#o}$o;{spX{bA=O+TrMOKF__0i_gGd7a9LV`&7Gk zFe{rn&%XCny?QX9?uwt=x0}M%GcxrIr^FSpClX(6&W53!&S8V6h;h6q+dj+T!|M(W zHY|x}dG z&dS=_SmsAW0|Nt+ZkQEq<-H>~9{VNvvOO0}&tIRnfVn+{b?(#GaPuyfM33`9b|SXI z9y>8Ph{>9PuHVYAsc$`|b1k0!H<;yn*9*I55eOp*%g3@;#Q{0sk+01Msyc_ji= z?zZJNKQ~eSdj+_2qGB1dp-~v_DQVO7MvAuf!}D5vF4M+%a*vQ&^yBSS3aiBuv3)x< zAOX8$&hGYU6qVR-)6}Yf1+l$jIdyb9cV+MX$n;=+QO+W=*?OaKg^9g+KHpeD!m@uf zeqb4P-P=F0Dg zF<%vqs1xC)QSQO9Ez+Pgn>~xu)mhv9YGAp}9+(|KVZKcvMN3{WGrpAGWoTG7HvxLM zM{}PXM357DGFS>|e&{MfBSA%RajM*Q^1C}fFGFCCO{A0Ksk1QHo+n2H2>H;kNMCK| zf#NS6ITEIfJQ*qlu2$jlIim%Wp7D|zOe(5I^eO>sZ@H$wqxUt_#ZJFs4XrnG)$3pz z7?_2}MED?PoqJm4rP1(wxn7+A7fnGg(bSg&;r^aKW4OM8 zTHz8){|Ml=^PZRiO7egd*m0A(&5(BdKcRW_9w5y1bulpI6pfVnoY8FK^}^~&Gp#wT z57~0&QL{BYV%^w#%fA!Q&|xz;(PT+y0fBqB_wf~U=;h8MD~blww~UhVWECGuCeVrI z?b`Ac*idz#_hWyX69*IflkizotmF+m<$41umGMBlC?0XeW-!T>*dPbj@?@?}?qZ@Z zCG4nGbJozox}rDuTdN05as8V_Xs;?@0^2Rde#_|UrYX|>VWW^a0}kmb4w%)z%ZzL8 zAr!8HKeAWwP9ENdhT~|3g|XYwe*4gb(}ExP3k9V=tX*sMZR{9 z?HI$HA@x=nzxN&ocXB&4X((H~=)xm*$Fh+Yq3TpV3au<4a9y60nlF>tJF67ATue!lVhiTmAR z=4=b)P#bLj8sve@c_c{mI%_`UlB0&dR!KTmeKZGoF!3CmB#^w~IO`)Y0S7{6y+{Du zq$w)b6>C=fl%UI(iU458PDP_FtWAxaZu}r}&O{isLC?D&*aMC~_H8bF8Q_vh&>+HOc1Y>hgooYP^ge!uw>)Ql zO)~Qbfu-g``!ONoYD6!rCd>{S;h2z@a>dy9FvP&=YJW1$QZ z$Qu&6SnHWDm@{k2Nmj`1?zCxGyQnhj7b?b5J7_T#;&bu5P;7c#wLH#Qb5`p7qf7wq z1k!EgQ?R3}tLLv71>T4|Qn1Sts_kJ)hZ@E)YW(b(7LT~B~W2o!M>(gWO*}iLO^Q$Nb1TUuF znBcUr(Y!BHpnhf*FcW0(Bn(lbNF8BZg$@flg0UYPjaHBt7Toc(3FiM-IKC&dhPRy!HhW{*05nbo+S zor5ngoK)#>b8?P}6-h`)7MeVq!C(v(_t zGvT7C;yuEV{MGq;5}*MN2)0Vlp@nxcNfTu>d&fclG_rnR1~AQc?zdkLaAx#NnFS!u z!AIH*hu`iD074Jsus`tl`5Xt&Y{~tRSK3>5b(xm7UUw>>K`8re(+^o(xEAf~s!Fk0 zXyoGFbc1iKs0d}EN^V7$tzt?EuV0Q#lz}blb*~6U3b!YoOp>+N`6HM2z&7u=SY> zbY>uzR!3W`|CBlT-r~)owYW8>P>`qz5BQSsYtPY4EbV@o0nd1LQ-Q4o9f+j)VdSEJ zdo~z^i6cL|id6Ca`h0`z%N>oOf61b+(ZzM@^Yf%p$gzb<4g=@}UqG?7+GB%37N)J{ z-C*Zm5NE%;qqQkA?b6K!L-BO(w;Hw;iX&CeR|XmCSG{df4UtusQ%$Yl?e?& zC#Dy_*c?HNHL61~h^c)SedV5FfTT+t%>2GX-caMMO5p@Q$gnE;+|0F1WnM!)_vm`k z3K{W1*}8i*RWiVW7^}}L>!Z6`CMRKt-GT(>#)!Re_z#rd-aZI$8MQ7!iLKNU3=r=f zip~9JjUaL3;hIlFOwxn&T#HVtL!6-ek4olwGp{qyP(rx!4-IlByoF82a~C&Bn6llV z()zgwAadICU>sZnuT&*vR8XmLDk^ZrPk;NOIXFvoaq48wj!MGo zaCfl_%!zPtabaRmx106YtWxsx;dY%5<;3735^8>>1LqPfQ1j!HnqFS1ypPhx{#L!) zp1*?uQ0&v1OFst#T8Gg8N{H~O}3vY_PwftfuSV|5-csJGzfCNQk+xSd; z&RE^2mY<|%1d#Lfye}@&D?WE@TDdNl=;Z6&>ivChiEK}j3i1ymID!+k2~yzJ`0Hrn z9{H}-Z@GK)tKYtu*)*0Pb>3#H4>_leSYN*?XoVhMsiiVm@CEvXmIUKW-lZ1F2n-Ld zb-+;2&;)m^R$Gpnoo)1HONJw(qQbWg>3N?m9_aamlxRY4Gtw4fFj&;aG4qRXTwM@4 z%+KHJdPHqeRO{T@F6Y)*FMvJopBk>m&HlrEif}J*_Yg3&xUR_7t2YLMc95LJ(NQ%H zD#Fv_-KiU_4iW9Au>8N7pq0bTi|)0rsnb8L6j{sV3P{-;KNtL&gYwx6Igo-pJ0-KH zV;FS2cK;6kw2{)dxA!9sSdBZZawEcAHZ^o^9-T4oH-ofe+qOIShX@P9i={VR-CTw{ z1#1^f-FfkaNi;E(9lXV7f=q#>um8f!FzNUK1`~(J#OMmU^3m$nAP`HK#AX(2vgxON zMF50BdV??JZLbJ)*p} z^&ah)O%A6YEDO@B9Ld>h#K7O75m(SxsFs9U;9aF3=y>olKA?60LVIsD46QI z?a4}md;zDG-I!C!sOSAdlj+c)$kWe^`(FQ>)Vw3eqHFSzQ?W)UP%KhVKL0!Tq+{+= zRkm!u|71P5_X@)fw{9=P`sMJT!n0dEMhImiqNmT?j+RV7HDZgZv`rS@Tl-#;e$ z{6%&#%e;E4KCYfR>gJaI8U$zLf;a!S7wLVN7SBwPjH;-&3k68^u+R^cbDSR68bBa+ z%j~)4$C9O`Z$b6XbY8$)A}Gt9SqOV|rX(xqC6Fh2)jv}TH`m!95V}Cm1fD3 z`#A#5rW$-|FRHVvnx#uF(u_U7_b#Q3y5~VqHk{w-#1b5o3s9zIXpp8hIt(MmBJFt^ zKW6M&kJmQ3<)eC%eH+}ad?~&HdaA{gsk_Vb(mcO6P!pTTB_vmBV!#6Mn@8$|woiW}W&gXY z>h1Yay=V#2#*3A2m))SM3Jv7{?U((pFNqa%s3S5l&Mf%0!&d!?Dk^G_9CxfH`uBSj za~RR7aRL_&lSu~>IMA4xSFru8Uy1zh;d=aVFwJ5%6rUL9o#SoeXKx<^`*(1N{seEv z^!y;jLjk9x#(E2#Ac`#~pRTo^*eHWtr24JG5k`6Tf|F0?!>XBMbQ476U@7y8U*+OT z(UZo1nzw%*A6N`0#uv6EwbUq&`xHDf0EOK5E`VLlKiE&>Eq?A6{-|F6^C~a?>i!fH zL%B?x-}l6#UCF>`_jDEay}z-YRbX5O+e!5&IfUb{&dTG+ z{NO_8qcxnI${*zUMExXa%TaZJxZ3sJ7Z_|5X#L8gG=1zP1?N+KvnZi86wQbsLt&0; z89DTCuBG~-i0u5!~ZVZ0Cq>~ zE{A~-|2$X(dhk-O$66s7n$ha=KpftJ_b-8@MHR*^U7?qvt7FN(KIBFF^Oz!u$Q63w z=Oa|}p``hm$^7`%EAd#Q?8e|2>TRO)brmb!=Z@QMj0?4+&4QZ6Kwhh9LsKc*xckZx zAw<|>(7DG_49ddV#&mCeygRG!Tt6>L60i> zKkqFH1o6@7sWC<592$FBNB_D@%ew-DPwd@fAk~~bD&irMn|*Qp#<-&~8~>7wGzyuS zrt7_hP`wu0SpPqv*I`#K_l>Sqn&b)y5pbeg=S|u3tm#W&J^c!*SI5(P<989ISCP)h zElchzHy6>D-rhmFcFB?|kMYaHpXpq1ew_V~JTp^c$Upxf1(rqN&&Rb@3a2W9`iIEob9C#s`)eo3G8oNB z-&G|r#dot{6KXzHeK~%mq35OZxS*!dwd88c_yg}CV5TAy7f+%sKsIqnMq%sz3zuXN zCIzMcxv(%4{0@91B=;`1_jb`aBBd~bK_#qr#BfAyR}~@t16AxUE(d79<;e3=Z*AMy zqww|YW==$iHR_2}e*MT7oGcB$(zT|K}NH$av}|U1iiMq5@8$gET0R> zdaZdkzyA83n!1@ky2wBG2CyHZt@mJDZEF`Gi2#A*e!5<`Omb9(;b3#d+0w&^g};W+ zLV8Y{;p(5Ra)v&JNtFtdT%F{J`!OedH~)V`y>(bs?ejf+KtM`FNFyE`>F(~9?(UH8?(UBF_W68&*SjzNIKrg|&z?Q^nzh!<^kc)B<)YrhK>hFfyhPZA z0PSN42kiyLR@y8}Rra_R$6=84%2X-lEVf1K>ZpJe5t7|J+~7vIemvLvf%wYrkj3+5 zzH|0wZ%&xJqYPD*R!R*bI^>q8{i%HRv??r0+buGS*}Z2# z7gEkoTo~P5kD9_T-Dz!bvP{#_xy9-sJ!I`Diu%(jQ7HvDc5F&|xHz}U zFLSG0o&NQamxIHH(RzEz+hexrvPwP+HXu?~!#w#w48A{YnD{?p~yOm}9J+eQt1^b>)L}<*i_R z;6%kAVa6X%QZW$sYFivgMD1A_r(nI#ZDhoZFZY<`BN@pi@@}BL@M?9~i?CD4U#*c_ z3JDRbHM|TguBGbTb66!FHC`M(UEF9>F68%Y7}{0BcRr_b{T!o!|G!H=5EZ;mB!DNx z{svW(HFz6y23wsiF8|?(b%kGVuQK5zZ+ zAn9cV^InX&fXmQF8(2HvF@G!mm_6G>H(c?(9$Q(tAueoVY)$J=wK5bTee2=w-`BM# zO$Fm`gxjaO1xY(Bmy7PvpgvFN%kFmmT8zxmd-!yEGNrES?zrn~_~fTZVcFZ%&2V^9 z;2UH^0rP(sli*Ku7?@!+7*v69;S`D&{95`PmJ-H15vU`h@uitVc8efnnHiLo=X1_7 z#$jV|H|c|Hb7tJWlwNT~Q9JgDspHxCRcVLcmBaFU=!?mQE)IXcjX`-0ZZ9=rxo#{* z-IPsWY>K7Sn8QO3TXFo~rfDfT985hxU8__zI<7qJMi3izSsPD?go;Q$UXt;us?Y7$ z7SwBTC34QkFFGlO`cBPveDl#!jS#!+eHodQO+Y1CsR~J-x@}=ixFq_G@2ak$hO=8R zRuJhUWGCYy1->j@_!_Tyw7z2I&}4O}K&zST4euSUEzd93S6A4Y>7n^(ixqmBcyIdf zK;*uw=VdZs1wg^28yi3;TC^kZ@?H^jYBjqjV2tOcm|xjlf;k=E;f4 z|E2O5wh?<45g6mp^tj||Ot)J|Cd#_!*fT47v1dshv>Iz}#<8Zj#t&$pH}T{9EbzaJ z5Z#aCv%r|6dzQ}M8h_m5y@`fY3b0GsIDr~LzQ!HBn3q|s6XRMi5x^2LBRtwtjai{3^Ox*K_cwj0e3cR(CSGseSgl?$~vKnSp)lZsQ zv@HG!nNI!8DO5>&MIPUYs?+yzZ-ttEkuq`gzrHN;ESXCiDt|yg545iyx0>o4e{2sN z1s`qyW}GUvF`y1y`S!XgghyGOBi=#|!+u6S3XvOab!TTc)-dBN7bxx?+?RF5K_jlt z=7!2qHsC$TxQuGZMyX02?ilO&5GwoP<%a%Xw*bS4wd{CEB|eJuAK41!gjcgFL%#L5 zeWYo23A$;e9|;?g4jGmX8y==yFW+Rvhb)S@a_0~>Mp+(+qtHF*rA}I*zVi~GoSacH z{CxNriHL8H$%LaUl!74M((sh{$o|g9ON(McKC98*+Uzw1+MAMz$$95k!@!_glYd^F z+G5@qGe$|Im+FyCP=L^J+&1J%VW3oS9z@2TiUKX) z;UsTLBIR>>cWxkE!z^hqkGc;2D6{l_z|h)H53)V7AGZsmYi>%(2|=gCNvZ5poe@x^ zL_Kqc=F=fuMS^vMN~36d8QegGaf1q@S+%}%OZDpAy5Ml*)9Kp+PBy-@-jl7P%))lJ zXGZ30y{SJ8pChbGkE9G84@wEGJ4Q!-3lj6XB`B!N54xzO3dkw6PtVA+PfiStJbe79 zJG0#986F}>seXDh7obk^_T;UPm$e!G%!r}ZhfjwVzY3I?AmQT13i6ibmj7~yrnU%z zs&|Oz4u6xIkyx8jFC9@(**VQYLQf#=YSF|lwVf$hUh3NWH>9n9I&d$Ck?jM%W3bw!emEVWfo8!><3~3hfMb@7~-WH)~>B#Pa4E?`Lf#@GHiS?=|TpJ%z zd~vo8r&u3!)Tf_F{WA1`cWbl9|Sm+kCpRLj71<%-OZ&%S?P2tU2LPs-J{2L zB}mldq6ED%wvI=Pvv;faV~HO^;Ci?k1>;Qj`*b53>*oDPib{&|RLnNdv zZa*nw?`$G7ZQ6B+-$ze0SNUg!f_Y^K{!*1S3_mJa&-RvZKCiAQzP-RpmTe{SFvTPv zuE-L9{~Bp#Wc%J_|5nCZu4@O03S&H5BQI@>MZqMkICz{J=j0(lZFq0JWm{Y5365&( z$E3-nin?i9E5^VK4^BUQ35=J6g&iiX%qpyFqTzQ67_ath{I}1|_GYvYN?L;yuBXfO zoOrIFn$(ZekRKa0f?eG@Fg#roburUrRfeqvM5saJPv}j$xsF!7*AG~sj|axL%{wPC z7D^=V?$$d8d}r8(&dDzkprN55*j#qIR|hj^*VSe-_cteHnyy{Zad8J=(EJh6mw;q$ zN16I-N)+TyH+OduVqz8+7A9t96PCnZuXA&9c%9ETfzK!?DClIlS+7FP)YP=5rY42k z@pz^zt+BB&H#b+1){0oJK&dICtSl`eB12OT9wI=9s`mA(fxbQm2ZxZbaD*7CfrgUo ze|gORTZsYVsO97DnO^_+#c9=RHXA&nJrXqCgPtQdtY<;(PBf)8v-wM`3?NRK^Sdmx z_smX=FE*#lZA2>>Xk@ccJ2g#qe7DuI2(+BG4vX|S9vkd6INL_hXWHxDDIR3B>Z6n( z&$#szcS;f>&Vct9x^LJCjBBx6cVEul;dzO^yTHJP0}t52RP`zR68?afN)btIm7?M~LR)D_a6q-N+W z5~TJI*l`l({8XEtd44~CTU!3n+mz9%imzNl+sZ=o(u}pb!>8+YaG$X3Do8xK?7Te5 zSC6=^>o)LTC|rt&QxeIdqCT#}!$9-B94K_;UQfuH#|w<*k2Z%6t#t;LX*CA0>&uhh zx;@`r?7TcboV+FAQ*tfx1?67(sapk0P&+<5I$kBWF9f*SuQa`=${b@{Q4MRVHU`FBjIMXB zw;{L(G!VhV2=^S-pQ)vnC)2*8Um3>Rwah4)P!ZkH%ix*$J9={}^lsB(NTWp{7lzew zeYrH1t#7;-69Vs-d3l(*Q#Mh$;vN%O=*MEcUwGNg{QB~TS(ufLvria~^G)W8R`W|D zZ3N<;nXqq9btu^?ELpEimA%Fy;5mwjuCPD*>7Mcy3LtF8DM19xwB88I`mt4%Grwma zOt^qcjNd1Q@7O_7J4zB1wi0saMoJP8pFLlPhTjkm%eB>Yir3M{43xy*c9EGxt5< za`XL_*?D-#fGl`CP^gIrLyX+Xq1nEEwX@PR7#T-~)<=EL>A>=2d;CqyLYXbjlbd>P z{V0xr*%V$*F7my}!o|b$5q?8bydyiKXQcMd{JF$?3dBKbC;?SP<-h1eW2EC;8I=3X zllDVhAJw@EA#!qR9&3V{YEEv#!cXW#<9kYylCQ9mZV2~P#l5l!VW8KhdEdFRg(Ynr zcs%tdMb0B`qEbee=XcS=<}^NI^EJi!w$$7wlIWV3CSOFbNq=mrB~xK+9RGf!hd}SeXTyU(u-bryvw(vRtz1HGhmq9MONne0{bGG#b{zj z9@>*V9uKC?O6Y-=NQf~qtSnZrE9(^MaM*AQzZWY{7;aef;tPcDE(<}FArjeoRuauiH>dhfoS*@lWDt1fn4 z%Y_ws^ne9r{;T;ywzfT_@y0DSg1R^hidYJ4&=xWYsR^c0gQOP>$XyDJd#bTPD^WX} z3aotQ8?l4KgedTB2l#a@hDl-dVabsCBWyHgQQA;2MLd|*Sz=18FBA{z(g!$kTE_1& zyK00CXDw+uo$*b)lxnMDf7BvO^8Tb*NvTJnMn1GXY9=lAq_xt7EdyjvR8&gu z)z#IV(X>}yVPRp-&CSuN*a5@wj2nFsB$3>p1>?Mzz;kwXHr#V4DKRO@707GKMJg3) zI<14?k>ql@+`ZTt9ekjd`vexW`!W4>V*~>!81;HGz6A1lJ~z2PTpJ9=QY~b1efd|p z(jvk@UYS>3l`Cj>S1sPU{Q8z_c*(!RNs7T+zt+*+yk=8d{&h?*9xNEOfEeaj?5gMsxLu-xU%}s5=@pqf^(p z%^Epc;nT?rn1)L}EkOz?HD?kY9?p92SDBD3e0(Uv-TNvo{GU`FoSt}JO0<`Xsr1qO zrHG@%F_5hzH?DoB2hVe~->wBx#VtW=h-4=z|t-#!-=jJL=SA57Eo2cnS&K!63c%w}DQa>PdeTYKXw_>aTZXEi`Xa)Ojm>6WSxT^tMl0;!_o0 zr!?N3ldervKE=H(6YBQ zH9x%Uc2WKr=}Rfi!Uuomo^B8EmyZ}|1q`)zH~SN#$L@}lQ3adB?H3mKv@pbfb0u#C zQ(H_ocN$)?XF5fsEWKhS=9$SX9DQ z=a@(I>H}2UQup{$w}Qk@vQH)FOL9LgWz=|HQ2FLr_3E?U%a4nuvo+czo!3-I?+dUZVwsHy8YopS*ArbKKFP+6WV_+}mW(t@J+veC(hYPVz-K=)1qGfz+ybMH5g|m9hp^H z>T$Bn3wmvCZ_5V1^o9|f932ho*W^zH!bsy-SR8TMZXYf+s*Ezj~9K z%&pP-0}JC@W)%(OQMI=`s4Q?$Hd)|ZSAA82tj@#n$dMdI`-z&f|JKQbjk6n382#!Q ztdlR8b>J*WCmXJ+c73}Q$o06SgY=zd#}GR%={a{bB&BqX)HUu^g?uFeB?eXfHcTA- zH*05>;B^8fJa(Io=Dgv{xu-Xwf8N1RQ*)@6w$!=Z0SZ?5NOU^FM9~#m;Pz;y_4KCv zQCyma!8qsdvf7JfQ8~f6aUXN*iT_m$N?k}Fh|>&>bt2NbtnvF_Akwc?^8cnuni^$NRWakiLE@P6Ax?cV~&6@?wT;7{c6+Y->n4_KuUar z{>j#`?PLC?p$cORKt<_u6<~C4Q$|tILcOgK74OFSIvQF_Z;MXd4{wQ*FCWSyBL0Hg zQfsyH+v;Ca%SbY(1bw*3>A^QkOG^WTtK%hZ2M2?d7;ECm6K|k6Ja?~)+YiWM5HN&Q zk5Zm{`Srv|FIN^u4GHS=H4UJ5EL4``Q}WgotL&API`T$;#Nf_6GE=twp|gbiIGmqw z8Tzd&Ks@zgA%yy4*Z6z}It}RsZV3CpWK3d1^7Gy_v!m# zWFrp2uKqwW-SI$8jwMD+1uBfZogu}hnL35=9aDnTd`cjvaSROk=}^LXYUKfYiWo#l0#C#twn(Ch!rOgG*93w)u?uIc2;%My?o=DzU8 z{@Tm>dFUw}zMDPS?Mk;csQ6F7fIvDK_St1pxX6}q-oLMPI$Hh>?sPtnmBdlR7X7hvY+s~MfAhnty+ z2|WhvfPerG4-ao|?~|3*IKGIc(pVoKXg5?14UMyr7#h{!*YC|}Io6+gdU_C<5FoSW zHBR}@PY;s(m|I(0>mvZ5$1LOEI?Q7lsYyr-TpulfUp+K56!0Rkv9U=>3m{0p2nvGS zWA>EQ^+~N9Vs*IE+A8y!It8mvE)Kx|Uq)s-ewpgW0h6!7beke*n`}P-hS@RU0v6`p3+1vMfUztAExo>`Zy-}F) zlNcF2Sjeg1EmoM$$Xc{@op8)yri6-zv#`w9ySVZ5;>hvGN<@EZbIP{h&&{Ho_9F6| ziZcGZ-Fv6K{h=8CBuM^S#W=6Os31RC{50$R(kXh$ ze_3{ThK{bOshmF<-!<7KtFzC@8lZbM$eLYJFh0}S(`aR+_r(ITisUD&!9_U+UrKeveZ`k;xD?dwy0_9RP-~;a>kVRb-EE?f0^qS zGh0>EHb>QSyqn7;%hPF*QfyOF#@XLNhUnI6vvz2=9wYa==10myI`vjkz#?+Z5? zO;tW$c%%g4h@4Ebr&kX^GB;T`H9H3l!b5-tKFe;fa%#QSv0hMWT?iv|%J zse#0Z1t&xe#QCPS7BXRzdg^(X~+n8|a{pn^5d$`B}a8afG=|yAt)GUR+5h0WD>~L|6e#BCQXb8f@ zEpmNe<&YqeEa57GpQg80=lk+IH10#LkR*d;AFv-*CIVwnaHcu_u!)OS!TpTp3JmLH$WCn(`+}70{THG9xqHj# zq=mzk{dfmiH~6;PRyEc+AA3)7!W(gom&`UGK6`NQG;A}h1y z`6IbeZ6ukyZBi4gW~WpAL9(9H++2`QU}8td@iLTUeMPK4$!GW}(D$E;^kSH$V*W7oq4g-E9vi85$bi8cIq1BL$6y;^lLa1PFH*YRhJ6`HV)Ay~yXB&q z*A+>bPl_>J$#>i4{VI-5OF~R+Y-%cId7`Z?T{?*kJd==e z=L^Gsc#Kev4;~UKWN%_{b31rp%AM|IX`^M_Hu>~O{xq85eJDZf+ok$L+Q%=GSYEFy z;v07I@1I)S6Exqdm-NcpOQd_i}L+ z{52kpn$XGX!+lnOZNh>M&J--D-{>QqtgrgY|5n3MRT4J_8KRj=c&v5rEg7a*XWe?#E}sTy^IQ(onL#+s4$j`&QBq#9ttp;bo>;xT>?6!tqrFq096y-C{EhXN*J5Ga4aEvne2hJtD@6Hro80^J|S zv&xE!c>EqszP_*g1%Xh&>3;u*<9(DEDK5v4e_Tn?Rc58yCnF=HMd=`Blksc-36c^L ztT~dw&&o7vj{&<3vbFL<)l;RxARx(zm+gN1i05`J1^h~GuAzZ}!T0a$0PlU|b@6L$ zFqt673IRe!X<9EMD=ROcR3-})&xXCc{?TL8B^r{~Un}*4I2t;7dPF`kOk!e%VB+8e z)ds%7BY!gL0I9Uwf)->*i=%sKYW$C3J8Nr1I8xs%ESl~16euVtSXrw(Iy&-X(=2Dp zKR5mHyx1NF#Hwi6#~3EVFQr)E?@dlBL4JmY;xm4SX|V+akLU9p#q#v{cwuiERUDGq zZ_4#Q?8yTI5`f&RVEWtadIM1G-26NMPVoMMJWYFmPQNYUqjB)(8>?pnQtVx z;WKjjiubC-A=ib<#J+EFT(gY<{_$ozs3fZSuz0kmr*)v%{S8y76r7h0%FRw3jG(+c zSrORyfcr`xO(IWjSDz_VFn8mnrP@TFDMc_tv5y5YLFV~>zm`onGwfCXF-qh!YV;`j z;md;?rh$)4o+Wo}eo6_WETN|7+Q`&wuJ%w3V1eu&<`i1By_c6;dVf#Ndpguw%B`59 zbIht*Ll-#M!}|yXIs~}$T6i8zfBupJ1rdy(T+_SmPhxxvIwWqg-#|mjIjB=WPyylB z*w}K=2J9ohIo^{N4_lPj`9h`VH=#i;tEVt|!af|2+i}_7pFG{ab;$lp1qnZAWZx7# zeCpezekUJFD3eZEXKxayi)y_S+ClL^c9*RE%{bk};(K_sy0R*{F`{uHQ_V0=X2t-- zD|?jokyr4Y{&2LnVE`An#eigGVr9kWcKGxkOR)NZ#|af8Mmk=h*W2?OUy|6pM4AIM z6leiOL$h9?7(F{LkKg&ctFv=s=kxYR3XKXmGBRkGa~f-LcRed&V`JOs30(kGJb~w< zd=c;4k36WOefmsgI<3n^s`ULR;Eg`8nks=b>jm{HI3xt>8>mFVlTbEY4v;~hpP!JB z5X4K2v@mj!iiybv)T~ZPf*FhTwt-Tmc`N6jwP^j?s`ZJynfW-Y*V<84siGFhHX&M@ zq-cBKNdGPlfeZ}~r=+BKzC7KuwY32tvd$fb&%J$gbhNXhIuZY-UR@4@m6a71!uH^5 zEo5tJ>t@s(F$nuf6vKKRZv;G~pz-nS8fbsuy=m?Wb8-v-{>GwJ2ag+t=62BU-yR^p z$Hc^3>H-u&#n%i1`0DCP+3V>1KjV`+hXdD9wef!UVquU$Eca0PbYX-?5H~S2>^#;8RF}rJ(#mB$R?`4j-A3XE$ES7snDOxYv3SJ}SUe2-4kJ=7;tIw1u zh?ABIjGd}SKxgC&_LX><3jMyXa4fcxJ*d%;p;zOzSV^iYleutU>j8iKRyfX#B>5gz z%RO$12O~E;udLUFOWpXusm9{rG>ZkQZDsj$icFYi+TFR9NOK-~FX>sv{=)v6DGozR zUW7N+GA(P~?sxsi?$>27Ol3c?sD?<&++_I$`T}oPxb17lEw&5{T(>NkPc`4iR6){X zVhaV0+O5W~P?*Np$C7Ki7Urt)B?O^Xzh3rUWH6R#=PBcq{q@0ixv9zd+xK^re+!eP zUh@a7@8qSAW$BTog%pByCIVAN>jCo0u|Ar*oO=D$<Y9q&#-E>=J#m>w7G+SFO zsziMSFe)4zobo*(Jd@Qj4_68u?+sGgC;_Jp>9UAC3m@O|_;}@fYH4XH0s;b%bZ@`^ z6a7HS4#A&@yZ~>}0#0O*h(U7>y6tA)yQX7daq*zIxVX9jR{o{~e4)%2PJ64xX7>K58v|Ri4yn4;_ zw0Q+iMcLwS&xGiVe*MRzh1Tg2QZ)6R*rZHC(e300n>}G-#h4aG<5aWJ-vHGsobblQ zF)Qyy1QCdyAY0N6z(7v@JC@eMpjJ;js+&k!9Zygoy`>_o`dm#cki9(F*ckuzL|DF( zH-FA0sb!XbJy|?!zp%cfw7w`f7zqAyBNGD_ zXshQBYWlq!%wDJ9523&f^EvBgn9W=ZzH^}cqlP#yCe?W0BMv3dfzwCKcfmJ4jd}zw-T%IIG%H?nv z&q3e_D6$_v%0I!f0RqJX77*R0=XoUX#3K!_Aj$)Z8y`4rgcg@UGtB6KU;N%g9w?k8 zD>gxi4DOf{Hv>aCxdC)wgTT3I5~l?woL+ zf4rnj>k5Hz2#y>u(8jCerz%%6x!BU!6v|pAn$rXeVb0)vKE*HQG45DM31MS7G58Fk z-`dygP3HE9f)P7VasmUh(tl6}_9fZFczxtZ}6pulO0@|n%XHUE{!ueC`k<#^Gss&4b#ASO*aJ7 z`U?_rQzFvz-f&kLMn;tO^Ffsr+@zZ ziK38|pdyd}1;qg&Z{lYglU6m(@XZy^7tC4;=|oZkN|?{kuU_TY%{Drg)$v-d3sLb} zKR!KmAL+3g{kC^>1QZ_8GFFffI=K{w+wCbJV$OKMy>E0pDYd8D0~NT?;`CVl)`AXG z$Cq@kLT};-vC4pUfcZ>$^}&#z^&0*5ur!m^sZ999pW=wTM{k5aA#QJOf`hm`H!Yb3 zwI&NuN6aE- zOOis=ep+gdf$vQ6t+RV=CPMv%ASH&qqort0&1|ykoHJSPmo#7>H}B|6Z1KLFQnngS z`%M_GJZ@*3WZruBqxUF~GWbs|GprZROTe=uzse*=Q-{5fpDuSPKeQKYYAS0piKmkj zq^-hC{>|fqN9nc?ao@hP_I<;CP+IF@>t+7uESg`r7rD=8r%Vv!%0Ce~RW_2o?_;YV z0x_R0e)a3$N){-c7dyWyTmJggt3aT|do}sThjyXksrQ)Qd0$-Igm%gdcSn!cLP8ei zv*ofhDho#({%7gU%{VA8%fUCY=GwE>7VfqSCw#{als=2D&(EWtW$sjzdSjHK2})IG zCKD327bh*GXt+2y3DMD)wt<(IcK@;G5J>+$Dt}h#b91q(u&{89s-%QO7m5xNQi%En zBs*FS49@`_lumfU@*l%)a@a^o+Op{vQIL@_D8^cyFLGy7q=_Srmzx*bSR6I!RNd&6 z<>d?PS^8HaAKmVH+jn+$s?>DSI04=^pi(rqvZB9c>h0~7JY!=2|C2o&ljS0ZH8&w) zTX#1ZB_$;-ZOIza2B}^~mjP`e2krEWuz&zz5a7~QZ&clfJug^~hIh_Y-z+>H*GD1_ zvAt%9fXC%6L5E<(s)+DN;~p+s=eG8yqTk>-UyE#fG5rV`quShhM7H@~?~U z3WNzkdSK*f=bqO9o06vYWB1c^du3I{T6JCaY_#F0t8Vupr|8H2EZ=UQkG!?KKa0-` zYfDPlq7p9eB&EKazM|;p#zWg{glE!qVpny&u)$*gc5nxW^8Cix!#qg|0NFlD`W{Hp zlnN1q4Mx!q=E5A|fIY5fS^uT_aMh zp9_)Q6g(&LQe)w?X@k@E;=`4TwDPDDygN#gIDBuEaM9h@0RIkXcXlVneP6xdeagh zw=K0%rD?G=9DR$ByPVm@FC(A;enax%+C+4TpS0ZW%$DV@q9-d{CrB+iH*OEZudFqH zwuU_I#otbLl&$nqw#BY#KbbF(K=M*s799?BJBxH_a1jw;y?)--4zOis93r|NT3YZ; z|FvF;>P;qy3;c9>2<9r4@>$&8Tfe*hvgudUe3$)h$)EV|P>GS#8||pfy7HLZ)q^<5 zyYIuR(_XrAnj_=#s`F^}7{U*4DhXJZC-Ott{?k0yw-3fbD$@AayCWHX|28b7{?k?a z)ns6VZmM$a45phbW`AFrZeg~ppPzzQgjq)Z4?N(RP7 zj5*ogN}&UL>5ICm5iOm!!kFNaG*tQvzS$0bU9`c<^XWFQb_ylf6C;XZ8#!m3o*C%x z2f#04nUjQM1E`rGgA)SlppOoEfAQH>dV0FRVyreX^y|;4W@ZPbo%MzKX+^I;pomI{ z>nbWvWQm3Woj|$C=<)XKO8~OTYBq$hR0|4{n3!07eKMBeTlWOaMge$ou>G6D>rN5s z71h<4uKoY?gR4mPQ&V{u>0Z+Aluc4HO}x`pd)zTMz#ErSut6;CBEPS9&}9F%8hJ3&_3-+u#zA3zljNX#;%UKJm78RI z0JN8PYER-FA3U^%%*s#*9As)=8C`~a7F>V7OlmuIvb=<;*QU-*PHA`R?uI2x@pgs3 z8-hy%f=hD?Q*#Sza1|v(3o;~B^~RNPSja;K^W=>&nEa*2r{tz4l%lqxf_2qkKL(%C z!e{lABV*+ycW)uUym=%RKvmKBiIXIX<+oFTq@dY>j z@6TbwkcIL0m*n@&bXM!;(g`BgivzK_ox~bVPY+TC=A|u3&ww=4t_h z_i>+Vu{EhB1Iq^zpeviD*wLXQ-0OxhK(P{%*@ZwIv)Dc#-nq8oIeDm8j*E^V+|c;- z_o@BfYcQ^?uG0LIJBR-)=r;L=t;`ddY+}YlyxMB1vIo&6@^8=2y18w zEBa@Yf+!eM!e)U3QJ|2okLD{PuPbLz{F@Fncz_xl95VGnx5889zfRV07t_c#t)H}- z8yqpYdKMzp^M21o9xr)MPh+ zmw)@%swOr#sH`Jo4~>aqp;uaOy$ixL?M2hdC5I~kDCp{}dF382zN zvN9mmd`HyHnj+SmNDwLHKNx`8hREe-S10vyIaXxLi9y1XRIxlZl)Hv!!0_jSmt5lt zP+?nA1~0o_1`L}ZFd2~uJJaI2eZvuYpnTF`EU%&p>UL>bVTJ-F3OE?j?1jaoVEz#r1zr({@5a=u< zL<<6ypa;sx>>rb;v@{(cAmB39ZLT}^FY>W^6N(84v;o)0*)U)wroSYk!ovU|7?4$f z<%9MDHoM_eUOdkNV7gql1itnt>oz|>80*HbN+{vn)o^q_542Q6{)@39Xn#TL|E{?| zCWUF22Cc!a{Z)WMxgM?@{XV8FMQ4+WlA(!4%Z`X z8)lmEV_g#zi1lzih65%rRi4^Z;uu(kg`j6~Exc-*)383b8CjQnW`E%n)KN|8eJ?fV zByoJ_v6i-!QVs@lbeQho!#qwv}khbaZdU(6{hGUA>){Iz~32~4Hs;w?2_p$2Q zqq9ToJ%oitxuHP=$v;yxY(?vBnCCMwW^3T!`)>d7Hy@4P3dvB+jr~=@XPW)%SngYh zh!0^JlyvCgsXHsUW>S}d>oMbnBZepAmPmBl?JBB3uzcZS)2M+qMRA3XTA zd+U=}OaXtwubOeCi5Ug6oSfXEjLe*oNrjj`M&Z1%f~lSO4u-@1siK60>b#2kgyQ02 z06P%S$sZHV3;{o}?+xgMx+g$zsXtse@mO~WV3OMZ1|C^Jw9naYOb!5d0!Rm^HGzS> z;J&+F?s{9HeBfZ<<<(MFu3q*nDkunAh*XZqVeoi#s^G8&WNUUdDIQ)DmozRG7I{6- z%FK-FVyv4YF$swQjx-_a&q3T*UTzaotnUlokc5+xe3=ik1{ehnR|V|%#>T}3js|ey z^EjOXM<<9XFe;==2Qx@0BO_xXPd1M4=jMfo?cYEDT)M08Ge?ab1(U;JrSgaVfEC~h z?R*ZjrpJA$X76vM)E?6+hvZO|5OE+d(C;9Rj_dMo9ckR%-@sM(Zw(YcEwd=eyJ6#BQIbT0L@MH`zkVC|Im@_!5u7HfPm;QG$@oOV2KH() z3N)l>h)lhs17crcMZd&USafbB9~R1{O>wo7b-K2)lR0{r5yC5wu@x2O{~I+)8NAB- z4(78Qj4�=y*|?mg?IBdHkcm1v{7MXA_IflEvWQh8JtZ*Pfml2h-Z#<)!JA>n1Cf zQv61ZH6>8#+0mG2xaih28Fh8b%4E?2{{E>oH4^F~y5o(X3>L<-D;Os5)^^780%;R| zeaF7$qIY$lJYv7o(dV2Nlit`R^u+k=pyg`E{mcuwEU(7iom@-9S)O1|TSH2euKVac z{tjLUv`f!1nW-01yun_aQXxe3^YiO#`F3GcSykoh<3lc!EcPEQTA5x@V4|-d9TNi! z0S5|@TLAs3aNp{3RhS#sr(X$(aVMfXAXA!_sHCK(9`EhV6)5Hbfzws;eF2b1e>Aw$u<9Ry^3Puwu1{oukB<*{cOH*_!WTe4ksY$tO>TDz zj}yR(5+IQ?U@UGcdY(K}cmPV}qI~L=2|CeEVBrVU$NI)b8n0`O(db7|lBGR>jhVW- z6+jRJH8UW1H@Nk_e>cUXAl=B>%qOSD_y>+}{eSGv$@j_?orV-UyLx_&PMSubxI7-r zXg(aC-*u@|;|sQsFQ7P0M2Gf9h16+2k2Ke^mExVn$*v>?omh8ge*Ko4C7czmlVe!r zd{rDV1=G#|?|$tPWHpNEelG>Ib5UVoN;HFkqW_wx<`MwU9!Vy7dJU`; zT{LAy!YVRUI$9ml_ zHT5IJe5rvIP;L|yuOa{7(Eelrn4}|~Ajt*H{|(L;KQitzpY66(^|~Lnm6cTm z2T?IC0$b8BD5^Ub06MSKY?g+~DM2C!mPj{Lj6L4U#>x`o@$dqDcRej8f0zL*id*Ql zmW#KLZ+pLh z;dEURs$Nhy-naQ{aUG71W?Dh-Q#V?<`R?b+U{~d z1MZxT#PqYR^IGJD4UQ(39PCeCN<^98hJqQp*H2yZt}oxi`?H^0?RhF)2V$#90PFtM zODSXfrggf`%78w9kOi;l*Vz-%ddxG;Ae|fWHM)xzQN` z$T-B;{T|Pcccc6-(c_%d)cfFwTOS6Zipl~lA)!FiX%mo6K!x420DP?bQzw{vAjhe- zE^@3#bpMm0zoLMH5yWPT(*@}K0dhE?(84{G0H6lA1~}j7m#eFb%d8nunCv`aE6AoNzSYv@;U_$Z(r?=jpSChoF5kA z9mg7u`4sAg6l|UgrnLZ3H?WKVIy`YH-Dtx4l~$Q~l7U5GT9Rswn|+_JsMVIi&Sm<6 zfi_9+2?}I8r%L}%H6=i2N8#&xwIcfs*ongCGHqs2cA=)OuM+a0851H!?i_> zvK)56nrUci>T;IoN|g~eH@DUNpS_)k;h~|fwNH@M{r``uuMEnvi`sn<6p$38Q)!Tp zZlt?I8tLxtlJ0Jh?(P;4knS$&PU$?`_dDmCInOT`Wf<;Qd#$V1f!nqO%f!~l7!%NL z>GwxsoG!Gv)*2Yv3IE8>{$K_8g7sbM?TBy#zcRpGOG>D)f5J3h?+%ESM`rl|jy?LG zBBcW$AL>mbBqRhN;jV($-<^o2GEN90P%_>BuGI0a)Zg9Tr)syK@)bK2`f_HjJ2COA zd-PIKAhiZ5hKVxNP5O|@W0jcJQyMMhd+a!8FHcqTV=SWzS&+uSj&fBKhJ}@p_CVp0 zdLm%T5dF1wKSq@kvgw-4)#_GrYx58drQ%v36G4imPj$Wo1Yn3p@+ISqJD;kqt!f}s zjn#32(~%4{M7#cnAG)3lj~hotP+W%Z2Z%?BHIEYs&&V-CAkLw=F1BV9zVp#964tcc z2`yimc=4jgDNYsyc8k@Su+MY!{f;+vgdDRgiw#H}Ykkvy#5X9&$PuW4J;Db!PNlO) z9%kRn_+)KvU||skG>H@b{npN>t;(8{c8|9`LCp~Pw;F!4fvG*7ns2TSg>qv*Bl5oA zh2?F>OGr@foOs^<{CnVsw3YZBQ4oD?)6CXdE5S=gkmUvOE;62xi!=ghs4VL5AfCUX zO%4pjWo3wO-wqDNc}x5RUYE`ODA`ozkS>#=OUW-^#%t7?Y;=W$eyy}R|MPxd?oH_b z^npUa{8Uv_gBBuWz1FePV2Sr^RxXvwybnaWy1KfzJHF7c03NK@>kVD=dKeiWj~?3Y z01|Lep4QjbHv~baUm|U;sH#e-R=)voLOv|~)fz)d6BEh~2sag#DG;j7+~1q`4h)Dd zcK}*2FX-!Apm6|#T#)kUez6tevYW{R6bK7~+5a*`!O<)FF^1Rc@fQ64tc+W5iUI9K zQ8Di?p#JRc={a{B638AO8yj0)^;)Pg1c#`Kq9P3)9f)w#27rP3qOA zyz7A#0fe)ISwKM~Zu8%1TdGpd>2b?ISO|1)df&bQCmDm@FF3%K;zp>bsojBUtXL@X zkL5-IY9ZzvyP|N+iJ2AVNplCf_!|Z(zT;f z)%=MS#agMxH32XHX&PM{HS9X|K@!N7vAs`=aXscWrR8e{J3@dR8J{ugEraqt?WnM@ z-x4HCL*NTVhuCZ{hIw@^sMWJ2ue2^byUR;3N~npc2fvEoXye~f|_>Bo3WQuGSe`aW1FM>Iw}iimV+ z9%n3->*r#_NFBdc#uDCX$K{!HiIlMawv6~|ydEF^Qu||G+yL&MBSsE<6pGN6kfO3J zZ6xL%~8+EQj0Mk+liFq7DB#`7O1ai_jKoem?pBaqObKk1_rQhAH~0Hph!8I???w@Vwe_iP zPvDaWdxQwsR+U;?%hZ8`jlH+KOTk0sT|aKZ44x#9lt=J5!o2bgpD9m~GBPmO@_UVN zcCf5>>)|E!-$xo2tU9^_kEa6l*C~^_y}dnt|2HAfYG5wN&$CDc6f1zp&1tt+Y$)GL z07N7wH}`x5JaIsV^y&*gzpuhCcqF6<;9vxn!{8fIQc|%%+&}Cb93Vq>B!x-z-o%dk z*p69BSeT5Hvjr4vy^uqo%>)wZqT-i4@wn%k&KGeUR0sg2hCToxR03kK=?1E429OWX zG9VuElyFIy!Dl_4tkMPPy&ChFpR*TYdzg4YE&mi2L9FkROw9$RmvSlfFYo<;*`m4khNWYZ6dfet2Iu_ zD>l$x`1bBVK@#o-P03^6mO8jz^;F?xRxDCWKlNWT>_(2Gfk_$O4K;|3*KlT}QO~l# z+tA#{n~wsq$Ip*wEZJUDA?3?^wH&p5weZwe*nwmnGEtFkC=id1pB-9h`jUMX={uIo z5~b%6??Q$0Kd~lg27RTU}yb+zNATY}^m~mpR?deq#AvhS< zt4pbL@>YHceN1jU{G>ySzdH5IMv-$1!~euD&)(vpS?DAJtfD}}m9-HMkFS~aty*1% z6bA~*_v4QV6QHa8N5&fn`%(ipnlms%C_L`70~IgOXvM_D00vH>B}Oa{C=_=={=0h0$z%&_J_!@jm1|G z52J>0ci4SDABFgwVB&eXn2$eHt8Pg9DniJF_4PtTa{EGk+CP3&<^T0cL8w~Z!pCRQ zeTnh!v#Op)XuM_ZpC`i3Hp7f&d)04A?Ypb?gien_oEaTJ!3p4-sKV@}Kik_^k9U8; zG~D_ExsfpF^Ue_&^^2JT9)NkPsz}xBA{i&yD0GXoHhuV{?j& z@A9F6fFwCSe!9!^yMV`h0CqB%{jIDjlD=}4vjNNxWLgLa3NA@2wtGFb)YNRt?m5}B zqP;#&{}Nq^5U5+CKIpmfz#V*8;z*jeop1ce>?Kr{mY(woqBP5@DdpnvdEM4l7-=Ru zL`dB5xSFPz$uoV9{yd}eTJ?cKj9c4IAoOlO>o>i2M^w`-@y{_`*{aiDPZY&)<+*^yue`<}0@_8au>#AP$3*+Rld`~&FC%!{n0@RO|=FdmA zgI%KHe!D;1%uTF`HiC5L0~O~K?G~+tG}RRw@8=U}r`l#^@KT-{@_yt={6USbL?-C( znUncEqgV-g1Qe9Y6109+^inN;TDI0*n|u;{g=0IDh@LkBbh4A{V012|z|+c`No(Q#97 z1A|e2!0lK%$JBMr$w(R-KtB@anhSvq39O_5KYMhvrVobTxWvSraw$GAW9R1T7s@nN zRk4Ex;Gble+r;nk9lt|~YLzJ2>9 zAt3>@MG6X&fF1`8w34zi_^&{c)ZW$xTouAC6^HhqCje�HZrS?(8Ha-qOElsi^en zRWFV-1qXxQ4hAm)0Rey#gBQ-;&MsN10GNg#eD&xxBKHk)F<(oO?gMOxSPB$JZGd#Lp4`?~$FT3h{5z zv+M4z-d&D}D}R%G&e(^;@p^ZYh%B#j@7ggZN=N#fz(U`&MBjXYghbKL=ln@9 z^x&bn$?b7h1?DV|!#&Pk{w_joP@at`H3;}tMk%*ybItitR+3en856mK73h9@ok(4L$OzYK44?wt`J((EoS9(-_LdWbxrp`Z|c)mC1-nCW)7Xue*@HW!`1 z$4Q4Xs0(R)yJ;>#5?DHy%Seb(@8s!HEsY%g=}Y@6+i3sl@k&rMCpKM??4n*mzR^Xadx(Dw0AL{FkuD) zO7P(w#h8!{%gNaY#h~G}B61*1c?5QYZ2L;m>*2)cVT1&Ne+LXw?e8s z;?tUX4#JU=HsE448T%}s;dW0r$+XoqP#}SvSx!X{nrD=Sik)NAa`L}NUDeBoRbOE*ZRS-xU5p)YNuzH*##>WoH)Nz|$~wc=p1Td`02=K z(Uugk&dq7QXIG`{BG!Q?&+xjRO9@;oY2)@~XF}%&XDJv;fKFMjgU*jw?Cbf8^V)eL zD=Q0&V-*y;pM$Wesc9SQ1*FPshT6=3|5Kg)EB+2%Y_S0b*gMWucH5u>IZl|u&7jGK zgH#iYc%_V%OedCoS3&f!gCD<+B{pi$1s_syOzx2zTU|Ea&8)-aRb=Bp^3)||AYYC~ zjQ<+BUrtP^L?@P5nqgX-5IA0mJ83EY&HUDRN0N?Vkk=qghPqObidq>^mMNma6~Aqm z?@UWHHzXHEI*?0&7M0mH=cEs~zlaYlD{Ou!szak8FNC2jEd^PaL1u@=6$|(ls~X-T zTkp_==1*Iqqi-K0#E7aw7u_J^a|+@^kCiQvIq7v-X(LV9PtyrokRLfY&+`MniuPcS z6TR-y&Pm~H*R@1c5>53=)V{7c+&m-bMoX^FJI=A%y}QpNddy$T9K zyMZ1sl8{G288&!wa&mlp9LzpIX|9L{mR$vtDk>Jcn^nfZ&i2&#QZ|JU!7(;&LaXmENu}C|%dSIZo^0iO~zD zJj`2>_p1tc15!(L$^;Irtes3B9<>A2Ps2((b-cJQ_Xx~1Fmr2Ui0a}UH@xnTU365d z8E#MWnQq==DW~ogJzYh-WCm=0x)i=mG8dMHhU}FzzJEVEC8y15D>j|zitwm4^L~4E zE3rb;liFsZ;x{EP6MEZsUl#>`fwsZneJl1rtKI#AtkY5#o7-x3WR zFd)a`-0J22uyXoM5A1($fr96Xd+A|GB8IXYftZF3{+j15o8S;(v+(wsHJ66snvkQA zlEm0x=ijq@^R>)1X}lT|=EMV=+x`!5w{{>0noe5+<;?!9ruz131L9V5rwkNWv6SCF3?OV99}k=Bp1#?h9ti2kK)nMbQwbK~RHJapI) z$cNNL$+l^jMRur{9n+@eS)wpw6#GJ#Cti#2CpH>S0yiA|yAQV#5<9Ds&TC)cI&sB? zEukSM#gy}x(`n4zt0SX`JwC+0VfU?_jykke=e@Y%8rGQ+A!5{VdXLzwZ72>msWPE& z8F_P$9@~$VkatHF@=o(Hy6N(@2k8b3gqNzIFL&X0txF4X}>$lda^}A z>Ry2KFI7+1hn6g;;!#rnHfVRb;cSdQP!$r86*WxH+Wf6Mt02WG9=m`+=1tmL@P50| zo4k`;{VHvFDLZ9E&Ec%ORf6B%qBFB)b}TQbxnpPJ{6r(tdEF5rwzS7yQJQT~lwXot zQIuPdSNy3mhqCY!Jqi6#e1e|D=RF79)$72vot+)flnIN7)TqYRV;1EA~vEs6vED`;4iM86XYC@LvAoc-a4$bJ0^C?k%U^)qNPP@xW4EH-}B za^;ANXUr}*?2DE@8})9pAT(xDRf$uXyl+vt<{J4_5oN~N!Vv>Ax zLSllE#OHl*SDdhLFvFCUH536%0y59W$K_rsQ5x}ZaoO?3msJ(DwMUouvWtqu96x~< z2<^K_Ztt&Omj^Ql5ToJb7=X)3bbnmw189m1o1UItvJ`oJ*BR`8_s7s6-&)V|?7)_A z#%)>@ZO-RtTXWHF4mMYPIhl`8k z?8r)Vx@)o^i3Le*PTxx!V_l0XMSrrhL&vD+$%JALwB*Ec-d!-)Mbgk-I_rr^<}-Gw z%w+t?)ydweI)1Mo9PHA1xo=!iSwIS2kX%X%TAJQ?qse_{+*6J-Np^f0X~(O6s-Q6@ zR0}7pRTwpS`K~2C-wU9PASME_W-q`d4+!$i^mGrP_?qyHowXcp= zUwvVy%Zr(2m3nN?9BVZgP2n;EI|pc2n(olnwoQam`M#KE@q!KTkfw}Pl7s@1jvt);?GCogW00u8>X*vNXb0=oN);X3EHpz4D);`Ce#B?dtavM0NC&5n-s9@HGl$wGxWIev}a z0>FB8pbE+n>2E+tgE%TQEG#yVZvf&gsHlps$M{j<`?l?XSqcRLY=|J-sDKmyIs4yv z(JmH?56%mdl>wO%-H^plXoTgy>&jwl_1oQ)#~ZYj$~0;$D?=FMee)ls2cLg_eD+Ez zW9LUDjhh%n7~d|%nJPrYH8B$^+{Bl`+H)D&uxWD+%+O|NP6Ao>-SB^}Glpo77Y{8Z z%@3sOrjaY)8<;2G_}F79paiTKRg*fzRv4N)C8ZQ#en8x1`E_z>J#v_yv+%5u0joi) z%~lZ=GwPd>Vvy%4zy_KQ(tG?Vfx!u8Ot= z_E93qYra~Ks*YUrO+bHdkPk9VfP+Ef>(`qPPe1jlNiDw;DO1zXxIR$Gd4a|7ThRFZ z`ug&MRCx~oa03p=9L~2NeikD`_)!PHVHe~SPmkrI%=kX;J`ga0U4Z4*2DFP#*N(b4 zGwWiMtU;}Z7OxsMcz8jI(JmOt(nXq zD9kA!>|t=dlgXNYx3SFep^2lG2W&mL-=sr3ed%J@v$n1|ZiEkd&ive+%LZ?AES|efmeW*Ivk?f7 zUd&-5Y7Lu@wR5LM$fA=mq>rBWnBv`}YtNIGtk%&|_;m0P%f<|d&+t(W7X4c3?*aCd zy)ZJmY&Dlhy{#T&&{IGCeU&kSRE%6W6~Aq8J%S_`Z%WmpuCYX#ZmZ!Y6Kr6Xn3T2` zI@KX?b2kFi5HnQll2e>d53y;t7}JF;i=tlL5PPzeXMG$50R2e-v{=nd={k}UgO z6JROY2-L7{s7vcl#rs~j8bv*=t4bYhVkwDE%Y$p_ZS;_4QruqhX)5t+T`kLAcAk<|@a`ai^3E7%X`LIrxU7}ZFPW6SQc_4c?awEgkXbhQS=NAyWh(X#)} z7GegA4dSF0l4{D{4l?LS|+5-RID2tUv-6C6yN+j!d(AmuyfYZVtTRCYPG zf>Hd>PWkX_`#{xwGwLCUuPkt;PaRDb&9QPT^Oq~pz8Zz$ciY2PVZ~!bkwu=^Zw~#r z%P;Fg56oVT20m}?>|5(HElyqkT-WeJdA=RcNP;qQaVLOd_?eft2Z6BjN8^`~J@|O; zIX#K%!>_*QK+=bd!^IldHxr?}e(`2G+RR+|fdYgvUAsB0dj<$5V{+YGiM8!{?m7(o5GOS{o)rJSS&VnA6spkVzd?}r8(ULjOQxBcZon-)k6T~#okl@4Y1tA{#_etWE%e^xV97zG zwoJ15lBYtklVrWRZDtgBn6t%o=({!A*R*+nZ z^ZDyiRyqMow^47b{HGjO>3adpiHY#|%C7Gp7ISYz*0|6p>heeUq;c1oevGANjZu)b zzn@L!)?kyaIyK&^cGXeKIGdYz**V>xt8~^!m;7l9ggSqjb?+cUx4rIs_^D1k7qm0#r2`{whnGyP6HIAjv3=MVu3QY$A`1^ZwvtD2l{b<$;8LU3%LO}lEBvu ztYQb0Bob22kIIX2cz?_%9t4Pn_ufT0tX_us9;=MDBu!}v6Wc`1=~MzP-dQXDK%M=hwW@nSG9l*71eNQzze4!>T3%g8DW?CZXsTyJwSl?9bEKMl&Pr_TU!g8w2!b3t=mGcYQfzGV|x*pS3 zGY2g$=4xaDLDMgpuiLdbii<7={w+Y*eS2`27tag#O;4XSh}-CS-a-1pYtRJ|rN}*3 zP?3ab(iZKlk;a&Y z=J{mE7x|c5YBxtoaH#=8zP+upd=f|uC(sPIJrIoc){rum6r`KAJ07a676Q)$u;^4& z&<N~o&G6mTWleoQ<~n=B zv5V&A3WZ*i6`RwOmywEgbxUa5jT~Ny{yrsU8UjRt;2%`Jl@AMHaIT7j(?_fR|L|FE zFBs{I247XYy?N{dB^H)vTl(wGhsw5Li><2T2b_JAFpu4fbR2(aY389cN!i^%r)$mC zQTTx@aIrIa1})9>t{A3&YCMFH!EOA^l7FTvwbmK?Hg3WsiX8mt==39vAme(iYr7r^ z@`IS3wuP9Cn}o$c%$kZyWU+^>myAWJ|H7Mj8e?a~h7bLEq_H;0tb}G~M#;;Yr+a&E z?E}sL%uKcCCy(JR!ncEJ0c3pNMeX6M1Fr>t$_cCO*Ofie42<=nHCNqV32l<%JL?FWW29$ch_L@$%h)QT^G-ZWjwkC%>J`SBDQKr=r= z2#Msj%GVVADhxlLed}7-rRE7z@Mz8be{7Be;-o}izDVi+31`e2If$-0m-n!E7QOVKZxQ!=8@9 z#qckP+iJN9rPR{E(C`L`W`WaqwGfE7(Kedl{2VYP{?%Z}m)NanVysk3W66<+)T7py z)_6oFRwg|^=ffLlBrRdp0PBBiW zei{KHvrSl`r+o3byA#kHA0#CQ-}p@ULND=_U3$*M{^`V$c`Rk9oc^L{IHZ{cElHt@ zcgV_G3*{q%J|K%cIwT$3_JQ>c1V-npyj(OZqe5k|Xy+H#2%ScDfB)gjSw=mNsyK;;1* zWGEltw{wU}pG06VM73nnT}eo1Y@CQZ8lE$$a0^ zl(swJS6G?Yv9c|*v3=ne2|Wk~Wqmy@5f4<${Bdpw z1R80>T2&`Vv+41BB1V$fThL*uFKwoWoHsK0GWKTYz6g??diGA3>m7GScnlD0pd-#W zpfv!^!P%M3G!Y)a9JaT%*txjqbvp1NHuzB?A?G(YSRV60rM4OYlIH8(ApTvq*Gtww zyRO+pT=uU}d;+s2>J}e~--^)ZvcG#?X}NRb`*r$X6&eVlwymG2Cf{)2kVBMaoKl=J zMn17RFmlLiEWO8i2@l*{b3sH^)6`Q?nfufHBxh>bULJFj{d!Y*+psu7G;jb8|C?a+ zR>8|D>v^?5$|)7!U4Yjd+znTpN~#zB;QqA>DGa@v;-n(}Hg+S$3DBqz(i zv3Fap$FC(vq%E8^m>@r7Td+{I*wpfWq$^Ww3U(L09*!KQJ9^e^ka>rrH))e)Xct{S zdHX<}{rI!=R7owQ0rmr&01k4{RO#1BkQxgCF+{&dM+t%8{ZCIUDGmlkZ|m{K#zlTl zTU(n8+h`^aO+2`O>(Kuy!lWOmZq*B9&6VUkS6RPHQkE=j?!?*CJLhK(XFM`;A$}S4 zw-D-5QU|D`UEDO6fsoOJcVTVu$dFC^R;jg9)@hbn?#7_D@}h(M(s%ck(G4}P0=mMh z8PRdNJV8l;G@BJaq#**@Cg|evK?hFd2 zhPv20EYD%5BkGPjXVPm>d_q~`q~Z#p;(Uaxd@hq;OigtY8GCF)Ryo$cS%0FZxcXGf za9ZAk^{kJ5S$%Z=mwGMk!(WOw$k9o0ZtC}52l<bc$!R1F1F!}Nh-phpON)_V_@gUVfDl5b&1C`v zJ7k9gLF<5CwM(O;qhqH-a&t4sX&*3JeYXQ0uE*YD?`Kq)cOMa#h%G9R0nJZ|*I6b@oKf8o?Vdxl8vlnsX(IYi8{W>a7^>?TD` zI1#hOe>nW4<2S~rz9<1^&}KW+(WT!&dmT$8ZK?x1-L}Bslt`i~SH~-#viJH2-(VrP zPuiMzLGK{vuJod*>fyM$=w3$^RTXp;6!q7zMEL!5Sn2d;E;P43dB0?ooDEGw7CO*1 zm$@xvgX*pXFF5`QDV~qkJL$?7-ydz6vDl}kWi@*4#c+MCk3ajn+6q}ARn5!hmG;kKp|s{jSjN~M`jh)HP)zyz z;mLKo50zx0e2`u3KxCe)(gR%QtWMhJQWBk<(h8wi(t|+SkDz9QCJ>A=a!T(n?xDdg zjs$^SgCJh9zOL>&`%X|2B5<+c9*0S80Fjg{TazYTST6|ac$FDO3`Znq_liIINYnm2K`~b?l++K zblm=$uq`XGs20<5?A2Bn(wi*b&@W2{pYOvP*cBU)xu`B-eP~~aq4nN@IeJg{G7Hu0 zD_qQwn0xQKO@!OQnX{XgF$7a_X`&Hgh2RHqKMHFT9+ z=OK0=0WX7w;O5kbRK`ewnB)|#+deZ(we`vfrnZBnymHK6oS8XeB^?YyHAs<#8T$n( z%a*NOX@mhOIebz6;F!Mi%(4S zQtc0g(*k&^i_2{|4%625c5&ou@RlKD$ne>11&;^O($nv*fa+zk$v{>7a{mG*&+`kU ze?!jyyZHXP*zj8@*=sB;tQ0z~zi-%US*7qh=hKLTvyg@Q3%B7u3vAh+n=a_DSRzoD zP#p77QS?UZG8pFV)gS_Tnr`Hq7!x)lV#|Afa%p3+&-)4voN+R71yd;wxc)M6IaAnm zC`90G(f`Aq5jbU&9=VxSDXEeW*ZcX%Yp}FW1T$^Ku$ui7YvJ~rupT|z1q&o*n$X z&MNpuqXusFWO(g0QH1FHF|3PpLjdQNDDPSdX-X=tn(U;`jU!`i9n0YG?``X7XX_y> zncGrlo!kU(7(DEvr)$ZdafQ}51mR=D8=W#?lxD6t*hQu$lvNAMH>WQ&b{7YZww9K= z1ttCz&41W2)6Uwe#kZ!4cX;ZdJ@5lt)Fw^X#bY@z@|R*aPv5s;UO5I>o&G*A7&NO4 z8%iRI)Uz)(z5bS0Jh)?{KlLkKL4Z>)T3YrCONLM-Ae#ZfBO?>}AHf5otf4W~Iw7J( z4*6-DE|P28thq|n2IEh>3pPx_{&%h`0uK)Rql3plYIPbB*%{O8yQfh#eIq18+a|t~ zNGZ1qk-c{xv&6={G}NYk6z2Tiu%o6H;xZ&^)r)M1?T%cTlaMeIa?1ugYSNQwaM1nV zlwq^D%q-AspnMUkSxu1PwNVh{_sX~#?`jW+elvfIQq_EQX*geA7p^HU-7jTRop!Vs zHM0FC1EunC-fo&!{QN-#HWI-mG{T$wPmYnGXZ>j>j!f)UHWpVZ+=nu`KA}b&ei*fb zzo`E&7vQi_7`xmgZ)ND@&|rtBE8uhsW~?@-c}nD&)x}^fz#O{lVefQ-gJoStMa)Ei z{{vq!`)V%bvbwekW(y=b{owHE9pUVJj|0$xutn2am2)Xbtz6-TChH8B%2hHrwsjo4J9EHEDU;D zAZrZ|N1Ul97Hj;X1hue^WoQN8yE0{?{F77FAqk$Dmu)&!T2OE(ZNn*R9840f3vef$ z2qZ8ZSp2B}sWXVne=>x3{jg?l^+>om9gEX(I9Q&^UTcoRo1Y)n2C#lE{A?F%foYj=@GB-9y81B;m%y3h^eX~k-YSg8|e9Lwl%dKMR&m!?WDH0*fY&B zHP=6*B*{80WlFhpAg!SW3vZXK4jG1I$FC)2;bWiK`L(R6AuN32Xk~gG z<}46;_yW`$;pcT%cvG^1(ohgHRp~+|qGOrXk&~LS5cKl<*EhB%M)sHlZD$p+e#30C zKD9`YJfriMt-xTv{CD6K;su^+U=jLfr%y~Q0BH06h1jTh_(G*WEV?1@7uHbb%!c(6 z3SZN;Y{7;7*sS!uTb&T1NYdvgE{T65^8Yk$7q5YOPvVL2uIC~KPut0*_^1z|6hCNb zmX(=y)r;;g(t!pgZ#9(~l;FMFf_f+?N7p(U1jJ+{rc=@t%Sd=}*!V2Kh_<2+L>0Xi zbVyZA2U{={uwbRkvJXA`3WCv2a+Z;5w_9V9atJ-n0ub#RM6qR#e43?{|V>`G~z3RXL=$t8a$y`xVe>@$CZ3>&M7K?ouWKL^BI zvavyYriZ!T>VM%a%q<9R(G8md(&i|94o0vqC2FXc1g;z9#NBGY3Ykzc_S0=!P6hTm z<*?6X`khw_{wCp(o{e_#Tm4VfZWPT|M(ls&}UGEoDhJ3rk42)7f6;O(Oxd{ zp!J`3>UrDZTWQEoRehVHicdkUrJxU!pfPuhf3IX9+=`yn$e7gigRzmom5Kmj)WoTP z?O*f`2EQd^h0eG}+xsZNCK5eqmOAmP_jD!c-KW zjQK_tEPD#>LFqZx&mX=!UaL>+Fvk6Vksc$)slz85?NU zwKPKChVxl= zP*tTMD&8d^>fg=qYx5$m?A;PFExVg9@j(8nzvxvxssXbaRo@!Z6Z8A+IE24!%gtT= za4(XKL!k>#JuQ0pYRS zSqNnBf;?p+kySWMi!!1bDV^A2u>eYf^-0KGetoOZ63fM5t&-I#5xW%_Lh_J?bH)Z2 zsh>vfuC`~2IjuC(;ShWJ?O7@mfaby3p79A>jY7d9J#%H3iD1H0NV)#O9dZg$pL@MZ z7J@-{BudJ2_gXx*fM8y%KkFu78-e1n-eIu!pGHNZFGv)mV?L`QU?6`#FgC{L^~heR!M#olC(Mw;<>e59 z-%(OReJTQipzx4BP*bZXx-p~-qqIBy-y<~>K&1}B1s(T^dn}TokLqd{-eDPr@ACu+ zAB!tW?=LL(bB>K^%sJ;q-@nT#TfPy_pW!@^P!GN6WpVu2@-}SfwGW1*NbS5Pxxa|< zcrqfcKff`9NydsyOzi!AkfZS}!scQGMQtHU1KV_*(PWycPVdsrUbvJcS%7d4>=Vn1 z^A2BO?ORDsu5LYgHa40#brt)c&2s$e4J@|o&TAbw7A6N=1v~Wn*JIR8v5ASUsP%y+I|-wxQP(d1b1v6=MrR9m@e)4 ziKh3~II=UdM8Q~==+r_m+F<`Jci~0bex1SpzRCGtDLuE$SsLn$qAM86b`05gj5wlr;^)Xb{Oq0M} z>@z*jjgDn(M(Vby%x54=s;90qm00g(E@-g9AlWcm?%0hQ8nP2DaFE@*+zd%QvJ6)? zwm9*-Ud2ZLHe$VkHzLodpr+SQP8gT-3#U$CAyE=?tKIh7(?F2HEjKER`W?k&7x2It-gvqYd`?UDe(Te_1V@3r;SWs{$cfm2`9?dEKQWQF_}Z-IdwY9}{zBDjx4GDY6+j?j z7++Kp?_C~x%i(B9#f1WJ>4LPUw-B(s6$juUyRcOYM?jo?X60??^KT5BRHNhoabvre zb_^>vR=s>Qkw?J~!s;pqR(+-Q?)259-xf$-K`P%$+OH+x?HBErQn#0*dNt}2b}^wt zAYT|$5cx;FuUfYDYyEiJ-4Ux9+EcD1C_g*Gui>}aICaHqFXFZu-Hog`SHuX9#E+ah zTjT#lASC+Zvbj^c!)hOg{e~tfQbo~n!GUGM1vBmT^j4N)k1rMX@hAgj;ee`*>>$vN zJmc|g3)j0gtkHo_Ma3m^)AGIh>|O8rhdF|J7M`by{g>#Tn#kt8zEy%o^2y@}6dgTl z-iPseRaFi`Nl7h;%T?;j>&2cxH83|k6ju%cb+H|Hpl`i$6od%&tFb-U1R3k0aBrok zu-v2Po2o6wu2akV_Z}H&EhLeJcakIqSp#A`-J!lnV3zEYs=Zmdf>D|hXEZQ2&f;qNT697AGZOk2S9M_*bQ5mMq@>GHWXxec^R1bzB>Xe zF(V-M--(bqLOj$S(y5Q_M8aV%_}dUTZ|F{r+{Dl}6l#p`kkfa0zghlbDd{mqfG7Sl z3J(E_pVdO=sDK`=j*=}H{x9Rtn{$c7HLT+c_(%1mpF)?aJz{LuM7TY4ZW~%8bY!oh zu6)hCIo8H+dllsMJ&!UTZY+wdN8J@I7W#iG42Tr@I*7N05PaCa;}veu6u3Rb6ZiA5 z;p^8o(20t9+Q^yu&ikA+tuj}c+1MErvy;kKn0h(+pxc{l3nlY_(!1HjFvNL|E0f3L z(sKhBN6s$TudWL&^M{JWXWnZga&^eh4ZF(DfyMauUnizVN=dG#PR^IU(IfWE61HCK zMZk=(YaEzEeNiU|6O)=8n?=Y4@X`hc!+||hv83`q!pNByru60DQ;38Na1^k8`h*Ap zORzxl0N*nO@UVd;J%HYQ^)vaiJ^*yVW&u~OpI~z>5WoX5pVMj#2oZTSP~`_DCa?A% zu7~RN4ZBazUVv^@Fa=&5JuQ_5SiFMrsepXipIDrV%GU|(+c|DsNKi)NVVM?Mgw}jz z%l>_>f@Cgf#Hp514UgU8Y2lC{C99X=16w$uGcUK%20j;_KW!)MQ`3osrPkDLe{zc1 zNEXj`;@?D=L56%Z42%|sLqdh zTBbKOJR;WwCx?`yTQIWxRs()N`Ht_?%IDb!riJW>PWkfoetU4vb|S;+-&?)`n_NogJ>G-NvhXFzG2 z5s+?>?(Pne?rx;JyBnmtyBnk%zT^AGxa0YsegzoWF@|vigpvBXx@rj~taL z(OZ>~biV2u|J8}>T|Oo$At}aPTS-SpQO=3(&-;;$5i}L|XGtJy%zx)$vD)Cj#rF?5 zUow`-8Rh|cH#$dx$b|_S$iR&@3fRS=p^(0S%a2~G380JBc67V}O>|<7qf>yV4dkmg z{X1N!{~a!HS;>e`9dmJsXIxp2`}{yl;(f?N^^&x+Z&YYTN%2fs67U;%eiDu*yvTnc zCqU-hAI{wjfl`gM*LCL6pz?FVRB(K{%nQ2ahY5E&2JDNT6xFZ&%Q!!Jycp$2%<j9$g_RFLeT9C3TbBbXSZ(}^)RBRX_wj%t4;n%8oi zKK?V008~}Q@tek1e29?(<#}$V^Zg~k8}IlE^kc0ssGvY!QZj<1mnFrqHdBKRtFSG7 zB4Dsg{Uw<)%CT!{g)g=LqmX|Kuk;wh@yZ)WT8e@ zn`*~jPYocI{Bt(p69Ur;V4CxM2?3xCl37h6CntdItoYw{exn{4d8xJUIc}GijM7yk zM7YXYoV8?y8v8&5m6#Qo&6CJTD&bFU`_I7C&zH{Ez0})-F(|4GE(D4i$9N1}Haw(3 zQ?BvfTWkb{JM{1Q*8=&kE)zip0xiV3J8V3WQ}6fz1Fdm^295*^O7RyKMfY3n2E;3Us0=@x$)6$ zFcw^j7)9@Wp+sQDmEvPN(jJYkAJbwJMQ#oaK7xviwgSL<(?_iB=@6U1p3Td9?en~y zo|yr%5tEXz0hOjiE4TzQ_OD|;W2jiJ6~LSVroF&H(q_LWB_;;*v%9Lc76B3QUmS8t zNlEa(vt{SMhvCPRa#M~lX#KI1$m@Ov7dL>$j#?c7QVTW(R}t`>H9?24GT|W|d{n_L zt1IKUe3QmDsfCYpri>+qr{xnayTfCt?#w8v1Y(=7uCCC~(O+L*os=-JBb?Wqsk6@% zMQ%9!`?tcmotX4j5f!~|Gc+j~pSKL{B#}Ufw^exDtEqFN>MfhmrWG$fZ(}mQxy!I} z(wL;AN6*c&4>*TzH}9lLTSUZBp<^Bz8=Rrkff|>Y&O0?EZ#Jz1;k}Hd9=q~GW{&juth0g%|Q+DLfA1XS!JRYn(%;Mr= z02c_vD=5JNj+Y4N@WVuYN|AR_LT>wAz%)t7%>v*(z~H>K-kaOo1t50F`_)~*|I>dG z9mszYolkHuLi$zifrWvgo@$P08mkoWp~EFvoo*&ZWi#S(&t};HSZmv;&>-NM3@~yk zoc}I5bOhG>=qCXf%sus06dnY;R*RM#lCl5EKmmRA2)RJdp1s?>=Yvft7Xk7`C$Y6{ z^Xk*n)74dCsy2XxN5E!CXIXrcx0YXx!?qF))FVx8IY15AIEtQum??9tdtb+DI}M5h z!%Jhk$AX)^Z$p;x>~0?R#`;~#3rSu&k@3EW#*z$^TLC2`x-l~D=2Y79ZXc{2XO^g# zfLiPP!u-JI%H!8puQL=v*(N96T17#`_VOFh=3R#6n|?CS7^Z;vFDw1LPn$bTtL>aW zg~=pcwUs-_$bsgBe+ymk426r02jS~>$+9Rc8Gh=LQqVQ^S0qd`nAf4woIna;-EdUB zDS1^qeVcLPS|GW$DDs2Zhd@0bdk+f>t4(g|4IbJIismE$DB2nRb>~ICkIBe#|5T&d%L3Q&>EoIwueqcziPd5Q*Zr?6JAOLutdy z6_Ahsw9!)aRS%cJsJzde(SIVQ%xQ@0+DWj zxjq)!&Gi)*anQJoFbEJ#P1B$O#XKMb1pR-Fp@o%HRcUExo{$^l6%(J$bRE&9w-d#@ zt+o|vu_Nzsen_d$EIZr5F@OM71_*jgHX4}qU)#P}MkVCJOz@(84nKtM8EIw0L9Euk z1TMrt{vqI-@sYjFY&kJxO`AE^%kjn+27POF)!#U@tAL@P8LrvOXZLxd=&*tPHA5O2 z%A)xO$HF<|9jE!UFm552RgV$G%sijWyV5%}1r0j2M9LJPca75=elD!2@7+Ns;JDYj z3iBiKdTLcCUvrnz1GfcT_PV_7m2TtKBJMWD-@Iz?OZtaw2Yk@>G=hL zIe{%-oSdM1niG#^V79naG#4CQ@4s2mlY@#3s>e-CUJ??!w(H(T9unYAjd&|BggBB~ z4}a{I-p`suYVPUlL4%6bAAtj-?$E|)c0{POpn!szIp$a`T8^5A2Ij*DK&)Dwx@hsU zL7*iL9^?q)HC$5tPexT98z4&XWr4mEh=8G*WnVb`3`eTx`Us#R`Txv2E`(kVU$H2O z-_+BVmwCM82qg|xaUKgh(Un^)ad+pz8`YIA5Z5lPLKMI_^4wNhv}K^PrP_AXA-C9W zeF3JNjM@>(-b7YJR9BLhk4Y2jqh1i8Ib~1T+pEI-gMdZK*MtP4_hp`;)o*EITX^_p zFR!Y9YshoIg|n+L;CtC_&{2xV1&XOW)$-vX>2^3`L^gg~jiygXYB}bUH3wRb;fRNF zRybM=*dPJE5;u4yL0WKAl7SP`(CwLz{*T^au zkd+KMJ$=6aa*6U~QhHCLO$YIPf(eC|JI?zy4;qu@?bHa0uC(=vFVXR^4BcHVC*ab6 zHoKe&j{%|L zZQP!vE>*=DoUCZc-b=ts6u|PE#5G~;(6Rbl1}u36aMuZt2Rl3K8^6*b(eyW`+lg8# znSITuPHAZVmAT09bm1>k-Jz+V7`IVvRa0Fp*8MCsk;3Z?n5i9_baE|G&a&92X97p| zGMnQ0+{efBebT8bOKR&T2~Q5XcrQ1|-*a9ng6&W1`Yb_*YYS=t3x}ZCO|MqXM+Gv5 zyok$3R#MUgu%r!RtHIWFp$smVtk=>heLc|~6rFk(7=?p@X$1Tv(G=GAq9WjM?aVjw zlO`T;3e%WXXBJPmkq4{jKXLA`ET8`RO8uP4f5`TtCkxSfEi?N`9*$`1cL9~En%cwe z5PFG$@Y_$lPag~Z>ci{tmPLybm`yDW{fGmv#`y{; z=RZ;WcXpUc#FmwoLirM<(!ef!J2xs4brR97e}Lr%OG=%N!*c|IKro7?tPk>2M15Cc3a0H z)?$17nK&pEpAxm5Gu+rr{!z+4blB=l0+rq0veXGyxa-_U-)r#A>E0SSPB@FhXtKJ> z%|L8r$}}tUhY=vRt+smsV?Nz;_A^O%WC`*=iO9N96O%a#0*atQ&w^r(D$J#}18pkxiNM|Yf*Rvwc&Y^mqD1jF|Z%)3VOFCBTP)J}$iqgee zN->hC_fXo4A&-3{09vwW24}M|-(X$=9EQz?b6o;IsW~Ey0f0FI z$~>SA*#f^pMB&LCA|1OcC`gdcYN|661PWQ+BL$M$B_V~Kdv#&{+tE$`71HuCiTakB zr|%wz^|T>H10UF3Z+{)9sVl)wf5Zwx=s5u-z+ianTw(@IHv1#Eh4*Tg4Lz9*ZBW-l zJ8nR`A(@BVQjJz{6Dlm1oqV~*+4s^pbIsDMhKA*m`g!I1bp!}uA&d{AN*K^ff7a6i z!1vxheHx{~@P?l@HhQnUu&mGdCErELS zdUlYhjX{0GU-m$4Wo>!c$ocPci|ajLKz$TM(gdBn z4~@!jrB~zZ%(RMfg_$KiRcV4F9o%6NZPeeoEn6;t^b{NU!EMjUIH$N`PjO=oX-;O% zMlN&3 z3`OJt)zu`&BIhB{A;W@p4|`6%99cg*Ougtu2DV7q->3}b8**te1k(a^07_2J2U|)L zO70c{&}=Q9P2!p)UFXW|;~o1ZS0FKNO9t6C{M@kP09dn7h?SNW$?5}M1XyqHKHJB# zSwVS@DjO?>*y8kpt9pv$VatG2L#ectSHyVWYF?euW%i~DAQ z6|vOD`6PK46z0SQU42?u+vfBBc4o*4Yv8RPt$~Yzu$Vz$z^V;D@VCU?|DyJ-tgPm5 zN^1~O{quI%r*T=a*0*G@XIa^=UwJ`%9`kYbr4Zu-h%oe(*(#oK8~H0So3>w#>Q8Hq zF<~ofnx_T&_15Y>;lK>q*|jDYvY^^@4;ZRrVJ>U>wgLUThGs6%BZM1v|2w zsn0Jn;~JNF@`|J+XUQhj>F(m{JY9$_#5u1EQLaTjs_r-W6a2?9qvZZbwI#4Sh2D?a z>iP&;taHu~W8RX0h>4{^!6HULE4s=}qN=n)&*N&kAjXoHii^<7HMRws(({bHa|D@C6YfEIUa9b>g0r>3O_-k z`9_Zo!{fFo0u~3UB^4DI5Ji$xD=B-!sk58r9<0qrP##C^Tc ze{;~J@pC{>uhb<^itp6Q$u1&a>^zx0DsjD8-@;@&gFJ7doq(6oGpX?IPP{AsHXqxLZJxFQCL9kcPa_J@TbxRU9hGg!GZ5Y! zlp6pE0R}OX!n(qG0ibU70+OZynjZh3Z+`*Z>lngYjskUu!J6o&&;B=`r`>7hX<6I~ zfzAZUf2YQ->xtM;ZTdz=6wT%xeTOtQXWUre*x;^koRou|ubO@S!^HRn%%|FZIOH+I~7D@?om#tWr&6Z=OEY0N39`pRsxqH^@Ou_Z_H zt@E($;ez+NxDp$y_Y>n`KTWe-Sha~Om)hB>7tj7CH)%03UCEVqlW^NXd0Q?5hNQy| zdr0&;dw*z9*WdF272TH|_tnchFS!N)T*a$~o5#nn>2lz;@pCu*m+sHnq+flcB!YaX zt@zNwFPA2#9i2AiTFmazontp<>)i(0kp!&{kM=x4*IS7qSXeC@ukoeJ8XAI6d$T_f zp8G302pFmXww(Vkk7UrbUI7o@-K!IxCNBd;w&Z>+r(022Vyc3uXn!2#;ZbxOCo8(c zYGPyK&EK!QL1SxN7Zb$DK3kZ(q^oeB@=!iQd`$ob4J5*9cqw=!DKRu`XOuA%X( z;~ixiuGrpREcXL6G$Ia@Z}$(7kfMpS=TgSQRVz|iCJF-PdCx?4wAq!C#%x@=G>YJ= zLl$_;+WK;BRUd(HOx?SpyP{$JtpV!Q@=8bPrFqYMeD#S8?B@4(+qB7ZRZ@?D_;x-|IAb$)?5@*iiV~r#RL2KiJ+t+1yF|kxZ zPtMOLZcFEDmlG@-t;^&1T$e6lp{U3kCb(3kL^%8r{sz1iYmu@OiH=;JN0s^ere!O$ z^LB6Z29ksRUBiF35P9fnX-k`$)TXOFPv6FXGIql5!phh`Xl%PItJ&*y$cW+R8Ibb= zedHlQBB}o3NEPSuQ5bbdcnC14_Q@zJ+f5uFZM@hqpEaWt%sZ>8qQv(?(X*8c`gd(eG_nFvoFnT`uJa4u7gv;kKnqD?ZOU)cbJpu` zSdZgA(KeoG(BETop}InE6+53Iq22{9ZQkE~T&}Xn-d)hkPBaZb@4MK8vX?R6?ER&E zzZY6yV9bt&ES{VgG6BmAph?8yq0cBw8snG4x^t3p zeEJpg$?@Z!m z^hIyr0)N8u?9hO$%!^b)S9sVo#_!uYHK2)u``3Go0l9H6Ur2xDd?9oqyKM#z5%rH( zj-bOIVK$ed@{!0O6UJ2=>+>HhOW&}9hE5HEKPg&&4jHp7(ao3o)T&vogEc=jJHK9r z7q3G!>~kS+6Ss6*oXn=}1^{6VwY3hE-5rW{j1@P|k{0S0x$gCzw0Q-%Sa=%Jd@q15 z)b7fiww99YH!v4)>0f((p8xp+du8dZ0yri|7QSiKIgZvN+@qXF?%Wh@7nbBqtq(Ol zr!128`&`h`I~jq#>raYehx_Lc_@*D;y;Ep^mANE1q$kCD&G6*pe6+S!OE&3C7k=}e z7g$eJttcSob}uY0-nr#iU&jJPt6VBH1)YB_;_^0|<}+$pJsb7cWdPqKc=H9OmdH}L z)1QqxgaAu><*mVlJXpQE8y^@511zn4?#vM|e`n(0ur4!8-Fd4=1!#_=&hyK~nm#;@ z)8jJ=O&(&XN0f0V4_>?c#KO@6{{URjF^B|%3tl`0S*g=Q_$W`qIbs_*RE)5oGyU}0 zVR8u&mlH>QcD9Tq?3sd-%ys)LUzT5D9Dll8eyB$mMbOBvb#h9vC?X^fY>nJnaT{Y@ zm8&RJ&mubJAWBqPpuyr@@-8JgX8RIm*ci9V`_V7h3D5Fyljl~XI;K>Db3wZjo8hwq zUhnql?~H1y6-oWyhD<_8ng0#Gz)Fd@T+c?wewbP zbWwc>(BZx;s5QCB63n{W!zL4pvd?5%=Qj1F`6qOi_yBI^z$%ZyNLlD4pA}|CQ?U21yMn{DIIam-azuVf;p{i1|`yu^#(J^Ogyr5ja5+jWYA{;lGO>CM zecETd({|r@aicc;U3{!xvN1i*ga0l8RL50%Z#am(0GVCAEHi%NvKMeYuB`B~u+&sk z$ch9Vp6HlR;FYB9y9d(%OFF;W!E>{q%TQ5c%kgPV9#y0y8l7+S-|c zj`wk>ut@C}ceQ9%UCs%bU*~b?AfT@ZH8iNarI4V#wgVUzxGVq7hRRZ)a#bmBq7}{S!?u3Q9Xr$DQ471*Dzb>N z%}5vWPUZpV?QwQyR=_JiJ@CwXWL^Z6p#1LOSdmW|vHLu@3_9-rEIT^a1mK2v+np>@kSaRcl zNRW}h!5r*F#76`Hxu^kf?*7d!EdUH`dUm!hVNGT7ML|bLfR9h>Q2gkmFDqr!titBi zczc4J`wLFNFA^_E>M&iPs0G4SfTC977lcY+tE$}GRP-WPb1C;vG?eeYGjoO&Bq(i@ zoHB3ksqYXU*OFslWHnd{^CV5%W|`+#K)?@Q(Zp3l^qz~m84vNV#*J1)eO0*t7) z)jT{)g^HQsYwm~FWUA92r7#n4!jdBRovac{3q?5_^=q43j)yNsJ_Va{LHIf*$o_aA zokyM6YSP-C%GFQz_du#apZKJ^Q*Iv0N*)xkJ=Y7shB3OLOz%lM~uigIhBjV+!Ne5JupwRGVpI*)6Pjk+LJg z5C;20lNjD00LYc#|5|KjdLzVafv;e~;P6dlS++Wt;Im-M3XCzJ4&C364A7h? z=6XB&?YGTm9ks$!Tv~c^a?)6{vON+fii#~afnC;ljdEI9a+gzc*Lc$S3+MYiTS%r5saMn#D1cV?NKzvt zuY=r|p1uhnP86o*Lk_O$9YM**N8s_F_U_B`)L<}lZ`ENEJYB`#=WGNXgeUsUCo#oS zEj5DiQ1k_L0(d2-Jj{66H8=aYqr>3>EC<^5pC*YF@9bJz8GBO$fhvd2r_i8iNaX8H z69?e~wcy#(1C8*dkh-8>pdT0J6b)oosId~V&=I!KzVYEbeRbGdr6|_?XbY>uj#JFR z87-zBo6sLk&MivTE0o41OdiM5ay{*)$Ev4%FtK$@>8Gl?DcMmP1dEa+XD-K0=u0}T{CMUTSZA4*Kh-u zq5~Vx*3B?^n|(j?(lm%oF9S-E_E7qL<*V}$D-sS+d=jUM3P(u^?J(_d$k}gD7v_l2 zY2)JZAyn6^i71f6jfQO_fc)&f(Jg(yXleaB#A*1nQpFAS&*Gp3O{6aJt4Ih#QhI#5 z`O;KM_6kF$3$|rjvLr%w>5a!lmfYae-wqE5z?6r=k zsCRgvcbe&~IF zo#14_0fUBC5W1Mq5kBCZ4a}@wqhx+`EEEAUQBI|se73r4`~BASG9$BRUd5vB7wc~| zz8Ug>l;Y>0d}SLG&~pysXtfj2W4R8028nhXz=Wr7I$b79)L2~D-`66goWp{oq_#(b zO)ZM4XomL^W@p*oo(tcctN@$OfLFQJhovHa{8j|Il16&z+bC0EQA7h$;D{ zMK64%jx$jQaQ>#|=I;)gv-u9iS#*d5Y_sR3o5Hn0?k^YLEPH17B*mBO=|6P?kn85S zDY~P4HN%~kABeqZXlOh<0pI7%jEw;?1qCDH1jVAsRSszwdhi*>zlqw*` z1yVZMK7Y=>7r$@-?z~DI)4~YC3+%pz!+}Ec6?Z&;?vcS-%Z2en_ou z#y|%iJLC+IYqAawpK;gk7$}j9^sZvp2mjyEN8ZCFl@wt(xFI$Q@_$@aK@xy4{ygd! zZ^fG*!{biu$)Cx`M>TA2y;qQM^R@Tv@L^l4`WNNL6)4KZ`#NHz)EBuw>exWR}sn0ST9#nB=56q*&x* zGWLO$bs_0`KrldG-sr}Q7r|jPjNyRbfLK*{%Xnv$QGEO$|faS+q}O?MzgY9ekS&Ei2sjx@B*~tv^-qaY&t5?8YcVyM>PQW z6!p}RxX?T0Bl(D52I7)H#t3Or>g+))w*auK^3lGPCBNQNGEcrciu};6;I;-?NM+e@ zLSC%Fzl+m(#ton$@P`sUc-w0?hQG3C5@pf7?dsbwAaZoz&OU;7I}FF5!T0o>}sJ63zmh zz;uQ1zeh~nuPI7!ZkC&!Q)PazH;Z1AKtL*N5RGnt#!h+zT;+v4A2?3fv-|siG+3g0)5@8{z1}3lI0E*{5H2A`EtwlS2UiJk~-yz_s>5u5_ zaN*z-xl}DqTn)Ewu14JPv2gjrGchlAy=#A z-a}S{)}xA~jQqdzbMoIMRO?UDP&fi`dV&qmpMi#oa0Q20tBTB=g7|_0yjaX<%Jl|@ zuK11=bUxe(so`O~I_3DWdbWOBF67UPqapISVq099N--J}<`_m=kSl0dWyM7gMNOV^ zZCtTD?NgKUb|-FttY2#Q(R=OJRJSHFQS;jJup>L?%h}AONk<0Z_L)$jyc@OL+cm~x zGk{b!8GmPUDlS?*SQFGb?FR1g(7v0+9X-pRBX_bL0@G!+I`=m95j1-fpXSli7y{B5 zme~wEoXr_Plemtc&8mLK$kQV|+3ZcTl>V2zuM%izGdiPcUYm`%oN1aV6)l0Bg7s1LRN>#)HVDG_E|Pf9P=}6?z7P+I2U{}$-oD@?+Vcf z_$VL&&w1O&e#D65Sdu`p&gS~ zzYhz#0uw~5$A<|i71@X8c2T%%2~-iO=yylw*mg!q!8$nqKN$b!KzS%tOtZ_4#(~8h zTq=o1KM68QO28AC220SOszn0O@2PwS?r!|B2nafaD{LUVwj}-ccPao{2##I|H4r68 z`T==X25D8Uky2(OD;n~MT^zK|B~1#)S>A*>>vGK`xvnQ| zodx)ed=G0w%ffN@KpepTwE#6w3u#lkMW8O@u%oLN=3H1%*K48Z%SJ#iIYS?RYMcH> z_6Sfkp2I1o#V_fWUm-_dO>7vOr?&p=u|-^|=RY1VKX}=wDo=3xF)^mD*dQ)0kfT85 z0Lf=v*nav7@%>ZUXykYp?2ZZ2qxGN*W$DOCxZ|t~15#^~ zU1q1^23_V~m|IEF>hLLFxr*Yx>sb>)hosBG{R3y|+ZW zU>V!C_V%$cqenL%Ue>8~*k!dnergSNJBJ`gN}$DqiUSmt{|%gNB_D@A`IG#iT|OT6 z=*T#?r0xmauQ3d-gvt;bDt+tnl-Sa*St3bDKnJ0s-^Y)Td(wsX+u~LVu~I@pK~ZB2 zuMGzg6YNvVnt!}XqYNKldU*4+bo*MH*ZZkU^W=(iJ5wg3`lNJk@cO!RE@8JEsUD)s z>-Vn?KbS1uQ6G7~o#d2SWotUlp`DCpJSWQ)ZyaAuL5rO4z}-znNx>YZfPmt3IFIhC^Rf z(O9W)I7Yg6-qQD230Fl?b5VbzrCk!P@leRqsk!7!f4 zlG%~oc_{Rd&d<$ABY~#1I);*=-Ew|lb|))F?3wCnK-o6f;?$Y)yZ>X(7=AQpn+Q<# zbQwEj8ODDv#-KzABU<&G&GQ@7@7!>6Pk99?8slHTG+5M@3%u*~Fh-$gwO?!jIwDXP z*2oViBcs63nwOE`z^l|o)s{!4mBpu#ZhY1Sf|hG4T|Y6+GyWInhlAem{1d{6z?~#Y zQL4$q#%-~ zYG_!e-~SN>1%+XVKLNX$#z(Llux&* zJsaro6hnMZZMa3@eSKBWNpcQOi zo`!gxF5+d{er=*jE)X+(T)*ip^x5O1R!~(@V<-E&e>br(jy$dKwYS3EqNz0^Ceq!@ z>lMg!c<99Z^(BSJ>3B7`89;-oBf05rtaw&4B}#w1PLPFcet%q=o*(vpeF6e*5$q<= z?s-_{SAd~AAMVi7hRn+FxyU1Y-UON9B|i zajr$|f}ErV%)7)XHK(`WPJjA*T3%M`v~KUXy+2W;@Q_2kt*d6$dhVp2QSE z?@f9VTIyR7jy05enVAhRVd&tP5x_s%HRGNi)C+I)GV&VPf3%iG z1z})gqkB#;)HF7t;1Yi+oZ{sg&1Ga5Oezef+8W+=20m4PDJ%CXtSf-o;nLDl4p(UM z(9qBr5V|-yS=Es9IcLI{!j))kSPQ%3Y!H2fN=d6_UFTDP4H#Za0mjDzo(;%IL(TrL ziT8w~<4x)rUkHfR3cfO1MkcpJ++&_M3;<11iCDy2+dk%|3{9#Ay@9hz8p^zzj9VcYrlzF0F~;-FG&G_%AQ2jyWtLmtKPpYV!T7a_A!re!?7kLMv!IM)+V z=Hx^}g`RhLdiC?oD=>Q+PnU>{^knl&e1G^}X_t9Nrd@`z>RBatmpQqSH!lmHxA{*LA?Hi1SkhK+%mlnnzK{J|6b}q?6lw9%wY#Uc;THYDlL6i-q4zxRFGfM(o)t{ zQ&&})`}1k#*d?>H3Ik#Rmlf^rZh=j0q_uMeAB54fk5!L-8ASejP)R|9Q5O=LOoB<{+u$-*( z6YFoiQ-dQ@a)SzKo0roQ%FOFc_hXJvVPrFqP2ZIlEB6wD|+ z6|G1(IWZ4hAJ*3R1qB6xIb-$ZnJz1kI}JoaD^kV7s9bL>nGh=pV#-Ck&=4;drG3DA z8VAB*p6|}kUY?hvYm!nnB}2UHn75e*b3azGX@AZpHB9(t3|WcYz|qo~NjdT3((+sJrvVyOoN0*an>IoiLrtPT#$%x8sq z$A!!*6Xg+eDe5XtXP4Ksxav8k1%P5fBx!yZI&JI&C>796R)?Ud$~LvM43CT)uTbNh!Cz0`N9)C!o%7T55Wu zI5nxFyr3{OtD-#f-MDBH5S)ZNZ8URB+BZSh#?35uo132$S(ulW*ictm(G{EjVXQ1I zvWS0dL2$7k197RMY7bhnDa{gE@wrxI2Ic4PCFy#pE30FoqbsVZ!GVB~TY#_yAa6jn zxonSy=X1{ED};9<$F}3-(#i(t?7i^l6u`VpI6Vj}aUmrn_3BB^kcze2;lO-Z?)v@7 zdBX%84H$%O=)t~B`<#-5N6(7@(03#7U!(QLiYrn){F;b)()c=NF=#>>Oc<%Ahf}7D zdTM5qQ$}*Xf3KdAF0D#bkdLk1d>1U$e`blqw>HMN`i-96k$>#TBlY&(?#mBlhm-b~ zSo{f{x@w+gaQ9v;f&a*7I0j++CM{%PH0W;fU|9eOiguRanX%VU>zaVB@HF1@FXLli zF#TAE_^@{<#Mc)DYSN;kH$rcr8MY7yZjvQ4Q@7=3vB-s#I{cgMTy%#+x9t0emf{lic3dlq!jAUBDF? z2TnnI{CixHT(?LGt;!Wv6R7e8Lgg7U*oMC6?0g^KW_`@O=u}N&)LJh~Rr-vS?wWP{ zl$doVo)zNuuoN$>6IpNq8=-N!-^jzvlCKpocst9v%w>ugs3%w{_YAy?=Ux?hG5 zU18KG%E{nJt^fZq>7iW54b5(NBG#3Q>`1ELanv`E&eGC2gHRTI1ff{O1`G_`U4;&` zy$s(BlA9fUII~GlvgZ;Rm`TEw(>)h-m6nm|UYnck9h+SnQ&N?2^DljcR`u{k?%P6} z8!Mj}ra`Yk(67~D+F+%sk04*O%2)&%$fPJyB!bcDRgI0RN=kH=ZjW`crWxPdpXbWcWi)6cEx zx{eC}Oem2naY5AA)A#q+4~V@Yi&xIEPXai=rGZc$+w1A^qN_HkEuxXGFW4Y85#FTT zHg5^$F4y+~9iN?B3AEE&L8jBOzJ5XVFc%*m2@>Y6qTgNQ!8uoecj_gQ2)la z`8sInZlSr(-P+!HYS}=3?2NzJ*_*!7a=Wj5JxS(o$R-*R`xx+hoM;_q_(RLWR;T2u zj1BCVf=9?^8anL&fzx=*G?=eZg(oX876(=->rvRzjQX|8*I-KzF2N7 zE)rp9;bLcn=p{F&Gz6s;rxbGp8ekCgG9eB!zhwCUB-(C3n@G@m=vb0c+|bby+R-u$ z2U{w$`=?=iJZJf-u4noW<bF zW9B)*G5g`OYd}Ydl#2T8-Jv0H3#5u6OwPI^nmC!OJH;NtZGcG@r(@!;^;*8M^HH)~O#< zz-0ex?)UMm4wv&;ZN0MwSU{}Yk(h~k@2J1nbyN%cxRkoSTJ_i7e18Jl`s1wM_ZVT~ zw-QTIF~_NoCAksm^8<9WPxtL;g`2qr4`OsE5Fq3v54!#C^-@5dfIZl~(v1N+S2byS zR^;fGrITw{_TG@68CF>%ZNAboD~)DN;{Yc>oX3?%KYpM5_{}>w zk?}vGzA~!H=Z*Fd5`usrohky--5mnbE!~ZDcL~zn-O}CC(%lWx-Q9Qm{qJ3O)~t1a z4~KQmJM-jz_Le|nq4}=5H7!o}`gkkO``ze&FoJ9=5Cjm=c4Usn)2M@v(8%ERBTTOi zUYPQXa+305cXZfoBQCDAy^T&42bGN0&eNAG(@wQxFgc;|JS~R7^c@0p7kNF;X(Q3F z_UBiBt+EAT(arPTfZO~Le+2!dB=z-@LU4V{&yge28a;i}EH2}^jQWIECwwQO1zv2H z)fJrV4tvuJu|G#6rQ$50{+enfnV?>v_>$^JSEC=dA>glZQaNXqXYHk(($Q}5YI>0e zEFb8;LZ-a>I>+sTM{~Aaz08%T_c^26AcNcW;ePt^l*6w_>N0irh`ndoaWyO!#^&a3 zsS7|4$_L1VIVPJE2$qKV9(02nOW%t}-(+BWHQy9Tjtr-BEvRdSU+2;`H*K_J{1GEz z+P7ugZ=w;!D93P7DV>s}R+7q>OtJ+OQ~*5>^pdl z?{Mks%I1jeH`icHn&ceE8MXPRI$0v+0u=vYi$xUCmIvp2>PFN}`LZjg+fuuDmnMk+ zBWf#F)6#$MoV5_0V8A!fGYI-+oo>pFZ@jg1{G|VA zgkrPm&dYm04o~DI0>?8p|8-%2Y-LJD^e857Bk+eaG{2I^V7*(J5tfn|Cq-1|I(vD+ zWZ`cyU~+I!I-Yno#^_*F7Ut$a$edqLAi zd~N|}ZgC$lUMAw1$HgPIF*M1ZV)=Go=t!-)$xDbwNuUv|U?==VgH0g$@W>qxd%MYs znXf3`9o=iC+cALLxX2;0Lws3zmvMs5%yTM$Sf5V5bU!MK7EOARx4A6QUtKqoLa@&< zw`z17D$tdGXH051z6pXcu;Z=V2lg zGJi^#|3Jm?5NV!vHi z8ot~so+NcU=R;%+rLfM&B4Xtvitt=!kc2I z*U8#nIk9}E8Sr169qnreeJk~Qv9Pgcr^WT(9D^eBL{noru?mQY9?K~3((uln3;=aa zE`j)fi8{GByf?|u(ElL%29tb#Rnv8Js3GDmtsC}&Le(X22FS$!S~o`XP<<4yYRD~X z$fdpi0te|EFHDnfoVuc`W;+cj%PHp$4G4jpK85cXs@Es9Ap*SjgyI%a$`{qc#8 z`!#oqRc%u2;?&gOH~4fXlj5n&9UeowP%r^=7exFbE*!i!r~645aw_DNk5U!&Oo;^h z{Sp!tbEzMlCY}C}wH>p@Mr$+n%=ehr6pO`RyeLZlJe^eu(ajW7Dl|1YasZ4P6y>J( zy0f*D={M@wL`K=Pt@7g58;t&-tyheVS*b!CeUF0FhQvfa^Ff@E_o=(7EvHGmvJXOu znZZ332g@Eq{Aur->#ohwMaYjz3`v-eA3oGsE`Js43VC_+FKIDbRH97dG@lm!_g&*6 zlElPeOk5cQ-lSI4|1irQ0x;h_(uN$*(u9S2oU`m|zOwJ3Syfl8ji-L4jQ#}n2!3wl{Jl;5Bi{^OIY~%7g zIm0o=FJ~y*@oc6Hrg!$&qP?JH`osn48^X}J(w?e%P09PR7dr~M=vIKk-!o0cVWY~) zcfT7R+$yyq7hb)}d&sQBy8d1|q$CkBHNzb8enAU-X`k*y9F^yNHY9$RO2Kg?lJgv7 z`)@5)KwiIUbEGWH7YtsQ+`~7g(ZJYe8F~u|raDkLZq?9upBMK-u*Tw?9xu+e;CyXx zhIgrE-@-GtHn}jZsT&Z~1IAj)J?rNyP}bE{!#;a!Oy(T^;u`cdM^c-}_Z;Kr)CWU* zLhXF%0szp3{%4E&LUUoOm`~&wWBLbF`AR)eUqjPGTOq1V&n7^t-osHT=pdg?m|o@uwI2C*q=HwTsSfe z(iL*p@z5Nv*s(Sr;BMe}?$YcdCnt%0ap4E>_}ZY%*?bgIOw|D z92fbUAEn;VDhJFX-`ab#r3`CUuRGhwg|WjN=k)~C9jSk4TSU8_92yszeY{fM@_|m{ z)$?Xa=;HarVuapF{ijFn4;66HyTdPD=&`#Z4Xj$q80meGEpRT#$-~cJaT|f zgSIxbd9O|8ru1K}&c1~Pzyo(rN4}*}BZoh-n|BC%aR}i5k)T2e43X}+C7tgKlEM(x z!|5TLTWLCet?2Up2=ib*4ev;2!_Z7|b>X>9;w-w1{4L%Jl7R3QH1QuJJI~d(Ok@TJ zBbqi>SKqh4s1;*}bJpvxr3UeuQNGq(5#G$>?p$oi&!2ew`Mw~+>-x^vr^(ff?f@?# zyDz~555=Q@U(m};RNDItexfDkP6Dl79|@;< zi(_ky;{UaJch9?8+OpypnIEg51*cbp3+Ov}YFxsG`VoQlgQqZhe^wLXLp@f^I4o*`%ev~|^PSwq)vd^9f zzV6ijmB=EH!q=*Moe8!1W(PZjCn^!3QY13JI{JuhcD%N&uw|b5Bqkq~&)%iiiL&~J ziJIJuf!VcjF`efM3>yVRk|6(mxTt*dovnAR$L8 zk?ZiZ^o?D7go3PIO&y>}qbfFy-PR^rlb4UgUo-7`-?)R6o9CaGz<6Lcx~bXA;6Ad% z@h+IOSn*%2dL*@fP||(<>dk=U?;x{sx)1*k3qac6*2?2})h@+mFK!5_ON}Y6w(+DQT6s1Urq)_pMjhv{EG*UdC44XFQJ4bhGp(nwOE>3$90y<8tKb@_}?Q-R^Q$9#Xk3_Gdz4iM@#6Z5nPg zUN@(&X1w9L`hlE;&xXhGN?GaB`7e(x9l{BzyB?kBUG2-mmkAm9hpQLjvY8(dtv6JU zBQvh0S3UM!Tv#%=I5Mt7NySIU%W!Cm_~d^F%G!HDOT`^RNQyJ%4MfqBn|kWBQC1S~ zjGUY$#6xv`Rm-F)YeEPw{_8Kl zBd`NHUdUiSGi{6jTBMPx8kyq_RSASEOtvQeyT5|-#2{hN=7d8raIth zpwhLJmJV=@3!_OXUq*kN`Kd!mnbP`nOzkI-M$BL^C1xx`t{_7`nO)UXEoX{Dc5a|L zdM%S92OY5RL;9SVX&Ty_73<;9FZ4UxaRmo-fd?l?YH+@?2Ms0_+eIq;2h$MJ{e28A zTcB{Bku)f;sC6@37Xo8(@5TH5XKm2Ps(wCic`2i!vZ1VLrCh|zik-p))V1>ZurVQF z+S?4cMD_h=PGbuxh2nrJU)Vu1>({*YB@aV%z5BRVAI1CJRI7EJ44wy72*ZesFx}=- zBvI{GJ@&$dJ2A)|41aXMP|v|W$m^Em>c1t6CUxTFxemGc`tf6qfFB%?JP6|OelZ|} z%N`QOwx+by(>K{L>)GEuG|?aMV&3D=mEnh}djpTE(Z_cva#j#xv#a78I11HcwxkE4}z zlpG;$UVmO9WHYK69NOb0gG;8`egy?d5W1X{FDy01dVcSM`oo(|UfBpX!X}A*MN>%V zEu<(#{Uun2$Br+D&1Y%kbL#rmCd-17aDR}Bu=0~pk%?%u!K24sa=?>7M78#awi7iF z+pO;QJG|e6@Jl&NhL=Xk-|p}FOf}OTuMS=j8Zc4m{Yv_Q0ufGcrFpJGMDB9`!an*; zIX5Sd3i(Qj&wAASOkMvt{QbF}e1HA=hXRa-%(DC3+=mUGOV32E*S!_y-Szn2KHR2| z$e;_{}~R>E8SX3wsgu)bjsT7?<*D~F3QM_S4OGVt@EC8uB#ZNv+Cwhl_HHlE4ietvg*?MRxX{wio zu%P$I!xj1^E4AT){Zsi#Sl7`30(6;{oBh?oNAlk15bQVgHDg(_XB!EvtucuXcNzne zz1`>LLrBn3{Dm}}q`$=XwF?{}L@au0LV4NA{%o~*1AQYSN;pGCE|Sz`XXZlG z^c8lFN(}7#?SD^T>GAsxHNNql4lE?Db~pv~54W@O<#D`2Sm|e(*Y0qMqp#1GY^38u zrtPQVS`I^#G-l$md9~9f^RUBy^xBmV)!^~jZ4c3?*Hz40Fc8GDL8;5glo#bXmhHTj zCKpA9kAp*g)f5-f_@g?gu+%3#NSe>X0rQQaiwMW-+7MDgPWZqrzTIM@4?7%=O(Y=N5+g`W~-URqG=+BpVAcApa#5O&CS z>3Nm&E8*;JxO;g?Hq$N*K^s-#$n%p!SewW))~2He0vsfF3Om`D+oSPswV$i&KGHVo z*>x2T^N{Bl{X@3z{@{+hB=Kj;MOaR$W zUhw21aH2XAVOz9X!gp}kG1e8*jD5FR^_q$aiR$&hK?5V(2RF?>Cdgf7nB;X8fWso> zmoV09l^oN}m}4rJ)A34+n}|mP=ot+}CnJo;F(xI+%F9*QFtIr?veq$7F^x}5DX7S) z=uz~o#nJ}o)z#2b6`K_mrBJ=}3n?nGsVKA5);$-@*=H7T1PBOxu`#p>lc{KKIDYMG z5A)Hmx<`}jKS;mdKPyP0sh}XA$l3XQAEEyDMDnlZBsTf|GCd0&5&zf-7iAL@gnbB8A$k@|FwLKnF-&soIM{5Gm-3SW`dXKO^%J))J zQ$xUJnHm@N9M89%yE3?3fAB@l=W=_QPfS&0#jAoaWtgLuN{w5z#+EU?+9EY2g9gG} z@A&A#$Z&pLjk;1)Si7NN;W~$KW78VG;Z6wUJ>T!Cr4gt4E$Y9mx;*ybd`x6WOw_|W zPXNCF6m|tBDu1FOZfYlyOUA0~9vr~K!Y=*(+==%VcTn=zl|rQh8+f=3RTHxe6Z-|l z`MG5j0S49s1;`5wpZeT?zdv?d0=cJqK$2$d2Om1s4dk*2+P zXKC;|vYS$4+zmU^>-NL`cLb{$x0w%k;k>1Ebv7gj>>jLFm-C8T>Q5p_&=%h>$tADT z>E|ETo*uz9m5)EQ<)Z; z(BC}`K_58Y%jX9>l15hEq)Tw3bx>!pxIb1v;lQy0>T{=)m4inqpu_;Q^?10s0iLtv zHw_QG+8<$F&Kf=eQUw`dtM2*@o7bLqVtU_|a(+b^>gDmdnO4YTGC^t_?2q}pb`HY= zA6MOb&-|ZuVgg;ixuDY5vyP9;tJqdD+gCDg0&?rZtMQNtZRw>$fZbZ@q)KU!cdpj- z_7V4x$1m8Z5B0<6ZUbD(gQKH#l$7Y*a$v0H-K?EUWXsKbK#9b7Sk@y z^YtQ=xS*zogp$(5qWI5!Bdp>b8W89I<{koRTNPXUu-*&%QT^49a?>mJ>*Ey?vGPdB zpO<;AlM0Hmy0DC-?^AhVQM4kQV&&OlN{SV1)Z@G6dg9gfe|}Yd!qX4w`Sne&{1?f; zB_&+solQ|;@2DDI%Ct%>#Om%{(cVeR-bQuC$>p{^#8fdflKQ|s%0n>7`34DtihzLN zGc-22HCV#Xz9dfgLQeQy@yeDKU*rtFJ{M2C4q8n@tQbO6jrQNb!9$*~l8BdFU^7QY z77)#e=9{|7i+w{Z@Ej`s#6-qo9lFOB)3YCjQ`u)fL!I;4Ca!;+7{k?E^eil*ptZ;r zvGjN|W{MY3Fe*fJAL)|?D0xNRCt4ti^8P9oo{87%O8$ME88cP2sDRc&#K|HFwcu~#As2KMs`aMp~e*Qv} z(F(+!aQ7e#r?7D9+wvd18fZv^#fprb=c1i)&ayLAB{34bsIaw=1$dSOa_!xS;3akC zJ-Gx5kug5^NL_Z_XU0!2HeUq{({9ZRL&Vg#0ceg~*br@I)+&)*OIxY2q3HNz?$Q$l zGfsgZPQjwAwAJt)mJ8;n|GqWmk}P-HKs2^DjwK<)mNMtdFKXfgO8!V1HX^$_AtSQ} zROI~WJ4lB?mDkJ0*@+i73POeI?{*;x3B$W0?@v_j8~R$yZE?yP-^Po_>65;g=bp!s zG-ry}ef??+6x#wHb`8f*vf zS-A+-qePUhv8NCj`~x`3BOy(RPxjws|57{Q1h{Z_93^6Vt%#xhEHu*)k(&JRP>6k8 z0Mx0zrx{z7vDs@CjD|% zxyW10&&rl;r$1!s)$bYL|7h+pM4KHn66~gihOK?t2x7{U-CD5 z4O=bWW+avV)Jey9hx@3v!sJ(-@0nV-MqsQ?q+RhiC1n$)s;Jt$`R5I$%lzdmMk=ibo?h~D)Di`2c?xs=Ji*V zP$!$TLlRFLy>`##o?uppcP=*it<4ow%J_npMY0gt+rhy>z^J`4F;UHf9?{$Ea1fuZ zH&voq4XCzNyx2^82Vu`yUf><%P{_(RKci|Ahtf)udB$)ge6 zq0UKocWxwPZXbP;H9ny0Kp?1ZzLzIvq2C>1?}f(g zvfX&yE#`h7!9^j^X|c092e&llmEA=&X?t<)DP41Ur_sT7ppjZY5CC6P#Y%z09Wo#*MxZ6u6(gv&u05g4w=Z(bWAav zy4Lr?B+tUBspyz4Bv$7KpA0rBpkafgKeId2nq?liMj^n`8*~Q|N&r1L%NCa*q5ESD z`gf*Vb|^ckt2_68)ggA`|1CcFca#{H_uB*Y)9TM^)8B;33s`1USSNU=lv;`l%gqiW zUdh34zB8P1_yPc6MP`)6CX}BG<>J0jP*M(3Q49`#?(3uM>+6&2dxst*NQ#C?4;9e# zoj}{8DfR6Fc zwxZt}YNmI7B|ePfTOa#^e#K(QeU3RCb{siR_!J{en+TZqkCe5r?Sz;JEo32e8eZJ? z<^h*jpS3TS;cwkHHNLGkRtRI0=Kw#6k6RdVRd;AZ_fCW=C0XWAKCiPX$(gn%VT_2? z_i3itamI-fSE>;~@i{v6L(G<;!f-~|#tGEg2`lzW+wj@!{xXPtP1`XhGv3kd*#=uoQgE-K0&kDVVv;^TwU{N9K3w>n%0;RJq)3Q`d4rTNAZRP-St z+hkyn&Fwi@2RRrO-Us666+;q;MT-S@pG-MjdL={kpx$mxaqgq)kbk;OS^UawXN1T7 zmOfeGM+C~hNX`UADc#=<>lkrMw&9EvH0|`I6f_NmhI?HT zA;sZ}a>@#d$~lxp6cm($gK~yj?+gt$Dc-3vCP{vXX2^rWk{jH)cr`4EQvG9jqEnZV zV+f12`p4wIALnVPOFB$V*M8F!o5n*=;)y=U!9r`KPS-jifxei_z=}4p6r!n@P%A8i{42g%)U3!Ud0JUC$m>PL8WC%P|6Ut{RB znbL-|r4*Ir`DX7HuLo-u5KX`h4P-M3)t5}hi-6CYV)fzG?wEq|A3;IGrXN*ju!OT) zK$#aP!CU$D4Ghq#)rd(*6vy?)E5-iM-94XK!SY#>lou;}ri9>Z^G&BTnB@n(M zmeGEJcsH1j@=j+pMm2ukO<2wLA}}mu`)RZ0ew+zGmax&AD}4oQZxsElI~LFu2v2-V zE6&6;#>_PKXjJAjP+Zlw`Fm5vs=JjFJ!PCE<}Acz6#4S|B`VYgpt0e78DP6`hW78p zK81y*C4Pt)T|;W%<_#p*xp1+d&FI3eu?4T?NyFmQ6dO0A81HaOkuA1y9RR0jfd_-AlAhC zn?~jc5PsRqFN(@*i!y4G5@;5P_NIk%zZn2g63`NXfrbY3m%jO&_pibmT|V92#~COO zl5qTT@@vYEzQTEm-=1mS*|_J!gB3XTtdp31b&z5L1zGX@^>jCt!$u6Zm;yhT`WLl! zDCo?QOzq<@Vs(@L8tmwBk?2&aCc~24g7P9lbadMn&+^$%z@k!vC$6rZGC2?zRltvC ze<^&~0>AtuCQb^i^zVT`-Du-V_GD5Hd_XwYHWES#?7#Q=02|Ux=$Z6GkOZND13!o2 z{#MWl8{XC9qDR~f1uKmsIvU?h;;QkCE*&v@$<24WuAydQRTvsuHZE307 zn~N=yzlj~I6m)=CIgFO#o8W-{>K*c2>E*c%ZT`n;2n4uSuv-?`>Qk{?56xD?7l*bb zd8~Q$1`{xbLcLO03^$HMH9EXvG*E4kJcguF!|bhcTlN=kg?=7~=%Jz-81(&JbuYAx zB#(iDNC$BGy;ZOp8&jA}EFgQf>Ap{yjU4xTj|2I;p+~l4Vpzgs{Df;m^d(q8j+v5@ z5>T&_lKz>PV7v@DQ^@Dg=DfMobtcOo@8`I@N)aMKXmaBXpFY83ye2Y|nEjC$hWiSV zIn8jL9^@|fjWz(y4OQ2~NZKOt1PRh0hZmG7L~VQ4DdHSxH$rT^sAFuUA}=p5D@$_U zDro52yA@+72H|geCVGoI-Ic%+LH^51XNK+PytUykeT&?}q9R#!xlyAll76v5 zY;mP;2M0dcyVs#!MXFMy&{42&#pt78F~sPzjz0N_`6C!W`@muZ(fc4{h|>#1k+O-e z3J8g}@`+mMRTjKBuB`-o^2Ew{K~6gxu6>|+DN6v-KJbu=hKwks&y4OW0nk7+Rty5M zlv#)M8_t(EkUnmb6Fuq7m7jGw<#@@HL7Tl3SRFUc>O9Ows{r-#A) zXQ!F4OM0(qVIE)^X^t<$RdKEzGYI6M+&)W0W)xM23f>=Ez#uMz^r`AuO;vSerT^#f`cm_44d2GMIb6?5+PRTsWXM>b4q+<}eufrl zI@$v)RDcgcaE>Cw__Uyu>YC<7@8!Z8o!gBVX7TmtWAW-dZ4$4?J+Qv7vY#lyoN4C| zBnNwYSZIH-57`t=H#*KslUgSD>_;{Ztl$%aGOLe8Cd+q(C5PMok*FMIICfeB0?63f z9tQ(IxssL^5f;|<-wwadPC@jb&AmNb0s?NQV~tOFTC-I!5TJXnrgnWeIg<_sH`&h*}JE2(fBDy5=|kr3)h18J4yU(h8ANCq-*wTjJ!!p%BFmNpUi|4N$1nkmC|HV z%uPmHvu9;-)^p=0yVm<1K>wvA5!BS)4F$<86?}75K~?;ny7+tMcuL^aArH<z*{wV!zqj$5iR`@!GE2qUa^9^*k19YLJC|F@ILR56!C!|S2MF0s z&dj7U=m*r5Ekw9&V{Lmq9thi8jywp2Zw3x`&?EEQl2kBkJ{SJrZqo_9IRx^34pJ&yyi-udSL^U0hFZw6c)f`{sWHzZ+FLYL?ehw)oS-g(zrkl&_akIB1cs21cq6 z(sP1-h(LS4;A+31SJ#KOhN1Po*vG?c)E3Q~;Vvd}(qU*7E{w3Zm^5#6%iT2L(y0Ez zKoDRVxNDf{Rb#Hxo0~nO;_9~Z3@@}*X7ANQd-lhhQ+C1DUq0tk&X5@j?x(`_q@C|- zF2R6>a%+~WHs*wZ%smpNN4@*Z2=P9-2?)@ZcD`m$Vat`2vdN7c7#P^-jYvsJkxAp6 z?)-Xl6Ei3u9sJCDmHW6%!of^I(bwRbc;4{1xTE(_(H!4;zive?gW%{x(!PD#d0e0s zBo-4bK>`&3fjnl#a4<|RN~;RgB|aY;YGwhN&JVPht4^}jRkgKY5fN5q`?Q8(l4OBE z9A|G23POUgeg@0s*_xJq=UDN9FhI7jN;#g>0&7RJ1AhFbh_+mv`1InWk}qOR9=Bo6 z+8T1q@gABYm{z;>5lHsUNr;GufN`Dt{QTTpQiwM{2?8Qwqx+q$iODY<)P+wUMIANH z(J?Vu#^Ad2uU>3$QC!)!6_PI{J}!28OG8Q&8vzyXoBFul=jXBfUMZ0} z@I0DI5Qqv1!r;KJCpK#Yyn!JNVJJ0WC=S=Q@bcH7hU=2^CmpUQ6smx&KZ0~Xa|SG1 zJG+asv$Io1z*>&=Hr-+Ea5CWjd4~Kj%4$aDJ=$MU6?A;_^Q#Yq{|^g*+p-|1B=p(- zDp&lX2OWVvg1iAY&0*ijH?|KQhhBLmh)#;Z0}lsITLvFE9p!rjLPzYyXW7LC>le*K z>YVmQyPb4k)fAS+NGHJees#4Nj|BXfOK;d=f?rx7^N_VIy+6sXO_B0f=|xp|LtcU+ zIdqu%pr{D-%2~A_z0v6;T{fw~W}{~)iK&uK6f2}ww<{oqTm~9~MXSN?c=!zl24*~v zkjK?NLdFYZmmo7yQc{9=OC-<&QusQrdLZ|mpAQGgEGbzU8>9b?Ex7hq49lGt3HUJ4 zP6R7EW<^Xt?vjPJZfuh2tIz>XS0%!nqO!sw6!S@Z9GbZnth%M>&;*BQG%wm@=?`c` zt)uR$Dl>u0m6xx46aOGWAjAUk&n_QbW+|}}4qP_bi3K2#ySV9ktvXD-YgPuWla12y zqAJ6p8$7QY^Fj_4d94}Nn@Y)GMTW<8?9fo={8wDJ4{8b&!VrFzY7T0qjf}$*B4Y*y zgF z&1NW!s-LYqx8hqW6lZoQvgso%6_mF1#Sq5$jl67hN_D5#y*x4F4^lLeH5oe;ZTHRu z-ZwfXhSJohPRfyan=G-LY_VdTScM-SH4kCGs{oY`fG!7jg@u*XahIPI9hg>g6O%p@ zv$gYEv;D91$fa6)ZqIu10~hGOg_SdG92npr!rIciU9H3tMf4tmrvBLt8=W0c5Qz7> zVVbM==nkFwj56N^7)tQ*@#(AwRBO_y?C+_l+;+#_L)z5=Lc+LoMGbuRDXQ(BU z{#DF?C*-nszSw>iO48W3ZoNm>`ToX`@XZ#=Vk0+HX}XrGs7fq| zzIOM*>6xap$CGh}OK&fZ3fevC^?p|)*Ra-3&RYIu&Y*Q(nvImD?F@wfYm`8RcG|2) z^jLE_JUPL(oxHyY{rJ7MR$0R9akgr7L(2v3DZGe4Yf@*lgbyn30e|L?l`Yq@7w%o!mG5uwmYVq3>Jv)<1OuLD!+BlGZX_TH3PA%;Ak>ev%LDr=d2J-xhC& z>(NZomjJwGujIR?M8{`6y)QG1S=KF4VD!+|fl(0cvVYpx13&BcFTJim%YoTmii&b* zRu&*y$VS7&{GrrUU0rQnE{QN-Z?zhPK|W`3{q%4Hl&zVW{}>s19WB)E?wUZn0nc!J z#<))cownW^Af9SN_zr}W5^zd@M}?G}oE$KYWoBk(WeJFjgX!pgkeQB*g!7}B&YyrG zNWFoIeQ)sAU zATP*)2NURe7qq>e9QgV9BRaqs4UJ~gJM+~>JNQ{=8|wgO&1a|>aoCoqqWh0Zl?k-c zU%-ZVE3-y?G0z^~RhpKnG2;yTQl8B+UbII;15=xSRsBPf^f>7)0_2v5Jhfl{#)Y8F zTgFFxJ*4=1cgQl2id-CExvxd4ss<>8s$b0>7YZe(z z`V`vn{+2W%nUMkqU$p2y>xq>eHubIW6YbdIxfgRqBpz{C5jJ{_rv846*r6qBA+WE%dmolmh!saE;il4c64)%Ss&y9-lUy7#+@$+s#4#2FM+ z)B;(Gv$d3L+S=Nv|5k8tFyHfSPEwL8 zTQeIQ+sSe>8y{cWQxD)=0}GrF(3^F?npP3k)0Qr%th52aA#ggKG!709LH{lA2H@D% zRaWj9IlUA4$B7Ee=rummf9vJ(VzgAfzNw+XzHwt7&`GbhMbw%yFMvKpS65dAAs2{I zW^~;<+GME7rBkgP9hK$w=IbQr-x1k@!2Dh)q29lWk+e&0KOkp{%fgs(UTNAMue31u zOM%j)X$_egOPaEjadlwER(rwQ1A@be%J3>udF7)N;~LK--*dE9Y9H#dU;I`@_|x?j zt!?mk~alm!UEjxA| zsGeh6r%pwGDj~U7_31(ARzmvS%bC>hu+a3d;7MKFYDatA-@+_i99u@!8)ds|e-Az+ zNNkLT60>r+)_ZyELS9oobK*WxKBRr?(XJfG5dQEd(AeH88M-6##-R7pD!ln#aTbNz zWqjSmXdrQMAipabvJkWZf`R*6U3TVnM2K|@v*1Lf7##(F#I_b^vKwN64)&YHpnI+D zfiLNRmy3u94YpFfk;;g`;_-!uM&@I6#up=aX(!FIr+4O5%U$r>#%=Ci$9j660zYy` z^i0{ePWi|=Z7W_!6nrMUYoHi|TU!;Y}bMkbi#{kAwcd7-dOCX*f- zgu!OD@-BhBQl|r&C;}ext<}A;xY#_w!{2faNJ{B(P@tfU6yT8Btp78Hvt^jAQ!_KH z^z-3cW2JiWd?uF!XM{Aa1RHa8s)=X7;-JB+H! zH5$>0h*}*EW4sFjsT!lWi(R8wgbcqAo7t>&Qa_$mx2 zKuHyh?@qJW6Iso@PK``dz8BuYDnGlTmz#)wA35*aDsyQ2w$+(#Z|+;RdYtXuBaF;xjopT$Ou@Vh@* zu7-di>WB(EN(x7ll2-){NCCt%yeps<^&j zfEHwVs8>@{NN^KbmI`S~!Q!?$oT!aCJVFkir};YS?Dj0bez5-jLOlLmBD>8)A`Wx) zI<^&?%)A@DUUR5BHqtK}>-!;kO!7ZW()#*2*0j><>JJLbl2THYJwVdB+ja@~I!R}e zD6z!Daa^nr;0~c66;)Nfy6hi5tb=j|usq;+02c`S*|*=$l?e$dR>mYY*49l1^nVbE zBI;c(j7q-i>Q?G@!RgvUQieg8ZV!$lL}#{46ZmCi#lz09eUP0dGJ^1|8R(M(23-qE zpqS|I@4xExLI{ynRI~@S4k(&mQ&vc&u01k3BvxAujU|xTLP3Dh8k?Q1 zuc+AN?!4F;{W0(-Un<4F*^WIG{3a?a41u5!^IDji&S#xY{XoKoK-B9kyKB%mI2r-n zR~3i?0Qjb&0&Q{b69_{qD=R%cJ+m{&K&5u1Kvp?kK{=j@ZPKjmt%!gSOm*7nl_Qd>LHSD2G(*($zw!L9+N z{X2r%BZd54iBA@xzP01X#B+0AZGqR)xbvPA1r`FK;AG~_ z{t~c1DM;|cXtrj18%gy;l4i&&Sg5s14zOACIajH#8Ca%}H8Gf-40R4$YSfMO2PKN( zKD|y|`y%&mMHLqpmzS3p2Ns4jo7x*(gDSgu(Vhps^?23UyVsvN?zfuP2WYvzap2LZ z6YCvWKtq0+n($iFQXVO(uFCMEgJ9{Y7^+WredtVI)_cX-uR!V&8i9YKCN;J%n49Qj zag2|0@Sy30*z;(<3;%OETJZ{SsFvR;swjP@GNeXB0D^Ey zOXY2{KKvvlzMh+XZzp!! zI|Joe?~b?RdU|>lZ3ZCM(DuB`^Ems2i<@NCdKVyFU~FWRO>qxsuJ0~(oaWLxbUQ$AD%uV8mE$lPQ>lf}p_?@_A~AiWWTe zfnx)h7l2WOfgAz{PEB3X)d%eZQJ{lB0D#Wk+8V7@BulpSexHgl$sMF1kalpcD{Sb| zU|k-rX&{*`2v7oJQ-um%FHbjsY1I;Be(k`h5D*fId_D&KT)#XC(wTG;R7*`w zJHp=1@9n#huZ5D)81ne!?xeu_D}W z;UWN$%MzvqOd-fR_DYC$SXF3mk~m7a0vT$SUow|V>4RUtKv9^a2#Y`{`DGQovmu$g zZ7?bn859wLih=?(Bhste?QAPH;zGo4Ec0yGv+)RrlXqyTBt|5uDf+3b+B79(zK=U8 zxch37Ak^44>>TH6gbm?%$KX(t{OnCIvk{aIAlS70k=a+uruj=41pWbX?aV@aKKvDy zdx&r25CMms#y!)1#w3G88)9;+b?OcK#hI3o%=$T8g8P|<>i*5qOa1@WutPSlZ6aQ z9wdFB3>Fd`4C;8zC84m8u_+5GKP_$T(Ty`s4HEx51z?&9Z-94#2t?M^vBo=0^UfE! zf!tS>8f)hI>gq|cJ~A>A)chgspoYfz6XP2TC8WK;O#Cf^e`Y2LwaW(<7KimeL7m=G zQc{573ZV1-Ef)ppNOT2SMl4oaJvMs6Al{vwowv8n06G;VjS0$V#w7325ji<2n>Yz4 z8`%kXOYgOjj?L}^QLjvKts)(f7Cp$njihe>!9WmvX;L1wSVKfh=WiE+b%zCtx;ZkB z_I%s>DoBE&5pIg<{i64b9sYS5hv`g}af2J@cLcl{T^QERkIJ+eGk=`bPV4Gnf(I30 zAY*^bmT{gV5xR zjqMnY3&(3nW^@Pp9rvA};cvR8td^2EDkK%lR^01?Yz@C z2S4h1Znm=|)NEN6h)CZ`fL6dKEB>{3m@Rnj?(*Oxx3D6j7fGUS1;4s7Wn4JA^!bd+&-cUMvZ*Ye93qw#E!X#PUKqN>*UXLJ`=8BHnD8( z?Bq}^+&%M?pt;|kLYafiBLpXro@21R9sH|pg=K$SOk7;tqloZq6E(F(&Uu+2S_s70 z*jO@EOj;T%7z5(n9fA!2^&VjJy*yS21&N!RAArBDwzvU}D=?q=TsRJbdLW@lPZa{1 zD4d*}ue;Sj>z4p=V#^NyhamHq3e%VhhUMqac~73yMY|4|koG=V{jM7Uir})gvtOCE zzm$XfiZfeEOWBl(-)5R)%dI4&B6B9Z0_qoYS2ukp5z!-j!-vz}Pt*rfxV*juQevFR zk?-{MYZnIXVw(mcCOz5^FB_7R?O0d}eEQKBqwd913}b6@rTNh+>L$`Smgmh&KEnzi z1hpx{-UjEA~prZ2qYNQcBD9}AWuRZ4#Tn6~q?jNJ- zl}rbGbOiUAR_ph#vNB#Usu7j^an>r0)x5QLo-c!2=JRpBHPGo zo~2s~ zdP9TxJ@k`NOla`M{pYcInCusO1drAF=vzIW>9CA9pwAh*I$FN z%!zcG&=5|C&HfBNk9+eVU;hg(RvdsJlXGxjTLK$&evM%OK#&P}qJ!AuCl@VDwr$=DKepD{F{^`VPyE{|1uZQP&~F3=#vkl-6wB0{mz@w` zM_DNi5zqOZj%Bid+@s<@VD;~d}2$~-{(jvc9)#EXQ-_N7PhA{6{;?}~tvBh2Fs2e>40{>3bPz+gFYYsoar7ia({CMpKc%kZJ7xdF ze3@#0Vg&_|a*^tSu2+fJTkp2s$le#zv~$=0A=0~cxp8-KoC-c1T`a(B<|@X!A<6Ld z_Vm81ayY(|CMybEgn8=2jZE1xU>)kAs4AqRqo&4ep}NjBQ0Kv(!R}x+P^gTx(1M1{kA>wL_1pDDDqE@ z=l{Zmu;#kGJU_*dNr20rLN>*SwfFDt-qsj8;#h|F`I?u`gH5W-FmX(X;=o;tyu@vb z7G3&wR$loJb)~9{F^MbLiKLcEB4X<6G=;puh&r}y(pC>+d2)iG@h@o!7l=bmRH1}( z0PA6B*dcI7Xo>guav(r?z1$vC2^bcQBy&CfhV!1Gn+FtrGc(M(>a$8H*0jdO^7BQ( z=&u|RjfdUaj+P4JVo$Guggx4drTZI6Mx2teg(0!u++L?AWS&c zb^I-3(`F}`e-;*Krf8VJ{sm-UWE+B!D>yhf@7}%ocfEaYYx5Ea<6-;w@wA0)6Eov> zybvmib=RqI_?wTMojdezh9>RyUrxF1%w_d`1i5L;YgMN0N$)MVpQUO3z)rX+dV%fY~s0wd6Kay)BZ&~06HcA?SD zRDPn_fBnX}_z#t{iJ`Pk&o@e&ULARg*zX4~_lRPD2pN+&yGM1ezJ2EtMb=${+dAuJvXKq0ct_NO8H~`Tx+h$Q6h{-9nim0)6G(x@>R0meNZE!~pB!cwhWx-N@4d$rN5dv7p^e zZ@zn6U5%)~_^MXvG36_?N8N1j-g08L5GuL-T2I$fa}ED zxK;*A)74L7hPBtxKbPTZRSE^hE>H6P<8rd%a`bnOFkr0w{N9G}5yC^ysJUNkH#fJW z02Bf~R^{5o*7FeVo~g8^bKTLEf_EkU^lM;FAGTpyS$a5F04e+J?Gufj&gxkJ#LbXo z(KODPPZKeou?(zH!Km8_+}jBR1e}b=Iw@L8$?BhDw3HNY6MDBLC&-+>5u<;HK-yK@ z<;;qxxl#`r&bi*M^ht3ikbH}49^qgQgF=ivX~Xam@Ula3|3J6anSR-X)RsSHPsA~^ zG`W0fFLO-PmlG6BAbr!wjRysBQ0`XaEb+)@q(qerAd-82E2j9`|Ibq~e;WTUlNx4q z{X=5`f~Y)1Ct}31Pf+XJ)cU@cphzc!KQD?U|GoE$C3z`A&*}yYTa1sdGk$vg`t|i( z=Gaa{eZ51|(y{4d0Fv87PRhTKAee><4|^03bVt?IEXZB>C_Bp7xUc=IfEIdUqP}?( z#2s)MZC~60uF{IV1+YzkQ3V>D7jXC%XJz*Zf!J$j=Vo&N1M&-;iYP#T&bQ}hXG7Q2 z^qMhlBlRp2%Gy$4BIX-?x2K0B%dCK`3xLH?5Ky0j5*z#^?AgB{ujhn$lR0L}gk!{_ zsjKT9QeYTecK7`KcK2~Ti>IyWM)C1%JX$P&1wqx#AUTgfIII*E!eDHqGuVI5!mfR? zVO_|*9xSC>^0;JUx~b=Wy>1Aj6W*s36ZZ-NrrC9TJjJP689ER5=PL}H zAYMM1ol%#%+VR(rO1IX4X9{lpjp~$utw}y@ObiW;k+e0;m)RFj@JVDgx zm=7%;4b+0X8G^b&hx(?Q`ljGfMXkN{a<-8&)|C>okrI>bV$$qq6zS|nFi-pR?6yY^ z??>1gWq7W^ck|p@rCf8XKdb}~ZR+iD`q%yZ3t@BepZlAE-4+fdk&aUoMEew8dzo() z(`7Bmrd=7IjNWi3%iwd&3=efp4a;~06!V5c^Mk1;r*rtaNMVaWrq1+v&q+x!SiT9UlA3Y*j$A60K<$G5u zDk)_v70qQYHaBzYlZwHGhJ{rHMMcSHM*Rbv*nk$eaEeg-3E;BO(9jTwg@wgYSdkM2 zEiICzr$rMhP)SpPlWJydou^a;=t;;oAQ=bDCmQI*-9rHpk`ZAwxPj;S4 zHU0?7d-U~v7NH9g@1eoPCq{DPHo6MTAy?vS*@f}(=!67{dtLBw6ex64$VCryLj(?* zYIK~PR3H%9vN9jjT%F;;=-#`Y6|#HVJt6yN|8-9vvdJS|sC@R<9cg-TsfxHRyWYCn zsZimz<7+wEkZ%wnB7Nv@jhanUcz!=Ud5D~}%X z*UXmcFA_`k{nxESytRUy5c2ie4u*WCc$`LlUou=OZeBjhZf7M_SkM*!0*J;S-!3mN zsg?7c=IL3gM|4ciHwV1 z0YLNK-tEi1Nm})CBPN`{z(4>IXX{l0nMA$yV!i1YAw&?ciYaWCQ&UqwOVX%q0~EJv z0v3A{c^`4#wBXj?te~Yx*){R~AVu5OsJ+QVMbh)Sng*0tvP`}p@ht!VU5^$5ADsRb zmGlaj*5>B=HS=Je!*TCx4t4s+<9+`rj*|}r>Ux~FoNEnSaoDMHl3DLUr15aFh;2)` z{QeBu7*yriL6=Ccuzh6ca8U*$&;Ro1SH}lt)`eu&Ngcy21msJJWKTyF56WCZc`lbw=*${Cn;6D?=3g4NebpP{ecvf||zQ8SQbd7zu$ z-tKc|{#m>HOTXOv1~?%!s6k3pQJvcfE&huK_E*J+haWIZ=q|JSqhCP>j7fYKy%PjB-N>GL!L7keL! zs(+ZsJ+{)pgXh6m{`1{>#VAJ_lREQ)QHLKaMnzi4-A+YPhAWOF4K42Vi|4`pR&L(Q zh2ss2Ue&P2!0)P%G2P5Z+WMlR**!)_)27$*Rl)j65D_LQieI2_4ij=G6LJ^$3u-_- zW6**gAuTQLxnBHEhkNEr@#E9OXG|dyoY=&~EG6T2n8xpltY4_92A>TmO9RfSiT= z0_3TmpPy)Ey`8=NKk?P^a!b|H_kTBhJvOWmU~JnO8XA}gH8nNYB7c8;m8G=sfhrX7 zI1cU$1XruFeC^7u+or^81%}HsKLzJkt5N0Obdd8o($BJT#Q3c6ZPWnPY1Rl_6jK`lSM3VB?0K zs9E-R`U~@H7^Jn+tS`l%>xm1Ci|!m8u8+cbDN-jdP<1*J$ItC#W%D#y(StTVQ%tP-JL&Q%1U*mXfoZst7pUy5`0<_F`_TFr>@Qy++hV#9r$GO}_cb z?XS}p@t@9;fyCKD<_B{9Tm^Yo?qVYP??|yv+-dBCD=IIIdqmQfZCprgysg7eo~53Y z8VNttGM{-EcnY*H?XiX()m3hd^j&=+Xs2j|nT&tQ;@`b-<2tzj2YRR7w(#U@rv%!M z`K3WCEGahfnD3z~$&uM&l=_Cb2`s*l4w=JIX8XU5XAdx>$&F4s+QuJ@2{Sn!L*Jv| z0;cSCk}Pfj6H%;?JwzA5P?CvPfNY(I+Q-MIR7FZjY2qKy%E-1-WeCTv`S0w3p>tP9 zRN(u}EDX%%0(o=*54zCiaRcr~2n3)kT8(yD<>fZP{6MUV9f|?8?nhc*z_pAMi%kiE zkfWRb5BP(DU}9m_*Ve+17_GE>g|PvlowF0S`xXMA{6X2`$)7o5qOPufGl;)9IQXv& zAIspAmXz!t84*M6o|(oE-rh#oPT|pzX{PvgFrNZeB$=D zy9XEz{^<=&O=sbreoar;J)k6EaKZ|~*duaweY$O?^}Dl1t*y=QtZs-)UZqN*H1CmkfkB8vWsLJ@w>M-In z$DPLeuUfyE0)CneKDf3R;cX%k*6%_>ZCbPud7Yp-f3+vXO7#%`PTz=Lgq#Z!^XQc(+5^{MQ;uw{|* zi@zcyXiyMO>Y>oZW-18u_)&u*zVFmicP^Yr@iBXFg)#h(U=Ag@7k9mhHK$zSldjPb z^^bKwfS45l(Vm5X?|j_%m8_H6M9nP6ajv?`$7@dL>+~k8XGIs<;4z6?Pbdn>(>rKb zAviPfjJ^$yDOMg@{1-+hc*K^o^o07syYyK&($|WO4u2U!gg-YLzYY=oeSmeDoREOE z1{WeotU!gCmAGSfUzFW7zM(d!2ZZ#1O2LHt}r-hICywSi$FXmY!Akup;*F)wL1gl z5YVOH-Q7XH-QVBqhG0M-EXju(8rP1>lhEnr~YNy3Ybq*9EIce0RFl* zOJC+_f4)Be5*YAn`U={C>D4+dE^oRO|Cw@LgQnvOn4ZitQu3;9lV$Miwp8;-t7D^j z0`_Tnp&9o=?)AR;+N04ihj**gaIn(<2$}$IUs9rj2)FcC^FZ9#2k}7meDO z@7-C?cz+!N$<{H-~kB{Vy*X$!7ir|eOK@etC53K1M18n}-# zp2m*kZMNG)11weK;XAXFV@pGeG67+c0k80w2OKg8BsANWf672uOjpWSOg87EnJ^|I zf~4MdKz=AGgt*RKq2%r@{pGt_SI*K{vO&>cQ~YH|>4`PZ*!|-C4ta4sZoHEtQ&#Kx z)R3Z?sex-{%Eg9SJKZg>@UM?7Y)7&;@i7*~shn2290ae4blT7sxQk`$kj1@fV7nR{ zA1Fd((pnfAQ{5nddP2Kf4`T$O7n_g}1p?%z0}FMQz@h-=Hvs-Hz*rIpk|XD5T*Qe{ zzgYS$RwNw?nwwM4*f~04oY^MGQ1tcn8LF;=(e=wqOHR(tK%k6^hqtl59^g#o>E-qE z{9qe11~^x6)Wp)h=_d&ie@V=^o_{UuPPa!j{ET6HH2_L}gEt-?57+9(y46A@vx!s-i_S z+AQW!OMXxV;WByW>8xDFMd=a!VT4P@eevU)qfRg)=D}R1SApgAUy?LmWz+@a!(bj% z-Qg=CgE%aCKO|@;M=2B9NIkW3zWg?bKPAetP0%z(j zPGRbU|Piti&vVumki1A%<#G`G}>FRV*hDLS5Pkf~9monle& zX9?4}M8Whqc~e2md@ zT9?c?n9;pGJN2A6I@iG4BlK%}5*c#JLZVl#|C7qyrB9VKnbXl4HPpNQ>dsCS5*V$& z$3-#|=SRE?I94#Mv^$m@2f247m1EKM78u3?%n`jdfJIxQYjjlZvMoG397IbzboAKx z_*aly;LM*cc{!=>05!_Ld!k0z2-H9Nzj{J|_UZKW6ktj;@y+Iw`SQ*icAUa@LO@d2 zr~@1%maPDiNzM65^;t>DuWovJS}gpiI|Kt56M(3c7f_D{6SxKj3&SHz%gc+l!NmPt zT^pc}2{3i68sk9Q*S8cdUNum$5ojm)%8# zXKf1Dvu;egJ{wv~gyXXQW-4fxQPP(z;PmbMQq#Z}{zy%_FYP)jCKu`QdI79=5#iEf zx=SO&C%R$64?nm_*5yUSgFZ5kyNuE$#-x0Ld~;VDD%vTUb*vUZQZ)F&&&mtSm6GA~ zk&n8+dmYZz)@viC#3!Z3;NmhsLKAH^`9NceN$aX7w3fGiWtY?O-`_W9?_C)mRMXQD85mVt9aZzW!`^7p<}XXh z&{K%HEw#q7{TthRA6^nn4f(r*Fp%mA4wC!i2lNn}M^%VmPr=a!GNXe1*oHKML4_*d z?okN1FPB|c)43ceK)p^$87xW)Bu674K^utuP+VO6gx}HLPA{trBzfvQ`@6d!2IdwN z=r!7r@bkCl=8DS6jZRKF0#!&D7X7}@f4Q4~443bgDHJ3nHC15iJ8|h7i7bVMmq4Tn z0vU=6P(o)m|7dl)czq#8j2@C5h5>988XpSR*Vh?p-h9^5BI5V_UdQttM8Pahdmx2p zsDtwrJl*|6R?7Et9TxKCYJVCi1L&~A#&&=j-bXMBv{&$FHTxP#$X5GLcQ?>DMIT2= z$DDd95(?WLl64O0mWZAlC@P3kej1VOz&pt+$gXz#=eUYW-K%((@|MbR)hUPCoBU`K z<(NMB$pL6K3xYXmXa;{mT5YW!*_faA7JWy&?n=K?(T7vf*UpUJcaAJdNn@8>U6wbp ztS{8eJ?zPFOHV+#z`X@S^nivUiGH1N{}mJyEUiw+AdYFA@hYt594^4hO7?sXo6Bly*fCog7%s*aT z31HX&$-cWMi0C5tHQ{H(0tIwBEMo}nNO+K+lCcL>J3GCSTy;bQvs5wfGAK7s?$=)C zT25{$200*qPjpOfRy+D@}G{FZ_bCU_LW+tRP$7nEE3DC4BFr_9$zN0%!0-27hlfMrqW0;}X zXD)(*+PTTe3##keW#=f+8{ox8gcS{2DuswkZQu2;7J4u{LU%=XWD+EHt)I^EqNI-K zpEX*c1dnV~5#Y;+i{9CB0(A6PRlTh7D}PJ9ICaayiSd+L8`cdN2E2+KlC(y!yKB?7 zJM{iSAj5rYvrM2Notn{Tw~HZ<9G-+vCxayx!>hY>D23?svL>^^Nn4>2Pq?tD$ZIjE z@s?HRhUu5x2MS6;vDnSFsYj2Zw=@cPxCbbisOap&v#h^574$qLzb{6kas))nh;L)f z_EV}FZL80)(=_(-MRj#2W5`+y2SgL9CmstX^=JEWjvSRHR&-N8DPppOwHEm zMvS%MW`>}y+s&09tMNZy>$bbBw7ZPRLMy`6;K~Ic+Zk7#J~SZip=|15N?Ch9aG)ge z?Z@jo^+6{gO!g;ZNRqiCLIjEOC@GncJ$BMvHwnK` zhQA&jYt>uDjM>^bIK<9Y9(=U>E9kcR9f&S%LC*C2c$c0W1&+x{`@=Da(C{SSbb*7# z-(*RLbx_u@a=#W#gepv{R{Hg3*)=CSd(&4cZ-UR`8lTTyrF}E@gS7k2?v*6)l9`gi zK_DOf*%R^1Ow&JW%efNsT?}n)zU@U$-{61D$<=Ao4Pj61=ypAne_s$N8Wk-1UVD0P z&%t7U`|xQ}LF*tcX;(3WaD^QUQJYID7AMGhf%8BUsbBK^lYVEY^p54iu2tm#EY0p1 z-G>2sY6LAMbkC8p6(l0|UkeN-pT1t^LYcnEEj@G%-0zzh!;LG;FvL<6%(+;4ZEl)e z?XNSVDYnCt2zm5H5{;#C{+JtiFu)<*HTyNbH0SMf6Q9#kL3iu4|3f_o$gY6q0cR)5rUs)uQ%RQT^XwA?=R`6Ejsd0@*UDA5glU?knjqFkmUCL$>KqM&Af$2 z|5nFfn6)u3_GQ5D$SF97PKi1uT{9tFQ{0t!43ls#61Dl3vWEXiiM-B!&4oRY;K_h| zxeC&oMI}oQh73VMb3?1;fV2WM(q3tCWfZ0YT{QUlS3rpC?93`FqbDO1(TzkP$*rj9 z0Nw=lhqGt^C#zNHKArUukp+O}!+>8X&B-AXS z%XAr!o4qDA9gpYIcPRjO0Aiy%pkf2oOkk)40d&;3{cal%=+_I57XVNDPaeL~8iESc z=##+1fR2etjui$pAj?fn4J+a; zeucg;!^^GVRyC>a?;ky&s+ifKtkUYXuUD5lunjA6k0VX=`>Gq`n(CZS-Vmjvr-Qn{ zYlZCAlRv6&!=Y(!Pe;%1sSqI7U)|kf$)#d*Whgu@Q^&^@P=Z;_7NdkixUY0(k>A&; zRuBpN>O6}gl^8xn!Qmle0jFZ=cnGdO-P#&!oM5>_CAxBtO}xj%+LqgNZMU$h6DLTN zAohuefpEz!Pa*^ZxeJUWA|qT88imgS7jQk_u=4)F!Nc8MQ*-lY4UMGtd*Zu0JfWE@}b`9>X z(G3*y`fEPhh9L2A0+Pms1$jo>ec%!WSusE~fdrf^02aCve8faLzkr1cV5`SsJh-48 zKt;#1JIIR+s*=bD`W9>!=jQ=q|H$<&nF;yfa#9|Qn551mC&5G{Lb5tr@A;<+F;{8p z-ML7l*Selo*DJCL10o`;7#q1%M(q=KE(#K<+6{}rMKZFTMhUOjrJ;;uhWmtcy_P6N z|M)htRbK!E*VcXvEIkDUqw5KOn`203CQ(?I?=WmcE_u`a!d*nj8EsG$-oZNa(N&T? z;~W0VgTSs1y+hQ{y~txd@{Jw&@&4fnyO~t7J{g2Qdl?!MloR>ejRMxTq%mLpr119F z$l8Q`(~Akj-|Hnz6zb~hbvwLuyxpTV8e3Xgz)qBvm1Sk=e+#z$7F_086}qqu7ZTb! z_&fC82CKlpWGtjONDY>il8|M6kMV6TT=wPv)dJ`klpDvUD&BW4(TAtx1#EEUtSho} zfH9b4%L~=+A>Tu6=UIg7U5=yZP-t1yn$jtJ-Lp_9`a6_3KR`pM5<)>I;VjSzsIsyW zi1PK?+}S`AlJasnY3ZSn5qe_cFT3MeI`u}CRaNuVU<$eJ3J~Li4xGT9%Y^LcZ}XVe6BwZiXazHP8@VTmYT)`RVDdLmg*i$Mu3G2BjP? z_;=u-0zc-QRefBX@;|i4>9Pj*8?8LRQ;du@4Y|-E5Cy%JneATgg$QWzhGDM>TZDm& z;J`Pvr{Kc*;}I5&O{`kn(utv zSw@K4Mqa&{EK-I;&mBCJT%t$jCp3T2V*WVewReS9#VGE;N#_@x&YxDjmCEV2`=p$o zl7S(=wQoISPy^_!j5>%^EGXf*xZb+ErzR!cg6FESF$vgEQ{T@e;YCKCio-j9&(nOR zdj9@h@?Ct{n2qXhV^;fZQ86zhzfD+ScoLZMl|&M0y1EfW2bz`SCzweVC{v8~e5y}0 zF;WQ0D#DU^EJZ(vb6JX1p4&<ImIIZU_%(JruJKK1LFh;K@Yx8=N4ZzXY$FU0vIbf8*#no*s>FJ-ucA zd!0awz$d4qjDnhDrqpz%=6EOtfEw;ji2$CX=0yfijbcDaR|wC%lf)lZ@(_zfSQLsN zPxb;=OEAwARhav*Z|EI==4(&2U-tM##p41&`gV7TOa5?aGcbjkQ&oRAN$|Y<-!Nl5 zjg(<|aT(s@F}Jh}cvCY3=6XP|Ddc#?)#WYk)AT2|kvGnoa>K&~;;x^HeMEor>--7V z|K6L7q3bILpH*FbjJ0G71m2!^=itDh30tu*0^|?aZ~<;2FE7x&$ltxF+pZy{n!~GT z&sdRNTYdJ2niC%d!&L6aEE`$CCD&6MNj;&&PFS?q4EJ`=tLZSk`wYe8kPCb2KO4e! zSdkkzksG`Wsbf1|aNJK%%%z6D5%*~-v!f&P%(;_)TzW&|WHe;n4C6*9EL@s&w;U=$ z6x4k?33mN8BCY`pL~vFm1wf1th`WAeYR&?fq$G@w6^R<#@9v0J6%iTY2@MswmhbuG zu4p-STrmn$M29T0KOTrfB_(D#G~DIED?2>f*WLU%)w^+R`n_%Bz2QbxZrF_(7Y&XM zO+;i7h9~{;W+L3!SNhND@?qpfxh0x-?Ywg{CHYA5zs%CO*4}Lfpbm~6k9fQhLIos0 zxV17KC6JJiz!YR)+gDar_MkO{qun?Yc|sLF61F$-&f`^#(b4EJHW~|Y$x0Gd5jf$> z8v66hYZQ}SuBvH&ncJwR(!R z7{b{Kqar%Vo{8x#kGr|hfc5Gn#Ad@iKT&cW{*6V|;KWxbH(5Mbf&z#np#!F9ZLfBA zA&?&M7=XwX(f~@CZuD zGigDV%Y+`!>jmyoeEylvk^PcPY@-6~r{|GBEgTnSA;IKpfp1r0lhU3bHWbFQ!ak|so=ge1(PE$2SbS0SrS9q~s)J(E@ zBx5lVK9FX?vJnT2AD5XXfUzPx#^3HKD4|8tnUQH*wS--Xmr0MKJ(-_U+4}g;!Y*_F zZAwHMS60k>V6KcH=K9x*;}26ncx@eT*>E+DyAWs`hzIjs4Y{MhU-XDrW=gLK~lr2 z)1=pl25rlXSF}7gqcJ-1GCICYjta zGsKyBs~221_bBg=&3Ujmt-{{UEJe?XA>aIUeTGM`6%~Ek!q{3xbzan!vkeV>I~29~ zTpoSd*C|nw_}O#tzOGN;4CO>q%HpTn{qhhM1agT_4(KRIp|7O6M4hzU>6}%-INWm_ z;-UrO=i;zMi_~stG!hcUS$_gK_igyB!$T|J-ly~m%dq)eCIGL`Nly98Cv9|$D?O8S zlH)f0G%HJ_RV4VU9+#Wt>`kBQdyx)4VrG0iT#VEGSmt^Z6U@NSi;`KNGj-nynv(JO zv{OVoQTXW@nkOBg*2>Oa@674jxeyT%0isBdS_3G!tBs(m6`#-=hnP&ND!>dQG<6}c zPS*OJGyR9@h`TN4yLZl{#_XZkQt%B!LV&^yNpCfiVae^a=YOQY>Tx4)0Li<4U3nwV>&2?IXQ(8?hn{Z)u>Dpoi zib?J}YTGb)eJ8f=1dcQXN!fy9j1W--1cY>fc7TTftsRJ<*4EbdZ}&jwk&7m*UiXaa zmjR_X@(&5yZlQqG1#Vj?!0vMmZreZRQ7l|*#ty&~m0KFOVGEEx-3 z@FAz;9(>k|(xFr|xtF-|emK7EpBrb!5O#TTm!eUv(W$9tuCHaWD7So9?=nsxJqG_d zfJk1WW^EX|94Zo2ux2?iiR@;Za!?R6*a6Tu2x39pzw$Y;&l+2L7bO?28@AKL9-#N- z6%`-`6_%BaJTVd`4w>>fT2+AtCm^LJjoEdqRe8^Tw7IeIbS>|+Cv}GzH?Y`qDOWc;(hSoNbfarDx3AiloS0|Lp_V%N} zzP4ZSn%Ft&$0Bsd(2FJq#9cpf)MM|c@-%6^A>4lF<6FPc>MHzO2Tk~W2p2enct<0C zQGFFFcGuFBL_FXSe*8%#YOziZ!zl#^p~Cv#qY8x;8O*b&H#}Ov6HOSM*-(&|$5-;5 zD@fmpJ@o+@D0DH!re|lhw6rX1?u3PN2mhLrci*z`_1UaU*mwFbp$XH= z`jxHr_GHQ_ce-r(+}48bHjWxL?JlrFwY5~GO|DU3W`l&7m?Eb0hcFa6ldfCNbdyvtJ>?qii;n}am@lL85xggES7I!mYBlw+-J2#6^;35Ej6vlxrsZu z=?Mm5_&xgvX?ZJ@(P!dQHUYz%8Iw-SDoase*&&(!qZN0PyL>l{{D2}o2h!npBu*wf z#?3H$c?m)FQN86$U%i{!g5Q9G3D?Z%6}j2>HxLCnNjY!=72d|!MDE9@?Vi`BXHyla z(8Paw1>ISbP*hScpWB)Uvx_51uHaSdNL25#iS& z@KW6qdhG&eu1tzO%;PK~Jv~DSUHTj!KNfmVI#jftBSvljZ2=V{WIWULi$jl#5Lheg0_Ae~bp;5`% zG?uTjpLuw`fR=4t_#AjaQEF{FId=dl*K4Mofe!xn*3xw%4qRpOvpF>=zlrb&(~A|uUohbG&)ix=!h6E znClNr9EAA;LQ5Q7pb@#LMNbGt+4$_haF*2g_;={&ELL+&raGB#+v+_tFES)&{2lJd z%5>NNE*%~ob^wyMDs_7}c>`Sc^AdS^5ofeW5`8l8JxrpgEbOWAcFZDI$p`_vT(E60 z>8QfM@>0C|QJ9L9^!M;^X;u~qzpnm>H+86m?Y~z=X{qNS*eu{%tl8GuHNUv5bvyrH zNRSN{ny^x=87dpc_Y~ajk*n-&aYaY4Q%V|IlYf35GtSb5Uq!B#beixVSrh!*s{`G6 z+AHV1sUrkdQVJQuO6N&xkaaQ0+iF=`>xy|#*HB~?hxP7nzm=$XJpS!KOBq(4_&UYU zVChn_=l=^Ckf7+gtakqpMf)e^VlA^u&>A2hI?UUZu`WQpUo04)c;zjn|!09ahX z$DQbAyPWo*Uz4k)4z~dx#e^4(+U$N+9NXoIFYc;CX{h{^d|}utPtuQ7FK z$W-pj{)>>L)Q9KJnnJ@*y93dI!fU|MqWg92m8F)&K3|~ zs;W|xjh2sJj34Y0g}oe$yG^u%9Sdw-EyeskjTfk&^Eg z7Deyow~qN;y2NiYc#1-GS-dDug1oFAxSC-U!xyUWUm|qRmIEtf%33^h;imBN5_Z&e zCjQ?HL>y!w?c`UtoMluI5fShtBD$`4aTdawl#PTXwo|uF>aayB?tg#zf?h*l^ngT) ze4`rP&EuARz+1M|@4HFte_Y#AO}b~-<&xPpd))pkG<(M8mg@|xR30at>SO#3_OjgN zid5;)BvbZ6!rO?9M485pKzREWv@tQWuxNJLiw)&?@+6Isq{6h=J0*HD7O|EFYho*0 z!pGb~AC>v{n9sM=nwGkvysWnJ__p$Cg%YT9tphRH^rq1DnNW8{3=!QGW@L|{hrCWT zl5CWLROR-fimU=OZhDvJuNEU?wz5gQg7mQ%&CQ;SL|Rn}+Q454ZM&g`gMC39)%u=aLujzmhdz$woKU(ZI> zGFM*&cMhvE8%LXr_9${G-6n^g`FXdbyG@2T4F3^BH@Y&=YiLw$4mZ5ZI4YCfZabCi zO@uRbXtP&|*-Y{b!v=J%C9hVd_J9aqp9(?&-5e3p06~u?)qQS7e<2(V+mq?*FR` z>pFKT{Rv7jkZ=^Avs3R^gtFS(SAPBaB{y4J+SWc4DD^2LZFhrxPn2b2V!>PDO~I}J zB*2x2ham0e}$`^`)|CQN|$-!s)H!nwE0U!j94 zXL<9*7Lk8Qeh-}ND5J4d=oC-hUaIZQas)m{Vc~!9ynauDO`@iPowXlAmOk7%U1WvC#DtK0E09;KK^%o z9o=kys%|RcJG4(g|SL-o@6GY0nGIbV}0U-ZRYwATdBLx~)LQ2@(^3 z7}epPSs8#PQBl%vaJl;P_%POLkRoi6`S%bF{Eh+R08mhE`U3^?T0>J4K!TY9KDzOX zNBnMLLKT92gdZpgMPiNAJ}ZK?W2@a}6&#LoiR4`6$il(Q^pTANk>jl(ydu0Rd@&ED z>W_MLnw$pqph_;nIEnc;37iKP-7O}<|S!Ivk2f(5#rnEqP@D&q&9}`y4EYd5Y3~o8I z!Ji?xZfbe1nsoUU(3FZVw;sDU@ZX)c8R+LD6Wh?X3so;&9 zZ4{W2EdsBq&gRp?&%jsKSV5~w@$TiSW}fb?4_va$%v5gk0zWXD8}^0^!Gm^-%#}am z(s;Snc1`l;rngNKcT5w9I{N0n{)IGr#}POYq_pHw)*_JBA{f%2(T6ATi;b^U1$^LU z!w(fi%Lo1}IFUJ-hB^D|E_mU3ral)==Ipm=W2z@edVM{1+0B+>X_M-zBX*;RF!n_T?E#*V}T@g>nG~K zkDAY72E#?%5J3?^2Vhb8#%*82#5OxyW^H}qt|+UhqZ5HzJJy!8Y zI4PR&z2{1uE7p(zSAT_nKB2eU>6<|K*d=FH;}`ngx^7R6*eNQP@T zB|xv2n;UTa<=xoOsy?U~eD%xWv+~6|qf+Jd+R~=WJgy6hq`}pvO<2&>q-m^WR5K3@ zUdB}#pjC{L7k$w&24WzHX~tM-Bnam&2FFL;+ILZ&{H_YMwsTBGu6jI~qdDd+BuNybUTiM)4*rPSe6Wn7<< zdHLqG)p?4XE9)StaFMx~ZCiummZ@^O4&4jg()C(WJQwwy6I>yVn|a_6Md|bQ)XwMT zN08X<2MOckDekDf{r{?1iizp9{v(;@9EJ4i>S~}n+B-OKBsLi8OeIV}J=e4c1q6I`b2E2r zateO@p1~i9GZV(ctPL9MfZzfwNw44F8WkLw6dcXC#mP`$gna;GoWM*O)5AIK6VB$( zqdF|?q=VQbQ!5Pj)(<@x_6^NGu5RXy-hMqMBmqV&$%yrV`WiAa!@qoCH0jg;;{fPe zmC8T5tQ;H?@b9+Oimk#(W5}PUj&7A3wghki15SW}gTA)6Zf5aI{>>Ti~!eWx;?7 zw{I+W$fvZ_Lie$QkEo50-QxS~_7JVsz7_&C$vX_CDizX%Pu%3|C?OhDd#It^(Do87 zl5;C0Rv6B;F0~EtugZR3V+m;)dU(_b&RyHOV&MB2d2j+?Ss1>L3Av9Mzsnxk<5n8E zj|smEe1RIYao*F?M5Z&7Wnqc=J-|Rx&WtAFkSj~EKo&G<`t~0{%Emf3A_bC-(Bd*t zMHSGPY<6gXBlKS#-D8jyJj?Iu?R6*tK7hG74SA#s=`d_hN9N~WM^1sFi>{c4CUX5d zc1vv@pw;r$oisNO4_SbQhHEelj^s)~fJ%-2eR)p&fDteiw7DFmfNTwDVxad6`j0Nbb;pXg}L?OtBvIGPM_H=jKH357O z^kQMqX(q>FZI}@d24-$Vk{=HAspXIqyv2=c%I+ii=ohmCGj=B@1;NJDoRYlu7@Nvu z`O4&|$NYuJpvMICyVlU`dWWjRvrn3F=?1!X?`h*=hPGeQl66Z5+rCuC1*4m`v9Y)~ z;IPJFXfyCI%_T?2G@Ly0)X0*@mM@{Y3Uq8=sR!XCJ2C`!$Lw3kdPj% zRE9BqI_}_5>Ow_zRut!xE?Ng^gPnHvCGTp6e^1}$qlE$C6&oqo~?6xP@M_sT%e z*(>AcTYsyk8!mfg+V-B+=AIY}De;qWA4DAARBT9P?eqbb42SwU2>!i2U*NpwZHqkj?f-S=@5&ZE7x9-ECdW~^c!s^ zEAI(-`g|fKxo?yclYQK$mi-hlx3C}w`rpsZ;gEo5#~z3SfGV=te;(bB|Zh6MBG zNl@u^EP2fdrs*nm!b|^lr3e`xoY;f=E6&dgI6V9Focr_LKj8yVh0v|iWJ&hBvqbx4 zc!P+)dlbF$U9%zUgC*qpA?eB)h4jW%41QVC-CbOhlqAW`?po2p{S3PVrQ+TbH!M)Z zTbNY=-rT52G-8SR|3dwOPomA-!VbcUfb;~`HFnTZWqf?RqAxOo@bAk^r_X{}n(+T& z>Mek>TD$jQjv^r`ARt`=N`rKlfV7~5bSg+lH%bafE8X2G(x9|-cL+$Abi=pM-+#V$ zk8{MCqx0h-Hzt06^(#8~-772)R{hTR>7I0KTPL3#n}u8+2XBk0 zGM&Dh-?Nu`>Be_QDlEAl5wGb(T|79<3EynkR}vNU&l;qIr}ent0y)&-aacVsJ_ zXuQ(aDf<&NWU631_|ihl_-K2^Twh;Q=(eOXxJsv4{(b}1KIr*xvO)_jJmQ|bkih<# z`S4Xlk!h~@B|fhl2C+fD4QudEZ;48)`-R%}8M&p}A2u?WmYPfM4JN@~j^nb30~;+r zefamlcpnBod2gx;MfUt~oi&XA0-YA5+1E1NeaxXBkJ9PQdM*k{F!^6sDRx-v;-WRr z8+!YNVnp0CGIn-HPRa)6%`Vr9zgcWin>TZpbK<7#4jg%R7*7)Ar%-j(@mlWu9ByYPFTpDC$M~h@O7D z%(yFt%@8DAqwOKd>npXZJJdL0OJ8tRPc-U491e8~X(AaRH8x z9c^rgmN(hECo*3!)~JRxKHPPAVQxNGIjCLla`F3;J;q^|(RTCnv`5!LJAl8Zpv!4V zaZGAwM|qX+e1I+G`xp^dyr6y)B8ZGg+FK3YiHV8X*px{Ojs-A&4WpxbUcAyzD$Vj{ z?GM+cmRI?oIW@968=41{AfB{GZ{8Fv@b*7N!a7DJ+%#T!ZMpJV$o@!4+5h*!e8v{> z!r6*eprNOZD?I;F6(rWjynm-boeguIbR9bN;k7P{yM5OLvdUp8N>+Gc8MF%Q?_*)e z@qeSkLvQ_Y3WD?U2ghre5JZ#eg^OI9Sv-~)Y={f3O*gDW2<;WfWS& zw@fFrzL|cM{ll94Yra8;l3B$BgH(|B?M6-dO2|wG+gnYN=?B8512L%s4X+x6M+OU~ z#|F0}xf6H@l0_XU>}u>d<9kfpFSeZm(

f8|d#2s4^&553jtvhmb<{cep6RgyCST z8uS~{Pv4BYHz__IA{$3hacQBZyA&{-tWG#5C*?0HGk?bUi`ohLXh55uKaa@G%}q{D zZftCf4Ih{e`>zl6~QBu5p-AQl-HzE`s3aM70_9>w6y$j z68Kw1z+b-4{vhZnjQOXhwHPDrPL0@DE}ZAyI2x@~z%#wY-IxHxf8T?>s8rK^!>S_ z4J|AR<9?{L;-Dacj`ZO8m>dA{*DRqQLNL)VuM(AC6ne=Un(^B%$Uv(J3k@85!C-uM ze;+b7>{;2*=KAM%u*l-H)oRZj*4Gl=PTJz}gv>hWe@ymg5|eJr@E7#xH85n_T4A&X zJ@x0$cq53m{OJdpotGc6$4*(W?8`W2{v3WP3v9EGS1?&p&7(!Q@BN{K+1bTKA%+!9 z%LphxM@KsX4Qk!&MV;8=`08rjkj29hjGIl34Od)B9&-cxV}pxvWJzH{1UUc4MO^E`E7rc!;!%L%WwL;Q`s|{CsK%5W=t} zm2cQu%*;sw&SjC2Lsz`zm>HSH{Eo^K$z@M=nz<#Fm;PQ*mfC~!H9R-i)k;gWgdLjl zlnt$3e6~_lkb9J!ddwJ-9$PwJEJv2nx=7)puw*({^jOWEu&>Fm{GQmuhYt-(PfFvZ zBjljS`l$>hfq!Asqd>7Sm3>?*0tqRn`l|&!e&WUC2ItI_9FrbLx}dXRm1vFRT}~T9 z$x@hX+;~zO7XXZ&xu{-Oh90J(dPe8D|! z(G3r7pQ3VRrV7H8TO|D7Bh&`YAuBI$>Bd=M?EHuA?d@o0?KJ+VS#xk>u6K1*S0C>P zr`E;9BwAizckR2XIdWLCP<98K{Q#Pu020Cl=ctpD)5-aHZA}g4S4YCvI}~BkIDtVP z&+2rBbJEbFvOl56T`yp3TabyZK9l)@#a+BSJeFrNH1kC0PQRG8KkvQhcfs{&gU!KW=suWEBKYS1cHObt^k#A- zPQ2typ3ERWN1HEmEU7Q{vm*M51h+#43|w>EM3!!h(lS`MS=_w4DKAbu`Ps19_fCBI zSBgv&h#v5`u2WbkZq!fB$u+9gxGVwS``x2~RkC>vFx&iFwDo18oud@Ul` z^2tKPV2mF?umiPOpIhy@h2ZV2VcBDcLc!_iLljNlMi2X6zl&sxSv=oKZ@zCOS9D&h zSUpVMmTinJ&QXf>Q_jSzsBi{0Hx6pJn!30nWB1-zc>G(;jbJrDF%PkN5%ISO2&chFwt0%iCGE-SYtz^A8!qhjqQw=E`k*e3BLJa#yDr`;%7U|fnp(h zG~Xten}U4Z9UkQkRX0DMV_-Ci6wk)u$AZfKYzzTWTbt_ztK-V9Z3)*?6bt$KE6wTu zOiXC8#iVSupQFI|e}EK4Y;}#ir4?u4*Uw=B0;}t-@0_X9IKOwS|Ab2BH^yXTckTQL zyibrWrgWLx>l$j70nxvu>IFBf@7X$DPRF&t5j+f4f^IN0eA?oqXtmprZW!2y*ypJTEQ5NXC%CPeZ^Y=%d`9O~(ik%Ie zhSQ%E395j@U7`9v@*LXQzE*dn&}#x!j6sZ3tX=yJPFt|9qobw0i+IabJRQpqy|(_K z{x*m1gRSj}A&zg`0v;G*qQzb>!W{xKB!~53_tDc6F(kw?0e<8M%y6T=`4$2Ki#b~! zWvYi%Ozcqve-WN^H;G`d81BRmNJDvfzzO#N9zM`M0p!6H#csflB5rTb zs=J)+Q^`8l&>SF5e+CK)Y7@C6irP5Eep>8HhhLMjvfq;HBYrmRPH-UQ(z5!d>vhaO zU}R#tCl)t+ekKFJndI>UzW8++{L!b$770Q6?5{+cru(suEqR_v ze}wuygtqW&kh+aiR4Y5gIBYM5lzsIWDQnXP)lK%U}X zBWnnAc{~4p-|2Ne{Gg?U1=z_0hsVcr>Tnd*8-X`N7(oNxydfmKds~%rSNna!H@Oc9 zoZ|y)ebJ_L%r34=Ii>i|V#=GIAh|V!R^Jip=nuOxdptu@W@UD7TM&||ZN759uoUSW z4Yl=AG&VAV2MUFhj~L}lDSfyAZz}WUeQU0U)9>f-8n3dfFq74#)?ozrEX-_R_L2UX zpSV8S__CuWCPTtH%VT_4j$UkPCU_3+w(& zeM&EJ&4_G#k)1-xg&>mp?+gm&jU$>MTpuEB-6v7(dm1T8yvvJ z&%l5xI9y;Ae`>1>u`8db6{l%jI=gmb$5^XVtZ6tP`vI#Sf>=&TN!Yf?XIUZs-)Fus zp&ev0_tbc8lolNxbKVv0nWtw96IBr1N9|Eb$I_(Nc7D%>j4Bhw~I&!ohi>nA#ARH%f zf%4?)@AcBpF9=DJnUL^ZV}s>N;b)Zz4MCo|n9J44HDa6Dq!Hfc~D$z|aeM!2-$s|fm6ud5iu zRu7z)lLpw3B~#_6dTqxGN~tf`LhcA)J*E6KVX9T1{=dg=rL@{pIyxFe<%wxCLnA#y zLzR~=pE~jc(y{D50skIglm|!B(c<54-0xGqCwk!GOBh+aVtS*yhe){A_V%f%Dah-A zUCb#iwwRd1qqT!Acggq_PVo?_o^CZ!JZS=#f4d22!N`Q%)M-^NO47lBqM<=ZQkf=z zM~jOd}51`Cnzd8fgHEdAL|I2mzNAE*g0ezK)Mi$2o6l9%)X`CJWPD}>zRF8B8+juX9QSzo-A9`S zfIPo2LQb^ydX5PvaM3}Fr*wZXg-w*&L;{m=erG{{Yk}?E)p;rB3wcz6?W_888$<2< z_1h}CjQC_vzDv?lO-L%JeSW`s>5HH%&3+&Vv3~rAsZC2q=oEwNgHCD3{qTCF z!r#?pZq^vzSyPJ`nS-CsR*E}61ts*m=yp7kd;jbtj#1-$G<8+ z(mV=GqmQ7HIaP~*A3+C0B@_5LoJKO7Jpz7{`AOy`-iZ>?zCz&xasqII2*6IG&)ff! zz3&>B1_K;x5*B)TinA~WVha zUD&Pu&|F8|hJ-~#{PvBZz~#t1u+6P3EF0~qkAD?)`F1DWZ^2Fy`ZhUPx7SG<9B+^( zK_gQ*=N8!0mhR^S#Cj)MIqE5nzmt{K+y5r6^6_05B^5OMYlt$oL0m6X7WFCE!*MFM4{ih@ZEzMCm=v;g#K6c++a)A3nrT6|l0x>bM zPrqW9uI1Z%I`z(;W8p1+%SY|ol7gFjse4YzrYVKZEQ_Wk)&jh|r@+DKlvNUZO)Vs-Bi&P2F1)Mj z=2F2}WPyt5LEwYu(t9&}g zwjt8q+Xmq@r*B>MCJy9xuIKMB;IJ{%7-*Fg=D#>N30vKzq)O%CsOQ-h5!)Mi+mpYY zLk~zAx78b`R|LM1KRY<*67|Z}#i^bYRz84A^Xm4$;$c>gTZ)#BF7MT(Ccgyu(t*UY zr^if*Eqx4RK*HA-k>TNN`b|Cv<{J#M1Rj4!8QZhi(9pv! z0vG(CK=y#=5p79owV)82>2Ya>r_@yJ@oI>*&D;|+oRCG(q}BpSTUEi+~6DhAVV}0lAj%mlIriS)YasmZ--(6DKcF|DzG)xQhO;4_R zxD13|PqlupL=DU+d%joxe9!azjD?>&|KmGK?=~b?-x?nYC-{Z^Tx0&Svs}t5>55LH z+;sjx>~FvHXZIB_n>-*hp_FoaLy=a>r+N?;vsV^Z=;&X@4)VV*K?fK+%V?h%DvH}z zf_L``m$!dgSfsYEQ2Ia*2uSH_i0m4~8pu9-1_h~@xVSL!eGY2+UxkfVx#pf13zw!p z9ystePUeD)59AqN7}UUa4Xo?I6+=GwlMW#PpZi;B3-Kvm;)(MG%R$n`McSJ4f&j8m z{c#w0KxE+OdRWz{&)-nT8=$`9JiY3-b|ed(S<<2)X}?nEfXqyjo}-~|8D#(Q_v9n*s|1`40Bq=qQ}N_l^2 zP326F5tP{X6h^v*{59+4x%!m7Ko%y;4yUUis#ZZjAQJsM;GW$7_KkIPz!DE-4dZru zcyjOvp>C)W-792VY76G<{TtQ|%F$*PUXtt_98jx2LPtjjJ&>WGtt*e~8E@U`08L=V%f^PxZ*?EGtzA+|zbzdk zb!8uGjSkNHOPpd75eQh@g(XIwLK_u@KkBx>)^M&7H~qSv-%CuJ6`g@TFOwgellDtz zgO;sPPxO%YZIacHI~N3XFnkkH`&V4zN>uSBR7Dn^ZN;svh3wjfTEF{K@`Ph#r0reZ zeio?jpnm|^2mT9Nf(OsInwC}_v`;xXIilW3Ob_^+A{uv^8m}I`SzoA;HbIXu#|%t+ z3_%7A3}9wu1*R!*EiR_#=Lcb*@z}JW&Hi`3J$psRpIF4Vy6=r#kIRKfX$Sn@g9Eac z2pdeseF;vF*XITmt}WFbf4OvDAKgWBG%&nHmPN1A!%(EXkJg>07Zvo58=e~&ZE$k( zQWmeNYJTs3g9~GljcfH!izmgpq|&u{MT(;SBA>0PIOioE2lWKT@%RwlzMt=R%->;U+hgrKPjUW4vHVQktch2`WV!9qoNA?bM|0${emID2V;gB<8 zJ+b+kC3>E$*W+7M6q1X;QR7YqRd@~uF${z$Az=&~s~NP+H$(*!6OdK^?41_a?ioAE zm_FMcTv|c*HAFE{puZ!j4CGX}09dQ2tOS2ofWhB!aGjf-toHeb)TyYPZfp^cJquEO zFnE63zmW`2A>uc5_laLJYxEyw_4MA8{dk>0pTKyfzQ2CCFj--jK~MHu?ZN&p)|QE8 z?r0BQ2+hH0e;2&@hEY+$&Vkl6PTsSjYivPB&|!ZkSz(AY=vD{Hgs=A)3%NYmap#{2 za)qNm71x(1?Q7io@L)pU-04w8XfEluRtrp1NH(==#9a$0#gfuFa8>{&%xUL7113D*Fe@Y9~sCZ)s%k32v@rA@@n3)X&Y$H8)eY zbaEM8e8LoSNiSH<{_Jy(@r)ez+GaI}z}*YQ>&EqEZ%X zq@-McQu27E;-^)J%i0X8==`>)j+V#b^R`M|GVE{WCgzdZWwxxG9Ne$p;&g0ac+Ea| z^4++VPR05Ye4QPGo8vee{!t%?0b20bgu({D-4r#8zO8sanXKC$!aTUf|PsER7wnfV~V zY+|tbalAjoVL+|;?Kbx7Ut#sq^g<SgalmZIbyx?EiAZDS;V�OHh#gM&sFd{odE65(MUfY;HU_3Yk-m|kYQ>1OAmw(C@eY!vnJhO| zl)QuCo!SjxL5`FPUO6q+fpyt<^-IY|fylAMgicOP^V({(Jw)rv%MNRU522!D6%-VN z8E{mVLl%r{%Q&1pm%0f33U&Y3I*W47%+o8omj62bf*g8fV>yZ(+13+G#KGy-;uDsB zUc5DK7x6|hu<0kU0*P>XT9SAioj{B8Qnrc)V}~5;=chtU|9h1AeYCT^I9%_sWCn)d z2j-&zog&er(Qi+Yzy@JO{(0`#-}+o>b#-+W759r4)F>iopk=kSv7uE+SpEI`VDaFQ zqBc62t>)Kn-)3);!GnpRrUL^2=!-{@kb=ah34A2*o{a3&yKYz?CDOJ3wDzHOKC9m( z-qbhfZQDieo5t;NZwXd;w~yjLuMQU5o}s>^rW8H*>CxTpRtN*_H_n@{T-t{pv#( zi&C{$6AmuDWx2{j$n~t;kB?eA>V=c}PyDl%n)%-GY<|Z!^`aQsZt4!0CB)wRx@QYd zi7+!Y68$ed_2A!(7UQ0gl|@G32#wovHBX3GJDi&Wh3_No8=mO`N!K z_zZ4T3U>f^6p&+LqN9VoK}*t!G!s+=(>@3SSs;c6zeK?H%V0k~K8~*Jy>dB;Vet!j zR$O$l6-o@~KACZYyj19~Ln2naQ|{&r17 zUcQTCLK@P_P&<3kWU|M`Q1H<_PnF1PUx{5?>u6V8f;x$>{2s)_;{^D$b)3@$rv1+J zS;a&Yz?D>ni4I($-+D1CzM)lo+n~rGNoZ{YVU;L$?8F2pBLQf8p8I(_r`B%~x*l5B z*^doHT-WKohJNVQUs$?L77;~Fky1D$+1P0HmYebJ>`rU1qE(?B=PHoa75(@bkkN&{ z?kBi4k`so~w_GziV)Zus9(zr5s;KhIi9L<@I^?Q`qgM25={~Fmk9V^XrSWQ)iG+PA z*||G)?pyb6*m^hRw%2WvQ8(ViW)u5*`V?G0Wug2C&+7)4%;Tiwg#OWG zkAu;1{dr5C5L`scFVCDmt$9=7$YLeQ1-r(iv9kAP(chuNiP7B(d@8f6Tk81#xB$Dc z><`u!7Me`TIde5i0VR@Dj;)Mk7XjAXaT{_eo=l;KyR4x+$IN{HBZi09%`)aN64X6k zxTEITUd-M2^2O|*9#c<~towtcaR$~^j6O=XXm< z>CIQk(L$e5<8gTggk_N5tfK74@~PlWjrG3!${GG>zRU)_Mq3C&Cc@a4GsN;Gv;i>5 z0c#RM_(wrdxK$|TH_Y*Szk0({_fz>FQU=V~>Lhsg57Ox$9}d>P+I`?{D8Ay(H8VQ0 zUYi(HtXo&Pa0!k|SqNABg zjHzD3zyO;@>|>v?XN}YJPvKcI&KBfmrDxANp<7l=r)+r)~leB%+eV!pJ-|E*;dCB2Qb2!GiX~x=?_Kd znr(UpjzMd_@Hg(}f_Br#eZ^<52Wvn@_mO_CkE=VCKcV3VE8>g98mXk%_d>Yq{)7G3 z@Jx8Z?4f2%QHC^7&Vm<@5JXDhE@OV^pioB8+$5NRq1m#@;YMx#C-hsA5hxI4j-P`5 zM&>xZ%^!R?#>O}@@t*5;)auVE)G1mKp84_VS~=ftE@kR+SeawW;wD^X_*r=JdauT6 zQHYd_FD$Hc)UzgZ`=iU+d^c)bvtC1(h}7!)!l)z{{$K0sAMbg2j86@X5=@3Im zAbFWwe;#7Ka6yi6HEmoXdNk{5W%M}b<88W-n!=a-jTIx4SDLk?g%#o;zM9c248*;U z{Md^=2L%PwFOYG9SgfP!{PLYN6BRpiHI3WsUQ^eSP2WmKc-V?<-#%sT4s4B}Vl&s$ zN)Rxi4KwO|8Od5al%H_H|A6xMuV3HoD4r<2d^tKW@Mf_hND?O}f7Tovc}J%b-7{lDfMS?Iy5P8})RyqLC}si` zq2C+kbKp}qKc?#`=)7m-?k+eq-$6ylGvJNvn1nLvi;s^FmLYQO>`Ktzp`->5YML~w zmzqQc_-=G!+1a1GJ*yadW0&-a<_$%>#UG+=H=*ytg=SNJF5dJU8PSa?e) zYGKO&hbkR4wRSs-+q569{_`T@`)?wEOwdg!aIxxE-I&rHy1kt!RzmR>o@C|7iz&_1 zd;&{LD_mB>0D;cF#}|z;k0zZkkN^3ou;oA{ z5gP(DdKy`rFO)e9F_fGG<+AVAP$*&fWZiy1|Csk3!_t2${}IN$_B@y&L2veOb9}Xy zemAQr%p7Zw+=I(qoL`sKSRp1j@)3MQWI5U~CSj`$d)<~2UPdQTq`+XBpWL%fhRuE$ z!}74h0UZbky~^CJ2D=$Dkw-f_p2msbjo)Q*^Rbk$VZV8QtE{2|&Lkr~NN5a8`R_=* z$J70!U&Ix?-5S05-KVq+#AHmJt?7ZU#|<&dkRz-gqtz!Z{*Z1kGFC?67f-`lGS$mmP$Y$Z`g)HwIVO? zF69%WjxbmsLfRvg1K$x4`n*G-DnY;tOH3raS+yz1wk!V1S z$~{YF9WELfm{!Kc#6UDH8>yP`J022ucXyBY_kE@&?3q@cx@m>k&O1+k99dzq;k>5` zn2YCeJ(WOKv*nPz985EV1zQ;MCK0df*Z~1{N2Ol}+u_nQnqObvt8jx+E#MiwwGcj2 z`E~-V1@?v%g(-a?aMS@T9UHc7ID>QDrpBS>c0TEk=3&g2 z(C{G+w{QQrROkGT5$$)q8$zw0ACga4boAIh>U#xvcf^ zqZuXSN@v}=jUa&aw|U1417HVIBf(&I=mV^%4D8ztvoUkDRmmFCvaErkwjVY7Q5=g! zkYAaq+%~i@zMr{LTn=FpkD#N^$w_G#8yjQzo}h5&_(6`J#iG&Ka;FT9Xp!sUah#1w z8Fk>waIb8!JL`|uuFih-+UE)$d8*$+-K84Y?E_WOhgznuT=Au&*y+~8O# zzQNTE($j1>vbSF3T&K%AI%3VtX<-sm;t{@8wAkBpt)y-%**4`^wTey&jEjiCA!z1v z_+-CHCXS-aU0bj-cw*ZwA=H@V@4fX1?a$n~&h*b92EOPgUxzQ65(F%w6)_VgZB!cO>a*1QsHs<~LFl(7aQViZLzj`Zg{oAY20s8LT!|4c&_^s>i30zw zkJtxk3T)I#$*nChL24$SuzY{t8o#@zEC&m>MC}9`4ep6z)7-xwW6-TGppseETx6h}gefo6BwF@g^in;zt?h^t zxnBcg3cQQ{_oax0$V))aV_>^aLHSmw``r$OrDC~OzSNMjG_FuQHNDf*bLXxyyLX}odmyOI)nwBWc z66D((L(1o?DgW#1T?yGmy2iw_=HymYds%at!oyL#k)S#gg1vr}vFgEi&#%Qm3??}S zrAn}nTW*EN)R-kv$UOE)TZ}jjVK|Ukm@}l|Lw*oOlU7uA?ReQZHtbkLcRhn-Ke6X4 zcyVsHS(lJpgOE(ok$X>Prw@WW44_(7Ocs(vfsTqRzQ>@Hk3i=_feB8Kn7Fty^@5c) z{fpXu<5;4zwDk05lk)t$_!BounXm;@N*o$0R7jDf`dZGZ^m0MKLw#VB*6HZ013JnY ziAL*E*~su0;`QWU8LHZgx!tA_-X|N4Y?r2QUq&zWswtXHx0QdmcYXCap!Yv)nu&0n zRUQ$DYY7qLCPHdvtuw?}Cu|(#?O&QJkJem$TeUxOA}lU?r5%6`8-ih}H5Z!Ns1gLc zh?&~tJqPw=1u95|u#h8XiM?ty_JVJ-r z7wR`xmF4B}b?p-`5S8{)Id{S8-)aC4 z}3#JM^ef@!ElV{JKC3Zn>R^p=%YMtHP8TfpW7~sDIVj@5lVQ87&_H??| zv2S#gi-Do5wN=vW<{eY|IzJ9IfJnAb4>J^FEbCW$X1?$BKVlzed#5gHnw$_)CbNRT zSpSyTYI_w;b(b844_9~cd;RgED%B47gO}i2Ax}d_nFu?qlU7!` z(zDQORIxWXBfu!`SA9^oq=%1<9*ZjJNBODC;BYT!SLOZChSD0JZhSm{+p{B9dmNCt z?e@;2C1R}wLmE@>(#?^YnmP|v3`C36yPdL!w)5Mse~ybI5(9NU(w#fIP6D}ikPudH zJ^kx=qJDIAMCf;D_1qqAsV@RIifemO}E=;VbJgf!rbp=4LEY-y}%5jmpPaGMR&8yhbX z-)WUOCTAm+O_p@wQzu^i{F1Xpr(2H?f7zKYrqJCACuANKl>n-fjG-JjuY+1$wA4>K zg^Qf(j;Px$nPP~~4$meE3on9pHTWxae(#8qw^t`@2 zhR|POPlBMtvMzP`$eilzNiKo6m#Im8maph$$;Rr?>p(liKSp|LSYJ~iOOMtJYW zzdxI1IfjckU$IQU%cMeqk4vPPcW=@Cd{_NO-xNJahVz@2MqWdMmzDk_%}?^hq7Ll^ zvi1RjA<*77lGadtZe}Atuqk0Z+4auV;$nFCaOv!D;r}vW8;vk%{bm%=W2qyI)L49@b_nQSOg1Dj+TMK7-3M%-EQi3kdr{!)Fvhv4GGR zu=`Y`Bjfy*6)8lj1gd-DSdTcOm9?V6QHG*}duT3`G*W#>pc1y52b{N!>~1VLKDl3`rY)kyv}JLZ9vHEv+^~ehjh{rbqNQ*AX0-t zwmx97E}d#7VW!)2q9!A?;c&Q=7}dcMC;-$I5j=M2j6>y*+(x zBAubjZgG)s80hPNT7M3enTCw+$;I+YT3trWP#4d3|PV8!1;d~vi}lHF3&wYK+nu91mwAc+x?@X zPwUBe2P9v`|2mi`;8-b3AeEMDh9dxZ9Nj;yMnEN%W|et6OUIdXH?8@-QHgxd@H)^#mkr5msgTh%C@$)fCu%(+ebBS z%dtxH{r|_}FUW?B0f-}|go0O;+9s@TjGB$m51iF8DGv;_BBU8T39_$wJa75w^DAbJ za_`23__AqXx?Y|~CKh}mA|m=`In&v}f)?Ecx_8M|U?|QG4?CQ!_BaP!^Vx1=ib+d; zIfrd<>gp;vw|e`#BeOSn95!5ea2e4ekvE8Z+uJ1kS zrw1M@VE;yfd81hV`7?Kg2_QImCNLwBfi?0y=pQxU2Mi-05EFBd-a!x<_}+T;#Nf9S zuT#|v2tl#+Tuz?5LRaSBiGv!-;tdIF&$M{Kq{-n}M@|;Hlrcag=Wxly< zp?|kUCs%G+^6^iZF8(xQ%~(?4-31^)j7dsL>e!=<=O{LcO+mld~Es~ zU$@7t1D-M)2O$pWGBZxV)yZOLZ}q?feIp~ERWjZmOJzNB6;pS_*hEo$(i%gvdrs%R z<#VH{s#be$U+OBYGAtX0yZ>lTXgssz3TY0S)@wb%M%EzZ5)JtD2@nuT6i_4{0=bRF z@=q&)u2QipAX4RJW$TwoZ0N7RhPa~6Y$OlZNCcHKva%a;3U6oYH29zh()s7u=MA@q zGDHav-wAc~TO>MoKti+pl?aj@7-6f6Q#_L+qp$b9C3z+4;F+^-Zh? zAfMpMK>XNA0WYrC-@iYA;g1Z^knjUGz5g(h>7xF ziMvVrao8;;pP)B?OQ;fQ=mm0$R62+(?W^p5Kh7xCpj1VE^`0s13r}Ui_9Z3-Z;S2&lOD5h{ z9lS{UWy*jGhNIwj=&Y`6`-I6K-kfgOTC0NoXKO8riij9F zV4URFvSBF{K_~UA1?_AW<6fqoWxOss4a^qn`gYfx2&?+F_`me%d zB<}?Qv(_(bp67pYIj$i%A0W~dWQ&oXKMxNMHrY{#2q7XOg0d3e1^X5|jn$1#wRM%1 z&HeMuGSBtpeb)^wk9Voj#|~sDqS(X7I&Gse6xbOV8LUEdGQx5(tf~7POkyAT-0s>l zC1uC{OnmOgk8vLbJuw9%WD!_DD5)59#UEWS62Hg`_s0J%=)cy`(&jU=GPiW$H!Hn+ z$2RnV0(hko#|eNHnKKCb^!F4rS?<&)Y9I8Po{xHR^-PSoT@Qpt^`2K$=LXLr&`=sx zbrG2BdUqp=pv;cC__i9{>>K26e|~^Gy%)^&S9(b?{TG*(I4vf>-a*3$n>KW#72v%C z!d~ONzYPBe4lXW;AK-Ns7Zba&90G|>k|XmCJTQAWoRR{B3I0fX8Z~gX$WKD2c z7*eLkv*W!xVop{z`IaglS_TvAoM7Umsj67 zS1Q72cG2>wf>P4w(T2md277Wv`**Co)_aRAYFCM|S085ySMS84BAh|G$itmoIbQJt^^uM7}J0r6-Qr^^pZZ4n{fqXFX_r3378^ zuV{kx`{|!dFYR-}YuMK>csrs%sl)pg0_#5(D$+gXXku*au+N`c;N8Jg`iZI{-vf{E z7Nr?8bvQ|H2s^fBXXnk%NydeqBW~7P-N>Tg&d%6&=DCke zm!oJ*S?8$x3Pc>uxzJdcn2hJdhE?j{=m)+GxZiD17k|IJylic&=Cl$AfCc3 z%L&2dsKBW?<;oCMoG>lDy{fL_O-~P^Pd~&SL&=C-C;Xtv9M`St=ug=QGI5-f5Pp`_ zT*9^TZ|fJ9+#v9%RA-#->M{6P2M$l1oS7ZgYPp<+Iiw$l4{%PCf^ zo*t7riKLmdW2KDjCH#L}fO~$F82g}W2XzrE2=Gv#8%0G-+Y5Y3bo|C5GZfq9`DDHi zvP{}Z7q3;p^yMF!FX5#}4TcPDa(`0UV*b0SOhK$5?0vS+1;vi2Gz2d9^@Xm{BM{nM z{p_lGp;1s&Bm}Mjt?|ut8=^mdS5}hn*hkX*^cD5Up4E8LIiWLv8S&CAZ~6~*`wQ|A z;p*f1U~`?IfTM@^npii>mjj>^G(^N>iXq4%MfG}JS<&r3Qu# zqiK_i5oq%aKgQ$X=RZH`=wB)l+;CSU5ltyXjxd;=h&!)pQc`hWJP3GYBF{NA8u8l6 zrd>(bwv#6rL$~ka)bZ6A1DzzMBTH$&ir`KmLzrq z%!-hSjDffRdr>KE?U}AF20_8ZH4%g`cU4_9L2~gsKC6XYrLIzaWE>`PZ{EByHh#!d z`{j{+aG|W)7V+}VpS3AN|A|+~nvGX0BVV=0tWaCLD~kZ&cO^~_L#Pcy;O95LZI-D- z-`VBv!Ys6LQO$2~FEy2J`(#Pq-@vh>iOEf~~bHh}dy|W&Ymr zg;yd2^Dnx9ln#K(r%&h_RYdpRi!PZ+?h2pAmXo@JI;#p8v!HLwqF%pGBIWKHuB z^YW-UH0l!>$MlxxJxW|bt(Wb(atw@7zT+8wUB<4p8a{~QcaX=|)^b!BUTL08Xh_n9 z%yxFHE^EHQp^T6ivlN!=al%_St$gkBG1&Ji?u80Nems{&eVEHexLv5o71&sWH_vNT zMJ6k&x7jheL334~`jISE`FbgP$JF(jx4{)R2B zpWO>BEoDpN=S|JZf_R;QPV=2(26b)mjdpWGYOh4vkfS{tw$P+aVULKpMX$im8Rz$x z4wo|RjWa9cgDoP?4XwseDqrNAikaLxKrDmt{-4KxI|f!lj0fy3Jw5VInWYiS(8;F- zF-eE`2F?b~;=k_mJC2Z36h6`s1x04h>UFSPc`E7( z8m6S|*Cwf@*-u}JK09mH{|~cR5$hY*(5vItuYsLy$yYqdv)V6j-wZ&$P74YkQth&2 zN5+O^3cu_l@y4EXq0ykggY9Ae)4>z_ieYRq7@|Je24e;`h|(j+0?hgEHeVQ-=}RV- zlb7X8!A~i@H&}rjT_jk-I+DoRX{+TEU+7(0=>2X5i6#KW3p=1?%T51Pd`g9{uFgx( zhm`!hYh;u}N`ng;CTSa81PIrZkvqe;GsBSYAn0NKB}bq?hx{8*JqN1Yz2ASQ7XzwL zn!&X)#i0whtTwSA|fjxowx_NScqdWLS!=44|2azrS9XoqLp0vak@Wm1P)? zivN@kCDkA6+1T}*kPo(u0}ZuIS-Nmy%>)~5%KogWIAV@kOs^xG*Z)V=SqD}5ec}G7 zNDD|whqQ!rcY}0yNl15>A|c&f(%szx(%lWx-Q9QV_jhORJ#*$b{sD7%-~H~r*0Y}V zSwyih98K$d&bGE3&PQ5&qNt#w2%IV4&b+{%@>bW}Bld;=v@79)9zSI@XYYE?*O&3) zDlWHC1LuPfvvLiyQZ=)(|Cd5D(?UurTjm<2w}PxrqQsr4d?bC1jd3u}pHR^%6{C)> zS>zc!vhPh+hJTe?iROc?8uC;2ztA#bd}apVZro1(ya3ezdMrv95Jy!AvhRX#2SUH zn0L#iTgz5)jg2@No!Wu{O%bH(sta~}c{^u*2m4eFWl~DM;daj#xV=(eb%@@+$2cXG z|9^w7GSHL>04w$U1YhGbs_?E5S|xdA=ul~GPScr8hCyTnngqxuWK=C!-N&;ffK#Pq zZuZx&uW_QUUyc=~%d*d7m1^^L&Gr8IwZ>6VcWludGyZ#fqSCvdondfdi2METzL|;f zNws7Ri6}!$%TG?z(If%Z8=Jg`BVHA%DdtcDI?Y!^47Aot<>&hoK0{K~Y^ABn3MzH0 zGgTbdpYA6z4H6lR;QdFtnN$~`1pn%SvC$pM^(omQK3umaN>21_TB+j_*xnA2z#kmn+e<0W&)`$h1E^(ij09B#hc`IVMEew14QLY^Jmn+TBRmHns1evb!s z9grYqiOCsad_B@H+hZj7=~zcs8|Z883N@0%vJWz8aCRz)W8z?A1D3+I*S*uXAEj=E zuHn>qEp?7Z*}p_4d`xcKL^-)E>TNcat~?udn#$=X@bQmuFpdh#K&={lU64Ru|2zPo zz`*$9KxkHX_m6>Hzi*4K>2$nNFt!?r$a@!+OeU`FgM!SxW<9P1yjG&$2aVTY;oyKC zqBKPsyx|8DDfdob{=*XBOo1UL zuuwxoLqM$rwMNgg4PepO9njeU9gPvfQD|;Z0&%g|#L|K!QNm=Kj^J$z2kQ2N(he=! zw9VQ>ElV^P7c3+_u3};5R#s+Bu}R)~Be9tsW_$7=9tN*3F#l|U-!;_Ku)vP!k{CAW zOL{---6vJJ!Q#!};Gm=wla{9A;nA!{6Q}1s!cAA;^}O)CWiF}*Z8Ro%=j6Jt8Vyd} zTvh7Ku0oB?^+3t`dg}BYq4Lc59JD9cLPUKz#Qd5#=RgK2j;gG}{5yS^+v|cnd?sBI z^%Vss+Nr7?omLB*as7f%fq)98nR=JsDM;vz;Q$wT84%Bl(qz}p4v z@Pe?Bq^Q9n03!%$cc6g_fOh@-{D4>sOH4vSBJ9j!K`V`MNNhGl%gEpmLMm^oZV9BB zK7>Rp|Kh>Rj)%hl7|wZh?2sR4cyBl7#uwwf*7fD}rykfuiJ%hUM$NN*!czXf+=&H* z0YH3wUD|^H4eLgf{fA#i)Jtfnv^NpRDZuv>fK0e`>Jnw8L_?mOu>a0{^)$YOcVpl9 z_VOO>fo3SIg~Qv~>~4CanpHo2d!rqNJkaYUQUJz=2`!V| zNg#(;+tEna)kxR}?}Ws?FW`AHH3hzhH~5_B#KI`TnwrUAaB`;m29&Z*W~S&?P+c_X z2bxkUn$kIU=BYt7_ZzvMRRN?hR?*cgFd2eW;%__?DtNU{y&>=dlJH+I?{{s0(|LNl z|7){L^dNZ2_@72`4EJWtWso`%~R9rnK9BUEQ{@ z6z+NzJE>lC@_D0u{KsvcgG;3RZNFiF*djK8iOz?eiPRt7GXr^RhFpr{{ps?O#Pw0X z0S_cY+~Ykl^;7>+APLWwG@M;I)BNSa8jR~ExOPL64h-YjzznjsHcp3b8PwMAK=XLo zx%dUK(0VqzN<@^J>yyHnwORMpjiN)bRIxm@N#5E&ED1HzQfk^*|3+`c>rzQgYX>>50F zo1gjl;$|gGeng{jo`C@}D|cR-N-*Y~LrfIfeZZdBFktj%y!Gd7FF!ToBH4$Ip+PlV zV&N#m)%8M>fC<#$l?-PUY6%or5wT&T6q&(9^j#L`ak+OC(Vm*|8;c(`ug?qm%@UiK zlSRSl^qbz|J_lDhl=iQ@n=w3n)$NACA}vN|#E2hkkx{50|49!5dIRQmkv)Cz#C*BZ ze+=x{m5B?-#7)Jz8UOE(oGH7#9@$J!_4aj}!$({W(7-;)_PX zqN4re)BC&cH^cu6;UMThz{SNKa6pG3I=%Esuru5CFNZ_3Tm;r?=aWC}0m$xrAwR9N zLF9cb&%Dc8LHde9uD4vO>=0ewZm>nqn zBqUj9ceyPRb$?^s)-(oCt?d~z{3iF?fu_>0&|h0^^cv^5rQF@VSvF!lLH_6?IfagJ zRDNk|O=)ZF6@7jrnkjar&V{*B{=oKeczn)VXZ}+Dp})rW*Z(wVNbl4X3j>3^-9#^h zC=Y8lOx^WTNm+9MxAYsRj_?9u_woK(w-z|M$&;71+l;}{0fYH7n>2S*rzP?EH2Je= zKm!f#Th6ggBgcoXWLZhlvA9aqo}Ny-N&4+kei*s{KNK@_v~2B>l@^kM;$j(8T1jbK z-IMFU>h*1=-0*XE+WD1*&a=_sx(O!uwgs2m4EePhsccbcX&^(I!e;2oP}B|RZ$G8b z6Y{*Nx%b0#V_< zq1*3~szIobM98ZbCcwDf{PMrs?27^q2gl)hMmix6A=1n@P0i-())R6wP~>_RI$i~w ztMK69fx!dg>33kzLqbA=7n{H_I+?@Ux4#?t)~-{o_GePdGBua6^L$f zmizK2Y42*U^+e+>_>76yo#i>7;_cW|6nC%DD$f&<@FfyW=*V=pLb?VOY9Jw|QVO5*_Qt7$;Gl;zTyfR~=TMU7 z?Es0-BWH!``MP(2yR z1QRd_crSN+%=y$k+ILS2UP89Btlrh@ermh^4|e_i zRRbSB;ONS4s|#t*tt@c%f(tPtDx{sLF}FB4(nlA@l~$^^PU<#2yI6b4Kc2y~Yft`K z3j2_U`!^NyC@}-s_4HwnRKPUh-(p!^U75A1X6wCDllT+4!{3mPb5dIhrLBjY0Y8{# zTuE_SLDe*F1Km*iO-YVy;b6&|M^8%yYjHCVQRI9dG-T`~rM=jHZ9EWhw0}>*S0oTW zsFvwinnvzoM|_+7+coMdiHngbT+iGRkY^p0tA=w1fFgW}2=a@Q?&|F6W2^Gt@}Qg(scgW|Wqq|FJwg zvhW9}>>otEc}9*iif7>j4f5KTK{3#s06Q_wR{K=TcKWA4^E?+y25XhWtbX7Jy$M_` z1vUux-@bio;G@<`QCcZaSL9Ka&J^ai9)QLuSpbnhGrO7Pe?7q^o+ZE&@w^rIG#`Ikvpw%GtnhFwC0Oa55?u{wm!oxO!e7 zL?!UJv-<0=5H`iAQ^upc2OK77PPN+Vnq%Hr5DhSz%TX2$B)>TYK@TUWFL3}-u>^+l1e~BL1{HPm6S-& z6Hb0BZl{;h*4C!PWWtB#hs_8n952Xo?g`WV1G?z5vmFj*87kDI90>xADobm8V^o<5 zen|76BnP2%*lz5b9&UW0!F+3h6g*&L&p`tsN6d|%MOm$<+c)6kW5T!A6|bW%ugu*A z1J%w5RExDxMfxSY5PD9*R#rK8@R`jnEZc|)Uxv>z;a#Zy>{0z>H>OMaq5rqA?q*vd zIG@Fe(`sQ{&_pp@642TnM$(}j)+2FQ117S^=Cq1S^=b$l$Y=bQU|>Q1B^Wl1zZ1uWfywWE!l{cyRuJDwiu18vHV-NU5?T`t1rAp%C(~Rcd zLN&&!yX^aY3a1?cv;8KGJnwSjqxP!$%+ZK$IsCvW4`w?=YAZcGo(|Zd+NtW(f%e$O zO_tFA0*??k>uwt|I<8YGQT52*`wR!SEX!=Owo=(mG0|vuZb^lOi=2V6_ebgS8FcAw z$cb?Le13QwFD5u&Kz96?@c-sWL_*?Gi16@0#|G;UE4Q>1;F{l7GvWV`iikwcARD@r z?|HUBJprZW?cvlSFx(pj2k{j}{&1zvRYo*Ea-<=DkWW`sa=0LgXh?Z&ZKqTLD)xvWSW=-p$JNAiu1@9GKU_k{>m`fqgqxn@`^%5EvXryHLd7L`@$G0 zE*exq7-FLS?A}jLF23}=QjnxbSjEwgAS{erd=U93l)v!T2ZlDVP5k|`qRO3Cco!rT zhSC^iMjK;%X7d`r()jA-OB6xIXwJx=CS5FU@hLHb;t+^Xn}#q z&RtW?ebbj)Eo|QP>0$nREn=I2yRK3_?}OFYpH>edVKdsixWVy|J@LiB16q*MET+jJ zDNF5dat{w*ls)$aSrm%Pvw{Z4|1Z=FBK2RV?x^xVA)kp5$xO*EvsJp*__uM8)a5cO z+zmBK346WxZvNcW%UA3Tvo8rLV$K7 zmr2u-(i_qDHm%m!Emn44245;tBg@^J>r<5BhPW!LrrXlX$=<+XcM%2i3Yb-aFkPBt zqVtch_;uu8S74k3?-J5L_}l+E_#iuyLPDJr6Vae-63xuaj3TH^OA9VyWBa?n%rI+9 z%xV(f!u{k#Br%`Ckm|hfOYI6u)JskgVd;dbFA~2;iQIRr_OYqXqkZH>%GGJ6fn|fj zdg(J~%G15Wp12Vb7XuI9_NpS#@I-`|mEvXIkV)8G!Zc;iS=pnNWtW@%h%@`yRx*iG zQ#&aHyEN$az6Mj5oO|@N2$|e~J`pVf4^^MEz(v=l0SbU2ZPdXaPRM8|*qH#g$Oj8b z)#&?CLUJ;RuR>6x3NC?#VeN>hIErl2-r{9Qkr@UpN4tI%cj}N&v*q_@OYr>*Vg)nU z=~`7;eCv*+s;gMbYZ=t;AI-0i;*MsWIJiEMm&(PlRFOl`gun^H_MPoN0QCfz2dwz$ z9vP0{LFSkaAJ4<_3xgQ_K;QnT?%A;+o>anzNFs_fP4lM;Drunjr0sdzbx@a~gpsF! zgtCC`RA>mpymW7 zW8{e4O7*DZlfT@buX#Ypkn>j;hVlWZsqV z12c1O=mxm~Wyhh{UCOV?rv7~@Z%&2!J`56UelcRVO$ZRD)TuJ4yU=WN`S4gn7KzE~ ze{K?Bv64!s%!SNy)TFqnN+nv;oSBcD z6czc(U}VLc<0D+G`=M6Yw%(kd*PWi%Nk|MY)vQa7MVsAq#PgASPhHk!SI|_%Aie-? zqktF}8zX)%c&TG&YYPVtkNV>`;ZabLdF1*Un;VW<@cWmrQ64;Q+O86`+D*zTTX%k( zx6oXi^$EDiyF2DZxI15bT^t9cf3G8eK>QuL>gGFDj2I=1xG8vFg%1o%s#yMUBiMoZ zJAZ1SbP&=bv3RxbdRotQTUkAKVmDxr2|v}!uqfNCnToUsYXaT&>mwUA`6?DtA{>!v zg3tf-1+4#^Nk9KiIt3OX0BQ%1cQ!3EGdgiK1qmp)B~T2c^V!}Ka#U<4&y`-0Pcnv6 z)W>T&-D#;vYVc~q#jodCrE}Z69}WJQoA40~;PCV1&}ojSGEr3!aec+}rZ=4bV=|~h zv5rph!vdX2yV0Sbyj;%Megw2OGB5zopC_98s+TF*#42L%g1kV#*6`);Cg#8VRgYGp zO#`R?E{i=-2}de577A!+bWu;z#6=pDzbvx#FqABd{JYwka-^iNJl zM+cz!7}mZ*5cdJ_qm~vPS<2aD+vr_2epxjvf0Xxzt+}?yDHfryQ6a%2+;;C*`f*CpL;E$x?yPlF0khyOFC;)xbtzXCGv5AH+4YgKhTO zugUdpVU9gv2iH_Rd2cRZFBHik_o$@QI%7{+PFEH?30hJ)@%|`el{B#R*)aV=(|dVX zI!{dIq^gc7B=NxcCLe0$zL@6ntze>aB9$-Nn#nb-A^BJ4NO+Aj0b*o$$S=JAa_Nso zz+Z1^`FL~sIrr6zaiKTK>^2laVIO<*!f9lCml*5>)AAez0dGE2+M86o5yOYbYsJg; zet83VISh}d!*U$Gtzx}pO=gi7Cs{>%igb56(ZHnO`PO}mbqj=iK9$(WGp>($`h#?9TdXv!pRue}N z{uN&NWx?to;$UzAexmxuM)==rD+-DUVIuw!jJFIiI2^jj=(0V`=KFy`}O^N>9;{B zJztuq7q20Z%D?UMz;i5H3}y@u4H?yb`S3FyJS_hDyGC7d@S0bv_~gmFd;f_(AmJ;Xdc~`V)A1cFdvun%wRd7C4i3aNkrgj~~{))0B$P zeU=a^ecd@)ss0v#FRx`KJwuDLq1n7V*hd;c#|Tcht4vqg0xMVpIt!!jPNDB+ zi=V#0gN@^rco!Z=#=o*D%74j@#)1 z{VXs|xjuYLQ*BSH{dP26Li@1N#>M())>H`PH{0>?gYC8ZF%7=$`tqucXn?4 zy+?KH6hQE((z`|TILT5Tq8n3Emc{Vlx2w{Rs+OD=f;twowIed~PlbM*`0`%b*?Oa9yuFu%@DhYqi(s8|M! zrrQG(y|0i0s=z!M%&_Bn52jTaUU1;V6rygoR1lL2u6SRufdCFo00lfY!atrDt!=Gj zB8%cLZ3yqHW{yGQ`+QR2fJr#;d_3Htte5F&Z!CJnB)PD;_yYQpuvg6%dka@y6q;*z z_VtX?*Z9l%@H~EFVAg>|82vLPKy<*FdI5m=QerQ%iOI;i#>P&Uens?L*1RL^_xzag zGD}qEM?&&+-$K{Jr73Zm%$8D8c0t48-sQs*OzG5Qe?KX0%OvTSrDX3tC3%IAq5QF} z_DK1ow+PhCNKE3Zjv2GfH3>A2`T2eaEzer;#{=~z zX0d~IyA-$#-fSUXPfW-SG-;;TYi4|4#b0*4O&$u)^3j5hN&(#$a~ETXBs@dSOyey{GaaIQdsvvf^cMGET{w7@FE>+_C& zwybV37dCz79s3WmB3^x{hUn+Eby%;z-o3GwUx5>txQ$cNE;^!h9Rk#VVHA zl=_dM?{%KiRQ7oj`;Du94nyf-0)hhA6G`SC%m2D;dt)LZP;!MJ3Q;L3c<Z?QhM@$dou0?h#bk=Vt-?b@{7v^&azm`On z1}A1@#6bsiWf}z>hry|=m6z%E7tq9;nZDTV6(8uNx0sa6^WvWFR|AGn-Ksiz%8v!E zpUgd`$$8hfo&g_?~n_&iBT0gnSH%&EjD} zLG6)f>|tP>o<;Xf>t5^kj1<)tD);A#o_L)qT(mDc4A$-Crc5uNm+e`uMjaD5b?5>@ zf&Om(nKQzRk(oJ#-S)kI#t2f1r3L%vOQy0?zw3UjpWiEJlZrs&z=;LQ!rjpk?P7zj;U;YwGjJAL-NNR4l1v726uNL@f( zm$@j>RIy{Xz!VfGjY^(h8d!9lQB?|#O5OhKTQxjA=i0JgAijF}6}s}?WD-L8|I{;o)&cTrbaeElt&IIBA26;1 z>v95{by|GIZld3(yoZ+PkLgQ4AIS&6lF7|;?67$)DV%@`^B*mkRo3Q-JZyHLII28gr>55D}*0*2P zNH=e@jZP`mFicmC&ah6+FiuWSPAJW&sE)}gD=4p-QBs>06wG2fwwXkcGJv>a_4r9S zvg(Ek&beC}Aqd`K+3jMFnyr>;M)&aw3V|f`%4wBtz$rJ6J3`Rc;dV1wsI$i<0GjK@ zMcvr&O?431E_&US1jN29o!eGDJWXJM=n}ln{uf1ASIixNnZY1cWWa}wNCW#daF~yz za?LD`((8|DDn2bMcj5}qQJHN(kw=SAumijr&X#q0LR^nHq+aStjg+)(wQr{G$!4Y^ z-H316_Qw=O5qaC`R&TmDw>?SC*Y^DU4PP}HV|xFmL{7&-&@!yAyj18tjM_qwo?TK3 z+|Ua!5h3!5Yo$Th9K$_{q<-V4{Z&x*@q;v{`tK^P}Z3tATu;O``CE+xc)Gk@M}z9*c<=T?rK9PJ+o>3HcXY6 z&1^9RGIiX@!sIxO$$9wO_XhiS>x3RW=Ph-jw64xGknPc`%5gE+rD5zZQR_y{TC~&N zm_pK*&|gD-iFc(;OXPmkegWwvb~%RzSMQF9i0BWPTjjx<4xXwD(93ZQ{{c{u= zued(vJSUGktR>kWVs zqV)^X2p1=HOz(dDhI2lf!E2c%M^U)mGcQcu`Qqd%uGv)nGqZ8vcGuACq_g=8LJRSs z;8@SXn!@qBD-stU{wcsZc|&W8oW|Yul>B^yP8_9^TPDf7HfUi|W(Es&CBq?AOEHL&b>VQJ}44q0zOy)KgW_n)~27 zI4w4ZKqB)1hOD~#2fIaFN$j_};M;vBA!4Q%hGRtcT;Pzpd$HUG{`tx)r=S223o9-o zV+;yM${xJl&rgrh6tYgB@rc!AbsVjtPO_=3SgpO+ZU~N8pj^$R`_X{#UGV8!g7uCi zLJZa8kd`<*P05Mt^)tQ_w7F{?G}K6J7Gy?q`|odfOyS#?C zQQesSj_cg;4GQYNIbCP)eX{oUkazSP!A;&r3WRe=NB@&slIw$Fh6c+)Gwq^lV*V<% zjV`w#3D=K9lPeL&;eOVg3}bfGp%`IYRQ>^-S_)5a_a6&#&JY63gUgyijV&kx@H#Rkbu%`=9>22q#SG1<@ z(6QO^dbZoR$c+VjqZk87LC=tcpc&{Sg?wzg4+ z1}vm{c90i8Ido^LyKf#H;!^YQiQ+Q}YYGPJB$YihgjB*`c9-F-hyc%$6|xv6z2eDE zzAYjl_j9ILVu^>RSe2IWX+zy>W0@;F8YeQNu8v8czBe=K!(8V0n6Z0<#ta2%$Q#E! zzU+Q%2T(SHWq~3Gd^p&QZZJL1bg9wNqF7Kf;k`1y{N(09Jm3hqUGCKsI`dI`KK=+m zj=_)d=(90u5tK)VG}F+mxc%80&SF@acSSrn+TJ$Z-Zj|WHQ>k>`xNBE+4{#(LRrH} z-b3-5~i|}HT(4`;pfMlbKC~o?~h*QFX** z6lP;LYkX}a$YSuwqUQ~0XNtTKVlzlv`Qf_ER^L^9x|GCLwNU~))4nWWlRQdGP)H9f^r8(0P%WVo_J5e9qke0vW$>GMPFhmYL z_PmjK&EO!`cbhPbBuYH)pyeigLObYF3wpey>PdQqfdZco(UnDuQdUGrOb~m+@s-b} z{<)|#+w_b+y?9V2V_NHC?cTcYMLuS$mSLXTTX=#a(7pD=%1HBGxH zo5!n7{@xG}ozoQU2R?&S6H{X=Qe$oFt_TQ2MCBndzNnulD}>);2KpHU%2Af)7luj? z^4jwh)L-bn4u+kQnx~Wq{ozc%-r?8GC8X_sQH#8@H1n}u>|Bvz&B?NDdbU`$GZOLT zWM1*a&RABWl(EBNw7Y4;rLzY1F0$#0fz3VU7IY&-jsj&_y#ImZ&Pjqy)$|*yXc?=H zld*mL#>~<}&r3ydy_t;c?azE&seR7`=!u0S z%+)-vTJHp4#}NMAfe0E-=c5Op=LSBgEJc_N^!I~tzBoK?4yq{fP^0m$DpAKJ48YE6JoWA1Qs>~L!3^jcH?Cl($z=_`yvptJ z@s4Yuk-Fqbq3wCI+q;fXrQ6(aPJjLoy3ucz25ph@ljl~6I6q9B$C33~B|$Ttj`fM8 zgA)nya^;=leQ$<4^9X3uLX3(KCp9~@pB)()SzdmU#&CX|(}eIx37dS}*2njJ)sh0| z^ON#JS-!{h<}8Bk-ejLY>FRyt(hI$wJD_{GW&cPT&WjxgDv5TytR_PjLH*s?WIC`V z{DF&79qRf#{mL^xGLQh0oxLT77v%boonc8zipq|P?|dM&IGd5$5m1f1vqLaC2FM{v znO`$0cdd~EeWPl9e^T~OcVj`k?!9)JzRRJ*`em}^OqB&wSLw!N=f2~Xbd_KH+KSGb z#%k`3J-n)C{IY;sQb<$LbR$|2mJ0dbc|oj>g^PQCa|1j#lw2s;%zy+7oFJdOLrjhJ zU2Qui+wVyll4i(LU&>8w!TU;??}HK~PaP#s-Iwul2vTsvMaNWOWB6nyF{E0J#u8I8 zxyz1$#dLdPbh)p6p?|z*sk>)sYyX6;vzs+CN`Nctf!>=K)ka||yOIxCaxWr)C z>=kzt<7MewqVCLAR^7v+&J2-6Nm~A3mdbz*9Xp)E<&mD>j;op9qI01vHN01!mcl(c zjD#Y5<%TV3zYx>zTx4c@sKKn14r#%H1?+O0Yj8YOUsXY6R#W`=JS(+zlXgf6Ut7j^ zPWC|H;83I0V&52;D3B^%e>Z)(E*nMpb$>3AXNeoy7bcDO

T9c#Lf{vC#%aEMRCG z?$+Z)Iz{n1+@6bvPRUnQ#hxOJ6SLcz#YP+}?KknNn%Wd7KX#hnZC$+c7uRaf)oSu;kf_y9meMPeRvM{ z(e4(5gI1kCDTP+E1>0fj(3t6B2d9XDr!8rq@cXxlsDZ*XapJ#GBgJVjgZ$oCh!bH3 z2?MrY?>jgs!56x}w-Ii+U$n{G<$dizlS5~rZ?1|hfrD%`QwDN7P>|CJwM0oSA5HJS z3!fb89)waLRGWq)_Qiqxw;3NaI_xUQ$q{+=#M``}atr4tVh7FIzrMYCe0T`+4NZ34 z5|+{ltNflB@F9;JHdBHYZFog0jfakXbSf}nSKG-{`p_?L2VX@{Tw>>I#D>+&yr7U+&rVooA0%hsAkiEecs!4zXIMCd8iJ)nSae zHl!c?TmXW1zKfktyWZbu1oB!=PNCsh3{&i+P9~~tZ<}D)w zn;Id<#PpaJO{7JuGX*2@(UPQa#m95_!Ve{u(iZqbx|^Oy$sGB*$;T>T#`L`l*At)D z7-ucWle_e)5-l*JFR#9~8$Uj$j=QUkbLCt=*e78sUg;ow)QJ_r4{LD!D4l6lrrf+( zJfm+6rpTa-3;%B|nwXn&c|Sck9|JV$WgtBGeDVcF1<*C{f!actt3nOXleLwVr@)qA z`Q4xP@%}6@udg2|2>Qb^N)y%U6r8Y8EK8i|9i4HmI$7nhV}4-~*Ax5g&AK73(03HV z;}=884GD>e*t5nbU#DM}Q4ecNa(Z#Z);+5UXUe8^RS z5C;pB{jfQABFb!LN48xss$G9u*(6xV1~BKVlaw z^h#5}7QCElZq5p1K9eB!je-5Q_E1vAqrfP$uDfsqTrjSI15ZXuD#RdD5FVs4fJ+O! zb@-^LmD%pr)Sll`lgO2)Fq37iwP<2rs(- zF)|%%bFK0kYOyE@ZA+WA?7u0+Rxb-r32Ab?Zh+QeToE>q^kCt;QqdRGz5hi_x8(VV zhfI)+@6PslA�cL=?sM1KaP~^75Venj+s!@=~6BiNrum8CKeqV(Nim^PBdqr z0bRZ3(Yy>Z3{uW^y1La=ce@sz*PfZ4>oGxGZfSBHUfV@3VK-H}OS{m3;I|grmfmK2 z?K<%}S`J;8XbnLa@{k*zd&jL+!b;Nxo=MHU_%{}iP!9!I;>~t&sK63uL!paY?u-c$ zq5SUZqT<37&I43Tx_B<|aPA&*sqf=HI4Ccfr{y2v%4M2@LC8dR$2~k;t}u=4$DR@V zs!HhmX7aXX@~3zEb@N;t7uL(gdGSqoO_v{6kWpdp$#R-QII+$TTwiEU6i|Ue7Uy;M z)WiMv6d!1I$3yg;v5aWV&oKH?r1>Yqa8aZ}LP8Qzi_gvv18kf9NC7ef6#ghsZ)+~! zmx(gH>*2b-xcAzmti{}Csk;jp*j_)=_1M~2!#N5)7(6OHdK7iwbidJsGxY?@i3|;M z9V;E}_EY(pp~kd12TbWVZY>%%8tj6itegXWl&ILoSUDkB;;zpBT?HrsIdlv#wj3QE z49H^i;F?)}PA_-4>xkv%? z`|7ctm>4@@4;nn!uX)#d`+lxGYq)N@*$HH%m8u;7*@AKM!uLE`5IF~^s-#|PrzzEc z(emX`YAhQ9!OIt&Li1W7Nj$b{dCw1GSw#cTkSUsdz$?YX!;_MqJSd@v!AD3HN5w=$ zhW?7bKk}n%FWK=idrZ;Y3EoUcS(WYD;{sWAn2i(+K5#y_gD)y7J{T-Ml*+lj!20vt zv+9axd3BjEImd_JG3bl9m_o}+gCCd(mwiPk-3)f$lF7>wKwcxxegW$P`I;dV;O622 zjsf8+K>N~ea*B5}D-n}V@82W;=rF-}9_jh+%*&Z4*K1 zNK@&ufm7W=3n#ZMuYM&NmN>^9jI#&*iSxCVMR|E978Z+b0QJq~1jc2sdKw000`Sf| z8Z|&=fqC`n6+jvQh7$&Q*PpX23ew*I$obTUPzKk_rq`um@o?Vm@uuC)iH04nd| z;_9TD{&=iJJ=|)jp2hJr+zyE#cxaGLMNhc!eY$4#m2FJXH|=_NacZVA^>v>f$ed&C_t z1=K*pu}l%*eDJ&;2Eg}pK5s8T@Bt~n-?py7@7r5jNCezKQ|>ul2Bb#t`rD}vq=z&x zFRQO_H!HlwcHKYXs4^Wk16kkhZ+xM^3;q2q0U)qqfGG>qMm;_|zt>N%j+Vf#F9$&0 z6Q3!<`Ml^i9Wzq445BvXDx!-o-{@e*ZNH0+h7v&GM}d-%RMZoGEONS+X+tAG5^A|Zeb&*e6Z{oETYFkL1 z?w8cW(AGh4+|s<*QbO~c(;dd~s_^+36RC!|C9|<* zUikqw1OetMo>wKZL7Dkwt#@W%tnzr<-u}Mx{&Y!Z=Gt&77X$!uVcy_WgW>^TsSeP) zXlNvbhs%1t76<5utHXs?zgpa{`v(SI5OHwKb#|@;_&VWIm)Gr?(Oeq3V7@#(2N)d; zTL6U_jDdr52k=$}#&C|L07mZu2H=57D>bGQ#?L2X=X5DgT-4vM)WyG|Wl_xHVC8IM zdfx9xCe1^~O6JYniF7X1*q|!HYetfhqT(zQQslM4TO4BkS#zLaXxPo_BQGoVm}!A& zI^rp3Vm#Q~9Gh6kYN%0;mr2v+be%qf3Y2h#3Gd-`Fa1W{kshg$_GrJT!pAfse?(j= z>O{Tu#_ciJ?(%9tVnnC(!OA8ejt*i2swE3`%K1yo0w}Mb5%m}ow++&{y))#^C*r#A z1iX$OI9JnX-^JnwYdti3y%a!6K3byNJ~hN${nEc~MQ4RBGIV#!umARqqj)R-Fp_a{ zoFDd%IW-rGZ^W9gnAnU7Ij9o=nv+}<>5HELH@w>62cT`Qz5>!96f`s^Cnu|!A#XY% zIy$N6=gp%dFF@tTq}34TBc;9gJ5T^L#=!Y?0QS}9#>N-Z$D%&KTayOhEeIAi_TP=f z_X9e!h&Yq}$lu-&ab;kat}~yJnUg2FlOT-(!}@^5=(|8v@||DU)x8#(Cw2q`rn9>- zDPgnqLu%b#f&wGjiR?T0ip;$h6i78G#qg3i^jCh>?Ofz3hg%Fl1`%?9av))>p?P~4Rbzda}@yoHyXLm?~`GPYs0J6%+3 zj;&7UQ#>$=zJfv0YV}ah>E{Fsp?hwwq0+x@?PspGdBa}O-}pMXQC^|=+rUvL1r$hh zb6Tl5qQxeeXI`tfHZ@Sh6V}(<`VRT6M~xp`AYP|>2Mz4 zNriQF2_f(Z2*_aPS?&Zhz-$=MY}hjhC1~f@_uo|o@zme@6C1*eC?XF)WSsU}h!C1R zoMxhO+|cjGc#M?|Iga|an~N)9Dk=jmbJi1)q%Zh|3Ud6TMl3pPK99id%ryXS41}ZMg+^699s63Wj0GJ9Ep&Z1~ZtV+O&?> z5QX+L-2vX@@^VFX%Kc$K3E8HWMt4l;MI|Fc%gm%FCT$=}Ae2r^>8O6yqeV$FFV3Nk zs`7ETH?!Bus#Wr{md8{7PzX&B)EX@SKK^nhrV>j~^nf2e?`q22jyTvf&^`Kf=p`lZ%DcK`~M@S|;HUbeQn-DMlg zXEh7siz*5UKk3H~<;l}0=UeXA^yUiXISnspS3TiU4y4&=kvqW}(FNVel)LTMAp06a zQ=^#%aLJsWJegFpn_keQ3hIU9>tGnL*IxCXKYF_Y1_o>HWgo1U8p(K0fcx>L8I~AZ z@4s`57PPm7mJ|d{ifd@h1InEXw~n>*$Rmj;+hdMesyGw`5xS2kws})4DMfB}7|tg* z6%As;#(+))^S*LD zwep%k0U6QN%^mi?%j(_71te|H`j=1LO?6+ePud5Xm*9}G5YMhLvc44m%5BFxlwzYp zU}L=L6&Zpxh4_pQ;?hzEMOjfne+4hu)an02)K>sy)wS(DCs{uRR{OM5r=x>|#s7}y4;ATiWZOL7pOK!Tj3dB)7WpP30-gkwxiyCk zC-Q6(hVnvp>yN1*RP?;!zKDsdhbBd{PWWyJ3k7*nnz|_ws_L z(q-fMkLp@lw8(Hdy(}#0?n`T{tAt$jE@y_Fu&ng-?ACvHf$=e4`?g~@ND3lvfnapP zaWg?#NeOV8dItgC_7TJ`Ak74!kpajaX#AS$>m|}Y-++1*`^F4~FxPlISqGdcT)(fs zzaU6PdU|@XxNuSNz)u_$f1y~6J?-PCdpRb)m%?#V(*vL9&nJ4{hJIM+7;x>(T3w;$ zQRptork@OmW_hEqu|_Q@Z=3Zqr!b)Rsb7yiU!s>QOb$v%SSACEeuW=;yOn2=X&@ zIs<`>5s2bi^i_=S5u~L@fkY$+C+ACuplt6kad&=;%+NtFeU@2K*{wZtPUU#n@)24EAoAN)Uwa)0tp)sG!&)8qqk|xIog87sQL*s&Q(d(qN z$^DtKTv%`k(;FxU0lMAwpIrdJ_ZzuFAlGN3Jh`x$nVHAS>B-4dT;wz~%q%RWF5BHY zz$68H>Fei&hmUrLU;@6J$q(2}I<%wz4Y(DM9D5#76_k~ams>blS!Yz#x5xboMtbrj zu`JFbJ=ix5MjQ>zFpxHlD|TL2%05!;=hS0$GsQZ*@SZH@hwN-*#l4#%_nypJE2%q1 zT&k%%uGKUvTas{&EbBI`y|mM~?ff&Ck72pODtxS$l zW3k`}`0Lbh?rl$qh={)5zHNb8Pqz!s$Y@)w_0QzeM%s#%y4$%`!${FrkNcMGw{Ko} zYhxaHpeL6eSZ|QfRUtz(B$Lk9uf8;F8ni7n3L$q5;0IXGIV*TSV;;nh)78Ia%G=`5K5kHaZ>_78L<$j`QB7?WW5&CHzbu@NmDRc4T9W;bhw5uV{; z?Of(-a4}aX=ox2UF=8UiVyo3c3 z+P6#LJzZUs_|LljAa8>e3J}(<_k3`*us8%LRA|SAeBHLfgDV3h8Y1yAf?`)9GQ!5D@^?sGE zBXCmYRFAIs$Qg?DyP~-HmG{_pvfJr5ma9%zte*Rv^DE7Bpk43)y2O5d&}u@{Q&Sdm zmASxct@^N*m%K4Hs%Cd%nDw2#R$BqbybDKZGPYP$SM5}OXr!}=F7qvJa#&0M6g{!4A^A3tbS*ybR=JLF~i<{$Ne`x}V;Ino(L>+R4G81UP#X7OGY1_a`x%8N(xhXz*{7I0c4s zl^%DF2X%RKNY&=mysTZ>eFhww-M{lsos~90(IR(rR)37%5XqdVUP@=|E$nVEl+60^*&a z?%$T{p)6L#(*(hmSv4FhHBgrMmM1^TrU_sP=D$ zZ2Mk|?2(*Ju1H=2IC%I5n{}{jBz8Go=K7d@H9_-lHt=Zls-mJ|4xB$22|#_F$dd%R z*BNzKulTjm{~<&Q2gk=NEf#9u;`P-lgiZqYaqwU^Z5w=FAtqstO$n`h?G7!fL{yYh zXT1M9SwJ8C>eZd1tqW%uxur|Rsuja7zt!>)pRJT}cpMb%2zFe`PqH|XwKJ`r?G_EY zi-17?o0GC0lODWCCs}j{>U}Xs#Yc@5dK$Ira`3qt?2I%u*G*|bk#_@pjPCBl2fqY$ zMY)aIvZU50swzeuTr^$2tjRA+nf}X#c42C^M}2;AUR_=9&VA_H zyV>^L{rYRA*WHR2?mO;7I!Q@0=7`YP-&+PchNKCJyxPIz3`fQIZ(088`|##0zInxR zSYMc(eX+6)b?rP0a03>%KQ4xeAJ1l(!h7A02^rQ;oB_lsBqZb|B#Ia$A7E5ZwII_O z_%@!D%#VK+9IpW$Ea867I$YZmeLma3J7hwe{%ZGw@`VhYqrH>9GW@c{?}CjwDspv(Z&8Y!?~fYb=6IjXCfAVB228w}SOIsp%z)$E~R0b1Te_%FM(uxMn}dC-mu7kb+Sd06ir}Cradj zlL92ve97dkXyIz)d1i{A{fgvI)Ab6|`xa{P2poZ?5Of&>Vc!0^u@W`de>q-WgtEZEv^NFsv{IX8$k378*= zynX$eJ054NtqKS=1gNn9-3dVW7$5TU@o5JQbW)ns-@kt&@M7ZQS#8MuTJ`_!^b}Il z)6;!@eJithUxS4xG75^Ume%r6#~xTNyH+Zdw>%MD@y|0t-Y@45Z{Z6MByAZ(e^W5$ zdl5XYJJAf!R+jODFRJ9gm|Q7iO(Y6hE!puWL90qRg^SnZ*#tT-2#vtg=V5gV5BP&= zwYUz0aUl>t0>jCvntR_Fv__h1y}h1JiU!+;FfE7KWSn#j1{Wn`%vYj9_|1&$_EWy< zqX5We&XPczlH0pPaxS>DpT%G076}5US zmWEcxZYenCPY)-By|bL8tY?|5Y`%M>AVLmP4t8;sU@8(N#&%NC)v6mQYPu4k4;b=RK-Lx{{X-O$X0INuw}n*d(WGBu)4 zXS-_-rynvl&36`!HdMz+#`Kw;@S>X9uKfWKE7k>YqpP-uu$YX;78~q@!#?Z+J&yG^ zqsw07cV1p$nl;Bq6CVtO3*l%|%xOzgxSPePf&@@&HrLKk_T{6`z#U>}8FKj|8SM#RV5l!QdepWyQH(Wx#>sosNlRxrC_s_F1R}-a ziE}D=O@j6y7xv-yB3dU7oQrfai=^vkgMk<@3^y?|^Liu%Rz%Tw&&QgFF9Z}^ft=s@ z?81V2z$`Mq+`sp25;Q(QBFL3NlP`QS=6|pQfc-`d?En0Mh4$C)hShM*`Rp?PwB@t> zn>!~>Iv06ntGzH-r-^g>>dTVE$;QNHF~3M?zHPVZC!+8Tfz@QOR^G|Q9x>%yJOqqIzeWhI+Fqg&Qd;~)%Od2&}E-g?` z0qWHIA5WIbhM-|JH>c(Te|MEHrQYV*at`Q6mZ`FL~8GM zc3|a8zSkreA=%m4db+v^#5da+I$zw?m^Nf_4{*UsbbAI~`N39z81*Hu1&!CqHxHw* zZZK;PeZrwHZ%Y51rDzQNEa^#p>oS^Hb)?=E#t?s3a%5o&FVaoPgs5QetKxX^4d!XOYnGLyVJ!}1hml=-bf4Uy)in=MC^^a$ zW>wdtLQ+CE)q$b$DHRoI8e8@4r9-3u!%wF{Jx(JwPWRI4@3)noCRUn>76&?H001+` z{Q1xvZL@$@6qs~Etbs%e$mn2JH_G!weYiiCD~?GblqA40$7v+j#^aCCl?%7bw#b^(gd&O41svj)9m7dV4qH(w=IlllhHeN`3V9YV?V5Hr0|HSR7 zTcJPLSXFi^o_f=Qg2xnsWu5<#2l8=&{i|++8G+~?w9BJm@Z&Z17K8WwL(1yr2 zpce!W%@+aP{xt#`85$k|fF0yqvH5-lhDH{6T_WqZl3&`_9&8?}s+~PfoloY+p9VRV zUK1`iTnF9@3<$kIhfHEB7UBa@4FVr%erz5-2o$s^Dg>yGgC7Jf$prAb+pCA{&=BNt zGT|4<<9N(gJg>oj2=+iC>7U{Kf=ZDf-+~Qw$+UrKblCUCnhD@H;fO%gTl|K83@PB z2{W*Tn+HQ!;ExQ+081IS%LCwE_2ZlbA${~|H4vZ0e3pO<%=c6Aadq}43qat6{Mp{d z#K+h6;t`YusIT#LkTM@m2kAmzn-9cLm`xYEoUHi^5Sh$XZUTDcLY)=e13+zpQYeYR zAo#p&y(iQR)Qs7$gyC9X{{fvic4x{~z)MGrDybzWfd4Fd96yN5px^i766#~p9Xtst zQgpZBr&)wozQnmjqsM7pS6dU}Mrg}8z*;^!@TirR{7I*~Psd{(;c)3!og5`9_vDyS}p!IgnpVWyZPF-b^2a4*H~Yb>;;^*{1tNVh{ccx z93(g^t;MAw+Q4jpQUi(7`P=l6Rct}a}TEn|*%w~XS_#{HFL^o%->j}jH9oP$> z4Djb5O#q{(R8A*aIyx{;Z2Xgsi2$n0l^U~nYH1w8bEJQD#U7YK46Lj?F>06={w=PNfG;eR{WLBDnZ@KBhe0dU=aqD7+ z^*-Fw8}iGrs@VL8AirpPksR3N4`bg)BN0A2tO$?4uD#4dg;$i(fP$dIj6XqvtfTM{ z2lJXdgM9B$JNK!KC-0{h-sxq;i`UJXC8ANza&dGq-=TPkJeVLdF&pU<%Tg!DZTt@e z7dlUzIHy5!viJ>GD-`ihJUNdJ$9LLryY|OJ{F6`HOMmxx*e5x!cptVmQjJcICW_OW zAEkccAEu&JV-?G6vqi8BEC)CFmeh#qw zoHf^mGVw^uQpz(!*ZYf09y4n^pXEJV*i|0sipd}v95-Kk0~i+z>9T495b&0yeH$J$ zB{vq(?zm8cgC(4;smSaM$~?K_l-yXPx!pM|dt23mfA}~WlDa0x1um%Q9y<8Rd_jS> zIo;?#ZoQLg6wN9u+yll#$7$tyyXwXSAju45Mci^2z4I`UHe@k>f=C|V6H(vrX2dF zX;ytI+C}Anm@w`V&s^IB2ngA)>fXNot5$y9SCsX-TX@|5`S_H7RMvEWEy+_x4VUlh z%sWx~_dhQ7XGRkljX>zaq|=fR69Z-pH0renj$3IkDMAE7?8<*=jo5yW6NcCc1ur&r?gmI6w z3`V5bg08s_!dG9IWJHYBA>XC@bE$G%$0c9BKI$l;cP4^@lw<8ZXn7Nhc%2z~;J)yX z%LXNuv7|Jg+zZNf!WR5F_2hEi9D0a37P7yptXpico_v^G#Q!)tHCf;hn_pR| z2Kibwc~?{n0d-HQ(pNL%E}hCf0e+ZK+Bgx%uBEov)S61C@A>}S%O%=}oQ^zueZsD9 z3K(|N-~l$`9FHF@8qL;K4m36(eyG=)t7hZ90|*fml#|tm{{H@I0YPMeyUW9U9Ked% zfV#p5um}FVe8nOq@Gl0!UQqCX9>dg>GNk(h2PH4mgs2-T6A9Fxg&vrV=#=a24lW7l zKK>WzFd40!Wap}lnIr8B98cFCMWU^Fcs1_rC!FEFn3jo+yVltZXcuy}uY1e5%5VE> zk~sMC4M&ufM^m_RiW=iho#p#sAh<10wAG;iFo_Bo=@Dx}U@6IAJNVnmgTMF@PPe1a z`$0WlB>{_^Dxrsg@%KVC_2S69%5%x$nnOayd=P-lUoCg0ya+0cv3N>iV(5?*&%_*D zVf5&fh*lU95iB%_1nI=2L|b(hDQlbGbUEa)Uy?~jz85n*Yc}UrQ~uceD`(YBU+NM@ z_{EM@o<)kbT!r&-cj?)aipRz=>5)T($j^1Br~v9vHczr3KGbaAhq98ysj`;0nvqm# z=V)0agR+hUrhg2i=t09nS$){$20G;F*@W`WI|gxaFf4rg!0d27h9veQ-$x?!f`#@? zRaHBd7L1aKK_Vr?CZO4bfsp5d51#g}4bR4S zbmUqkiXiXDQRVhke_oI40McHx#1DJ0fvc)(@7Ra)_%>bz_uM`deEu(m6uMmb(rAnDX0bv?rPqK91*e=K;3%FDjhRS{48XeUygIu9}gnQE$G_=P(9$Qusa2E@;Y+ zzJ??|Z{Oki|FMuF8rQ7ZKuT10L>GYvo2qN~Rwp|*E_OOjImw07Kg&ZH5IpYwY>E^w z7aZ(qhp1S;EQJO_7AU{`$O$mB<7|9n7%!>IjPtzQANS{!hV`o34BuIJ5h(&izbHM7 zd$F**f}~wiTwu0o=;qm7t=)5O$S}2w7$ZW|o`!}P`N))>MXroy5a-}3eY)R~37egT z*By;ud+TQzi9?2sRVd>+G%MmXQTgflmBx>0?S`t8B=A#6<7lZBdcN;&YIT+tMn+`E zs-P_aihMVxE&`lByng|!=NoZr(v)y1TFX)@!9@J>q=dF|d~~9+hL-9VI~6Ng2=Cf5 zys9X<81o=U1y=Fb1xGWE5zV>B1>XH>RCotQ3cE47CZW>rjfpV@f4+91_V*`jw2Obd z)Ci51QFuZcE-OoYhgZx(av`8gAJVN~`F;RNU`mu2)iZUheN03=mch|I(s(HqXFVL( zT~&2;&Dhg@=0`hWNh~h#lmaOw&p;>4k+R}9G~rb4`N-5P8V+F&(trJX9atv~n&`js zT?IPgK&S;&mcZ1HfSOuDSlFL-;l4wZiqqkELawyxUVd6Mt{3V3G#&&mug_os`rd9A zFK|V9cKoJSgNSC||xak_r%r zy1R2#s|9~B$Bxwkj(#=Adggx_xxmlxx( zH<^nC>B`+0#~5~7zD$wHtZ}#?$|HvSBF5qmA`&C^cm*Y3Ctrsg2q-4*a0KMRu8);F z;3nFb(8b`)y1f>odct%$8XFcq3wU+IruM*XXYA^Ea@91_N?9P|Xq>J!Vub+Q&#k z(v$x~~R0<1pM zNQgc%Cg%3u9*3)3`R8aL8Ujrr{^HljZw+$P{G82+4--6p2U`hB$y4FPNq8Z~48WgCI z$vLaT0Z9{*;mcKlL$E$Kc&V9GAR>Jb9z5zrfBoy|#%D>W+PJ}5DBY9Gy-nRQMO{6= z9D;yY%}R~Cd*BU12Da2k?IPpmtJmMOLRtPGYkIV6EfsGG5EEpY7Pa2#oI1Y zG3s$RV(iRVQ|jkj9=Fo7X@A-p@{94y#^dE7X=2}O&%O7NnH(N{*qg_ifQ61IyqXqE zVrZ|FLX5m7cnMJ`B)beWh5lwRQzpUgaL!!Um>4)*u*B%*a3MQ1`RaBaCqAHoZD4-} z@%gj2N)%qb#(vKDp?p@hL=+UeXJjHX-%?XjfQ9qX>MGy*!oa`W7~>?|jh)biszCpGPA> zu2CwXjc?ueD#A$WXOy+r?20_UVj=^U>Y<1gDExc>v1eSf zS=qsuI4v=8E`kx0WT73%8>w=?e)NV%SW~8~x~oa7$Q0CT2Ip38 z>l4~L`^F^+v&WNBW%nB9F}O488W&!o(p4ODzD>;e1luLdMj2vPP-3`&j!hz^{rZey)|cBAR06^U&_IQ2TaB1lU? zrZ2fhZgW2_rGP$GW?eSpo(8Gj?ge4a>3?CIbv_ym3kwUl0wVIP%+KHMm$hA9T;#GM zO!C^;*g(dttkn%*Pg~#oKB+4u+21p!NoV|?O;R>^RU|ABLJ=ISVJtO^QYC>tN)PG=} z1Hg0;FDZ`^AwLBT@?910!E$kQl-sE=MR}poU++9k)#q?&7h6L+yvnj)#K}m!@s+^N zo9qMh7tgEJ|9`c(*a;&=@VMP)e+HJ%9ROs3UqHa45u=4b6OjLlr_*hj?f?asE8t z>wdlynRD_c5HtiSK=`G!l=ko>V>H?_ErF?u_3$H_q&Nl853(Y)TtD+~d6DdYX)LI$ z@D!j?*~4CF zs7{W$=2pw;Sv;}XWn%OYC~p}#Q-MQkDi_GttnB(j0Vc}r6AX>dj87fAg^i7lB`MOv z!=@{0mvKCqU3uEHtpO;_Kxs**82hzIdPaTymM>a zsbBJS3C?J+Sr@Dgxv+_wU5syv2ROx zcXX~B5!TSMduX4{GdsGT|-a)9&rc(98pHY;M5c& zEbJ|%rK^UBsdwgjV#bu-za^rUC&YROJ&e|`0H;@>g4vM zEk^g!A#c4+b=mO{ENbB zh6@9fXg+SwOWWnskN(}Uc#atHN>Xo3cS{e(kau?N098ob%xvvc8?b&jWFfyt(-7wI zZH@&?(`bz*D*vW$oj>hZ8EWEQCZ!8Ao&8E9hx;wEs|ww)gv|e)yIvm{biftRH;|G6 zG^&_b@X%Xey$6qwb3y5OuIl3A(%s!nYIw`-88#5Mxvqs76Viqwy~8;YjY881ZFtQuAcXBSsB)*IG>aZ5TWBmH z4W_5RnB`wF(8m@jtjfEhLWAJhAb^Isq@}Fv<*~OD)kZfHB*4|k6tc{<-*Sk;F@G?{ zgLrk)1-f)lFQFr9Lw^Jp$aH9AB&<8Dfq1Y<-!cSo)}4R#8HAd4?dqs)(0gig_~P@N z+K?ZaOYGEVj-H8M%mOe?aZl(F4wdn-dvIwaudwJBoS2f^IXrj_{ziSbrH!+7)pmWv zF;O>%{M>|BvS=!IUf)ep^JL|@qAD^%Ks=Xs^wuuTXf5HZGUaFqe8KieOkwY(ukrZi zrN^N~Tje5qAwQT29+u> z^s3~-NR}qovbAMMAH6!Qn3-4~W25Gqc=Ri`(S-WrdSIs}^hMH%VLLM+s=CU!wEHWo z!3TBCkg3D%^YVQHT=F|XHlz8`@pc;ZBj@=w)SJP~@>Vi$0Z|enMP(FCg z+iY!@;!mX%#{zcKl)G9U0w-2EiPcYx5&v zg%`vXb7k82btDXP1I(6^y%4Qd9~x-q;6T#7#DHbDOan3m^MAykz|G0I9;C}%UZ`5jq8p7q!)<>hd_rr$eS;x5us@OrfDcEb-H{XP%PYoZN zpPE*}^0(0wv35!yP5&es$aAn{lbuMc@{b$+kL<4|S^>(`6u@~02I+KLw)AZw5gI7y zxh|~koBqgInEy~^HAcq9v!H->`2pxKQ|Ej+!(7)`%R)4@fPrHj&UwYSm z#$hYKw!knO^d`hmu}2|nkaN8uDc%E2E!cmTg^907spK;kmkIv#LUO>~_V^YW*nV_x zp#>9KgmAgaA=6~HxT?AyPs`V0Fq*q#V&O>v^z_eN4i2@t^@%It-f>j9huP||OaCay zMfLr=Xnn_Wa{<;ZOO{77&Y`NADpy&J<>P!@r?jsl1?}VneWM=xa_Eaeg9+8vSCzv? zXKw}%heK;ev0OIt;fFsYH3lJih#|&<(ycfTqf8$2sdw1}mMPK#5z@v;;kV3}b4B~z z9y*dp(tOrU{h+b5)Z(z|vi5R$L9K%7QcD&cC+k}V(=J!ekh>SOhr3ctq6F&b@n#FA zjqNe~n>qcF6gy}0kv&HnEmA|Et@*4S_|HCsSGF23b%2;|2Mj=w09H?d8e)L7$Z(Nz znV7hEGSgITIYW+q`^%mppNzde6&8RWvk zLLmAcnxd_VPr{YD2k0`d5fE}5CI7O2BOvZZ`_kJZQ~75irZ}HMbq|}eWa0i-H}I=* zO!fFev{+bZMn)&~bL$N`{41Fw$H#qTgPYp{4vS%Rk2?`G=1%`sJ#`#6c!8{neblW7 zCn*jT%7lP6v5@Yr-9c&B@VRRH^|`fiF-|mJF8N!F+iYQZO-Z$n_fs+PN+10u>#KiQ zMp1~FUluy1x=RcvB0+m=Lr+jZH!}QB2wZ0OE?)Rq+m%;~jh(%ru`w?vN2U_{`Iq=8 z%D~3P2J8(#e)OG>Z6^cxl`s7Ki(Do38nwIxruW}q9X0K=X3fsK9DN8!qTX!vaX4I| z09%N{ySG6iQ5zI?B(S3zE}uEua!%+Ww-Sw2PrTQCBh#z#wnuT(O715K(>+=zVW|z& zQih%FxVR5sW&>pKg=llL zviNV{%=#}nKnn+We!#^g$I(Vc8{9OI$^!$1+X!`Vl+#S^ztxp;d&Mgn>w;jqcKYS* zqQ}8Vs&GU|ltbb>L1kNQXjX?E6SS7C-B#&GrJ(Lmr@ar0lhFbj?PhN=51M|7LORk@mE}S3`ykmO%4Py^v_WxgAMuxRCur1O6vn)&-C?p*p^pSWtV?Z@Q7MP z18^!LxNl(>K3xF+@%i)TEKXN4YKk zTVXGRxPc}~&bTeZH1g|R$i6SGI%4_pr}brQ)X4W8YB+9BTa!T{cFP;@-l{d$H7AYQ zCj@7l@KkNSW8QbvW_RB6OqcSkShcM1q>a=HgDvAyOSBe*7G1&L-ZB6-N$d9-c`q~l zQA1ij*Xnt*cjrbthXF{8x6ds2;mu$0^Cy95rDQS-2M5neCcmg?|NMMX$4_p)D1C6{ zD6DW`xCyaBxV}2qpVwU?+VjFKNlE2fy%DuQ2D>x|}K9`~VT5P^K#&UK|Z#N0REZnUA zg+GR^2|MM5BiU}&<3Qe{sF;1KJsd-2K!beZXRzakvXb!9gMtLZEH^#};n)5I-wO*V zkpd?w^n~w?MrG&b=POmHO@1NaRYbv#h@p`no^EKf)?`jm928NmH0+J7g5=a%l z=t54YUswPal#GAQ-Vnjg?K7AcJ_Q8@ZEa8C+)9FipaLf$An*?R#hqDLh>eMPHGzfx zS5vowje-Kcvs_0{FQ=g_EUhs$+r}aEkA)??N0Wlm8R!r{;CZOue=FU}dv{889$OQt zh&X;0Oq5^T^l*x6Ic^R#}w$uC9y)93l*o+J0*t}&G+ zC1O{tziGR?Kf4Sn9z%DLfo&`#L6C9{5dtBHVI+ILCol@Cs=(`Ls?lK|OkcLPx4rJZ zVuTpz>gob;E%*W`u2eV@Y8o1VWVBk&u`)a@qXpR0PoKu<#!!sb{Y1oucRcP7QTU~` z485-UdYqHh#~1sD<;N|9sKMP5z5H0TAvM%_Um{3C53!&i zE5bw)C?K+)iatly8Or}%7GOpIEZQ(arYiJ$%b1M;Kj7r_6zCD&bp@fpBD_Zi?9k02 zKR;k!I>eMG4IT@?W6ga~n$hx+TbRtx<>KF&^+#88YB>4B%-<)PPf^lzPh^d7Y_MO) z>aN15Ik7fhn0#Zx79e?m{i-d=KI5+G_V3(6u~UEvu;5bx$%`RlRqjjNyo%hweD)j36y8|KYw%Pw>~hZZcF`KG-j zRN};l$m&lw!~vOA7GyW>B>Wzj@wC3;Mf-S2 zvLMvzlGyb1wDi1MqtPjz4zJZw#OIZiwMsF`@565;<_SnZXb!vzeE&sIhA86aRk@5z zMsBVFxJqCF?#qam#A=1q4}Yr^iaj>x)>s3FyoCh2oCNbA-oUrX$y@5}XUJnrv z7`c5~g2J~7$&DIB+>Ed$z4X^ z;ocbQdSR)iPZbZP`I6cqbQ+D>W-6!(Nv?!OGgkhCRT2&8x9NiM{zB#vcaP2!to(4e>`%r5Wq)*}N{%u0k(t~dS(T<92eWa5`l`o2&Cz;_o>1ge=C-B# ztu)Gx7ksW+1D#xO<)Zy?KyR%^`O^zu8%jJ1)=IRHplD3_5ly%0)=)Q)V5BTD7Nj38 z{wU3Vqi7Njp~}SyLKq*DQ&f@_qjA=zK>ma)u2*5>Zllm7V+QoK3B=JEfH{Zs|M#@< z*7<R(@Go?u_zulRj60eoz(LF-1LIt z4AcD3p}^J`Q_Sr@#SPr4inEK1R`Q06oaZO|l8V)u4w45oNoqg$u?mcL|4u5*iLoRF z)FuU_7t3^&4HZ!KmzEY)_Z86=A)gMyFu&vX%q@>=N0N<#N9#=a!p2tgU7LNYCoJCJ zCLN#UaXM|{w^t8LLwfVwK|jt8i~yEU-T@FLeMuHAr6sY8dN|jT>h#9z?umA!+4J#a zZP)E)%GOKkG2g!?79l0#E=>w}f$<7aY`C}!x`Vg()j#Je$dH|rQ{V=)2lNX*TieR? zbnW|{K9Z*oc~&3g?H))aYeEJK2dHk&59L;h6?@|!rYvI2t~XOA#Ry}Qk?fFc##ubI z<+=B@_#eu)72-D(;)z>5G@e4tKh#Yy+5V=l_|3$mIKiwiJt-&m8+>mTH0&jL+B{Io zS~O(j$@S4;{-yG}f6XW9AMr%*CQJB78SZAYBS{RZO`{LD`qA97V6PuR z|I1ycc<#@dZC|rmZTW_8jpBvs{Umo$mYr5C|Mwl^JPNab{9>uurV> zmyD`>Xs5i6or^gwrjeaZZDwU&WU$hgH58OJTf#Pe8F|_b<;N#zA^-9`{$F%u@ypk0 zs;}O3y3O4pIv}n7DdzX=PQc;R_9y^nf@?Cvq3SY^z3=q)a@K*cfH3phv2G4<3_J}^ zs^O%=XG@%<8{r|XR#ix`QYkj-I4V+)OV2v)=3`M^0ABM^b{o!rpx^Xj3iJeg0aYcC zsAdEb)gVv(XEF}yg9ffTA()`*@b93cr3LC7xggRD6!-3C+ou{_TI_lwb65)%8dW^0 zITGs(mmjgT3a=37$G2JCe{1|)qpF3A!XFYPy`dD(Vpt$X_@uNvsP017<_HP1W-gUO zdq?xd0P&>(A}$FtZdwwlvTAfuanDwPZA{FZ1_?%BNELI#z`PixN@pI0GQ8QKKXbZ1 z-J-*Aio*|hAcb{1QYmbN9c9l47uwWdq`Xs}Y4MVlIDZo(p7lJ@w~SCUKpqVr9YdLR z&iS%!{pyt?A{?Ui9tS~==2cwNO!`vW1?r7iinDIj++GqTpw8aJzLV%ZjaFf6{Zwh; zSHcAviRZ6-;(sn!yrlI_P1=p;MJecdU0|XHQiL0#xum=;zvh>@x#27&0@ujL)cunJ zMKvvtzeB#3zth&2vV}C3e)nApvjq%a?&Xx^xN<&CMY3KMygoI96Nq_ZIsn6Ll8cDF z_p3)WU;sN{AnDaWlIwsehnVTSSYeWefdkU9o@xN<$X4ZSzyV#10s3F69*vco#(UUD zs218$p1UKP9Fr=ZrhqW@bVyr9sK5a4rhvzs3yD`5TgCQHYWvd52lZKm+ZKyDpG=&1 zJWh{mq>0Smv;;%%IzQbU?sj#Y+@R2-)FM4+h-;4PI^clj{`TMNK!64e9zk-Sn3zZe znH)$%fOU=9N;#j0pXayyblfmKI)+nYwI`hEqXzV)fo|~?hGhz8vpr_0le49>yLlLA z9F^ENraepZk~)40;C>$zMuG2u4?jL?_zp74{5H=jE+{M3B0*2_xU2VpLA!YH;2|9A zBOL3doE^R#?<`aD@qQJRyC{%4lL!-y`N6S*^|3@aqA7ZJHgV}T^oJJv_E_i}3W-3W z>|f=EaG9{Da}z=S>u2*_0(0yP&oB7C2n-n*B~YXM1<2U{qz=t9Q4+Qj0~RR}fQJ*^W4UqTB`{d4ZH;9uIUEeQcE+kBx=7YrPgMnzE#29>yXm1>2V_)^l z<}*84azqiD1$gsJ(3Ym5o)7kAPZeB5I&kB8`QIxYz-vUN_B%es+My0~lAZ~C6Ss&? z506E&ghed4^|Z*r*~5!S!awlVCe;!jQVj(TX}CHhQp^Otte>$ zELZnQ<5e$d-&>cPEfi>%t$}DQJr>#(*Vf{!p7tsCg&>MIEJ#z+ibfnvul;(Q30(Gf z{q$yeR)1F@MRdS|XY9S^z45<#RR25Z#=u?*oF4Tp=-+5@2o*Hc1Sf8JOocm2c2<-$ znqvprRY6-$BJjh~?C7yZeoqPel~K!IW73XrM|fU&w&T2d5lh7wjr7q^sOIfjr7C!)=^_mUDL=!t zsTO0cn->0FG=(o>1a(7Ymco`kG9DctMHT0KW?=aJF1TA7*m*VnAZGmC-tWK53xV)_ zQy3eOsysJ*3(0`|tKlJYYez?6>whu)F^ENV&r`5ssm1%2d#CO@POnWkdq?J!Wi)m( z463<*J`uH9=9zNfzrD^@^@|O7To}kA374XOpRZ9aGn2l)1Vh-RQ&s=Lg^LQ&Q%&%l zS7%z$lCY(Sh`Tp(u<>!Kwb@Yw&%(MnyIVI4!_=nrT=>%ig_W zby!?6+&CU4nq+U5(aV=oO5^9hUx*!+=q2BOku-aVgj?FK*czQQXSW>o+?#%k5|3Iz zcA-wY{`oWKbY*zkEp#ryd6Ob}IBb7nZ)e!0Wvz3Qyx_y~$eVsqX|fNUh5L1x@`N6 zR=VV-+l^&Cr&kVd5YB54Ss4oL+Wrg=N~g_wMemNamiecH7|bWdGU4M68>Yj^PsG8_ z3WhF_U(!)m@waqxePl3@uMvwH%m4e7+JS(1RawdK{3)+LQxJU@OdfIk(8_Y78pjcz z-=S290zb>PZ&pv_LMumk`;c4?OPn&ZkM9GY}GfoNWI7EJU1CGyc#4e%5n#Mn$d5GYv|M_)8`aWQU zY#tm8*`vP}VL(ofJE8)w1d46cJvmJox8o{Gz^6!&;*PD6%iskRhRKz&|Hsu=Mpe1B zU2`lzKu|(bq>=6p>5}g5?%dLfba!_*(hbtx-O}CN-@@a0zcHSBFkt)3z1F?fmGhcY zLFVzFon4)M&i+r4NXV;`xFR)St#&LnhgbU~FlpUdUOS@^H*A+7&6hz*jfXRRYLqyY z&1e@hQ7i*(Q_0&kO<%;5ateE$mF1K)`V85kOIm5oOm>e3sVq*8!(T&PVRow0jM(Vj z)W3$3qWD*3?i+>4qS|ChW0X*MFDw(nm?_co()C$}=(DrIP zNfzzH;8#^6txQh$w$K3~l9}3ATAZmI6`|^1NTSip-;vRIWmSCui-8c#NfuN$y$p{f zsF;6x>H&a9S_j$RUppJJDAZbP;@Hn)~R zVecI6sUhG4*RcIi%HF0YHq1PS>W2I4Wdv*M>r>bv!P}%L{)CRdw9Bv0^hnm$S9g3D zi{A38A}(B^Tdh>)_)R5W80{`_4{{H8H)Vz0Zx{MtC9C%qQR&l3Z7AjL7QNXU(zWKt zFAeaLu2%T)sP6X5PD)r+Tz}n{#aZ@w_Veo|r)Ib{5=}x8PwiY+EJ%l#gfP+z$Aj7O zzG@BrYKQ$LqF<9edShX*A%{6bDGdcQ&4Jrnp+On2;OU^~L(%n4PseT}p#%}Kw&;uuPr~+ytLFHAHpCI17(Z)B=qcg8E@&h< zIAFJDZc;6vlBP@_m?!v>fFs&m&3JBNZB9gxM%TeFZ)mUOPFdVLKtA*^=d`_4)FuRh z5f$xoijwWtl5=fq@b0M6D?gfFIdO!hZs@<)q``GR>KnHBH z(aeLuUpMRTaPPRA;+HM1aGNcqxSA#GsK)Q;H|U?Jijt=ZyPVCpwHHXT3p$-0{GRI{ zb5dM6tDj1yyfL*DaAcH~UN%#cRb^~0!>>+H%tLQ_1zfq65+XC=yE@i?QfbzfT}KdQ z+c#f8X(9Ck@mF9W16Pi}g7DFZ@Oh~+#g3$l_6a?b^VcD*v&TN-9RipNi^Hhg7IFzq zM-SogiCGf7lgqC;Nb5*u8}chFa*C3hujKi;Wcj&N#f4OP zg`bM@KNYOR$e;EVT(3{u`Nz+Sx|ySDO39Pw7NbtWc)EPgRUm!mOUPU*MSPkb+-B2R0BwnvykVB)oA-(al8JKxU8|zp z=%|c~Wkm$E@M42K(Umb|@M$7Nyv{rzZ4_t)O}*N9*0883MnKjE6bQlKHK2<{*R zmM{+~kbF0axN)$WZ#wT4)e3H`Oofj|s!edm?VDnrBb$cSD)%NTK&^s;zvM-kqskzL%ZCfUuS&Kf~%6MEvw z)*oJ<_Ee2D`4Xgb0m+ip{O|MgW-cnXAHswOANH0H^*&W<^&?b<3_TQS*1Y%YM)0e4 zrdm8_p;t7iA0sQtTxr>b^m0hp8q#O$h9!rW?a0qjUtl*buXUiH!C5Y4te2{u-URz* zuA}CCFjqgXyzRQ@%7F7}<2oZGa@fq?d|5`9goWpccV;LhYzYGW)KK&x{9&7n3wC}$ zuKE@5uZD92#-gsy&R4G{)#35b0>CV2v-73JHucj>|8|3N5rO)2ch+!X`t(b4n>!yB z6_{;3#QD}eIrr8{zGoNpy(AJ_^$YbxvJ3*9zq6R0rT zx1${Jr@srJZ)v3DHCn%W5hg76SmF=Y_m~v%4M~MAv(0;{9wGR|ww%sjjHY2NgBIt< zg(S`}zYqcAt!oKU{ZvxzCnUe^If)wyZeeijgHAz&VcbVep;>eAWvMiQdO>uZ%-RXj z*!HS3QKC_Gq(Z&=J6`>ec(nt~AQd&1%h#nqI72cMQ{&lP5-pe@IJ1T7T9T(@@R^X; z6MvD^wFCl)d5cu5MGp>_0Nqf<8JOt(rccE2bFuJ#$4h5Imtp~eRJeb0okwk6=c=eVB)Z2Eze6s5L(C9^(4AYDxDwYF ze9vTko3v(!DxZ~xJd4|KA(?QYfnqTNvcuiuo*!$h@4G(?W+lQ!0+IsV^nUf8H zRN+r3!)#scFDil$o{rE$5=#*$cS+vay;sf7cMxrZ&%UOsiXYCL=gdiR&=Yo>si<}u zEvH%w-kW-sG3LME+X{(px#w(n$_iTXQ7ej&?X!>pCI}FHz~F%bo3F3$5aN^ANn*rv{#d(3+tn9Ug51R zpTGqrU8Q&B9SRQ3pKc~TH^#VTyTPP?!1=j)CI_)hNKqZ=9W)xM#aMXd9ST!aYn#!R zY#wrAlZ#MuOylW>XvCQM$8y>QR%@ki3x)x%C6R+Ki7dwf&{iyoZwUm24@d|Jh0U#1 zo6?^WAZ(adBDoYY`QP(N*Rk&7gtSB?Z*ejxu{Z z2VKv&8c=wWR~Ro;vD)+baK*y9YHjn17pBX)`J>OzSTu=&{xkb=9hXG#gT$+RD0a}) zU3ZCp`p^df9Mzg?FSZM2l5i2X~K?#Cze$c_3 z7wdsJslpoP9G+K#EN3q(Z(qaZ>`6FZ6n_u+&BA4%vgs?q#p2C5FqGi*aMs7GYzE_v z$1uxn6q;`t`@q2k}MC8QW;NB+ie?VIKNR#g==`H zCinM`zF09S3pID}c|#7jjFSjl{aO_3x6qOb9LR!x?M>L;yDm@)1(oWaQPg*)tgjdda2r-o*`zfd4E9CLh%T+7Wm-z4S#EGIhsfh?yl2mp{^Ekz@mA3`{!vgd)*m6dNzkK;j zdSxWDJwpTrkC9OWSTg{>QK%BUAbtgY8u>UoUL3O!Fn^-#lTzjE?84~!NuumXe@UGE zi1`v3R|G76$H0&LmB&Zq5)Qy!#t16w%`EQhhGPR=#GFkjO`zH6aaT4J(lv7xdF}eF zEkPSSI`ZD(=9*qPYspx=69qmk%6>WP8~w{;h`Ou0zm>J35^X696dM$1O#Zi z1voz3&x$SYDWVbJ*mKG)h10d$6`TH`>xa`fFi! zdSO<{CQypPEjHOay+Bz`T3#VbO1HDQ=-~2gII<=_ieCsJaZ2r7rf#MXXs`@$6hVk3 znj!bs>3Pn5Vg+0uHZXqE*jsC&%4<|g{oLBg;**rst8#m;!nkRd~v6fp{!?h@~=nu_wRy*~20sc?;16?Fc%x*li1c_sj7Xui7A`dXy*b3EPH zsp24aoy~)^XJ}Zd#n&&VXl@Q03a_HY?TX^J98OHVk;o`YoMOZ7X*f5v1up{jp3Pw6 z4Wr|d#r@Vhhx`eA-S3a$pc~n)>;lhVf=xb5cLos(Gx^B(mc%(<-)+Ai(m%-Be8f6H zrkN*!0`=278HRI4Vl$kPUq50HWr5DSx& zlOu$EE<*h6;D498{-Sb6!nhkDX^>rUH5^sI*!ol1K_58Sf z$7*>;WfV#=g*a%25U8~ZhbNwIN*ECI3{cIMF5d+sY`*0+F=?=Oc4wv;#TSuLR43{m zpz0rZgV+8Z2G?+dIA@ciw_Bp8zi0(6HYo0$2?rG@(2pp8@KRI(L?&HX_aqTF9oJo+ z47%1Drq0rYe!ap*hy-1E#(#9Ggf3Pz06_xCK9e*K`{Ya;$lAD4I(aLxdsGwu$X zp*|&@DP8vZfg3`I=@Q4Q`)_c+`Ck?CWe=>$guH}{YmFv>a2YZK#XQXOm1ju2s&5uk z9hAd-Yffo6Q@zB6`p^<&OQh;+#seM9GdhAE!itZe=PBxTc@ykm;uVu~<$eF=Li5?g(?XAtSja1GYhVtVc9Q!I}l75p&j4ab4o zpVvfqq&rp+{G3A;aE6IK7G}v-8yxIoCrvFj)>3W<2R7b~`(0jOZBIQRn(jOb<6TX4 zT1Ylh;zTtG$IFZ@czW1y4VjLvmoS*+Wo1u$_>9#54b*=8EmXg+uuq=^on-SUCa@%{~kA{fvZRvG!oONBDb?+^{AHbwFg!``r?g?$r z^kA@-oW6$T?WE2qXZX>1zAN<)vG+AnxuyzCi?!0@Jw(*G<|PC`md z#$G}whM30E``zpAZ33*frq21IJL;atsXeJRXcI*xoblIv>L#QP8Ee{7_($4!N zj`Yj8M=Rk%N;F-t(RbL)zs%9nKOzUf0?T92GMf}b1P%Ol1+2}<>CdVv8k%vLfD*T618lN3KB!(#tPNb8^+}#54d~2h`0)kpVuecZ0?IOoN zEIPa1{W8yPyUu5gxO{+gj!v{>N|H32Lvsz#L`5qea)(ts^1tKt9q4@CxUX_O%{s$0 zF(!Ws`FRBS`5DF!cICSMk~yWB_3Np$wqw*;N^A8?R#gJeL3Q^*yN@=Y0Ge1@{&;Fd z8*+%Tre%I+`Nb#kq-=Y0Xx=TMM@#MphpQVR48D6NgcWpYWdNB6A%u>e9@gX6F?BOL zB^6cl{IX3gLP@Sg|DS~G3j1$=s=mp!=iQYwC_Xfwd@7J8j6xPBX50DAva{5Kh*xnw zEPmrq>-H!wfZ7~aoEPQI<8o0zy7nz zvO6es7pWBrhjYYVfnFTSKO*V3A@n{HGc%)o4lXYIvIqm>Np)H8-v@Dp9c5=K-5kRk zEpsxZqV~suoWOE;e0+R(n3S5D1Sb9G&m-N&RuaHY=D*C#%bQuwQuO^FC@!HkA=y9i zv%j99Aw7-o3)Tqp1!bd&|r9YO>;hH|;aQZIc6K zhtA67cT$0n~#|qPc82jFN*LH zn(VGuKwMG~2wHVB%0NSl-$IWE_4A*jMjowR0p>qUS-v6gK!jFY+TRPf^|4 z3mke9ByS{qeJwQF;0!LDJ78(I;+UkDW_Bgt@=~!8+gb9%BFiT!CtDNp_C0XL-dFi< zTVd)w29xJWE@5sNpB-WzAtMe^lcrQ%3G*LjIS0?@W6RNvLOXr$z-Z z@)|82muQ5*Vs;OV*j)!6^ch}&B^KqbJl5~>jvvYU43WTjrZ12jI$$&(|Eh(CNwXN3 zw?xDl14WRcmNWB%YeOy5*lz%=iGcFqLveb#2NIyNo&{AfZf-5W84hL=VA4`kKf=Mm zu-SGMjo?L!gBIQE%b?m;IzrLkXn)%w=QDJhm| ztAt7$lT1dOnsG#-+B9ENxnsyxlX$=t^$WdFg#K84QS3z9!c1Yhf3wSFNA7aLn`E(K z_bD{kz((Wh;du6{6ZDQ1Arm zPQp|fJTMcJlfhWb7A+nx!?`WyYmNiR+q=4KYt^V?cGuShmRG=OfEu=6us5sn74Ov|8r` zHT2XMLp$}oI?zb}OUkL(apTk!FR|Nfz9C=HFln`7cfv&^G`h7JQ;=COt zE*whuX|)Gdp9vBxOUi3B7vDY_E(*L1Elcq3jX4+FRFOqg#HGjqn4=}*Sh!~|<*u@JXrPjppucEeO}-$h_vO?Oe3 z``k6wSH|4`wBVU^a)NEVS#nHZeKTpI`|l%RuLINh-jtqO6SqiHT!J;cTWH6 zyj$$UU1g+Tlu_<64LmtA!^IkLkqN&Cz;M0geJ&)ZGJ`>jGZB>S?rY63OO{$`){ISw-}yzzEDl!(tXP*aYtU8h<~KW6 zS}~U7zb%|~W_4=s^)@6X6n>}PaGSo_PDy^LmY@IjDqdOb+Pr=5XLo0R@4@m0EfEVm z2mqmu#(>xe;B^Et7$6hh*xv40wgOT7-Ti$GmAZCt1c=g-8qz=Hvj41%F!?~CV|QEy_s_NEop#MUTkor7Y|^5D24jw{jK*;tG+wE zp`n4=A>?HckEUu)T^w?MlFhxLnUMa6O@*?vUXZK2QSgRI+apt!lnC`zi?-R&x>0}Q z)2P=L>U)v=MQB`VfTIwJS5n6K@JJBJ2>8kcq2eLXD$UQSG%%W<=NhTo$+z2+?>?n;foxKxWpgiO6p^czip& zqjHxkWjg0wGCVQiYO-tfa%yWl!L9kR`+EQU!c!j#l`K~UxeML zhziJEzg!0z#qW?;*bJn;X8Q1@mQVB|Pa!URc`M5%(BMx!EVV3Mle%JE#)vtbl~r9& z#G4yWJ#Bq=kt_?@Mqf{sm15Ez@VocB6uN+MsASYwtXfS7U*VR-b=Ej~m_yv#+2P{M zMDY9DV;?598hG=xBE2^v;laVdV0_{Wbh^=2GAj>_H0$!J0c(w^SZVB)>2_E{tBtXR zxml{;T3S)W3%_o4V`k!o2T4-2uJhN4)h0+d#$>Ozu}rL^Sg18NPffi>=P%bfy3C;q zYupaAUdPaXqS8COT3mE6Kq=N#((uw%vNa@|l0y$>5`-gxXt3vmRM+b>YSujbs_fP# zcSuSlqCXxPo2qTw+`BhjAKAOiLYrl~bv~P$t@TOnRopeGtErjLCq@EAzNZIMAe;No zkjw8WPi^#=J_J};Z8jtUSx~|0NOv<9S@#@=*1_5_?#G#W+xC-4buep~Bks3t-K>eQ z1Q`ieUE(Rn!_LOaY%f|Ua$ez&NcWXA+FOz8jxY6@ z1f6!h?KRkP8}pLUhyqCF-2#zrT%}lu3O>O@n`T@`tV|BD9amw>SAr~OEep}O1-J!9ZI+JX6P5kdy{;;%FF}*Fxra?I`f%f1ZqYWkhU-FKMfdRYujr1(d zhL>mYpW>tmRZwYui0GHEr=ooa71P#RKt&{+m%?XWaTi~Pr&!%k@~IkB1u#|sl0(zL zc;N+Yd}1hz+k^C%=Jl>2?$)=H)a|ERn$Ov!)|(rDtJru(j0pR%49UsMZ?3P!L`TZg;=sK_ZeKa~v*w%3 z%xoHySr^~OY`P6uq%0J7b87LN3lS?Y!7fZd$1svX&*9iX+bzl~PK*zGPiuEwl~Ell zE;b&csKn*G(9=Q>;r!xS(6dSzY;p-vLV21md3v(+4s2nbK74jHpRE9-i(iD&K7zLB zn3c^wpDKwlAqjBrs+*S~uWj;{;fSdvNJ|RCTC-DZE13mPn5VfnHnZ|_N$+VH zgSVBq)>kZowWm)NYrjCBaCcC!o91J1hesE3p$`Fc4yilJtG3XczhVM$wL!Rc_Q%a4pCNm`jSwe-~O#mWH0gmjPy)$Ddj*r`fghK!dAugzFr~d4ZO*3H_Wl*C>ORhrq4cBDE^!@q z-QdG+h{+3Hh#@^C0xH`|B%CYz^=TvvGj8_g`@VVZtq}aXBwY_Rk#Nt3f46o0?^%u$ z4A;}rO0BD78~aY`0etkCyu>i;Tdb~;%&TrM?ScXz|75=rGA8hb4W3%pXX- z(R0192*oFZq1t>&d?KF7TrO>PEGYnlCjf&QMYA-v9S}@NEOe<_bvj(6@||>iz~Qmo z?ewNo>0a1By&=B&@rDn(t+S&#jaow4KreNsDX2d7-R^C_L(_B$%&s#0KZXe2dpSn}TQE`@H#~>nC6H+fF9OmtV*+ zYJMKmKp5xOeBNWOngb&{B`dwUUlBh(`I^@AOaJ-yRh|+258`;3v=tc)aX@kj^UVC_ zaQ2QdN93J0i~vJ5H%;jh@W2K)vj}S1Q|r*YVJyGK1mn8080BUdeggRfILU_N!ZI-2 zNTE5|Ib?0Z@zg!ayf<-W#l{zmAO6Dr?$3C zKYIF$lE=MSQ?;v{c)-L6(%wp86+*;qB6;Uez={1vVu!iPm7Fno6oRWECvAUrAd40p zf`LTlWu)(4S?l&SwOoo&qv4(dKoON|QdTSQMqsqT9LUp?`X8US(>*0K5cjDn%?6=xJ*8CSgnLt0Dy(@NCJ_g=iTQCJKfbRm5P`ETf2G!l-SE-Dt1c9)0$BkcJ$lw&7}#J z^Ug%q1+6Q+7-GS1U$7dV8CNon9L297-xQp&KHg{8ttxEtif{(^KtC!`+1U8}P!|&P z;JSJ1VN;)dgC%IE%<*wjN%7QF%)H(T5pSGp9_NvfE6zCg*!$8r2x->t>J^V9K}{#j zah1=%M*Z9P9i}BHK7j*=1O^BI!ES6YFWAxVTk))b5?+{WknyBuud>`3VgG|C(rm@! z>~!rdoS5G3i6a7|hN-4A9^T@^3MM$fnhm?^-1L%+i>YpOcs{uIN!>lyHYue!l1ui7rA{5afd02N z)SwDB0y@xSPDXwku69DP)=M!Z8(31#+1pWUmNphMh0QHAXT>)lgeCh_vIrse+xF#} zn4NRm_*sP>`0p(WMf>XmEWmU;5>jg3^@M3?OZ8Lxrj7k`&*wcs>eUS`8@mNz!-VX^ z05ZXW#roB5bB|UVc>gbfA$rSKX=n9^roF)Ys{*j}ZL8258&DatSxqhg&Z?(}{C>8D z&~KxJ>zpZPx^>p-Z0*fx;HfPKDwVfx8LQQ^u90|F*J(3_*09WiDGis~-vmO3UF}qy z5wRY+)8C{H3EUCPHunSF9X6c%uGwMIlJ{M=UdJ1wdq3kaucE|Y$#>7qf6csYY)~Si z8vABPwk6r2{BJDrQQa*234s9xWkd?!Hf`nr1j&FHbzHCj)dUfV5&NYeL$QsH-BM@` z3?h76@w~Wd4Q*+UIFEZl^7YV8wLjN@5}G_Rh%9m zxH9Slu~l2$H!odv*{(TiPIqoPNMw9Z1Ntf8k$45N%3>2^+1MsOOWq5p9Mqk^$Fkwz zK>{ywzG1z$FfIujC&=)^cWZXk)w(sy2ZI&xO*=*;ob43l1R0yf&K;kI7zL=$GK@!Y zst+_S6g4bR01FBl{EkFpinz{E^1tkiQcTv3*-c;kwdI)ze|yXHR8&-;&^XZBtHXwL z&A0k_uQO>B+&2x*@|?J^U@20K($kevI7I#O6p+`R43lEFJviIf*ClfOzepYln@g;@lJAI$reed+6(DLgUX@P0Ad=k4e;)iLn^jg=S0q0c#mrN=31n-cm z$LM628X+{aFlS|r4u?eREn_d*Li7E@n}X}UCwqr|HvsUpAp#vX16 z`}ue!$+P8=X zIF8Vsy-b*>*Igxb_IxUw002A0ao^6(PW{t1TpAFfu;0*Lf-3U?%PafM)40oJU&6Wv zCa5)%VK2kE)a#;GIo)QZus1gwbP+ix5Dz+t8&dAG?_ZkBL0`Fw$D0sf6o5iVg@J@6 zQ-b~0QRD8^7-so+%MVBhwn#h;7cpVGqp)X6RNBE>5(%uwyvxI2`a>zfjaRpd&9k=9 z_}4?9CDk>B)HM|sJ}dJ5`3?R#@LBRlPJ5m^4NvIdiI_!>9(G;m9n)psSgXEJs?Pv7 z!Q2z7;AsOs{oMdHAVci@aOY@lPC53yI|5WO7=TwHBxzs4%}u0X8dqU$^hvH#kq^>Z z_NI?Ha51c+Sq(&}T)_T9_JZ-Tv2MVQVu>!zF_2i1=vrhlFW?h*wTBd8a_QREhQPh6 z3Y*=|$jOn0vEFs@0lv71~lY_3A;N zS#F!lV`Mb+o2Y4-hrvLX+X;UCasAy31jgj@q*8F`n%1&2EK+kUQVY`B?_0YB!wCg+ z(i_4x735{*WTG_X+$gUnCT@+tpv>I`e%qM*8{251{q60xE)akpKNs7x-oh8ijT;oW+6kZ&iAnb7RHXc~pYPV`T? zDND-{Ueb5e8Y$DURfaDGQ0ZfERM{F$@1|oT*Ul94SeM-4?E#Asuv$cA;fY4bTl2F+ zfG@$}Vo8XfTj|3YLTzoNEc)Y+TfT$wM?TJ= zV)I6wwt21|J}^F@AH}F2b(cQc3#L^H8&=Nt(qk-7P6Nm@u?fBI7K%25O+r@xTkX65 zRx2ESc6wUx{^%y+R|t6%hGQRv%+Q}0nz(E#tV+U!rO8oR?o-YxlCCafY03JPk1+ZN zTv5@$8IF0Ns7b+_%q4xcXiMdtCAhAi;{592eoKRse)|x6Hy5I;64L)bk0@_=hK}$6gROe~ykfmF`#?FgY;#Tfd_D z4;3kf?p>->$YegdH&-132Gw2#^}u5D!Mt4(qn}pAph}t-SC`MLDcm`nAUWjj$>ew! z{{;gr2+wRTz?2bxJ1OH)nn&=BxO^r3BH97Fp!h5Op|Cj#2SLh4vlt6ZwuZ~sqLXGY zs9-joKTCf?X71S33cDz7E@7Y*@k5>Sys@ns)8ZV?lg49eMFmt!3&FJao)Wi#d%LwpkGbn`|jaj(pIS2u+-=)&c8Vs zx9?4G+tcNQl3Cr_GSb#=u|u)pqeH^VAYjEa-X*+Iu+fo<`F37@3%clF6pdDEg^9KI z3(E}pOe_`{`+Q?KuM1ul#wMB<(ri^qnGQ-g|EWS!Zx3~)wGo@0nyTpJUGX$k6Nmmm z{k)DcXX0taP2<12@6Pos|;NgxclkMPsfe&1p0;Ei0n#9pgK2fi6fSg3_}oU^<8 z@0)YOce1}W8{PM4Y!4j=Q%`gbYKK@8n9Oy^`rs96Z!9-GQC{iDqTuoOKU_)j$a_^A z2$sZ0d+X4aJ6uLR&pDt+jq~|v>yCJu1v7(YD?p0Y!yc1jVn#}%FyWRG>Tn)RXn8a= zKpqd`4R7}w`|TNulfeS^sVryq=B6}*qp#e&-DLxtS#?sz73S;Hy#rj-B}P^JLgIJB z5jlrB66`fvJk?H<*`7$MrhHT}5B8NM*pW5ZLk5*j_9kZf#X>MWgXHt5ZiY)U&J)XB zBm!Y>IGBjrvmV;99v-{^|Lth_=e1A&sgy@00x1q4p4d>Hi=D}dbnAoa(|KMPQiQ89 zHhQEhYB1ct02l@e)S~=uf*C2q&)=QWw=Ho-La3VQMrt|n^rq70;0cy34|gFc(Pk`S z(&K?0uJ-4QL|AuNVoYz=typg*=iNyUgBS&0#YcF!eDbHbW9DF0MteSYxaizyFmN5t z%@Lpd+yzURrsj3ZRHN$;PE+qY&W5C@S`AUB!Nj1P*_S0Vwsk6U#76O$b5pj$Q)oKg zJ%fX20a>ahPcG$~OzYrN=`Z&T5UpjTr@w|P_{taVAFvtvuOo0pW4JI!v5i-qnwIr+B?#TPo!gnHcVw|pR&{fN z-Q)I}GJI4pt0iMLPGzexNOA$&K_2tCPj9_2S?!JM@81gv%$mJsBN<&E#tV(d2dh8e zWo9Tgx-P$q#Yr#9!~DIwb118+E*_^ZGT&8!T2HkY;--1r9raSukKNUXJ;d7qzm$c9 zU6lgOmId1p%#wk}GnM5jNs<4SpKk(WGKP}aNe=l@lFs~*vEQ5zIKa5#oL81RC7>Ij zqM=gHxh?Ni8b+Bkw;P`0n8sq5Y@)r_xF(GXcnCj%xN`FfZ!OR1pvvB|pBwVm@-K&UN*WjO;oxugU8`1_n7Bo7Z|(2jN*cg+=ft z6LgI9lar%T1HGRf<*dMepNxZLZ?fAjyHZARyEoC*fw!sIqDQ|ht!H9qhNV`$x^!Br5CqzAFx}9L@c6657X8eQdue>!Q(TIpDo+mDX59`hc2n%LFO$hgHuzZ zm@2~1vM46+%MuD+l$ZLLNoumJ=gx?#!HSQ*WgPfns}iz5Y_X4J#d=oMWqH?Sfz8BR zSSL?>Ryi>xzQ4Yw#RJpR*C(L=w7SnDT3`$Z3QEoiML-&5eSaSZ4UPCv4P|yS4tdmQ z_e}E(mG}_ORIRb=KLXt?^oUc3wQ6dGH4C9`yEi`+f8^|8BX22p4HkO&x#Fmw=4>CI zNbEo-8xpf^D}Sxbb-k)Ufz~B-?@cbpcNrPCXnWi_+mlwC-(AzhEh#85mL2PE?H!(0 zo9gBlQq<%VQx#YLF|>JFBbs;^pcgi@c*t%oX|f$7E~?@%m3qFraambOr`F75wNcoH zNU*9`&d^4~>0Gi<>YAHTv|Wb5Nj%6Mnxs0LY!7a%D_ec#Wp3a4D14h*)1}VHh3$;v zMCp1`mfyiia~;NxNu*1U!sxS4Pn!_sz4B)h-U4x_XWxGV>6;S?ers2YUBaRyQ{&U>R@k7#o=Y4dUadYfitUt1y;!9%<%OEM~)U!_@RmCKx8?S8>lkD8 zAPjjt`i5!Xbbq%n%TOXN9Vy(O*mPrdT^!&gznh?`u&>G{ev?teAo}y^oqV)L_XXGw zD0%3$$W7Gz(7EByzwA{mRbn);W~1|=LG`2NTyncxsGMHM$aog9Pd0UD(_XDUi{dingO&4GYuk(U4OB2%_sJmdTalkEEsD!QDQGnIZjz{|i(Uz| z>O#em!h?lhm0pgwWKiL)-4xW|hZ*&bjKK}5=_oTzkC^J0yH$AHQ#CT}G{ox9R^?}8 z;bjc)g=DP$$o3?5?akLWEi>FlvX_6E)PwiQi&y%0O_AbZ!|=GAa#dz^2t?hugcQxS zelAZ|HKwIe#UI09X$IQdyHKrZH(gk6A!qL>vc}d2vbVC`|4!~tbV-KXar61fHA`8e z2sk=BXOwnbK9EbuF$Dh_)Vm*i%Y~!v)sb#Y9z39IoBn#}BczO;z*Ef~M+in6cE*+2 zX1MtI_Vr5(LB^2V;E7GsZr0`!6o3E2tcK-J)_1ex5i{wB$fMr(IGDF&Bf^@tk2h%s zf^<6<Y$EKzmVVzGNSt{SZIx)~$t@_mHdI4v**gP{Ojj*zUHM$^_php=@tvujHBg z`mv3i(O!OCAGyBDL`w{&1=01-#=q?N6CioKc=jF8p*56Cv7|ujD5l=O5s+4QVo*nZ zXJ(Q2c)^$dcyvB>&={%a@mfexOk6$b@kUlfN8uudc)Rf@=W1q2b;u9CI8-Xf-vi&% z)#cN++|3TxapL&V!SRr4a#T8@zR>;X>J5X>8@Oir-zEFNv4rmO;9k7Bre_$*mn2=01iw~Lhgl;U>G6Gyr_ z)pn47KN-uz7UnrgISy5rN(N{D9@F?!Dq! znm2eN&gb;9jvl_8W36?|@zy_}Lq<%hl)7=&#t{2W*a8+MdJ9X669*N4`c_`LfPxL&fcDtw z7kN}?pBR0R!Xp$JY?d|hsN_CLp}_8q>y3W4l=(gbaLC}RvHac0z;sev+!VTf)ZA9l zW?PSv)&v?(t=@)YGO`AcCDjM3rGzGax_^Nx#tCi9+kHN@B+>SO_qL6K1Nr!JWUNCc zJH&jf=-@|fh08`M90u!QBI(;lTG#2N`gBcV%q^2WRp$Oye#NG1;mP5qBABNgB*j?8 z=VWE|;!P9w8p_Jsd1wjB&O5%JyW3t0)K|U}ej=L5#mv7wtN|aS)|Hi&Sy{Sk$AUey z(7hv9f>+}&vUefDM;ErJXaU(&>}-&I5$`Yor`G~vd;+q3L{yZke1ZzwL$BT6EkJIQ z+Y9&D>Nav_#Ve$yA~d|YWeL&1NXA_JNmNt~wu)b$w9E>y@x2^Wn#z79g_*6JdHH}7 z@2g3E?~X|?riqKVeN(o#f3&xMRd#-GbbfGEd~sELa&TP}C;}EgReiy*Ls(OG*!S$@ zV5e0G!V!YY5eMABU7huFOT_shd~EN57hxdHFU*SMR5qiV9UsTPZ_S z+Y(Vn%lfdb_pQB!dPrm`EzZ;1A*Hk10TJ}K{GqwI+x5N}{4n7~zwQ}Jh=df%M6FN+ zUWQAp+F-)fxU}u1-X>Zv4bRKbtRQ-U?sLVgS*GL4t@gEp1itsz)s{NCwNs|;d(b{Z z9o$iZ-rNzC6dyeUug6ULQ#3|>A4zxaH-4H9CCB6^Noz|V2WAQVxOKMM9oE{eH~@^Z zaLq?bn94n)zP~0>1d>>;g-IhjLL#dzx#MDu=9Dp;f*%QgtfL_L@C{*4E;fEoYCwKE z_E4~V)=$Y$J{MpgV`i@2ohs>Lf6IDnZ_O(vWWEwu9F#CaPl1KzW(Wvt$_6A#D@^nx zVQLjFR$kx{5;SWmO)rlWB_Nv3T1otXdhc4`PS8e_^jnfsECfQI9~TwYC%+=&>0-ey zcVam7ju+ z+sKvs8~$d|NNWrK&QUo<(sxVlmuW6J0T>1|UIo&)5u1>ci)srgp)QxB2}-YYogU(A zz9+lM>Ubp49X~eeyL69u`Ow0(ScIKW_j>Zcm&Nwl*m#2qo8$T;E2Hy9Y;YqRBOUWd zT-B8?gH6PDkfwh6WL>Q8o*W)dnSg3J|Me|L|JY26N4jr?kQymwd^+*{NR@en%8A5N zh6a`S>P`l!f7kz`>aC-y?7nDWn-D>z1O%i*Lb^fe?oR3MI5dI>kZzFf?ru=& z?oR3MuJdj1{oU_g27__N`G;rkXYUnr%{A9@rNx};{W(K{{Ac=M8VtfpQp?&WF3sAe z(y>o9=P)OnJ)$2IWGAXPMCphl*_sB4SgNs&Sq*rfm{UJt;g2(UV!1Oabo6U)5 zucEkkZ*O;Zbva{!p(R1N0QzHru+m$unQFUm2;u!xf1r*!B6{$%Y&A7CKjY%MIbJ$l zsV7{RZ2vz_!1daj?)c1)f6VgY6vFPzhRR#i?4R$L6GM^9RRz^_yHwQhYwodCh7*hN z@3>*2>v_#vBPu&fpz)J7;cbJ{QZkNB*>R$&n%zO3S~qGsXplLBZ1}bY#wq$-PrMo# zQ;g6IAC~Tz7nc&^qMlrfi<{8j})1PgeGLv)H^9PUdprJ$^dp$Lc!++Dy5nl$xkCwmrx!q%@&6Y||Utt=sH(xYX7<8|K z@Y(+RzZ9N`$z;^Z&Mp#yaRkK01!P>&=b@XA<HCZ3?2Iq9Ew9P>x=;+C1eDa=flZ3=oiu z!A-0`BmOQaskOPG5R%qesbopwKH|`NJTb@O+aw}UJ^qPx$igeJ$}dCd!-|+18I2J3 z@8rzgHyIHTp1BPxG%hMKn}3lVDhW%T&JZe!`*WJDwqzuMlGlpBp5kwQd-mT9>i zN5hBxFb2b%Qj2_clwvZQ0P4Ck9I3DJFNMhCM7x)XPH`R@9W?{BzlQSAknm_lb()S@ zS(t?DL+p*;5Dt+=%(mBc;q7EXIJLVHR9AH_rmm-LZIE9*;^p+QtH`50BoUov9~!pY zmS0-x@`Z+y7U^&7$b0E`d7_?^^>T#9D6LEtj0dlNm%q@TbeDO{i3=#s&+m#=*w?8zGdzV1!8<;iFj<|`1p;V?~HLaO~LuzHpw?O&H-$71$oDA z&Z4(5d?T>>gT7B@8(}kQ=bG2{lV^q7hfz^`^KQ2U1dW873axo#>zuQukfWUH<%`{f z241I30xk{CM4_{@&n)-v<=fWNf45YV+#mG*nvCTsI6BsVb>hOo`AR0T1M&BjHB1RD z>z&`_kfVO#FKkn>6xM9jKslV8CVHL{smG$h;o9jaTi|YYMva|g<0o=ML#{M&EP7iR zwIsZEnv_Va4=H=qxZuD7aTF0RudLwUipGc_#ArHYt%}5>SIvHDxNj04FZa*7%Fm6T zu^aDjjIg&%w>EQ3P4i50kHr7%6`sw~ z-@SV*p~_r^!(}UF;BYq}xwE}52#o8_7quY`c`XE*V(U(Rz!QPm80skvAf zICvQ9KQLU|UjFTgAsJY~L~}b1xf{%d8xgvW+L=*qINXWt8E6WjDq;M@Ja~0Mcf2>p zqVHz9wdE=&w~I;JeVKUKKD=tk3qjspojKUZ?3hw8I)*|h$!^8Df$xY$Nuf13mE4Y5f^>{Zi}S!R_68X6t-FHD5HS{r-uno^5Aq8$#g`Vl*+? zwid5sdyL3X)+CR6#8CdStSOKE+X$S-|F{5=Xn6k6G@F9!C5fZOW`}2|ko}$Aqw@m? zbJfwLih~s46Bwc+(NnJb1ci&-lub@f&fZe_Q*yE0@mdd7IkI8{70_&WgLQfT&OJ5a zir^dNhpha6r-$8E5Hvx*K9Gw)SN>=6<(_z^AYzgk#aWCO#QOTeNsL%7@dPDR(|*kU zJTF4Qj?OKmBzCH+cs3(H)ra0mO$mI{hShl%pIS|y$zW!Zdyogw$5AWs-cS5KPfHO9 z4lN^I9tD_;F%FH(-wGIJ4AgGnZYG;|Mwss_`1` zT=?r>*cS#{;+&rU`5vOn9odlgXMHT+Tt=Rl-S$i*_RlcmRK+0*x0av&WR`?^ivtP@ zGP1}(Xa3i!@^w5mSF4KV?4F??9o7iwaRaIFs-wkhA9J`6K?ljBM`IB?+!gm9$k9AM zf7nOM5KvQd`StBFn0O17oORJQp*(nj1HwmjydP}BO!?{Xx0qOM^o3;`*IBQ#~G@z z7fWX?ES|d6b2aCp65iD|4#j>guAd0?PB_p12xdIp{z7oS8fpE1Vd)qE z3D9HIoCU1; z$ZH*=6qPLLFJF>q`lF5gu*$EfUM1Ce{P`3CYN^2~&-Z!imZieU)6VEGn12>VldXw`+1J z8Co}8P=VJUZEfG`xrUC+&F4XNLAl#<|IsDzdniUxW>ih+2Fb`s1$u9Im93F zm6~g$y}=_O=HP+|k8~kehCh4K;^yMBy={7PH5>ONz01Qsh1|sYz$Yf;Zhv9?zYDXtYfj|(zBk+V zBy-Q(_ay!;nDSML#+|Iq4bC#D{oa}Mz4EZkPvf#%^uNG+1?8Vh2ilYp3JM=b>>Kwt zH#c9sXDty3z(DFLdKL7JovR|{a}vv)l4enGG&Ix{Q96O#nw_$0zluv_icPW(gUq!f zKF1{Hh`+YNo)8MPU zHM@t$Cy9t4oELdH2SvE`ICUGH13CuT>yo=otY%#@$i7LesdJHC?yDb(8-uRxuKP_D zxGk+dA0H*qqA;1hE4avyr%VQA-}^W6nczR~q`ErC`9&r&KYtrE_-IiR04kDw{tZo zfqWwxGxgn$#+z&q63UO+DT?3Y?Bm&fK-0i>TO^hGrghd>a})VgU#=~BzjS_wW8CQc zzM9A&`UVOGfl;xN-L`hhHXdgt74XW4Z4J3lf?=eAdg-R_#mce;QW!y zUP(zI`d<#0LjEsWHz^FqAd^>6a5>rdyT0DBYSTiLWQSk*S64K;0W^`h&Lxuj*WGRH z78jBC@CmyAUL5?M3c;fsN@%la^xAg3JwscwRU=~)$JXS6y>2Nv*GQp2@JTUdcxTF8aJA-c;0jJck z#k;asp*aAl<@86LioG1bYm)hU%wCmCc0HE4vJngC^!(4&p8bx-bCQ8s&daX_`w1r* z;+Td#gNeUEJaevy%;i#t{!)P9no8{Ur{>inLUF{AEh1&Orf_G}&dw7<7h51FkM2jL zko7_}pX_{aEN_U?9n_Hbn{>k?>bDRSH(YxsvU^bJ5hC2btGq`kW=KXvlnzFV z*3{Pewe~Ji8ww4~kfHgnB+4s%$k9&eT^4L7TS2=g-Do+*g^s$}8tJ)u;c4CeINxaZ z@xsT$h&kSr(+)0;Ez%0fqVErV{T9Z2Ik!#Bg==4oQK{El7rDdkTAq_rW9*`ouezp{ zBrehWZo*^FMcrc7^>R(ZKP<^WD)|LE5{dQI^j1C@ zgk|{JnEJlv_$ZIzU*1=T3h(Y3rerORwz{^)3>38Z_*$SVffht8K3dL%V9SGx?!o2> zt+p*en+rly)*4$7vLSgb%}gE zoUTh$SH>iMjpaiiG{8j&J$b)5KP~0+|DLwIs%p&&t@?S8kB{I&lbf5Xt5Mv%$Ci6> zsoF5TE%3=vOM3PtB&?GL?zX;Eha7%uh~_sap2b-ZYt?aYs`anv(j7 z!-)uY);R3e(uZ&qsP*^@MZiK*c8556r^`^b!-wZeR?xvNF0kV(3{94n!7%-He?s@2hf`!DFi)F3mSS zIbyVB;ema2zEXRH*C)K=38c`Iol)U4F)=^kR#0P4HOlkOSU^+q>xrx`Ijr=CK`}7{ z8so=`s6XX8Rv^kMDQI$+#s}3l{RfJA|06|wBXn>8;;ioO?x3|-UPh)C{W5E0u(H%L z92{G8#vD_CviEbKtRxD@a{0q1%}0u|5k!1Isjac2ZbQxOHZSx|UkyaM^9TEx*_QIa zRtG`G+U()A6WjCtO6vC}-7wx-en#^TRP+4Y|L95j19bY+5CdNs~Zw>40N8s&DYOD?q zFEcZJ7rehuQEXX{sAYUu^GIN_@jjk<j2oq+!os4~+P5XvdaNM}QMx?k{Ncz32 z+quE87?XWeZ9Xj2S|>H07CwNV8hfTFZlpd-VYSK6eYHTdn{&_GZGs4SF5FDdKg$T2 zIxG>D#7hVYQu#CL#2eMIDEZ!DxixDT?nq`)qL)M0Lwkb2zjW$RDtY(xwCcRdYallJ z_~{D}KfUEO=dmNQk`-2z^aMVxtb$3wbd0f!f{Oi&Rdl{q9$rj%va$0^J+dAKS_Pvu z>k5}>ME22w*v>4R5QFz+k;HD}4R$B}N5R$`+zN`1M8y`=$J7CE0M!?h(;(RL&>x#v z=<9DM-<->4LWKx(vMTwB!M_nRS_cU?1A|9*#Z#)D;O%{d8NsX>%*dLA=jrSd#R`1U z0r&RxbLPKu`iKBJIXT(M@)$&}Abtf=Z12v^uPy?RAVpeoE6o3VoWv-A>v%z|rA)Q2 zPQ0k8?s_hfN+&`A1nd7cEhpObi6u$Vb|<>P;0g3*dyA&)7W(_5^RiLqPmH)Y%#H<0 ze{L?xd7Q@);5KXxRmfkx!rC;wLtnAA+y23js*7TQIA7-Y>rdAm(G#_6r?Gr}(?82m z<@r%j-t#F*eONv!7wglm6!M6*qVIX(iK6vJs(ewFd0Q-O*iLR_673ijNZwuEFV2aG zo!Ox*ywB$T07)}-+R9^t58sw@RLZj&qSuZucW0_0Ha0pcXTyb)Y^E)AUwNl%80X4T zsawjlAw;W*0j;h;f}q-M->jK=cYAbtbZY=zN^;-D&G)qp*JfKP%lQ*CY?>+T6T_Ic zGI2lcpP@|ID7y{xZpJX@SI<#>ogijvmTl25hiJJ)iJOY5RAEIDYPD0FM!9aWWhsA@ z=m!<5E19ogu_Xe3mS!8$0t;@WjM)H&3wQup?U@aZ5f|ki7K{>#y;}k!C&AC*boZLW zh5sx_FIgiH1ZKc~TQ0bd)oQ-VX2&T1&Jn2LDor)C)N#)G-q}F<+JMHNsrKP=qv88M zWWUhYX+V}fJv|~Uj9}TGnwt9d_7=?l1^5Ei$B+eoSL)?wdD)NeBx=4nobjBs+&IyaUfb39vyVQ-LpU;fqOi>I_fzLM?Ty;tV2 z?AZ%ZGf?K`wV3lrx-nK!;*qiyQZrxvC5Cg%FEFx?JG)1h(eZ0ssh`XFm{aD=Pe7n) zcg#RC#Ix`kuKM&eXQaE&Vtd|HXn@~e)J>~7kFr>)qupF>oSA-*Dp!PB+1c1A+SrVrXWQ1kce@R*^Y-!d%mTl)-bMNOK`yA*iWUym_`_9Dje7Te{jT5C z*i)cv-7`RO0qJz^s?xYp?dnG;MXM6^;}<_Tz~$icIWb-!Uy~SKy{08@dPV@v%ISLA z*f{$>1CmI zGENEMa0tz?&30eCMLeW%Z)j><8pdCbz*lVHk`!A*u(fo+ZmzhC?e<~iXtSkSE}ULJ zd9ukoCV01zdo{T!NNpVZ(l@N79e-QX~EL$!@XzU8(1l3@-{b@EruwK zR*1i&owOu#-u?p+6A7n}xP#R*e;V9bRBCpE!!&()dl^x;vWA}2aALPmTF=ma0ep)q z@GTdkM@rY&fQg*L=E9wIvq)nZnnb`A7eQHPzGMnelq<8B z@e@PY=H~Udczkz3oQI_As6Azz`WDHlnr=SM=os(|%@VaPOlv1$9LajhIpn>V{qHLK z+UM=o${s6XTzxb+4XnYcw=m=v-GZ5xwyh4|HJ#45jOS}-i2;r|Fx{~3)r}uNHVmbf zr-m^}+&4$EcXnrJ_NSc+^*;h+8fP?Dcc`UU8>QI?8hY$fq`~H@Mwoxo>tUXlamuhR z%U=-?pnvVq|5DKY%2v_HJ+<}BKn4wKEZd$e#5o-Cp~Zdd^*=L_e0b@KiW&ihKHH=Q zJtNa#TqqnIT(myO&Zy>`G0Kbe#id(*jS8>p8l1H$=LWJWl3)H=I)rP1naw-OZ?8pc zL-bU9(sDF7iVq!Uo%^HD&PW|9`*uy@&vD1IN~%QEo5?KZ-TKv$)0JPp?}Zq6>GVhs5F=><#?0;g6E=&%9_f>T>e)*D(>Zskn|lZ7CI+ zeHLwh<}3q+&bxIAZ;ZP|r;u-OiE!Ol?cF4TWNPHFS}%^r5}n`0EtE$=8hCy zexUC}B)f0~lSpuvv&1sP`_t8Uym&sP z(+#uq;`;qxKTCBTnw(=JleO&DLGJ=YGi)Cb{VW&*{JQy8Qd7Nda!GVOckbP6fyhOW zsN{U2AF@8Tw>CC2H8(BDOxL6r=ao>X&B?jgiuwu8whKh7XFFNM%#61fFQ3H%TW{N} zky&T2fV)R`PfR~KDEw{AYr@@OG502`8)ykY-h7>t793#JKStVM^6v!_3N)jM&xf9da9FAnosz>ey55Ho|sC=jiz>H z*9yq)jHUlv8m4zPpW4JVo?fQ|RQn9}crR67pFb!|Z;@ zCWqXxt-D8m$jOQMC)O0Up0fYFOzr<(CW^#}qM{`V)f*?@=49vam~$8+ zx}+q=X+q%^o7(ggRty^D6Toa+7eZBqbPEF8W3edrrOs`HT#2&{pMM?4UIuGo9R4TmW`|wHA#dvRp1}3b> z@8B#;N|2G7-NaZ1L|1Y`V4?tJww9w(21xr>0LYZ~W)k1xFY|&f`Bo_8aHxVO4-- z`c<9`;22u?v%_N!Yb9q;>HnU)^&ggTP-tW4kY-#5FzW9wUJU~YEmT;SN9$Dpi*9BZ zPUQFRL8ZB2lDr1vmp@~`T`nzwLTBrESWmtxe$g&pJF9mH0Yv90z$4gAe%=9<Y9< zoh9ssdhhOuuNbRAn^_TZv_4VxqOc6TDfTqt-*fXj*ILHUs6uAvy$~ zI_z>E`wM!^6&H!b=eEArGUN|sn{Rgiu;>G7&(G3X`PS3Z(@$R@9h{sHL#N$01Q#`Nc&tIss=eduiB_y2Y;(p=H;l$7e7X`;vRZ+(Ds8rQJcBc)RxgC2a z2X}V7eC(-UCzf|DPqD{JRX^pS_ND%Jf+@cIJHcu|`>(w{v(aM;%+w_(?;IYcXW)Q^ zG=nQ@Czn_IMFp@TCTHI1qod(Dp^<>Lor#Wuou-*HD32eotEyFLS_AVEtBGMtI`7^x znwcspHre(}r^mdC?5y&d?QMv4i?)odjCt*_5jrl0d7joYubW?)O+-LUP4T^DwLp11 zJNo-3Ei#7R&#-g|n8EGQ+%DD*ci~d|bHmilX{_z{QZij4TSD@F-o5{Nl=JDI19MMd zOia9Rb^m<-^C+aF-tJ?S?ZI^QVX|H*PGlGKi#dh=wA;D1wsmQPt&EWX;ZS6HHfB;S zKRgy^&8e4%bF}3%0edi1&*!FAMVa_$Z=|f_9gknD9+m^F8x{2yBZJHk*kN3D*6u&N z)#7hvu@T@2aI$@N)!y{4+9(!nY=4F2U-7%TUj6a-1K=PF`@)XXW6l!0gQDl2U*^=V zm?7$%^U2w*|5~6PWgz0S-ao(lVl_i4NHD*9c>!5pkYIL+1^24r1_ysZ6jtz_$SJZ9 z6RudFCjuZ6LJ4%I35U&U{qE$(t3AlnXBRg!J)dSj15MtBNth)&rH1D#mg1EPO zKdqT`x6%DrKvFWbGS)r$EGP^4Z1p&j^6H<$kNZDR`5S&oMTNZV)!`}|vhVWdCf2)m zIhmR0$Lytm`m7dKte=1vIlOU~#3+I5?-~~tLh&Kf9yaG|5%0hyAx!^i5NU=X&E3t^ z$uJ`YSmV1}mIVE&=5dt#IWSaBn?bgW)c%spY?BVz7Y{U5^cQ>^Hq%ZuR+W<@In}+& zhB8L$SNBf4SoKlR#FU%pH!mPhHNh5l1F^DSB6R(a3*gIcufpxr%^j^za?E_c&5!=i zvoBh)GMU_br7B5En*ZhbRIS43cgarN;E&W1zL$WPB!wdSU2H_N&!m*9etG;U*!C`B z!}Vu-lMvP;ijWSCij4DbzoPF6EgGyaJE=(t5Ht+WEb-g=bbdjj zhewTkp%fiJhje^#xcpJ6h+jx3J3HId*qF&^Fa@yW`}_OfBWE+d(QI~iTkVb_lS(2c zCbnXIZ)$3aiHQk%T=-i2-QSW!R$gM#6lm0+RUcwftLm9v@9xS=C3ADxZAjbMRa8|~ z`T7b0HOLDv@w+1cK#UhJp=j;%q6~X*bqJlYn5Y0fgn-Um{3@bJR`wh^g`hwZ^a- zAD@8iKVYA?GBq*+!)jXQ=kGAH*H>1kluJGU zdH-!P&chi-oILu}_>FLKai>qSy@paSLskoVf!Wd9jWoKnAp~AsC)Y}{{ zuMy6_c+#+q%3HP2K)cUR`7t{57A1*ON>XF0F+Ct)tm$dGmyd;nL|+(06VY%j@HW00 zsj`eIvDWrvK?BndN+==#%GAtNbF&1tE)cw7hqaS_!+vg!hLshR5IZ|YA}IfY+u>;h zRgcBbx1ur`$I|a}fOuU$0FCg^OT%&mAx>O}bj%@gMvU07T%4rrqg z0E>rIB94`nHPSUUB7(tssTB^zy>6~4CFN`Dk2hLda9dkjLD)?9>3&(6O&7y@e_}kn zz9`$?N}l5iI5E-oG9W+FTPfA;05wZY8g<8$jUg~F$pH+{qNUxRFa>wZ>M!q!C+H9g zeWj}l#8d2fe|-J`kBsbKWz|WG7OYX?acCetp z5;1VUKcC0-N^R3>Y8;PNx=2Dy$MTrKme9sO1&SOXdvH8l65#DjV6z1Whl$aBP{JN? z;jplS7~x(BOqpGKI;r4di?mYes`f)7!Xk|FDrv5 z0IHbU+S-|xDHXaM$h@7A6msuzaS;fBHwIyie{it->6U`HxOi6t4;l`R3;3tBw8iv| z65#pB@zvDSz`T+FJ1-@HNHGd4qoogF=bI0R_u`Na8h_Q~kNwBBzJ;K%W6KpjFAn~O!~OpKdjZ7~5Lo~_izEc}zMtQ2?$5j32^$+4 z8Uk&@+sA!zOv{Ik(AQzYCz-0!*ythZvbrCjtQ;IM?sLgebna>@fMZJxEup#|;DM#o z0_@`(k~CUWXu^>BO8bGB)Jo#Z$lsmrg$M*Q7V|B%;^FoyL*?!>=cI<~>})DKJfE_z z)F%`bR_(V&zs{U#i$$NB&;LmxB&MTToj!EQZ#Un!;Am(({Pmb-dHqDo$?-P!O`%~g zeofY=;u00#7c+a*dz_>3Yr;DWN-~~ST?Z09g63}!1m^0Prz^BSBo7clYeuVq@bsMf zVSugJ7Aje_*3w}O&IIi5ie8hRHLb0!NVF7qp^qMQ^KZ2w_-F&6GEPp;lhadhS5I4X z0|Ns^@qm*<$HeqFHt8yQ$@|04uM0&go4k8;^d$bfSo%^}GM9_u(Xa9Gs*`P5G<`!u zA$Y&w;JYK@o-$zO$)J%9CwwDW5+9vjqoSg|c_VX$4i0e2Y!($)Ty*TmeX0~B6IJY= z@f*Yj0Did}t5hXV27a&3d>%wTaMb2wp^0Dm;%9m|h&J}EQE5qfvsd|#8 z?49J}Rs5_em`t&8**}#V=oc7}%jye@XPrD-XOE4dvFhQ|x3*HLK>zkNWn9vu;$ zEM;P)b)a=h5~5V7 zszASYj}>R+rLGiFdYJ{{Pev0GuZ+9Vy@(MLa@M>{u1DUfJO0+Q+8Z~*D7Eo} z^~n&xcv|YQ4I%;(l&!J+j=xq-PGiHvVB{kc4-XF$)9Kmnj6@vc<=VG{gM)A%VNz03 zKw!v0J|Ix zHca%xgiy2zul5nNPj5+_a*YF z!~5GK>jcl*`Ps(hY~R3PhVd}rDykklO^7p~YgSA0a8_Nyja)aS7W|2?w&dOQ(Kiyl ze`Ak6a78w(Q8FM!Bqh0T4rk8QLt<72>+H9O(uH6Jb+0iotF8Y2X>D!AZ!*!>XVUME zEIU)o`?>SGEr{A|J;9i^mHUOpy0Rf?zdu^pF0s{ks z1F}ceq4teZiukP?SHA{0a=~4X=bl22e#(=ooV9o@;@we3<&~AS-EQaP=H}jZ#ptW} z@e`WyJffbuC36V?gO`=n)zvw5THy(&%MC+71M1hr$B(|vBiI&wt$QE4ipc4zVosuSQe_P6sfStq=w$!@~up(sM(da9wrYY&3hc~nwQt3 zY#vNcV_tJ(9(8Tcpr*^(m5x6prtfm$Sbu(gphOu3x(RsQJ{S5evLeIWo*5C2npCP5 z7Ukv+-IRHI096_z&u6UTB87?z$>OiWVq>v-%A_t{lxAe;fh`e>p&46&TU%R8WVc5| zMjmg_msVD0HSA9a;km1EDCeDH$|`GYbhEN50SxXjm?quomT3x&-EyU*+YI3Yy!(w*;9D{l<;RZ_ z;^IIx$&Z|wxvHX~qNKzM$PF#H9`}LJvazudzoscIO$S^~u!sCBOG{-&Luu1Q;f_fm z{{H?yevng8usI#+NlNzTDdZ<{N~;D$2?f4OopQWj1(&qkaA3Yf`{|qAg=UZ83=y5u z@w;DcZf@5no3<;RZwRMLwE5~Cc0mSEp>SV>Zq=b{`9x=}%02PiE*k>D&*gVraZnfi z5;oXaA?>T9gL-_#gTpgB*Rt1m+0b{b6- zX;e0gOG;{%8%TiM#oqoDaEzEO=K;CX3U&(gzlK-fii(OrUu!e$*6krEt1_FS*KH3B z4-W@ph4DEZtqvA{+wbs0qD;M^P@_Kxm8yx+(OGjXpnQ@&_Iqq!Cso@p~X)7mef9AFd-^(dZdYtwJ>d1brS+tu0mAx(QLWfWgv=A9SvKD~45oaszub@Aqg;@pjACbJH))s1&dM@j zNf>;;m%+BM2_lEEu&~tB)K@v>I&J=BT2_m{JUcsuqxJiGd$EVfIk&redQ3Yg>5;xS zlRbJuNljhIMJhx5_V0r3vViU)|FO0XFQQzll^XBNNJQk+8n>=it4y*Wl00$VGHs<~iCE@u;N3W~UK{GPt%Zy~Rja#@vbzsE zxMmS@l6-lM^Df%yHiDwD!=4P-Su+!p>5I5NB^eo+U75zWeyx*}%9HMoRLi^o*kr{^ z8i9q4J>CReeEldT)A+5{Imz2DujelrLo5M{683egwUxi`DM)XHggQDD;Njs1GhPBo zHZYLJUPT@fg)gnvP*70txSA)nx!I#wvym}m0-#jCKB0gcVibs-$xiSbzr~U{FldEe zUNOju*YW*;hcnetP%?^qzC54L3(F~X1xoZgJ{gqI9+HnrJnMVfF;NK|L?`CAWT=(F zH?P_1P77?|im~5yuesg~`|$18U$V25k+ys)E_AZ~^^yy|yX}!8;8Z8vwgXj0kd2??(^5q z`HIoJkQ3Tm`3BcERvw=0n}R>N8uLr?UL>g4ObSfg$e&GAyHP$@VF8H$VCN7T}lO(6z4B!=bmb>F68Uq{0CVfUf?BMAk$%V!a5 zpA7GP44Slt&t@vd2KSeLy0dXqEt^hyfRV^&{b zb&SMYUteG~Q(*P}ueW|2oW1}$iNO7LyDl#RFm{QzEUx_HhR+f^3oDx2nfrzhn0ywa&W-P$LcaN zGIDY@tbLs^F)+rHWEETj#-BfX2KDtd6*MZ)YIeUoT4h%S9FY_OzdyhH4B9@^ki6d> zJpse%`{r*044$=xXSO_jqGo=<-}wfOs)x$m)Dg4}tY${Zu{Wv6sFHkTKv`zB*mkM+ zxY`LB{EJI%*4Jw;E)E5*ej*h7Nw3e5YDO5B==Odggj!+NTj{oO}hP+1-$=nW- z?^!`dL<*QzZXMA9co`W^A0oP_sHjYmi{1E|3ks+}Qe(Zp52i8$T<%SnGF6c->riJm za6TY?i=%rh6#O2G!JwDO5_USF#e@R-ulJIVGVF_+uC_A8Vn7X6o^lLiO7_)&`~11* z4Qhy08XH}x2>jF1c;Y^I{}~lFQ^8kw>{P5rCt&a|>hn#g_D0aeFYNiX9#5#EM$bl4_WKr$)@WX zw6d}?C@5&{Fhz}=9$Zs0zr_qIM1j+K`FX>~{9V*o0G zj5Qh(l{ShS!?P#s5_zU&tic~C$m?CWD2}SduB-9pOK;XQW;UbG*4}-2NT&L{`&$4^ z0pgu(C)c&!*jG5rMh-Ye2b>-N(N`%qFwPR3nVNcq&wb;G2vVidj3*$9JzgJ>l8|Tw zLtMcjWV2lZV*pXZN=pxGte5d>?!hrI#Opnq&C1Q?aivuhUm`_6BH{Vf`rJWe%O>}TCi{6nlGxwT;;jDK5+vSK_J%_IV2 zP__q91^C~Sqi+yrcG3C-Va=#y%J=Oae{t5S`oOi(KSjN2w%0 zH6utRhQ))p0sZK3xkIhmVs~jtR#g=n9X*qc(eDQcV8DE_)+IPKdS+(LQk^z6%SHiy z3JMBv%JNcEwL#wKM@~wb1;!vIFZe0HfAfYQq6@D^qfpT_ONEn@ygn?dP3O=b{iDG^ zQlV_FsF)Z4n2q%HSGTv-6crtg*Ce7uGi#~H$&LCG*k0YXds9 zXG@xOmYgk7*bn#)b|w+3mI7?LL4Fz@m$kja^dYa4PY&uaV6nLhvw*-uDwqjB{C)2v z8I5~=IVSX>qWk$cEyT*}2k^k_8ygo>hRMeBEK*=u;x_|q)PNor{0i=B!TocU6vNF_RZzY zYTl6tB>4n;#{AB(_`|;t&p=4(@3S}d`}2)}dZART$z{JK57-zM7DXUQ0fi%JX%N;c z@2dNESlihF>#nP=KI?}{28t)La&lNc)*u!o| z7y`{wbKRYtp< zv&cV!x@g3bZ3qco#%w4({#)4VJeY0yYugfOiPgO=l9mR)J`?t0tF!eFIeBYGc7%{= zv*KCNxWPE7%~PzFyLGZKMa^I?L5Rx9YG9uKR_{szM+~YB1EQufWB8}X57YbN2yVSm z`H91X*&%zgwYKX%bN!zJLG>*=+puvj4rI~bOM4j=H4tt@MUCALj z>;;|(75cTq5&Xu|Cf>@{WPAT`zq+>0hqt$e?>`J2vl(CJBB&T6sBHR8fxqbb3VU~j zoHKP!mG-uWc2>vs4#)Q6>VA3;-a3w`(dWTv_C3kcW)VVa`MSt2cif*cFS(X=c&M`A z2HDzFGF9_ME?jW4L~9vbBdJG*Nqu{P_jTWZ<9s>hNu85O=G!aFIB8kw=(y0>=+MNZ zpHbM!QPDpWVC)etFl?h4opNg^H)Fy%oSUFfW@aw0P8@RIuI|Ywhml?_KZH-a;>xYswCp-sP9PUdw zK0->5jfk}mXk@k{=P%Azo!qB zct`ha=#OsG65BM9*X3rdoxc%tS2`DD)(6@)ok08EHq&;J5_tw(Ge_xZ&xk)OJ~o7P5DxQ!H9oR44e9Y5Y?Y~OxA>@qW`YQ@%Atqe*l(f#R(BIX;2$iu z?v#4{|M7GcP*HAO8|8{3EmBgFBMs7$!q6q%Al==KN~e<2-Q6*SlG5EJ9Yc5Xzccv# zcd=OGT9-NJ?B4tA{TyHS_ngX@^4v)JoM=^T5G3xI&CPg`;>nBBXJTTZPEZg5Az||E zSsUo27V73iURlZMW3>>Pa#Mp7ECP1C0*|K-1eT_REY}iznW zblXH;rC-+D;uMIMQDt6(W4xI>4mN~+9z1Is75aQIh&AU*XR7{;w~0fH;MHV5|3@*Z4Xq9NcfGngJ;8AF=2ecAcX6S@w#kS}3H@_a%egvTUw?mjYxnzV zYbmbS(kSE#C8FsCo^psBgju)j+)6EOnQQ;D4DZ~U+wnp)Dgw90u38J?QW4wS5U~TF z)p_yaQO8>W9Zz`A_WhOovo_=};v$(fSx9{yD@*8F&2|*(Q++hAD^r_2fihhgtzYGq+;ME*kpe)`5CalOS7iXRw3Kw*6fmBmjZyhj|9lwk1x>D_f?}f zL#LSD($9<0;$X|W*>x7&;kD}AJIL!u7|;?Xyqi5cMA_O{pdRjA?3^7RRU?lEJhEhg zY-4nsJtqYfBkPrQ*E+U5PEKt2^#E^pLTpcB+LEJf&B!(_d>c>yQ9cqt_YX@Z&w%&_ zFn^aqMyz=DYGwaJgOo?Ca!r#Q= zpTz7{55ub0YCIZ2R1a4b`MHt=q_I)J4uJ7GdrQ&Yg|Pk@qMAYUF!!Iq4e}jwC@Bkj zXSL+8E%@G(!Q-tU4f{(HG9q}#VNCMB^*Lmu0}^$?zMSE^s%s%m6br?9O|V3@s^}g zWXj61V<(o`#)vTK*F`=WTN|sCN^mJaxc>6U2+|QdSj0H$hy9Z~!-T%wlg-oDzwPhw zddIitWfn!nVDg>unP%PAU!@DYVDh*iN!lXxrI4GI!3(DQd;Xe#@u2m4EsTcU7AIHEsF zqX4EXo9?TMAV8}Z`IZW_^C6n*>Jy_>0&FdB+P|lzIi$7R^Lbnm5cC9#7pUk4NiAMp zG!W7}$QG96%kMY1LUYQ`t5jq{epXx+7^%nYu>ylw$sY$v&{6v^<#%g50=>Ds^p`p- zqe8msN<@$XDkGhn_lf5<{%zy*349v}SXe_RF0ZQm_Mg5Hr^lt4&mVMbkrLh*6;v2pi-#s?uV(NMS1`d(O5( z(89!Ooy6@K7FNUchvwtOdZ4DAxINkVEXU`;@q8HLM^D8z+P;d5q5XEH&E}QMF=iut z;u?YP<6}Vr9P>R&Q{8`Pfm2l$G8oj>H?XuQxN`NJ|zIxZvl6tg+ zn#LR0{?$ctZpykmomTXf!*`G`j9PeYxs;@hZhAPg__)vvgrzVh3Hm%bGEA(_4io-6a??WmIN&WS z+{RE`L-|$`YZY7?8aK^4qLQg_ax6mpXKiXB6@$p4qeQsNU~cpq@VrHO+@~-xOCPi z-v1s|7(6B0O>|9m-2WS>EDfwOA=2sNd2ui}+InOV!hI7aLL01Wz;xR+v+}rby!dGb z;TNPzW_HR<`~Ku%zBoOVNPJWJc#+f=hhuR6Dr0m{2l0nmWR#Qr$pxv5@2{}BPmsB< zZpu15efF=THzmdwmh7`^LbLL z7!6v0a&!aAac9qMesM)ei<7rttYp4_+RG^Jd-r;DP@A`{&8yMTE?%+| zoV`&$N5JjDB)Zq&D%EMm9bLb)vn0Fg;dNXd@3FVw{!`{BaqT+_jkuC#rRdttICrxl+cvqk`HI-ygrwWBr2A?0eZPDtj-*jBUPgXmGn$ z?I^MBwvKZ-?8RzqVkHEgp?U#wG!pk6`i?+KP9AW6f8F(9@@fZqG3t`i?9BE-_8|dW z;uW8@L^8?BH9s`7z|Y=NkQau%ftJALga3F2ghv;OIkvVm><6l zG~M)d=C9q7KS}b;K6@?~xs5;k(D1!X^+7>igT|33l4EyWXKaZy@{!l+xc~GB@Hs94 zFA1>LW8zR2#7`)2f<1{X=eQrLgxkgiOWjg83$iPBtW|UjEst$f4H7SZs2eG>Pbt3t zs!e#hX-fKhDUVBUzw$Da`8jz>1i3D;*PgV@^;GXw0bwi@$9W>x63t~fpXhk zK$y%sgt9Q`b4omCwK&@&4$m(TNPOWgT%-EuC2DDKb1d>1xv@G{pK<(O>Adc!Ah1sD zpQ9+594Z_zZ2A1QKuv4^@M1M>BX0>xspfReZPnO%G0$AUjTa{BPa|Gqjx z3a{~*>FWy>6>yC9>}Wf3g4(Wu4fdL8*$kPUg}&B}Lbzl~vZ^C1)rqO}Z7@$Tt#Z`@ z=@A$*q?;zdTrJi57NVk}PU9w2C!BKgUrUt}Zaee;=!E>J1g0$0+#~%BTpC#NvSy(? zlfgzmIVR)o(Vd?}I0L^^YbW*NCYm}SLD5mVm-5R;}{gU#<_Hbk?Tj zL&JC;UNyHMy(DDx3lEzci(>JA8RlQRN6z=fMyY>NP@#fxK7u26{C$Lzeo!()|1I$@ z+rvpsU98mo$$+Pw$i&FjWoy>TP$yMU;=yH*Xwc z&i8;xCh7m31mp1}S}b-1LUjn?Mh0d=VD6!<3R#XW(ZqM;zeWa!eh-2fi@YS1vwCHF z!&|)%jxz`gD$Jk}UaoxHtIf?mDAOf>Lud>2M;&gHEj_|_><@kN{@eatmvs~J&`cI9 z@t-;zmN%W?F#=&weccwkG1Mmgap)75p84Aghw>Ab@-vrm6x;GD4vs=EiIRv_M@(; zhz8WeAMxr&sV3Tk?z(!m#ykc=^WyGWA0t*{CTKw@ig9{e&8-wm*;tvTUc6dKzR+smW zF3xv#yeq2bUT148XFZ;UA~s^AjcN)k`^BcXZ4IOA3G-Y!oesCdhxHMLP~rY(SZG1^ zk5ZB5%J5&4FtrZj*SPF815fqitPHFQxYK)v76->BHOQ|y!}Cjvd&CEuJ*dd;-4$dd zy`2?gMTJz%K4!`0_Da!}S997J83ov`Bq_%0?u}77ihI!UoHP{+5try2nUK8C_PQ*O z_(KUhI>H;IN16IGg3mQ_tN!!Nd(>z}^4nj?aeA|An%A>)z?rXS=B}n^#5*%*RV@l* zfNGB2)V}sT^g6){uQ!CYdQs5bGgq~nV-PnN4_l!|r^!v;Za#P}*b9*tNpAmWFHyHf zQ!84+4{dL2X**3?s6a&uoC#Wjy)1x$fFb-CSpZ^Y;u~0mhGm4pf|g{2k0<3I;GyaB zoJZifCMl0*!`hNfN$f;#|60=}^rDoc!Oi^ODvCGdz_{LpHG$fXOH-ek18W3u^`}QJ zq`VE?7lhu5KwU<6cyy57Q9Q6bgZSF_H3+Ij`OzuN|_3U4vHtQ zY;v@C+@a&C4h;oY?$G5Q`&wZjauX>Tt{-$EY;t1L6L#1 z$OG&uT>(6~;dYh39w$}=5&wyNAX!LocY^HDQ%yQ-@?OS?u@|O5BpHF9|6MY|%g22p zd+4;vlz2jEB0pwFCC(UC*i$hHgVArS;v$5uu<4toM~y>hvvV0^o!WF_0B}(L;#KVT z$Y>72-}c73>eUjU*-kJv`^G({Sk+*8e6Azu^7owNUbrak~HG;ZIHes%eqs}Fhro9s3CM{4axBhr_i-0w6y-)W@VTk!a5iUnA z*|)hs45(6)gwo_YCVu|tVdkj5T3Ld1Bb$=EC3trItLm{zR?WpOsVpQ}I;`!Bi%(<7 zJG2=a3w0+;P$Oco|Nhg+N2`kI$oLq$l&yxt?QD!jWTsQM<*23<;x1^cU#lrdXCgI5 zNP~Ya3+}LEyGimo-=Hq)MtkAx;QrJlR+5;b+CUI*XjXbfL4Wo)gWWcsFjxPH7&8MSg1GeKeHE1T;u!i{UHUk9mLoG7m% zUGmHfYH@r#@mydL zwR!TDcKn<9UFX@!D@;du45(XpG*0w9jcO#PwE1=i{awk;je>1gu%hfyK$i1+W;V@+ zrmjZeh5HG90n+sMx1Gzx8a&&j!mx#W*ClM0>F>;#2KN`o+X5O}Uyx3Qr<>yKs#)v$b)zry67X1N0bksG5lD7_^+-$>jjg=cEPe}Q03)N^-Yu!il zr=Fki`kW8f7?oMBaYY!Z>x+L+!3Ha-s~DLTGRH{t6wha@ zK1RVG@hy{F1E%MGV#(JIMmSZnaJc)3>!zAcbjZ<3(vrAN{9f2kS+H@fwkc64oMO7X z{*zjjxS3;5^W*a}SkJj4qoA#)jg5m<^*d536|8=gtNS1*_b+92!d&Hn?4XnBzu~h*_(3vmH8YAZ^`{Dl7nJ| zh@gN`?P>6}x&HEq+uU3&N$ z?~6CLBJPDa;ep8^eR~CrA;VwaDeu&06JULc9(?~TEpAtJ1!&*QR zoVA3%GB?pzSCki<<-hSYroR7*LN)d^?}yhc%u(3#;exE7OxYzeauXEb21gK8*x|;> zhozeDU+$*;&*{F%)e~Sh6>}S%v-Yd-?vA2}I1?CelDzKpm~Ry?6en z-p}1Ag}peZy4qx{*_`v{?Qy^2pP_bn5B2s}N--Ord3jL;;u7@+DM9&-nO%$hYUHnI zCZ;Ks1QgqNnkMTAhp@ky!r38s0S~f&u@;@nbQO)zw5HX&T`OqS*xC?$b9QT-eI*~E zlBdTCw!zpPc;6ozEuY3Xn-H5g=Sz+hAcPK3Kk8P2P#9>sSX~3&-EudLpmwt1^!fbm z-}ajyV_q~>?X1GpxjR(ht^oT+Cg$O9Uo$HOWJT}XR#ZgM7jwKO>p!SR)wTzFx1^?M zrAUSL#>>wCvU8dR9Wf6KB4FlKifl-rOxL_#7<*fgQOMH!o=u3^SsX|SKpFY35uiw`ND{l)|2id&AR>EiB<~J zxcTJbpe<+P2$e$aq$HW`$seor7kQqGe-z#$4)h~GX-B3aOU_U7enL{zh4D6d1DhwLPBwJstRqOGGo z_R~1s4J%Xxhzn+@a@472XSgfseK0D5?kp|}=1;$h#zpl|fwNy7s)78loyOYp&SsIn z;qU&0t1ISN+)gM=s%I)Ugsl`MDb9wwaBU0YTaN zo@o!1WT~Zu)M!TPxQ|5!-%p3auzq#64&A)W8qM< zjU3bwcK`1`cOEQxYwvA9e2ID8=;-8lNaF%Gpq=sy(qU`B+a&4!w)*z*=Oy(0imR-V zyWDe^=3q*kYqh+@!Z+kmA%K(6C@)&=iWe2{_}4mw@b8xF%=uiyQ$jsfHa@>l<=%;Q zr%X{^)_DUrH$dKQn z46Hs9F7K*B4H~QpBn1hBLWW&J#&~gZpVp{1X$2+dISR;FH2z84^2+iu)7(ezS|T_! z^CDE(_78xmTi`!a6u7A5KTpkzsw_m|+(%w`Q4QX^({8MDDJxd+ZiK2S*F*(LqoKah zDgiER-})RRny)9iY1T|pNEqsqE4*|mR&)|U!|I`Y0lIH*A2bJ|T+#R2V@!`pRP&?V zJ^RJ%xMmrq;IB8HZbRSK@0I~@_WX_oryD0m1@lK#wRcW)*&loyB}qQ2 z67t!?e0*_&WqP8bIVlU0qO9+HpD*W9z%5JHdDh<9YuR1RvJrr`WcYYV)%aN9+Q~@I zzm?6Ll-+!uPa*7YIeYmjHSdD+uGDQK-e5{6X*jDc9->59C_iOG7unGE*}4ofbu(UO zF8@r0ec4YE@GG>Ew88nmSfH5y#2(HRK;i(!19KW0kqp9;r$MHRm-%8-n7j!*v;wbXF*4A>xu4S~d`PIb*R zLLktiX+L-6q$#=%HEM__@6LWWWl0_FtI(i)(fTjbu{mdp++?^F{OBBe+Qi=$h~^+4 z5^3+b?}0nLsLW%(xotdIQDQ#Z8PFf6ncVF$cgJg}v1QfehtDSFw`bKXwbY{jq7sD2 ze}wr+-W8)g%qgaMVu#3+&%M78{(Rr({#S64P17)>wM@0S4O!s%+{o`Qv^hIj1iI!B zMRM{AFc_xcDq6DO_eY8?L#pCbK)^oN04IvMkuGHH>*{6GZsxQmO&*4>fWxKefS0Bq zV{+Kw5Y2gY-ODq39;eOJeQy*EJuAz4gX^C+F5Yk<7mR)k_IEyp**-nBo;+D5$MX2w zG4ORI%Mm{;<{RMr$;^Sn)ZnyPjiGGefy zcN%l5=~;4F^%C>}J6QeIxf*C-F!(`WvS()0QfMk&p7=I=O@X|3i01wzugYhSFD+hs zy!;wcch6@q5>&v)qup{*RO>!TE=AEfsVeF=tqzzX_(phvJ^Prk; zmx`W2rWu#rYYL{z6Q%L5csHkqmK5>gg)wqHh&tPgJzdjV`{BTgd6`bby8>*86|rr^ zP$g|08L)kDeNtdwhqYC^rv@uUt-iH_DK#9!Ioftq4Rr)Gu6 z)c`>sejfa3ZUi>G%R|_u(>P+^`v)IsK3{8sH{yAb80&7=pT`a&A)=jjb~Fw4!Cdq0 zdp#3G(lWV@&_8y!$7X~z3)?>B#m1X{pO^jGI(#>KhI*W#bXjd)8gxamfj-U5rE_y9 z)Sjc4z^n>a#9ZA8B~~+lBD`8;_9LmLvvg*N4Bj}0V9NN&lDp3*|7~?=V`=wGzph&u zwdv$DBX27cE5(xc(Jce1dSuDvE75LP&^ohHitJQm*M-pfT zlabT*(=A+%q%QB_c{QEhj6Mv$vdKQ+ASo`8KSMcmtl^l_pXoYus-EGtXetT*F&qx( zg`oDM&AG*-_Nm>4?# z9^*eAvU{Br!+;&y&Ns_@{4`E44s}Zc%tL;@qbH2mSK0f_|N?YNVveT$P9X&lgK&z@IFp>j}2Eu@PUVDEPb*#j>jFp-j)sN5(RX;hV3Pt`xOej48X>!&(elG zOcrOfA-gXFPV(l>DV+NO78~qt;&T%G8JP4#T0=$K;Xx`uVVlsa%{5cG%z8uuf}uws zs-9Dnf=%+frl77>Rnb1H-L=9U*%sXFn zwL6QCr$CZBpkV)=o1MKoU10zWp#%NNZd?g(GlBV^Bu<-<&ddUoK#RHr4Wpdcxv7UP z%o6;mrN2jr0*;2}kr6;PBJ;o7NCeZ=|LGMVNfAPfDfe3MhQ^*J-RDn*3y?GlVWjM? znHpa!OraBXGo+p806Ik;K*m4<9nUR+&WDeA_g|XdPbQ=i&nhV?0ZS(fZ2vn~FMve$L^~ZLcR(tv?Bq!1_T{sOIimMAXPS(Ei>%IE1btq?Y z{2m1`b_O&>gdWAw;`BRwG>%*S_lqg>!9lC_z%&`qzfDO+HPI|?ZM_dbxHUC5cgyWH zdsw98y0HCPiRawsZ}0@{bk@kx=4x70JR3>h`vcSi_ELwpL)c&8x5K{1Xlb6n9(}KW z3tA3i@mP#)BDt(_-KQ|2k6-9SWc~D$X6ZXWwx8l1``uZPR%YU4GypUdn?uGxdic3N z0NXeHd8S3gX5V!J672y<^h}irAXLr3Q(^AFOiAJZwn6TxwX}eoih|PpdM_XNbY$9F z)IMP!mz+FUyn3VI3vfC6>VLNI{GTvIs)eOsr(;)9`$=_V3Y!?%qx8M8y}1MNRG^-y zJfwn8C&UDb99hw?f2grYfs-3$9hyjcW@nD0$NG5CUX~UY-|j;WfSz%5QhqH(#gkJW zQYvG|0GxT~d>sbbIZ$#nj*;3n!bakD(0% zx?edf`y#hPQ{=bsN!rJ9%-Fv;RO~At8_G!b+x?quuBmZWS5-f926g0sh?zWYeSE$W z@Xez-UN|^0uYSnT6@AcQiVNDXO62z%K;a#F049tA(b*4`ia@~dJuM@nvvU;yn>p%! zbki(wQ`CFBv*^7qJa=WDlU@{iRjR(KT{2Lk0Phe%NPPW2?*vp+hYL3Yoq?{Drj(y< zXU>wVML2Ovm?Iga6etc-Z*)tZ9J8VX|Cw!&UH1EtupA<=NW$A3DVcMr2s9M?H;p91e}$Lb>Gfhs=DUb8{tDp2y8O{gpnDO zu=>wr@7fhv3Ri^g^_6$Y>zF=D@Tp7(lSaWL0znTq*l^GCYMgFw-jW0C{dyi$4&Y=0 zSOIbpBSIV}T!3x@)3S%BHb&6T84%^5t(}=^MIUX}7zu$lb7@u`+p>FFL@fy{gKfit zp^xbBK&Z`$2QWX~yF-6B8KETMNb4t<{QBm0Z@#UvOBK7SxI!o{I*w_)7MWZ!xQ~+D zA}?<@`EYONs?&dhu|>9_p#hlaWMX8TG*gw#Id1buL2d8XJ!+E0BhQ?$*{7$WJ(%wT z?$T?~iZEBU8?9zdDH4<*;g8b)zcBwf4@gk+mXG+x@uWbdP{ry&itgFm4TKpL+v6@( zrI1}(Uz(QBY6Bd3v@l8hFg)JN1wiKXF|{hu#=4vCj^;>BOiWnuc+hJ@@omk%YlcDqO8K6COs7#s6QY5x`S&7bJ%-h|)AU&!-fb=)mgmjki zv!&i^yR8Lprt?pTvRfNfh>x0 zzi64ijip=~$fqxxR2e|>c$;i{TK;f*+xyFQ37D7};=iHivkjtz>`sgI7;&Frky{x%=^eI%2Q+K{g)~M+@v=;Ot#nLRLut80-KSmCfw^V4ELEG2bBuBJQ;{eg9tC} z1Lk_7&?>N6b7pQJB541`2Qv}E zfI8?6nRel5;ysUDY*fp6TV~i-s2gm$K7B7*>9gra*pscPLo(BzSHp-4uQB=NJ~p3> z6Aq0@Wi=wX@c@Y<8*rgsCbJI&{Qwx8d||cbd{>*AdX{8kbnZeWTAS2*6cuDc*4+g) zZv&X8cUb8_&d_vcOWg!8?3#TZyi+&x81ZXe2Mo1~?LS{^Piyu#8w0-oe3;h&=(X{h z{fS<3#14&ph7*RSIbuJ1CP>E?bC0^v!$ zW)H1VG#6)2+hWtEAEr^bJycZ_cnHAXdXuJ98&YdARSE!d=?Kr-%-`f*9<>({TK0@H zSrjT$@LZl9TNxPWpYDa(0m`7E3qLzTBG$k1@+59oXfE1k<__E)QO4+gcmCuc{#o}= z&`uAhbMnk-i?1^6#+{az<+6P)gLBw-0IUL7NkgM?c?=DJ>kz6@VhRop1`-asckgU3 z?5>w8FzAbGcu!lJs?GoB?HAZBJS_-O_9mahxbAB#c9RwYSRdawisG#9@t}W&Dnd$XSu%E582PXQ`Km80Ug^3;Ab05>XFm^s$>3MQ;Z|W;WO@_K0 zI*?_mHDe^(nj7$VpQqPmv`nJo(%;A_sH&*M#m1i9T`V~e$b7=ZP0Wa3T4rrAD9vvpVQg495fm%Z9S z`W4efiC5OS9`{wwiRyh!lzMtRNrpsuEpsAU6H51ql)zG1==J{KBw#kR%a;AJlJ;t` z>C~{Kz`$TNKqmnE1o$l?B64jh914uBI`7YO8~*tY010?CIqU~qc=Mk2xmn>{Alo~g zIS#9^KPu|}qoTI6ph{3?Vr-zM+z$@!yus;Xu1duq6{x2eI+3gI>l(d0xd1h_taRT{ zpt;t{5Ry_yheT?J4fHciig-CFinvLLh$=)dh6oG-ec6@d=YY)sa29*}`#q0!Z#INV zR7kmO-vZEWz^_7hw&eYWcSd= zXppYlJzHLV?y}~lpUM&3HV;0!f?)G5Fk{t;99kQ2z8xGa)z4t_Uhag1 zwVQ_0i{^l2)}i_CSgAii=u-eg_E@?<=ah)*(&0$&_KiT(Dj)hjcp>0|HUQI0U!VpL z{0>m?$9IwM>ZKaHF{!~38n*{K+otdJh$w!jUH%zQEgRMGwGRoIOr`b8sAgq3C6AI*WBB&1HoXt%(!L)Eec$YN5xy6zs$X(U+K1oVDf z-r4+ax$Z5n=5#Jh40X$MAvw|=gl8+6efkKG?mN`!*? zzogt=1SwM01QULb-*fyRaQXLJmz%yp6s6gCzWk!G{$hu~-hxy9B2itJk-+?x7L z^7(8@(R?1_{)JKkKxyLfo@Z)rW?!?S1|UD12Rc%TugTzI`e zcA3s1@j@i-pw({o7s+1r;8WcYRFo!1X*mGkk-?*HX=t{gY}inx@yupxYXjwt)Albv z6&4u4kk?skYudUEfKrDZn6(ifMHx=SUAa8qm-&Zt!KY_h>UloxWBHB?1Yd?v;#DQ( zQq@}*(}5C3-Cx?fZ|{mPTBm9Kwz#W{bkp=J5{#F4L|z;L`C;RN zbt`|L52b{ptZXW;+c6sFJTow_nV$^C=tR?2a1rC1BnH29 z_;s8u33UnV*5C!1A0@JKtaYn%OsA#$X0(h(_ebFx3j)?AT~J=1*Tad$n`JwjJChTq zF{HDm{Ltb*Bz4_#at&776DmmnLJ0%J<=}jb;#N{V2Eh9SycR1zzs`$gXAc05uC#t7 z1Q<>S08C7bjJQ)uucArr+-`nfm)N+d9bBLEhou(q%fK>|bhAv@bdNikgpl%trU_cr zPZ^uyI~^!jzJSE56DC4RiItqXDODB7o8{mMSygX&2~Q<)jj6b~mN`H@va_j9i6<7e z9RXi8NeaD*ZC~D6Z1!+=cK-C~JLbye2=;@g+k$}3?dc+@^v`}0hsU|4hgf7 zrY^^%%UkM1G@j6DnaFCDj;Y_%i@|&U;qx~A{rP=ebb#{#do{F|s_e$|sEO`* zH*8kU%{NMk5{;T2ps)e>DSu3o$W2ID?Zee?AJS=6#~qK-W-6u+jQ#8O zOYWU%E)S0B-a{cWVXmg@^V1zKmcTI2I?VeCuv`cWKPV+$jMR9I-o#)dvDtwyrvLn1 zxOoW>!o+~T?ytC+gqx8)#BUn+N1!)N;~`p&aZN&5i$j#@ArV0G>+?NAEW1IQm7+q8 zDfS^JDFAB$z~#lvtju)Zn_Fr*>`3hG-BDb6D=}Kbxfzi%+P&^LkanxqoD{sqQGrpC zOo&UM)j9`@>ew`6fXPR}yvA&*mWOTJ62)}uHetlvNN7&s&YoQJ#HHNBaw!i zX6G^u26^XB+zV4OUQLSwVDmg&DV=%_=IN2Y<-i6I5{coOtC%uJWlsFWiNiucAZg-u z`-10Uoz&_!@4;*D0`a|~2l|;2_ei5+s80L)!lEL=_s{2+ZKabq7|6&nsb z&52($d-D4nn+k_t{bV2K1dvw%@E8F8g4PL%i~m`V*Chd99@T6uC;hs6<&>@|)$YWj z9M90Qy5yjnR@Bax3#zS7?(2??cfoW6#`hdBPNb(A!VO8X;-)jQhM1t0KN8PA#5;^K zIDSz__vq#bDctO4u|0&`WW({e$9&ZUEnFf5Kq|Nd3JE)PLO`J3pTJ5%PVT+vX6nA* zp2&$^RZ8k~lyj#odx18Vn(xBO!o_(qXv8W*-C1`8qdXhkZ85<7;W9?EU}(!ssnbiX zpAtU~ni-j>-@DG0-YP%bE3{J{c(vphK9@hCQj-+z$f z&s-YjIknH%&KX+AZBm-d?lukcHY z%5#(t3)i8P5{&V4hAbkTfnuG3E`NBrziBA@_icZ$Yig?hJN+dMoTZ*E&nnm|8i}s9v8$Ul=W3O>#L@V`G^4Lm`CW`I={Sz zTlJyq{bIYvz00AG!0uv`w}+*IVI)~fQDGtf?P0rn#})vX2o%AoB(685ps7A9+PdCt zjnS0by>9Iw8PYB12AdX3GeEi3>%tl?Lx>XLDk?j|3cF?Iv}*FBt!&EJ zE1P=zpu)mBzWcJT6lX*Pdl=U7pojRjTiutf54&|tl2Na5afs4h5vLL1#1rA95y3tH z|0Kf2B*Oik{ATGSvvkqLz4e(5N7Cj{T3KOX_bT_RI=fjntPIV0 z=MULXRdqVfwa1?k&MN1B)rZAJzGZOv(}qTMO(UmNst<(Pyuo{A_+a0@4=7`qQ!)|_ zpL6Evbnu?ZF70*$rVyf2d5;UoI;@&6|SB0 z<$pf&v0;xHqa|=y1kLR=tcMtBwk~N$;#fNOrAV1L9z;|7VY0y|(LDpX%A@WXidkwgQhMI|K+w|ghltkv!X5htZAO;~0wx-2b>#_dfqj7!#`v*` z7c-2e$2f?2x;*2n=eKrUzzZ4FPrngg@HsdIhQ;v@!Ed%ICt*Y%?6y=G)#x%$d71}d zD>IRebjDF0OmMmD%sN8dU6SW3#0)=Ty^jz~5>rjPy#P!Yr@?RW$T^4Zi$`&1Us#tV!iANSj+tc=%;O1){Bq$U+nIUD)II;9lmN zmk@S~b{}e?nOc=UNN8P|8}cshemQcq9NBE|)i>^%W&&@=V1oMxm#~!K*ciVcp3QJv zp4UTTJ(|?ZmHtzI_yR#Tu^d_brW)vcEG^#_~R?4Qj>w-?* z;7I=Yk4nMVto@aqHAEFpI>fWPX~a2cePM{Bwb{CA(vHmlqZ*kkdBP+O_9&OiLkoIe zUz7JpCvYpyVwvRrzg~dL$$0(;TLV57(>a#yk@zy87v<=22`-$+^CLiNloetoY2Nx_ zMvEEM$V4!{V|26ae6C?K5=Ajg?U!F_Z%(}Cf)oyn0+dPss_uTHE1-Vj#it@ZWO?@| z^yHf`qGu|+-YhE&Q)Se*z^*5;-bSsol_m~%XBBetT{ljuGYUrCLY#hU$^vk=X?I2p z#cY75>sHkHaOq?tfl1S6)RZx<83`#MsS*m3nY*wc2IDn#e@J;(!UZh~uXP}&fDG_O z>H_bI_Q^Fr%$|@=o;gcI8PEUpm_TbNl!TkA^a?we_hb$Lyyt;WqX_i%fU1gn2iXj?@C|Eiwu0WK6BCKb<254 zhTLPQVhZ1)=~tNQ;|rS@>syG)uUQjo)bpj5aqf+N=zHd>r2K-c@BYpj0u!Nk+}5H`HqqYA`3+*%XGKwKcLMS!nUoThcZ^g$%++64)Ts!Z$LS)n`At|i z7|iq+-xJrM!z^XGx&f>ck~wT}?^Sigu(VMQ2!*U=rb!I?7H`Aet%GKh_$rw17ceLT zq{C%$M}fX?ZxHD=N8q{PFcC~un8O(RJ0^o%{&uwTFQz+vM{xkAcVDQRg&Cwo;Kp8_ z(eUHF!8$$EErpIZ*Gzr{7De!dU7`BgRa@W`Ir(k8`=z%xOx*$$ST_YL0EO6H8w?iZ zp6pRu2RnLRekza*`ne`O9{nq=U@f>DleV5=qrTrb--`i#Cx4-mogl;{D z5llX$WM4NYzj#qyL^4qpc^Dfrei`^+uPyjp8~PTu2K&0T>9>P3<|_jSo7v1%^K89V*h5o#xKmPR+3$=5_No zw>1(a`qgl*BbbQ6Ez-9X?8NVY;t(vq&UzCf;37MXXesoSF z!C%SdB896gLLsKVn4~g=44>%-R8CCI{I)X03SyX&DI3*1kc?oCm67sU3Nih*!G)3S zS`@xR!4+xHp6hdc2&z+YbQ-WhKg`&5cY4q~dk@OMzNe*#G|*5zbkBbUZ~_ zQ(=x-K}+TQ@K3TzTL<4O?kO4v8VsTe3m5s}q19>FqYjOXyf2|(Q(QDi(PC_m!4|R# z`!WrZJX4l++)i+xODo0v3a_&GvcNfSz|~(N`{u~IYR)RzAZ4B;lJA#s?a$ll7MD%G z(%xVdGvo_ihwz@_VYqHEzkD=Q{=lgF4_y~oeB-z0zuQ)gLkqm>RJ^?;1-}oJL8o*q z^*aD{a=UPVoxxZBaiPCzpb}RTS$xyY4$h>D7i5j+vL|EL0-i_Fn3;;kgaReHAhP8z z7{!UCxCF(IM9wFCTn<&x%+`s{ZCe3@~( z=+L{qO-joDWA81avg*FR(aT#@L{Sh$Km`#5DG8C3kPuNqq>)m(k#0~>N<_LtP&%X= z6p&8oZt3nm^V%2p^Su9OoDb*2JI<$P4~IA0+r9T%bImp5H|Ltu;3lG>=iVXoa2c53 zv?^5wK^VBLK%F?iG*vx(Fs`3S#}FUH^K&jy#39eh74OY>8o85F1t@N<_H4!E*?JOf zWbAf`n|}6%#kZ#T6s1Jn1Wm;&0);-(64>NUyb5Xe%o5Y`os^DK^KN{=<1ypf)jPc4 zPdQt2?tb$^k7_FV6{t3TWDQX`oE@Uv{?@ni2fkZ=;o32)G9GIUh_W&ou-+N<^O*Va zQ{6p=^sSTp&?D`YUPEzGM9E_8<%_W^*d0F}#y`!*tK?Y!@d0lK6Id4T>J>b4;KX2|R2Yf=^L4}d#e3PB)u-K@1|4<5RUDHd z*Eld=^KYCw`a98_O@H}DPY2n2OtMiTp*4@APux9LkY(V2qcGnVhH4IX5d3wjxL@-Z(p z@)eII9=`ka`Mmt)&Dy<@BOUL?S>qw{dNS`AT6z}U`i5QLz9T1ObF-4fAIZWnSjkdo zy?mqExP;fW+QJA_t@-vdYU4l0a8lB<^iF$+gvc82j8o_Q?kqF0k6~1;B2_PO-W@C? z^gFUg1UoA)dJ?hLwa*%&?iX~^gfj|Ca@^yU+xq=cMXp4vq0|qStMM{BHhGOIZyTBS z1#&U%4i(8}{f_qK2t)wH`k^spRG9`ze*RTOmdR>QH3rqA@_|KS$61#dH|!Y3qfK|< zy(pG}9S1Ey`<}D&StvePW_3miOQZTR&|B@#^G5aAhE2A;)ImY=PCH$`R5@mSxJA5b zXxH?Z?O*{r_ilmb`eK7WrHbRgPGoynxe6k&ED*gvqw<=0$}RY!V_HB@RVtrF@!)mw znXb5WUpg%EYI!o_s{&$?5336rB|@2P4uV`|y6VahLPp-en4OjJT1q0i-JhJ&V6*qn z?)8WO>Q_Aemzh`XpfT@;8(!EU*N$oPFO3|XVJ->TE~>VRXzlb<5i|P<1!|*uFZxf% z>-&-w`57twT{<=eo%dC8(zJWaH|6y+#CaZ2pz$;p za}3$#ZQQ~Ll>F}|pZ}zF>HH71=z-Mi{=064_P+-MJF(Q#2a9x4@Wvx7U)?B_u#u@d zo%;8j``Mj4NKV~Ml;}LX3NkdrFWJfyRF^mfU%hK)=Y zzPkNfneevCVN(y8k^YYKANy}O=%Ns z&%@D0Z3EHZtwmm$fT?j22_=>w4zIIw(12z4_Q86s&$;Kme9VS} zKSUj`ys8;|G%HCe=|~dV!qb1Ay!>#Zc278nQm-Y>^H9Vpbz~7ucXegVXG1@xGn91E zi@wYoV5q-COV0#<%8V*Q->J9(a;v1OsA7?3IPx`qVEd}!&PaJP_vK>c&0RugF`+Mb zaic=BNB$GWzO~=<~K);)`W{8z9eR%TC?V||iKc{bX2kv+{4fSJ_ z%aBJ(Y_Dc}9aK*6k=^SrULP$O*domkF5B478?iPRd1L=}Y~dl4)E43T{h8u}w5s!L zGX8aIu}_DM@|Rm$RZ5+$A1|5|aHb`zyac0bcOPedb>lUGoyuE{=#-QzU1*8w@)v_Z zkW9Jd3%D)_c$n$ry^`GyAstb(J6LxtF;Kc#8m5-&pf)UN>j3#`P5(A_HD2q@2z|p zd`x2$v%j)bl3_PDVEIbl)@0u}{i^VA2}K2I>!M%B?B0GN#%a*a$3R4H(*p7ZB!UTA za>|vIRPv@wkAkZz9HBY#x5C&j!C%K1B)hNSGYD2u+&VRkOL!>Rr!MtEnFUHKHZ(}e z;lHvXUFa_VJsO;Ba*$hpOg3*#tK2frx6{*HW_Eu$((>4Qy<*>Dz)_x0T2ayQ*NrkA zF2`fxsB;pzt-3|JvtpugNc5-80TG)jbX*NB=NUen=KR)|Xw;oevsxTd zbk~Twqai@1@Q{zGdMv&U&CcpFCwP*?wQ{&U z#0<@Z9lzA(m~gn6sQG=$BC|r?o~N~fHE7` zz<%SIkjbb18{0-Vlu27{mklnek@a$KEz`vuEFvZ264cL(BAYaiyzOrXo7-}Y3 z4^l01NSp8|45)Q4Jq1{cP%*gj{jCAtt4<-#V=CB6G#MOk=S56f?Y5U;r{sw}FPsSL z6Y%hvw^m-M@e9~jEmsc|Ip>PxA@R#&xLis?x5apKqUAh!b?Pgp71aaF#_g1t=rL}! zrG49`5qbLKF$3QhAMjQg;#xK(6#YszMN2mQW-ly7jj!53SA!eOh}lZya-#DsLN%gt zwev#VMy$Z>wz^59TwpD~Ul(efZ?f4z;gI@g%I?i!abAg&ozuqTr{TpVHC~M@otR2A4p)t^}%i+j^flb z^kush;D(n%3(+q+TG~j7M7+v3S-Q7~(InsafLH-CW9=-yDaQd$;r}QSstgnmg$@DI zDIg%0)U2OjJL{IS*P&*0i*|itS4qNm0JffqBVV6o?#vpynqm-poo*^Jk;Qhi{=JciHl;W~NQ;lEm#NF4~ z32z?kDllJbFFJ5os0%VF+glcWAeQZ*kAP;V!rKUQNLxkhR+?pT1 zv=I8y_pP&3M!~6a;E5qE$B(=pKb97;)sH2TM18GY?_;MljZlPe-1h0pXATRV*Fhu zO3XOeQaM@c-Uf#CTH;^PBqLEjW&yf4i%Y z`hMi}kqG`)a_(a5^Tni-m(gN4ewF!aAi=bb|5Q^8&0%(bLV=I3_oX}~r~M8UQQ4`4 zs&hb`L76WVyDPsYWP?cl8a|^WUz%aJa8S~b#h$G+K~k?G&me|;=FUu8I`<|0C;{s$ zZz}K4b(GuJ64H43{d&hX+tU#~n4)7aM!r1bA%14p-j{6b2USdfTVdIs)YKlyMjJa9x?k&KpZvn6|2!E~iIPB7?x$VbkI zN1`6D>@P?6Cr4n=p`R<5eRsFoP5;*88`<<+`QlBpe*Hx%Z{8?}4rwRvk{{xPth>9O zW4m^9(1OFcW6afEGEk2=m($O!Fl+i}Be#xOIO1rsB5+?D%uHKGLdfmxrP&T%I-c+1 z-broh?g#Vq2C^PQBHnC3BX|vP6Ueurrfg#if4udaeYLK+BkM5>yE4#snOJsuzrl!)5k6`gG2j0{O&T~>8 zO79tLD#y@xR1jlpzKIvuBE8qm^;h7Tj?wFCO-BgDN#rLGFIg=q>08^{f)nWZIs*-0*p?O*I(i62wW znCqV?UN}m5akm(Oo>nl?a)a~jUvU}1MZr4LEBJna{M}Y8|Em`+3~jG*aei#@BK&P&^yE$ynYH1?$*XU_Kiv)GMt|NXk4-$>gX z{hf5VoUS+7q2h!&;7w2ktQjQVepo1tCu`huUPrd5QE}ERm^&)yzWj&O;>y`H(;`~s zF7$65ieqMS9B@PDL+amt*`<^Wj$J36?~Su>yz<(W|0E9>m7Pl#z@TC-t;p^_eEES( zLtuoMV6Xe|iPV^doQ$k|q4KpBXa(lX!+PTRsd;v+AntZZcx_*g|? zbCkgzSwNz>D88>qV#wX|$=_1eN)8UM-8X4AHM175ZDu<&oox9&^>1=$%>f^mrXDG;~OE`;c6iX|4Sqo7g(FAJsQ z(<>O}XZ;6R3TsjFK!TOb$Urt<+*=f)k+%UMMxlJ%5H+Ckl4%O-Aj#RgTk_&9>gOyc zPm*Asyg83`JR8+%Hv8kPml#GU`*#r}HhBClh0{rnKb{6V9!0w?_nB8)eZzGhgq>i*&DRmc%tc7T>b3I-!ZX)Ai-VE^Gd^NE_7!$Nkr^QnjnMpmLKkU-t1cVWFrscx}fuCFK5yf8r1 z!Q}{p%*ICYM^&Fao7oUSa)amudi|-0x%c#2B!BvEEG+nDINsGb%&>pYM z(|}({Yl3rJiKdTBH0H*reRGnJX^Do`QsCqlQ%sZs)q?nLM5m{)?%!+DRtw|)F00^n zGREut2n7mDiP0jBb&f~{{;p*r(h1GxSoocx|Q?KXOjtOI+ zI&qLC`&4~f!m3gcOEIlcM0|+|0x<{-#czZRt4bIDN`fWUjD$%Gi2b{XV;OSN9x+=ek9?E+_Z?)&JN((k{D`xfh;+-vvJVoy*UnNFbf1j#F*43y zVsmY>^Vn@4?=)V%+;Zy=%Lx;@d_-)&CviAv&n~n%!xE2`P1v9GCab=}JnP9I95A4* zC#9RBR88*l9xiN>pgW@5)1OHC5?oK#p&SWTf6{sBp7H6oF|Vd*vCdBqaLZ1{xpNU2 zXY}Nk9}8}pAcvUi{4I1UzE1r4Bby$8<`I;G2eMWEXx6-8KkbiqVPBOsOHh6pNm-7q zM+D7B)^D=<-zfO!udYytdJODcjP7R^JlRbn2*p2sdup~{N0cu8Q;m|`c!6^zdqYgZ z93A{~p~8@|E2{w~o#H1WB{`wyc14Q8<)D+ME}j@l$SS`Tn8#l6<_vSpT$7~Tv zUw?8l61h2%Y|2TeECKw{Vn>~)%w-sP=S0((V}f{3vF@le68?(OjfhBc z^&{eV&9AsBD(M@ko`AUld9F-|Mu=_kYHZB=?7~&&A?{!`DU@0n^9T|7)R^H)GILXZ zihnM4upUpM zELv;*B=mkn?+q6x40&k&Do~d_yLA3l6#K)$r4v!a--FrWG9@b1DXF;`PAdo^#m%c4<|}Sod{tcb*}~*Y70t4;y-(7nshSPCm0?~D2!8{$L64^ zB>ll+{mkrX;mPf@m_(6;&?tgEJnfv!x~M@~dV!OVP9WyaSu`!Mv-;&GCG>8Pem|iF zIYJB9uaRxaKf1OAmIAHt|CRSdNInZwXq=h0gf30p8x>ytm+l}Aka#%iA|@1ik(-+J zs(St-Zv8ij&{YC+?-NE*dv;9RPfzLO5`Lh?9u`B)nPnjM{$#v>YXZxBntUo;lw$eu zZ@o4P-vcv&?LwiGH-sbBjyk3AROIZpQxWwW(_<4k)+x%kvL{X~gLWAykp zk0=5kVZSMnkCV8@eR3E&x=>++>iGxMB<^=aFJB^gm@CWu?|`Wgp+*TM%CN7B7W3(J z*0J3>iJ6}yMEhNZJswlw1O=UHcfkC5Oa8yB?wS~{_cJ$>C$YcwLA`6n={ z1(F)bic8JAeR$5L2xzq;p}g2tgc+;U|GH(K2yTqnMkyg2{P9aV zM9-ja;Ie;p4B_6t{2e2$biEM;=t^7N4k}8TXdu)oYKfFdS@s0lAi<~+)3oft#Z}#? z%AZdP7JqQ)1mdMoVq8TO>q#ELwK$J=1h{BZ-PQHUg%i@uU<4CN)MMPs3|`;$B{EavkwZWxp)?`2bqr(M0M-g<8v^A#O5(*tM&W#vKF5P8wvqn=CqAJ+N_+{JwL zZJPA0O$q%Xi(U@l6A?Uf38CuQ&z30x(dX+WaVvVioy2lcw-8Fy{LGTb3&9xc+87_s zMU@#3+Efvp=BCz9eq}hGLqV-{?I;w19NHL>>W>=twEqe*Sa^CmJ9Sb<)SsBA|7A?p za;dziP3oPBrygj=XqbOxplNB!pD7@pK+lQXR?k1#qAnK@0^23Bn2rm)q==LID{($s z;l$+TPe)j%EP$h9wzS_(B%>jU#4t|}V{E%%;;Cm}2ywo>gf`ZvByjWoHP-oWAy1yZ zcb~C`>pkiJG}K*+F`^Erp!4j1%I(gRApO}lF;wLDG%bfaXI%JCw(kp!`bULwzD+6o zIof3_t#R7*-_i0QYbuh@3k!>9xJq^i{CpR%^n{_h3Hp{O&BAqBBpVbay++NIJ0=?d0WDWT&k3q69Qvv+a8g)~8qAIguMKmyyR+q=`Am zg*>|Q!4n!-xpy++(Hm$v#@|Cp?nM{A`O{N9b@9U>&ElQ7lW)7UVrXp8((%KUzI$3k zd=8H|9wX*Z4j7+DMarC~o93sXtyO3B#(zogQ4QqH%i+^4=S%7jz=~JVxbp9imJwQ% z8GL*|ZHQR$7T)5W80#42gvqhYC<-EA3z%)Ks@3^jaH3XGM~ME~$S5o&ZjSu%KV&xQ z0FkUSDpEO66D&BW*8THhMCY>;^|gbziftv@EO-NyjlQa^+Wcm4TnUjgqt+NIKnw>b zM0)cxx1Vw`E)HcRETf>MKn!CRq$Ghk2C!WxO1e3DLm`r>z@&%>d z>Q6t4fm|@jk$3x?Wa7TH1x0f3H29nSxzBat|3ZH#5=^>h-grWZxd7mTdzWtv+*j%1 zLc|=(r>Qga^198V8|=o)(6}z&XaKq_Ub%9`A6l+QMGe7;U|}i!oJ#b8oAg%&dL0SS zTlAjSpKPthPoF+Pi?}BuBJ51BPRrk?r$3m9_brD8jEDQ%bY6eT9rsCj>^A0mTE|Qy zr!(L%1_X@f;Z({6T-@gRdSZ6t$YyQsMIJar1$_fIRMnvWxS;!`GWAf6+RrMsQ$fS? z?87#K{@?o1B|kQjlY$2EK(nv~-t}#hwWN(4V$dL7j3iRw-52~!J+#ZIu zt=q#FaBzy(Tet`ExJU5n{`~oKj?_jSj)WyTy@kJ_Z=>VxREYbfTU>BPC?J`aEb$#( zYRcZYH)Hu~&5cB-)d6Tz3#xm1&~&2FFs zbia^%HL_@BpBZB}mkbH!KYskU;FJ{p3QWRcDo(stSH|;sT@$UEPEw~`w3GclTlT|w zDrmT85bg=(E>z3xzJLF2>#V4xWY@@0;IKVpJzZP|-L{8IZ66*!R##VtLr$zIC zbOt>cDut$BYbTNoew@unOPPZ)=!cH$D#%bKXyi02_~g+r^yF~Ky@@pUEjZl4u7+M zzC+XaYXZHCTf*LimUEr;_A-986N)f}317bZZacGyF-M!3&MI(@(z2oZXAqh>j`u5$ z*HuTX08g{u-WpbwmCe)dN_l9|jZIE!zmNrM6>0UT6ISS+n*z+gpx%_@CiHXd1*U~! zK+XrNwc&OXVtj`i9U^3otZ*Wh%MmiwKBamtMuM%8QR_liqG^tCqhdJ?plS=5)6N() zc67sg`}VE(bw=LJ-a8S^`Rc#kH#LcoyQQQom#(*j6@&x^!YHo~&%2X3aq#ezX?wh< zZ{+0UEEu*+-44ktU3(Vw`GNjugK>d9OnZ2~WVyTq&T&61fc$5fK}XkZ)l8L=t)>AuqB&poR9swKLV|Z4*KuznOMzYhJEYNartNG0 zIfKy#zJnFl0t-DT2Lyy~DTRMAJ3Ig_q@AI8X?SLgfxzaOh@jC?b@XH}^X}Ys=RSoB z_Z+9PNb6WwD$86PcE`BFsEQB*I7u5ds2&iL!f8mxL=Sv22b3 zh0sx_OvV2jaCFD8@(o<&K6{cNym4h6Q5r86v&pB+oAPRomUG$A?^VD9PMmf*NXd2q z9iL;5InJgLGAK=!?X1?4@$F6qn3v&#`(8C`6_b?lhwFn$Q{4_=~^J#H8mzJ|WC!$w#-aCV(*^DwbY=|TEy*yK7x_eZTtwigGc%P!&KraR_;OoPp` zw>e+dGffLQ7I5->*gJeZzVv>@ff;$V|J~ zw=TKk#X(!;`OFI5^{s*trvdxhFQE}H)M{Fc8Tb;^*wCPSKV+Nh(W3)p-=sbpsdeHq z=+OBHI?QHgXGa(p>otWkODBjy=Uks=?N_BXt6`f>$r;6SDPO+ek-ODSjG0oS_yeZ( zt{i_aVJ+KFFFTi|gGN74E+qXS1aM9q4sWij`ohtoCiZ(?X8Vf;_L;Ef*IJ#Aa&mK_ zS2CPffxbP^XFZ5c9*3M#R4G@ty{LvWQdUro*J>ej`wl(*!XrxoIApn9IkDOqNUSQa z{Ps7r1}&2=6ciAsfylVs=3IF5&FME;3i_9<`-?5-;g9~Y?I{$~P2ah8E&)OD+0fNm zUO}0!+5e6$(KpeU6}Sp&e~`iErOPZGKU_V2?0Qy9Q!{e2d3JX8IUFs|))aMeI(p7n zw(;jVW7O8iz`#I|$2B!I-4CCX$=|1;Syhd6&ivSCm{F9Gl$10}s~-)QYERQ*f8Gr? z!`^db4saNG+>@Gxg{9P79Z>lPrYO;qXc37>fET514D(%ddlA^yc z;_DSh;t5_5lS80!rkN-CM_gztc zt-gs}=dGnjKRoqK4vt0tB-~&y>QhpZ>&xQzc6rfdzPOZ1rlO1?A>^PrBSZlnPS?wQFWcOryOvS-&L>nPeF%+~jV*-_$oX zS(FgU5Xhwltz)%$(yo-LZerhX&o8yLYdw-n-GrU=o9jhfF%3O^+QKTf4DlJ{ zDmOlZB6q86MPKrg&i>y~E^{^Ks<;&C3HO`a@a{Z%G^oqkFX^q)1f!sqh~$9wyJ37D z9v(BG4g~}R)YW70?mT#44l-(ey48AO#HnCAP3cuX{m3(Zei!<>s~_Y;oBz^CC)BM) z^VqW)56-0XoJPgc1zERvK5iapTHtBZ&hf+eH?fpt8EIazk6}CMX zH=wlIbz&U1=2A2BLCf^+LFpf`Jc2wop7@aP93QOXlCXYZ>@&;E6678d&Q?mZn2;WHim34MoW?4CdB%Lx~YYa;!X;``z7fIxM% znm`gx)(c|4&Qkc>5;Z?G34WB_3*rC*XM=t-iIHDySA?24bpfsH)>4-5wcu>laB zg<%y8p9+}sT-V^>;E2<{crdkO^uqLX>@RY1a`f2X*rXfY^I&>nCUqCOA(BUfIdci7 zn{%?%dA*YP2{qPhgq(!|H%Ih9K~)?d*~5Q^dRzI9R(%&145{gELWu|-o*`Y!^YWvdzMDiuNoRjqIZ|Fk z@pp~xPrBh%j*K{iwU&`7;=nN&;4PaK8!zoh6ii10D3P02zgFQJ|$as^CY}w%q zr*r%-^?T;;ab+a8ra7n2kG|R>;E;W1lY9PkvP`{aw2!e}&InWdFI~LKG4snwa!?Ma zv-w4QyF%XteiD>HGnWms!E$Iknk5K;uxNzr(_&s1HdL&B+w+%u2@%FGr@&%KS%b#) znqS2u*d*B4i7rCf$UrbO7)xHpyW7igx?H$^pTjmuTKsTvdRqQ*g-eXXnrK)f7ztoZ zBwI*^{(~A7x=Yecll3^j+L+9kg=9CA1koETvv)aPvyzBY1<()heMnE5hO=^y31yu5 zuNM_e1F`$qN3?V5J?U<~l-A7!b5uDU&V%r~-0Ty@&Vtnj8I6+y&dH)|@VEVRW}o4C zzV}TCbb`8{vNBl>0-P6Ae6n<6e=DWbA2{?Xnk+x&d6=x0o#qoek*Y5%mqRy03xHT0(NZu z8@iDP=Xl$bovOCa4eGIl)gea~P@{Jk>?F|J49W~asU<0mn?bpb`&NqB*w`MQKFKuR zVAZ{Sp|7tmQ6h@gXgyxU_wV%d1@eP~17$G@n{u6?NQJC7AF7NP2pi|RQniW%0w5{r z?L`mH7oKo;+(2Nah`^y!} zrlud8nwr2McohuBa{5Q9D*{;O&RH)Hs|17Xp#p8l&DP()|EG(Af|FAb_wrQawEbsa z-w<=&c1HW>X5bNsjwlv_t>E&WxRY9c7$x z<8U=r>aix0|Ae~7$MEsChqreL_;X+f(7N^hcwO}o_eMAfTM$;@W`SgGcnm2=(3IY! zboFD5+A7tDj~`niIoCg2SH%;Ed}M0|-P=KA-Qu#q6Id9j;Ct|3{kV*PuLA8^T50{z z$x@g!B)m)Auw~jR;KA#-X9$KkxTpdiXi?Z6Ck#F7*^LLm!j|pwA$~wbMO71ZTHa}* z)^{XJLqt_Inyu>;>P0)WDzu8|-{d7`rL7)WnE!}S`2~$0Gn80*Gg;>sKrML*2gl!; zl-tS>W&o8rUxayrb4;(4TjxY;Xb&dD?x^eKHyRpKF+e~X{$bN4l>$rV1nS0)0?CY5)u({*sf_dr+_YuQ?v++)KyGf zsyOR==^?j`DdNVV3I$5)Z-CVft==QU!;67)UC&)sEwy33cQ46y{V%3jy-1ieOLcWM zy>j8o%2*ZJFM|>rP?uJViHL;V*kQey9mIJFJbTvlSJ_9~LY?^bot3J~mx)<4K|;c- z55UlcEfdbF=MVOCVBl2}k~!7X!Qd}nzQFJP{&8>1poKNot*uC1QbnEB(e~G;-jy3; zu#BM4$L`1Lf+pqrOC`h)v|05#pEk#x>TRsAmvZ$a_Njq#l!%}Q@jl5aA%G3Ce`UpV zB)`@?d0JwmVC}hD!T50xYh1TK`L@v6Gr;mmSb$x~p>>LO4ktZ*Q^De?l$=!gOu}o| z>dioAZMA+m^&&&LDDFuFHVzKX`SV3~oBAW=jvw&o`Q_@s&pXju3w zB{A_HNzbPP!@8jpK3%z44^T?1np~=?KLKuKCEqPG>-1PWHFiYcxum#E!VhhXscph$ zci3|O>Ig0;-*{QogNrOltk-Qc*1GW=S9C$J{b409JS>BKIuJ>nAALwkjSd6tmQD+m zeQA?)A5`JXO)!Z-p5(tKh~xu=m{3<|5GYUNkXy53U)X*P5Gq_r{!h`Vj)!Zn&En)< z)Flc&VNW9-OGSWq)Qb;(NM6ZQDs&!ru`>QEKEkbMO%%yZN6FZpe3X(CpOk1L^KpEH zaCdjPKJwa>^ZsZsufi~#n!56zfB1-5Q-ssGNO~@y@ABsfU`8Z7Fe#M8IXdx<;#E&Z zqSklhQ5iwZdlil3n&(npU)s?ft&5m{VjxF>-0mVgp<+6h1lE28-%V4UeY?$vDM%W+ z%bX8}h(=V^mp0a&k3Vxy#J_o%gnSl-jf|<4m8hGht<_}g76n(A$&2=D2$fJDkOwop zmN@a%*X*aa#tLd!Q`(e}Z}Kx^h9s+NR%ysm)@P#d#+B-tJd#k0GW9rl^0~wgvCsN3 zTdq!g1g-8d^5oAGI?&z&?~t`+o|`iH?YdVlCvx*10cI-sI8P-)Kh^X(o;^(0d!D&W zjNC26yqD3tAb^0%b!>C^^m1Wxp0zb*E)AIRGA>`5*JLHq-YC|1vCgJC2y6hC>1oW1 z*~aoF-P+Y{ifR|Dlxk!i9-s7M>uqwdwH z;sH0Glc%_ZFid1$?|E*(`bZ=sn(g(2HUq?;MXB6Dc1xqrWVPel0v9+d-?aFQSw^$F)Juj#PD7+UViZ==Bg~%54ho8#fz-Ym zj%P2N{`a2Pfx{3`%jKnFBo(zk346?T0r^?iccmDsDChzYveP+?Zn5~@J z+?_2qXa`;+6Wz#p4=1GDm_o|tt^ z*W1kK^X-_c?J9a%Fjp)M`umuRUmCs0n9C&r88PM;aYP1Uehx?23iC6oFnaAVm#!E3 zqnPV|KY$UaK#l(;(Z5WA`d=>kmlXfsHrm>{<>?oC%FtE-VEh$Jx>yl_j6Qt$kPY_j zdskP-0n%75uq~fRN%_&=@TrN7y^WZAYwPO_gx>TKVhKNg@?-wb+8V?{==XPb&tPHg zpWbN% zw{^trJOPXl<#L&s94Qxrp3wi#lF7AMd)@K|O2+s)U}1KfDd;tLXw=_{ObSAInmRg- zU|93VKk-3`$qn!xxJvZr&Yi2Rso6s>l@&OU;Mgi&x^ThU%WKWZ-eqn9kW)f$;oz#O zDnRb%f$oqS_OYHl<@-$WyAE9WUpa9)Qr0Y zbuj-ng@J=cV}1yD3sl*20{<{kGKMWo41$PD0N{Z)T)m zm5`9Qbn&80W}hbe7+|rL2wda#_vZ5P?Zhvlf}s)SX@VN{scT` zI}#zFS>D9%K^vc49dFN^XFOC4h)HnKIsnY9Cc~w@0`KwrQ~OtE>hr59a;JZXW-Fz` zj@pCB+MkXNMz!*rgoNF|YTv$ngP0iyr%Iz{P9OZV0T|=LaM?Z#+N=OD6S1dHnZm?c z3a0ivo>iAz=eSi9U%iQsN&$<`1&~iR@82(n#UG7y6F^CHK8u+zboM!YhJgAh0tj+g zc?m9l(iO9(LST+3Z*W#LC}faOMS{@!A8k*$XAiylF4)-h-@9#3+OJO^#ji+YL1A?yQzqms*Mj*>g zIy4+?<0ffCm++a4kJqT5)$;y%^7|^qx!{Nbegt9Y3JAzr&UahJ+XA|qS-v;tMK_vPcM0(E#{!JLLp0lZ*tRz4p%L2v z1n^Rw6wjVHV+n0W09#p;Ozqn1H^@BPo6o#dApZRMt2}*KQ`40+#T+@M#b0|QrlSFW{c&{9xnz_!dD1cZ)RqsHyy#|A!MGQOj=Mn)ZN z?cu_=8h|=oAfz`fdkwk;;FtUN?%@f9iX}`(+e@4Y?9xAk0*I3o4*?%F1XKwo`+NyV zMteO|dDP;DuQJ)GSi87stXKoK2qO>)YqeSc2-t7VeQ(ac8^!VV4e&ig3o_CSvlL{` zdBcXKrlLx5-hx7?(GY0@l&YSO?`UV@&45yRH^daqlXosZC3pL!PV~s;2i`cKD*CSh zzSDXQg#Mm436SzySZsB*kR=v?Et!A1B}GO3KESfF3{$3%k=4Lfxa-CNkPW>B#L+jo z8L=of()?=>YP99BXy^l%X18UkRRE@)!u?gi12zOYcOlzhvJT%ixh4>*yN;PU3SFCMI3p3WT8G~J46yk#&;pNv0gmYAXg5>GIK0d; zT7&=wL6amU2s6_<|EB$ZsH3n(Z3rx@ zMb6F5O-I)_CI^r!GOJg{MZ&?}n_aTmIXP33w&X&fC~juB&NaEO&WMTut&W2MuQM%s z`5xa+PIRJu(a2L|CTu;F%jux7^kP?r%04tFp|@pmcXtOcaWVS~Ao z9V;s7yv#H)US0IXr?M*Y7C*w=}S9;@NHq07hsi?7l1-QP`#|b*WyXNJbit)*EKr1 z56H@WL?qul!_Kl^R#m*$Bj$)jVUfCavaIPW8qcDXfOj5-iCwb(1B(l?fYqQoEh(w) zw;iKuX_DQ>7BF6J*T+k@XfNm&64@)0Nd*;}z3VV~WafzFqVGM46{`mEvk*xKbP~>y zwXCp7DpW#6FJ}vp9N^HG`3_$2@Qu4QYY!A#rqXlYl#rS0Ob(z=YWdLs*&~c@p^$np zR^@KQ_6l0|KuU!LsBMVzLQ+P9Q!|9#8U*a@imSF7rS6P4iTT;FQk#BTuAXh<`n9Kb;L|-L?SV?(4X^rFW$!LoupEm?3TdiLroZaN8 zOJ0pZ;m0U2l4+Le!#mQz7m*wDvXZ8t4TrRIuGt5HRJ$U7-*oSjNQN)!MU>yr84FM# zDlM5>EMcThJFlDbEp;L41rM67+J1pp(`KMJ#02zGyE4_(2xX=fzk`;6u!0&|fgKFI zd-o3P6;=|T-`#;9&>MEy`Pe?|Fp}e~0AXiq8>p#U9H#u(S@3-TMBmJ(#uVunxJ(Y% zY%nE&KzzHqrbR9UfUeJz2>@eXzI?d_F+fN~fKVoc=s^2IVhY#7RY@iRcUqH2c0`TU z6c$NMp$!cU{-=LHh`n<0bLl0pBO3+aB~fXFczCxjuthL%a}PM#IA-`JJyS0FIm?FV zDogO^+bB}IQvTk7Oqg0QmGk=YzX34Ix6vjD=0=7|Tr{1h2lQAlZ;Rez*3VM{!^%sG zm(*e97mN)S#bJ5441jV-0U_oz)2!dVa^r>p6A=_Y1t|~K$Rx)%G@`8e*oPvG6n_ua z-}|t{4inQ4hyY|%sL9y!`iflEm;?Ep{Us>K5}l_60X*>*2nHM-?1KJ% zXxM8CX(k}R?-#v#k6-*Ud7^!No?;bSs$suR*YH{|VZ^4GJA=dvk*ZPuO#=-IO z_MV5d7U=yEh4n#j?*24r^vE;-ZIc=x>{=ix0WvCRZ2XKw0Y*kW02xJUG+eq1DF^}{ zkOlFOBJAt{p$1DBgczLzty95ZX?(w~rne=DR(5^InfD;g46dNQN|Mn!y=?=(zjuH(6x5vbc}>A*A!?udLwa-|7H#(d^R4? zJEsqFNcJErOQbA3CZ+;oy3|xxLw-lRGW*V4cRJmL{q5y~KEv-(G1(vdNeI-&_dIB; zeqV?*p75KeK*{Jdah{s_46+XFMy=hi?xeIv2`rf=^9;7Ow%IRIcVQ$)TW<} zkgz#(LTB02oW4@^U;o%rceb`>f|5bElG!GFz`_FRIKarjHmrd;u6!(#OY|Q9T6%VEd~lD*IR3Tf-=QxBo1j+vdGcY~=_rWjr0T@ro)z>a zWEgfnK1Amg32AHpMRE&nklKu%BBloeKZ5CXB}j{|=U^7WudR>PKj8^z-SYC$YTd+_ zb)CP?F@&)eZyjV#zwy^n~6x?rV35q`s!` zKhn2#q$HL4s_aX%kFUK{wyo;^fE|pcN09!PeE@z|iBl`O(lfAm&=gqriP3g*WA0?p zz$j3LdbwyiT3*$53QVQTJR2`sqj{#dzBgZ4!0Hj1Q7*b~TI_S8Vj@u+T42Uxw-s9& z^d-wh7?nLej0QVAC7{cYE#mhZKdmml9v=PJR&=zw686euhY>`U@Ak-F@V&`-=K{#I zfDd5u{0<0?^=cP=q>m>JaVRRPC&Au6Nw4l>QP4_U^APdL^sT0#{XEaC<$Rn4)Bm2{ z4FN{QLaRk3E35o@hS|ZQb?`Q17$6V|g0lk>Sk2AME}pH*Y2}TGj7>!+X%%;d>E{V`DP zpb3Z}&PpMv^q%$!EP%LJas=bl9wWj@i8$5qH3%owZif0x-hA%o=l4Bbn=PVCsIcWU zqWGMScBg?u#2g$-V`5_3bq%{xy1+p#hphvO^*lM4x{O5$Ucb!7_ON;Adj4Z;eAd*~ zj)v%R@WjN#!-4J+0YO2nF;F=YT>mtFmH2??A3 zHkRM2$Ok;s9s71ewgRI8IqbLKV#LMW>GFrIX+L~LhIr2tj75F0WuY-A*f(}-_0&;4 zaa<`PA|m#Glwfmz)vu1rr9HkxNAkQ@w^PsHovqJ-F71R305#4*R7X~ zAlD_t?@R}=o=>?5bfsqgp1@V=bXXkl+Tj5tZkd^R8I6c7qy7X@g&x?qM^nvZ$IzxL&; zCORo+C}dTR;Q(ZW`(-X@QV47btugSdz|9QOqOQ0OW+meVaI&D}J%Iog78d08w5|uo zHnhn;D!wHR>^kRH0M<%S{xRf3SD?4|JV-ss@MlbMcVv8Q00Lsi^G(8@@=1mcS@o3_ z$A`;*x}{uGbB%}kH`|rKpejX!G)+x^mbCv)O*tMPZf7emXx{^f;gqrR=mxRxd$hjR z0CiS|PK9f34gyHSXrC0k$zl|?kx)coU1eS*A zoDI4i1-{L#Cir;y6G$cMEuI zRz|_p&_eq_+dq=AC`vOLfa?c}-`TkJ6yZx-559G$|CW%D@@{Amw)`SMH(#c}S}qz6 z{q~JgaR(ASo_&@!$y0)|>F~GKjY+(99GH;RlFENhsL)|In|=qN*E47Iau#7@LY6CB zkWJTT)-@AZuSxPi`xAX@DDy;!nv+z;3&_5^&Zv3-7;FO{q{!2l$kK8TBqSs>w9A86 zI6H|LC9ZDh_5WO$65V~ujd8r)mdWmlG$hBAEL580^ihe0svmQJz}?-Qj)BVfl*eMv zoiNs604xEG zn^xs~06S9#VB~}{$yMm7!xxB`U*Jt zm5fXvG@}|cZv`K?1bj*`q##EY5|7OC!0`b5qg;78m-U1em{qqfx-Jc{)-)gkkS7Ug z^N>6YHZyDvGE&lVlM&u7Epo{11vKP-ktFr%%=Gj&WZ9OjR9+D90Ov0aT7p3q5UA#J zmq}$7H`do99_W0odR2fB#qn*Y&LbSOC#KSF{!g3tr%x9Zb^CLZg9qgBTz@fXH3T9^ z2$)#XFJGcFtDO`-!!eW5pYK%DvcUG;at_|L&yr1*OF^GJX={7I$aXd;>e57eKqweh z=zbLu4-Ke}OF?6RnwFN9?urTlOs^%Bxk{78_B)!tQ@ws;^w98>su=Obk1$WL@8yQ( z2LXBlFg9Vy4dn1Rtfc9LgF#0^Gl=p#BCc6V>5zdAsV%9+1pNTDgD2cpFVqdQvMqA_ zcd6$*qX}G8HMO+r1t66;Z!mwH$fpL50NB)hAqUd*6`4;1f&v+WJ>NtFz(0g7lzANe zAfg$pwLNHJ`2i2oTN%y&RJOIXf!7>`&X#H~u{K#o&yp8COEAs44|dltlktM^+yg)s z@^Ptd-;M>jga%i;QbVjK{M6m7Wy@?j*Y=)1sw^4&Oap*Jh4V3}Q1s~(Gz1H;goGeS zCWjs?;Ddr793m~_;pIJo2+I!man6wM4crfI8u(It_wQ#wf?38Rsg_Orpg`*XQd=J{ z-c7{xE=6PPNgNmF|10wOzu`Vi*a80jzZZD`y?{bNd5E0Fk&0swR<|DN%ebD!egFPF zoF*!{E@rY9$Nir;nBfjixFJP#;vhN0QY=;J)m$B*9)$j&daasU`S9pmiO z%Cik=fNYeM-yp64Mi2VXk9>x5SWwXSw;Cx$8ygmupMA*qh66Nye2M!v7XXe~X>|Qn z&g(;?FwRRw)5hQo!r>*z)B;QTJOP#AP%(673@+LQvtOqvv>h@w!RHVX61qsj3igdK z*dykdcOh9Wwa@SfcuhqSAbv1ZwZWr>6JOxk>$m+s?R|MXmFeGqGkvE`wiG3lB$YK= zgp?LjMB+HeGK6xIhG>(_IuyW_w{={e?Nae z{WUYDe6F~6Dl?svjoPZve;=e=YZZv)+s4kEN*J!Pcz63RX)TyNxXj)_ zbkmguhWTv^P(=jR?~51F8Z?6V^XzJ%e1+U{_*JZ;)5owgY(nxf$55%2vO=tg!&uc3S?14ET?5IV!C)2eX~fyrrR|791YtGNZ2BNQ@PWvbJM5tY zK>MG{r}pzKgXtJ}IuGlcM}yQ%=(GzC&)MHE*W*g%BjLm@<~}#FsEkZw%V_Gn$D^pv zbv9@9^kf}-KUmDLDqa01{VJE_eygg-pp{$~fyE-&<~R6Q?p_^S3h zgD@!0j!u#{UbaWkp~J4PucxwOH)(5YlO+vP3G*H>lL|8Kt<;#VBNVxmw|JelsP`wL zqN33CrbHNzydzMkSFfaU!Y2E@J$d^;MFG>ubSE_F!)Lmv)#7Oa{wvjF^^c|QDl{X% zk@CTmKP%S{VaD0b4Zk%YZzFp9`Ud!K0fgY$ygBrBJAO&(7(YyO$E&&ZkF|@4{Bq(| zo@&xfxevOjs`3e-o0*xJh|AE4=HGbEX9qt+mU0trF~)gJ7whQR=~C;zgDyWb4AN!K zn}B=w92IVotgWptU3y`B5qWu95*K;-`uSBy+?fBK{HP;EU^k(`%@RhDq_gEzZ3q{o z={a!N?EZQ}!P%~DWMuR>C!+uVzdF*0-Hk2Rl~&#SS4MWT&N$cMXcy<+$u_5{D>k^= zRlbJ)T2@Qz+mLK)p<5QEk|=AXTUJmnGUma8OuAp+8GYE(NT46cW&6lUR`+l5e#UK` z_}11#DNjE40%{ktjYeKkOXJ$H!@gt@l~Y7Dw(%E-QiLv$^Le#%lS3LEB{*3J?PJ_a zz~N+m*{ujwxLuysl`B`w&Erd*n>qy>lg^0Rs%p&+SGb-__aiaSZYg+bR@Tk7Dvo+! z1483$1#-EiAlM@PRHIt*jjujDmKaslheCHthxDbtMUrpTSYJnwvjS=A2FA(Ct^s)w zRB7b|nqp?z$G6>xixMoTxj5B;fNL+$fxxoH^>jVW1;ksRXlVuV^3kvr6H~)OLwB>- z*x2aPN#f+XS?w6*wy(a+%gbmbL#*UX^$$SUKirm>*vvt@}*tKYD0;Ln`q}iY68O+LRt2@!|poFAz*I%E$dch%T+%?Zg2&u-`R%w z0L5%t7674z0f0Uc)#=80C_+KDcHw*gMq%Ys_(4xEhQ{|~#$X~C=-FO>+#8zdhG5Mk z+*DYcLtf*4>^ou(d%A-t0YrvBXoCo@Li&w6v9ukVxVWOzzn?c%W$koA5OMyS5&7K; z7=pfqMQ@?oBq8E&;2r;1KJ#(AeMQ|EiW#-L_!Qh0*yY?}f-VaL=HHr{sA~q1L83f=#xnv)e1HCw2Vh?1wulIyUNRa*(YS^QZ%}Kl_mH&w*)+i;HV*ZN=Y( zy@4#uQ$6J}V&mZb$0|mk{h=#36K}1nYispOs+Nbmmdi_v_!X(gS=XAK!xD}pTjv~v zUr@T^2aG=z&dq5imrFc=6jA2@Q-C5edf5OhJ4FsU?tuh1M3tJF8gavMR2ZWo6XHo; zE6WpmXvcu&#~P-!jhsK06~KU;n_PBJ6ejvr&UX` zLEgy}Mp>iJ0>Q#dqi_8;>A{(rdvq(wq*!0D%QOf59+5;=W`et4=nP9abN^UHu1>l< z={hxWFS$Qu#-O48xjI0*Gj~&qnG@TF>_z$yu-vSTTH&hL{f+GKF9;$H^5pb71fA*}Oj?_$aLKIV1*I6)y zYc_6;TeHm!ssRfNiws9CSP`L)e->kzjueQW`)=I!%w+*35_B}#nX2yJ%NpNuQTD7R z`=&ekkPjE*HN63!A|s=_j&sKjFF?lf_T9!shwy*HUA?8FADM|?+VZY)#DkL;01^7K z@90Kb5K_6D9EnT;GdweF=Ec!O_|?P33K0n?=FljhtMTE0ltt^z8RyJA9IWUldIMpX zWWh1fWnnyMMCKj-60v#PwtXzz{)yP0{Tm1o5;`AK&neP^Usbg3MJkRB;}L>BIPhk~ ztwV?AW3G=8UHa&bfb^YP+%2olr>`MhpCIXWS0LzZ#ZUk+CA9F3V0nK*^`jo-5_!de zaL0njc0y3*cm_AjG2e|kb1gtAR3<8fU=qB9gmLnuZ>1$F!Ip=D$C_$kS+zDRC{h=2 zJFZnKu~G<2I-dKm!Qo5)OmbLDTP;(0Ml?pr)eYA>k!NwB1z= z2>``)9w!zh5A9+ROhMYJO9{NHD2#H35CvOX4V*Qn$GR@Bc+cW73B7}vZ9~Gn(jf^^ zjk@(uBeYg)w+6k-w5;4zckSEP@??Pn;d`{ATp@#*8b-K;%0$=GHNDyGHE>O)H$HA92Q7rl%XhsVQ$XQs*Q(?q zIrPtCO~qZ->gH1i?&lws!T)LN1tFb2(+OEK5f7njO~LbkBSQD>uF5hb2qAInn@ud#MQ$n@K|%|g{H z7k=fq^BIQ~|L5|mXloThC|33wdM?)O@_M45o*qoMyq#luk=z`M87^!V`)69d)1X{)l6+7tIdZz70>8rx+R2xVDTK0>ArHBLqu zOJIhL$#p2NMAh?O8KqKQE_$sj^iX(Bub+JW6YXEb0POt?{pMeVhlak|d=XrrRr{;( zjIWWr;elcbEvj+l0A8g|5VO7Rf#+zuoZ(*EyI~h&+=!k6>2P}H4;4Mfu;S_V%b8MO z*exUx`Ly}}2rJ$D5ox2h!zl+o`aq>I1&`TR9J_Y!#L ziQcAK4G=KH;Gpo-Sl9XPXfZLdPLO{sJ-3%0a!vz!-#6Yix3DmS;Fn!<5E4M_a&+01 zU&WU3a)BMP2%^TJtqI*r1D;F$#024meD6NZ=1~{Y`1aVEJ4eG*da`&_iy>2Mus%l; zTIi^2csb^fYFadp^dS1!FXYbfOM{HwjB){|sin}w+xu03E#Z6b^S&Dx80haWns@t& zPj496G-JoRQ$NSbDRtx_%F&}oA$PPg6MbHv3+{C;AilN4YN+W68+-J291N?Y-E&<) z;vmV;Bd-E-h0KBJFx6{fK_Jw8{<5X`khE3vc}EgU(0>>HTTe+zX?hMOK~%g)*T|n1 z$19dKd%ylt6rLKCv7||U|L)a#pf?O1R1WB$B7*xS$A>ehv2UgW;~!r}N3ycKfMAS1 z@CH!%^pa&GRx1hbNRXEh%rK6eQoGw#aIN~b`?m(c=k<|MQH#h`EP`mJKhtzY#$R`S ztK?@xGRm4Ti#ye0{Swau`vV`m@7p@CQ4hXcmJSbPom7*9UfT91W6ifFNa6t3|X zX+GU+NrM}F`w2fKe9a(m$>!!?(H;|kFgjifQP-IZ&VN@s$w^A4<1AvkaH#?FfPd3v zw0+BYk)1n_a5vEgEbYtWe?DC5>TfZ5aeX?zOV&gWz70727n>vXWXKrp)oir1O6g0XXLKIr%>vCNsWut{f$ZQjoLUbNpq zSeWQAx%s+NL<3ISpg}c9=L=M8xM^R@%y`riKNruAFF7SGx+9!a?c5u@u6yxhTC;+M zj=M1%gr@GPajrbi!1@~;>Z1*b{#WiWC?*+T=eCG?b3h0aq&!gpWhpp+J~pl1_330I zJ-uJe=j|&eWa^Y<9D9%Z(P<*V0B)zSPl{XV-Ae}1^lwg6ATa>Vs|WINs$sYQ8g`{Z z_Ox^Qwd$b=#>1a!@!ratxw(_7FeT+58+w;xIe(@DC`k}Nup|l|M?VA%oIC~q(s-+4}=R(o~b)My8pyC1TkAHC&6AJ5Q{KE?oPK&M{j8v(Q9FuFE0 zAe#gPmdkj|La)7fZ?oC8r~w26EqH$5%z3}2d9=I5Xi+McTz_70j&7-A0INoMtl4eN z%EHo7;^k#C^Nu9XL^{`Uxzy8YYIosE2CijTi_*ylve<^hy&yJ4 z!iWVjO>d#U9-1ScDf2W@(6KJzn91J^_0==9Bk&&s;EIBv6}f3thATcke!oV4{%Lpg zLt*QFchfx>9MN=_QwYR$iYxj~thod9`Ar5fI_ zy3!U-PQezv3$I%zd&`IEPR@`;pz;ne+d1Jo3n`RddsU{;Z4P20ffl6@<&IcnjrBp_ zD#wZ&#?nJw$xSux3mrf0elUXfk&C)h^S7pZFkBB(O>{U*wo0 z3>j?&GFWt1NY?Er`>G2%{^z2_LcDzfxDlFKe|C}f9xgpDqt`Z#C%Kz`uq5i-QIC*M zO$<@L%HS#Yp3fb z2Zl_6jM*2Gu1{x}lQ(@wR?d7F8rpx7&UdcI`Pob35meGvM}@;*+jSYWr* z*Hr>o7+Ukp#rG_dxw&DyX~}rO6sK4(4`GOfua34mV^#6qb?Z`BAS0&u+`oHUT2wsX z{s7)jsG@NPj*2A#q(hCme>#OnRe!XO0V90hJ&~A)0}!wQ>~}^&uRVBR>&D@m3Uh@w z7JsT6ZdGvj$L&1n3BsIQrmnlYyA9pS%F3kJ!!Vp*>(B8GX8hX@4o~Sb*hrtr0UcOM zw8&YS%EwQfSi*_GPS1*sG10jv(Nb{0(ff}tE0@Q|)cRiVN(I&xRC@y;7mm-~D$xt3pUP@HN@myxufK4>riJ!xnnbLCuzLwH9T z)0gHGzAN}{)GR7A^u{AB?5wO^#h&N2#__ICY_VcWSKN<@5l|#_^(ldB+wrSexqpGw zqsL#Ny3QY77|CjGZU#7r($$a~)#@b*$aK>lP~$_G}P{A3N82Ph-yZ#qe=QqipSWhb_BRy5d0n!ECx)R*YQR=RNEg1iqSYwk&sNug_f;U#o;)EkC| zZN&cY=)$3*X}^+}lS>pQMOy(UyLWt-EzNwZw#rm!$~=<0oTLgYCs8Ya*(@n}!^s^0 ztgR+dj;uA@sjBMb=%`ccffzIJ2?R1Gpc&fX2pjSjVTzt6tAjay?D@D41<4#l2hw4M zPD6o*UgHJQ^eBnWzn7k{0@x{YtlP-O)*i|yAfR9LkFccjnkwxc{0pYoz6l zgv~)F$k1d=8Is8t-6YP@Lg%UDFyl0NNM5_eJS`3!mv*0!GA+D+G^gSVK7Qb@OlKp{ z0{t4!dbHsB*<-!E&v-=#LB<-G#yx+2Oadf`-(-!vynIy-F8oQ79<(#8)|dfLOSWCW zFruiIw0?l%w3Z8u>B7aP++wF1dja$V38~H_tq1bHAs`LT%`6#i-@5hTU-< zX@P-klZ%7`jTl-JF1lyaz2RXBV-VW6#L=XhvHpI%BLO~d!WEmBa7ZY@*Vh+KFHyX# zeBADP0Gb_y8M&&5NjCMDWNn281xg=1+T;{uzCR4jX9I?A^f#Q{dlk${HUr_2t{-%K z7ifJ-{jXoyeCEeg1ev>{W>I(}Yzz5^g@?m|QQBDupi^2>(%vnoa&fVc_w%038{iS) z^)*|K2G4s>NB$5^7DXZMKk|Z1GSW$IHM@F7)s|3yglm_r{jahNd zce<^OO>jWQh;mhxl|zqF)Ze=|;e`z{&97c<^62;Bz*z+WL$<;YhwvE#H)YSX()E*T zKVkga40`uSvY~;&C0kokjl8;*>DZqwVMY{t`v@N4{iqYJhzizQ<`}QYEQ!_Jkl{33Hr6iLYv(a%W^(2Kjs6}?W*UOFq&pNQy zR-@#<>rfC!~)XcwsU7*$~uvdAuiER*b#P*9-sSTp5> zulYt+R+_!;DOjOw&cAMpHs&{9^>+1b;(GC&hIm$j!p!E1^Y2;hU_T1uJEvw+7AF=x`y~H%(yL_&) z*=CDjzP{~;KF1vQogAO}|Gr+fJM1)Vrc(CIc@QA7ys31$4EwR{La*kSQiu0a8>eFK zXCplth)v_f(iQP0va+&7Q&irlf4p9lMt6CS_rO#lds0kWrvBdD(AlYsNh>^aJG8d? z#&@eeJd=`|YJ26%OBzkbkK8hKNp^oSJ9rn5YgA`cob2oVO&{C0Zx@x6Y`Nm27LVn9 zs;*yNUhePjFOzC&XlSF@?H{VShnVN3DOy`oLlaEx^1*x{;2PPr>#}NVYqN)P6A>XW zrBL(oUw7W28@zaEPj~5h!Q;vT}PU?#ulcp<-xLQ;1SL9G_=& zBK$_Cv`$2ZQ+2_6KtZ4C`jWphndfcje7^WK;)NTHkOM0OpWq9ihUu z?{6?^nVg)Yp@`BQwr_ lCx;OK_J9BUzg&|g7OxAGvbKS#6T}CcI-zwuP3@oC{|}!<`S$<- literal 0 HcmV?d00001 diff --git a/man/gini.Rd b/man/gini.Rd index d9b1976..0a83558 100644 --- a/man/gini.Rd +++ b/man/gini.Rd @@ -7,7 +7,7 @@ gini(geo = "tract", year = 2020, quiet = FALSE, ...) } \arguments{ -\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}.} +\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -33,18 +33,18 @@ The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -According to the U.S. Census Bureau \url{https://www.census.gov/topics/income-poverty/income-inequality/about/metrics/gini-index.html}: "The Gini Index is a summary measure of income inequality. The Gini coefficient incorporates the detailed shares data into a single statistic, which summarizes the dispersion of income across the entire income distribution. The Gini coefficient ranges from 0, indicating perfect equality (where everyone receives an equal share), to 1, perfect inequality (where only one recipient or group of recipients receives all the income). The Gini is based on the difference between the Lorenz curve (the observed cumulative income distribution) and the notion of a perfectly equal income distribution." +According to the U.S. Census Bureau \url{https://www.census.gov/topics/income-poverty/income-inequality/about/metrics/gini-index.html}: 'The Gini Index is a summary measure of income inequality. The Gini coefficient incorporates the detailed shares data into a single statistic, which summarizes the dispersion of income across the entire income distribution. The Gini coefficient ranges from 0, indicating perfect equality (where everyone receives an equal share), to 1, perfect inequality (where only one recipient or group of recipients receives all the income). The Gini is based on the difference between the Lorenz curve (the observed cumulative income distribution) and the notion of a perfectly equal income distribution.' } \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Tract-level metric (2020) - gini(geo = "tract", state = "GA", year = 2020) - + gini(geo = 'tract', state = 'GA', year = 2020) + # County-level metric (2020) - gini(geo = "county", state = "GA", year = 2020) - + gini(geo = 'county', state = 'GA', year = 2020) + } } diff --git a/man/hoover.Rd b/man/hoover.Rd new file mode 100644 index 0000000..ec9edca --- /dev/null +++ b/man/hoover.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/hoover.R +\name{hoover} +\alias{hoover} +\title{Delta based on Hoover (1941) and Duncan et al. (1961)} +\usage{ +hoover( + geo_large = "county", + geo_small = "tract", + year = 2020, + subgroup, + omit_NAs = TRUE, + quiet = FALSE, + ... +) +} +\arguments{ +\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}.} + +\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}.} + +\item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} + +\item{subgroup}{Character string specifying the racial/ethnic subgroup(s). See Details for available choices.} + +\item{omit_NAs}{Logical. If FALSE, will compute index for a larger geographical unit only if all of its smaller geographical units have values. The default is TRUE.} + +\item{quiet}{Logical. If TRUE, will display messages about potential missing census information. The default is FALSE.} + +\item{...}{Arguments passed to \code{\link[tidycensus]{get_acs}} to select state, county, and other arguments for census characteristics} +} +\value{ +An object of class 'list'. This is a named list with the following components: + +\describe{ +\item{\code{del}}{An object of class 'tbl' for the GEOID, name, and DEL at specified larger census geographies.} +\item{\code{del_data}}{An object of class 'tbl' for the raw census values at specified smaller census geographies.} +\item{\code{missing}}{An object of class 'tbl' of the count and proportion of missingness for each census variable used to compute DEL.} +} +} +\description{ +Compute the aspatial Delta (Hoover) of a selected racial/ethnic subgroup(s) and U.S. geographies. +} +\details{ +This function will compute the aspatial Delta (DEL) of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Hoover (1941) \doi{10.1017/S0022050700052980} and Duncan, Cuzzort, and Duncan (1961; LC:60007089). This function provides the computation of DEL for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). + +The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: +\itemize{ +\item \strong{B03002_002}: not Hispanic or Latino \code{'NHoL'} +\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{'NHoLW'} +\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{'NHoLA'} +\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +\item \strong{B03002_012}: Hispanic or Latino \code{'HoL'} +\item \strong{B03002_013}: Hispanic or Latino, white alone \code{'HoLW'} +\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{'HoLB'} +\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{'HoLA'} +\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} +} + +Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. + +DEL is a measure of the proportion of members of one subgroup(s) residing in geographic units with above average density of members of the subgroup(s). The index provides the proportion of a subgroup population that would have to move across geographic units to achieve a uniform density. DEL can range in value from 0 to 1. + +Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the DEL value returned is NA. +} +\examples{ +\dontrun{ +# Wrapped in \dontrun{} because these examples require a Census API key. + + # Delta (a measure of concentration) of non-Hispanic Black vs. non-Hispanic white populations + ## of census tracts within Georgia, U.S.A., counties (2020) + hoover( + geo_large = 'county', + geo_small = 'tract', + state = 'GA', + year = 2020, + subgroup = 'NHoLB' + ) + +} + +} +\seealso{ +\code{\link[tidycensus]{get_acs}} for additional arguments for geographic extent selection (i.e., \code{state} and \code{county}). +} diff --git a/man/krieger.Rd b/man/krieger.Rd index 2a09ec4..de13069 100644 --- a/man/krieger.Rd +++ b/man/krieger.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/krieger.R \name{krieger} \alias{krieger} -\title{Index of Concentration at the Extremes based on Feldman \emph{et al.} (2015) and Krieger \emph{et al.} (2016)} +\title{Index of Concentration at the Extremes based on Feldman et al. (2015) and Krieger et al. (2016)} \usage{ krieger(geo = "tract", year = 2020, quiet = FALSE, ...) } \arguments{ -\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}.} +\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -27,7 +27,7 @@ An object of class 'list'. This is a named list with the following components: Compute the aspatial Index of Concentration at the Extremes (Krieger). } \details{ -This function will compute three aspatial Index of Concentration at the Extremes (ICE) of U.S. census tracts or counties for a specified geographical extent (e.g., entire U.S. or a single state) based on Feldman \emph{et al.} (2015) \doi{10.1136/jech-2015-205728} and Krieger \emph{et al.} (2016) \doi{10.2105/AJPH.2015.302955}. The authors expanded the metric designed by Massey in a chapter of Booth & Crouter (2001) \doi{10.4324/9781410600141} who initially designed the metric for residential segregation. This function computes five ICE metrics: +This function will compute three aspatial Index of Concentration at the Extremes (ICE) of U.S. census tracts or counties for a specified geographical extent (e.g., entire U.S. or a single state) based on Feldman et al. (2015) \doi{10.1136/jech-2015-205728} and Krieger et al. (2016) \doi{10.2105/AJPH.2015.302955}. The authors expanded the metric designed by Massey in a chapter of Booth & Crouter (2001) \doi{10.4324/9781410600141} who initially designed the metric for residential segregation. This function computes five ICE metrics: \itemize{ \item \strong{Income}: 80th income percentile vs. 20th income percentile @@ -53,13 +53,13 @@ ICE metrics can range in value from -1 (most deprived) to 1 (most privileged). A \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Tract-level metric (2020) - krieger(geo = "tract", state = "GA", year = 2020) - + krieger(geo = 'tract', state = 'GA', year = 2020) + # County-level metric (2020) - krieger(geo = "county", state = "GA", year = 2020) - + krieger(geo = 'county', state = 'GA', year = 2020) + } } diff --git a/man/messer.Rd b/man/messer.Rd index b9c4f5e..5294391 100644 --- a/man/messer.Rd +++ b/man/messer.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/messer.R \name{messer} \alias{messer} -\title{Neighborhood Deprivation Index based on Messer \emph{et al.} (2006)} +\title{Neighborhood Deprivation Index based on Messer et al. (2006)} \usage{ messer( geo = "tract", @@ -15,7 +15,7 @@ messer( ) } \arguments{ -\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}.} +\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2010 onward are currently available.} @@ -42,7 +42,7 @@ An object of class 'list'. This is a named list with the following components: Compute the aspatial Neighborhood Deprivation Index (Messer). } \details{ -This function will compute the aspatial Neighborhood Deprivation Index (NDI) of U.S. census tracts or counties for a specified geographical referent (e.g., US-standardized) based on Messer \emph{et al.} (2006) \doi{10.1007/s11524-006-9094-x}. +This function will compute the aspatial Neighborhood Deprivation Index (NDI) of U.S. census tracts or counties for a specified geographical referent (e.g., US-standardized) based on Messer et al. (2006) \doi{10.1007/s11524-006-9094-x}. The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for computation involving a principal component analysis with the \code{\link[psych]{principal}} function. The yearly estimates are available for 2010 and after when all census characteristics became available. The eight characteristics are: \itemize{ @@ -59,11 +59,11 @@ The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify the referent for standardizing the NDI (Messer) values. For example, if all U.S. states are specified for the \code{state} argument, then the output would be a U.S.-standardized index. -The continuous NDI (Messer) values are z-transformed, i.e., "standardized," and the categorical NDI (Messer) values are quartiles of the standardized continuous NDI (Messer) values. +The continuous NDI (Messer) values are z-transformed, i.e., 'standardized,' and the categorical NDI (Messer) values are quartiles of the standardized continuous NDI (Messer) values. Check if the proportion of variance explained by the first principal component is high (more than 0.5). -Users can bypass \code{\link[tidycensus]{get_acs}} by specifying a pre-formatted data frame or tibble using the \code{df} argument. This function will compute an index using the first component of a principal component analysis (PCA) with a Varimax rotation (the default for \code{\link[psych]{principal}}) and only one factor (note: PCA set-up not unspecified in Messer \emph{et al.} (2006)). The recommended structure of the data frame or tibble is an ID (e.g., GEOID) in the first feature (column), followed by the variables of interest (in any order) and no additional information (e.g., omit state or county names from the \code{df} argument input). +Users can bypass \code{\link[tidycensus]{get_acs}} by specifying a pre-formatted data frame or tibble using the \code{df} argument. This function will compute an index using the first component of a principal component analysis (PCA) with a Varimax rotation (the default for \code{\link[psych]{principal}}) and only one factor (note: PCA set-up not unspecified in Messer et al. (2006)). The recommended structure of the data frame or tibble is an ID (e.g., GEOID) in the first feature (column), followed by the variables of interest (in any order) and no additional information (e.g., omit state or county names from the \code{df} argument input). } \examples{ @@ -73,13 +73,13 @@ messer(df = DCtracts2020[ , c(1, 3:10)]) # Wrapped in \dontrun{} because these examples require a Census API key. # Tract-level metric (2020) - messer(geo = "tract", state = "GA", year = 2020) + messer(geo = 'tract', state = 'GA', year = 2020) # Impute NDI for tracts (2020) with missing census information (median values) - messer(state = "tract", "GA", year = 2020, imp = TRUE) + messer(state = 'tract', 'GA', year = 2020, imp = TRUE) # County-level metric (2020) - messer(geo = "county", state = "GA", year = 2020) + messer(geo = 'county', state = 'GA', year = 2020) } diff --git a/man/ndi-package.Rd b/man/ndi-package.Rd index f06f9ac..85de2d5 100644 --- a/man/ndi-package.Rd +++ b/man/ndi-package.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/package.R +% Please edit documentation in R/ndi-package.R \docType{package} \name{ndi-package} \alias{ndi-package} @@ -9,7 +9,7 @@ Computes various metrics of socio-economic deprivation and disparity in the United States based on information available from the U.S. Census Bureau. } \details{ -The 'ndi' package computes various metrics of socio-economic deprivation and disparity in the United States. Some metrics are considered "spatial" because they consider the values of neighboring (i.e., adjacent) census geographies in their computation, while other metrics are "aspatial" because they only consider the value within each census geography. Two types of aspatial neighborhood deprivation indices (NDI) are available: (1) based on Messer \emph{et al.} (2006) \doi{10.1007/s11524-006-9094-x} and (2) based on Andrews \emph{et al.} (2020) \doi{10.1080/17445647.2020.1750066} and Slotman \emph{et al.} (2022) \doi{10.1016/j.dib.2022.108002} who use variables chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x}. Both are a decomposition of multiple demographic characteristics from the U.S. Census Bureau American Community Survey 5-year estimates (ACS-5; 2006-2010 onward). Using data from the ACS-5 (2005-2009 onward), the package can also compute the (1) spatial Racial Isolation Index (RI) based on Anthopolos \emph{et al.} (2011) \doi{10.1016/j.sste.2011.06.002}, (2) spatial Educational Isolation Index (EI) based on Bravo \emph{et al.} (2021) \doi{10.3390/ijerph18179384}, (3) aspatial Index of Concentration at the Extremes (ICE) based on Feldman \emph{et al.} (2015) \doi{10.1136/jech-2015-205728} and Krieger \emph{et al.} (2016) \doi{10.2105/AJPH.2015.302955}, (4) aspatial racial/ethnic Dissimilarity Index based on Duncan & Duncan (1955) \doi{10.2307/2088328}, (5) aspatial income or racial/ethnic Atkinson Index based on Atkinson (1970) \doi{10.1016/0022-0531(70)90039-6}, (6) aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954) \doi{10.2307/2574118}, (7) aspatial racial/ethnic Correlation Ratio based on Bell (1954) \doi{10.2307/2574118} and White (1986) \doi{10.2307/3644339}, and (8) aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) \doi{10.2307/2084686} and Sudano \emph{et al.} (2013) \doi{10.1016/j.healthplace.2012.09.015}. Also using data from the ACS-5 (2005-2009 onward), the package can retrieve the aspatial Gini Index based on Gini (1921) \doi{10.2307/2223319}. +The 'ndi' package computes various metrics of socio-economic deprivation and disparity in the United States. Some metrics are considered "spatial" because they consider the values of neighboring (i.e., adjacent) census geographies in their computation, while other metrics are "aspatial" because they only consider the value within each census geography. Two types of aspatial neighborhood deprivation indices (NDI) are available: (1) based on Messer et al. (2006) \doi{10.1007/s11524-006-9094-x} and (2) based on Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} and Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002} who use variables chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x}. Both are a decomposition of multiple demographic characteristics from the U.S. Census Bureau American Community Survey 5-year estimates (ACS-5; 2006-2010 onward). Using data from the ACS-5 (2005-2009 onward), the package can also compute the (1) spatial Racial Isolation Index (RI) based on Anthopolos et al. (2011) \doi{10.1016/j.sste.2011.06.002}, (2) spatial Educational Isolation Index (EI) based on Bravo et al. (2021) \doi{10.3390/ijerph18179384}, (3) aspatial Index of Concentration at the Extremes (ICE) based on Feldman et al. (2015) \doi{10.1136/jech-2015-205728} and Krieger et al. (2016) \doi{10.2105/AJPH.2015.302955}, (4) aspatial racial/ethnic Dissimilarity Index based on Duncan & Duncan (1955) \doi{10.2307/2088328}, (5) aspatial income or racial/ethnic Atkinson Index based on Atkinson (1970) \doi{10.1016/0022-0531(70)90039-6}, (6) aspatial racial/ethnic Isolation Index (II) based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and Bell (1954) \doi{10.2307/2574118}, (7) aspatial racial/ethnic Correlation Ratio based on Bell (1954) \doi{10.2307/2574118} and White (1986) \doi{10.2307/3644339}, (8) aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) \doi{10.2307/2084686} and Sudano et al. (2013) \doi{10.1016/j.healthplace.2012.09.015}, (9) aspatial racial/ethnic Local Exposure and Isolation metric based on Bemanian & Beyer (2017) \url{doi:10.1158/1055-9965.EPI-16-0926}, and (10) aspatial racial/ethnic Delta based on Hoover (1941) \url{doi:10.1017/S0022050700052980} and Duncan et al. (1961; LC:60007089). Also using data from the ACS-5 (2005-2009 onward), the package can retrieve the aspatial Gini Index based on Gini (1921) \doi{10.2307/2223319}. Key content of the 'ndi' package include:\cr @@ -29,13 +29,15 @@ Key content of the 'ndi' package include:\cr \code{\link{gini}} Retrieves the aspatial Gini Index based on Gini (1921) \doi{10.2307/2223319}. -\code{\link{krieger}} Computes the aspatial Index of Concentration at the Extremes based on Feldman \emph{et al.} (2015) \doi{10.1136/jech-2015-205728} and Krieger \emph{et al.} (2016) \doi{10.2105/AJPH.2015.302955}. +\code{\link{hoover}} Computes the aspatial racial/ethnic Delta (DEL) based on Hoover (1941) \doi{doi:10.1017/S0022050700052980} and Duncan et al. (1961; LC:60007089). -\code{\link{messer}} Computes the aspatial Neighborhood Deprivation Index (NDI) based on Messer \emph{et al.} (2006) \doi{10.1007/s11524-006-9094-x}. +\code{\link{krieger}} Computes the aspatial Index of Concentration at the Extremes based on Feldman et al. (2015) \doi{10.1136/jech-2015-205728} and Krieger et al. (2016) \doi{10.2105/AJPH.2015.302955}. -\code{\link{powell_wiley}} Computes the aspatial Neighborhood Deprivation Index (NDI) based on Andrews \emph{et al.} (2020) \doi{10.1080/17445647.2020.1750066} and Slotman \emph{et al.} (2022) \doi{10.1016/j.dib.2022.108002} who use variables chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x}. +\code{\link{messer}} Computes the aspatial Neighborhood Deprivation Index (NDI) based on Messer et al. (2006) \doi{10.1007/s11524-006-9094-x}. -\code{\link{sudano}} Computes the aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) \doi{10.2307/2084686} and Sudano \emph{et al.} (2013) \doi{10.1016/j.healthplace.2012.09.015}. +\code{\link{powell_wiley}} Computes the aspatial Neighborhood Deprivation Index (NDI) based on Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} and Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002} who use variables chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x}. + +\code{\link{sudano}} Computes the aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) \doi{10.2307/2084686} and Sudano et al. (2013) \doi{10.1016/j.healthplace.2012.09.015}. \code{\link{white}} Computes the aspatial racial/ethnic Correlation Ratio (V) based on Bell (1954) \doi{10.2307/2574118} and White (1986) \doi{10.2307/3644339}. @@ -44,12 +46,20 @@ Key content of the 'ndi' package include:\cr \code{\link{DCtracts2020}} A sample dataset containing information about U.S. Census American Community Survey 5-year estimate data for the District of Columbia census tracts (2020). The data are obtained from the \code{\link[tidycensus]{get_acs}} function and formatted for the \code{\link{messer}} and \code{\link{powell_wiley}} functions input. } \section{Dependencies}{ - The 'ndi' package relies heavily upon \code{\link{tidycensus}} to retrieve data from the U.S. Census Bureau American Community Survey five-year estimates and the \code{\link{psych}} for computing the neighborhood deprivation indices. The \code{\link{messer}} function builds upon code developed by Hruska \emph{et al.} (2022) \doi{10.17605/OSF.IO/M2SAV} by fictionalizing, adding the percent of households earning <$30,000 per year to the NDI computation, and providing the option for computing the ACS-5 2006-2010 NDI values. There is no code companion to compute NDI included in Andrews \emph{et al.} (2020) \doi{10.1080/17445647.2020.1750066} or Slotman \emph{et al.} (2022) \doi{10.1016/j.dib.2022.108002}, but the package author worked directly with the Slotman \emph{et al.} (2022) \doi{10.1016/j.dib.2022.108002} authors to replicate their SAS code in R. The spatial metrics RI and EI rely on the \code{\link{sf}} and \code{\link{Matrix}} packages to compute the geospatial adjacency matrix between census geographies. Internal function to calculate AI is based on \code{\link[DescTools]{Atkinson}} function. There is no code companion to compute RI, EI, DI, II, V, LQ, or LEx/Is included in Anthopolos \emph{et al.} (2011) \doi{10.1016/j.sste.2011.06.002}, Bravo \emph{et al.} (2021) \doi{10.3390/ijerph18179384}, Duncan & Duncan (1955) \doi{10.2307/2088328}, Bell (1954) \doi{10.2307/2574118}, White (1986) \doi{10.2307/3644339}, Sudano \emph{et al.} (2013) \doi{10.1016/j.healthplace.2012.09.015}, or Bemanian & Beyer (2017) \doi{10.1158/1055-9965.EPI-16-0926}, respectively. + The 'ndi' package relies heavily upon \code{\link{tidycensus}} to retrieve data from the U.S. Census Bureau American Community Survey five-year estimates and the \code{\link{psych}} for computing the neighborhood deprivation indices. The \code{\link{messer}} function builds upon code developed by Hruska et al. (2022) \doi{10.17605/OSF.IO/M2SAV} by fictionalizing, adding the percent of households earning <$30,000 per year to the NDI computation, and providing the option for computing the ACS-5 2006-2010 NDI values. There is no code companion to compute NDI included in Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} or Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002}, but the package author worked directly with the Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002} authors to replicate their SAS code in R. The spatial metrics RI and EI rely on the \code{\link{sf}} and \code{\link{Matrix}} packages to compute the geospatial adjacency matrix between census geographies. Internal function to calculate AI is based on \code{\link[DescTools]{Atkinson}} function. There is no code companion to compute RI, EI, DI, II, V, LQ, or LEx/Is included in Anthopolos et al. (2011) \doi{10.1016/j.sste.2011.06.002}, Bravo et al. (2021) \doi{10.3390/ijerph18179384}, Duncan & Duncan (1955) \doi{10.2307/2088328}, Bell (1954) \doi{10.2307/2574118}, White (1986) \doi{10.2307/3644339}, Sudano et al. (2013) \doi{10.1016/j.healthplace.2012.09.015}, or Bemanian & Beyer (2017) \doi{10.1158/1055-9965.EPI-16-0926}, respectively. +} + +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/idblr/ndi} + \item Report bugs at \url{https://github.com/idblr/ndi/issues} } +} \author{ -Ian D. Buller\cr \emph{Social & Scientific Systems, Inc., a division of DLH Corporation, Silver Spring, Maryland, USA (current); Occupational and Environmental Epidemiology Branch, Division of Cancer Epidemiology and Genetics, National Cancer Institute, National Institutes of Health, Rockville, Maryland, USA (original).} \cr +Ian D. Buller\cr \emph{Social & Scientific Systems, Inc., a DLH Corporation Holding Company, Bethesda, Maryland, USA (current); Occupational and Environmental Epidemiology Branch, Division of Cancer Epidemiology and Genetics, National Cancer Institute, National Institutes of Health, Rockville, Maryland, USA (original).} \cr Maintainer: I.D.B. \email{ian.buller@alumni.emory.edu} } -\keyword{package} +\keyword{internal} diff --git a/man/powell_wiley.Rd b/man/powell_wiley.Rd index 3ca5529..1fbc20c 100644 --- a/man/powell_wiley.Rd +++ b/man/powell_wiley.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/powell_wiley.R \name{powell_wiley} \alias{powell_wiley} -\title{Neighborhood Deprivation Index based on Andrews \emph{et al.} (2020) and Slotman \emph{et al.} (2022)} +\title{Neighborhood Deprivation Index based on Andrews et al. (2020) and Slotman et al. (2022)} \usage{ powell_wiley( geo = "tract", @@ -15,7 +15,7 @@ powell_wiley( ) } \arguments{ -\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = "tract"} (the default) or counties \code{geo = "county"}.} +\item{geo}{Character string specifying the geography of the data either census tracts \code{geo = 'tract'} (the default) or counties \code{geo = 'county'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2010 onward are currently available.} @@ -43,7 +43,7 @@ An object of class 'list'. This is a named list with the following components: Compute the aspatial Neighborhood Deprivation Index (Powell-Wiley). } \details{ -This function will compute the aspatial Neighborhood Deprivation Index (NDI) of U.S. census tracts or counties for a specified geographical referent (e.g., US-standardized) based on Andrews \emph{et al.} (2020) \doi{10.1080/17445647.2020.1750066} and Slotman \emph{et al.} (2022) \doi{10.1016/j.dib.2022.108002}. +This function will compute the aspatial Neighborhood Deprivation Index (NDI) of U.S. census tracts or counties for a specified geographical referent (e.g., US-standardized) based on Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} and Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002}. The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for computation involving a factor analysis with the \code{\link[psych]{principal}} function. The yearly estimates are available in 2010 and after when all census characteristics became available. The thirteen characteristics chosen by Roux and Mair (2010) \doi{10.1111/j.1749-6632.2009.05333.x} are: \itemize{ @@ -62,7 +62,7 @@ The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. \item \strong{PctUnempl (S2301)}: percent unemployed } -Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify the referent for standardizing the NDI (Powell-Wiley) values. For example, if all U.S. states are specified for the \code{state} argument, then the output would be a U.S.-standardized index. Please note: the NDI (Powell-Wiley) values will not exactly match (but will highly correlate with) those found in Andrews \emph{et al.} (2020) \doi{10.1080/17445647.2020.1750066} and Slotman \emph{et al.} (2022) \doi{10.1016/j.dib.2022.108002} because the two studies used a different statistical platform (i.e., SPSS and SAS, respectively) that intrinsically calculate the principal component analysis differently from R. +Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify the referent for standardizing the NDI (Powell-Wiley) values. For example, if all U.S. states are specified for the \code{state} argument, then the output would be a U.S.-standardized index. Please note: the NDI (Powell-Wiley) values will not exactly match (but will highly correlate with) those found in Andrews et al. (2020) \doi{10.1080/17445647.2020.1750066} and Slotman et al. (2022) \doi{10.1016/j.dib.2022.108002} because the two studies used a different statistical platform (i.e., SPSS and SAS, respectively) that intrinsically calculate the principal component analysis differently from R. The categorical NDI (Powell-Wiley) values are population-weighted quintiles of the continuous NDI (Powell-Wiley) values. @@ -76,16 +76,16 @@ powell_wiley(df = DCtracts2020[ , -c(3:10)]) \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Tract-level metric (2020) - powell_wiley(geo = "tract", state = "GA", year = 2020) + powell_wiley(geo = 'tract', state = 'GA', year = 2020) # Impute NDI for tracts (2020) with missing census information (median values) - powell_wiley(state = "tract", "GA", year = 2020, imp = TRUE) - + powell_wiley(state = 'tract', 'GA', year = 2020, imp = TRUE) + # County-level metric (2020) - powell_wiley(geo = "county", state = "GA", year = 2020) - + powell_wiley(geo = 'county', state = 'GA', year = 2020) + } } diff --git a/man/sudano.Rd b/man/sudano.Rd index 4576cc3..c98c5c2 100644 --- a/man/sudano.Rd +++ b/man/sudano.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/sudano.R \name{sudano} \alias{sudano} -\title{Location Quotient (LQ) based on Merton (1938) and Sudano \emph{et al.} (2013)} +\title{Location Quotient (LQ) based on Merton (1938) and Sudano et al. (2013)} \usage{ sudano( geo_large = "county", @@ -15,9 +15,9 @@ sudano( ) } \arguments{ -\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}.} +\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}.} -\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}.} +\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -42,47 +42,52 @@ An object of class 'list'. This is a named list with the following components: Compute the aspatial Location Quotient (Sudano) of a selected racial/ethnic subgroup(s) and U.S. geographies. } \details{ -This function will compute the aspatial Location Quotient (LQ) of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Merton (1939) \doi{10.2307/2084686} and Sudano \emph{et al.} (2013) \doi{10.1016/j.healthplace.2012.09.015}. This function provides the computation of LQ for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). +This function will compute the aspatial Location Quotient (LQ) of selected racial/ethnic subgroups and U.S. geographies for a specified geographical extent (e.g., the entire U.S. or a single state) based on Merton (1939) \doi{10.2307/2084686} and Sudano et al. (2013) \doi{10.1016/j.healthplace.2012.09.015}. This function provides the computation of LQ for any of the U.S. Census Bureau race/ethnicity subgroups (including Hispanic and non-Hispanic individuals). The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: \itemize{ -\item \strong{B03002_002}: not Hispanic or Latino \code{"NHoL"} -\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{"NHoLW"} -\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{"NHoLA"} -\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -\item \strong{B03002_012}: Hispanic or Latino \code{"HoL"} -\item \strong{B03002_013}: Hispanic or Latino, white alone \code{"HoLW"} -\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{"HoLB"} -\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{"HoLA"} -\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +\item \strong{B03002_002}: not Hispanic or Latino \code{'NHoL'} +\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{'NHoLW'} +\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{'NHoLA'} +\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +\item \strong{B03002_012}: Hispanic or Latino \code{'HoL'} +\item \strong{B03002_013}: Hispanic or Latino, white alone \code{'HoLW'} +\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{'HoLB'} +\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{'HoLA'} +\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} } Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. LQ is some measure of relative racial homogeneity of each smaller geography within a larger geography. LQ can range in value from 0 to infinity because it is ratio of two proportions in which the numerator is the proportion of subgroup population in a smaller geography and the denominator is the proportion of subgroup population in its larger geography. For example, a smaller geography with an LQ of 5 means that the proportion of the subgroup population living in the smaller geography is five times the proportion of the subgroup population in its larger geography. -Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the LQ value returned is NA. +Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the LQ value returned is NA. } \examples{ \dontrun{ # Wrapped in \dontrun{} because these examples require a Census API key. - + # Isolation of non-Hispanic Black populations ## of census tracts within Georgia, U.S.A., counties (2020) - sudano(geo_large = "state", geo_small = "county", state = "GA", - year = 2020, subgroup = "NHoLB") - + sudano( + geo_large = 'state', + geo_small = 'county', + state = 'GA', + year = 2020, + subgroup = 'NHoLB' + ) + } } diff --git a/man/white.Rd b/man/white.Rd index cdcafee..53d1097 100644 --- a/man/white.Rd +++ b/man/white.Rd @@ -15,9 +15,9 @@ white( ) } \arguments{ -\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = "county"}.} +\item{geo_large}{Character string specifying the larger geographical unit of the data. The default is counties \code{geo_large = 'county'}.} -\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = "tract"}.} +\item{geo_small}{Character string specifying the smaller geographical unit of the data. The default is census tracts \code{geo_large = 'tract'}.} \item{year}{Numeric. The year to compute the estimate. The default is 2020, and the years 2009 onward are currently available.} @@ -46,33 +46,33 @@ This function will compute the aspatial Correlation Ratio (V or \eqn{Eta^{2}}{Et The function uses the \code{\link[tidycensus]{get_acs}} function to obtain U.S. Census Bureau 5-year American Community Survey characteristics used for the aspatial computation. The yearly estimates are available for 2009 onward when ACS-5 data are available but are available from other U.S. Census Bureau surveys. The twenty racial/ethnic subgroups (U.S. Census Bureau definitions) are: \itemize{ -\item \strong{B03002_002}: not Hispanic or Latino \code{"NHoL"} -\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{"NHoLW"} -\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{"NHoLB"} -\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{"NHoLAIAN"} -\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{"NHoLA"} -\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"NHoLNHOPI"} -\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{"NHoLSOR"} -\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{"NHoLTOMR"} -\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{"NHoLTRiSOR"} -\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"NHoLTReSOR"} -\item \strong{B03002_012}: Hispanic or Latino \code{"HoL"} -\item \strong{B03002_013}: Hispanic or Latino, white alone \code{"HoLW"} -\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{"HoLB"} -\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{"HoLAIAN"} -\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{"HoLA"} -\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{"HoLNHOPI"} -\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{"HoLSOR"} -\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{"HoLTOMR"} -\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{"HoLTRiSOR"} -\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{"HoLTReSOR"} +\item \strong{B03002_002}: not Hispanic or Latino \code{'NHoL'} +\item \strong{B03002_003}: not Hispanic or Latino, white alone \code{'NHoLW'} +\item \strong{B03002_004}: not Hispanic or Latino, Black or African American alone \code{'NHoLB'} +\item \strong{B03002_005}: not Hispanic or Latino, American Indian and Alaska Native alone \code{'NHoLAIAN'} +\item \strong{B03002_006}: not Hispanic or Latino, Asian alone \code{'NHoLA'} +\item \strong{B03002_007}: not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'NHoLNHOPI'} +\item \strong{B03002_008}: not Hispanic or Latino, Some other race alone \code{'NHoLSOR'} +\item \strong{B03002_009}: not Hispanic or Latino, Two or more races \code{'NHoLTOMR'} +\item \strong{B03002_010}: not Hispanic or Latino, Two races including Some other race \code{'NHoLTRiSOR'} +\item \strong{B03002_011}: not Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'NHoLTReSOR'} +\item \strong{B03002_012}: Hispanic or Latino \code{'HoL'} +\item \strong{B03002_013}: Hispanic or Latino, white alone \code{'HoLW'} +\item \strong{B03002_014}: Hispanic or Latino, Black or African American alone \code{'HoLB'} +\item \strong{B03002_015}: Hispanic or Latino, American Indian and Alaska Native alone \code{'HoLAIAN'} +\item \strong{B03002_016}: Hispanic or Latino, Asian alone \code{'HoLA'} +\item \strong{B03002_017}: Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone \code{'HoLNHOPI'} +\item \strong{B03002_018}: Hispanic or Latino, Some other race alone \code{'HoLSOR'} +\item \strong{B03002_019}: Hispanic or Latino, Two or more races \code{'HoLTOMR'} +\item \strong{B03002_020}: Hispanic or Latino, Two races including Some other race \code{'HoLTRiSOR'} +\item \strong{B03002_021}: Hispanic or Latino, Two races excluding Some other race, and three or more races \code{'HoLTReSOR'} } Use the internal \code{state} and \code{county} arguments within the \code{\link[tidycensus]{get_acs}} function to specify geographic extent of the data output. -V removes the asymmetry from the Isolation Index (Bell) by controlling for the effect of population composition. The Isolation Index (Bell) is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation). V can range in value from 0 to 1. +V removes the asymmetry from the Isolation Index (Bell) by controlling for the effect of population composition. The Isolation Index (Bell) is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation). V can range in value from -Inf to Inf. -Larger geographies available include state \code{geo_large = "state"}, county \code{geo_large = "county"}, and census tract \code{geo_large = "tract"} levels. Smaller geographies available include, county \code{geo_small = "county"}, census tract \code{geo_small = "tract"}, and census block group \code{geo_small = "block group"} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the V value returned is NA. +Larger geographies available include state \code{geo_large = 'state'}, county \code{geo_large = 'county'}, and census tract \code{geo_large = 'tract'} levels. Smaller geographies available include, county \code{geo_small = 'county'}, census tract \code{geo_small = 'tract'}, and census block group \code{geo_small = 'block group'} levels. If a larger geographical area is comprised of only one smaller geographical area (e.g., a U.S county contains only one census tract), then the V value returned is NA. } \examples{ \dontrun{ @@ -80,8 +80,13 @@ Larger geographies available include state \code{geo_large = "state"}, county \c # Isolation of non-Hispanic Black populations ## of census tracts within Georgia, U.S.A., counties (2020) - white(geo_large = "county", geo_small = "tract", state = "GA", - year = 2020, subgroup = "NHoLB") + white( + geo_large = 'county', + geo_small = 'tract', + state = 'GA', + year = 2020, + subgroup = 'NHoLB' + ) } diff --git a/tests/testthat.R b/tests/testthat.R index e78b8e8..40f13cf 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ library(testthat) library(ndi) -test_check("ndi") +test_check('ndi') diff --git a/tests/testthat/test-anthopolos.R b/tests/testthat/test-anthopolos.R index 5b368fb..41ba7ac 100644 --- a/tests/testthat/test-anthopolos.R +++ b/tests/testthat/test-anthopolos.R @@ -1,37 +1,68 @@ -context("anthopolos") +context('anthopolos') -####################### +# ------------------- # # anthopolos testthat # -####################### +# ------------------- # -test_that("anthopolos throws error with invalid arguments", { - +test_that('anthopolos throws error with invalid arguments', { # Unavailable geography - expect_error(anthopolos(geo = "zcta", state = "DC", year = 2020, subgroup = "NHoLB", quiet = TRUE)) + expect_error(anthopolos( + geo = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) # Unavailable year - expect_error(anthopolos(state = "DC", year = 2005, subgroup = "NHoLB", quiet = TRUE)) + expect_error(anthopolos( + state = 'DC', + year = 2005, + subgroup = 'NHoLB', + quiet = TRUE + )) # Unavailable subgroup - expect_error(anthopolos(state = "DC", year = 2020, subgroup = "terran", quiet = TRUE)) + expect_error(anthopolos( + state = 'DC', + year = 2020, + subgroup = 'terran', + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(anthopolos(state = "AB", year = 2020, subgroup = "NHoLB", quiet = TRUE)) + expect_error(anthopolos( + state = 'AB', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) -} -) +}) -test_that("anthopolos works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('anthopolos works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_output(anthopolos(state = "DC", year = 2020, subgroup = c("NHoLB", "HoLB"))) + expect_output(anthopolos( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB') + )) - expect_silent(anthopolos(state = "DC", year = 2020, subgroup = "NHoLB", quiet = TRUE)) + expect_silent(anthopolos( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) - expect_silent(anthopolos(state = "DC", year = 2020, subgroup = c("NHoLB", "HoLB"), quiet = TRUE)) + expect_silent(anthopolos( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-atkinson.R b/tests/testthat/test-atkinson.R index 0695241..419c0a0 100644 --- a/tests/testthat/test-atkinson.R +++ b/tests/testthat/test-atkinson.R @@ -1,50 +1,86 @@ -context("atkinson") +context('atkinson') -##################### +# ----------------- # # atkinson testthat # -##################### +# ----------------- # -test_that("atkinson throws error with invalid arguments", { - +test_that('atkinson throws error with invalid arguments', { # Unavailable geography - expect_error(atkinson(geo_small = "zcta", state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) - expect_error(atkinson(geo_large = "block group", state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(atkinson( + geo_small = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) + expect_error( + atkinson( + geo_large = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + ) + ) # Unavailable year - expect_error(atkinson(state = "DC", year = 2005, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(atkinson( + state = 'DC', + year = 2005, + subgroup = 'NHoLB', + quiet = TRUE + )) # Unavailable subgroup - expect_error(atkinson(state = "DC", year = 2020, - subgroup = "terran", quiet = TRUE)) + expect_error(atkinson( + state = 'DC', + year = 2020, + subgroup = 'terran', + quiet = TRUE + )) # Incorrect epsilon - expect_error(atkinson(state = "DC", year = 2020, - subgroup = "NHoLB", epsilon = 2, quiet = TRUE)) + expect_error(atkinson( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + epsilon = 2, + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(atkinson(state = "AB", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(atkinson( + state = 'AB', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) -} -) +}) -test_that("atkinson works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('atkinson works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_silent(atkinson(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"))) + expect_silent(atkinson( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB') + )) - expect_silent(atkinson(state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_silent(atkinson( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) - expect_silent(atkinson(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), quiet = TRUE)) + expect_silent(atkinson( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-bell.R b/tests/testthat/test-bell.R index 2f50bcc..f7bc18f 100644 --- a/tests/testthat/test-bell.R +++ b/tests/testthat/test-bell.R @@ -1,48 +1,94 @@ -context("bell") +context('bell') -################# +# ------------- # # bell testthat # -################# +# ------------- # -test_that("bell throws error with invalid arguments", { - +test_that('bell throws error with invalid arguments', { # Unavailable geography - expect_error(bell(geo_small = "zcta", state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) - expect_error(bell(geo_large = "block group", state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) + expect_error( + bell( + geo_small = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + ) + ) + expect_error( + bell( + geo_large = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + ) + ) # Unavailable year - expect_error(bell(state = "DC", year = 2005, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) + expect_error(bell( + state = 'DC', + year = 2005, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + )) # Unavailable subgroup - expect_error(bell(state = "DC", year = 2020, - subgroup = "terran", subgroup_ixn = "NHoLW", quiet = TRUE)) - expect_error(bell(state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "terran", quiet = TRUE)) + expect_error(bell( + state = 'DC', + year = 2020, + subgroup = 'terran', + subgroup_ixn = 'NHoLW', + quiet = TRUE + )) + expect_error(bell( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'terran', + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(bell(state = "AB", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) + expect_error(bell( + state = 'AB', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + )) -} -) +}) -test_that("bell works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('bell works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_silent(bell(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), subgroup_ixn = c("NHoLW", "HoLW"))) + expect_silent(bell( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + subgroup_ixn = c('NHoLW', 'HoLW') + )) - expect_silent(bell(state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) + expect_silent(bell( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + )) - expect_silent(bell(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), subgroup_ixn = c("NHoLW", "HoLW"), quiet = TRUE)) + expect_silent(bell( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + subgroup_ixn = c('NHoLW', 'HoLW'), + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-bemanian_beyer.R b/tests/testthat/test-bemanian_beyer.R index 5a648ff..2cd0509 100644 --- a/tests/testthat/test-bemanian_beyer.R +++ b/tests/testthat/test-bemanian_beyer.R @@ -1,48 +1,104 @@ -context("bemanian_beyer") +context('bemanian_beyer') -########################### +# ----------------------- # # bemanian_beyer testthat # -########################### +# ----------------------- # -test_that("bemanian_beyer throws error with invalid arguments", { - +test_that('bemanian_beyer throws error with invalid arguments', { # Unavailable geography - expect_error(bemanian_beyer(geo_small = "zcta", state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) - expect_error(bemanian_beyer(geo_large = "block group", state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) + expect_error( + bemanian_beyer( + geo_small = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + ) + ) + expect_error( + bemanian_beyer( + geo_large = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + ) + ) # Unavailable year - expect_error(bemanian_beyer(state = "DC", year = 2005, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) + expect_error( + bemanian_beyer( + state = 'DC', + year = 2005, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + ) + ) # Unavailable subgroup - expect_error(bemanian_beyer(state = "DC", year = 2020, - subgroup = "terran", subgroup_ixn = "NHoLW", quiet = TRUE)) - expect_error(bemanian_beyer(state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "terran", quiet = TRUE)) + expect_error( + bemanian_beyer( + state = 'DC', + year = 2020, + subgroup = 'terran', + subgroup_ixn = 'NHoLW', + quiet = TRUE + ) + ) + expect_error( + bemanian_beyer( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'terran', + quiet = TRUE + ) + ) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(bemanian_beyer(state = "AB", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) + expect_error( + bemanian_beyer( + state = 'AB', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + ) + ) -} -) +}) -test_that("bemanian_beyer works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('bemanian_beyer works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_warning(bemanian_beyer(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), subgroup_ixn = c("NHoLW", "HoLW"))) + expect_warning(bemanian_beyer( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + subgroup_ixn = c('NHoLW', 'HoLW') + )) - expect_warning(bemanian_beyer(state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ixn = "NHoLW", quiet = TRUE)) + expect_warning( + bemanian_beyer( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW', + quiet = TRUE + ) + ) - expect_warning(bemanian_beyer(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), subgroup_ixn = c("NHoLW", "HoLW"), quiet = TRUE)) + expect_warning(bemanian_beyer( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + subgroup_ixn = c('NHoLW', 'HoLW'), + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-bravo.R b/tests/testthat/test-bravo.R index 662e1d0..60efbe0 100644 --- a/tests/testthat/test-bravo.R +++ b/tests/testthat/test-bravo.R @@ -1,37 +1,68 @@ -context("bravo") +context('bravo') -################## +# -------------- # # bravo testthat # -################## +# -------------- # -test_that("bravo throws error with invalid arguments", { - +test_that('bravo throws error with invalid arguments', { # Unavailable geography - expect_error(bravo(geo = "zcta", state = "DC", year = 2020, subgroup = "LtHS", quiet = TRUE)) + expect_error(bravo( + geo = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'LtHS', + quiet = TRUE + )) # Unavailable year - expect_error(bravo(state = "DC", year = 2005, subgroup = "LtHS", quiet = TRUE)) + expect_error(bravo( + state = 'DC', + year = 2005, + subgroup = 'LtHS', + quiet = TRUE + )) # Unavailable subgroup - expect_error(bravo(state = "DC", year = 2020, subgroup = "terran", quiet = TRUE)) + expect_error(bravo( + state = 'DC', + year = 2020, + subgroup = 'terran', + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(bravo(state = "AB", year = 2020, subgroup = "LtHS", quiet = TRUE)) + expect_error(bravo( + state = 'AB', + year = 2020, + subgroup = 'LtHS', + quiet = TRUE + )) -} -) +}) -test_that("bravo works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('bravo works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_output(bravo(state = "DC", year = 2009, subgroup = c("LtHS", "HSGiE"))) + expect_output(bravo( + state = 'DC', + year = 2009, + subgroup = c('LtHS', 'HSGiE') + )) - expect_silent(bravo(state = "DC", year = 2020, subgroup = "LtHS", quiet = TRUE)) + expect_silent(bravo( + state = 'DC', + year = 2020, + subgroup = 'LtHS', + quiet = TRUE + )) - expect_silent(bravo(state = "DC", year = 2020, subgroup = c("LtHS", "HSGiE"), quiet = TRUE)) + expect_silent(bravo( + state = 'DC', + year = 2020, + subgroup = c('LtHS', 'HSGiE'), + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-duncan.R b/tests/testthat/test-duncan.R index d895140..da49e0e 100644 --- a/tests/testthat/test-duncan.R +++ b/tests/testthat/test-duncan.R @@ -1,48 +1,104 @@ -context("duncan") +context('duncan') -################### +# --------------- # # duncan testthat # -################### +# --------------- # -test_that("duncan throws error with invalid arguments", { - +test_that('duncan throws error with invalid arguments', { # Unavailable geography - expect_error(duncan(geo_small = "zcta", state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ref = "NHoLW", quiet = TRUE)) - expect_error(duncan(geo_large = "block group", state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ref = "NHoLW", quiet = TRUE)) + expect_error( + duncan( + geo_small = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ref = 'NHoLW', + quiet = TRUE + ) + ) + expect_error( + duncan( + geo_large = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ref = 'NHoLW', + quiet = TRUE + ) + ) # Unavailable year - expect_error(duncan(state = "DC", year = 2005, - subgroup = "NHoLB", subgroup_ref = "NHoLW", quiet = TRUE)) + expect_error( + duncan( + state = 'DC', + year = 2005, + subgroup = 'NHoLB', + subgroup_ref = 'NHoLW', + quiet = TRUE + ) + ) # Unavailable subgroup - expect_error(duncan(state = "DC", year = 2020, - subgroup = "terran", subgroup_ref = "NHoLW", quiet = TRUE)) - expect_error(duncan(state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ref = "terran", quiet = TRUE)) + expect_error( + duncan( + state = 'DC', + year = 2020, + subgroup = 'terran', + subgroup_ref = 'NHoLW', + quiet = TRUE + ) + ) + expect_error( + duncan( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ref = 'terran', + quiet = TRUE + ) + ) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(duncan(state = "AB", year = 2020, - subgroup = "NHoLB", subgroup_ref = "NHoLW", quiet = TRUE)) + expect_error( + duncan( + state = 'AB', + year = 2020, + subgroup = 'NHoLB', + subgroup_ref = 'NHoLW', + quiet = TRUE + ) + ) -} -) +}) -test_that("duncan works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('duncan works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_silent(duncan(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), subgroup_ref = c("NHoLW", "HoLW"))) + expect_silent(duncan( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + subgroup_ref = c('NHoLW', 'HoLW') + )) - expect_silent(duncan(state = "DC", year = 2020, - subgroup = "NHoLB", subgroup_ref = "NHoLW", quiet = TRUE)) + expect_silent( + duncan( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ref = 'NHoLW', + quiet = TRUE + ) + ) - expect_silent(duncan(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), subgroup_ref = c("NHoLW", "HoLW"), quiet = TRUE)) + expect_silent(duncan( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + subgroup_ref = c('NHoLW', 'HoLW'), + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-gini.R b/tests/testthat/test-gini.R index 957d982..e4b7b23 100644 --- a/tests/testthat/test-gini.R +++ b/tests/testthat/test-gini.R @@ -1,35 +1,49 @@ -context("gini") +context('gini') -################# +# ------------- # # gini testthat # -################# +# ------------- # -test_that("gini throws error with invalid arguments", { - +test_that('gini throws error with invalid arguments', { # Unavailable geography - expect_error(gini(geo = "zcta", state = "DC", year = 2020, quiet = TRUE)) + expect_error(gini( + geo = 'zcta', + state = 'DC', + year = 2020, + quiet = TRUE + )) # Unavailable year - expect_error(gini(state = "DC", year = 2005, quiet = TRUE)) + expect_error(gini( + state = 'DC', + year = 2005, + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(gini(state = "AB", year = 2020)) + expect_error(gini(state = 'AB', year = 2020)) # Unavailable geography for DC (only 1 'county' in DC so, alone, NDI cannot be computed) - expect_error(gini(geo = "county", state = "DC", year = 2009, quiet = TRUE)) - -} -) + expect_error(gini( + geo = 'county', + state = 'DC', + year = 2009, + quiet = TRUE + )) + +}) -test_that("gini works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('gini works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_message(gini(state = "DC", year = 2020)) + expect_message(gini(state = 'DC', year = 2020)) - expect_silent(gini(state = "DC", year = 2020, quiet = TRUE)) + expect_silent(gini( + state = 'DC', + year = 2020, + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-krieger.R b/tests/testthat/test-krieger.R index c2727e9..5d20b63 100644 --- a/tests/testthat/test-krieger.R +++ b/tests/testthat/test-krieger.R @@ -1,32 +1,45 @@ -context("krieger") +context('krieger') -#################### +# ---------------- # # krieger testthat # -#################### +# ---------------- # -test_that(" throws error with invalid arguments", { - +test_that(' throws error with invalid arguments', { # Unavailable geography - expect_error(krieger(geo = "zcta", state = "DC", year = 2020, quiet = TRUE)) + expect_error(krieger( + geo = 'zcta', + state = 'DC', + year = 2020, + quiet = TRUE + )) # Unavailable year - expect_error(krieger(state = "DC", year = 2005, quiet = TRUE)) + expect_error(krieger( + state = 'DC', + year = 2005, + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(krieger(state = "AB", year = 2020, quiet = TRUE)) + expect_error(krieger( + state = 'AB', + year = 2020, + quiet = TRUE + )) -} -) +}) -test_that("krieger works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('krieger works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_silent(krieger(state = "DC", year = 2020)) + expect_silent(krieger(state = 'DC', year = 2020)) - expect_silent(krieger(state = "DC", year = 2020, quiet = TRUE)) + expect_silent(krieger( + state = 'DC', + year = 2020, + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-messer.R b/tests/testthat/test-messer.R index 2193965..698100a 100644 --- a/tests/testthat/test-messer.R +++ b/tests/testthat/test-messer.R @@ -1,46 +1,77 @@ -context("messer") +context('messer') -################### +# --------------- # # messer testthat # -################### +# --------------- # -test_that("messer throws error with invalid arguments", { - +test_that('messer throws error with invalid arguments', { # Not a data.frame or tibble for `df` - expect_error(messer(df = c("a", "b", "c"))) + expect_error(messer(df = c('a', 'b', 'c'))) # Unavailable geography - expect_error(messer(geo = "zcta", state = "DC", year = 2020, quiet = TRUE)) + expect_error(messer( + geo = 'zcta', + state = 'DC', + year = 2020, + quiet = TRUE + )) # Unavailable year - expect_error(messer(state = "DC", year = 2005, quiet = TRUE)) + expect_error(messer( + state = 'DC', + year = 2005, + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(messer(state = "AB", year = 2020, quiet = TRUE)) + expect_error(messer( + state = 'AB', + year = 2020, + quiet = TRUE + )) # Unavailable geography for DC (only 1 'county' in DC so, alone, NDI cannot be computed) - expect_error(messer(geo = "county", state = "DC", year = 2009, quiet = TRUE)) + expect_error(messer( + geo = 'county', + state = 'DC', + year = 2009, + quiet = TRUE + )) -} -) +}) -test_that("messer works", { +test_that('messer works', { + expect_message(messer(df = DCtracts2020[,-c(2, 11:ncol(DCtracts2020))])) - expect_message(messer(df = DCtracts2020[, -c(2, 11:ncol(DCtracts2020))])) + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + expect_message(messer(state = 'DC', year = 2020)) - expect_message(messer(state = "DC", year = 2020)) - - expect_message(messer(state = "DC", year = 2020, round_output = TRUE)) + expect_message(messer( + state = 'DC', + year = 2020, + round_output = TRUE + )) - expect_message(messer(state = "DC", year = 2020, imp = TRUE)) + expect_message(messer( + state = 'DC', + year = 2020, + imp = TRUE + )) - expect_silent(messer(state = "DC", year = 2020, quiet = TRUE)) + expect_silent(messer( + state = 'DC', + year = 2020, + quiet = TRUE + )) - expect_silent(messer(state = "DC", year = 2020, imp = TRUE, quiet = TRUE)) + expect_silent(messer( + state = 'DC', + year = 2020, + imp = TRUE, + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-powell_wiley.R b/tests/testthat/test-powell_wiley.R index 1ff4de4..97f509f 100644 --- a/tests/testthat/test-powell_wiley.R +++ b/tests/testthat/test-powell_wiley.R @@ -1,46 +1,77 @@ -context("powell_wiley") +context('powell_wiley') -######################### +# --------------------- # # powell_wiley testthat # -######################### +# --------------------- # -test_that("powell_wiley throws error with invalid arguments", { - +test_that('powell_wiley throws error with invalid arguments', { # Not a data.frame or tibble for `df` - expect_error(powell_wiley(df = c("a", "b", "c"))) + expect_error(powell_wiley(df = c('a', 'b', 'c'))) # Unavailable geography - expect_error(powell_wiley(geo = "zcta", state = "DC", year = 2020, quiet = TRUE)) + expect_error(powell_wiley( + geo = 'zcta', + state = 'DC', + year = 2020, + quiet = TRUE + )) # Unavailable year - expect_error(powell_wiley(state = "DC", year = 2005, quiet = TRUE)) + expect_error(powell_wiley( + state = 'DC', + year = 2005, + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(powell_wiley(state = "AB", year = 2020, quiet = TRUE)) + expect_error(powell_wiley( + state = 'AB', + year = 2020, + quiet = TRUE + )) # Unavailable geography for DC (only 1 'county' in DC so, alone, NDI cannot be computed) - expect_error(powell_wiley(geo = "county", state = "DC", year = 2009, quiet = TRUE)) - -} -) - -test_that("powell_wiley works", { + expect_error(powell_wiley( + geo = 'county', + state = 'DC', + year = 2009, + quiet = TRUE + )) - expect_message(powell_wiley(df = DCtracts2020[ , -c(3:10)])) +}) + +test_that('powell_wiley works', { + expect_message(powell_wiley(df = DCtracts2020[,-c(3:10)])) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_message(powell_wiley(state = "DC", year = 2020)) + expect_message(powell_wiley(state = 'DC', year = 2020)) - expect_message(powell_wiley(state = "DC", year = 2020, round_output = TRUE)) + expect_message(powell_wiley( + state = 'DC', + year = 2020, + round_output = TRUE + )) - expect_message(powell_wiley(state = "DC", year = 2020, imp = TRUE)) + expect_message(powell_wiley( + state = 'DC', + year = 2020, + imp = TRUE + )) - expect_silent(powell_wiley(state = "DC", year = 2020, quiet = TRUE)) + expect_silent(powell_wiley( + state = 'DC', + year = 2020, + quiet = TRUE + )) - expect_silent(powell_wiley(state = "DC", year = 2020, imp = TRUE, quiet = TRUE)) + expect_silent(powell_wiley( + state = 'DC', + year = 2020, + imp = TRUE, + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-sudano.R b/tests/testthat/test-sudano.R index 8ecc335..c929055 100644 --- a/tests/testthat/test-sudano.R +++ b/tests/testthat/test-sudano.R @@ -1,46 +1,77 @@ -context("sudano") +context('sudano') -################### +# --------------- # # sudano testthat # -################### +# --------------- # -test_that("sudano throws error with invalid arguments", { - +test_that('sudano throws error with invalid arguments', { # Unavailable geography - expect_error(sudano(geo_small = "zcta", state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) - expect_error(sudano(geo_large = "block group", state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(sudano( + geo_small = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) + expect_error( + sudano( + geo_large = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + ) + ) # Unavailable year - expect_error(sudano(state = "DC", year = 2005, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(sudano( + state = 'DC', + year = 2005, + subgroup = 'NHoLB', + quiet = TRUE + )) # Unavailable subgroup - expect_error(sudano(state = "DC", year = 2020, - subgroup = "terran", quiet = TRUE)) + expect_error(sudano( + state = 'DC', + year = 2020, + subgroup = 'terran', + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(sudano(state = "AB", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(sudano( + state = 'AB', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) -} -) +}) -test_that("sudano works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('sudano works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_silent(sudano(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"))) + expect_silent(sudano( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB') + )) - expect_silent(sudano(state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_silent(sudano( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) - expect_silent(sudano(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), quiet = TRUE)) + expect_silent(sudano( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + quiet = TRUE + )) -} -) +}) diff --git a/tests/testthat/test-white.R b/tests/testthat/test-white.R index 07e618d..0e85449 100644 --- a/tests/testthat/test-white.R +++ b/tests/testthat/test-white.R @@ -1,46 +1,77 @@ -context("white") +context('white') -################## +# -------------- # # white testthat # -################## +# -------------- # -test_that("white throws error with invalid arguments", { - +test_that('white throws error with invalid arguments', { # Unavailable geography - expect_error(white(geo_small = "zcta", state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) - expect_error(white(geo_large = "block group", state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(white( + geo_small = 'zcta', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) + expect_error( + white( + geo_large = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + ) + ) # Unavailable year - expect_error(white(state = "DC", year = 2005, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(white( + state = 'DC', + year = 2005, + subgroup = 'NHoLB', + quiet = TRUE + )) # Unavailable subgroup - expect_error(white(state = "DC", year = 2020, - subgroup = "terran", quiet = TRUE)) + expect_error(white( + state = 'DC', + year = 2020, + subgroup = 'terran', + quiet = TRUE + )) - skip_if(Sys.getenv("CENSUS_API_KEY") == "") + skip_if(Sys.getenv('CENSUS_API_KEY') == '') # Incorrect state - expect_error(white(state = "AB", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_error(white( + state = 'AB', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) -} -) +}) -test_that("white works", { - - skip_if(Sys.getenv("CENSUS_API_KEY") == "") +test_that('white works', { + skip_if(Sys.getenv('CENSUS_API_KEY') == '') - expect_silent(white(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"))) + expect_silent(white( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB') + )) - expect_silent(white(state = "DC", year = 2020, - subgroup = "NHoLB", quiet = TRUE)) + expect_silent(white( + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + quiet = TRUE + )) - expect_silent(white(state = "DC", year = 2020, - subgroup = c("NHoLB", "HoLB"), quiet = TRUE)) + expect_silent(white( + state = 'DC', + year = 2020, + subgroup = c('NHoLB', 'HoLB'), + quiet = TRUE + )) -} -) +}) From 036efc7d4d065b20a60e3fa5648f80621fe2e5ff Mon Sep 17 00:00:00 2001 From: Ian D Buller Date: Sat, 6 Jul 2024 14:07:37 -0400 Subject: [PATCH 5/7] :memo: Updated documentation for ndi v0.1.6.9000 * Updated examples in vignette (& README) an example for `hoover()` and a larger variety of U.S. states * Updated DESCRIPTION, NAMESPACE, & 'cran-comments.md' --- DESCRIPTION | 15 +- NAMESPACE | 1 + NEWS.md | 1 + README.md | 812 +++++++++++------ cran-comments.md | 16 +- vignettes/vignette.Rmd | 1398 +++++++++++++++++------------ vignettes/vignette.html | 1883 ++++++++++++++++++++++++--------------- 7 files changed, 2539 insertions(+), 1587 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ca8e078..a0b6915 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: ndi Title: Neighborhood Deprivation Indices -Version: 0.1.5 -Date: 2024-01-23 +Version: 0.1.6.9000 +Date: 2024-07-06 Authors@R: c(person(given = "Ian D.", family = "Buller", @@ -39,16 +39,17 @@ Description: Computes various metrics of socio-economic deprivation and disparit based on Bell (1954) and White (1986) , (8) aspatial racial/ethnic Location Quotient (LQ) based on Merton (1939) and Sudano et al. (2013) - , and (9) aspatial racial/ethnic Local + , (9) aspatial racial/ethnic Local Exposure and Isolation metric based on Bemanian & Beyer (2017) - . Also using data from the ACS-5 (2005-2009 - onward), the package can retrieve the aspatial Gini Index based Gini (1921) - . + , and (10) aspatial racial/ethnic Delta based on + Hoover (1941) and Duncan et al. (1961; LC:60007089). + Also using data from the ACS-5 (2005-2009 onward), the package can retrieve the + aspatial Gini Index based Gini (1921) . License: Apache License (>= 2.0) Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 Depends: R (>= 3.5.0) Imports: diff --git a/NAMESPACE b/NAMESPACE index c648ea6..71b1c6a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ export(bemanian_beyer) export(bravo) export(duncan) export(gini) +export(hoover) export(krieger) export(messer) export(powell_wiley) diff --git a/NEWS.md b/NEWS.md index b2f1942..ad665cf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,7 @@ * 'package.R' deprecated. Replaced with 'ndi-package.R'. * Re-formatted code and documentation throughout for consistent readability * Updated documentation about value range of V (White) from `{0 to 1}` to `{-Inf to Inf}` +* Updated examples in vignette (& README) an example for `hoover()` and a larger variety of U.S. states ## ndi v0.1.5 diff --git a/README.md b/README.md index 93f3f51..0470ef5 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ ndi: Neighborhood Deprivation Indices @@ -169,7 +169,7 @@ library(tigris) ## Access Key for census data download ### Obtain one at http://api.census.gov/data/key_signup.html -tidycensus::census_api_key('...') # INSERT YOUR OWN KEY FROM U.S. CENSUS API +census_api_key('...') # INSERT YOUR OWN KEY FROM U.S. CENSUS API # ---------------------- # # Calculate NDI (Messer) # @@ -182,13 +182,15 @@ messer2020DC <- messer(state = 'DC', year = 2020) # Outputs from messer() function # # ------------------------------ # -# A tibble containing the identification, geographic name, NDI (Messer) values, NDI (Messer) quartiles, and raw census characteristics for each tract +# A tibble containing the identification, geographic name, NDI (Messer) values, NDI (Messer) +# quartiles, and raw census characteristics for each tract messer2020DC$ndi # The results from the principal component analysis used to compute the NDI (Messer) values messer2020DC$pca -# A tibble containing a breakdown of the missingingness of the census characteristics used to compute the NDI (Messer) values +# A tibble containing a breakdown of the missingingness of the census characteristics +# used to compute the NDI (Messer) values messer2020DC$missing # -------------------------------------- # @@ -196,43 +198,63 @@ messer2020DC$missing # -------------------------------------- # # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the NDI (Messer) values to the census tract geometry -DC2020messer <- dplyr::left_join(tract2020DC, messer2020DC$ndi, by = 'GEOID') +DC2020messer <- tract2020DC %>% + left_join(messer2020DC$ndi, by = 'GEOID') # Visualize the NDI (Messer) values (2016-2020 5-year ACS) for Washington, D.C. census tracts ## Continuous Index -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020messer, - ggplot2::aes(fill = NDI), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Neighborhood Deprivation Index\nContinuous (Messer, non-imputed)', - subtitle = 'Washington, D.C. tracts as the referent') +ggplot() + + geom_sf( + data = DC2020messer, + aes(fill = NDI), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c() + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Neighborhood Deprivation Index\nContinuous (Messer, non-imputed)', + subtitle = 'Washington, D.C. tracts as the referent' + ) ## Categorical Index (Quartiles) ### Rename '9-NDI not avail' level as NA for plotting -DC2020messer$NDIQuartNA <- factor(replace(as.character(DC2020messer$NDIQuart), - DC2020messer$NDIQuart == '9-NDI not avail', - NA), - c(levels(DC2020messer$NDIQuart)[-5], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020messer, - ggplot2::aes(fill = NDIQuartNA), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = 'grey50') + - ggplot2::labs(fill = 'Index (Categorical)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates') + - ggplot2::ggtitle('Neighborhood Deprivation Index\nQuartiles (Messer, non-imputed)', - subtitle = 'Washington, D.C. tracts as the referent') +DC2020messer$NDIQuartNA <- + factor( + replace( + as.character(DC2020messer$NDIQuart), + DC2020messer$NDIQuart == '9-NDI not avail', + NA + ), + c(levels(DC2020messer$NDIQuart)[-5], NA) + ) + +ggplot() + + geom_sf( + data = DC2020messer, + aes(fill = NDIQuartNA), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_d( + guide = guide_legend(reverse = TRUE), + na.value = 'grey50' + ) + + labs( + fill = 'Index (Categorical)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Neighborhood Deprivation Index\nQuartiles (Messer, non-imputed)', + subtitle = 'Washington, D.C. tracts as the referent' + ) ``` ![](man/figures/messer1.png) ![](man/figures/messer2.png) @@ -250,13 +272,15 @@ powell_wiley2020DCi <- powell_wiley(state = 'DC', year = 2020, imp = TRUE) # imp # Outputs from powell_wiley() function # # ------------------------------------ # -# A tibble containing the identification, geographic name, NDI (Powell-Wiley) value, and raw census characteristics for each tract +# A tibble containing the identification, geographic name, NDI (Powell-Wiley) value, and +# raw census characteristics for each tract powell_wiley2020DC$ndi # The results from the principal component analysis used to compute the NDI (Powell-Wiley) values powell_wiley2020DC$pca -# A tibble containing a breakdown of the missingingness of the census characteristics used to compute the NDI (Powell-Wiley) values +# A tibble containing a breakdown of the missingingness of the census characteristics used to +# compute the NDI (Powell-Wiley) values powell_wiley2020DC$missing # -------------------------------------------- # @@ -264,44 +288,65 @@ powell_wiley2020DC$missing # -------------------------------------------- # # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the NDI (powell_wiley) values to the census tract geometry -DC2020powell_wiley <- dplyr::left_join(tract2020DC, powell_wiley2020DC$ndi, by = 'GEOID') -DC2020powell_wiley <- dplyr::left_join(DC2020powell_wiley, powell_wiley2020DCi$ndi, by = 'GEOID') +DC2020powell_wiley <- tract2020DC + left_join(powell_wiley2020DC$ndi, by = 'GEOID') +DC2020powell_wiley <- DC2020powell_wiley + left_join(powell_wiley2020DCi$ndi, by = 'GEOID') # Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for Washington, D.C. census tracts ## Non-imputed missing tracts (Continuous) -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020powell_wiley, - ggplot2::aes(fill = NDI.x), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Neighborhood Deprivation Index\nContinuous (Powell-Wiley, non-imputed)', - subtitle = 'Washington, D.C. tracts as the referent') +ggplot() + + geom_sf( + data = DC2020powell_wiley, + aes(fill = NDI.x), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c() + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Neighborhood Deprivation Index\nContinuous (Powell-Wiley, non-imputed)', + subtitle = 'Washington, D.C. tracts as the referent' + ) ## Non-imputed missing tracts (Categorical quintiles) ### Rename '9-NDI not avail' level as NA for plotting -DC2020powell_wiley$NDIQuintNA.x <- factor(replace(as.character(DC2020powell_wiley$NDIQuint.x), - DC2020powell_wiley$NDIQuint.x == '9-NDI not avail', - NA), - c(levels(DC2020powell_wiley$NDIQuint.x)[-6], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020powell_wiley, - ggplot2::aes(fill = NDIQuintNA.x), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = 'grey50') + - ggplot2::labs(fill = 'Index (Categorical)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, non-imputed)', - subtitle = 'Washington, D.C. tracts as the referent') +DC2020powell_wiley$NDIQuintNA.x <- factor( + replace( + as.character(DC2020powell_wiley$NDIQuint.x), + DC2020powell_wiley$NDIQuint.x == '9-NDI not avail', + NA + ), + c(levels(DC2020powell_wiley$NDIQuint.x)[-6], NA) +) + + +ggplot() + + geom_sf( + data = DC2020powell_wiley, + aes(fill = NDIQuintNA.x), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_d( + guide = guide_legend(reverse = TRUE), + na.value = 'grey50' + ) + + labs( + fill = 'Index (Categorical)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, non-imputed)', + subtitle = 'Washington, D.C. tracts as the referent' + ) ``` ![](man/figures/powell_wiley1.png) @@ -309,35 +354,53 @@ ggplot2::ggplot() + ``` r ## Imputed missing tracts (Continuous) -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020powell_wiley, - ggplot2::aes(fill = NDI.y), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Neighborhood Deprivation Index\nContinuous (Powell-Wiley, imputed)', - subtitle = 'Washington, D.C. tracts as the referent') +ggplot() + + geom_sf( + data = DC2020powell_wiley, + aes(fill = NDI.y), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c() + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Neighborhood Deprivation Index\nContinuous (Powell-Wiley, imputed)', + subtitle = 'Washington, D.C. tracts as the referent' + ) ## Imputed missing tracts (Categorical quintiles) ### Rename '9-NDI not avail' level as NA for plotting -DC2020powell_wiley$NDIQuintNA.y <- factor(replace(as.character(DC2020powell_wiley$NDIQuint.y), - DC2020powell_wiley$NDIQuint.y == '9-NDI not avail', - NA), - c(levels(DC2020powell_wiley$NDIQuint.y)[-6], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020powell_wiley, - ggplot2::aes(fill = NDIQuintNA.y), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = 'grey50') + - ggplot2::labs(fill = 'Index (Categorical)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, imputed)', - subtitle = 'Washington, D.C. tracts as the referent') +DC2020powell_wiley$NDIQuintNA.y <- factor( + replace( + as.character(DC2020powell_wiley$NDIQuint.y), + DC2020powell_wiley$NDIQuint.y == '9-NDI not avail', + NA + ), + c(levels(DC2020powell_wiley$NDIQuint.y)[-6], NA) +) + +ggplot() + + geom_sf( + data = DC2020powell_wiley, + aes(fill = NDIQuintNA.y), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_d( + guide = guide_legend(reverse = TRUE), + na.value = 'grey50' + ) + + labs( + fill = 'Index (Categorical)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, imputed)', + subtitle = 'Washington, D.C. tracts as the referent' + ) ``` ![](man/figures/powell_wiley3.png) @@ -349,7 +412,12 @@ ggplot2::ggplot() + # --------------------------- # # Merge the two NDI metrics (Messer and Powell-Wiley, imputed) -ndi2020DC <- dplyr::left_join(messer2020DC$ndi, powell_wiley2020DCi$ndi, by = 'GEOID', suffix = c('.messer', '.powell_wiley')) +ndi2020DC <- messer2020DC$ndi %>% + left_join( + powell_wiley2020DCi$ndi, + by = 'GEOID', + suffix = c('.messer', '.powell_wiley') + ) # Check the correlation the two NDI metrics (Messer and Powell-Wiley, imputed) as continuous values cor(ndi2020DC$NDI.messer, ndi2020DC$NDI.powell_wiley, use = 'complete.obs') # Pearsons r = 0.975 @@ -367,21 +435,28 @@ table(ndi2020DC$NDIQuart, ndi2020DC$NDIQuint) gini2020DC <- gini(state = 'DC', year = 2020) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the Gini Index values to the census tract geometry -gini2020DC <- dplyr::left_join(tract2020DC, gini2020DC$gini, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = gini2020DC, - ggplot2::aes(fill = gini), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Gini Index\nGrey color denotes no data', - subtitle = 'Washington, D.C. tracts') +gini2020DC <- tract2020DC %>% + left_join(gini2020DC$gini, by = 'GEOID') + +ggplot() + + geom_sf( + data = gini2020DC, + aes(fill = gini), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c() + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Gini Index\nGrey color denotes no data', + subtitle = 'Washington, D.C. tracts' + ) ``` ![](man/figures/gini.png) @@ -396,21 +471,28 @@ ggplot2::ggplot() + ri2020DC <- anthopolos(state = 'DC', year = 2020, subgroup = 'NHoLB') # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the RI (Anthopolos) values to the census tract geometry -ri2020DC <- dplyr::left_join(tract2020DC, ri2020DC$ri, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = ri2020DC, - ggplot2::aes(fill = RI), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Racial Isolation Index\nNot Hispanic or Latino, Black or African American alone (Anthopolos)', - subtitle = 'Washington, D.C. tracts (not corrected for edge effects)') +ri2020DC <- tract2020DC %>% + left_join(ri2020DC$ri, by = 'GEOID') + +ggplot() + + geom_sf( + data = ri2020DC, + aes(fill = RI), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c() + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Racial Isolation Index\nNot Hispanic or Latino, Black or African American alone (Anthopolos)', + subtitle = 'Washington, D.C. tracts (not corrected for edge effects)' + ) ``` ![](man/figures/ri.png) @@ -425,21 +507,28 @@ ggplot2::ggplot() + ei2020DC <- bravo(state = 'DC', year = 2020, subgroup = c('LtHS', 'HSGiE', 'SCoAD')) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the EI (Bravo) values to the census tract geometry -ei2020DC <- dplyr::left_join(tract2020DC, ei2020DC$ei, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = ei2020DC, - ggplot2::aes(fill = EI), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Educational Isolation Index\nWithout a four-year college degree (Bravo)', - subtitle = 'Washington, D.C. tracts (not corrected for edge effects)') +ei2020DC <- tract2020DC %>% + left_join(ei2020DC$ei, by = 'GEOID') + +ggplot() + + geom_sf( + data = ei2020DC, + aes(fill = EI), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c() + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + )+ + ggtitle( + 'Educational Isolation Index\nWithout a four-year college degree (Bravo)', + subtitle = 'Washington, D.C. tracts (not corrected for edge effects)' + ) ``` ![](man/figures/ei.png) @@ -449,76 +538,124 @@ ggplot2::ggplot() + # Compute aspatial Index of Concentration at the Extremes (Krieger) # # ----------------------------------------------------------------- # -# Five Indices of Concentration at the Extremes based on Feldman et al. (2015) and Krieger et al. (2016) +# Five Indices of Concentration at the Extremes based on Feldman et al. (2015) and +# Krieger et al. (2016) ice2020DC <- krieger(state = 'DC', year = 2020) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the ICEs (Krieger) values to the census tract geometry -ice2020DC <- dplyr::left_join(tract2020DC, ice2020DC$ice, by = 'GEOID') +ice2020DC <- tract2020DC %>% + left_join(ice2020DC$ice, by = 'GEOID') # Plot ICE for Income -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020DC, - ggplot2::aes(fill = ICE_inc), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1,1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Index of Concentration at the Extremes\nIncome (Krieger)', - subtitle = '80th income percentile vs. 20th income percentile') +ggplot() + + geom_sf( + data = ice2020DC, + aes(fill = ICE_inc), + color = 'white' + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Index of Concentration at the Extremes\nIncome (Krieger)', + subtitle = '80th income percentile vs. 20th income percentile' + ) ``` ![](man/figures/ice1.png) ```r # Plot ICE for Education -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020DC, - ggplot2::aes(fill = ICE_edu), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1,1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Index of Concentration at the Extremes\nEducation (Krieger)', - subtitle = 'less than high school vs. four-year college degree or more') +ggplot() + + geom_sf( + data = ice2020DC, + aes(fill = ICE_edu), + color = 'white' + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Index of Concentration at the Extremes\nEducation (Krieger)', + subtitle = 'less than high school vs. four-year college degree or more' + ) ``` ![](man/figures/ice2.png) ```r # Plot ICE for Race/Ethnicity -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020DC, - ggplot2::aes(fill = ICE_rewb), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1, 1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Index of Concentration at the Extremes\nRace/Ethnicity (Krieger)', - subtitle = 'white non-Hispanic vs. black non-Hispanic') +ggplot() + + geom_sf( + data = ice2020DC, + aes(fill = ICE_rewb), + color = 'white' + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Index of Concentration at the Extremes\nRace/Ethnicity (Krieger)', + subtitle = 'white non-Hispanic vs. black non-Hispanic' + ) ``` ![](man/figures/ice3.png) ``` # Plot ICE for Income and Race/Ethnicity Combined -## white non-Hispanic in 80th income percentile vs. black (including Hispanic) in 20th income percentile -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020DC, - ggplot2::aes(fill = ICE_wbinc), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1, 1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Index of Concentration at the Extremes\nIncome and race/ethnicity combined (Krieger)', - subtitle = 'white non-Hispanic in 80th income percentile vs. black (incl. Hispanic) in 20th inc. percentile') +## white non-Hispanic in 80th income percentile vs. +## black (including Hispanic) in 20th income percentile +ggplot() + + geom_sf( + data = ice2020DC, + aes(fill = ICE_wbinc), + color = 'white' + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Index of Concentration at the Extremes\nIncome and race/ethnicity combined (Krieger)', + subtitle = 'white non-Hispanic in 80th income percentile vs. + black (incl. Hispanic) in 20th inc. percentile' + ) ``` ![](man/figures/ice4.png) @@ -526,16 +663,28 @@ ggplot2::ggplot() + ```r # Plot ICE for Income and Race/Ethnicity Combined ## white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020DC, - ggplot2::aes(fill = ICE_wpcinc), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = '#998ec3', mid = '#f7f7f7', high = '#f1a340', limits = c(-1, 1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Index of Concentration at the Extremes\nIncome and race/ethnicity combined (Krieger)', - subtitle = 'white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile') +ggplot() + + geom_sf( + data = ice2020DC, + aes(fill = ICE_wpcinc), + color = 'white' + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Index of Concentration at the Extremes\nIncome and race/ethnicity combined (Krieger)', + subtitle = 'white non-Hispanic in 80th income percentile vs. + white non-Hispanic in 20th income percentile' + ) ``` ![](man/figures/ice5.png) @@ -550,25 +699,38 @@ ggplot2::ggplot() + ## Selected subgroup reference: Not Hispanic or Latino, white alone ## Selected large geography: census tract ## Selected small geography: census block group -di2020DC <- duncan(geo_large = 'tract', geo_small = 'block group', state = 'DC', - year = 2020, subgroup = 'NHoLB', subgroup_ref = 'NHoLW') +di2020DC <- duncan( + geo_large = 'tract', + geo_small = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ref = 'NHoLW' +) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the DI (Duncan & Duncan) values to the census tract geometry -di2020DC <- dplyr::left_join(tract2020DC, di2020DC$di, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = di2020DC, - ggplot2::aes(fill = DI), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates')+ - ggplot2::ggtitle('Dissimilarity Index (Duncan & Duncan)\nWashington, D.C. census block groups to tracts', - subtitle = 'Black non-Hispanic vs. white non-Hispanic') +di2020DC <- tract2020DC %>% + left_join(di2020DC$di, by = 'GEOID') + +ggplot() + + geom_sf( + data = di2020DC, + aes(fill = DI), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Dissimilarity Index (Duncan & Duncan)\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic vs. white non-Hispanic' + ) ``` ![](man/figures/di.png) @@ -583,25 +745,37 @@ ggplot2::ggplot() + ## Selected large geography: census tract ## Selected small geography: census block group ## Default epsilon (0.5 or over- and under-representation contribute equally) -ai2020DC <- atkinson(geo_large = 'tract', geo_small = 'block group', state = 'DC', - year = 2020, subgroup = 'NHoLB') +ai2020DC <- atkinson( + geo_large = 'tract', + geo_small = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB' +) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the AI (Atkinson) values to the census tract geometry -ai2020DC <- dplyr::left_join(tract2020DC, ai2020DC$ai, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = ai2020DC, - ggplot2::aes(fill = AI), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates') + - ggplot2::ggtitle('Atkinson Index (Atkinson)\nWashington, D.C. census block groups to tracts', - subtitle = expression(paste('Black non-Hispanic (', epsilon, ' = 0.5)'))) +ai2020DC <- tract2020DC %>% + left_join(ai2020DC$ai, by = 'GEOID') + +ggplot() + + geom_sf( + data = ai2020DC, + aes(fill = AI), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Atkinson Index (Atkinson)\nWashington, D.C. census block groups to tracts', + subtitle = expression(paste('Black non-Hispanic (', epsilon, ' = 0.5)')) + ) ``` ![](man/figures/ai.png) @@ -616,25 +790,38 @@ ggplot2::ggplot() + ## Selected interaction subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: census tract ## Selected small geography: census block group -ii2020DC <- bell(geo_large = 'tract', geo_small = 'block group', state = 'DC', - year = 2020, subgroup = 'NHoLB', subgroup_ixn = 'NHoLW') +ii2020DC <- bell( + geo_large = 'tract', + geo_small = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW' +) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the II (Bell) values to the census tract geometry -ii2020DC <- dplyr::left_join(tract2020DC, ii2020DC$ii, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = ii2020DC, - ggplot2::aes(fill = II), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates') + - ggplot2::ggtitle('Isolation Index (Bell)\nWashington, D.C. census block groups to tracts', - subtitle = 'Black non-Hispanic vs. white non-Hispanic') +ii2020DC <- tract2020DC %>% + left_join(ii2020DC$ii, by = 'GEOID') + +ggplot() + + geom_sf( + data = ii2020DC, + aes(fill = II), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Isolation Index (Bell)\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic vs. white non-Hispanic' + ) ``` ![](man/figures/ii.png) @@ -648,25 +835,37 @@ ggplot2::ggplot() + ## Selected subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: census tract ## Selected small geography: census block group -v2020DC <- white(geo_large = 'tract', geo_small = 'block group', state = 'DC', - year = 2020, subgroup = 'NHoLB') +v2020DC <- white( + geo_large = 'tract', + geo_small = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB' +) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the V (White) values to the census tract geometry -v2020DC <- dplyr::left_join(tract2020DC, v2020DC$v, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = v2020DC, - ggplot2::aes(fill = V), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates') + - ggplot2::ggtitle('Correlation Ratio (White)\nWashington, D.C. census block groups to tracts', - subtitle = 'Black non-Hispanic') +v2020DC <- tract2020DC %>% + left_join(v2020DC$v, by = 'GEOID') + +ggplot() + + geom_sf( + data = v2020DC, + aes(fill = V), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Correlation Ratio (White)\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic' + ) ``` ![](man/figures/v.png) @@ -680,25 +879,37 @@ ggplot2::ggplot() + ## Selected subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: state ## Selected small geography: census tract -lq2020DC <- sudano(geo_large = 'state', geo_small = 'tract', state = 'DC', - year = 2020, subgroup = 'NHoLB') +lq2020DC <- sudano( + geo_large = 'state', + geo_small = 'tract', + state = 'DC', + year = 2020, + subgroup = 'NHoLB' +) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the LQ (Sudano) values to the census tract geometry -lq2020DC <- dplyr::left_join(tract2020DC, lq2020DC$lq, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = lq2020DC, - ggplot2::aes(fill = LQ), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates') + - ggplot2::ggtitle('Location Quotient (Sudano)\nWashington, D.C. census tracts vs. 'state'', - subtitle = 'Black non-Hispanic') +lq2020DC <- tract2020DC %>% + left_join(lq2020DC$lq, by = 'GEOID') + +ggplot() + + geom_sf( + data = lq2020DC, + aes(fill = LQ), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c() + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Location Quotient (Sudano)\nWashington, D.C. census tracts vs. 'state'', + subtitle = 'Black non-Hispanic' + ) ``` ![](man/figures/lq.png) @@ -713,25 +924,38 @@ ggplot2::ggplot() + ## Selected interaction subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: state ## Selected small geography: census tract -lexis2020DC <- bemanian_beyer(geo_large = 'state', geo_small = 'tract', state = 'DC', - year = 2020, subgroup = 'NHoLB', subgroup_ixn = 'NHoLW') +lexis2020DC <- bemanian_beyer( + geo_large = 'state', + geo_small = 'tract', + state = 'DC', + year = 2020, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW' +) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the LEx/Is (Bemanian & Beyer) values to the census tract geometry -lexis2020DC <- dplyr::left_join(tract2020DC, lexis2020DC$lexis, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = lexis2020DC, - ggplot2::aes(fill = LExIs), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates') + - ggplot2::ggtitle('Local Exposure and Isolation (Bemanian & Beyer) metric\nWashington, D.C. census block groups to tracts', - subtitle = 'Black non-Hispanic vs. white non-Hispanic') +lexis2020DC <- tract2020DC %>% + left_join(lexis2020DC$lexis, by = 'GEOID') + +ggplot() + + geom_sf( + data = lexis2020DC, + aes(fill = LExIs), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c() + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Local Exposure and Isolation (Bemanian & Beyer) metric\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic vs. white non-Hispanic' + ) ``` ![](man/figures/lexis.png) @@ -745,25 +969,37 @@ ggplot2::ggplot() + ## Selected subgroup: Not Hispanic or Latino, Black or African American alone ## Selected large geography: census tract ## Selected small geography: census block group -del2020DC <- hoover(geo_large = 'tract', geo_small = 'block group', state = 'DC', - year = 2020, subgroup = 'NHoLB') +del2020DC <- hoover( + geo_large = 'tract', + geo_small = 'block group', + state = 'DC', + year = 2020, + subgroup = 'NHoLB' +) # Obtain the 2020 census tracts from the 'tigris' package -tract2020DC <- tigris::tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the DEL (Hoover) values to the census tract geometry -del2020DC <- dplyr::left_join(tract2020DC, del2020DC$del, by = 'GEOID') - -ggplot2::ggplot() + - ggplot2::geom_sf(data = del2020DC, - ggplot2::aes(fill = DEL), - color = 'white') + - ggplot2::theme_bw() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = 'Index (Continuous)', - caption = 'Source: U.S. Census ACS 2016-2020 estimates') + - ggplot2::ggtitle('Delta (Hoover)\nWashington, D.C. census block groups to tracts', - subtitle = 'Black non-Hispanic') +del2020DC <- tract2020DC %>% + left_join(del2020DC$del, by = 'GEOID') + +ggplot() + + geom_sf( + data = del2020DC, + aes(fill = DEL), + color = 'white' + ) + + theme_bw() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs( + fill = 'Index (Continuous)', + caption = 'Source: U.S. Census ACS 2016-2020 estimates' + ) + + ggtitle( + 'Delta (Hoover)\nWashington, D.C. census block groups to tracts', + subtitle = 'Black non-Hispanic' + ) ``` ![](man/figures/del.png) diff --git a/cran-comments.md b/cran-comments.md index e8c6374..a80e2cc 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,10 +1,12 @@ -## This is the sixth resubmission +## This is the seventh resubmission * Actions taken since previous submission: - * 'DescTools' is now Suggests to fix Rd cross-references NOTE - * Fixed 'lost braces in \itemize' NOTE for `anthopolos()`, `atkinson()`, `bell()`, `bemanian_beyer()`, `bravo()`, `duncan()`, `krieger()`, `messer()`, `powell_wiley()`, `sudano()`, and `white()` functions - * Fixed 'Moved Permanently' content by replacing the old URL with the new URL - * Fixed citation for Slotman _et al._ (2022) in CITATION + * Added `hoover()` function to compute the aspatial racial/ethnic Delta (DEL) based on [Hoover (1941)](https://doi.org/10.1017/S0022050700052980) and Duncan et al. (1961; LC:60007089) + * Fixed bug in `bell()`, `bemanian_beyer()`, `duncan()`, `sudano()`, and `white()` when a smaller geography contains n=0 total population, will assign a value of zero (0) in the internal calculation instead of NA + * 'package.R' deprecated. Replaced with 'ndi-package.R'. + * Re-formatted code and documentation throughout for consistent readability + * Updated documentation about value range of V (White) from `{0 to 1}` to `{-Inf to Inf}` + * Updated examples in vignette (& README) an example for `hoover()` and a larger variety of U.S. states * Documentation for DESCRIPTION, README, NEWS, and vignette references the following DOIs, which throws a NOTE but are a valid URL: * @@ -15,10 +17,10 @@ * * -* Some tests and examples for `anthopolos()`, `atkinson()`, `bell()`, `bemanian_beyer()`, `bravo()`, `duncan()`, `gini()`, `krieger()`, `messer()`, `powell_wiley()`, `sudano()`, and `white()` functions require a Census API key so they are skipped if NULL or not run +* Some tests and examples for `anthopolos()`, `atkinson()`, `bell()`, `bemanian_beyer()`, `bravo()`, `duncan()`, `gini()`, `hoover()`, `krieger()`, `messer()`, `powell_wiley()`, `sudano()`, and `white()` functions require a Census API key so they are skipped if NULL or not run ## Test environments -* local Windows install, R 4.2.1 +* local Windows install, R 4.4.0 * win-builder, (devel, release, oldrelease) * Rhub * Fedora Linux, R-devel, clang, gfortran diff --git a/vignettes/vignette.Rmd b/vignettes/vignette.Rmd index 1cdfcc0..71315e2 100644 --- a/vignettes/vignette.Rmd +++ b/vignettes/vignette.Rmd @@ -1,7 +1,7 @@ --- -title: "ndi: Neighborhood Deprivation Indices" +title: 'ndi: Neighborhood Deprivation Indices' author: 'Ian D. Buller (GitHub: @idblr)' -date: "`r Sys.Date()`" +date: '`r Sys.Date()`' output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{ndi: Neighborhood Deprivation Indices} @@ -11,13 +11,13 @@ vignette: > ```{r setup, include = FALSE} library(knitr) -knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, cache = FALSE, fig.show = "hold") +knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, cache = FALSE, fig.show = 'hold') ``` Start with the necessary packages for the vignette. ```{r packages, results = 'hide'} -loadedPackages <- c("dplyr", "ggplot2", "ndi", "tidycensus", "tigris") +loadedPackages <- c('dplyr', 'ggplot2', 'ndi', 'tidycensus', 'tigris') invisible(lapply(loadedPackages, library, character.only = TRUE)) options(tigris_use_cache = TRUE) ``` @@ -25,12 +25,12 @@ options(tigris_use_cache = TRUE) Set your U.S. Census Bureau access key. Follow [this link](http://api.census.gov/data/key_signup.html) to obtain one. Specify your access key in the `messer()` or `powell_wiley()` functions using the `key` argument of the `get_acs()` function from the `tidycensus` package called within each or by using the `census_api_key()` function from the `tidycensus` package before running the `messer()` or `powell_wiley()` functions (see an example of the latter below). ```{r access_key_private, echo = FALSE} -source("../dev/private_key.R") -tidycensus::census_api_key(private_key) +source(file.path('..', 'dev', 'private_key.R')) +census_api_key(private_key) ``` ```{r access_key_public, eval = FALSE} -tidycensus::census_api_key("...") # INSERT YOUR OWN KEY FROM U.S. CENSUS API +census_api_key('...') # INSERT YOUR OWN KEY FROM U.S. CENSUS API ``` ### Compute NDI (Messer) @@ -49,7 +49,7 @@ Compute the NDI (Messer) values (2006-2010 5-year ACS) for Georgia, U.S.A., cens | EMP | Employment | B23001 (2010 only); B23025 (2011 onward) | Percent unemployed | ```{r messer, results = 'hide'} -messer2010GA <- ndi::messer(state = "GA", year = 2010, round_output = TRUE) +messer2010GA <- messer(state = 'GA', year = 2010, round_output = TRUE) ``` One output from the `messer()` function is a tibble containing the identification, geographic name, NDI (Messer) values, and raw census characteristics for each tract. @@ -73,106 +73,134 @@ messer2010GA$missing We can visualize the NDI (Messer) values geographically by linking them to spatial information from the `tigris` package and plotting with the `ggplot2` package suite. ```{r messer_prep, results = 'hide'} -# Obtain the 2010 counties from the "tigris" package -county2010GA <- tigris::counties(state = "GA", year = 2010, cb = TRUE) +# Obtain the 2010 counties from the 'tigris' package +county2010GA <- counties(state = 'GA', year = 2010, cb = TRUE) # Remove first 9 characters from GEOID for compatibility with tigris information county2010GA$GEOID <- substring(county2010GA$GEO_ID, 10) -# Obtain the 2010 census tracts from the "tigris" package -tract2010GA <- tigris::tracts(state = "GA", year = 2010, cb = TRUE) +# Obtain the 2010 census tracts from the 'tigris' package +tract2010GA <- tracts(state = 'GA', year = 2010, cb = TRUE) # Remove first 9 characters from GEOID for compatibility with tigris information tract2010GA$GEOID <- substring(tract2010GA$GEO_ID, 10) # Join the NDI (Messer) values to the census tract geometry -GA2010messer <- dplyr::left_join(tract2010GA, messer2010GA$ndi, by = "GEOID") +GA2010messer <- tract2010GA %>% + left_join(messer2010GA$ndi, by = 'GEOID') ``` ```{r messer_plot, fig.height = 7, fig.width = 7} # Visualize the NDI (Messer) values (2006-2010 5-year ACS) for Georgia, U.S.A., census tracts ## Continuous Index -ggplot2::ggplot() + - ggplot2::geom_sf(data = GA2010messer, - ggplot2::aes(fill = NDI), - size = 0.05, - color = "transparent") + - ggplot2::geom_sf(data = county2010GA, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Messer)", - subtitle = "GA census tracts as the referent") +ggplot() + + geom_sf( + data = GA2010messer, + aes(fill = NDI), + size = 0.05, + color = 'transparent' + ) + + geom_sf( + data = county2010GA, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Messer)', + subtitle = 'GA census tracts as the referent' + ) ## Categorical Index -### Rename "9-NDI not avail" level as NA for plotting -GA2010messer$NDIQuartNA <- factor(replace(as.character(GA2010messer$NDIQuart), - GA2010messer$NDIQuart == "9-NDI not avail", NA), - c(levels(GA2010messer$NDIQuart)[-5], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = GA2010messer, - ggplot2::aes(fill = NDIQuartNA), - size = 0.05, - color = "transparent") + - ggplot2::geom_sf(data = county2010GA, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey80") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Messer) Quartiles", - subtitle = "GA census tracts as the referent") +### Rename '9-NDI not avail' level as NA for plotting +GA2010messer$NDIQuartNA <- + factor( + replace( + as.character(GA2010messer$NDIQuart), + GA2010messer$NDIQuart == '9-NDI not avail', + NA + ), + c(levels(GA2010messer$NDIQuart)[-5], NA) + ) + +ggplot() + + geom_sf( + data = GA2010messer, + aes(fill = NDIQuartNA), + size = 0.05, + color = 'transparent' + ) + + geom_sf( + data = county2010GA, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') + + labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Messer) Quartiles', + subtitle = 'GA census tracts as the referent' + ) ``` The results above are at the tract level. The NDI (Messer) values can also be calculated at the county level. ```{r messer_county_prep, results = 'hide'} -messer2010GA_county <- ndi::messer(geo = "county", state = "GA", year = 2010) +messer2010GA_county <- messer(geo = 'county', state = 'GA', year = 2010) # Join the NDI (Messer) values to the county geometry -GA2010messer_county <- dplyr::left_join(county2010GA, messer2010GA_county$ndi, by = "GEOID") +GA2010messer_county <- county2010GA %>% + left_join(messer2010GA_county$ndi, by = 'GEOID') ``` ```{r messer_county_plot, fig.height = 7, fig.width = 7} # Visualize the NDI (Messer) values (2006-2010 5-year ACS) for Georgia, U.S.A., counties ## Continuous Index -ggplot2::ggplot() + - ggplot2::geom_sf(data = GA2010messer_county, - ggplot2::aes(fill = NDI), - size = 0.20, - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Messer)", - subtitle = "GA counties as the referent") +ggplot() + + geom_sf( + data = GA2010messer_county, + aes(fill = NDI), + size = 0.20, + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Messer)', + subtitle = 'GA counties as the referent' + ) ## Categorical Index -### Rename "9-NDI not avail" level as NA for plotting -GA2010messer_county$NDIQuartNA <- factor(replace(as.character(GA2010messer_county$NDIQuart), - GA2010messer_county$NDIQuart == "9-NDI not avail", NA), - c(levels(GA2010messer_county$NDIQuart)[-5], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = GA2010messer_county, - ggplot2::aes(fill = NDIQuartNA), - size = 0.20, - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey80") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Messer) Quartiles", - subtitle = "GA counties as the referent") +### Rename '9-NDI not avail' level as NA for plotting +GA2010messer_county$NDIQuartNA <- + factor( + replace( + as.character(GA2010messer_county$NDIQuart), + GA2010messer_county$NDIQuart == '9-NDI not avail', + NA + ), + c(levels(GA2010messer_county$NDIQuart)[-5], NA) + ) + +ggplot() + + geom_sf( + data = GA2010messer_county, + aes(fill = NDIQuartNA), + size = 0.20, + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') + + labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Messer) Quartiles', + subtitle = 'GA counties as the referent' + ) ``` ### Compute NDI (Powell-Wiley) @@ -198,7 +226,11 @@ Compute the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for Maryland, Virgi More information about the [codebook](https://gis.cancer.gov/research/NeighDeprvIndex_Methods.pdf) and [computation](https://gis.cancer.gov/research/NeighDeprvIndex_Methods.pdf) of the NDI (Powell-Wiley) can be found on a [GIS Portal for Cancer Research](https://gis.cancer.gov/research/files.html#soc-dep) website. ```{r powell_wiley, results = 'hide'} -powell_wiley2020DMVW <- ndi::powell_wiley(state = c("DC", "MD", "VA", "WV"), year = 2020, round_output = TRUE) +powell_wiley2020DMVW <- powell_wiley( + state = c('DC', 'MD', 'VA', 'WV'), + year = 2020, + round_output = TRUE +) ``` One output from the `powell_wiley()` function is a tibble containing the identification, geographic name, NDI (Powell-Wiley) values, and raw census characteristics for each tract. @@ -228,197 +260,242 @@ powell_wiley2020DMVW$cronbach We can visualize the NDI (Powell-Wiley) values geographically by linking them to spatial information from the `tigris` package and plotting with the `ggplot2` package suite. ```{r powell_wiley_prep, results = 'hide'} -# Obtain the 2020 counties from the "tigris" package -county2020 <- tigris::counties(cb = TRUE) -county2020DMVW <- county2020[county2020$STUSPS %in% c("DC", "MD", "VA", "WV"), ] - -# Obtain the 2020 census tracts from the "tigris" package -tract2020D <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) -tract2020M <- tigris::tracts(state = "MD", year = 2020, cb = TRUE) -tract2020V <- tigris::tracts(state = "VA", year = 2020, cb = TRUE) -tract2020W <- tigris::tracts(state = "WV", year = 2020, cb = TRUE) +# Obtain the 2020 counties from the 'tigris' package +county2020 <- counties(cb = TRUE) +county2020DMVW <- county2020[county2020$STUSPS %in% c('DC', 'MD', 'VA', 'WV'), ] + +# Obtain the 2020 census tracts from the 'tigris' package +tract2020D <- tracts(state = 'DC', year = 2020, cb = TRUE) +tract2020M <- tracts(state = 'MD', year = 2020, cb = TRUE) +tract2020V <- tracts(state = 'VA', year = 2020, cb = TRUE) +tract2020W <- tracts(state = 'WV', year = 2020, cb = TRUE) tracts2020DMVW <- rbind(tract2020D, tract2020M, tract2020V, tract2020W) # Join the NDI (Powell-Wiley) values to the census tract geometry -DMVW2020pw <- dplyr::left_join(tracts2020DMVW, powell_wiley2020DMVW$ndi, by = "GEOID") +DMVW2020pw <- tracts2020DMVW %>% + left_join(powell_wiley2020DMVW$ndi, by = 'GEOID') ``` ```{r powell_wiley_plot, fig.height = 4, fig.width = 7} # Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) ## Maryland, Virginia, Washington, D.C., and West Virginia, U.S.A., census tracts ## Continuous Index -ggplot2::ggplot() + - ggplot2::geom_sf(data = DMVW2020pw, - ggplot2::aes(fill = NDI), - color = NA) + - ggplot2::geom_sf(data = county2020DMVW, - fill = "transparent", - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c(na.value = "grey80") + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley)", - subtitle = "DC, MD, VA, and WV tracts as the referent") +ggplot() + + geom_sf( + data = DMVW2020pw, + aes(fill = NDI), + color = NA + ) + + geom_sf( + data = county2020DMVW, + fill = 'transparent', + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_c(na.value = 'grey80') + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Powell-Wiley)', + subtitle = 'DC, MD, VA, and WV tracts as the referent' + ) ## Categorical Index (Population-weighted quintiles) -### Rename "9-NDI not avail" level as NA for plotting -DMVW2020pw$NDIQuintNA <- factor(replace(as.character(DMVW2020pw$NDIQuint), - DMVW2020pw$NDIQuint == "9-NDI not avail", NA), - c(levels(DMVW2020pw$NDIQuint)[-6], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = DMVW2020pw, - ggplot2::aes(fill = NDIQuintNA), - color = NA) + - ggplot2::geom_sf(data = county2020DMVW, - fill = "transparent", - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey80") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2016-2020 estimates")+ - ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley) Population-weighted Quintiles", - subtitle = "DC, MD, VA, and WV tracts as the referent") +### Rename '9-NDI not avail' level as NA for plotting +DMVW2020pw$NDIQuintNA <- + factor(replace( + as.character(DMVW2020pw$NDIQuint), + DMVW2020pw$NDIQuint == '9-NDI not avail', + NA + ), + c(levels(DMVW2020pw$NDIQuint)[-6], NA)) + +ggplot() + + geom_sf(data = DMVW2020pw, aes(fill = NDIQuintNA), color = NA) + + geom_sf(data = county2020DMVW, fill = 'transparent', color = 'white') + + theme_minimal() + + scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') + + labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Powell-Wiley) Population-weighted Quintiles', + subtitle = 'DC, MD, VA, and WV tracts as the referent' + ) ``` Like the NDI (Messer), we also compute county-level NDI (Powell-Wiley). ```{r powell_wiley_county_prep, results = 'hide'} -# Obtain the 2020 counties from the "tigris" package -county2020DMVW <- tigris::counties(state = c("DC", "MD", "VA", "WV"), year = 2020, cb = TRUE) +# Obtain the 2020 counties from the 'tigris' package +county2020DMVW <- counties(state = c('DC', 'MD', 'VA', 'WV'), year = 2020, cb = TRUE) # NDI (Powell-Wiley) at the county level (2016-2020) -powell_wiley2020DMVW_county <- ndi::powell_wiley(geo = "county", - state = c("DC", "MD", "VA", "WV"), - year = 2020) +powell_wiley2020DMVW_county <- powell_wiley( + geo = 'county', + state = c('DC', 'MD', 'VA', 'WV'), + year = 2020 +) # Join the NDI (Powell-Wiley) values to the county geometry -DMVW2020pw_county <- dplyr::left_join(county2020DMVW, powell_wiley2020DMVW_county$ndi, by = "GEOID") +DMVW2020pw_county <- county2020DMVW %>% + left_join(powell_wiley2020DMVW_county$ndi, by = 'GEOID') ``` ```{r powell_wiley_county_plot, fig.height = 4, fig.width = 7} # Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) ## Maryland, Virginia, Washington, D.C., and West Virginia, U.S.A., counties ## Continuous Index -ggplot2::ggplot() + - ggplot2::geom_sf(data = DMVW2020pw_county, - ggplot2::aes(fill = NDI), - size = 0.20, - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley)", - subtitle = "DC, MD, VA, and WV counties as the referent") +ggplot() + + geom_sf( + data = DMVW2020pw_county, + aes(fill = NDI), + size = 0.20, + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Powell-Wiley)', + subtitle = 'DC, MD, VA, and WV counties as the referent' + ) ## Categorical Index -### Rename "9-NDI not avail" level as NA for plotting -DMVW2020pw_county$NDIQuintNA <- factor(replace(as.character(DMVW2020pw_county$NDIQuint), - DMVW2020pw_county$NDIQuint == "9-NDI not avail", NA), - c(levels(DMVW2020pw_county$NDIQuint)[-6], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = DMVW2020pw_county, - ggplot2::aes(fill = NDIQuint), - size = 0.20, - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey80") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley) Population-weighted Quintiles", - subtitle = "DC, MD, VA, and WV counties as the referent") +### Rename '9-NDI not avail' level as NA for plotting +DMVW2020pw_county$NDIQuintNA <- + factor( + replace( + as.character(DMVW2020pw_county$NDIQuint), + DMVW2020pw_county$NDIQuint == '9-NDI not avail', + NA + ), + c(levels(DMVW2020pw_county$NDIQuint)[-6], NA) + ) + +ggplot() + + geom_sf( + data = DMVW2020pw_county, + aes(fill = NDIQuint), + size = 0.20, + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') + + labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Powell-Wiley) Population-weighted Quintiles', + subtitle = 'DC, MD, VA, and WV counties as the referent' + ) ``` ### Advanced Features #### Imputing missing census variables -In the `messer()` and `powell_wiley()` functions, missing census characteristics can be imputed using the `missing` and `impute` arguments of the `pca()` function in the `psych` package called within the `messer()` and `powell_wiley()` functions. Impute values using the logical `imp` argument (currently only calls `impute = "median"` by default, which assigns the median values of each missing census variable for a geography). +In the `messer()` and `powell_wiley()` functions, missing census characteristics can be imputed using the `missing` and `impute` arguments of the `pca()` function in the `psych` package called within the `messer()` and `powell_wiley()` functions. Impute values using the logical `imp` argument (currently only calls `impute = 'median'` by default, which assigns the median values of each missing census variable for a geography). ```{r powell_wiley_imp, results = 'hide'} -powell_wiley2020DC <- ndi::powell_wiley(state = "DC", year = 2020) # without imputation -powell_wiley2020DCi <- ndi::powell_wiley(state = "DC", year = 2020, imp = TRUE) # with imputation +powell_wiley2020DC <- powell_wiley(state = 'DC', year = 2020) # without imputation +powell_wiley2020DCi <- powell_wiley(state = 'DC', year = 2020, imp = TRUE) # with imputation table(is.na(powell_wiley2020DC$ndi$NDI)) # n=13 tracts without NDI (Powell-Wiley) values table(is.na(powell_wiley2020DCi$ndi$NDI)) # n=0 tracts without NDI (Powell-Wiley) values -# Obtain the 2020 census tracts from the "tigris" package -tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE) +# Obtain the 2020 census tracts from the 'tigris' package +tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE) # Join the NDI (Powell-Wiley) values to the census tract geometry -DC2020pw <- dplyr::left_join(tract2020DC, powell_wiley2020DC$ndi, by = "GEOID") -DC2020pw <- dplyr::left_join(DC2020pw, powell_wiley2020DCi$ndi, by = "GEOID", suffix = c("_nonimp", "_imp")) +DC2020pw <- tract2020DC %>% + left_join(powell_wiley2020DC$ndi, by = 'GEOID') +DC2020pw <- DC2020pw %>% + left_join(powell_wiley2020DCi$ndi, by = 'GEOID', suffix = c('_nonimp', '_imp')) ``` ```{r powell_wiley_imp_plot, fig.height = 7, fig.width = 7} -# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for Washington, D.C., census tracts +# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for +## Washington, D.C., census tracts ## Continuous Index -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020pw, - ggplot2::aes(fill = NDI_nonimp), - size = 0.2, - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley), Non-Imputed", - subtitle = "DC census tracts as the referent") - -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020pw, - ggplot2::aes(fill = NDI_imp), - size = 0.2, - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley), Imputed", - subtitle = "DC census tracts as the referent") +ggplot() + + geom_sf( + data = DC2020pw, + aes(fill = NDI_nonimp), + size = 0.2, + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Powell-Wiley), Non-Imputed', + subtitle = 'DC census tracts as the referent' + ) + +ggplot() + + geom_sf( + data = DC2020pw, + aes(fill = NDI_imp), + size = 0.2, + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Powell-Wiley), Imputed', + subtitle = 'DC census tracts as the referent' + ) ## Categorical Index -### Rename "9-NDI not avail" level as NA for plotting -DC2020pw$NDIQuintNA_nonimp <- factor(replace(as.character(DC2020pw$NDIQuint_nonimp), - DC2020pw$NDIQuint_nonimp == "9-NDI not avail", NA), - c(levels(DC2020pw$NDIQuint_nonimp)[-6], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020pw, - ggplot2::aes(fill = NDIQuintNA_nonimp), - size = 0.2, - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey80") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley) Quintiles, Non-Imputed", - subtitle = "DC census tracts as the referent") - -### Rename "9-NDI not avail" level as NA for plotting -DC2020pw$NDIQuintNA_imp <- factor(replace(as.character(DC2020pw$NDIQuint_imp), - DC2020pw$NDIQuint_imp == "9-NDI not avail", NA), - c(levels(DC2020pw$NDIQuint_imp)[-6], NA)) - -ggplot2::ggplot() + - ggplot2::geom_sf(data = DC2020pw, - ggplot2::aes(fill = NDIQuintNA_imp), - size = 0.2, - color = "white") + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE), - na.value = "grey80") + - ggplot2::labs(fill = "Index (Categorical)", - caption = "Source: U.S. Census ACS 2016-2020 estimates") + - ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley) Quintiles, Imputed", - subtitle = "DC census tracts as the referent") +### Rename '9-NDI not avail' level as NA for plotting +DC2020pw$NDIQuintNA_nonimp <- + factor( + replace( + as.character(DC2020pw$NDIQuint_nonimp), + DC2020pw$NDIQuint_nonimp == '9-NDI not avail', + NA + ), + c(levels(DC2020pw$NDIQuint_nonimp)[-6], NA) + ) + +ggplot() + + geom_sf( + data = DC2020pw, + aes(fill = NDIQuintNA_nonimp), + size = 0.2, + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') + + labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Powell-Wiley) Quintiles, Non-Imputed', + subtitle = 'DC census tracts as the referent' + ) + +### Rename '9-NDI not avail' level as NA for plotting +DC2020pw$NDIQuintNA_imp <- + factor( + replace( + as.character(DC2020pw$NDIQuint_imp), + DC2020pw$NDIQuint_imp == '9-NDI not avail', + NA + ), + c(levels(DC2020pw$NDIQuint_imp)[-6], NA) + ) + +ggplot() + + geom_sf( + data = DC2020pw, + aes(fill = NDIQuintNA_imp), + size = 0.2, + color = 'white' + ) + + theme_minimal() + + scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') + + labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') + + ggtitle( + 'Neighborhood Deprivation Index (Powell-Wiley) Quintiles, Imputed', + subtitle = 'DC census tracts as the referent' + ) ``` #### Assign the referent (U.S.-Standardized Metric) @@ -426,25 +503,30 @@ ggplot2::ggplot() + To conduct a contiguous US-standardized index, compute an NDI for all states as in the example below that replicates the nationally standardized NDI (Powell-Wiley) values (2013-2017 ACS-5) found in [Slotman et al. (2022)](https://doi.org/10.1016/j.dib.2022.108002) and available from a [GIS Portal for Cancer Research](https://gis.cancer.gov/research/files.html#soc-dep) website. To replicate the nationally standardized NDI (Powell-Wiley) values (2006-2010 ACS-5) found in [Andrews et al. (2020)](https://doi.org/10.1080/17445647.2020.1750066) change the `year` argument to `2010` (i.e., `year = 2010`). ```{r national_prep, results = 'hide'} -us <- tigris::states() -n51 <- c("Commonwealth of the Northern Mariana Islands", "Guam", "American Samoa", - "Puerto Rico", "United States Virgin Islands") +us <- states() +n51 <- c( + 'Commonwealth of the Northern Mariana Islands', + 'Guam', + 'American Samoa', + 'Puerto Rico', + 'United States Virgin Islands' +) y51 <- us$STUSPS[!(us$NAME %in% n51)] start_time <- Sys.time() # record start time -powell_wiley2017US <- ndi::powell_wiley(state = y51, year = 2017) +powell_wiley2017US <- powell_wiley(state = y51, year = 2017) end_time <- Sys.time() # record end time time_srr <- end_time - start_time # Calculate run time ``` ```{r national_hist, fig.height = 7, fig.width = 7} -ggplot2::ggplot(powell_wiley2017US$ndi, - ggplot2::aes(x = NDI)) + - ggplot2::geom_histogram(color = "black", - fill = "white") + - ggplot2::theme_minimal() + - ggplot2::ggtitle("Histogram of US-standardized NDI (Powell-Wiley) values (2013-2017)", - subtitle = "U.S. census tracts as the referent (including AK, HI, and DC)") +ggplot(powell_wiley2017US$ndi, aes(x = NDI)) + + geom_histogram(color = 'black', fill = 'white') + + theme_minimal() + + ggtitle( + 'Histogram of US-standardized NDI (Powell-Wiley) values (2013-2017)', + subtitle = 'U.S. census tracts as the referent (including AK, HI, and DC)' + ) ``` The process to compute a US-standardized NDI (Powell-Wiley) took about `r round(time_srr, digits = 1)` minutes to run on a machine with the features listed at the end of the vignette. @@ -463,6 +545,7 @@ Since version v0.1.1, the `ndi` package can compute additional metrics of socio- 8. `white()` function that computes the aspatial racial/ethnic Correlation Ratio based on [Bell (1954)](https://doi.org/10.2307/2574118) and [White (1986)](https://doi.org/10.2307/3644339) 9. `sudano()` function that computes the aspatial racial/ethnic Location Quotient based on [Merton (1939)](https://doi.org/10.2307/2084686) and [Sudano et al. (2013)](https://doi.org/10.1016/j.healthplace.2012.09.015) 10. `bemanian_beyer()` function that computes the aspatial racial/ethnic Local Exposure and Isolation metric based on [Bemanian & Beyer (2017)](https://doi.org/10.1158/1055-9965.EPI-16-0926) +11. `hoover()` function that computes the aspatial racial/ethnic Delta based on [Hoover (1941)](https://doi.org/10.1017/S0022050700052980) and Duncan et al. (1961; LC:60007089) #### Compute Racial Isolation Index (RI) @@ -494,83 +577,99 @@ Compute the spatial RI values (2006-2010 5-year ACS) for North Carolina, U.S.A. A census geography (and its neighbors) that has nearly all of its population who identify with the specified race/ethnicity subgroup(s) (e.g., Not Hispanic or Latino, Black or African American alone) will have an RI value close to 1. In contrast, a census geography (and its neighbors) that is nearly none of its population who identify with the specified race/ethnicity subgroup(s) (e.g., not Not Hispanic or Latino, Black or African American alone) will have an RI value close to 0. ```{r anthopolos_prep, results = 'hide'} -anthopolos2010NC <- ndi::anthopolos(state = "NC", year = 2010, subgroup = "NHoLB") +anthopolos2010NC <- anthopolos(state = 'NC', year = 2010, subgroup = 'NHoLB') -# Obtain the 2010 census tracts from the "tigris" package -tract2010NC <- tigris::tracts(state = "NC", year = 2010, cb = TRUE) +# Obtain the 2010 census tracts from the 'tigris' package +tract2010NC <- tracts(state = 'NC', year = 2010, cb = TRUE) # Remove first 9 characters from GEOID for compatibility with tigris information tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) -# Obtain the 2010 counties from the "tigris" package -county2010NC <- tigris::counties(state = "NC", year = 2010, cb = TRUE) +# Obtain the 2010 counties from the 'tigris' package +county2010NC <- counties(state = 'NC', year = 2010, cb = TRUE) # Join the RI values to the census tract geometry -NC2010anthopolos <- dplyr::left_join(tract2010NC, anthopolos2010NC$ri, by = "GEOID") +NC2010anthopolos <- tract2010NC %>% + left_join(anthopolos2010NC$ri, by = 'GEOID') ``` ```{r anthopolos_plot, fig.height = 4, fig.width = 7} # Visualize the RI values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts -ggplot2::ggplot() + - ggplot2::geom_sf(data = NC2010anthopolos, - ggplot2::aes(fill = RI), - size = 0.05, - color = "transparent") + - ggplot2::geom_sf(data = county2010NC, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Racial Isolation Index (Anthopolos), non-Hispanic Black", - subtitle = "NC census tracts (not corrected for edge effects)") +ggplot() + + geom_sf( + data = NC2010anthopolos, + aes(fill = RI), + size = 0.05, + color = 'transparent' + ) + + geom_sf( + data = county2010NC, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Racial Isolation Index (Anthopolos), non-Hispanic Black', + subtitle = 'NC census tracts (not corrected for edge effects)' + ) ``` The current version of the `ndi` package does not correct for edge effects (e.g., census geographies along the specified spatial extent border, coastline, or U.S.-Mexico / U.S.-Canada border) may have few neighboring census geographies, and RI values in these census geographies may be unstable. A stop-gap solution for the former source of edge effect is to compute the RI for neighboring census geographies (i.e., the states bordering a study area of interest) and then use the estimates of the study area of interest. ```{r anthopolos_edge_prep, results = 'hide'} # Compute RI for all census tracts in neighboring states -anthopolos2010GNSTV <- ndi::anthopolos(state = c("GA", "NC", "SC", "TN", "VA"), - year = 2010, subgroup = "NHoLB") +anthopolos2010GNSTV <- anthopolos( + state = c('GA', 'NC', 'SC', 'TN', 'VA'), + year = 2010, + subgroup = 'NHoLB' +) # Crop to only North Carolina, U.S.A. census tracts -anthopolos2010NCe <- anthopolos2010GNSTV$ri[anthopolos2010GNSTV$ri$GEOID %in% anthopolos2010NC$ri$GEOID, ] +anthopolos2010NCe <- anthopolos2010GNSTV$ri[anthopolos2010GNSTV$ri$GEOID %in% + anthopolos2010NC$ri$GEOID, ] -# Obtain the 2010 census tracts from the "tigris" package -tract2010NC <- tigris::tracts(state = "NC", year = 2010, cb = TRUE) +# Obtain the 2010 census tracts from the 'tigris' package +tract2010NC <- tracts(state = 'NC', year = 2010, cb = TRUE) # Remove first 9 characters from GEOID for compatibility with tigris information tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) -# Obtain the 2010 counties from the "tigris" package -county2010NC <- tigris::counties(state = "NC", year = 2010, cb = TRUE) +# Obtain the 2010 counties from the 'tigris' package +county2010NC <- counties(state = 'NC', year = 2010, cb = TRUE) # Join the RI values to the census tract geometry -edgeNC2010anthopolos <- dplyr::left_join(tract2010NC, anthopolos2010NCe, by = "GEOID") +edgeNC2010anthopolos <- tract2010NC %>% + left_join(anthopolos2010NCe, by = 'GEOID') ``` ```{r anthopolos_edge_plot, fig.height = 4, fig.width = 7} # Visualize the RI values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts -ggplot2::ggplot() + - ggplot2::geom_sf(data = edgeNC2010anthopolos, - ggplot2::aes(fill = RI), - size = 0.05, - color = "transparent") + - ggplot2::geom_sf(data = county2010NC, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Racial Isolation Index (Anthopolos), non-Hispanic Black", - subtitle = "NC census tracts (corrected for interstate edge effects)") +ggplot() + + geom_sf( + data = edgeNC2010anthopolos, + aes(fill = RI), + size = 0.05, + color = 'transparent' + ) + + geom_sf( + data = county2010NC, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Racial Isolation Index (Anthopolos), non-Hispanic Black', + subtitle = 'NC census tracts (corrected for interstate edge effects)' + ) ``` #### Compute Educational Isolation Index (EI) -Compute the spatial EI (Bravo) values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts. This metric is based on [Bravo et al. (2021)](https://doi.org/10.3390/ijerph18179384) that assessed the educational isolation of the population without a four-year college degree. Multiple educational attainment categories are available in the `bravo()` function, including: +Compute the spatial EI (Bravo) values (2006-2010 5-year ACS) for Oklahoma, U.S.A., census tracts. This metric is based on [Bravo et al. (2021)](https://doi.org/10.3390/ijerph18179384) that assessed the educational isolation of the population without a four-year college degree. Multiple educational attainment categories are available in the `bravo()` function, including: | ACS table source | educational attainment category | character for `subgroup` argument | | -------------- | ------------- | ---------------- | @@ -579,84 +678,93 @@ Compute the spatial EI (Bravo) values (2006-2010 5-year ACS) for North Carolina, | B06009_004 | some college or associate's degree | SCoAD | | B06009_005 | Bachelor's degree | BD | | B06009_006 | graduate or professional degree | GoPD | -Note: The ACS-5 data (2005-2009) uses the "B15002" question. +Note: The ACS-5 data (2005-2009) uses the 'B15002' question. A census geography (and its neighbors) that has nearly all of its population with the specified educational attainment category (e.g., a four-year college degree or more) will have an EI (Bravo) value close to 1. In contrast, a census geography (and its neighbors) that is nearly none of its population with the specified educational attainment category (e.g., with a four-year college degree) will have an EI (Bravo) value close to 0. ```{r bravo_prep, results = 'hide'} -bravo2010NC <- ndi::bravo(state = "NC", year = 2010, subgroup = c("LtHS", "HSGiE", "SCoAD")) +bravo2010OK <- bravo(state = 'OK', year = 2010, subgroup = c('LtHS', 'HSGiE', 'SCoAD')) -# Obtain the 2010 census tracts from the "tigris" package -tract2010NC <- tigris::tracts(state = "NC", year = 2010, cb = TRUE) +# Obtain the 2010 census tracts from the 'tigris' package +tract2010OK <- tracts(state = 'OK', year = 2010, cb = TRUE) # Remove first 9 characters from GEOID for compatibility with tigris information -tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) +tract2010OK$GEOID <- substring(tract2010OK$GEO_ID, 10) -# Obtain the 2010 counties from the "tigris" package -county2010NC <- tigris::counties(state = "NC", year = 2010, cb = TRUE) +# Obtain the 2010 counties from the 'tigris' package +county2010OK <- counties(state = 'OK', year = 2010, cb = TRUE) # Join the EI (Bravo) values to the census tract geometry -NC2010bravo <- dplyr::left_join(tract2010NC, bravo2010NC$ei, by = "GEOID") +OK2010bravo <- tract2010OK %>% + left_join(bravo2010OK$ei, by = 'GEOID') ``` ```{r bravo_plot, fig.height = 4, fig.width = 7} -# Visualize the EI (Bravo) values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts -ggplot2::ggplot() + - ggplot2::geom_sf(data = NC2010bravo, - ggplot2::aes(fill = EI), - size = 0.05, - color = "transparent") + - ggplot2::geom_sf(data = county2010NC, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Educational Isolation Index (Bravo), without a four-year college degree", - subtitle = "NC census tracts (not corrected for edge effects)") +# Visualize the EI (Bravo) values (2006-2010 5-year ACS) for Oklahoma, U.S.A., census tracts +ggplot() + + geom_sf( + data = OK2010bravo, + aes(fill = EI), + size = 0.05, + color = 'transparent' + ) + + geom_sf( + data = county2010OK, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Educational Isolation Index (Bravo), without a four-year college degree', + subtitle = 'OK census tracts (not corrected for edge effects)' + ) ``` Can correct one source of edge effect in the same manner as shown for the RI metric. #### Retrieve the Gini Index -Retrieve the aspatial Gini Index values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts. This metric is based on [Gini (1921)](https://doi.org/10.2307/2223319), and the `gini()` function retrieves the estimate from the ACS-5. +Retrieve the aspatial Gini Index values (2006-2010 5-year ACS) for Massachusetts, U.S.A., census tracts. This metric is based on [Gini (1921)](https://doi.org/10.2307/2223319), and the `gini()` function retrieves the estimate from the ACS-5. -According to the [U.S. Census Bureau](https://census.gov/topics/income-poverty/income-inequality/about/metrics/gini-index.html): "The Gini Index is a summary measure of income inequality. The Gini coefficient incorporates the detailed shares data into a single statistic, which summarizes the dispersion of income across the entire income distribution. The Gini coefficient ranges from 0, indicating perfect equality (where everyone receives an equal share), to 1, perfect inequality (where only one recipient or group of recipients receives all the income). The Gini is based on the difference between the Lorenz curve (the observed cumulative income distribution) and the notion of a perfectly equal income distribution." +According to the [U.S. Census Bureau](https://census.gov/topics/income-poverty/income-inequality/about/metrics/gini-index.html): 'The Gini Index is a summary measure of income inequality. The Gini coefficient incorporates the detailed shares data into a single statistic, which summarizes the dispersion of income across the entire income distribution. The Gini coefficient ranges from 0, indicating perfect equality (where everyone receives an equal share), to 1, perfect inequality (where only one recipient or group of recipients receives all the income). The Gini is based on the difference between the Lorenz curve (the observed cumulative income distribution) and the notion of a perfectly equal income distribution.' ```{r gini_prep, results = 'hide'} -gini2010NC <- ndi::gini(state = "NC", year = 2010) +gini2010MA <- gini(state = 'MA', year = 2010) -# Obtain the 2010 census tracts from the "tigris" package -tract2010NC <- tigris::tracts(state = "NC", year = 2010, cb = TRUE) +# Obtain the 2010 census tracts from the 'tigris' package +tract2010MA <- tracts(state = 'MA', year = 2010, cb = TRUE) # Remove first 9 characters from GEOID for compatibility with tigris information -tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) +tract2010MA$GEOID <- substring(tract2010MA$GEO_ID, 10) -# Obtain the 2010 counties from the "tigris" package -county2010NC <- tigris::counties(state = "NC", year = 2010, cb = TRUE) +# Obtain the 2010 counties from the 'tigris' package +county2010MA <- counties(state = 'MA', year = 2010, cb = TRUE) # Join the Gini Index values to the census tract geometry -NC2010gini <- dplyr::left_join(tract2010NC, gini2010NC$gini, by = "GEOID") +MA2010gini <- tract2010MA %>% + left_join(gini2010MA$gini, by = 'GEOID') ``` ```{r gini_plot, fig.height = 4, fig.width = 7} -# Visualize the Gini Index values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts -ggplot2::ggplot() + - ggplot2::geom_sf(data = NC2010gini, - ggplot2::aes(fill = gini), - size = 0.05, - color = "transparent") + - ggplot2::geom_sf(data = county2010NC, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Gini Index", - subtitle = "NC census tracts") +# Visualize the Gini Index values (2006-2010 5-year ACS) for Massachusetts, U.S.A., census tracts +ggplot() + + geom_sf( + data = MA2010gini, + aes(fill = gini), + size = 0.05, + color = 'transparent' + ) + + geom_sf( + data = county2010MA, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle('Gini Index', subtitle = 'MA census tracts') ``` ### Index of Concentration at the Extremes (ICE) @@ -665,93 +773,135 @@ Compute the aspatial Index of Concentration at the Extremes values (2006-2010 5- | ACS table group | ICE metric | Comparison | -------------- | ------------- | ---------------- | -| B19001 | Income, "ICE_inc"| 80th income percentile vs. 20th income percentile | -| B15002 | Education, "ICE_edu"| less than high school vs. four-year college degree or more | -| B03002 | Race/Ethnicity, "ICE_rewb"| 80th income percentile vs. 20th income percentile | -| B19001 & B19001B & B19001H | Income and race/ethnicity combined, "ICE_wbinc" | white non-Hispanic in 80th income percentile vs. black alone (including Hispanic) in 20th income percentile | -| B19001 & B19001H | Income and race/ethnicity combined, "ICE_wpcinc"| white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile | +| B19001 | Income, 'ICE_inc'| 80th income percentile vs. 20th income percentile | +| B15002 | Education, 'ICE_edu'| less than high school vs. four-year college degree or more | +| B03002 | Race/Ethnicity, 'ICE_rewb'| 80th income percentile vs. 20th income percentile | +| B19001 & B19001B & B19001H | Income and race/ethnicity combined, 'ICE_wbinc' | white non-Hispanic in 80th income percentile vs. black alone (including Hispanic) in 20th income percentile | +| B19001 & B19001H | Income and race/ethnicity combined, 'ICE_wpcinc'| white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile | ICE metrics can range in value from −1 (most deprived) to 1 (most privileged). A value of 0 can thus represent two possibilities: (1) none of the residents are in the most privileged or most deprived categories, or (2) an equal number of persons are in the most privileged and most deprived categories, and in both cases indicates that the area is not dominated by extreme concentrations of either of the two groups. ```{r krieger_prep, results = 'hide'} -ice2020WC <- krieger(state = "MI", county = "Wayne", year = 2010) +ice2020WC <- krieger(state = 'MI', county = 'Wayne', year = 2010) -# Obtain the 2010 census tracts from the "tigris" package -tract2010WC <- tigris::tracts(state = "MI", county = "Wayne", year = 2010, cb = TRUE) +# Obtain the 2010 census tracts from the 'tigris' package +tract2010WC <- tracts(state = 'MI', county = 'Wayne', year = 2010, cb = TRUE) # Remove first 9 characters from GEOID for compatibility with tigris information tract2010WC$GEOID <- substring(tract2010WC$GEO_ID, 10) # Join the ICE values to the census tract geometry -ice2020WC <- dplyr::left_join(tract2010WC, ice2020WC$ice, by = "GEOID") +ice2020WC <- tract2010WC %>% + left_join(ice2020WC$ice, by = 'GEOID') ``` ```{r krieger_plot, fig.height = 5.5, fig.width = 7} # Plot ICE for Income -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020WC, - ggplot2::aes(fill = ICE_inc), - color = "white", - size = 0.05) + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1,1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome (Krieger)", - subtitle = "80th income percentile vs. 20th income percentile") +ggplot() + + geom_sf( + data = ice2020WC, + aes(fill = ICE_inc), + color = 'white', + size = 0.05 + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Index of Concentration at the Extremes\nIncome (Krieger)', + subtitle = '80th income percentile vs. 20th income percentile' + ) # Plot ICE for Education -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020WC, - ggplot2::aes(fill = ICE_edu), - color = "white", - size = 0.05) + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1,1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nEducation (Krieger)", - subtitle = "less than high school vs. four-year college degree or more") +ggplot() + + geom_sf( + data = ice2020WC, + aes(fill = ICE_edu), + color = 'white', + size = 0.05 + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Index of Concentration at the Extremes\nEducation (Krieger)', + subtitle = 'less than high school vs. four-year college degree or more' + ) # Plot ICE for Race/Ethnicity -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020WC, - ggplot2::aes(fill = ICE_rewb), - color = "white", - size = 0.05) + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nRace/Ethnicity (Krieger)", - subtitle = "white non-Hispanic vs. black non-Hispanic") +ggplot() + + geom_sf( + data = ice2020WC, + aes(fill = ICE_rewb), + color = 'white', + size = 0.05 + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Index of Concentration at the Extremes\nRace/Ethnicity (Krieger)', + subtitle = 'white non-Hispanic vs. black non-Hispanic' + ) # Plot ICE for Income and Race/Ethnicity Combined -## white non-Hispanic in 80th income percentile vs. black (including Hispanic) in 20th income percentile -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020WC, - ggplot2::aes(fill = ICE_wbinc), - color = "white", - size = 0.05) + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome & race/ethnicity combined (Krieger)", - subtitle = "white non-Hispanic in 80th inc ptcl vs. black alone in 20th inc pctl") +## white non-Hispanic in 80th income percentile vs. +## black (including Hispanic) in 20th income percentile +ggplot() + + geom_sf( + data = ice2020WC, + aes(fill = ICE_wbinc), + color = 'white', + size = 0.05 + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Index of Concentration at the Extremes\nIncome & race/ethnicity combined (Krieger)', + subtitle = 'white non-Hispanic in 80th inc ptcl vs. black alone in 20th inc pctl' + ) # Plot ICE for Income and Race/Ethnicity Combined ## white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile -ggplot2::ggplot() + - ggplot2::geom_sf(data = ice2020WC, - ggplot2::aes(fill = ICE_wpcinc), - color = "white", - size = 0.05) + - ggplot2::theme_bw() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates")+ - ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome & race/ethnicity combined (Krieger)", - subtitle = "white non-Hispanic (WNH) in 80th inc pctl vs. WNH in 20th inc pctl") +ggplot() + + geom_sf( + data = ice2020WC, + aes(fill = ICE_wpcinc), + color = 'white', + size = 0.05 + ) + + theme_bw() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340', + limits = c(-1, 1) + ) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Index of Concentration at the Extremes\nIncome & race/ethnicity combined (Krieger)', + subtitle = 'white non-Hispanic (WNH) in 80th inc pctl vs. WNH in 20th inc pctl' + ) ``` #### Compute racial/ethnic Dissimilarity Index (DI) @@ -784,40 +934,52 @@ Compute the aspatial racial/ethnic DI values (2006-2010 5-year ACS) for Pennsylv DI is a measure of the evenness of racial/ethnic residential segregation when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. DI can range in value from 0 to 1 and represents the proportion of racial/ethnic subgroup members that would have to change their area of residence to achieve an even distribution within the larger geographical area under conditions of maximum segregation. ```{r duncan_prep, results = 'hide'} -duncan2010PA <- ndi::duncan(geo_large = "county", geo_small = "tract", state = "PA", - year = 2010, subgroup = "NHoLB", subgroup_ref = "NHoLW") - -# Obtain the 2010 census counties from the "tigris" package -county2010PA <- tigris::counties(state = "PA", year = 2010, cb = TRUE) +duncan2010PA <- duncan( + geo_large = 'county', + geo_small = 'tract', + state = 'PA', + year = 2010, + subgroup = 'NHoLB', + subgroup_ref = 'NHoLW' +) + +# Obtain the 2010 census counties from the 'tigris' package +county2010PA <- counties(state = 'PA', year = 2010, cb = TRUE) # Remove first 9 characters from GEOID for compatibility with tigris information county2010PA$GEOID <- substring(county2010PA$GEO_ID, 10) # Join the DI values to the county geometry -PA2010duncan <- dplyr::left_join(county2010PA, duncan2010PA$di, by = "GEOID") +PA2010duncan <- county2010PA %>% + left_join(duncan2010PA$di, by = 'GEOID') ``` ```{r duncan_plot, fig.height = 4, fig.width = 7} # Visualize the DI values (2006-2010 5-year ACS) for Pennsylvania, U.S.A., counties -ggplot2::ggplot() + - ggplot2::geom_sf(data = PA2010duncan, - ggplot2::aes(fill = DI), - size = 0.05, - color = "white") + - ggplot2::geom_sf(data = county2010PA, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2006-2010 estimates") + - ggplot2::ggtitle("Dissimilarity Index (Duncan & Duncan)\nPennsylvania census tracts to counties", - subtitle = "Black non-Hispanic vs. white non-Hispanic") +ggplot() + + geom_sf( + data = PA2010duncan, + aes(fill = DI), + size = 0.05, + color = 'white' + ) + + geom_sf( + data = county2010PA, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') + + ggtitle( + 'Dissimilarity Index (Duncan & Duncan)\nPennsylvania census tracts to counties', + subtitle = 'Black non-Hispanic vs. white non-Hispanic' + ) ``` #### Compute aspatial income or racial/ethnic Atkinson Index (AI) -Compute the aspatial income or racial/ethnic AI values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties from census block groups. This metric is based on [Atkinson (1970)](https://doi.org/10.2307/2088328) that assessed the distribution of income within 12 counties but has since been adapted to study racial/ethnic segregation (see [James & Taeuber 1985](https://doi.org/10.2307/270845)). To compare median household income, specify `subgroup = "MedHHInc"` which will use the ACS-5 variable "B19013_001" in the computation. Multiple racial/ethnic subgroups are available in the `atkinson()` function, including: +Compute the aspatial income or racial/ethnic AI values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties from census block groups. This metric is based on [Atkinson (1970)](https://doi.org/10.2307/2088328) that assessed the distribution of income within 12 counties but has since been adapted to study racial/ethnic segregation (see [James & Taeuber 1985](https://doi.org/10.2307/270845)). To compare median household income, specify `subgroup = 'MedHHInc'` which will use the ACS-5 variable 'B19013_001' in the computation. Multiple racial/ethnic subgroups are available in the `atkinson()` function, including: | ACS table source | racial/ethnic subgroup | character for `subgroup` argument | | -------------- | ------------- | ---------------- | @@ -844,41 +1006,53 @@ Compute the aspatial income or racial/ethnic AI values (2017-2021 5-year ACS) fo AI is a measure of the inequality and, in the context of residential race/ethnicity, segregation when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. AI can range in value from 0 to 1 and smaller values of the index indicate lower levels of inequality (e.g., less segregation). -AI is sensitive to the choice of `epsilon` argument or the shape parameter that determines how to weight the increments to inequality (segregation) contributed by different proportions of the Lorenz curve. A user must explicitly decide how heavily to weight smaller geographical units at different points on the Lorenz curve (i.e., whether the index should take greater account of differences among areas of over- or under-representation). The `epsilon` argument must have values between 0 and 1.0. For `0 <= epsilon < 0.5` or less "inequality-averse," smaller geographical units with a subgroup proportion smaller than the subgroup proportion of the larger geographical unit contribute more to inequality ("over-representation"). For `0.5 < epsilon <= 1.0` or more "inequality-averse," smaller geographical units with a subgroup proportion larger than the subgroup proportion of the larger geographical unit contribute more to inequality ("under-representation"). If `epsilon = 0.5` (the default), units of over- and under-representation contribute equally to the index. See Section 2.3 of [Saint-Jacques et al. (2020)](https://doi.org/10.48550/arXiv.2002.05819) for one method to select `epsilon`. We choose `epsilon = 0.67` in the example below: +AI is sensitive to the choice of `epsilon` argument or the shape parameter that determines how to weight the increments to inequality (segregation) contributed by different proportions of the Lorenz curve. A user must explicitly decide how heavily to weight smaller geographical units at different points on the Lorenz curve (i.e., whether the index should take greater account of differences among areas of over- or under-representation). The `epsilon` argument must have values between 0 and 1.0. For `0 <= epsilon < 0.5` or less 'inequality-averse,' smaller geographical units with a subgroup proportion smaller than the subgroup proportion of the larger geographical unit contribute more to inequality ('over-representation'). For `0.5 < epsilon <= 1.0` or more 'inequality-averse,' smaller geographical units with a subgroup proportion larger than the subgroup proportion of the larger geographical unit contribute more to inequality ('under-representation'). If `epsilon = 0.5` (the default), units of over- and under-representation contribute equally to the index. See Section 2.3 of [Saint-Jacques et al. (2020)](https://doi.org/10.48550/arXiv.2002.05819) for one method to select `epsilon`. We choose `epsilon = 0.67` in the example below: ```{r atkinson_prep, results = 'hide'} -atkinson2021KY <- ndi::atkinson(geo_large = "county", geo_small = "block group", state = "KY", - year = 2021, subgroup = "NHoLB", epsilon = 0.67) - -# Obtain the 2021 census counties from the "tigris" package -county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE) +atkinson2021KY <- atkinson( + geo_large = 'county', + geo_small = 'block group', + state = 'KY', + year = 2021, + subgroup = 'NHoLB', + epsilon = 0.67 +) + +# Obtain the 2021 census counties from the 'tigris' package +county2021KY <- counties(state = 'KY', year = 2021, cb = TRUE) # Join the AI values to the county geometry -KY2021atkinson <- dplyr::left_join(county2021KY, atkinson2021KY$ai, by = "GEOID") +KY2021atkinson <- county2021KY %>% + left_join(atkinson2021KY$ai, by = 'GEOID') ``` ```{r atkinson_plot, fig.height = 4, fig.width = 7} # Visualize the AI values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties -ggplot2::ggplot() + - ggplot2::geom_sf(data = KY2021atkinson, - ggplot2::aes(fill = AI), - size = 0.05, - color = "white") + - ggplot2::geom_sf(data = county2021KY, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2017-2021 estimates") + - ggplot2::ggtitle("Atkinson Index (Atkinson)\nKentucky census block groups to counties", - subtitle = expression(paste("Black non-Hispanic (", epsilon, " = 0.67)"))) +ggplot() + + geom_sf( + data = KY2021atkinson, + aes(fill = AI), + size = 0.05, + color = 'white' + ) + + geom_sf( + data = county2021KY, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') + + ggtitle( + 'Atkinson Index (Atkinson)\nKentucky census block groups to counties', + subtitle = expression(paste('Black non-Hispanic (', epsilon, ' = 0.67)')) + ) ``` #### Compute racial/ethnic Isolation Index (II) -Compute the aspatial racial/ethnic II values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties from census block groups. This metric is based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and adapted by [Bell (1954)](https://doi.org/10.2307/2574118). Multiple racial/ethnic subgroups are available in the `bell()` function, including: +Compute the aspatial racial/ethnic II values (2017-2021 5-year ACS) for Ohio, U.S.A., counties from census block groups. This metric is based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and adapted by [Bell (1954)](https://doi.org/10.2307/2574118). Multiple racial/ethnic subgroups are available in the `bell()` function, including: | ACS table source | racial/ethnic subgroup | character for `subgroup` or or `subgroup_ref` argument | | -------------- | ------------- | ---------------- | @@ -906,38 +1080,50 @@ Compute the aspatial racial/ethnic II values (2017-2021 5-year ACS) for Kentucky II is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation) when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. II can range in value from 0 to 1. ```{r bell_prep, results = 'hide'} -bell2021KY <- ndi::bell(geo_large = "county", geo_small = "tract", state = "KY", - year = 2021, subgroup = "NHoLB", subgroup_ixn = "NHoLW") - -# Obtain the 2021 census counties from the "tigris" package -county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE) +bell2021OH <- bell( + geo_large = 'county', + geo_small = 'tract', + state = 'OH', + year = 2021, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW' +) + +# Obtain the 2021 census counties from the 'tigris' package +county2021OH <- counties(state = 'OH', year = 2021, cb = TRUE) # Join the II values to the county geometry -KY2021bell <- dplyr::left_join(county2021KY, bell2021KY$ii, by = "GEOID") +OH2021bell <- county2021OH %>% + left_join(bell2021OH$ii, by = 'GEOID') ``` -```{r bell_plot, fig.height = 4, fig.width = 7} -# Visualize the II values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties -ggplot2::ggplot() + - ggplot2::geom_sf(data = KY2021bell, - ggplot2::aes(fill = II), - size = 0.05, - color = "white") + - ggplot2::geom_sf(data = county2021KY, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2017-2021 estimates") + - ggplot2::ggtitle("Isolation Index (Bell)\nKentucky census tracts to counties", - subtitle = "Black non-Hispanic vs. white non-Hispanic") +```{r bell_plot, fig.height = 6, fig.width = 7} +# Visualize the II values (2017-2021 5-year ACS) for Ohio, U.S.A., counties +ggplot() + + geom_sf( + data = OH2021bell, + aes(fill = II), + size = 0.05, + color = 'white' + ) + + geom_sf( + data = county2021OH, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') + + ggtitle( + 'Isolation Index (Bell)\nOhio census tracts to counties', + subtitle = 'Black non-Hispanic vs. white non-Hispanic' + ) ``` #### Compute Correlation Ratio (V) -Compute the aspatial racial/ethnic V values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties from census tracts. This metric is based on [Bell (1954)](https://doi.org/10.2307/2574118) and adapted by [White (1986)](https://doi.org/10.2307/3644339). Multiple racial/ethnic subgroups are available in the `white()` function, including: +Compute the aspatial racial/ethnic V values (2017-2021 5-year ACS) for South Carolina, U.S.A., counties from census tracts. This metric is based on [Bell (1954)](https://doi.org/10.2307/2574118) and adapted by [White (1986)](https://doi.org/10.2307/3644339). Multiple racial/ethnic subgroups are available in the `white()` function, including: | ACS table source | racial/ethnic subgroup | character for `subgroup` argument | | -------------- | ------------- | ---------------- | @@ -962,41 +1148,52 @@ Compute the aspatial racial/ethnic V values (2017-2021 5-year ACS) for Kentucky, | B03002_020 | Hispanic or Latino, two races including some other race | HoLTRiSOR | | B03002_021 | Hispanic or Latino, two races excluding some other race, and three or more races | HoLTReSOR | -V removes the asymmetry from the Isolation Index by controlling for the effect of population composition when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. The Isolation Index is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation). V can range in value from 0 to 1. +V removes the asymmetry from the Isolation Index by controlling for the effect of population composition when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. The Isolation Index is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of interaction (less isolation). V can range in value from -Inf to Inf. ```{r white_prep, results = 'hide'} -white2021KY <- ndi::white(geo_large = "county", geo_small = "tract", state = "KY", - year = 2021, subgroup = "NHoLB") +white2021SC <- white( + geo_large = 'county', + geo_small = 'tract', + state = 'SC', + year = 2021, + subgroup = 'NHoLB' +) -# Obtain the 2021 census counties from the "tigris" package -county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE) +# Obtain the 2021 census counties from the 'tigris' package +county2021SC <- counties(state = 'SC', year = 2021, cb = TRUE) # Join the V values to the county geometry -KY2021white <- dplyr::left_join(county2021KY, white2021KY$v, by = "GEOID") +SC2021white <- county2021SC %>% + left_join(white2021SC$v, by = 'GEOID') ``` -```{r white_plot, fig.height = 4, fig.width = 7} -# Visualize the V values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties -ggplot2::ggplot() + - ggplot2::geom_sf(data = KY2021white, - ggplot2::aes(fill = V), - size = 0.05, - color = "white") + - ggplot2::geom_sf(data = county2021KY, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2017-2021 estimates") + - ggplot2::ggtitle("Correlation Ratio (White)\nKentucky census tracts to counties", - subtitle = "Black non-Hispanic") +```{r white_plot, fig.height = 6, fig.width = 7} +# Visualize the V values (2017-2021 5-year ACS) for South Carolina, U.S.A., counties +ggplot() + + geom_sf( + data = SC2021white, + aes(fill = V), + size = 0.05, + color = 'white' + ) + + geom_sf( + data = county2021SC, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') + + ggtitle( + 'Correlation Ratio (White)\nSouth Carolina census tracts to counties', + subtitle = 'Black non-Hispanic' + ) ``` #### Compute Location Quotient (LQ) -Compute the aspatial racial/ethnic LQ values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties vs. the state. This metric is based on [Merton (1939)](https://doi.org/10.2307/2084686) and adapted by [Sudano et al. (2013)](https://doi.org/10.1016/j.healthplace.2012.09.015). Multiple racial/ethnic subgroups are available in the `sudano()` function, including: +Compute the aspatial racial/ethnic LQ values (2017-2021 5-year ACS) for Tennessee, U.S.A., counties vs. the state. This metric is based on [Merton (1939)](https://doi.org/10.2307/2084686) and adapted by [Sudano et al. (2013)](https://doi.org/10.1016/j.healthplace.2012.09.015). Multiple racial/ethnic subgroups are available in the `sudano()` function, including: | ACS table source | racial/ethnic subgroup | character for `subgroup` argument | | -------------- | ------------- | ---------------- | @@ -1024,37 +1221,49 @@ Compute the aspatial racial/ethnic LQ values (2017-2021 5-year ACS) for Kentucky LQ is some measure of relative racial homogeneity of each smaller geography within a larger geography. LQ can range in value from 0 to infinity because it is ratio of two proportions in which the numerator is the proportion of subgroup population in a smaller geography and the denominator is the proportion of subgroup population in its larger geography. For example, a smaller geography with an LQ of 5 means that the proportion of the subgroup population living in the smaller geography is five times the proportion of the subgroup population in its larger geography. Unlike the previous metrics that aggregate to the larger geography, LQ computes values for each smaller geography relative to the larger geography. ```{r sudano_prep, results = 'hide'} -sudano2021KY <- ndi::sudano(geo_large = "state", geo_small = "county", state = "KY", - year = 2021, subgroup = "NHoLB") +sudano2021TN <- sudano( + geo_large = 'state', + geo_small = 'county', + state = 'TN', + year = 2021, + subgroup = 'NHoLB' +) -# Obtain the 2021 census counties from the "tigris" package -county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE) +# Obtain the 2021 census counties from the 'tigris' package +county2021TN <- counties(state = 'TN', year = 2021, cb = TRUE) # Join the LQ values to the county geometry -KY2021sudano <- dplyr::left_join(county2021KY, sudano2021KY$lq, by = "GEOID") +TN2021sudano <- county2021TN %>% + left_join(sudano2021TN$lq, by = 'GEOID') ``` -```{r sudano_plot, fig.height = 4, fig.width = 7} -# Visualize the LQ values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties -ggplot2::ggplot() + - ggplot2::geom_sf(data = KY2021sudano, - ggplot2::aes(fill = LQ), - size = 0.05, - color = "white") + - ggplot2::geom_sf(data = county2021KY, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c(limits = c(0, 1)) + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2017-2021 estimates") + - ggplot2::ggtitle("Location Quotient (Sudano)\nKentucky counties vs. state", - subtitle = "Black non-Hispanic") +```{r sudano_plot, fig.height = 3, fig.width = 7} +# Visualize the LQ values (2017-2021 5-year ACS) for Tennessee, U.S.A., counties +ggplot() + + geom_sf( + data = TN2021sudano, + aes(fill = LQ), + size = 0.05, + color = 'white' + ) + + geom_sf( + data = county2021TN, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') + + ggtitle( + 'Location Quotient (Sudano)\nTennessee counties vs. state', + subtitle = 'Black non-Hispanic' + ) ``` + #### Compute Local Exposure and Isolation (LEx/Is) -Compute the aspatial racial/ethnic Local Exposure and Isolation metric (2017-2021 5-year ACS) for Kentucky, U.S.A., counties vs. the state. This metric is based on [Bemanian & Beyer (2017)](https://doi.org/10.1158/1055-9965.EPI-16-0926). Multiple racial/ethnic subgroups are available in the `bemanian_beyer()` function, including: +Compute the aspatial racial/ethnic Local Exposure and Isolation metric (2017-2021 5-year ACS) for Mississippi, U.S.A., counties vs. the state. This metric is based on [Bemanian & Beyer (2017)](https://doi.org/10.1158/1055-9965.EPI-16-0926). Multiple racial/ethnic subgroups are available in the `bemanian_beyer()` function, including: | ACS table source | racial/ethnic subgroup | character for `subgroup` argument | | -------------- | ------------- | ---------------- | @@ -1082,51 +1291,144 @@ Compute the aspatial racial/ethnic Local Exposure and Isolation metric (2017-202 LEx/Is is a measure of the probability that two individuals living within a specific smaller geography (e.g., census tract) of either different (i.e., exposure) or the same (i.e., isolation) racial/ethnic subgroup(s) will interact, assuming that individuals within a smaller geography are randomly mixed. LEx/Is is standardized with a logit transformation and centered against an expected case that all races/ethnicities are evenly distributed across a larger geography. LEx/Is can range from negative infinity to infinity. If LEx/Is is zero then the estimated probability of the interaction between two people of the given subgroup(s) within a smaller geography is equal to the expected probability if the subgroup(s) were perfectly mixed in the larger geography. If LEx/Is is greater than zero then the interaction is more likely to occur within the smaller geography than in the larger geography, and if LEx/Is is less than zero then the interaction is less likely to occur within the smaller geography than in the larger geography. Note: the exponentiation of each LEx/Is metric results in the odds ratio of the specific exposure or isolation of interest in a smaller geography relative to the larger geography. Similar to LQ (Sudano), LEx/Is computes values for each smaller geography relative to the larger geography. ```{r bemanian_beyer_prep, results = 'hide'} -bemanian_beyer2021KY <- ndi::bemanian_beyer(geo_large = "state", geo_small = "county", state = "KY", - year = 2021, subgroup = "NHoLB", subgroup_ixn = "NHoLW") - -# Obtain the 2021 census counties from the "tigris" package -county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE) +bemanian_beyer2021MS <- bemanian_beyer( + geo_large = 'state', + geo_small = 'county', + state = 'MS', + year = 2021, + subgroup = 'NHoLB', + subgroup_ixn = 'NHoLW' +) + +# Obtain the 2021 census counties from the 'tigris' package +county2021MS <- counties(state = 'MS', year = 2021, cb = TRUE) # Join the LEx/Is values to the county geometry -KY2021bemanian_beyer <- dplyr::left_join(county2021KY, bemanian_beyer2021KY$lexis, by = "GEOID") +MS2021bemanian_beyer <- county2021MS %>% + left_join(bemanian_beyer2021MS$lexis, by = 'GEOID') ``` -```{r bemanian_beyer_plot, fig.height = 4, fig.width = 7} -# Visualize the LEx/Is values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties -ggplot2::ggplot() + - ggplot2::geom_sf(data = KY2021bemanian_beyer, - ggplot2::aes(fill = LExIs), - size = 0.05, - color = "white") + - ggplot2::geom_sf(data = county2021KY, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340") + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2017-2021 estimates") + - ggplot2::ggtitle("Local Exposure and Isolation (Bemanian & Beyer) metric\nKentucky counties vs. state", - subtitle = "Black non-Hispanic vs. White non-Hispanic") +```{r bemanian_beyer_plot, fig.height = 7, fig.width = 6.5} +# Visualize the LEx/Is values (2017-2021 5-year ACS) for Mississippi, U.S.A., counties +ggplot() + + geom_sf( + data = MS2021bemanian_beyer, + aes(fill = LExIs), + size = 0.05, + color = 'white' + ) + + geom_sf( + data = county2021MS, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_gradient2( + low = '#998ec3', + mid = '#f7f7f7', + high = '#f1a340' + ) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') + + ggtitle( + 'Local Exposure and Isolation (Bemanian & Beyer)\nMississippi counties vs. state', + subtitle = 'Black non-Hispanic vs. White non-Hispanic' + ) +``` +```{r bemanian_beyer_odds, fig.height = 7, fig.width = 6.5} +# Visualize the exponentiated LEx/Is values (2017-2021 5-year ACS) for +## Mississippi, U.S.A., counties +ggplot() + + geom_sf( + data = MS2021bemanian_beyer, + aes(fill = exp(LExIs)), + size = 0.05, + color = 'white' + ) + + geom_sf( + data = county2021MS, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c() + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') + + ggtitle( + 'Odds ratio of Local Exposure and Isolation (Bemanian & Beyer)\n + Mississippi counties vs. state', + subtitle = 'Black non-Hispanic vs. White non-Hispanic' + ) ``` -```{r bemanian_beyer_odds, fig.height = 4, fig.width = 7} -# Visualize the exponentiated LEx/Is values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties -ggplot2::ggplot() + - ggplot2::geom_sf(data = KY2021bemanian_beyer, - ggplot2::aes(fill = exp(LExIs)), - size = 0.05, - color = "white") + - ggplot2::geom_sf(data = county2021KY, - fill = "transparent", - color = "white", - size = 0.2) + - ggplot2::theme_minimal() + - ggplot2::scale_fill_viridis_c() + - ggplot2::labs(fill = "Index (Continuous)", - caption = "Source: U.S. Census ACS 2017-2021 estimates") + - ggplot2::ggtitle("Odds ratio of Local Exposure and Isolation (Bemanian & Beyer) metric\nKentucky counties vs. state", - subtitle = "Black non-Hispanic vs. White non-Hispanic") + +#### Compute Delta (DEL) + +Compute the aspatial racial/ethnic DEL values (2017-2021 5-year ACS) for Alabama, U.S.A., counties from census tracts. This metric is based on [Hoover (1941)](https://doi.org/10.1017/S0022050700052980) and Duncan et al. (1961; LC:60007089). Multiple racial/ethnic subgroups are available in the `hoover()` function, including: + +| ACS table source | racial/ethnic subgroup | character for `subgroup` argument | +| -------------- | ------------- | ---------------- | +| B03002_002 | not Hispanic or Latino | NHoL | +| B03002_003 | not Hispanic or Latino, white alone | NHoLW | +| B03002_004 | not Hispanic or Latino, Black or African American alone | NHoLB | +| B03002_005 | not Hispanic or Latino, American Indian and Alaska Native alone | NHoLAIAN | +| B03002_006 | not Hispanic or Latino, Asian alone | NHoLA | +| B03002_007 | not Hispanic or Latino, Native Hawaiian and Other Pacific Islander alone | NHoLNHOPI | +| B03002_008 | not Hispanic or Latino, some other race alone | NHoLSOR | +| B03002_009 | not Hispanic or Latino, two or more races | NHoLTOMR | +| B03002_010 | not Hispanic or Latino, two races including some other race | NHoLTRiSOR | +| B03002_011 | not Hispanic or Latino, two races excluding some other race, and three or more races | NHoLTReSOR | +| B03002_012 | Hispanic or Latino | HoL | +| B03002_013 | Hispanic or Latino, white alone | HoLW | +| B03002_014 | Hispanic or Latino, Black or African American alone | HoLB | +| B03002_015 | Hispanic or Latino, American Indian and Alaska Native alone | HoLAIAN | +| B03002_016 | Hispanic or Latino, Asian alone | HoLA | +| B03002_017 | Hispanic or Latino, Native Hawaiian and other Pacific Islander alone | HoLNHOPI | +| B03002_018 | Hispanic or Latino, some other race alone | HoLSOR | +| B03002_019 | Hispanic or Latino, two or more races | HoLTOMR | +| B03002_020 | Hispanic or Latino, two races including some other race | HoLTRiSOR | +| B03002_021 | Hispanic or Latino, two races excluding some other race, and three or more races | HoLTReSOR | + +DEL is a measure of the proportion of members of one subgroup(s) residing in geographic units with above average density of members of the subgroup(s). The index provides the proportion of a subgroup population that would have to move across geographic units to achieve a uniform density. DEL can range in value from 0 to 1. + +```{r hoover_prep, results = 'hide'} +hoover2021AL <- hoover( + geo_large = 'county', + geo_small = 'tract', + state = 'AL', + year = 2021, + subgroup = 'NHoLB' +) + +# Obtain the 2021 census counties from the 'tigris' package +county2021AL <- counties(state = 'AL', year = 2021, cb = TRUE) + +# Join the DEL values to the county geometry +AL2021hoover <- county2021AL %>% + left_join(hoover2021AL$del, by = 'GEOID') +``` + +```{r hoover_plot, fig.height = 7, fig.width = 6} +# Visualize the DEL values (2017-2021 5-year ACS) for Alabama, U.S.A., counties +ggplot() + + geom_sf( + data = AL2021hoover, + aes(fill = DEL), + size = 0.05, + color = 'white' + ) + + geom_sf( + data = county2021AL, + fill = 'transparent', + color = 'white', + size = 0.2 + ) + + theme_minimal() + + scale_fill_viridis_c(limits = c(0, 1)) + + labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') + + ggtitle( + 'Delta (Hoover)\nAlabama census tracts to counties', + subtitle = 'Black non-Hispanic' + ) ``` ```{r system} diff --git a/vignettes/vignette.html b/vignettes/vignette.html index ac5c2d8..6d60e41 100644 --- a/vignettes/vignette.html +++ b/vignettes/vignette.html @@ -12,7 +12,7 @@ - + ndi: Neighborhood Deprivation Indices @@ -340,14 +340,14 @@

ndi: Neighborhood Deprivation Indices

Ian D. Buller (GitHub: @idblr)

-

2023-02-01

+

2024-07-06

Start with the necessary packages for the vignette.

-
loadedPackages <- c("dplyr", "ggplot2", "ndi", "tidycensus", "tigris")
-invisible(lapply(loadedPackages, library, character.only = TRUE))
-options(tigris_use_cache = TRUE)
+
loadedPackages <- c('dplyr', 'ggplot2', 'ndi', 'tidycensus', 'tigris')
+invisible(lapply(loadedPackages, library, character.only = TRUE))
+options(tigris_use_cache = TRUE)

Set your U.S. Census Bureau access key. Follow this link to obtain one. Specify your access key in the messer() or powell_wiley() functions using the key @@ -357,7 +357,7 @@

2023-02-01

package before running the messer() or powell_wiley() functions (see an example of the latter below).

-
tidycensus::census_api_key("...") # INSERT YOUR OWN KEY FROM U.S. CENSUS API
+
census_api_key('...') # INSERT YOUR OWN KEY FROM U.S. CENSUS API

Compute NDI (Messer)

Compute the NDI (Messer) values (2006-2010 5-year ACS) for Georgia, @@ -430,30 +430,30 @@

Compute NDI (Messer)

-
messer2010GA <- ndi::messer(state = "GA", year = 2010, round_output = TRUE)
+
messer2010GA <- messer(state = 'GA', year = 2010, round_output = TRUE)

One output from the messer() function is a tibble containing the identification, geographic name, NDI (Messer) values, and raw census characteristics for each tract.

-
messer2010GA$ndi
+
messer2010GA$ndi
## # A tibble: 1,969 × 14
-##    GEOID  state county tract     NDI NDIQu…¹   OCC   CWD   POV   FHH   PUB   U30
-##    <chr>  <chr> <chr>  <chr>   <dbl> <fct>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-##  1 13001… Geor… Appli… 9501  -0.0075 2-Belo…     0   0     0.1   0.1   0.1   0.3
-##  2 13001… Geor… Appli… 9502   0.0458 4-Most…     0   0     0.3   0.1   0.2   0.5
-##  3 13001… Geor… Appli… 9503   0.0269 3-Abov…     0   0     0.2   0     0.2   0.4
-##  4 13001… Geor… Appli… 9504  -0.0083 2-Belo…     0   0     0.1   0     0.1   0.3
-##  5 13001… Geor… Appli… 9505   0.0231 3-Abov…     0   0     0.2   0     0.2   0.4
-##  6 13003… Geor… Atkin… 9601   0.0619 4-Most…     0   0.1   0.2   0.2   0.2   0.5
-##  7 13003… Geor… Atkin… 9602   0.0593 4-Most…     0   0.1   0.3   0.1   0.2   0.4
-##  8 13003… Geor… Atkin… 9603   0.0252 3-Abov…     0   0     0.3   0.1   0.2   0.4
-##  9 13005… Geor… Bacon… 9701   0.0061 3-Abov…     0   0     0.2   0     0.2   0.4
-## 10 13005… Geor… Bacon… 9702…  0.0121 3-Abov…     0   0     0.2   0.1   0.1   0.5
-## # … with 1,959 more rows, 2 more variables: EDU <dbl>, EMP <dbl>, and
-## #   abbreviated variable name ¹​NDIQuart
+## GEOID state county tract NDI NDIQuart OCC CWD POV FHH PUB U30 +## <chr> <chr> <chr> <chr> <dbl> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> +## 1 1300… Geor… Appli… 9501 -0.0075 2-Below… 0 0 0.1 0.1 0.1 0.3 +## 2 1300… Geor… Appli… 9502 0.0458 4-Most … 0 0 0.3 0.1 0.2 0.5 +## 3 1300… Geor… Appli… 9503 0.0269 3-Above… 0 0 0.2 0 0.2 0.4 +## 4 1300… Geor… Appli… 9504 -0.0083 2-Below… 0 0 0.1 0 0.1 0.3 +## 5 1300… Geor… Appli… 9505 0.0231 3-Above… 0 0 0.2 0 0.2 0.4 +## 6 1300… Geor… Atkin… 9601 0.0619 4-Most … 0 0.1 0.2 0.2 0.2 0.5 +## 7 1300… Geor… Atkin… 9602 0.0593 4-Most … 0 0.1 0.3 0.1 0.2 0.4 +## 8 1300… Geor… Atkin… 9603 0.0252 3-Above… 0 0 0.3 0.1 0.2 0.4 +## 9 1300… Geor… Bacon… 9701 0.0061 3-Above… 0 0 0.2 0 0.2 0.4 +## 10 1300… Geor… Bacon… 9702… 0.0121 3-Above… 0 0 0.2 0.1 0.1 0.5 +## # ℹ 1,959 more rows +## # ℹ 2 more variables: EDU <dbl>, EMP <dbl>

A second output from the messer() function is the results from the principal component analysis used to compute the NDI (Messer) values.

-
messer2010GA$pca
+
messer2010GA$pca
## Principal Components Analysis
 ## Call: psych::principal(r = ndi_data_pca, nfactors = 1, n.obs = nrow(ndi_data_pca), 
 ##     covar = FALSE, scores = TRUE, missing = imp)
@@ -482,7 +482,7 @@ 
Compute NDI (Messer)

 
A third output from the messer() function is a tibble
 containing a breakdown of the missingness of the census characteristics
 used to compute the NDI (Messer) values.

-
messer2010GA$missing

+
messer2010GA$missing

 
## # A tibble: 8 × 4
 ##   variable total n_missing percent_missing
 ##   <chr>    <int>     <int> <chr>          
@@ -497,99 +497,127 @@ 
Compute NDI (Messer)

 
We can visualize the NDI (Messer) values geographically by linking
 them to spatial information from the tigris package and
 plotting with the ggplot2 package suite.

-
# Obtain the 2010 counties from the "tigris" package
-county2010GA <- tigris::counties(state = "GA", year = 2010, cb = TRUE)
-# Remove first 9 characters from GEOID for compatibility with tigris information
-county2010GA$GEOID <- substring(county2010GA$GEO_ID, 10) 
-
-# Obtain the 2010 census tracts from the "tigris" package
-tract2010GA <- tigris::tracts(state = "GA", year = 2010, cb = TRUE)
-# Remove first 9 characters from GEOID for compatibility with tigris information
-tract2010GA$GEOID <- substring(tract2010GA$GEO_ID, 10) 
-
-# Join the NDI (Messer) values to the census tract geometry
-GA2010messer <- dplyr::left_join(tract2010GA, messer2010GA$ndi, by = "GEOID")

-
# Visualize the NDI (Messer) values (2006-2010 5-year ACS) for Georgia, U.S.A., census tracts 
-## Continuous Index
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = GA2010messer, 
-                   ggplot2::aes(fill = NDI),
-                   size = 0.05,
-                   color = "transparent") +
-   ggplot2::geom_sf(data = county2010GA,
-                   fill = "transparent", 
-                   color = "white",
-                   size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Messer)",
-                   subtitle = "GA census tracts as the referent")
-
-## Categorical Index
-### Rename "9-NDI not avail" level as NA for plotting
-GA2010messer$NDIQuartNA <- factor(replace(as.character(GA2010messer$NDIQuart), 
-                                            GA2010messer$NDIQuart == "9-NDI not avail", NA),
-                                  c(levels(GA2010messer$NDIQuart)[-5], NA))
-
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = GA2010messer, 
-                   ggplot2::aes(fill = NDIQuartNA),
-                   size = 0.05,
-                   color = "transparent") +
-   ggplot2::geom_sf(data = county2010GA,
-                   fill = "transparent", 
-                   color = "white",
-                   size = 0.2) +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE),
-                                na.value = "grey80") +
-  ggplot2::labs(fill = "Index (Categorical)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Messer) Quartiles",
-                   subtitle = "GA census tracts as the referent")

-

+
# Obtain the 2010 counties from the 'tigris' package
+county2010GA <- counties(state = 'GA', year = 2010, cb = TRUE)
+# Remove first 9 characters from GEOID for compatibility with tigris information
+county2010GA$GEOID <- substring(county2010GA$GEO_ID, 10) 
+
+# Obtain the 2010 census tracts from the 'tigris' package
+tract2010GA <- tracts(state = 'GA', year = 2010, cb = TRUE)
+# Remove first 9 characters from GEOID for compatibility with tigris information
+tract2010GA$GEOID <- substring(tract2010GA$GEO_ID, 10) 
+
+# Join the NDI (Messer) values to the census tract geometry
+GA2010messer <- tract2010GA %>%
+  left_join(messer2010GA$ndi, by = 'GEOID')

+
# Visualize the NDI (Messer) values (2006-2010 5-year ACS) for Georgia, U.S.A., census tracts 
+## Continuous Index
+ggplot() +
+  geom_sf(
+    data = GA2010messer,
+    aes(fill = NDI),
+    size = 0.05,
+    color = 'transparent'
+  ) +
+  geom_sf(
+    data = county2010GA,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Messer)',
+    subtitle = 'GA census tracts as the referent'
+  )
+
+## Categorical Index
+### Rename '9-NDI not avail' level as NA for plotting
+GA2010messer$NDIQuartNA <-
+  factor(
+    replace(
+      as.character(GA2010messer$NDIQuart),
+      GA2010messer$NDIQuart == '9-NDI not avail',
+      NA
+    ),
+    c(levels(GA2010messer$NDIQuart)[-5], NA)
+  )
+
+ggplot() +
+  geom_sf(
+    data = GA2010messer,
+    aes(fill = NDIQuartNA),
+    size = 0.05,
+    color = 'transparent'
+  ) +
+  geom_sf(
+    data = county2010GA,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') +
+  labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Messer) Quartiles',
+    subtitle = 'GA census tracts as the referent'
+  )

+

 
The results above are at the tract level. The NDI (Messer) values can
 also be calculated at the county level.

-
messer2010GA_county <- ndi::messer(geo = "county", state = "GA", year = 2010)
-
-# Join the NDI (Messer) values to the county geometry
-GA2010messer_county <- dplyr::left_join(county2010GA, messer2010GA_county$ndi, by = "GEOID")

-
# Visualize the NDI (Messer) values (2006-2010 5-year ACS) for Georgia, U.S.A., counties
-## Continuous Index
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = GA2010messer_county, 
-                   ggplot2::aes(fill = NDI),
-                   size = 0.20,
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Messer)",
-                   subtitle = "GA counties as the referent")
-
-## Categorical Index
-
-### Rename "9-NDI not avail" level as NA for plotting
-GA2010messer_county$NDIQuartNA <- factor(replace(as.character(GA2010messer_county$NDIQuart), 
-                                            GA2010messer_county$NDIQuart == "9-NDI not avail", NA),
-                                         c(levels(GA2010messer_county$NDIQuart)[-5], NA))
-
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = GA2010messer_county, 
-                   ggplot2::aes(fill = NDIQuartNA),
-                   size = 0.20,
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE),
-                                na.value = "grey80") +
-  ggplot2::labs(fill = "Index (Categorical)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Messer) Quartiles",
-                   subtitle = "GA counties as the referent")

-

+
messer2010GA_county <- messer(geo = 'county', state = 'GA', year = 2010)
+
+# Join the NDI (Messer) values to the county geometry
+GA2010messer_county <- county2010GA %>%
+  left_join(messer2010GA_county$ndi, by = 'GEOID')

+
# Visualize the NDI (Messer) values (2006-2010 5-year ACS) for Georgia, U.S.A., counties
+## Continuous Index
+ggplot() +
+  geom_sf(
+    data = GA2010messer_county,
+    aes(fill = NDI),
+    size = 0.20,
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Messer)',
+    subtitle = 'GA counties as the referent'
+  )
+
+## Categorical Index
+
+### Rename '9-NDI not avail' level as NA for plotting
+GA2010messer_county$NDIQuartNA <-
+  factor(
+    replace(
+      as.character(GA2010messer_county$NDIQuart),
+      GA2010messer_county$NDIQuart == '9-NDI not avail',
+      NA
+    ),
+    c(levels(GA2010messer_county$NDIQuart)[-5], NA)
+  )
+
+ggplot() +
+  geom_sf(
+    data = GA2010messer_county,
+    aes(fill = NDIQuartNA),
+    size = 0.20,
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') +
+  labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Messer) Quartiles',
+    subtitle = 'GA counties as the referent'
+  )

+

Compute NDI (Powell-Wiley)

@@ -703,33 +731,37 @@

Compute NDI (Powell-Wiley)

and computation of the NDI (Powell-Wiley) can be found on a GIS Portal for Cancer Research website.

-
powell_wiley2020DMVW <- ndi::powell_wiley(state = c("DC", "MD", "VA", "WV"), year = 2020, round_output = TRUE)
+
powell_wiley2020DMVW <- powell_wiley(
+  state = c('DC', 'MD', 'VA', 'WV'),
+  year = 2020,
+  round_output = TRUE
+)

One output from the powell_wiley() function is a tibble containing the identification, geographic name, NDI (Powell-Wiley) values, and raw census characteristics for each tract.

-
powell_wiley2020DMVW$ndi
+
powell_wiley2020DMVW$ndi
## # A tibble: 4,425 × 20
-##    GEOID       state  county tract   NDI NDIQu…¹ MedHH…² PctRe…³ PctPu…⁴ MedHo…⁵
-##    <chr>       <chr>  <chr>  <chr> <dbl> <fct>     <dbl>   <dbl>   <dbl>   <dbl>
-##  1 11001000101 Distr… Distr… 1.01  -2.13 1-Leas…  187839    50.9     0.8  699100
-##  2 11001000102 Distr… Distr… 1.02  -2.46 1-Leas…  184167    52.2     0.6 1556000
-##  3 11001000201 Distr… Distr… 2.01  NA    9-NDI …      NA   NaN     NaN        NA
-##  4 11001000202 Distr… Distr… 2.02  -2.30 1-Leas…  164261    49.6     0.9 1309100
-##  5 11001000300 Distr… Distr… 3     -2.06 1-Leas…  156483    46       0.6  976500
-##  6 11001000400 Distr… Distr… 4     -2.09 1-Leas…  153397    47.8     0   1164200
-##  7 11001000501 Distr… Distr… 5.01  -2.11 1-Leas…  119911    44.5     0.8  674600
-##  8 11001000502 Distr… Distr… 5.02  -2.21 1-Leas…  153264    46.8     0.5 1012500
-##  9 11001000600 Distr… Distr… 6     -2.16 1-Leas…  154266    60.8     7.4 1109800
-## 10 11001000702 Distr… Distr… 7.02  -1.20 1-Leas…   71747    22.9     0    289900
-## # … with 4,415 more rows, 10 more variables: PctMgmtBusScArti <dbl>,
+##    GEOID       state  county tract   NDI NDIQuint MedHHInc PctRecvIDR PctPubAsst
+##    <chr>       <chr>  <chr>  <chr> <dbl> <fct>       <dbl>      <dbl>      <dbl>
+##  1 11001000101 Distr… Distr… 1.01  -2.13 1-Least…   187839       50.9        0.8
+##  2 11001000102 Distr… Distr… 1.02  -2.46 1-Least…   184167       52.2        0.6
+##  3 11001000201 Distr… Distr… 2.01  NA    9-NDI n…       NA      NaN        NaN  
+##  4 11001000202 Distr… Distr… 2.02  -2.30 1-Least…   164261       49.6        0.9
+##  5 11001000300 Distr… Distr… 3     -2.06 1-Least…   156483       46          0.6
+##  6 11001000400 Distr… Distr… 4     -2.09 1-Least…   153397       47.8        0  
+##  7 11001000501 Distr… Distr… 5.01  -2.11 1-Least…   119911       44.5        0.8
+##  8 11001000502 Distr… Distr… 5.02  -2.21 1-Least…   153264       46.8        0.5
+##  9 11001000600 Distr… Distr… 6     -2.16 1-Least…   154266       60.8        7.4
+## 10 11001000702 Distr… Distr… 7.02  -1.20 1-Least…    71747       22.9        0  
+## # ℹ 4,415 more rows
+## # ℹ 11 more variables: MedHomeVal <dbl>, PctMgmtBusScArti <dbl>,
 ## #   PctFemHeadKids <dbl>, PctOwnerOcc <dbl>, PctNoPhone <dbl>,
 ## #   PctNComPlmb <dbl>, PctEducHSPlus <dbl>, PctEducBchPlus <dbl>,
-## #   PctFamBelowPov <dbl>, PctUnempl <dbl>, TotalPop <dbl>, and abbreviated
-## #   variable names ¹​NDIQuint, ²​MedHHInc, ³​PctRecvIDR, ⁴​PctPubAsst, ⁵​MedHomeVal
+## # PctFamBelowPov <dbl>, PctUnempl <dbl>, TotalPop <dbl>

A second output from the powell_wiley() function is the results from the principal component analysis used to compute the NDI (Powell-Wiley) values.

-
powell_wiley2020DMVW$pca
+
powell_wiley2020DMVW$pca
## $loadings
 ## 
 ## Loadings:
@@ -806,7 +838,7 @@ 
Compute NDI (Powell-Wiley)

 
A third output from the powell_wiley() function is a
 tibble containing a breakdown of the missingness of the census
 characteristics used to compute the NDI (Powell-Wiley) values.

-
powell_wiley2020DMVW$missing

+
powell_wiley2020DMVW$missing

 
## # A tibble: 13 × 4
 ##    variable        total n_missing percent_missing
 ##    <chr>           <int>     <int> <chr>          
@@ -826,109 +858,129 @@ 
Compute NDI (Powell-Wiley)

 
A fourth output from the powell_wiley() function is a
 character string or numeric value of a standardized Cronbach’s alpha. A
 value greater than 0.7 is desired.

-
powell_wiley2020DMVW$cronbach

-
## [1] 0.931138

+
powell_wiley2020DMVW$cronbach

+
## [1] 0.9321693

 
We can visualize the NDI (Powell-Wiley) values geographically by
 linking them to spatial information from the tigris package
 and plotting with the ggplot2 package suite.

-
# Obtain the 2020 counties from the "tigris" package
-county2020 <- tigris::counties(cb = TRUE)
-county2020DMVW <- county2020[county2020$STUSPS %in% c("DC", "MD", "VA", "WV"), ]
-
-# Obtain the 2020 census tracts from the "tigris" package
-tract2020D <- tigris::tracts(state = "DC", year = 2020, cb = TRUE)
-tract2020M <- tigris::tracts(state = "MD", year = 2020, cb = TRUE)
-tract2020V <- tigris::tracts(state = "VA", year = 2020, cb = TRUE)
-tract2020W <- tigris::tracts(state = "WV", year = 2020, cb = TRUE)
-tracts2020DMVW <- rbind(tract2020D, tract2020M, tract2020V, tract2020W)
-
-# Join the NDI (Powell-Wiley) values to the census tract geometry
-DMVW2020pw <- dplyr::left_join(tracts2020DMVW, powell_wiley2020DMVW$ndi, by = "GEOID")

-
# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) 
-## Maryland, Virginia, Washington, D.C., and West Virginia, U.S.A., census tracts 
-## Continuous Index
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = DMVW2020pw, 
-                   ggplot2::aes(fill = NDI), 
-                   color = NA) +
-  ggplot2::geom_sf(data = county2020DMVW,
-                   fill = "transparent", 
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_c(na.value = "grey80") +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2016-2020 estimates")+
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley)",
-                   subtitle = "DC, MD, VA, and WV tracts as the referent")
-
-## Categorical Index (Population-weighted quintiles)
-### Rename "9-NDI not avail" level as NA for plotting
-DMVW2020pw$NDIQuintNA <- factor(replace(as.character(DMVW2020pw$NDIQuint), 
-                                        DMVW2020pw$NDIQuint == "9-NDI not avail", NA),
-                                c(levels(DMVW2020pw$NDIQuint)[-6], NA))
-
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = DMVW2020pw, 
-                   ggplot2::aes(fill = NDIQuintNA), 
-                   color = NA) +
-  ggplot2::geom_sf(data = county2020DMVW,
-                   fill = "transparent", 
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE),
-                                na.value = "grey80") +
-  ggplot2::labs(fill = "Index (Categorical)",
-                caption = "Source: U.S. Census ACS 2016-2020 estimates")+
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley) Population-weighted Quintiles",
-                   subtitle = "DC, MD, VA, and WV tracts as the referent")

-

+
# Obtain the 2020 counties from the 'tigris' package
+county2020 <- counties(cb = TRUE)
+county2020DMVW <- county2020[county2020$STUSPS %in% c('DC', 'MD', 'VA', 'WV'), ]
+
+# Obtain the 2020 census tracts from the 'tigris' package
+tract2020D <- tracts(state = 'DC', year = 2020, cb = TRUE)
+tract2020M <- tracts(state = 'MD', year = 2020, cb = TRUE)
+tract2020V <- tracts(state = 'VA', year = 2020, cb = TRUE)
+tract2020W <- tracts(state = 'WV', year = 2020, cb = TRUE)
+tracts2020DMVW <- rbind(tract2020D, tract2020M, tract2020V, tract2020W)
+
+# Join the NDI (Powell-Wiley) values to the census tract geometry
+DMVW2020pw <- tracts2020DMVW %>%
+  left_join(powell_wiley2020DMVW$ndi, by = 'GEOID')

+
# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) 
+## Maryland, Virginia, Washington, D.C., and West Virginia, U.S.A., census tracts 
+## Continuous Index
+ggplot() +
+  geom_sf(
+    data = DMVW2020pw,
+    aes(fill = NDI),
+    color = NA
+  ) +
+  geom_sf(
+    data = county2020DMVW,
+    fill = 'transparent',
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c(na.value = 'grey80') +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Powell-Wiley)',
+    subtitle = 'DC, MD, VA, and WV tracts as the referent'
+  )
+
+## Categorical Index (Population-weighted quintiles)
+### Rename '9-NDI not avail' level as NA for plotting
+DMVW2020pw$NDIQuintNA <-
+  factor(replace(
+    as.character(DMVW2020pw$NDIQuint),
+    DMVW2020pw$NDIQuint == '9-NDI not avail',
+    NA
+  ),
+  c(levels(DMVW2020pw$NDIQuint)[-6], NA))
+
+ggplot() +
+  geom_sf(data = DMVW2020pw, aes(fill = NDIQuintNA), color = NA) +
+  geom_sf(data = county2020DMVW, fill = 'transparent', color = 'white') +
+  theme_minimal() +
+  scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') +
+  labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Powell-Wiley) Population-weighted Quintiles',
+    subtitle = 'DC, MD, VA, and WV tracts as the referent'
+  )

+

 
Like the NDI (Messer), we also compute county-level NDI
 (Powell-Wiley).

-
# Obtain the 2020 counties from the "tigris" package
-county2020DMVW <- tigris::counties(state = c("DC", "MD", "VA", "WV"), year = 2020, cb = TRUE)
-
-# NDI (Powell-Wiley) at the county level (2016-2020)
-powell_wiley2020DMVW_county <- ndi::powell_wiley(geo = "county",
-                                                 state = c("DC", "MD", "VA", "WV"),
-                                                 year = 2020)
-
-# Join the NDI (Powell-Wiley) values to the county geometry
-DMVW2020pw_county <- dplyr::left_join(county2020DMVW, powell_wiley2020DMVW_county$ndi, by = "GEOID")

-
# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS)
-## Maryland, Virginia, Washington, D.C., and West Virginia, U.S.A., counties
-## Continuous Index
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = DMVW2020pw_county, 
-                   ggplot2::aes(fill = NDI),
-                   size = 0.20,
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2016-2020 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley)",
-                   subtitle = "DC, MD, VA, and WV counties as the referent")
-
-## Categorical Index
-
-### Rename "9-NDI not avail" level as NA for plotting
-DMVW2020pw_county$NDIQuintNA <- factor(replace(as.character(DMVW2020pw_county$NDIQuint), 
-                                            DMVW2020pw_county$NDIQuint == "9-NDI not avail", NA),
-                                         c(levels(DMVW2020pw_county$NDIQuint)[-6], NA))
-
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = DMVW2020pw_county, 
-                   ggplot2::aes(fill = NDIQuint),
-                   size = 0.20,
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE),
-                                na.value = "grey80") +
-  ggplot2::labs(fill = "Index (Categorical)",
-                caption = "Source: U.S. Census ACS 2016-2020 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley) Population-weighted Quintiles",
-                   subtitle = "DC, MD, VA, and WV counties as the referent")

-

+
# Obtain the 2020 counties from the 'tigris' package
+county2020DMVW <- counties(state = c('DC', 'MD', 'VA', 'WV'), year = 2020, cb = TRUE)
+
+# NDI (Powell-Wiley) at the county level (2016-2020)
+powell_wiley2020DMVW_county <- powell_wiley(
+  geo = 'county',
+  state = c('DC', 'MD', 'VA', 'WV'),
+  year = 2020
+)
+
+# Join the NDI (Powell-Wiley) values to the county geometry
+DMVW2020pw_county <- county2020DMVW %>%
+  left_join(powell_wiley2020DMVW_county$ndi, by = 'GEOID')

+
# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS)
+## Maryland, Virginia, Washington, D.C., and West Virginia, U.S.A., counties
+## Continuous Index
+ggplot() +
+  geom_sf(
+    data = DMVW2020pw_county,
+    aes(fill = NDI),
+    size = 0.20,
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Powell-Wiley)',
+    subtitle = 'DC, MD, VA, and WV counties as the referent'
+  )
+
+## Categorical Index
+
+### Rename '9-NDI not avail' level as NA for plotting
+DMVW2020pw_county$NDIQuintNA <-
+  factor(
+    replace(
+      as.character(DMVW2020pw_county$NDIQuint),
+      DMVW2020pw_county$NDIQuint == '9-NDI not avail',
+      NA
+    ),
+    c(levels(DMVW2020pw_county$NDIQuint)[-6], NA)
+  )
+
+ggplot() +
+  geom_sf(
+    data = DMVW2020pw_county,
+    aes(fill = NDIQuint),
+    size = 0.20,
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') +
+  labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Powell-Wiley) Population-weighted Quintiles',
+    subtitle = 'DC, MD, VA, and WV counties as the referent'
+  )

+

Advanced Features

@@ -940,84 +992,109 @@

Imputing missing census variables

pca() function in the psych package called within the messer() and powell_wiley() functions. Impute values using the logical imp argument -(currently only calls impute = "median" by default, which +(currently only calls impute = 'median' by default, which assigns the median values of each missing census variable for a geography).

-
powell_wiley2020DC <- ndi::powell_wiley(state = "DC", year = 2020) # without imputation
-powell_wiley2020DCi <- ndi::powell_wiley(state = "DC", year = 2020, imp = TRUE) # with imputation
-
-table(is.na(powell_wiley2020DC$ndi$NDI)) # n=13 tracts without NDI (Powell-Wiley) values
-table(is.na(powell_wiley2020DCi$ndi$NDI)) # n=0 tracts without NDI (Powell-Wiley) values
-
-# Obtain the 2020 census tracts from the "tigris" package
-tract2020DC <- tigris::tracts(state = "DC", year = 2020, cb = TRUE)
-
-# Join the NDI (Powell-Wiley) values to the census tract geometry
-DC2020pw <- dplyr::left_join(tract2020DC, powell_wiley2020DC$ndi, by = "GEOID")
-DC2020pw <- dplyr::left_join(DC2020pw, powell_wiley2020DCi$ndi, by = "GEOID", suffix = c("_nonimp", "_imp"))
-
# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for Washington, D.C., census tracts
-## Continuous Index
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = DC2020pw, 
-                   ggplot2::aes(fill = NDI_nonimp),
-                   size = 0.2,
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2016-2020 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley), Non-Imputed",
-                   subtitle = "DC census tracts as the referent")
-
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = DC2020pw, 
-                   ggplot2::aes(fill = NDI_imp),
-                   size = 0.2,
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2016-2020 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley), Imputed",
-                   subtitle = "DC census tracts as the referent")
-
-## Categorical Index
-### Rename "9-NDI not avail" level as NA for plotting
-DC2020pw$NDIQuintNA_nonimp <- factor(replace(as.character(DC2020pw$NDIQuint_nonimp), 
-                                            DC2020pw$NDIQuint_nonimp == "9-NDI not avail", NA),
-                                         c(levels(DC2020pw$NDIQuint_nonimp)[-6], NA))
-
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = DC2020pw, 
-                   ggplot2::aes(fill = NDIQuintNA_nonimp),
-                   size = 0.2,
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE),
-                                na.value = "grey80") +
-  ggplot2::labs(fill = "Index (Categorical)",
-                caption = "Source: U.S. Census ACS 2016-2020 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley) Quintiles, Non-Imputed",
-                   subtitle = "DC census tracts as the referent")
-
-### Rename "9-NDI not avail" level as NA for plotting
-DC2020pw$NDIQuintNA_imp <- factor(replace(as.character(DC2020pw$NDIQuint_imp), 
-                                            DC2020pw$NDIQuint_imp == "9-NDI not avail", NA),
-                                      c(levels(DC2020pw$NDIQuint_imp)[-6], NA))
-
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = DC2020pw, 
-                   ggplot2::aes(fill = NDIQuintNA_imp),
-                   size = 0.2,
-                   color = "white") +
-  ggplot2::theme_minimal() + 
-  ggplot2::scale_fill_viridis_d(guide = ggplot2::guide_legend(reverse = TRUE),
-                                na.value = "grey80") +
-  ggplot2::labs(fill = "Index (Categorical)",
-                caption = "Source: U.S. Census ACS 2016-2020 estimates") +
-  ggplot2::ggtitle("Neighborhood Deprivation Index (Powell-Wiley) Quintiles, Imputed",
-                   subtitle = "DC census tracts as the referent")
-

+
powell_wiley2020DC <- powell_wiley(state = 'DC', year = 2020) # without imputation
+powell_wiley2020DCi <- powell_wiley(state = 'DC', year = 2020, imp = TRUE) # with imputation
+
+table(is.na(powell_wiley2020DC$ndi$NDI)) # n=13 tracts without NDI (Powell-Wiley) values
+table(is.na(powell_wiley2020DCi$ndi$NDI)) # n=0 tracts without NDI (Powell-Wiley) values
+
+# Obtain the 2020 census tracts from the 'tigris' package
+tract2020DC <- tracts(state = 'DC', year = 2020, cb = TRUE)
+
+# Join the NDI (Powell-Wiley) values to the census tract geometry
+DC2020pw <- tract2020DC %>%
+  left_join(powell_wiley2020DC$ndi, by = 'GEOID')
+DC2020pw <- DC2020pw %>%
+  left_join(powell_wiley2020DCi$ndi, by = 'GEOID', suffix = c('_nonimp', '_imp'))
+
# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for 
+## Washington, D.C., census tracts
+## Continuous Index
+ggplot() +
+  geom_sf(
+    data = DC2020pw,
+    aes(fill = NDI_nonimp),
+    size = 0.2,
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Powell-Wiley), Non-Imputed',
+    subtitle = 'DC census tracts as the referent'
+  )
+
+ggplot() +
+  geom_sf(
+    data = DC2020pw,
+    aes(fill = NDI_imp),
+    size = 0.2,
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Powell-Wiley), Imputed',
+    subtitle = 'DC census tracts as the referent'
+  )
+
+## Categorical Index
+### Rename '9-NDI not avail' level as NA for plotting
+DC2020pw$NDIQuintNA_nonimp <-
+  factor(
+    replace(
+      as.character(DC2020pw$NDIQuint_nonimp),
+      DC2020pw$NDIQuint_nonimp == '9-NDI not avail',
+      NA
+    ),
+    c(levels(DC2020pw$NDIQuint_nonimp)[-6], NA)
+  )
+
+ggplot() +
+  geom_sf(
+    data = DC2020pw,
+    aes(fill = NDIQuintNA_nonimp),
+    size = 0.2,
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') +
+  labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Powell-Wiley) Quintiles, Non-Imputed',
+    subtitle = 'DC census tracts as the referent'
+  )
+
+### Rename '9-NDI not avail' level as NA for plotting
+DC2020pw$NDIQuintNA_imp <-
+  factor(
+    replace(
+      as.character(DC2020pw$NDIQuint_imp),
+      DC2020pw$NDIQuint_imp == '9-NDI not avail',
+      NA
+    ),
+    c(levels(DC2020pw$NDIQuint_imp)[-6], NA)
+  )
+
+ggplot() +
+  geom_sf(
+    data = DC2020pw,
+    aes(fill = NDIQuintNA_imp),
+    size = 0.2,
+    color = 'white'
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_d(guide = guide_legend(reverse = TRUE), na.value = 'grey80') +
+  labs(fill = 'Index (Categorical)', caption = 'Source: U.S. Census ACS 2016-2020 estimates') +
+  ggtitle(
+    'Neighborhood Deprivation Index (Powell-Wiley) Quintiles, Imputed',
+    subtitle = 'DC census tracts as the referent'
+  )
+

Assign the referent (U.S.-Standardized Metric)

@@ -1029,25 +1106,30 @@

Assign the referent (U.S.-Standardized Metric)

NDI (Powell-Wiley) values (2006-2010 ACS-5) found in Andrews et al. (2020) change the year argument to 2010 (i.e., year = 2010).

-
us <- tigris::states()
-n51 <- c("Commonwealth of the Northern Mariana Islands", "Guam", "American Samoa",
-         "Puerto Rico", "United States Virgin Islands")
-y51 <- us$STUSPS[!(us$NAME %in% n51)]
-
-start_time <- Sys.time() # record start time
-powell_wiley2017US <- ndi::powell_wiley(state = y51, year = 2017)
-end_time <- Sys.time() # record end time
-time_srr <- end_time - start_time # Calculate run time
-
ggplot2::ggplot(powell_wiley2017US$ndi, 
-                ggplot2::aes(x = NDI)) +
-  ggplot2::geom_histogram(color = "black",
-                          fill = "white") + 
-  ggplot2::theme_minimal() +
-  ggplot2::ggtitle("Histogram of US-standardized NDI (Powell-Wiley) values (2013-2017)",
-                   subtitle = "U.S. census tracts as the referent (including AK, HI, and DC)")
+
us <- states()
+n51 <- c(
+  'Commonwealth of the Northern Mariana Islands',
+  'Guam',
+  'American Samoa',
+  'Puerto Rico',
+  'United States Virgin Islands'
+)
+y51 <- us$STUSPS[!(us$NAME %in% n51)]
+
+start_time <- Sys.time() # record start time
+powell_wiley2017US <- powell_wiley(state = y51, year = 2017)
+end_time <- Sys.time() # record end time
+time_srr <- end_time - start_time # Calculate run time
+
ggplot(powell_wiley2017US$ndi, aes(x = NDI)) +
+  geom_histogram(color = 'black', fill = 'white') +
+  theme_minimal() +
+  ggtitle(
+    'Histogram of US-standardized NDI (Powell-Wiley) values (2013-2017)',
+    subtitle = 'U.S. census tracts as the referent (including AK, HI, and DC)'
+  )

The process to compute a US-standardized NDI (Powell-Wiley) took -about 2.5 minutes to run on a machine with the features listed at the +about 2.7 minutes to run on a machine with the features listed at the end of the vignette.

@@ -1087,6 +1169,9 @@

Additional metrics socio-economic deprivation and disparity

  • bemanian_beyer() function that computes the aspatial racial/ethnic Local Exposure and Isolation metric based on Bemanian & Beyer (2017)
    • +
  • hoover() function that computes the aspatial +racial/ethnic Delta based on Hoover (1941) and +Duncan et al. (1961; LC:60007089)

    • Compute Racial Isolation Index (RI)

    @@ -1223,34 +1308,40 @@

    Compute Racial Isolation Index (RI)

    neighbors) that is nearly none of its population who identify with the specified race/ethnicity subgroup(s) (e.g., not Not Hispanic or Latino, Black or African American alone) will have an RI value close to 0.

    -
    anthopolos2010NC <- ndi::anthopolos(state = "NC", year = 2010, subgroup = "NHoLB")
-
-# Obtain the 2010 census tracts from the "tigris" package
-tract2010NC <- tigris::tracts(state = "NC", year = 2010, cb = TRUE)
-# Remove first 9 characters from GEOID for compatibility with tigris information
-tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) 
-
-# Obtain the 2010 counties from the "tigris" package
-county2010NC <- tigris::counties(state = "NC", year = 2010, cb = TRUE)
-
-# Join the RI values to the census tract geometry
-NC2010anthopolos <- dplyr::left_join(tract2010NC, anthopolos2010NC$ri, by = "GEOID")
    -
    # Visualize the RI values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts 
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = NC2010anthopolos, 
-                   ggplot2::aes(fill = RI),
-                   size = 0.05,
-                   color = "transparent") +
-   ggplot2::geom_sf(data = county2010NC,
-                   fill = "transparent", 
-                   color = "white",
-                   size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Racial Isolation Index (Anthopolos), non-Hispanic Black",
-                   subtitle = "NC census tracts (not corrected for edge effects)")
    +
    anthopolos2010NC <- anthopolos(state = 'NC', year = 2010, subgroup = 'NHoLB')
+
+# Obtain the 2010 census tracts from the 'tigris' package
+tract2010NC <- tracts(state = 'NC', year = 2010, cb = TRUE)
+# Remove first 9 characters from GEOID for compatibility with tigris information
+tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) 
+
+# Obtain the 2010 counties from the 'tigris' package
+county2010NC <- counties(state = 'NC', year = 2010, cb = TRUE)
+
+# Join the RI values to the census tract geometry
+NC2010anthopolos <- tract2010NC %>%
+  left_join(anthopolos2010NC$ri, by = 'GEOID')
    +
    # Visualize the RI values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts 
+ggplot() +
+  geom_sf(
+    data = NC2010anthopolos,
+    aes(fill = RI),
+    size = 0.05,
+    color = 'transparent'
+  ) +
+  geom_sf(
+    data = county2010NC,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Racial Isolation Index (Anthopolos), non-Hispanic Black',
+    subtitle = 'NC census tracts (not corrected for edge effects)'
+  )

    The current version of the ndi package does not correct for edge effects (e.g., census geographies along the specified spatial @@ -1260,45 +1351,55 @@

    Compute Racial Isolation Index (RI)

    of edge effect is to compute the RI for neighboring census geographies (i.e., the states bordering a study area of interest) and then use the estimates of the study area of interest.

    -
    # Compute RI for all census tracts in neighboring states
-anthopolos2010GNSTV <- ndi::anthopolos(state = c("GA", "NC", "SC", "TN", "VA"),
-                                     year = 2010, subgroup = "NHoLB")
-
-# Crop to only North Carolina, U.S.A. census tracts
-anthopolos2010NCe <- anthopolos2010GNSTV$ri[anthopolos2010GNSTV$ri$GEOID %in% anthopolos2010NC$ri$GEOID, ]
-
-# Obtain the 2010 census tracts from the "tigris" package
-tract2010NC <- tigris::tracts(state = "NC", year = 2010, cb = TRUE)
-# Remove first 9 characters from GEOID for compatibility with tigris information
-tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) 
-
-# Obtain the 2010 counties from the "tigris" package
-county2010NC <- tigris::counties(state = "NC", year = 2010, cb = TRUE)
-
-# Join the RI values to the census tract geometry
-edgeNC2010anthopolos <- dplyr::left_join(tract2010NC, anthopolos2010NCe, by = "GEOID")
    -
    # Visualize the RI values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts 
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = edgeNC2010anthopolos, 
-                   ggplot2::aes(fill = RI),
-                   size = 0.05,
-                   color = "transparent") +
-   ggplot2::geom_sf(data = county2010NC,
-                   fill = "transparent", 
-                   color = "white",
-                   size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Racial Isolation Index (Anthopolos), non-Hispanic Black",
-                   subtitle = "NC census tracts (corrected for interstate edge effects)")
    +
    # Compute RI for all census tracts in neighboring states
+anthopolos2010GNSTV <- anthopolos(
+  state = c('GA', 'NC', 'SC', 'TN', 'VA'),
+  year = 2010,
+  subgroup = 'NHoLB'
+)
+
+# Crop to only North Carolina, U.S.A. census tracts
+anthopolos2010NCe <- anthopolos2010GNSTV$ri[anthopolos2010GNSTV$ri$GEOID %in% 
+                                              anthopolos2010NC$ri$GEOID, ]
+
+# Obtain the 2010 census tracts from the 'tigris' package
+tract2010NC <- tracts(state = 'NC', year = 2010, cb = TRUE)
+# Remove first 9 characters from GEOID for compatibility with tigris information
+tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) 
+
+# Obtain the 2010 counties from the 'tigris' package
+county2010NC <- counties(state = 'NC', year = 2010, cb = TRUE)
+
+# Join the RI values to the census tract geometry
+edgeNC2010anthopolos <- tract2010NC %>% 
+  left_join(anthopolos2010NCe, by = 'GEOID')
    +
    # Visualize the RI values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts 
+ggplot() +
+  geom_sf(
+    data = edgeNC2010anthopolos,
+    aes(fill = RI),
+    size = 0.05,
+    color = 'transparent'
+  ) +
+  geom_sf(
+    data = county2010NC,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Racial Isolation Index (Anthopolos), non-Hispanic Black',
+    subtitle = 'NC census tracts (corrected for interstate edge effects)'
+  )

    Compute Educational Isolation Index (EI)

    Compute the spatial EI (Bravo) values (2006-2010 5-year ACS) for -North Carolina, U.S.A., census tracts. This metric is based on Bravo et al. (2021) +Oklahoma, U.S.A., census tracts. This metric is based on Bravo et al. (2021) that assessed the educational isolation of the population without a four-year college degree. Multiple educational attainment categories are available in the bravo() function, including:

    @@ -1343,7 +1444,7 @@

    Compute Educational Isolation Index (EI)

    -

    Note: The ACS-5 data (2005-2009) uses the “B15002” question.

    +

    Note: The ACS-5 data (2005-2009) uses the ‘B15002’ question.

    A census geography (and its neighbors) that has nearly all of its population with the specified educational attainment category (e.g., a four-year college degree or more) will have an EI (Bravo) value close to @@ -1351,45 +1452,51 @@

    Compute Educational Isolation Index (EI)

    none of its population with the specified educational attainment category (e.g., with a four-year college degree) will have an EI (Bravo) value close to 0.

    -
    bravo2010NC <- ndi::bravo(state = "NC", year = 2010, subgroup = c("LtHS", "HSGiE", "SCoAD"))
-
-# Obtain the 2010 census tracts from the "tigris" package
-tract2010NC <- tigris::tracts(state = "NC", year = 2010, cb = TRUE)
-# Remove first 9 characters from GEOID for compatibility with tigris information
-tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) 
-
-# Obtain the 2010 counties from the "tigris" package
-county2010NC <- tigris::counties(state = "NC", year = 2010, cb = TRUE)
-
-# Join the EI (Bravo) values to the census tract geometry
-NC2010bravo <- dplyr::left_join(tract2010NC, bravo2010NC$ei, by = "GEOID")
    -
    # Visualize the EI (Bravo) values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts 
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = NC2010bravo, 
-                   ggplot2::aes(fill = EI),
-                   size = 0.05,
-                   color = "transparent") +
-   ggplot2::geom_sf(data = county2010NC,
-                   fill = "transparent", 
-                   color = "white",
-                   size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Educational Isolation Index (Bravo), without a four-year college degree",
-                   subtitle = "NC census tracts (not corrected for edge effects)")
    -

    +
    bravo2010OK <- bravo(state = 'OK', year = 2010, subgroup = c('LtHS', 'HSGiE', 'SCoAD'))
+
+# Obtain the 2010 census tracts from the 'tigris' package
+tract2010OK <- tracts(state = 'OK', year = 2010, cb = TRUE)
+# Remove first 9 characters from GEOID for compatibility with tigris information
+tract2010OK$GEOID <- substring(tract2010OK$GEO_ID, 10) 
+
+# Obtain the 2010 counties from the 'tigris' package
+county2010OK <- counties(state = 'OK', year = 2010, cb = TRUE)
+
+# Join the EI (Bravo) values to the census tract geometry
+OK2010bravo <- tract2010OK %>%
+  left_join(bravo2010OK$ei, by = 'GEOID')
    +
    # Visualize the EI (Bravo) values (2006-2010 5-year ACS) for Oklahoma, U.S.A., census tracts 
+ggplot() +
+  geom_sf(
+    data = OK2010bravo,
+    aes(fill = EI),
+    size = 0.05,
+    color = 'transparent'
+  ) +
+  geom_sf(
+    data = county2010OK,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c(limits = c(0, 1)) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Educational Isolation Index (Bravo), without a four-year college degree',
+    subtitle = 'OK census tracts (not corrected for edge effects)'
+  )
    +

    Can correct one source of edge effect in the same manner as shown for the RI metric.

    Retrieve the Gini Index

    Retrieve the aspatial Gini Index values (2006-2010 5-year ACS) for -North Carolina, U.S.A., census tracts. This metric is based on Gini (1921), and the +Massachusetts, U.S.A., census tracts. This metric is based on Gini (1921), and the gini() function retrieves the estimate from the ACS-5.

    According to the U.S. -Census Bureau: “The Gini Index is a summary measure of income +Census Bureau: ‘The Gini Index is a summary measure of income inequality. The Gini coefficient incorporates the detailed shares data into a single statistic, which summarizes the dispersion of income across the entire income distribution. The Gini coefficient ranges from @@ -1397,36 +1504,39 @@

    Retrieve the Gini Index

    to 1, perfect inequality (where only one recipient or group of recipients receives all the income). The Gini is based on the difference between the Lorenz curve (the observed cumulative income distribution) -and the notion of a perfectly equal income distribution.”

    -
    gini2010NC <- ndi::gini(state = "NC", year = 2010)
-
-# Obtain the 2010 census tracts from the "tigris" package
-tract2010NC <- tigris::tracts(state = "NC", year = 2010, cb = TRUE)
-# Remove first 9 characters from GEOID for compatibility with tigris information
-tract2010NC$GEOID <- substring(tract2010NC$GEO_ID, 10) 
-
-# Obtain the 2010 counties from the "tigris" package
-county2010NC <- tigris::counties(state = "NC", year = 2010, cb = TRUE)
-
-# Join the Gini Index values to the census tract geometry
-NC2010gini <- dplyr::left_join(tract2010NC, gini2010NC$gini, by = "GEOID")
    -
    # Visualize the Gini Index values (2006-2010 5-year ACS) for North Carolina, U.S.A., census tracts 
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = NC2010gini, 
-                   ggplot2::aes(fill = gini),
-                   size = 0.05,
-                   color = "transparent") +
-   ggplot2::geom_sf(data = county2010NC,
-                   fill = "transparent", 
-                   color = "white",
-                   size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Gini Index",
-                   subtitle = "NC census tracts")
    -

    +and the notion of a perfectly equal income distribution.’

    +
    gini2010MA <- gini(state = 'MA', year = 2010)
+
+# Obtain the 2010 census tracts from the 'tigris' package
+tract2010MA <- tracts(state = 'MA', year = 2010, cb = TRUE)
+# Remove first 9 characters from GEOID for compatibility with tigris information
+tract2010MA$GEOID <- substring(tract2010MA$GEO_ID, 10) 
+
+# Obtain the 2010 counties from the 'tigris' package
+county2010MA <- counties(state = 'MA', year = 2010, cb = TRUE)
+
+# Join the Gini Index values to the census tract geometry
+MA2010gini <- tract2010MA %>%
+  left_join(gini2010MA$gini, by = 'GEOID')
    +
    # Visualize the Gini Index values (2006-2010 5-year ACS) for Massachusetts, U.S.A., census tracts 
+ggplot() +
+  geom_sf(
+    data = MA2010gini,
+    aes(fill = gini),
+    size = 0.05,
+    color = 'transparent'
+  ) +
+  geom_sf(
+    data = county2010MA,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle('Gini Index', subtitle = 'MA census tracts')
    +

    @@ -1457,28 +1567,28 @@

    Index of Concentration at the Extremes (ICE)

    B19001 -Income, “ICE_inc” +Income, ‘ICE_inc’ 80th income percentile vs. 20th income percentile B15002 -Education, “ICE_edu” +Education, ‘ICE_edu’ less than high school vs. four-year college degree or more B03002 -Race/Ethnicity, “ICE_rewb” +Race/Ethnicity, ‘ICE_rewb’ 80th income percentile vs. 20th income percentile B19001 & B19001B & B19001H -Income and race/ethnicity combined, “ICE_wbinc” +Income and race/ethnicity combined, ‘ICE_wbinc’ white non-Hispanic in 80th income percentile vs. black alone (including Hispanic) in 20th income percentile B19001 & B19001H -Income and race/ethnicity combined, “ICE_wpcinc” +Income and race/ethnicity combined, ‘ICE_wpcinc’ white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile @@ -1490,81 +1600,123 @@

    Index of Concentration at the Extremes (ICE)

    or (2) an equal number of persons are in the most privileged and most deprived categories, and in both cases indicates that the area is not dominated by extreme concentrations of either of the two groups.

    -
    ice2020WC <- krieger(state = "MI", county = "Wayne", year = 2010)
-
-# Obtain the 2010 census tracts from the "tigris" package
-tract2010WC <- tigris::tracts(state = "MI", county = "Wayne", year = 2010, cb = TRUE)
-# Remove first 9 characters from GEOID for compatibility with tigris information
-tract2010WC$GEOID <- substring(tract2010WC$GEO_ID, 10) 
-
-# Join the ICE values to the census tract geometry
-ice2020WC <- dplyr::left_join(tract2010WC, ice2020WC$ice, by = "GEOID")
    -
    # Plot ICE for Income
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = ice2020WC, 
-                   ggplot2::aes(fill = ICE_inc),
-                   color = "white",
-                   size = 0.05) +
-  ggplot2::theme_bw() + 
-  ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1,1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates")+
-  ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome (Krieger)",
-                   subtitle = "80th income percentile vs. 20th income percentile")
-
-# Plot ICE for Education
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = ice2020WC, 
-                   ggplot2::aes(fill = ICE_edu),
-                   color = "white",
-                   size = 0.05) +
-  ggplot2::theme_bw() + 
-  ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1,1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates")+
-  ggplot2::ggtitle("Index of Concentration at the Extremes\nEducation (Krieger)",
-                   subtitle = "less than high school vs. four-year college degree or more")
-
-# Plot ICE for Race/Ethnicity
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = ice2020WC, 
-                   ggplot2::aes(fill = ICE_rewb),
-                   color = "white",
-                   size = 0.05) +
-  ggplot2::theme_bw() + 
-  ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates")+
-  ggplot2::ggtitle("Index of Concentration at the Extremes\nRace/Ethnicity (Krieger)",
-                   subtitle = "white non-Hispanic vs. black non-Hispanic")
-
-# Plot ICE for Income and Race/Ethnicity Combined
-## white non-Hispanic in 80th income percentile vs. black (including Hispanic) in 20th income percentile
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = ice2020WC, 
-                   ggplot2::aes(fill = ICE_wbinc),
-                   color = "white",
-                   size = 0.05) +
-  ggplot2::theme_bw() + 
-  ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates")+
-  ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome & race/ethnicity combined (Krieger)",
-                   subtitle = "white non-Hispanic in 80th inc ptcl vs. black alone in 20th inc pctl")
-
-# Plot ICE for Income and Race/Ethnicity Combined
-## white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = ice2020WC, 
-                   ggplot2::aes(fill = ICE_wpcinc),
-                   color = "white",
-                   size = 0.05) +
-  ggplot2::theme_bw() + 
-  ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340", limits = c(-1, 1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates")+
-  ggplot2::ggtitle("Index of Concentration at the Extremes\nIncome & race/ethnicity combined (Krieger)",
-                   subtitle = "white non-Hispanic (WNH) in 80th inc pctl vs. WNH in 20th inc pctl")
    +
    ice2020WC <- krieger(state = 'MI', county = 'Wayne', year = 2010)
+
+# Obtain the 2010 census tracts from the 'tigris' package
+tract2010WC <- tracts(state = 'MI', county = 'Wayne', year = 2010, cb = TRUE)
+# Remove first 9 characters from GEOID for compatibility with tigris information
+tract2010WC$GEOID <- substring(tract2010WC$GEO_ID, 10) 
+
+# Join the ICE values to the census tract geometry
+ice2020WC <- tract2010WC %>%
+  left_join(ice2020WC$ice, by = 'GEOID')
    +
    # Plot ICE for Income
+ggplot() +
+  geom_sf(
+    data = ice2020WC,
+    aes(fill = ICE_inc),
+    color = 'white',
+    size = 0.05
+  ) +
+  theme_bw() +
+  scale_fill_gradient2(
+    low = '#998ec3',
+    mid = '#f7f7f7',
+    high = '#f1a340',
+    limits = c(-1, 1)
+  ) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Index of Concentration at the Extremes\nIncome (Krieger)',
+    subtitle = '80th income percentile vs. 20th income percentile'
+  )
+
+# Plot ICE for Education
+ggplot() +
+  geom_sf(
+    data = ice2020WC,
+    aes(fill = ICE_edu),
+    color = 'white',
+    size = 0.05
+  ) +
+  theme_bw() +
+  scale_fill_gradient2(
+    low = '#998ec3',
+    mid = '#f7f7f7',
+    high = '#f1a340',
+    limits = c(-1, 1)
+  ) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Index of Concentration at the Extremes\nEducation (Krieger)',
+    subtitle = 'less than high school vs. four-year college degree or more'
+  )
+
+# Plot ICE for Race/Ethnicity
+ggplot() +
+  geom_sf(
+    data = ice2020WC,
+    aes(fill = ICE_rewb),
+    color = 'white',
+    size = 0.05
+  ) +
+  theme_bw() +
+  scale_fill_gradient2(
+    low = '#998ec3',
+    mid = '#f7f7f7',
+    high = '#f1a340',
+    limits = c(-1, 1)
+  ) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Index of Concentration at the Extremes\nRace/Ethnicity (Krieger)',
+    subtitle = 'white non-Hispanic vs. black non-Hispanic'
+  )
+
+# Plot ICE for Income and Race/Ethnicity Combined
+## white non-Hispanic in 80th income percentile vs. 
+## black (including Hispanic) in 20th income percentile
+ggplot() +
+  geom_sf(
+    data = ice2020WC,
+    aes(fill = ICE_wbinc),
+    color = 'white',
+    size = 0.05
+  ) +
+  theme_bw() +
+  scale_fill_gradient2(
+    low = '#998ec3',
+    mid = '#f7f7f7',
+    high = '#f1a340',
+    limits = c(-1, 1)
+  ) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Index of Concentration at the Extremes\nIncome & race/ethnicity combined (Krieger)',
+    subtitle = 'white non-Hispanic in 80th inc ptcl vs. black alone in 20th inc pctl'
+  )
+
+# Plot ICE for Income and Race/Ethnicity Combined
+## white non-Hispanic in 80th income percentile vs. white non-Hispanic in 20th income percentile
+ggplot() +
+  geom_sf(
+    data = ice2020WC,
+    aes(fill = ICE_wpcinc),
+    color = 'white',
+    size = 0.05
+  ) +
+  theme_bw() +
+  scale_fill_gradient2(
+    low = '#998ec3',
+    mid = '#f7f7f7',
+    high = '#f1a340',
+    limits = c(-1, 1)
+  ) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Index of Concentration at the Extremes\nIncome & race/ethnicity combined (Krieger)',
+    subtitle = 'white non-Hispanic (WNH) in 80th inc pctl vs. WNH in 20th inc pctl'
+  )

    Compute racial/ethnic Dissimilarity Index (DI)

    @@ -1705,32 +1857,44 @@

    Compute racial/ethnic Dissimilarity Index (DI)

    subgroup members that would have to change their area of residence to achieve an even distribution within the larger geographical area under conditions of maximum segregation.

    -
    duncan2010PA <- ndi::duncan(geo_large = "county", geo_small = "tract", state = "PA",
-                            year = 2010, subgroup = "NHoLB", subgroup_ref = "NHoLW")
-
-# Obtain the 2010 census counties from the "tigris" package
-county2010PA <- tigris::counties(state = "PA", year = 2010, cb = TRUE)
-# Remove first 9 characters from GEOID for compatibility with tigris information
-county2010PA$GEOID <- substring(county2010PA$GEO_ID, 10) 
-
-# Join the DI values to the county geometry
-PA2010duncan <- dplyr::left_join(county2010PA, duncan2010PA$di, by = "GEOID")
    -
    # Visualize the DI values (2006-2010 5-year ACS) for Pennsylvania, U.S.A., counties 
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = PA2010duncan, 
-                   ggplot2::aes(fill = DI),
-                   size = 0.05,
-                   color = "white") +
-   ggplot2::geom_sf(data = county2010PA,
-                    fill = "transparent", 
-                    color = "white",
-                    size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c(limits = c(0, 1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2006-2010 estimates") +
-  ggplot2::ggtitle("Dissimilarity Index (Duncan & Duncan)\nPennsylvania census tracts to counties",
-                   subtitle = "Black non-Hispanic vs. white non-Hispanic")
    +
    duncan2010PA <- duncan(
+  geo_large = 'county',
+  geo_small = 'tract',
+  state = 'PA',
+  year = 2010,
+  subgroup = 'NHoLB',
+  subgroup_ref = 'NHoLW'
+)
+
+# Obtain the 2010 census counties from the 'tigris' package
+county2010PA <- counties(state = 'PA', year = 2010, cb = TRUE)
+# Remove first 9 characters from GEOID for compatibility with tigris information
+county2010PA$GEOID <- substring(county2010PA$GEO_ID, 10) 
+
+# Join the DI values to the county geometry
+PA2010duncan <- county2010PA %>%
+  left_join(duncan2010PA$di, by = 'GEOID')
    +
    # Visualize the DI values (2006-2010 5-year ACS) for Pennsylvania, U.S.A., counties 
+ggplot() +
+  geom_sf(
+    data = PA2010duncan,
+    aes(fill = DI),
+    size = 0.05,
+    color = 'white'
+  ) +
+  geom_sf(
+    data = county2010PA,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c(limits = c(0, 1)) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2006-2010 estimates') +
+  ggtitle(
+    'Dissimilarity Index (Duncan & Duncan)\nPennsylvania census tracts to counties',
+    subtitle = 'Black non-Hispanic vs. white non-Hispanic'
+  )

    @@ -1741,8 +1905,8 @@

    Compute aspatial income or racial/ethnic Atkinson Index (AI)

    the distribution of income within 12 counties but has since been adapted to study racial/ethnic segregation (see James & Taeuber 1985). To compare median household income, specify -subgroup = "MedHHInc" which will use the ACS-5 variable -“B19013_001” in the computation. Multiple racial/ethnic subgroups are +subgroup = 'MedHHInc' which will use the ACS-5 variable +‘B19013_001’ in the computation. Multiple racial/ethnic subgroups are available in the atkinson() function, including:

    @@ -1877,48 +2041,60 @@

    Compute aspatial income or racial/ethnic Atkinson Index (AI)

    (i.e., whether the index should take greater account of differences among areas of over- or under-representation). The epsilon argument must have values between 0 and 1.0. For -0 <= epsilon < 0.5 or less “inequality-averse,” +0 <= epsilon < 0.5 or less ‘inequality-averse,’ smaller geographical units with a subgroup proportion smaller than the subgroup proportion of the larger geographical unit contribute more to -inequality (“over-representation”). For -0.5 < epsilon <= 1.0 or more “inequality-averse,” +inequality (‘over-representation’). For +0.5 < epsilon <= 1.0 or more ‘inequality-averse,’ smaller geographical units with a subgroup proportion larger than the subgroup proportion of the larger geographical unit contribute more to -inequality (“under-representation”). If epsilon = 0.5 (the +inequality (‘under-representation’). If epsilon = 0.5 (the default), units of over- and under-representation contribute equally to the index. See Section 2.3 of Saint-Jacques et al. (2020) for one method to select epsilon. We choose epsilon = 0.67 in the example below:

    -
    atkinson2021KY <- ndi::atkinson(geo_large = "county", geo_small = "block group", state = "KY",
-                                year = 2021, subgroup = "NHoLB", epsilon = 0.67)
-
-# Obtain the 2021 census counties from the "tigris" package
-county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE)
-
-# Join the AI values to the county geometry
-KY2021atkinson <- dplyr::left_join(county2021KY, atkinson2021KY$ai, by = "GEOID")
    -
    # Visualize the AI values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = KY2021atkinson, 
-                   ggplot2::aes(fill = AI),
-                   size = 0.05,
-                   color = "white") +
-   ggplot2::geom_sf(data = county2021KY,
-                    fill = "transparent", 
-                    color = "white",
-                    size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c(limits = c(0, 1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2017-2021 estimates") +
-  ggplot2::ggtitle("Atkinson Index (Atkinson)\nKentucky census block groups to counties",
-                   subtitle = expression(paste("Black non-Hispanic (", epsilon, " = 0.67)")))
    +
    atkinson2021KY <- atkinson(
+  geo_large = 'county',
+  geo_small = 'block group',
+  state = 'KY',
+  year = 2021,
+  subgroup = 'NHoLB',
+  epsilon = 0.67
+)
+
+# Obtain the 2021 census counties from the 'tigris' package
+county2021KY <- counties(state = 'KY', year = 2021, cb = TRUE)
+
+# Join the AI values to the county geometry
+KY2021atkinson <- county2021KY %>% 
+  left_join(atkinson2021KY$ai, by = 'GEOID')
    +
    # Visualize the AI values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties
+ggplot() +
+  geom_sf(
+    data = KY2021atkinson,
+    aes(fill = AI),
+    size = 0.05,
+    color = 'white'
+  ) +
+  geom_sf(
+    data = county2021KY,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c(limits = c(0, 1)) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') +
+  ggtitle(
+    'Atkinson Index (Atkinson)\nKentucky census block groups to counties',
+    subtitle = expression(paste('Black non-Hispanic (', epsilon, ' = 0.67)'))
+  )

    Compute racial/ethnic Isolation Index (II)

    Compute the aspatial racial/ethnic II values (2017-2021 5-year ACS) -for Kentucky, U.S.A., counties from census block groups. This metric is +for Ohio, U.S.A., counties from census block groups. This metric is based on Shevky & Williams (1949; ISBN-13:978-0-837-15637-8) and adapted by Bell (1954). Multiple racial/ethnic subgroups are available in the @@ -2050,40 +2226,52 @@

    Compute racial/ethnic Isolation Index (II)

    isolation) when comparing smaller geographical areas to larger ones within which the smaller geographical areas are located. II can range in value from 0 to 1.

    -
    bell2021KY <- ndi::bell(geo_large = "county", geo_small = "tract", state = "KY",
-                                year = 2021, subgroup = "NHoLB", subgroup_ixn = "NHoLW")
-
-# Obtain the 2021 census counties from the "tigris" package
-county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE)
-
-# Join the II values to the county geometry
-KY2021bell <- dplyr::left_join(county2021KY, bell2021KY$ii, by = "GEOID")
    -
    # Visualize the II values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = KY2021bell, 
-                   ggplot2::aes(fill = II),
-                   size = 0.05,
-                   color = "white") +
-   ggplot2::geom_sf(data = county2021KY,
-                    fill = "transparent", 
-                    color = "white",
-                    size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c(limits = c(0, 1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2017-2021 estimates") +
-  ggplot2::ggtitle("Isolation Index (Bell)\nKentucky census tracts to counties",
-                   subtitle = "Black non-Hispanic vs. white non-Hispanic")
    -

    +
    bell2021OH <- bell(
+  geo_large = 'county',
+  geo_small = 'tract',
+  state = 'OH',
+  year = 2021,
+  subgroup = 'NHoLB',
+  subgroup_ixn = 'NHoLW'
+)
+
+# Obtain the 2021 census counties from the 'tigris' package
+county2021OH <- counties(state = 'OH', year = 2021, cb = TRUE)
+
+# Join the II values to the county geometry
+OH2021bell <- county2021OH %>%
+  left_join(bell2021OH$ii, by = 'GEOID')
    +
    # Visualize the II values (2017-2021 5-year ACS) for Ohio, U.S.A., counties
+ggplot() +
+  geom_sf(
+    data = OH2021bell,
+    aes(fill = II),
+    size = 0.05,
+    color = 'white'
+  ) +
+  geom_sf(
+    data = county2021OH,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c(limits = c(0, 1)) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') +
+  ggtitle(
+    'Isolation Index (Bell)\nOhio census tracts to counties',
+    subtitle = 'Black non-Hispanic vs. white non-Hispanic'
+  )
    +

    Compute Correlation Ratio (V)

    Compute the aspatial racial/ethnic V values (2017-2021 5-year ACS) -for Kentucky, U.S.A., counties from census tracts. This metric is based -on Bell (1954) and adapted -by White (1986). Multiple -racial/ethnic subgroups are available in the white() -function, including:

    +for South Carolina, U.S.A., counties from census tracts. This metric is +based on Bell (1954) and +adapted by White (1986). +Multiple racial/ethnic subgroups are available in the +white() function, including:

    @@ -2210,38 +2398,50 @@

    Compute Correlation Ratio (V)

    located. The Isolation Index is some measure of the probability that a member of one subgroup(s) will meet or interact with a member of another subgroup(s) with higher values signifying higher probability of -interaction (less isolation). V can range in value from 0 to 1.

    -
    white2021KY <- ndi::white(geo_large = "county", geo_small = "tract", state = "KY",
-                                year = 2021, subgroup = "NHoLB")
-
-# Obtain the 2021 census counties from the "tigris" package
-county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE)
-
-# Join the V values to the county geometry
-KY2021white <- dplyr::left_join(county2021KY, white2021KY$v, by = "GEOID")
    -
    # Visualize the V values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = KY2021white, 
-                   ggplot2::aes(fill = V),
-                   size = 0.05,
-                   color = "white") +
-   ggplot2::geom_sf(data = county2021KY,
-                    fill = "transparent", 
-                    color = "white",
-                    size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c(limits = c(0, 1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2017-2021 estimates") +
-  ggplot2::ggtitle("Correlation Ratio (White)\nKentucky census tracts to counties",
-                   subtitle = "Black non-Hispanic")
    -

    +interaction (less isolation). V can range in value from -Inf to Inf.

    +
    white2021SC <- white(
+  geo_large = 'county',
+  geo_small = 'tract',
+  state = 'SC',
+  year = 2021,
+  subgroup = 'NHoLB'
+)
+
+# Obtain the 2021 census counties from the 'tigris' package
+county2021SC <- counties(state = 'SC', year = 2021, cb = TRUE)
+
+# Join the V values to the county geometry
+SC2021white <- county2021SC %>%
+  left_join(white2021SC$v, by = 'GEOID')
    +
    # Visualize the V values (2017-2021 5-year ACS) for South Carolina, U.S.A., counties
+ggplot() +
+  geom_sf(
+    data = SC2021white,
+    aes(fill = V),
+    size = 0.05,
+    color = 'white'
+  ) +
+  geom_sf(
+    data = county2021SC,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') +
+  ggtitle(
+    'Correlation Ratio (White)\nSouth Carolina census tracts to counties',
+    subtitle = 'Black non-Hispanic'
+  )
    +

    Compute Location Quotient (LQ)

    Compute the aspatial racial/ethnic LQ values (2017-2021 5-year ACS) -for Kentucky, U.S.A., counties vs. the state. This metric is based on Merton (1939) and adapted by -Sudano et +for Tennessee, U.S.A., counties vs. the state. This metric is based on +Merton (1939) and adapted +by Sudano et al. (2013). Multiple racial/ethnic subgroups are available in the sudano() function, including:

    @@ -2375,34 +2575,47 @@

    Compute Location Quotient (LQ)

    larger geography. Unlike the previous metrics that aggregate to the larger geography, LQ computes values for each smaller geography relative to the larger geography.

    -
    sudano2021KY <- ndi::sudano(geo_large = "state", geo_small = "county", state = "KY",
-                                year = 2021, subgroup = "NHoLB")
-
-# Obtain the 2021 census counties from the "tigris" package
-county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE)
-
-# Join the LQ values to the county geometry
-KY2021sudano <- dplyr::left_join(county2021KY, sudano2021KY$lq, by = "GEOID")
    -
    # Visualize the LQ values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = KY2021sudano, 
-                   ggplot2::aes(fill = LQ),
-                   size = 0.05,
-                   color = "white") +
-   ggplot2::geom_sf(data = county2021KY,
-                    fill = "transparent", 
-                    color = "white",
-                    size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c(limits = c(0, 1)) +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2017-2021 estimates") +
-  ggplot2::ggtitle("Location Quotient (Sudano)\nKentucky counties vs. state",
-                   subtitle = "Black non-Hispanic")
    -

    -#### Compute Local Exposure and Isolation (LEx/Is)

    +
    sudano2021TN <- sudano(
+  geo_large = 'state',
+  geo_small = 'county',
+  state = 'TN',
+  year = 2021,
+  subgroup = 'NHoLB'
+)
+
+# Obtain the 2021 census counties from the 'tigris' package
+county2021TN <- counties(state = 'TN', year = 2021, cb = TRUE)
+
+# Join the LQ values to the county geometry
+TN2021sudano <- county2021TN %>% 
+                   left_join(sudano2021TN$lq, by = 'GEOID')
    +
    # Visualize the LQ values (2017-2021 5-year ACS) for Tennessee, U.S.A., counties
+ggplot() +
+  geom_sf(
+    data = TN2021sudano,
+    aes(fill = LQ),
+    size = 0.05,
+    color = 'white'
+  ) +
+  geom_sf(
+    data = county2021TN,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') +
+  ggtitle(
+    'Location Quotient (Sudano)\nTennessee counties vs. state',
+    subtitle = 'Black non-Hispanic'
+  )
    +

    + +
    +

    Compute Local Exposure and Isolation (LEx/Is)

    Compute the aspatial racial/ethnic Local Exposure and Isolation -metric (2017-2021 5-year ACS) for Kentucky, U.S.A., counties vs. the +metric (2017-2021 5-year ACS) for Mississippi, U.S.A., counties vs. the state. This metric is based on Bemanian & Beyer (2017). Multiple racial/ethnic subgroups are available in the bemanian_beyer() function, including:

    @@ -2546,55 +2759,248 @@

    Compute Location Quotient (LQ)

    smaller geography relative to the larger geography. Similar to LQ (Sudano), LEx/Is computes values for each smaller geography relative to the larger geography.

    -
    bemanian_beyer2021KY <- ndi::bemanian_beyer(geo_large = "state", geo_small = "county", state = "KY",
-                                            year = 2021, subgroup = "NHoLB", subgroup_ixn = "NHoLW")
-
-# Obtain the 2021 census counties from the "tigris" package
-county2021KY <- tigris::counties(state = "KY", year = 2021, cb = TRUE)
-
-# Join the LEx/Is values to the county geometry
-KY2021bemanian_beyer <- dplyr::left_join(county2021KY, bemanian_beyer2021KY$lexis, by = "GEOID")
    -
    # Visualize the LEx/Is values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = KY2021bemanian_beyer, 
-                   ggplot2::aes(fill = LExIs),
-                   size = 0.05,
-                   color = "white") +
-   ggplot2::geom_sf(data = county2021KY,
-                    fill = "transparent", 
-                    color = "white",
-                    size = 0.2) +
-  ggplot2::theme_minimal() +
-   ggplot2::scale_fill_gradient2(low = "#998ec3", mid = "#f7f7f7", high = "#f1a340") +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2017-2021 estimates") +
-  ggplot2::ggtitle("Local Exposure and Isolation (Bemanian & Beyer) metric\nKentucky counties vs. state",
-                   subtitle = "Black non-Hispanic vs. White non-Hispanic")
    -

    -
    # Visualize the exponentiated LEx/Is values (2017-2021 5-year ACS) for Kentucky, U.S.A., counties
-ggplot2::ggplot() + 
-  ggplot2::geom_sf(data = KY2021bemanian_beyer, 
-                   ggplot2::aes(fill = exp(LExIs)),
-                   size = 0.05,
-                   color = "white") +
-   ggplot2::geom_sf(data = county2021KY,
-                    fill = "transparent", 
-                    color = "white",
-                    size = 0.2) +
-  ggplot2::theme_minimal() +
-  ggplot2::scale_fill_viridis_c() +
-  ggplot2::labs(fill = "Index (Continuous)",
-                caption = "Source: U.S. Census ACS 2017-2021 estimates") +
-  ggplot2::ggtitle("Odds ratio of Local Exposure and Isolation (Bemanian & Beyer) metric\nKentucky counties vs. state",
-                   subtitle = "Black non-Hispanic vs. White non-Hispanic")
    -

    -
    sessionInfo()
    -
    ## R version 4.2.1 (2022-06-23 ucrt)
-## Platform: x86_64-w64-mingw32/x64 (64-bit)
+
    bemanian_beyer2021MS <- bemanian_beyer(
+  geo_large = 'state',
+  geo_small = 'county',
+  state = 'MS',
+  year = 2021,
+  subgroup = 'NHoLB',
+  subgroup_ixn = 'NHoLW'
+)
+
+# Obtain the 2021 census counties from the 'tigris' package
+county2021MS <- counties(state = 'MS', year = 2021, cb = TRUE)
+
+# Join the LEx/Is values to the county geometry
+MS2021bemanian_beyer <- county2021MS %>%
+  left_join(bemanian_beyer2021MS$lexis, by = 'GEOID')
    
+
    # Visualize the LEx/Is values (2017-2021 5-year ACS) for Mississippi, U.S.A., counties
+ggplot() +
+  geom_sf(
+    data = MS2021bemanian_beyer,
+    aes(fill = LExIs),
+    size = 0.05,
+    color = 'white'
+  ) +
+  geom_sf(
+    data = county2021MS,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_gradient2(
+    low = '#998ec3',
+    mid = '#f7f7f7',
+    high = '#f1a340'
+  ) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') +
+  ggtitle(
+    'Local Exposure and Isolation (Bemanian & Beyer)\nMississippi counties vs. state',
+    subtitle = 'Black non-Hispanic vs. White non-Hispanic'
+  )
    
+
    
+
    # Visualize the exponentiated LEx/Is values (2017-2021 5-year ACS) for 
+## Mississippi, U.S.A., counties
+ggplot() +
+  geom_sf(
+    data = MS2021bemanian_beyer,
+    aes(fill = exp(LExIs)),
+    size = 0.05,
+    color = 'white'
+  ) +
+  geom_sf(
+    data = county2021MS,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c() +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') +
+  ggtitle(
+    'Odds ratio of Local Exposure and Isolation (Bemanian & Beyer)\n
+    Mississippi counties vs. state',
+    subtitle = 'Black non-Hispanic vs. White non-Hispanic'
+  )
    
+
    
+
    +
    +

    Compute Delta (DEL)

    +

    Compute the aspatial racial/ethnic DEL values (2017-2021 5-year ACS) +for Alabama, U.S.A., counties from census tracts. This metric is based +on Hoover (1941) +and Duncan et al. (1961; LC:60007089). Multiple racial/ethnic subgroups +are available in the hoover() function, including:

    +
    +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    ACS table sourceracial/ethnic subgroupcharacter for subgroup argument
    B03002_002not Hispanic or LatinoNHoL
    B03002_003not Hispanic or Latino, white aloneNHoLW
    B03002_004not Hispanic or Latino, Black or African American aloneNHoLB
    B03002_005not Hispanic or Latino, American Indian and Alaska Native aloneNHoLAIAN
    B03002_006not Hispanic or Latino, Asian aloneNHoLA
    B03002_007not Hispanic or Latino, Native Hawaiian and Other Pacific Islander +aloneNHoLNHOPI
    B03002_008not Hispanic or Latino, some other race aloneNHoLSOR
    B03002_009not Hispanic or Latino, two or more racesNHoLTOMR
    B03002_010not Hispanic or Latino, two races including some other raceNHoLTRiSOR
    B03002_011not Hispanic or Latino, two races excluding some other race, and +three or more racesNHoLTReSOR
    B03002_012Hispanic or LatinoHoL
    B03002_013Hispanic or Latino, white aloneHoLW
    B03002_014Hispanic or Latino, Black or African American aloneHoLB
    B03002_015Hispanic or Latino, American Indian and Alaska Native aloneHoLAIAN
    B03002_016Hispanic or Latino, Asian aloneHoLA
    B03002_017Hispanic or Latino, Native Hawaiian and other Pacific Islander +aloneHoLNHOPI
    B03002_018Hispanic or Latino, some other race aloneHoLSOR
    B03002_019Hispanic or Latino, two or more racesHoLTOMR
    B03002_020Hispanic or Latino, two races including some other raceHoLTRiSOR
    B03002_021Hispanic or Latino, two races excluding some other race, and three +or more racesHoLTReSOR
    +

    DEL is a measure of the proportion of members of one subgroup(s) +residing in geographic units with above average density of members of +the subgroup(s). The index provides the proportion of a subgroup +population that would have to move across geographic units to achieve a +uniform density. DEL can range in value from 0 to 1.

    +
    hoover2021AL <- hoover(
+  geo_large = 'county',
+  geo_small = 'tract',
+  state = 'AL',
+  year = 2021,
+  subgroup = 'NHoLB'
+)
+
+# Obtain the 2021 census counties from the 'tigris' package
+county2021AL <- counties(state = 'AL', year = 2021, cb = TRUE)
+
+# Join the DEL values to the county geometry
+AL2021hoover <- county2021AL %>%
+  left_join(hoover2021AL$del, by = 'GEOID')
    +
    # Visualize the DEL values (2017-2021 5-year ACS) for Alabama, U.S.A., counties
+ggplot() +
+  geom_sf(
+    data = AL2021hoover,
+    aes(fill = DEL),
+    size = 0.05,
+    color = 'white'
+  ) +
+  geom_sf(
+    data = county2021AL,
+    fill = 'transparent',
+    color = 'white',
+    size = 0.2
+  ) +
+  theme_minimal() +
+  scale_fill_viridis_c(limits = c(0, 1)) +
+  labs(fill = 'Index (Continuous)', caption = 'Source: U.S. Census ACS 2017-2021 estimates') +
+  ggtitle(
+    'Delta (Hoover)\nAlabama census tracts to counties',
+    subtitle = 'Black non-Hispanic'
+  )
    +

    +
    sessionInfo()
    +
    ## R version 4.4.0 (2024-04-24 ucrt)
+## Platform: x86_64-w64-mingw32/x64
 ## Running under: Windows 10 x64 (build 19045)
 ## 
 ## Matrix products: default
 ## 
+## 
 ## locale:
 ## [1] LC_COLLATE=English_United States.utf8 
 ## [2] LC_CTYPE=English_United States.utf8   
@@ -2602,33 +3008,36 @@ 
    Compute Location Quotient (LQ)
    
 ## [4] LC_NUMERIC=C                          
 ## [5] LC_TIME=English_United States.utf8    
 ## 
+## time zone: America/New_York
+## tzcode source: internal
+## 
 ## attached base packages:
 ## [1] stats     graphics  grDevices utils     datasets  methods   base     
 ## 
 ## other attached packages:
-## [1] tigris_2.0.1     tidycensus_1.3.2 ndi_0.1.4        ggplot2_3.4.0   
-## [5] dplyr_1.1.0      knitr_1.42      
+## [1] tigris_2.1       tidycensus_1.6.3 ndi_0.1.6.9000   ggplot2_3.5.1   
+## [5] dplyr_1.1.4      knitr_1.46      
 ## 
 ## loaded via a namespace (and not attached):
-##  [1] Rcpp_1.0.10        lattice_0.20-45    tidyr_1.3.0        class_7.3-20      
-##  [5] digest_0.6.31      psych_2.2.9        utf8_1.2.2         R6_2.5.1          
-##  [9] evaluate_0.20      e1071_1.7-12       highr_0.10         httr_1.4.4        
-## [13] pillar_1.8.1       rlang_1.0.6        curl_5.0.0         uuid_1.1-0        
-## [17] rstudioapi_0.14    car_3.1-1          jquerylib_0.1.4    Matrix_1.4-1      
-## [21] rmarkdown_2.20     labeling_0.4.2     readr_2.1.3        stringr_1.5.0     
-## [25] munsell_0.5.0      proxy_0.4-27       compiler_4.2.1     xfun_0.36         
-## [29] pkgconfig_2.0.3    mnormt_2.1.1       htmltools_0.5.4    tidyselect_1.2.0  
-## [33] tibble_3.1.8       viridisLite_0.4.1  fansi_1.0.4        tzdb_0.3.0        
-## [37] crayon_1.5.2       withr_2.5.0        sf_1.0-9           wk_0.7.1          
-## [41] MASS_7.3-58.1      rappdirs_0.3.3     grid_4.2.1         nlme_3.1-157      
-## [45] jsonlite_1.8.4     gtable_0.3.1       lifecycle_1.0.3    DBI_1.1.3         
-## [49] magrittr_2.0.3     units_0.8-1        scales_1.2.1       KernSmooth_2.23-20
-## [53] cli_3.6.0          stringi_1.7.12     cachem_1.0.6       carData_3.0-5     
-## [57] farver_2.1.1       xml2_1.3.3         bslib_0.4.2        ellipsis_0.3.2    
-## [61] generics_0.1.3     vctrs_0.5.2        s2_1.1.2           tools_4.2.1       
-## [65] Cairo_1.6-0        glue_1.6.2         purrr_1.0.1        hms_1.1.2         
-## [69] abind_1.4-5        parallel_4.2.1     fastmap_1.1.0      yaml_2.3.6        
-## [73] colorspace_2.1-0   classInt_0.4-8     rvest_1.0.3        sass_0.4.4
    +## [1] gtable_0.3.5 xfun_0.43 bslib_0.7.0 psych_2.4.6.26 +## [5] lattice_0.22-6 tzdb_0.4.0 Cairo_1.6-2 vctrs_0.6.5 +## [9] tools_4.4.0 generics_0.1.3 curl_5.2.1 parallel_4.4.0 +## [13] tibble_3.2.1 proxy_0.4-27 fansi_1.0.6 highr_0.10 +## [17] pkgconfig_2.0.3 Matrix_1.7-0 KernSmooth_2.23-22 uuid_1.2-0 +## [21] lifecycle_1.0.4 farver_2.1.2 compiler_4.4.0 stringr_1.5.1 +## [25] munsell_0.5.1 mnormt_2.1.1 carData_3.0-5 htmltools_0.5.8.1 +## [29] class_7.3-22 sass_0.4.9 yaml_2.3.8 pillar_1.9.0 +## [33] car_3.1-2 crayon_1.5.2 jquerylib_0.1.4 tidyr_1.3.1 +## [37] MASS_7.3-60.2 classInt_0.4-10 cachem_1.0.8 wk_0.9.1 +## [41] abind_1.4-5 nlme_3.1-164 tidyselect_1.2.1 rvest_1.0.4 +## [45] digest_0.6.35 stringi_1.8.3 sf_1.0-16 purrr_1.0.2 +## [49] labeling_0.4.3 fastmap_1.1.1 grid_4.4.0 colorspace_2.1-0 +## [53] cli_3.6.3 magrittr_2.0.3 utf8_1.2.4 e1071_1.7-14 +## [57] readr_2.1.5 withr_3.0.0 scales_1.3.0 rappdirs_0.3.3 +## [61] rmarkdown_2.26 httr_1.4.7 hms_1.1.3 evaluate_0.23 +## [65] viridisLite_0.4.2 s2_1.1.6 rlang_1.1.4 Rcpp_1.0.12 +## [69] glue_1.7.0 DBI_1.2.2 xml2_1.3.6 rstudioapi_0.16.0 +## [73] jsonlite_1.8.8 R6_2.5.1 units_0.8-5
    From bd92050bc62feab67b734ad420814ed899c0c091 Mon Sep 17 00:00:00 2001 From: Ian D Buller Date: Sat, 6 Jul 2024 14:11:44 -0400 Subject: [PATCH 6/7] :memo: Additional formatting of README examples * removes horizontal scroll bar in HTML view --- README.md | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 0470ef5..8f6ae8f 100644 --- a/README.md +++ b/README.md @@ -296,7 +296,8 @@ DC2020powell_wiley <- tract2020DC DC2020powell_wiley <- DC2020powell_wiley left_join(powell_wiley2020DCi$ndi, by = 'GEOID') -# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for Washington, D.C. census tracts +# Visualize the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for +# Washington, D.C. census tracts ## Non-imputed missing tracts (Continuous) ggplot() + @@ -419,8 +420,8 @@ ndi2020DC <- messer2020DC$ndi %>% suffix = c('.messer', '.powell_wiley') ) -# Check the correlation the two NDI metrics (Messer and Powell-Wiley, imputed) as continuous values -cor(ndi2020DC$NDI.messer, ndi2020DC$NDI.powell_wiley, use = 'complete.obs') # Pearsons r = 0.975 +# Check the correlation of two NDI metrics (Messer & Powell-Wiley, imputed) as continuous values +cor(ndi2020DC$NDI.messer, ndi2020DC$NDI.powell_wiley, use = 'complete.obs') # Pearson's r=0.975 # Check the similarity of the two NDI metrics (Messer and Powell-Wiley, imputed) as quartiles table(ndi2020DC$NDIQuart, ndi2020DC$NDIQuint) @@ -490,7 +491,8 @@ ggplot() + caption = 'Source: U.S. Census ACS 2016-2020 estimates' ) + ggtitle( - 'Racial Isolation Index\nNot Hispanic or Latino, Black or African American alone (Anthopolos)', + 'Racial Isolation Index\n + Not Hispanic or Latino, Black or African American alone (Anthopolos)', subtitle = 'Washington, D.C. tracts (not corrected for edge effects)' ) ``` @@ -953,7 +955,8 @@ ggplot() + caption = 'Source: U.S. Census ACS 2016-2020 estimates' ) + ggtitle( - 'Local Exposure and Isolation (Bemanian & Beyer) metric\nWashington, D.C. census block groups to tracts', + 'Local Exposure and Isolation (Bemanian & Beyer) metric\n + Washington, D.C. census block groups to tracts', subtitle = 'Black non-Hispanic vs. white non-Hispanic' ) ``` From 8462005b6667a9b27d447eb30544866baa76f450 Mon Sep 17 00:00:00 2001 From: Ian D Buller Date: Sat, 6 Jul 2024 14:13:55 -0400 Subject: [PATCH 7/7] :memo: Additional formatting of README examples * removes horizontal scroll bar in HTML view --- README.md | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 8f6ae8f..694eddd 100644 --- a/README.md +++ b/README.md @@ -264,9 +264,11 @@ ggplot() + # Calculate NDI (Powell-Wiley) # # ---------------------------- # -# Compute the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for Washington, D.C. census tracts +# Compute the NDI (Powell-Wiley) values (2016-2020 5-year ACS) for +# Washington, D.C. census tracts powell_wiley2020DC <- powell_wiley(state = 'DC', year = 2020) -powell_wiley2020DCi <- powell_wiley(state = 'DC', year = 2020, imp = TRUE) # impute missing values +# impute missing values +powell_wiley2020DCi <- powell_wiley(state = 'DC', year = 2020, imp = TRUE) # ------------------------------------ # # Outputs from powell_wiley() function # @@ -276,7 +278,8 @@ powell_wiley2020DCi <- powell_wiley(state = 'DC', year = 2020, imp = TRUE) # imp # raw census characteristics for each tract powell_wiley2020DC$ndi -# The results from the principal component analysis used to compute the NDI (Powell-Wiley) values +# The results from the principal component analysis used to +# compute the NDI (Powell-Wiley) values powell_wiley2020DC$pca # A tibble containing a breakdown of the missingingness of the census characteristics used to @@ -345,7 +348,8 @@ ggplot() + caption = 'Source: U.S. Census ACS 2016-2020 estimates' ) + ggtitle( - 'Neighborhood Deprivation Index\nPopulation-weighted Quintiles (Powell-Wiley, non-imputed)', + 'Neighborhood Deprivation Index\n + Population-weighted Quintiles (Powell-Wiley, non-imputed)', subtitle = 'Washington, D.C. tracts as the referent' ) ```