R Notebook

library(readxl)
library(leaflet)
library(sf)     

## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE

library(dplyr)   

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(spData) 

## To access larger datasets in this package, install the spDataLarge
## package with: `install.packages('spDataLarge',
## repos='https://nowosad.github.io/drat/', type='source')`

library(urbnmapr)
library(ggplot2)
library(ggthemes)
library(terra)

## terra 1.7.71

library(tidyterra)

## 
## Attaching package: 'tidyterra'

## The following object is masked from 'package:stats':
## 
##     filter

library(sp)
library(tidyr)

## 
## Attaching package: 'tidyr'

## The following object is masked from 'package:terra':
## 
##     extract

setwd("~/Documents/DIDA370/NE1_50M_SR_W")

w_rast <- rast("NE1_50M_SR_W.tif")

states <- get_urbn_map("states", sf=TRUE)

states <- states %>% 
  filter(state_abbv != "AK" & state_abbv != "HI") %>% 
  st_transform("EPSG:4326")

## old-style crs object detected; please recreate object with a recent sf::st_crs()

us_rast <- crop(w_rast, states)

ggplot()+
  geom_spatraster(data = us_rast)+
  geom_sf(states, mapping = aes(), fill = 'transparent', color = "black")+
  theme_map()+
  scale_fill_whitebox_c(
    palette = "muted",
    na.value = "white")+
  labs(title = "Landcover in the US",
       fill = "Fill")+
  theme(plot.title = element_text(hjust = 0.5, size = 16),
        legend.position="right")

## <SpatRaster> resampled to 501416 cells for plotting

## ! `tidyterra::geom_spatraster()`: Plotting 3 overlapping layers: NE1_50M_SR_W_1, NE1_50M_SR_W_2, and NE1_50M_SR_W_3. Either:

##   Use `facet_wrap(~lyr)` for faceting or

##   Use `aes(fill = <name_of_layer>)` for displaying single layers

data <- read_excel("J-1.xls")

## New names:
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`

data1 <- data[-(1:4),][-(53:61),]
#https://help.displayr.com/hc/en-us/articles/360003863576-How-to-Remove-a-Row-or-Column-from-a-Table-Using-R

colnames(data1) = c("states", "9th_grade_or_less", "9th_to_12th", "high_school", "some_college", "associate","bachelor","graduate")
#https://help.displayr.com/hc/en-us/articles/360002876876-How-to-Relabel-Rows-and-Columns-in-an-R-Table

data1[, 2:8] <- sapply(data1[, 2:8], as.numeric)
#https://stackoverflow.com/questions/2288485/how-to-convert-a-data-frame-column-to-numeric-type

data1$degree <- data1$associate + data1$bachelor + data1$graduate
  
state_data_full <- states %>%
  left_join(data1,by = c("state_name" = "states"))

states.sf = st_transform(state_data_full, "EPSG:4326")

p_popup <- paste0("<strong>High School Graduation Rate: </strong>", state_data_full$high_school)
p_popup2 <- paste0("<strong>College or Graduate Degree: </strong>", state_data_full$degree)

pal_fun <- colorQuantile("YlOrRd", states.sf$high_school, n = 9)
pal_fun2 <- colorQuantile("Blues", states.sf$degree, n = 9)

leaflet() %>%
  leaflet::addPolygons(data = states.sf, 
                       stroke = FALSE, 
                       fillColor = ~pal_fun(high_school), 
                       fillOpacity = 1, 
                       smoothFactor = 0.5, 
                       popup = p_popup,
                       group = "High School Graduation Rate") %>% 
    leaflet::addPolygons(data = states.sf, 
                       stroke = FALSE, 
                       fillColor = ~pal_fun2(degree), 
                       fillOpacity = 1, 
                       smoothFactor = 0.5, 
                       popup = p_popup2,
                       group = "College or Graduate Degree") %>% 
    addLegend("bottomright",
            pal=pal_fun, 
            values=states.sf$high_school, 
            title = 'High School Graduation Rate',
            group = "High School Graduation Rate") %>%
    addLegend("bottomleft",  
            pal=pal_fun2,    
            values=states.sf$degree, 
            title = 'College or Graduate Degree',
            group = "College or Graduate Degree") %>%
    addProviderTiles(providers$CartoDB.Positron) %>% 
    addLayersControl(overlayGroups = c("High School Graduation Rate", "College or Graduate Degree"),
                   options = layersControlOptions(collapsed = FALSE))

#I wasn't sure which dynamic map to use so I just included both maps

points <- st_point_on_surface(state_data_full)

## Warning: st_point_on_surface assumes attributes are constant over geometries

## Warning in st_point_on_surface.sfc(st_geometry(x)): st_point_on_surface may not
## give correct results for longitude/latitude data

points <- points %>% st_transform("EPSG:4326")
state_wgs <- state_data_full %>% st_transform("EPSG:4326")

leaflet() %>%
  leaflet::addPolygons(data = state_wgs,
                       stroke = T,
                       weight = 0.5,
                       fillOpacity = 0.8,
                       color = "gray",
                       fillColor = "lightgray") %>% 
  leaflet::addCircleMarkers(data = points,
                            stroke = F,
                            fillColor = ~pal_fun(high_school), 
                            popup = p_popup2,
                            group = "High School Graduation Rate",
                            fillOpacity = 1,
                            radius = ~ (high_school*10)) %>% 
  leaflet::addPolygons(data = state_wgs,
                       stroke = T,
                       weight = 0.5,
                       fillOpacity = 0.8,
                       color = "gray",
                       fillColor = "lightgray") %>% 
  leaflet::addCircleMarkers(data = points,
                            stroke = F,
                            fillColor = ~pal_fun2(degree), 
                            popup = p_popup2,
                            group = "College or Graduate Degree",
                            fillOpacity = 1,
                            radius = ~ (degree*10)) %>% 
  addLegend("bottomright",
            pal=pal_fun,
            values=states.sf$high_school, 
            title = 'High School Graduation Rate',
            group = "High School Graduation Rate") %>%
  addLegend("bottomleft",  
            pal=pal_fun2,
            values=states.sf$degree, 
            title = 'College or Graduate Degree',
            group = "College or Graduate Degree") %>% 
  addProviderTiles(providers$CartoDB.Positron) %>%
  addLayersControl(overlayGroups = c("High School Graduation Rate", "College or Graduate Degree"),
                   options = layersControlOptions(collapsed = FALSE))