In bcgov/climate-disturbances: Detect extreme climate events in BC

knitr::opts_chunk$set(echo = FALSE,
                      warning = FALSE,
                      message = FALSE, 
                      fig.width=12, 
                      fig.height = 6, 
                      dpi=300)

library(here)
library(tidyverse)
library(flextable)
library(extrafont)
library(targets)
library(DiagrammeR)
library(tmap)
library(sf)
library(heatwaveR)
library(bcdata)
library(lubridate)
library(ggrepel)
library(weathercan)
library(tidyhydat)


# ## Flex table defaults
set_flextable_defaults(
  font.family = "Calibri", font.size = 28, font.color = "black",
  text.align = "left",
  table.layout = "fixed",
  theme_fun = "theme_booktabs")

if(.Platform$OS.type == "windows"){
  loadfonts(device = "win", quiet = TRUE)
}

theme_set(theme_minimal(base_family = "Calibri") %+replace%
            theme(plot.caption = element_text(face = "italic", hjust = 1),
                  plot.title = element_text(size = 20),
                  plot.title.position = "plot",
                  strip.text = element_text(size = 20),
                  panel.grid.major.x = element_blank(),
                  panel.grid.minor.x = element_blank(),
                  axis.title = element_text(size = 18),
                  axis.text = element_text(size = 14), 
                  panel.border = element_blank())
          )

Overview

grViz("
digraph rmarkdown {
graph [overlap = true, fontsize = 15]
node [shape = box,
      fontname = Calibri,
      fontcolor = dodgerblue,
      color = Grey]
edge [color = dodgerblue]

'Climate Related Disturbance' -> 'Services Used' -> 'Demographics of that Service Usage'
}
"
)

grViz("
digraph rmarkdown {
graph [overlap = true, fontsize = 15]


node [shape = circle,
      fontname = Calibri,
      fontcolor = MediumPurple,
      color = Grey]

{'What?' 'Where?' 'When?'}
}
"
)

Disturbance

Wildfires

Extreme heat

Flooding

(Crop failure, Sea level rise, Winter warming)

Wildfires - Provincial

tar_read(area_burned_over_time) %>% 
  mutate(FIRE_SIZE_SQKM = FIRE_SIZE_HECTARES/100) %>% 
  group_by(FIRE_YEAR) %>% 
  summarise(FIRE_SIZE_SQKM = sum(FIRE_SIZE_SQKM)) %>% 
  ggplot(aes(x = FIRE_YEAR, y = FIRE_SIZE_SQKM)) +
  geom_line() +
  labs(y = "Area Burned (km^2)") +
  theme(axis.title.x = element_blank())

Wildfire Measure: Air Quality

tar_load(pm25_24h)

label_df <- pm25_24h$daily_avg %>% 
  ungroup() %>% 
  filter(station_name == 'Kamloops Federal Building') %>% 
  arrange(desc(avg_24h)) %>% 
  slice(1:2) %>% 
  mutate(avg_24h = avg_24h+10)

pm25_24h$daily_avg %>% 
  ungroup() %>% 
  filter(station_name == 'Kamloops Federal Building', date >= as.Date("2011-01-01")) %>% 
  ggplot(aes(x = date, y = avg_24h, label = date)) +
  geom_line() +
  geom_label(data = label_df) +
  scale_x_date(date_breaks = "6 months", date_labels = "%b %Y") +
  labs(y = "Daily PM 2.5 value", x = "Date", title = unique(label_df$station_name)) +
  theme(axis.title.x = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1))

Extreme Heat: Heatwaves

tar_load(heatwaves_raw)
station_num <- "1074"
name <- unique(stations()$station_name[stations()$station_id == station_num])

heatwaves_raw[[station_num]] %>% 
  event_line(min_duration = 2, spread = 200) +
  labs(title = name)

Flooding: River Level

tar_load(flood_example)

stn_name <- hy_stations(station_number = flood_example$STATION_NUMBER)$STATION_NAME

max_date <- flood_example[flood_example$Value == max(flood_example$Value),]

flood_example %>% 
  filter(Date >= as.Date('2010-01-01')) %>% 
  ggplot(aes(x = Date, y = Value)) +
  geom_line() +
  geom_label(x = max_date$Date, y = max_date$Value+10, label = "Grand Forks Flood") +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  labs(title = stn_name)

Data Innovation Program

:::::::::::::: {.columns} ::: {.column}

if (file.exists(here::here("img/dip.jpg"))) {
  knitr::include_graphics(here::here("img/dip.jpg"))  
}

::: ::: {.column}

Data Innovation Program: link and de-identify administrative datasets from ministries for population-level research projects in a secure analytics environment. ::: ::::::::::::::

Service Usage

tribble(
  ~Service, ~Data, ~Ministry,
  "Ambulance call outs", "NACRS", "Health",
  "Hospital visits", "DAD", "Health",
  "Income Assistance", "BCEA", "SDPR",
  "Doctor visits", "MSP Billing", "Health",
  "Employment Training", "Labour Market", "AEST",
  "Support Services", "Children in Care",  "MCFD",
  "Rental Supplements", "Rental Assistance", "BC Housing",
  "Mental Health Episodes and Events", "Mental Health Services", "Health"
) %>% 
  flextable() %>% 
  autofit()

Local Health Areas

:::::::::::::: {.columns} ::: {.column}

tm_shape(health_lha()) +
  tm_fill(col = "LOCAL_HLTH_AREA_NAME", legend.show = FALSE) +
  tm_layout(frame = FALSE)

::: ::: {.column}

The LHAs are a mutually exclusive and exhaustive classification of the land area in BC. LHAs are contiguous (land area is geographically adjacent) and fit within an existing geographical hierarchy structure, e.g., cannot violate higher-level geography boundaries such as the Health Service Delivery Areas (HSDA) and Health Authorities (HA).

::: ::::::::::::::

Air Quality by Local Health Area

tar_load(pm25_24h)

pm25_24h$daily_avg %>% 
  filter(hlth_service_dlvr_area_name %in% c('Thompson Cariboo Shuswap', 'Okanagan')) %>% 
  ggplot(aes(date, y = avg_24h, colour = station_name)) +
  geom_line() +
  labs(y = "Daily PM 2.5 value", x = "Date") +
  scale_colour_viridis_d() +
  facet_wrap(~local_hlth_area_name) +
  theme(legend.position = "bottom")

Census Subdivision?

:::::::::::::: {.columns} ::: {.column}

tm_shape(st_intersection(census_subdivision(), bc_bound())) +
  tm_fill(col = "CENSUS_SUBDIVISION_NAME", legend.show = FALSE) +
  tm_layout(frame = FALSE)

::: ::: {.column}

Census subdivision (CSD) is the general term for municipalities (as determined by provincial/territorial legislation) or areas treated as municipal equivalents for statistical purposes.

::: ::::::::::::::

Demographics/Economics

• Intersectionality/ GBA+ lens

tribble(
  ~Variables, ~Data, ~`Data Location`,
  "Gender", "Demographics", "DIP",
  "Age", "Demographics/Census", "DIP/Open",
  "Population", "Registry/Census", "DIP/Open",
  "Income", "Census/Cancensus", "Open"
) %>% 
  flextable() %>% 
  autofit()

bcgov/climate-disturbances documentation built on Jan. 29, 2023, 1:42 p.m.