R Spatial Lab Assignment # 2

Task 0 Setting Up Lab:

To set up for the lab, I changed my working directory to where I stored the folder setwd(“C:/Users/Max/Desktop/Section_08/R-Spatial_I_Lab”)

Task 1 COVID-19 Data Join:

#reads in the data from the covid file
covidData <- read_csv("tests-by-zcta_2021_04_23.csv", show_col_types = FALSE)

#I kept getting incompatible type errors so I used mutate to make this error stop
covidData <- covidData %>% mutate(MODIFIED_ZCTA = as.character(MODIFIED_ZCTA))

#joins by using left_join
nycZipSf <- nycZipSf %>% left_join(covidData, by = c("ZIPCODE" = "MODIFIED_ZCTA"))

Task 2 NYC Food Retail Aggregation:

#filtering the data
foodStoreData <- nysFoodSf %>% filter(grepl('[AJD]', Establishment.Type)) %>% st_transform(st_crs(nycZipSf))

#puts stores in the zip codes and counts
foodStoreCounts <- nycZipSf %>% st_join(foodStoreData, join = st_intersects) %>% group_by(ZIPCODE) %>% summarise(FoodStoreNum = sum(!is.na(Establishment.Type))) %>% st_drop_geometry()#not dropping geometry made my file glitch and not let me merge the files like I did below
## Warning in grep("^[.][.](?:[.]|[1-9][0-9]*)$", names): unable to translate
## '<ef>..County' to a wide string
## Warning in grep("^[.][.](?:[.]|[1-9][0-9]*)$", names): input string 25 is
## invalid
#merge
nycZipSf <- nycZipSf %>% left_join(foodStoreCounts, by = "ZIPCODE")

Task 3 NYC Health Facility Aggregation:

#filtering data
healthFacilityData <- nysHealthSf %>% filter(Short.Description == 'NH') %>% st_transform(st_crs(nycZipSf))

#puts nursing homes in the zip codes and counts
healthFacilityCounts <- nycZipSf %>% st_join(healthFacilityData, join = st_intersects) %>% group_by(ZIPCODE) %>% summarise(healthFacilityNumber = sum(!is.na(Facility.ID))) %>% st_drop_geometry()

#merge
nycZipSf <- nycZipSf %>% left_join(healthFacilityCounts, by = "ZIPCODE")

Task 4 Census ACS and NYC Planning Census Tract Join:

#read in the census tract data
nycCensusTract <- st_read("C:/Users/Max/Desktop/Section_08/R-Spatial_II_Lab/2010 Census Tracts/geo_export_1dc7b645-647b-4806-b9a0-7b79660f120a.shp", quiet = TRUE)

#FIPS codes for ACS data
nycCensusTract <- nycCensusTract %>%
mutate(countyFIPS = case_when(boro_name == "Bronx" ~ "005", boro_name == "Brooklyn" ~ "047", boro_name == "Manhattan" ~ "061", boro_name == "Queens" ~ "081", boro_name == "Staten Island" ~ "085"), tractFIPS = paste0("36",countyFIPS, ct2010)) #without adding 36 for NY State FIPS code the population map wont show up for some reason

#reads in the raw csv file
acsCSV <- read.csv("C:/Users/Max/Desktop/Section_08/R-Spatial_II_Lab/ACSDP5Y2018.DP05_data_with_overlays_2020-04-22T132935.csv", stringsAsFactors = FALSE)

#clean by removing first row
acsClean <- acsCSV[-1, ]

#renames data and cleans it more with the GEOID
acsData <- acsClean %>%
select(GEO_ID, totPop = DP05_0001E, elderlyPop = DP05_0024E, whitePop = DP05_0037E, blackPop = DP05_0038E, asianPop = DP05_0067E, hispanicPop = DP05_0071E) %>%

#turns the data into strict numeric formatting in case there are some issues with data that might lead to errors later on in the mapping process
mutate(censusCode = substr(GEO_ID, nchar(GEO_ID) - 10, nchar(GEO_ID)), totPop = as.numeric(totPop), elderlyPop = as.numeric(elderlyPop), whitePop = as.numeric(whitePop), blackPop = as.numeric(blackPop), asianPop = as.numeric(asianPop), hispanicPop = as.numeric(hispanicPop))

#attribute join
tractsWithACS <- left_join(nycCensusTract, acsData, by = c("tractFIPS" = "censusCode"))

Task 5 Aggregate ACS census to Zip Data:

#turns the polygons to centroids
tractPoints <- st_centroid(tractsWithACS)
## Warning: st_centroid assumes attributes are constant over geometries
tractPoints <- st_transform(tractPoints, st_crs(nycZipSf))

#spatial join
zipAndTracts <- st_join(nycZipSf, tractPoints, join = st_contains)

#summarizes the data
censusSummaryTable <- zipAndTracts %>%
group_by(ZIPCODE) %>%
summarise(TotalPopulation = sum(totPop, na.rm = TRUE), ElderlyPopulation = sum(elderlyPop, na.rm = TRUE), WhitePopulation = sum(whitePop, na.rm = TRUE), BlackPopulation = sum(blackPop, na.rm = TRUE), AsianPopulation = sum(asianPop, na.rm = TRUE), HispanicPopulation = sum(hispanicPop, na.rm = TRUE)) %>%

st_drop_geometry() #makes the table show up and doesn't break the code

#join
nycZipSf <- left_join(nycZipSf, censusSummaryTable, by = "ZIPCODE")

Mapping the Data:

#COVID Case Map
mapview(nycZipSf, zcol = "COVID_CASE_COUNT")
#Population Map
mapview(nycZipSf, zcol = "TotalPopulation")
#Food Store Map
mapview(nycZipSf, zcol = "FoodStoreNum")
#Nursing Home Map
mapview(nycZipSf, zcol = "healthFacilityNumber")
save(nycZipSf, tractsWithACS, file = "Max_Lab2_FinalData.RData")