This markdown script reproduces the supplementary figures associated with the paper “Temporal Compounding Increases Socioeconomic Impacts of Atmospheric Rivers in California” (doi:XX).
source('_data/setup_impacts.R')
source('_scripts/create_df_functions.R')
## set number of bootstrapped samples
<- 1000
boot
## turn progress bars on/off
<- FALSE
progress if (progress) pb <- txtProgressBar(min = 0, max = ncell(grid_ca), style = 3)
## set random seed for reproducibility
set.seed(2023)
<- c(
ardtnames 'brands','cascade','connect','gershunov','goldenson','guanwaliser',#'lbnl',
'lora','mattingly','mundhenk','paynemagnusdottir','rutz','scafet','walton')
load('_scripts/_checkpoints/df_3hr_1209.Rdata')
load('_scripts/_checkpoints/df_24hr_0209.Rdata')
<-
df_3hr foreach (i = 1:ncell(grid_ca)) %do% {
if (progress) setTxtProgressBar(pb, i)
if (i %in% index_ca) {
<- df_3hr[[i]] %>%
temp mutate(
ar = case_when(ar.cat==0 ~ FALSE, TRUE ~ ar),
ar.cat = case_when(ar ~ ar.cat),
ar.count = case_when(ar ~ ar.count)) %>%
mutate(inter = !ar, inter.count = add_counter(inter))
<- create_catalog(temp, 'inter', cat = FALSE, interval = 3/24) %>%
temp select(count, duration) %>%
setNames(paste('inter', names(.), sep = '.')) %>%
left_join(temp, ., by = 'inter.count')
<- temp %>%
temp select(ar.count, ar.cat, inter.duration) %>%
mutate(
inter.duration = setNA(inter.duration,0),
prev.inter = c(NA, inter.duration[-nrow(.)]),
next.inter = c(inter.duration[-1], NA)) %>%
filter(!is.na(ar.count)) %>%
group_by(ar.count = toNumber(ar.count)) %>%
summarize(
prev.inter = prev.inter[1],
next.inter = next.inter[length(ar.count)],
ar.cat = ar.cat[1]) %>%
mutate(
prev.cat = c(NA, ar.cat[-nrow(.)]),
next.cat = c(ar.cat[-1], NA),
prev.inter = c(NA, prev.inter[-1]),
next.inter = c(next.inter[-nrow(.)], NA)) %>%
select(-ar.cat)
%>% left_join(temp, by = 'ar.count')
df_3hr[[i]] else NULL
} }
<-
proxplus foreach (i = 1:ncell(grid_ca), .combine = 'rbind') %:%
foreach (int = c(1,3,5,7,10), .combine = 'rbind') %do% {
if (progress) setTxtProgressBar(pb, i)
if (i %in% index_ca) {
%>%
df_3hr[[i]] filter(wateryear(ts) %in% 1981:2021) %>%
filter(ar.cat > 0) %>%
group_by(ar.count) %>%
summarize(ar.cat = ar.cat[1], before = prev.inter[1]<=int, after = next.inter[1]<=int) %>%
group_by(ar.cat) %>%
summarize(
n = length(ar.cat),
and = Sum(before & after)/n, or = Sum(before | after)/n) %>%
mutate(id = i, int = int)
}%>%
} left_join(raster.df(grid_ca), by = c('id' = 'value'))
# ggplot(proxplus) +
# geom_histogram(aes(x = or), bins = sqrt(nrow(proxplus)/5), color = NA, fill = 'grey20') +
# facet_grid(int ~ ar.cat) +
# scale_y_origin()
<- ggplot(proxplus) +
g1 geom_vline(xintercept = factor(5, levels = c(1,3,5,7,10)), linetype = 'dashed', color = 'grey80') +
geom_line(aes(y = or, x = factor(int), group = id), alpha = 0.2, size = 0.25) +
facet_wrap(~paste0('AR',ar.cat), nrow = 1) +
scale_y_origin(labels = percent) +
labs(x = 'Between-Event Interval (Days)', y = 'Adjacent Probability') +
theme(
strip.background = element_rect(color = NA, fill = 'grey95'),
strip.text = element_text(margin = margin(2,2,2,2)),
axis.title.x = element_blank(),
panel.grid.major.y = element_line(size = 0.25))
<- ggplot(proxplus) +
g2 geom_vline(xintercept = factor(5, levels = c(1,3,5,7,10)), linetype = 'dashed', color = 'grey80') +
geom_line(aes(y = and, x = factor(int), group = id), alpha = 0.2, size = 0.25) +
facet_wrap(~paste0('AR',ar.cat), nrow = 1) +
scale_y_origin(labels = percent) +
labs(x = 'Between-Event Interval (Days)', y = 'Sandwiched Probability') +
coord_cartesian(ylim = c(0,0.6)) +
theme(
strip.background = element_rect(color = NA, fill = 'grey95'),
strip.text = element_text(margin = margin(2,2,2,2)),
panel.grid.major.y = element_line(size = 0.25))
/ g2
g1 ggsave('_figures-impacts/reviewer_figb.png', width = 7.25, height = 4, dpi = 500)
<-
ncei.all foreach (x = ardtnames, .combine = 'rbind') %do% {
load(paste0('_data/ARTMIP/Tier 1/coef_',x,'.Rdata'))
%>% mutate(ardt = x)
df.ncei
}<-
nfip.all foreach (x = ardtnames, .combine = 'rbind') %do% {
load(paste0('_data/ARTMIP/Tier 1/coef_',x,'.Rdata'))
%>% mutate(ardt = x)
df.nfip
}
<- ncei.all %>% filter(seq) %>%
g1 filter(ardt != 'lbnl') %>%
arrange(desc(est)) %>%
mutate(ardt = fct_inorder(ardt)) %>%
ggplot() +
geom_vline(xintercept = 1, color = 'grey70') +
geom_point(aes(y = ardt, x = est, color = ardt=='rutz'), size = 1.5) +
geom_linerange(aes(y = ardt, xmin = lower, xmax = upper, color = ardt=='rutz'), size = 0.75) +
scale_color_manual(values = c('grey10',ggcolor(2)[1])) +
guides(color = guide_none()) +
scale_x_log10('NCEI Sequence Loss Multiplier') +
annotation_logticks(sides = 'b', size = 0.25, color = 'grey25') +
theme(
panel.grid.major.x = element_line(size = 0.25),
axis.title.y = element_blank())
<- nfip.all %>% filter(seq) %>%
g2 filter(ardt != 'lbnl') %>%
arrange(desc(est)) %>%
mutate(ardt = fct_inorder(ardt)) %>%
ggplot() +
geom_vline(xintercept = 1, color = 'grey70') +
geom_point(aes(y = ardt, x = est, color = ardt=='rutz'), size = 1.5) +
geom_linerange(aes(y = ardt, xmin = lower, xmax = upper, color = ardt=='rutz'), size = 0.75) +
scale_color_manual(values = c('grey10',ggcolor(2)[1])) +
guides(color = guide_none()) +
scale_x_log10('NFIP Sequence Loss Multiplier') +
annotation_logticks(sides = 'b', size = 0.25, color = 'grey25') +
theme(
panel.grid.major.x = element_line(size = 0.25),
axis.title.y = element_blank())
+ g2 + plot_annotation(tag_levels = 'A') &
g1 theme(
plot.tag = element_text(family = 'Segoe UI', size = 10, face = 'bold'),
plot.tag.position = c(0,1))
ggsave('_figures-impacts/ardt2.png', width = 6, height = 4)