B01003_001 B19301_001 - Estimate!!Per capita income in the past 12 months (in 2020 inflation-adjusted dollars) (C17002_002+C17002_003)/C17002_001
# C17002_001 - Estimate!!Total - Ratio of Income to Poverty in the Last 12 Months
# C17002_002 - Estimate!!Total!!Under .50
# C17002_003 - Estimate!!Total!!.50 to .99 1 - (B15003_016+B15003_017+B15003_018+B15003_019+B15003_020+B15003_021+B15003_022+B15003_023+B15003_024+B15003_025)/B15003_001
# B15003_001 - Estimate!!Total
# B15003_016 - Estimate!!Total!!12th grade, no diploma # B15003_017 - Estimate!!Total!!Regular high school diploma
# B15003_018 - Estimate!!Total!!GED or alternative credential
# B15003_019 - Estimate!!Total!!Some college, less than 1 year
# B15003_020 - Estimate!!Total!!Some college, 1 or more years, no degree #B15003_021 - Estimate!!Total!!Associate's degree
# B15003_022 - Estimate!!Total!!Bachelor's degree
# B15003_023 - Estimate!!Total!!Master's degree
# B15003_024 - Estimate!!Total!!Professional school degree
# B15003_025 - Estimate!!Total!!Doctorate degree (B25033_006+B25033_007+B25033_012+B25033_013)/B25033_001
# B25033_001 - Estimate!!Total #B25033_006 - Estimate!!Total!!Owner occupied!!Mobile home
# B25033_007 - Estimate!!Total!!Owner occupied!!Boat, RV, van, etc. # B25033_012 - Estimate!!Total!!Renter occupied!!Mobile home
# B25033_013 - Estimate!!Total!!Renter occupied!!Boat, RV, van, etc. (B25044_003+B25044_010)/B25044_001
# B25044_001 - Estimate!!Total
# B25044_003 - Estimate!!Total!!Owner occupied!!No vehicle available # B25044_010 - Estimate!!Total!!Renter occupied!!No vehicle available B23025_005/B23025_003
# B23025_003 - Estimate!!Total!!In labor force!!Civilian labor force # B23025_005 - Estimate!!Total!!In labor force!!Civilian labor force!!Unemployed (B25014_005+B25014_006+B25014_007+B25014_011+B25014_012+B25014_013)/B25014_001
# B25014_001 - Estimate!!Total
# B25014_005 - Estimate!!Total!!Owner occupied!!1.01 to 1.50 occupants per room
# B25014_006 - Estimate!!Total!!Owner occupied!!1.51 to 2.00 occupants per room
# B25014_007 - Estimate!!Total!!Owner occupied!!2.01 or more occupants per room
# B25014_011 - Estimate!!Total!!Renter occupied!!1.01 to 1.50 occupants per room
# B25014_012 - Estimate!!Total!!Renter occupied!!1.51 to 2.00 occupants per room
# B25014_013 - Estimate!!Total!!Renter occupied!!2.01 or more occupants per room (B25024_007+B25024_008+B25024_009)/B25024_001
# B25024_001 - Estimate!!Total
# B25024_007 - Estimate!!Total!!10 to 19
# B25024_008 - Estimate!!Total!!20 to 49
# B25024_009 - Estimate!!Total!!50 or more B09021_022/B09021_001
# B09021_022 - Estimate!!Total!!65 years and over
# B09021_001 - Estimate!!Total B99163_005/B99163_001
# B99163_001 - Estimate!!Total
# B99163_005 - Estimate!!Total!!Speak other languages!!Ability to speak English –!!Not allocated (B01001_003+B01001_004+B01001_005+B01001_006+B01001_027+B01001_028+B01001_029+B01001_030)/B01003_001
# B01001_003 - Estimate!!Total!!Male!!Under 5 years
# B01001_004 - Estimate!!Total!!Male!!5 to 9 years
# B01001_005 - Estimate!!Total!!Male!!10 to 14 years
# B01001_006 - Estimate!!Total!!Male!!15 to 17 years
# B01001_027 - Estimate!!Total!!Female!!Under 5 years
# B01001_028 - Estimate!!Total!!Female!!5 to 9 years
# B01001_029 - Estimate!!Total!!Female!!10 to 14 years
# B01001_030 - Estimate!!Total!!Female!!15 to 17 years 1-(B03002_003/B03002_001)
# B03002_003 - Estimate!!Total (WHITE ALONE, NOT HISPANIC OR LATINO)Sources:
1-B25002_003/B25002_001
# B25002_001 - Estimate!!Total (TOTAL NUMBER OF HOUSING UNITS)
# B25002_003 - Estimate!!Total!!Vacant B25003_003/B25003_001
# B25003_001 - Estimate!!Total B25003_003 - Estimate!!Total!!Renter occupied (B25070_007+B25070_008+B25070_009+B25070_010)/b25070_001
# B25070_007 - Estimate!!Total!!30.0 to 34.9 percent
# B25070_008 - Estimate!!Total!!35.0 to 39.9 percent
# B25070_009 - Estimate!!Total!!40.0 to 49.9 percent
# B25070_010 - Estimate!!Total!!50.0 percent or more B25071_001
# B25071_001 - Estimate!!Median gross rent as a percentage of household income B11007_003/B11007_001
# B11007_001 - Estimate!!Total
# B11007_003 - Estimate!!Total!!Households with one or more people 65 years and over!!1-person household (B25034_008+B25034_009+B25034_010+B25034_011)/B25034_001
# B25034_001 - Estimate!!Total
# B25034_008 - Estimate!!Total!!Built 1960 to 1969
# B25034_009 - Estimate!!Total!!Built 1950 to 1959
# B25034_010 - Estimate!!Total!!Built 1940 to 1949
# B25034_011 - Estimate!!Total!!Built 1939 or earlierThese Variables were only found to be available at the Tract level, that is not to say a suitable variable does not exist at the block-group level
Percent of Population Below Poverty Level
Percent of Population 5< with a Disability
Percent of Population Living in Group Quarters
Percent of Children Living in Single Parent Households
#c('B18101_025','B18101_026','B18101_006','B18101_007','C18130_009','C18130_010','C18130_016','C18130_017','B17020_001','B17020_002','B26001_001','B11001_001','B11004_012','B11004_018','B11001_001','B09008_010','B09008_011','B09008_012','B17023_001','B17023_016','B17023_017','B17023_018') (B18101_026+B18101_007+C18130_010+C18130_017)/(B18101_025+B18101_006+C18130_009+C18130_016)
# B18101_025 - Estimate!!Total!!Female!!5 to 17 years
# B18101_026 - Estimate!!Total!!Female!!5 to 17 years!!With a disability
# B18101_006 - Estimate!!Total!!Male!!5 to 17 years
# B18101_007 - Estimate!!Total!!Male!!5 to 17 years!!With a disability
# C18130_009 - Estimate!!Total!!18 to 64 years
# C18130_010 - Estimate!!Total!!18 to 64 years!!With a disability
# C18130_016 - Estimate!!Total!!65 years and over
# C18130_017 - Estimate!!Total!!65 years and over!!With a disability B26001_001/B01003_001
# B26001_001 - Estimate!!Total!!Group quarters population2010 - 2018: (B09008_010+B09008_011+B09008_012)/B09008_001
# B09008_001 - Estimate!!Total
# B09008_010 - Estimate!!Total!!No unmarried partner of householder present!!In family households!!In male householder, no wife present, family
# B09008_011 - Estimate!!Total!!No unmarried partner of householder present!!In family households!!In female householder, no husband present, family
# B09008_012 - Estimate!!Total!!No unmarried partner of householder present!!In nonfamily households2020: B09005_001 Estimate!!Total: HOUSEHOLD TYPE FOR CHILDREN UNDER 18 YEARS IN HOUSEHOLDS (EXCLUDING HOUSEHOLDERS, SPOUSES, AND UNMARRIED PARTNERS)
B09005_004 Estimate!!Total:!!In male householder, no spouse/partner present household HOUSEHOLD TYPE FOR CHILDREN UNDER 18 YEARS IN HOUSEHOLDS (EXCLUDING HOUSEHOLDERS, SPOUSES, AND UNMARRIED PARTNERS) B09005_005 Estimate!!Total:!!In female householder, no spouse/partner present household HOUSEHOLD TYPE FOR CHILDREN UNDER 18 YEARS IN HOUSEHOLDS (EXCLUDING HOUSEHOLDERS, SPOUSES, AND UNMARRIED PARTNERS)
**OR** (these variables are the same for 2018 and 2020)
(B23008_008+B23008_021)/(B23008_002+B23008_015)
#B23008_008 - Estimate!!Total!!Under 6 years!!Living with one parent
#B23008_021 - Estimate!!Total!!6 to 17 years!!Living with one parent
#B23008_002 - Estimate!!Total!!Under 6 years
#B23008_015 - Estimate!!Total!!6 to 17 years (B17023_016+B17023_017+B17023_018)/B22002_001
# B17023_001 - Estimate!!Total
# B17023_016 - Estimate!!Total!!Income in the past 12 months below poverty level!!Other families!!Female householder, no husband present!!1 or 2 own children of the householder
# B17023_017 - Estimate!!Total!!Income in the past 12 months below poverty level!!Other families!!Female householder, no husband present!!3 or 4 own children of the householder
# B17023_018 - Estimate!!Total!!Income in the past 12 months below poverty level!!Other families!!Female householder, no husband present!!5 or more own children of the householder#We have the different way to call the packages but I leave this chunk his way to refer back if we want to learn other way.
ReqPkgs <- c('knitr','sp','sf','spdep','tidycensus','dplyr','tidyr','mapview','RColorBrewer','leaflet','leafpop','ggplot2')
ReqPkgs <- as.list(ReqPkgs)
#suppressMessages(lapply(ReqPkgs, install.packages, character.only = TRUE))
suppressMessages(lapply(ReqPkgs, require, character.only = TRUE))## Warning in library(package, lib.loc = lib.loc, character.only = TRUE,
## logical.return = TRUE, : there is no package called 'spdep'## [[1]]
## [1] TRUE
##
## [[2]]
## [1] TRUE
##
## [[3]]
## [1] TRUE
##
## [[4]]
## [1] FALSE
##
## [[5]]
## [1] TRUE
##
## [[6]]
## [1] TRUE
##
## [[7]]
## [1] TRUE
##
## [[8]]
## [1] TRUE
##
## [[9]]
## [1] TRUE
##
## [[10]]
## [1] TRUE
##
## [[11]]
## [1] TRUE
##
## [[12]]
## [1] TRUECounties <- tigris::list_counties(state = "California")
Counties <- Counties$county
print(Counties)## [1] "Alameda" "Alpine" "Amador" "Butte"
## [5] "Calaveras" "Colusa" "Contra Costa" "Del Norte"
## [9] "El Dorado" "Fresno" "Glenn" "Humboldt"
## [13] "Imperial" "Inyo" "Kern" "Kings"
## [17] "Lake" "Lassen" "Los Angeles" "Madera"
## [21] "Marin" "Mariposa" "Mendocino" "Merced"
## [25] "Modoc" "Mono" "Monterey" "Napa"
## [29] "Nevada" "Orange" "Placer" "Plumas"
## [33] "Riverside" "Sacramento" "San Benito" "San Bernardino"
## [37] "San Diego" "San Francisco" "San Joaquin" "San Luis Obispo"
## [41] "San Mateo" "Santa Barbara" "Santa Clara" "Santa Cruz"
## [45] "Shasta" "Sierra" "Siskiyou" "Solano"
## [49] "Sonoma" "Stanislaus" "Sutter" "Tehama"
## [53] "Trinity" "Tulare" "Tuolumne" "Ventura"
## [57] "Yolo" "Yuba"#new_counties <- Counties[Counties != "St. Louis"] #Remove a duplicated St. Louis city
#print(new_counties)#County level Variables
varsBG <- c('B25003_001','B25003_003','B25070_007','B25070_008','B25070_009','B25070_010','B25071_001','B11007_001','B11007_003','B25034_001','B25034_008','B25034_009','B25034_010','B25034_011','B01003_001','B19301_001','B25033_001','B25033_006','B25033_007','B25033_012','B25033_013','B25044_001','B25044_003','B25044_010','B23025_003','B23025_005','B25014_001','B25014_005','B25014_006','B25014_007','B25014_011','B25014_012','B25014_013','B25024_001','B25024_007','B25024_008','B25024_009','B09021_022','B09021_001','B01001_020','B01001_021','B01001_022','B01001_023','B01001_024','B01001_025','B01001_044','B01001_045','B01001_046','B01001_047','B01001_048','B01001_049','B99163_001','B99163_005','B01001_003','B01001_004','B01001_005','B01001_006','B01001_027','B01001_028','B01001_029','B01001_030','B03002_003','B02001_004','B02001_001','B02001_003','B03003_003','B02001_006','B02001_007','B02001_008','B03002_003','B03002_001','B02001_001','B25002_001','B25002_003','B15003_001','B15003_016','B15003_017','B15003_018','B15003_019','B15003_020','B15003_021','B15003_022','B15003_023','B15003_024','B15003_025','B02001_005','B03003_001','B25070_001','B17020_001','C17002_001','C17002_002','C17002_003','C17002_004', 'B23008_008', 'B23008_021', 'B23008_002','B23008_015','B18101_025','B18101_026','B18101_006','B18101_007','C18130_009','C18130_010','C18130_016','C18130_017','B26001_001','B11004_012','B11004_018','B17023_001','B17023_016','B17023_017','B17023_018','B22002_001' )
#Tract Level Variables
#varsCT <- c('B18101_025','B18101_026','B18101_006','B18101_007','C18130_009','C18130_010','C18130_016','C18130_017','B26001_001','B11004_012','B11004_018','B17023_001','B17023_016','B17023_017','B17023_018','B22002_001')
#Han Vu: Removed not applicable variables: (B09008_010+B09008_011+B09008_012)/B09008_001; use (B23008_008+B23008_021)/(B23008_002+B23008_015) variables of block group levelThis chunk of code is pulling in all the county level variables described previously
CBG18_1 <- tidycensus::get_acs(
geography = 'county',
state = 'CA',
county = Counties, #The county list created in the previous step
survey = 'acs5',
year = 2021,
variables = varsBG,
geometry = FALSE,
output = 'wide',
show_call = FALSE
)## Getting data from the 2017-2021 5-year ACS#Separate Place Names#
#Again, we have better way (I think) to call out separate function, but I leave it his way. It's kind of cool
CBG18_1 <- tidyr::separate(data = CBG18_1, col = "NAME", into = c("COUNTY","STATE"), sep = ",", remove = FALSE)
#CBG18_1$TRACT_GEOID <- substring(CBG18_1$GEOID, 1, 11)
#print(dim(CBG18_1)) # CT18B <- tidycensus::get_acs(
# geography = 'county',
# state = 'CA',
# county = Counties,
# survey = 'acs5',
# year = 2021,
# variables = varsCT,
# geometry = FALSE,
# output = 'wide',
# show_call = FALSE
# )
#
# #Separate Place Names#
#
# CT18B <- tidyr::separate(data = CT18B, col = "NAME", into = c("COUNTY","STATE"), sep = ",")
#
# #CT18B$TRACT_GEOID <- CT18B$GEOID
#
# #print(dim(CT18B))This chunk uses dplyr to join the tract level variables to the block groups, the variables remain consistent across the block group, this is not ideal and if you find some way to represent these variables more accurately at the block group level, please feel free to change them.
# JndTbls <- dplyr::left_join(x = CBG18_1, y = CT18B, by = "GEOID")
#
# dim(JndTbls) #get dimensions#SOCIOECONOMIC STATUS:
CBG18_1$TOTPOP <- CBG18_1$B01003_001E #TOTAL_POPULATION -
CBG18_1$POV <- (CBG18_1$C17002_002E+CBG18_1$C17002_003E)/CBG18_1$C17002_001E #PER_POVERTY
CBG18_1$UNEMP <- CBG18_1$B23025_005E/CBG18_1$B23025_003E #PER_UNEMPLOYED
CBG18_1$PCI <- CBG18_1$B19301_001E #PER_CAPITA_INCOME#LANGUAGE AND EDUCATION:
CBG18_1$NOHSDP <- 1-((CBG18_1$B15003_016E+CBG18_1$B15003_017E+CBG18_1$B15003_018E+CBG18_1$B15003_019E+CBG18_1$B15003_020E+CBG18_1$B15003_021E+CBG18_1$B15003_022E+CBG18_1$B15003_023E+CBG18_1$B15003_024E+CBG18_1$B15003_025E)/CBG18_1$B15003_001E) #PER_LESS_HS_GRAD
CBG18_1$LIMENG <- CBG18_1$B99163_005E/CBG18_1$B99163_001E #PER_POOR_ENGLISH#DEMOGRAPHICS:
CBG18_1$AGE65 <- CBG18_1$B09021_022E/CBG18_1$B09021_001E #PER_OVER_65
CBG18_1$AGE17 <- (CBG18_1$B01001_003E+CBG18_1$B01001_004E+CBG18_1$B01001_005E+CBG18_1$B01001_006E+CBG18_1$B01001_027E+CBG18_1$B01001_028E+CBG18_1$B01001_029E+CBG18_1$B01001_030E)/CBG18_1$B01003_001E #PER_UNDER_17
CBG18_1$DISABL <- (CBG18_1$B18101_026E+CBG18_1$B18101_007E+CBG18_1$C18130_010E+CBG18_1$C18130_017E)/(CBG18_1$B18101_025E+CBG18_1$B18101_006E+CBG18_1$C18130_009E+CBG18_1$C18130_016E) #PER_DISABLED
CBG18_1$SNGPNT <- (CBG18_1$B23008_008E+CBG18_1$B23008_021E)/(CBG18_1$B23008_002E+CBG18_1$B23008_015E) #PER_SINGL_PRNT Option 2 (See Notes 496-521)
#HOUSING AND TRANSPORTATION:
CBG18_1$MUNIT <- (CBG18_1$B25024_007E+CBG18_1$B25024_008E+CBG18_1$B25024_009E)/CBG18_1$B25024_001E #PER_MULTI_DWELL
CBG18_1$MOBILE <- (CBG18_1$B25033_006E+CBG18_1$B25033_007E+CBG18_1$B25033_012E+CBG18_1$B25033_013E)/CBG18_1$B25033_001E #PER_MOBILE_DWEL
CBG18_1$CROWD <- (CBG18_1$B25014_005E+CBG18_1$B25014_006E+CBG18_1$B25014_007E+CBG18_1$B25014_011E+CBG18_1$B25014_012E+CBG18_1$B25014_013E)/CBG18_1$B25014_001E #PER_CROWD_DWELL
CBG18_1$NOVEH <- (CBG18_1$B25044_003E+CBG18_1$B25044_010E)/CBG18_1$B25044_001E #PER_NO_VEH_AVAIL
CBG18_1$GROUPQ <- CBG18_1$B26001_001E/CBG18_1$B01003_001E #PER_GROUP_DWELL#RACIAL AND ETHNIC MAKEUP:
CBG18_1$MINORITY <- 1-(CBG18_1$B03002_003E/CBG18_1$B03002_001E)
CBG18_1$NTVAMRCN <- CBG18_1$B02001_004E/CBG18_1$B02001_001E
CBG18_1$ASIAN <- CBG18_1$B02001_005E/CBG18_1$B02001_001E
CBG18_1$BLACK <- CBG18_1$B02001_003E/CBG18_1$B02001_001E
CBG18_1$HISPLATX <- CBG18_1$B03003_003E/CBG18_1$B03003_001E
CBG18_1$PACISL <- CBG18_1$B02001_006E/CBG18_1$B02001_001E
CBG18_1$OTHRRACE <- CBG18_1$B02001_007E/CBG18_1$B02001_001E
CBG18_1$MULTRACE <- CBG18_1$B02001_008E/CBG18_1$B02001_001E
CBG18_1$WHITE <- CBG18_1$B03002_003E/CBG18_1$B03002_001E
#OPTIONAL VARIABLES:
CBG18_1$HOMESOCCPD <- 1-CBG18_1$B25002_003E/CBG18_1$B25002_001E
CBG18_1$RENTER <- CBG18_1$B25003_003E/CBG18_1$B25003_001E
CBG18_1$RENTBURDEN <- (CBG18_1$B25070_007E+CBG18_1$B25070_008E+CBG18_1$B25070_009E+CBG18_1$B25070_010E)/CBG18_1$B25070_001E
CBG18_1$RENTASPERINCOME <- (CBG18_1$B25071_001E/100)
CBG18_1$OVR65ALONE <- CBG18_1$B11007_003E/CBG18_1$B11007_001E
CBG18_1$BLTBFR1969 <- (CBG18_1$B25034_008E+CBG18_1$B25034_009E+CBG18_1$B25034_010E+CBG18_1$B25034_011E)/CBG18_1$B25034_001E
CBG18_1$SVRPOV <- CBG18_1$C17002_002E/CBG18_1$C17002_001E
CBG18_1$MODPOV <- CBG18_1$C17002_004E/CBG18_1$C17002_001E
CBG18_1$SINGLMTHRPVRTY <-(CBG18_1$B17023_016E+CBG18_1$B17023_017E+CBG18_1$B17023_018E)/CBG18_1$B17023_001E#RANKING#
#These functions rank each of the variables, variables with matching values across ranks are given the max score, this is the default in excel where the original formulae were derived
a <- CBG18_1$RNKPOV <- rank(x = -CBG18_1$POV, na.last = "keep", ties.method = "max")
b <- CBG18_1$RNKUNEMP <- rank(x = -CBG18_1$UNEMP, na.last = "keep", ties.method = "max")
c <- CBG18_1$RNKPCI <- rank(x = CBG18_1$PCI, na.last = "keep", ties.method = "max") #Note that we are not taking the inverse here because the higher the Per Capita Income, the greater the Adaptive Capacity of a given blockgroup
d <- CBG18_1$RNKNOHSDP <- rank(x = -CBG18_1$NOHSDP, na.last = "keep", ties.method = "max")
e <- CBG18_1$RNKLIMENG <- rank(x = -CBG18_1$LIMENG, na.last = "keep", ties.method = "max")
f <- CBG18_1$RNKAGE65 <- rank(x = -CBG18_1$AGE65, na.last = "keep", ties.method = "max")
g <- CBG18_1$RNKAGE17 <- rank(x = -CBG18_1$AGE17, na.last = "keep", ties.method = "max")
h <- CBG18_1$RNKDISABL <- rank(x = -CBG18_1$DISABL, na.last = "keep", ties.method = "max")
i <- CBG18_1$RNKSNGPNT <- rank(x = -CBG18_1$SNGPNT, na.last = "keep", ties.method = "max")
j <- CBG18_1$RNKMUNIT <- rank(x = -CBG18_1$MUNIT, na.last = "keep", ties.method = "max")
k <- CBG18_1$RNKMOBILE <- rank(x = -CBG18_1$MOBILE, na.last = "keep", ties.method = "max")
l <- CBG18_1$RNKCROWD <- rank(x = -CBG18_1$CROWD, na.last = "keep", ties.method = "max")
m <- CBG18_1$RNKNOVEH <- rank(x = -CBG18_1$NOVEH, na.last = "keep", ties.method = "max")
n <- CBG18_1$RNKGROUPQ <- rank(x = -CBG18_1$GROUPQ, na.last = "keep", ties.method = "max")#Sum The Ranks
CBG18_1$SUMRANK = a+b+c+d+e+f+g+h+i+j+k+l+m+n
#Derive the Adaptive Capacity Index
CBG18_1$ADPTVCAPACITY <- dplyr::percent_rank(CBG18_1$SUMRANK)This Finds How Much Each Variable Contributed to The Final Percent Rank (Optional)
# This Determines the Percentage Contribution to Final Rank
#CBG18_1$GEOID <- JndTbls$GEOID.x #Geoid.s was created in the previous join and needs to be renamed before joining it to the geometry
geoid <- which(colnames(CBG18_1)=="GEOID")
a <- which(colnames(CBG18_1)=="RNKPOV")
z <- which(colnames(CBG18_1)=="RNKGROUPQ")
cols <- as.vector(names(CBG18_1[a:z]))
Func <- function(x){round((abs(x)/abs(CBG18_1$SUMRANK)),2)*100}
RnkPerc <- dplyr::mutate_at(.tbl = CBG18_1, .vars = cols, .funs = Func)
RnkPerc <- RnkPerc[c(geoid, a:z)]
CBG18_1 <- dplyr::right_join(CBG18_1, RnkPerc, by = "GEOID")#JndTbls$GEOID <- JndTbls$GEOID.x #Geoid.x was created in the previous join and needs to be renamed before joining it to the geometry
options(tigris_use_cache = TRUE)
blockgroup_Geom <- tigris::counties(state = 'CA', cb = TRUE) #we are using simplified geometry here, this can be changed by setting cb = FALSE, but takes a little bit longer to download## Retrieving data for the year 2021JndTblsSP <- sp::merge(x = blockgroup_Geom, CBG18_1, by = 'GEOID') #Now we're using the GEOID to join the Census Data to the GeometrysuppressPackageStartupMessages(require(leaflet))
suppressPackageStartupMessages(require(dplyr))
suppressPackageStartupMessages(require(leaflet.esri))
pop <- paste0(
"<h3>","<b>", JndTblsSP$COUNTY,"</b>","</h3>",
#"<b>", JndTblsSP$CENSUS_TRACT.x, "</b>","<br>",
"<b>","TOTAL POPULATION: ", prettyNum(JndTblsSP$TOTPOP, big.mark=","), " +/- ",JndTblsSP$B01003_001M,"</b>","<br>",
"<b>","ADAPTIVE CAPACITY: ", round(100*(JndTblsSP$ADPTVCAPACITY), 1),"%","</b>","<br>",
"<b><h4>SOCIOECONOMIC STATUS:<b></h4>",
"<b>PCT LIVING IN POVERTY: </b>", round(100*(JndTblsSP$POV), 1), "%","<br>",
"<b>PCT 16+ UNEMPLOYED: </b>", round(100*(JndTblsSP$UNEMP), 1), "%","<br>",
"<b>PER CAPITA INCOME: </b>", "$", prettyNum(JndTblsSP$PCI, big.mark=","),"<br>",
"<b><h4>LANGUAGE AND EDUCATION:<b></h4>",
"<b>PCT OF POP 25+ LESS THAN 12th GRADE: </b>", round(100*(JndTblsSP$NOHSDP),1), "%","<br>",
"<b>PCT NO ENGLISH: </b>", round(100*(JndTblsSP$LIMENG),1), "%","<br>",
"<b><h4>DEMOGRAPHICS:</h4><b>",
"<b>PCT UNDER AGE OF 17: </b>", round(100*(JndTblsSP$AGE17),1), "%","<br>",
"<b>PCT 65+: </b>", round(100*(JndTblsSP$AGE65),1), "%","<br>",
"<b>PCT DISABLED: </b>", round(100*(JndTblsSP$DISABL),1), "%","<br>",
#"<b>PCT CHLDRN LVNG IN SNGL PARENT HSHLDS: </b>", round(100*(JndTblsSP$SNGPNT),1), "%","<br>",
"<b><h4>HOUSING AND TRANSPORTATION:</h4><b>",
"<b>PCT LIVING IN MULTI-UNIT STRUCTURE: </b>", round(100*(JndTblsSP$MUNIT),1), "%","<br>",
"<b>PCT MOBILE DWELLING: </b>", round(100*(JndTblsSP$MOBILE),1), "%","<br>",
"<b>PCT LIVING IN CROWDED DWELLING: </b>", round(100*(JndTblsSP$CROWD),1), "%","<br>",
"<b>PCT WITH NO VEHICLE ACCESS: </b>", round(100*(JndTblsSP$NOVEH),1), "%","<br>",
"<b>PCT LIVING IN GROUP QUARTERS: </b>", round(100*(JndTblsSP$GROUPQ),1), "%","<br>",
"<b><h4>RACIAL AND ETHNIC MAKEUP:<b></h4>",
"<b>PCT MINORITY: </b>", round(100*(JndTblsSP$MINORITY),1), "%"
) #Here we're creating a popup for our interactive map, include whatever variables you want here!
BRBG <- RColorBrewer::brewer.pal(n = 11, name = "BrBG")
pal <- leaflet::colorQuantile(
palette = BRBG,
domain = JndTblsSP$ADPTVCAPACITY, n = 11, reverse = FALSE
) #Creating a Color Pallete, Feel free to choose whatever one you want, see the package Viridis for some cool options
myMap <- leaflet(data = JndTblsSP) %>% addTiles() %>% addPolygons(
color = "#444444",
weight = 1,
smoothFactor = 0.5,
opacity = 0.5,
fillOpacity = 0.5,
fillColor = ~pal(ADPTVCAPACITY),
highlightOptions = highlightOptions(color = "white", weight = 2, bringToFront = TRUE),
popup = pop, popupOptions = popupOptions(maxHeight = 250, maxWidth = 250, )) %>% addLegend("bottomright",
pal = pal,
values = JndTblsSP$ADPTVCAPACITY,
title = "Adaptive Capacity Score",
labFormat = labelFormat(prefix = ""),
opacity = 0.75) ## Warning: sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
## Need '+proj=longlat +datum=WGS84'myMap#Save the data to make Boone version
#write.csv(x = JndTbls, paste0(Sys.getenv("HOME"), "/Documents/Spring2022/final_project_spring2022/data/Adaptive_Capacity_R.csv"))