Skip to content

Commit

Permalink
Pushing Brecken's updates to all figure scripts to automate for AKR, …
Browse files Browse the repository at this point in the history
…including new and updated figures
  • Loading branch information
breckenrobb committed Feb 11, 2025
1 parent 654f530 commit aa2a316
Show file tree
Hide file tree
Showing 18 changed files with 851 additions and 324 deletions.
1 change: 1 addition & 0 deletions AKR-climate-futures.Rproj
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
Version: 1.0
ProjectId: 6bf3e8ca-1f93-4c33-b745-a68c525be38b

RestoreWorkspace: Default
SaveWorkspace: Default
Expand Down
6 changes: 2 additions & 4 deletions CF-selectionT&P.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -23,12 +23,12 @@ rm(list = ls())
library(stars);library(dplyr);library(ggplot2);library(ggthemes);library(viridis);library(here);library(ggrepel);library(rlang);library(ggbiplot)
SiteID <- "CAKR" #*UPDATE*
SiteID <- "KOVA" #*UPDATE*
data.dir <- "E:/NCAR_AK/met/monthly/BCSD/"
vic.dir <- "E:/NCAR_AK/vic_hydro/monthly/BCSD"
# plot.dir <- paste0("C:/Users/arunyon/3D Objects/Local-files/RCF_Testing/",SiteID) #*UPDATE*
plot.dir <- paste0("C:/Users/arunyon/OneDrive - DOI/AKR-CFs/",SiteID) #*UPDATE*
plot.dir <- paste0("C:/Users/brobb/OneDrive - DOI/Projects/AKR_CFs/",SiteID) #*UPDATE*
dir.create(plot.dir,showWarnings=FALSE)
Expand Down Expand Up @@ -75,8 +75,6 @@ Deltas <- as.data.frame(matrix(data=NA,nrow=length(GCMs)*length(RCPs),ncol=lengt
names(Deltas) <- c("GCM", "RCP", variables)
```

Loop through met GCM.rcp and summarize each variable
Expand Down
41 changes: 27 additions & 14 deletions Code/Plots/SWE-runoff-plots.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,8 @@ df$date = as.Date(df$time, format="%Y-%m-%d")
df$Year = as.factor(substr(df$time, 1, 4))
df$yday = yday(df$date)


#### Runoff plot
runoff.plot <- function(data, col,CF){
ggplot() +
geom_line(data=data,aes(x=yday,y=RUNOFF_in,group=Year),colour=col,size=.7) +
Expand All @@ -34,11 +36,13 @@ ggplot() +
CF1.runoff = runoff.plot(data=subset(df, CF == CFs[1]),col=cols[1],CF=CFs[1])
CF1.runoff
CF2.runoff = runoff.plot(data=subset(df, CF == CFs[2]),col=cols[2],CF=CFs[2])
CF3.runoff = runoff.plot(data=subset(df, CF == CFs[3]),col=cols[3],CF=CFs[3])
CF2.runoff
# CF3.runoff = runoff.plot(data=subset(df, CF == CFs[3]),col=cols[3],CF=CFs[3])
Hist.runoff = runoff.plot(data=subset(df, CF == "Historical"),col="grey",CF="Historical")
Hist.runoff


############################################################################
### SWE plot
SWE.plot <- function(data, col,CF){
ggplot() +
geom_line(data=data,aes(x=yday,y=SWE_in,group=Year),colour=col,size=.7) +
Expand All @@ -52,36 +56,45 @@ SWE.plot <- function(data, col,CF){
axis.title.y=element_text(size=16,vjust=1.0),
plot.title=element_blank(),
legend.text=element_text(size=14), legend.title=element_text(size=14),
legend.position = "bottom") +
legend.position = "bottom",
plot.margin = margin(t=10, r = 10, b = 10, l = 10),) + # for grid2 only plot
labs(title = "",
x = "", y = "") +
x = "", y = CF) + # y = CF for grid2 only plot
ylim(0,max(df$SWE_in))
# coord_fixed(ratio = .5)
}

CF1.SWE = SWE.plot(data=subset(df, CF == CFs[1]),col=cols[1],CF=CFs[1])
CF2.SWE = SWE.plot(data=subset(df, CF == CFs[2]),col=cols[2],CF=CFs[2])
CF3.SWE = SWE.plot(data=subset(df, CF == CFs[3]),col=cols[3],CF=CFs[3])
# CF3.SWE = SWE.plot(data=subset(df, CF == CFs[3]),col=cols[3],CF=CFs[3])
Hist.SWE = SWE.plot(data=subset(df, CF == "Historical"),col="grey",CF="Historical")


#### Just maps and ts plot
grid1 <- ggarrange(Hist.runoff, CF1.runoff, CF2.runoff, CF3.runoff, ncol = 1, nrow = 4)
#### Runoff and SWE plots
# Runoff gridded plot
grid1 <- ggarrange(Hist.runoff, CF1.runoff, CF2.runoff, ncol = 1, nrow = 3) # CF3.runoff)

grid1 = annotate_figure(grid1, left = textGrob("Runoff (in)", rot = 90, vjust = 1, gp = gpar(cex = 1.3)),
grid1 = annotate_figure(grid1, left = textGrob("Runoff (in)", rot = 90, vjust = 0.5, gp = gpar(cex = 1.3)), # BCR changed for more white space around y-axis title - # originally: vjust = 1
bottom = textGrob("Julian day", gp = gpar(cex = 1.3)),
top = textGrob("Daily runoff for each climate future",
gp=gpar(fontface="bold", col="black", fontsize=16)))
grid1
ggsave(paste0("SWE-runoff-only.png"), plot = grid1, width = 7, height = 8, path = plot.dir, bg = "white")

grid2 <- ggarrange(Hist.SWE, CF1.SWE, CF2.SWE, CF3.SWE, ncol = 1, nrow = 4)
# SWE gridded plot
grid2 <- ggarrange(Hist.SWE, CF1.SWE, CF2.SWE, ncol = 1, nrow = 3) #CF3.SWE

grid2 = annotate_figure(grid2, left = textGrob("SWE (in)", rot = 90, vjust = 1, gp = gpar(cex = 1.3)),
bottom = textGrob("Julian day", gp = gpar(cex = 1.3)),
top = textGrob("Daily SWE for each climate future",
gp=gpar(fontface="bold", col="black", fontsize=16)))
grid2 = annotate_figure(grid2, left = textGrob("SWE (in)", rot = 90, vjust = 0.5, gp = gpar(cex = 1.3)), # BCR changed for more white space around y-axis title - # originally: vjust = 1
bottom = textGrob("Julian day", gp = gpar(cex = 1.3)),
top = textGrob("Daily SWE for each climate future",
gp=gpar(fontface="bold", col="black", fontsize=16)))
grid2
ggsave(paste0("SWE-runoff-daily-only.png"), plot = grid2, width = 7, height = 8, path = plot.dir, bg = "white")

#### Final plot arrangement
grid = ggarrange(grid1,grid2,nrow=1,ncol=2)
annotate_figure(grid, top = textGrob(SiteID,
gp=gpar(fontface="bold", col="black", fontsize=20)))

ggsave(paste0(SiteID,"_SWE-runoff.png"), width = 15, height = 9, path = plot.dir)
ggsave(paste0("SWE-runoff.png"), plot = grid, width = 15, height = 9, path = plot.dir, bg = "white")

51 changes: 28 additions & 23 deletions Code/Plots/daily_ts_stack.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ head(df)
df = merge(DF, CF_GCM,by="GCM",all=TRUE)
df$CF[which(is.na((df$CF)))] = "Historical"
df$CF_col[which(is.na((df$CF_col)))] = "grey"
df$CF = factor(df$CF, levels=c(CFs,"Historical"))
df$CF = factor(df$CF, levels=c("Historical",CFs))
df$Year = as.Date(df$year, format="%Y-%m-%d")
df = subset(df, Year!="2017-08-13")
df$W.under32 = 90 - df$W.under32
Expand All @@ -18,6 +18,8 @@ means = df %>% group_by(CF) %>%
mW.under32 = mean(W.under32),
mpcp.over.5 = mean(pcp.over.5))

#### Time series plots
# Function
ts.plot <- function(data, var, title){
ggplot(data=data, aes(x=Year, y=eval(parse(text=var)), group=CF, colour = CF)) +

Expand All @@ -28,57 +30,60 @@ ggplot(data=data, aes(x=Year, y=eval(parse(text=var)), group=CF, colour = CF)) +
# axis.text.x=element_blank(),
axis.title.x=element_text(size=16,vjust=1.0),
axis.title.y=element_text(size=16,vjust=1.0),
plot.title=element_blank(),
plot.title = element_blank(), # If putting all 5 plots together, use: "plot.title = element_blank()" - If doing plots separately, use: plot.title = element_text(size = 16, face = "bold", hjust = 0.5)
legend.text=element_text(size=14), legend.title=element_text(size=14),
legend.position = "bottom") +
labs(title = "",
labs(title = "", # If putting all 5 plots together, use: title = ""; textGrob below adds titles - If doing plots separately, use: title = "Annual threshold exceedances (days/year)"
x = "Year", y = title) +
scale_color_manual(name="",values = c(cols,"grey")) +
scale_fill_manual(name="",values = c(cols,"grey")) +
scale_color_manual(name="",values = c("grey",cols)) +
scale_fill_manual(name="",values = c("grey",cols)) +
scale_shape_manual(name="",values = c(21,22,23,24))
# coord_fixed(ratio = .5)
}

# Individual variable ts plots
freeze.thaw = ts.plot(data=df,var="freeze.thaw",title=long.names[1])
ggsave(paste0("ts-stack-freeze-thaw.png"), plot = freeze.thaw, width = 10, height = 5, path = plot.dir, bg = "white")

under32 = ts.plot(data=df,var="under32",title=long.names[2])
ggsave(paste0("ts-stack-under32.png"), plot = under32, width = 10, height = 5, path = plot.dir, bg = "white")

over20 = ts.plot(data=df,var="over20",title=long.names[3])
ggsave(paste0("ts-stack-over20.png"), plot = over20, width = 10, height = 5, path = plot.dir, bg = "white")

W.under32 = ts.plot(data=df,var="W.under32",title=long.names[4])
ggsave(paste0("ts-stack-W-under32.png"), plot = W.under32, width = 10, height = 5, path = plot.dir, bg = "white")

pcp.over.5 = ts.plot(data=df,var="pcp.over.5",title=long.names[5])
ggsave(paste0("ts-stack-pcp-over-5.png"), plot = pcp.over.5, width = 10, height = 5, path = plot.dir, bg = "white")

gdd = ts.plot(data=df,var="GDD",title=long.names[6])
ggsave(paste0("ts-stack-gdd.png"), plot = gdd, width = 10, height = 5, path = plot.dir, bg = "white")


#### Just maps and ts plot
#### Create grids for plot arrangement
grid1 <- grid_arrange_shared_legend(freeze.thaw,under32,over20, ncol = 1, nrow = 3, position = "bottom",
top = textGrob(paste0("Annual threshold exceedances for ",SiteID, " (days/year)"),
gp=gpar(fontface="bold", col="black", fontsize=16)))

grid2 <- grid_arrange_shared_legend(W.under32,pcp.over.5, ncol = 1, nrow = 2, position = "bottom",
top = textGrob(paste0("Annual threshold exceedances for ",SiteID, " (days/year)"),
gp=gpar(fontface="bold", col="black", fontsize=16)))
# g <- ggarrange(maps,ts, nrow=2)
# g

#### Maps, ts, table

#### Delta data frames
delta.var <- data.frame(means)
names(delta.var) = c("CF","freeze-thaw", "tmin<32", "tmax>68","DJF>32","prcp>0.5")
for (i in 1:3){
delta.var[i,2:6] = delta.var[i,2:6] - delta.var[4,2:6]
}
delta.var[,2:6] <- signif(delta.var[,2:6], digits = 1)
#
# table <- tableGrob(delta.var, rows = NULL)
#
# table <- gtable_add_grob(table, grobs = rectGrob(gp = gpar(fill=NA, lwd=2)), #library(gtable)
# t=5,b=nrow(table),l=1,r=ncol(table))
# table <- annotate_figure(table,
# bottom = text_grob("Historical = absolute value; CFs = change values", color = "black",
# face = "italic", size = 12))
# tsplots <- grid.arrange(grid2, table, nrow=2, heights=c(3,1), clip = FALSE)


g <- ggarrange(grid1,grid2, ncol=2)
g

ggsave(paste0(SiteID,"_ts-stack.png"), width = 15, height = 9, path = plot.dir)

#### Final plot arrangement
g <- ggarrange(grid1, grid2, ncol=2)
g

ggsave(paste0("ts-stack.png"), plot = g, width = 15, height = 9, path = plot.dir, bg = "white")


66 changes: 59 additions & 7 deletions Code/Plots/map_monthly_dotplots_pcp.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ DJF.cf2 <- readRDS(Filter(function(x) grepl(paste("DJF", collapse = "|"), x), CF
MAM.cf2 <- readRDS(Filter(function(x) grepl(paste("MAM", collapse = "|"), x), CF2.ls))
JJA.cf2 <- readRDS(Filter(function(x) grepl(paste("JJA", collapse = "|"), x), CF2.ls))
SON.cf2 <- readRDS(Filter(function(x) grepl(paste("SON", collapse = "|"), x), CF2.ls))
# CF3
# # CF3
# DJF.cf3 <- readRDS(Filter(function(x) grepl(paste("DJF", collapse = "|"), x), CF3.ls))
# MAM.cf3 <- readRDS(Filter(function(x) grepl(paste("MAM", collapse = "|"), x), CF3.ls))
# JJA.cf3 <- readRDS(Filter(function(x) grepl(paste("JJA", collapse = "|"), x), CF3.ls))
Expand Down Expand Up @@ -68,7 +68,7 @@ MAM.cf2.plot <- map.plot(data=MAM.cf2, title="",metric=paste0("Average ",long.ti
JJA.cf2.plot <- map.plot(data=JJA.cf2, title="",metric=paste0("Average ",long.title),col=CF_GCM$CF_col[2])
SON.cf2.plot <- map.plot(data=SON.cf2, title="",metric=paste0("Average ",long.title),col=CF_GCM$CF_col[2])

# CF3
# # CF3
# DJF.cf3.plot <- map.plot(data=JJA.cf3, title=CFs[3],metric=paste0("Average ",long.title),col=CF_GCM$CF_col[3])
# MAM.cf3.plot <- map.plot(data=MAM.cf3, title="",metric=paste0("Average ",long.title),col=CF_GCM$CF_col[3])
# JJA.cf3.plot <- map.plot(data=JJA.cf3, title="",metric=paste0("Average ",long.title),col=CF_GCM$CF_col[3])
Expand Down Expand Up @@ -96,8 +96,7 @@ maps <- grid.arrange(seasons,maps.all,ncol = 2, widths = c(1,15))

################################### MONTHLY DOT PLOT ##################


dotplot <- ggplot(delta, aes(x=(eval(parse(text=delta.var))),y=season,fill=CF)) +
dotplot <- ggplot(delta,aes(x=(eval(parse(text=delta.var))),y=season,fill=CF)) +
geom_vline(xintercept=0, linetype="dashed", color = "black") +
geom_point(stat="identity",size=8,colour="black",aes(fill = factor(CF), shape = factor(CF))) +
theme(axis.text=element_text(size=16), #Text size for axis tick mark labels
Expand All @@ -115,9 +114,62 @@ dotplot <- ggplot(delta, aes(x=(eval(parse(text=delta.var))),y=season,fill=CF))
scale_y_discrete(limits=rev)
dotplot

g <- grid.arrange(maps, dotplot,ncol = 2, widths = c(6, 4), clip = FALSE)
g <- grid.arrange(maps, dotplot, ncol = 2, widths = c(6, 4), clip = FALSE)

annotate_figure(g, top = text_grob(paste0("Change in seasonal ",long.title, "; 1950-1999 vs 2025-2055"),
annotate_figure(g, top = text_grob(paste0("Change in seasonal ", long.title, "; 1950-1999 vs 2025-2055"),
face = "bold", size = 20))

ggsave(paste0("seasonal_",var,".png"), width = 15, height = 9, path = plot.dir,bg="white")
ggsave(paste0("seasonal_",var,".png"), plot = g, width = 15, height = 9, path = plot.dir,bg="white")


################################### MONTHLY BAR CHART ##################

# Seasons as groups

## Without historical data

barchart <- ggplot(df.fut[-c(9:12),], aes(x=season,y=(eval(parse(text=delta.var))),fill=CF)) +
geom_bar(stat = "identity", position = "dodge") +
geom_hline(yintercept = 0, linetype="solid", color = "black", size = 0.75) +
theme(axis.text=element_text(size=18), #Text size for axis tick mark labels
axis.title.x=element_text(size=22), #Text size and alignment for x-axis label
axis.title.y=element_text(size=22), #Text size and alignment for y-axis label
plot.title=element_blank(),
legend.title=element_text(size=18), #Text size of legend category labels
legend.text=element_text(size=17), #Text size of legend title
legend.position = "bottom") +
labs(title = paste0("Seasonal ",long.title),
x = "Season",
y = "Total precipitation (in/season)",
fill = "") +
scale_fill_manual(name="",values = cols) #+
barchart

annotate_figure(barchart, top = text_grob(paste0("Seasonal ",long.title, "; 1979-2016 vs 2035-2065"),
face = "bold", size = 22))

ggsave(paste0("seasonal_",var,"_bar.png"), plot = barchart, width = 15, height = 9, path = plot.dir,bg="white")

## With historical data

barchart <- ggplot(df.fut, aes(x=factor(season, levels = c('DJF', 'MAM', 'JJA', 'SON')), y=(eval(parse(text=delta.var))), fill=factor(CF, levels = c('Historical', 'Climate Future 1', 'Climate Future 2')))) +
geom_bar(stat = "identity", position = "dodge") +
geom_hline(yintercept = 0, linetype="solid", color = "black", size = 0.75) +
theme(axis.text = element_text(size = 18), # Text size for axis tick mark labels
axis.title.x = element_text(size = 22), # Text size and alignment for x-axis label
axis.title.y = element_text(size = 22), # Text size and alignment for y-axis label
plot.title = element_blank(),
legend.title = element_text(size = 18), # Text size of legend category labels
legend.text = element_text(size = 17), # Text size of legend title
legend.position = "bottom") +
labs(title = paste0("Seasonal ", long.title),
x = "Season",
y = "Total precipitation (in/season)",
fill = "") +
scale_fill_manual(values = c("Historical" = "grey", "Climate Future 1" = "#6EB2D4", "Climate Future 2" = "#CA0020"))
barchart

annotate_figure(barchart, top = text_grob(paste0("Seasonal ",long.title, "; 1979-2016 vs 2035-2065"),
face = "bold", size = 22))

ggsave(paste0("seasonal_",var,"_bar_historical.png"), plot = barchart, width = 15, height = 9, path = plot.dir,bg="white")
Loading

0 comments on commit aa2a316

Please sign in to comment.