Explanation of the template

Update the title with your information. Make sure to include identification information so that we know it is your submission.

Also update the author name and date accordingly.

Check out the Source Code from the top-right corner </>Code menu.

In the following R code chunk, load_packages is the code chunk name. include=FALSE suggests that the code chunk will run, but the code itself and its outputs will not be included in the rendered HTML. echo=TRUE in the following code chunk suggests that the code and results from running the code will be included in the rendered HTML.

R Spatial Lab Assignment # 1

Don’t use a single chunk for the entire assignment. Break it into multiple chunks.

task 1:


NYC_HealthFacs_zipcodes <- NYC_Health_Facility_sf %>%
  left_join(
    st_drop_geometry(nyc_zipcodes),
    by = c("Facility Zip Code" = "ZIPCODE")
  )

task 2:

Quarto markdown is different from R markdown in terms of chunk options. See chunk options at Quarto website.


NYC_HealthZIPRetail <- st_join(
    nys_retail_food_store_xy_sf,
    NYC_HealthFacs_zipcodes,
    join = st_within
)

task 3:

##### Assigning CRS to Heath Facility data
st_crs(NYC_Health_Facility_sf) <- 4326

##### Transforming to match zip code dataset
NYC_Health_Facility_sf <- st_transform(
  NYC_Health_Facility_sf,
  st_crs(nyc_zipcodes)
)

##### Performing the spatial join
NYC_HealthFacilities_zipcode_sf <- st_join(
  NYC_Health_Facility_sf,
  nyc_zipcodes,
  join = st_within
)

task 4:


##### Importing the data
Census_ACS <- read_csv("ACSDP5Y2018.DP05_data_with_overlays_2020-04-22T132935.csv")
NYC_Tract <- st_read("D:/adult shit/Career/Masters/S2026/GTECH785/R_Spatial/Week_08/Section_08/R-Spatial_II_Lab/R-Spatial_II_Lab/2010 Census Tracts/geo_export_1dc7b645-647b-4806-b9a0-7b79660f120a.shp")

##### GEOID creation and matching
Census_ACS <- Census_ACS %>%
  mutate(GEOID = substr(GEO_ID, 10, 20))
NYC_Tract <- NYC_Tract %>%
  mutate(
    county_fips = case_when(
      boro_code == 1 ~ "061",
      boro_code == 2 ~ "005",
      boro_code == 3 ~ "047",
      boro_code == 4 ~ "081",
      boro_code == 5 ~ "085"
    ),
    GEOID = paste0("36", county_fips, ct2010)
  )

Census_ACS$GEOID <- as.character(Census_ACS$GEOID)
NYC_Tract$GEOID <- as.character(NYC_Tract$GEOID)

##### Demographics select
Census_ACS_selected <- Census_ACS %>%
  select(
    GEOID,
    DP05_0001E,  # Total pop.
    DP05_0037E,  # White pop.
    DP05_0038E,  # Black pop.
    DP05_0039E,  # Asian pop.
    DP05_0018E,  # Median age
    DP05_0024E   # Under 18
  )

##### Joining the datasets
NYC_ACSPlanning <- NYC_Tract %>%
  left_join(Census_ACS_selected, by = "GEOID")

task 5:


##### Transforming CRS to match
NYC_ACSPlanning <- st_transform(NYC_ACSPlanning, st_crs(NYC_HealthFacilities_zipcode_sf))

##### ACS and zip code spatial join
ACS_zipcode <- st_join(
  NYC_ACSPlanning,
  NYC_HealthFacilities_zipcode_sf %>% select(`Facility Zip Code`),
  join = st_intersects
)

##### Converting ACS columns to numeric
acs_cols <- c("DP05_0001E", "DP05_0037E", "DP05_0038E", "DP05_0039E", "DP05_0024E", "DP05_0018E")
ACS_zipcode <- ACS_zipcode %>%
  mutate(across(all_of(acs_cols), ~ as.numeric(gsub(",", "", .))))

##### Aggregating demographic data by zip code
ACS_zip_demographics <- ACS_zipcode%>%
  st_drop_geometry() %>%
  group_by(`Facility Zip Code`) %>%
  summarise(
    total_pop = sum(DP05_0001E, na.rm = TRUE),
    white_pop = sum(DP05_0037E, na.rm = TRUE),
    black_pop = sum(DP05_0038E, na.rm = TRUE),
    asian_pop = sum(DP05_0039E, na.rm = TRUE),
    under18_pop = sum(DP05_0024E, na.rm = TRUE),
    median_age = sum(DP05_0018E * DP05_0001E, na.rm = TRUE) / sum(DP05_0001E, na.rm = TRUE)
  )

##### Attaching aggregated data to zip code polygons
NYC_ACS_HealthFacilityzip_polygon <- NYC_HealthFacilities_zipcode_sf %>%
  left_join(ACS_zip_demographics, by = "Facility Zip Code")

##### Test map looking at total population
mapview(NYC_ACS_HealthFacilityzip_polygon, zcol = "total_pop")