Hazard Analysis for SIL Project

https://berkeley-gif.github.io/caladapt-docs/indicator.html

CalAdapt extreme heat test

smc_cbgs <- block_groups("CA","San Mateo County", cb = T, progress_bar = F)
scc_cbgs <- block_groups("CA","Santa Clara County", cb = T, progress_bar = F)

study_cbgs <- rbind(smc_cbgs, scc_cbgs)

test_cbg <- 
  smc_cbgs[1,]$geometry %>% 
  st_cast("POLYGON") %>% 
  st_transform(4326) %>% 
  st_as_text() %>% 
  str_replace_all(" ","+")

test <- 
  fromJSON(
    paste0(
      "https://api.cal-adapt.org/api/series/tasmax_day_CanESM2_rcp85/exheat/?g=",
      test_cbg
    )
  ) %>% 
  .$counts %>% 
  .[-2] %>% 
  as.data.frame()

test_point <-
  smc_cbgs[1,]$geometry %>%
  st_centroid() %>%
  st_transform(4326) %>%
  st_as_text() %>%
  str_replace_all(" ","+")

test2 <-
  fromJSON(
    paste0(
      "https://api.cal-adapt.org/api/series/tasmax_day_CanESM2_rcp85/exheat/?g=",
      test_point
    )
  ) %>%
  .$counts %>%
  unlist() %>%
  as.data.frame() %>%
  rownames_to_column()

check <- cbind(test,test2)

Test confirms that the first column of the polygon output is just the centroid result. second column must be the average across the polygon

Get extreme heat days for all CBGs in SMC and SCC

study_cbgs <- 
  rbind(
    block_groups("CA","San Mateo County", cb = T, progress_bar = F),
    block_groups("CA","Santa Clara County", cb = T, progress_bar = F)
  )

exheat_full <- NULL

for(row in 1:nrow(study_cbgs)) {
  
  temp <- 
    tryCatch(
      {
        temp <- 
          fromJSON(
            paste0(
              "https://api.cal-adapt.org/api/series/tasmax_day_CanESM2_rcp85/exheat/?g=",
              study_cbgs[row,]$geometry %>% 
                st_cast("POLYGON") %>% 
                st_transform(4326) %>%
                st_as_text() %>% 
                str_replace_all(" ","+")
            )
          ) %>% 
          .$counts
        
        if(length(temp) == 3){
          temp[-2] %>% 
            as.data.frame() %>% 
            transmute(
              cbg = study_cbgs[row,]$GEOID,
              date = index %>% substr(1,4) %>% as.numeric(),
              exheat = data.2
            )
        } else {
          temp %>% 
            unlist() %>% 
            as.data.frame() %>% 
            rownames_to_column() %>% 
            transmute(
              cbg = study_cbgs[row,]$GEOID,
              date =
                rowname %>% substr(1,4) %>% as.numeric(),
              exheat = `.`
            )
        }
      }, 
      error = function(cond) {
        data.frame(
            cbg = study_cbgs[row,]$GEOID,
            date = NA,
            exheat = NA
          )
      }
    )
  
  exheat_full <-
    exheat_full %>% 
    rbind(temp)
  
  if(row%%10 == 0) {
    print(row)
    saveRDS(exheat_full, "exheat_full.rds")
  }
  
}

exprecip_full <- NULL

for(row in 1:nrow(study_cbgs)) {
  
  temp <- 
    tryCatch(
      {
        temp <- 
          fromJSON(
            paste0(
              "https://api.cal-adapt.org/api/series/pr_day_ACCESS1-0_rcp85/pot/?g=",
              study_cbgs[row,]$geometry %>% 
                st_cast("POLYGON") %>% 
                st_transform(4326) %>%
                st_as_text() %>% 
                str_replace_all(" ","+")
            )
          ) %>% 
          .$returnlevels %>% 
          .$`2035-10-01:2064-09-30` %>% 
          as.data.frame() %>% 
          t() %>% 
          .[-7,2] %>% 
          as.data.frame() %>% 
          rownames_to_column() %>% 
          rename(
            rp = rowname,
            exprecip = "."
          ) %>% 
          mutate(
            cbg = study_cbgs[row,]$GEOID
          )
      }, 
      error = function(cond) {
        data.frame(
            rp = NA,
            exprecip = NA,
            cbg = study_cbgs[row,]$GEOID
          )
      }
    )
  
  exprecip_full <-
    exprecip_full %>% 
    rbind(temp)
  
  if(row%%10 == 0) {
    print(row)
    saveRDS(exprecip_full, "exprecip_full.rds")
  }
  
}

Summarize results

exheat_map <-
  exheat_full %>% 
  filter(date > 2034 & date < 2065) %>% 
  group_by(cbg) %>% 
  summarize(
    exheat = mean(exheat, na.rm = T)
  )

exprecip_map <-
  exprecip_full %>% 
  pivot_wider(
    names_from = rp,
    values_from = exprecip
  ) %>% 
  transmute(
    cbg = cbg,
    exprecip = 
      (X2)*(1/2) +
      (X5 + X2)*(1/2 - 1/5)/2 +
      (X10 + X5)*(1/5 - 1/10)/2 +
      (X20 + X10)*(1/10 - 1/20)/2 +
      (X50 + X20)*(1/20 - 1/50)/2 +
      (X100 + X50)*(1/100 - 1/50)/2 +
      (X100)*(1/100)
  )

hazard_cbgs <-
  study_cbgs %>% 
  select(GEOID) %>% 
  left_join(
    exheat_map,
    by = c("GEOID" = "cbg")
  ) %>% 
  left_join(
    exprecip_map,
    by = c("GEOID" = "cbg")
  ) %>% 
  st_transform(4326)

Map heat

heat_pal <- colorNumeric(
  palette = "Reds",
  domain = 
    hazard_cbgs %>% 
    filter(!is.na(exheat)) %>% 
    pull(exheat)
)

precip_pal <- colorNumeric(
  palette = "Blues",
  domain = 
    hazard_cbgs %>% 
    filter(!is.na(exprecip)) %>% 
    pull(exprecip)
)

leaflet() %>% 
  addTiles() %>% 
  addPolygons(
    data = hazard_cbgs,
    stroke = F,
    fillColor = ~heat_pal(exheat),
    fillOpacity = 0.5,
    label = ~paste0(round(exheat,1), " annual extreme heat days, mid-century")
  ) %>% 
  addPolygons(
    data = hazard_cbgs,
    fill = F,
    color = ~precip_pal(exprecip),
    opacity = ~exprecip/max(hazard_cbgs$exprecip, na.rm = T),
    weight = ~exprecip/max(hazard_cbgs$exprecip, na.rm = T)*2,
    label = ~paste0(round(exprecip,1), " annual expected extreme precipitation event in inches, mid-century")
  )

acs_vars_2018_5yr <-
  listCensusMetadata(
    name = "2018/acs/acs5",
    type = "variables"
  )