Last updated: 2019-07-09
workflowr checks: (Click a bullet for more information) ✔ R Markdown file: up-to-date
Great! Since the R Markdown file has been committed to the Git repository, you know the exact version of the code that produced these results.
✔ Environment: empty
Great job! The global environment was empty. Objects defined in the global environment can affect the analysis in your R Markdown file in unknown ways. For reproduciblity it’s best to always run the code in an empty environment.
✔ Seed:
set.seed(20190513)
The command set.seed(20190513)
was run prior to running the code in the R Markdown file. Setting a seed ensures that any results that rely on randomness, e.g. subsampling or permutations, are reproducible.
✔ Session information: recorded
Great job! Recording the operating system, R version, and package versions is critical for reproducibility.
✔ Repository version: 497eeb2
wflow_publish
or wflow_git_commit
). workflowr only checks the R Markdown file, but you know if there are other scripts or data files that it depends on. Below is the status of the Git repository when the results were generated:
Ignored files:
Ignored: .Rhistory
Ignored: .Rproj.user/
Ignored: data/NAPA_clim_U.Rda
Ignored: data/NAPA_clim_V.Rda
Ignored: data/NAPA_clim_W.Rda
Ignored: data/NAPA_clim_emp_ice.Rda
Ignored: data/NAPA_clim_emp_oce.Rda
Ignored: data/NAPA_clim_fmmflx.Rda
Ignored: data/NAPA_clim_mldkz5.Rda
Ignored: data/NAPA_clim_mldr10_1.Rda
Ignored: data/NAPA_clim_qemp_oce.Rda
Ignored: data/NAPA_clim_qla_oce.Rda
Ignored: data/NAPA_clim_qns.Rda
Ignored: data/NAPA_clim_qsb_oce.Rda
Ignored: data/NAPA_clim_qt.Rda
Ignored: data/NAPA_clim_runoffs.Rda
Ignored: data/NAPA_clim_ssh.Rda
Ignored: data/NAPA_clim_sss.Rda
Ignored: data/NAPA_clim_sst.Rda
Ignored: data/NAPA_clim_taum.Rda
Ignored: data/NAPA_clim_vars.Rda
Ignored: data/NAPA_clim_vecs.Rda
Ignored: data/node_mean_all_anom.Rda
Ignored: data/packet_all_anom.Rda
Ignored: data/som_all_anom.Rda
Ignored: data/synoptic_states.Rda
Ignored: data/synoptic_vec_states.Rda
Unstaged changes:
Modified: analysis/_site.yml
Modified: code/workflow.R
Note that any generated files, e.g. HTML, png, CSS, etc., are not included in this status report because it is ok for generated content to have uncommitted changes.
File | Version | Author | Date | Message |
---|---|---|---|---|
Rmd | 2490b95 | robwschlegel | 2019-07-08 | Getting there |
Rmd | 82b8ef8 | robwschlegel | 2019-07-08 | Nearly finished with first pass at writing down node results. |
Rmd | d73fbc0 | robwschlegel | 2019-07-02 | Analysed most of the outputs |
Rmd | fd36d4c | robwschlegel | 2019-06-19 | Talk is as ready as its getting |
Rmd | 7ff9b8b | robwschlegel | 2019-06-17 | More work on the talk |
Rmd | 1bbfd07 | robwschlegel | 2019-06-16 | First draft of figures almost complete. |
Rmd | dd82bc0 | robwschlegel | 2019-06-16 | Merging with offline edits |
Rmd | c7c29ef | robwschlegel | 2019-06-16 | Uh-oh |
Rmd | 84e9464 | robwschlegel | 2019-06-15 | Little notes |
Rmd | 35d4717 | robwschlegel | 2019-06-13 | Added URL links to publications whose figures form the base of the figures in this project |
Rmd | b25762e | robwschlegel | 2019-06-12 | More work on figures |
Rmd | 413bb8b | robwschlegel | 2019-06-12 | Working on pixel interpolation |
html | c23c50b | robwschlegel | 2019-06-10 | Build site. |
html | 028d3cc | robwschlegel | 2019-06-10 | Build site. |
Rmd | c6b3c7b | robwschlegel | 2019-06-10 | Re-publish entire site. |
In this final vignette we will go over the creation of the figures used in the publication for this research. These figures are largely adapted from the techniques seen in Oliver et al. (2018) (https://www.sciencedirect.com/science/article/pii/S0079661117303336) and Schlegel et al. (2017) (https://www.frontiersin.org/articles/10.3389/fmars.2017.00323/full).
# Insatll from GitHub
# .libPaths(c("~/R-packages", .libPaths()))
# devtools::install_github("fabrice-rossi/yasomi")
# Packages used in this vignette
library(jsonlite, lib.loc = "../R-packages/")
library(tidyverse) # Base suite of functions
library(ncdf4) # For opening and working with NetCDF files
library(lubridate) # For convenient date manipulation
# library(scales) # For scaling data before running SOM
library(yasomi, lib.loc = "../R-packages/") # The SOM package of choice due to PCI compliance
library(data.table) # For working with massive dataframes
# Load functions written in previous vignettes
source("code/functions.R")
# Set number of cores
doMC::registerDoMC(cores = 50)
# Disable scientific notation for numeric values
# I just find it annoying
options(scipen = 999)
# Set number of cores
doMC::registerDoMC(cores = 50)
# Disable scientific notation for numeric values
# I just find it annoying
options(scipen = 999)
# Individual regions
NWA_coords <- readRDS("data/NWA_coords_cabot.Rda")
# The NAPA variables
NAPA_vars <- readRDS("data/NAPA_vars.Rda")
# Corners of the study area
NWA_corners <- readRDS("data/NWA_corners.Rda")
# Create smaller corners to use less RAM
# This also better matches the previous South African work
# The Tasmania work had corners of roughly 2 degrees greater than the study area
NWA_corners_sub <- c(NWA_corners[1]+8, NWA_corners[2]-8, NWA_corners[3]+8, NWA_corners[4]-8)
# The base map
map_base <- ggplot2::fortify(maps::map(fill = TRUE, col = "grey80", plot = FALSE)) %>%
dplyr::rename(lon = long) %>%
mutate(group = ifelse(lon > 180, group+9999, group),
lon = ifelse(lon > 180, lon-360, lon)) %>%
select(-region, -subregion)
# Bathymetry data
# NB: Should rather use model bathymetry
bathy <- readRDS("data/NWA_bathy_lowres.Rda")
# The grid that will convert the tri-polar coordinates to cartesian
# NB: This file was created in the 'tikoraluk' project
load("data/lon_lat_NAPA_OISST.Rdata")
# Change to fit with this project
lon_lat_NAPA_OISST <- lon_lat_NAPA_OISST %>%
dplyr::select(-lon, -lat, -dist, -nav_lon_corrected) %>%
dplyr::rename(lon = nav_lon, lat = nav_lat) %>%
mutate(lon = round(lon, 4),
lat = round(lat, 4)) %>%
mutate(lon_O = ifelse(lon_O > 180, lon_O-360, lon_O))
# Load MHW results
NAPA_MHW_sub <- readRDS("data/NAPA_MHW_sub.Rda")
# Events only
NAPA_MHW_event <- NAPA_MHW_sub %>%
select(-clims, -cats) %>%
unnest(events) %>%
filter(row_number() %% 2 == 0) %>%
unnest(events)
The first figure we will want is that of the study area. This figure will have multiple panels show that we can show the overall average synoptic state of the important variables.
### TO DO
# Gulf Stream curved vector
# Halifax labelled point
# Text "Labrador Sea"
# Text: "Labrador Current"
# Interpolate pixels for visual nice-ness
# Improve bathymetry contours
# Look into the new ggfriendly method
# One panel should contain current vectors
# And the other panel should contain bathymetry contours
# Mean variable states
system.time(
var_mean_states <- readRDS("data/NAPA_clim_vars.Rda") %>%
dplyr::select(-doy) %>%
group_by(lon, lat) %>%
summarise_all(.funs = "mean") %>%
ungroup() %>%
left_join(lon_lat_NAPA_OISST, by = c("lon", "lat")) %>%
dplyr::select(-lon, -lat) %>%
dplyr::rename(lon = lon_O, lat = lat_O) %>%
group_by(lon, lat) %>%
summarise_all(.funs = "mean", na.rm = T)
) # 12 seconds
# Vector mean states
system.time(
vec_mean_states <- readRDS("data/NAPA_clim_vecs.Rda") %>%
dplyr::select(-doy, -wo_clim) %>%
group_by(lon, lat) %>%
summarise_all(.funs = "mean") %>%
ungroup() %>%
left_join(lon_lat_NAPA_OISST, by = c("lon", "lat")) %>%
dplyr::select(-lon, -lat) %>%
dplyr::rename(lon = lon_O, lat = lat_O) %>%
group_by(lon, lat) %>%
summarise_all(.funs = "mean", na.rm = T) %>%
dplyr::rename(u = uoce_clim, v = voce_clim) %>%
mutate(arrow_size = ((abs(u*v)/ max(abs(u*v)))+0.2)/6)
) # 7 seconds
# The previous wind correction for when that info is brought in
# winds <- mutate(arrow_size = ((abs(u*v)/ max(abs(u*v)))+0.3)/6)
# Reduce wind/ current vectors
lon_sub <- seq(min(var_mean_states$lon), max(var_mean_states$lon), by = 1)
lat_sub <- seq(min(var_mean_states$lat), max(var_mean_states$lat), by = 1)
# currents <- currents[(currents$lon %in% lon_sub & currents$lat %in% lat_sub),]
vec_mean_states_sub <- vec_mean_states[(vec_mean_states$lon %in% lon_sub & vec_mean_states$lat %in% lat_sub),]
# Establish the vector scalar for the currents
current_uv_scalar <- 2
# Establish the vector scalar for the wind
wind_uv_scalar <- 0.5
# Wind feature vector coordinates
# cyc_atlantic <- data.frame(x = c(14.0, 16.1, 16.0), y = c(-36.0, -34.4, -32.1),
# xend = c(16.0, 16.1, 14.0), yend = c(-34.5, -32.2, -30.6))
# cyc_indian <- data.frame(x = c(36.0, 33.9, 34.0), y = c(-31.5, -33.1, -35.4),
# xend = c(34.0, 33.9, 36.0), yend = c(-33.0, -35.3, -36.9))
# westerlies <- data.frame(x = c(18.0, 21.1, 24.2), y = c(-38.0, -37.8, -37.8),
# xend = c(21.0, 24.1, 27.2), yend = c(-37.8, -37.8, -38.0))
# The top figure (sea)
fig_1_top <- ggplot(data = map_base, aes(x = lon, y = lat)) +
# The ocean temperature
geom_raster(data = var_mean_states, aes(fill = sst_clim)) +
# The bathymetry
# stat_contour(data = bathy[bathy$depth < -100 & bathy$depth > -300,],
# aes(x = lon, y = lat, z = depth), alpha = 0.5,
# colour = "ivory", size = 0.5, binwidth = 200, na.rm = TRUE, show.legend = FALSE) +
# The current vectors
geom_segment(data = vec_mean_states_sub, aes(xend = lon + u * current_uv_scalar, yend = lat + v * current_uv_scalar),
arrow = arrow(angle = 40, length = unit(vec_mean_states_sub$arrow_size, "cm"), type = "open"),
linejoin = "mitre", size = 0.4) +
# The land mass
geom_polygon(aes(group = group), fill = "grey70", colour = "black", size = 0.5, show.legend = FALSE) +
# The legend for the vector length
# geom_label(aes(x = 37.0, y = -38.0, label = "1.0 m/s\n"), size = 3, label.padding = unit(0.5, "lines")) +
# geom_segment(aes(x = 36.0, y = -38.3, xend = 38.0, yend = -38.3), linejoin = "mitre",
# arrow = arrow(angle = 40, length = unit(0.2, "cm"), type = "open")) +
# Halifax point and label
# geom_point(data = SACTN_site_list, shape = 19, size = 2.8, colour = "ivory") +
# geom_text(data = SACTN_site_list[-c(3,4,7:9,18,21,23:24),], aes(label = order), size = 1.9, colour = "red") +
# Ocean label
# annotate("text", label = "ATLANTIC\nOCEAN", x = 13.10, y = -34.0, size = 4.0, angle = 0, colour = "ivory") +
# Gulf stream line and label
# geom_segment(aes(x = 17.2, y = -32.6, xend = 15.2, yend = -29.5),
# arrow = arrow(length = unit(0.3, "cm")), size = 0.5, colour = "ivory") +
# annotate("text", label = "Benguela", x = 16.0, y = -31.8, size = 3.5, angle = 298, colour = "ivory") +
# Labrador Current line and label
# geom_segment(aes(x = 33, y = -29.5, xend = 29.8, yend = -33.0),
# arrow = arrow(length = unit(0.3, "cm")), size = 0.5, colour = "ivory") +
# annotate("text", label = "Agulhas", x = 31.7, y = -31.7, size = 3.5, angle = 53, colour = "ivory") +
# Labrador Sea label
# annotate("text", label = "Agulhas\nBank", x = 22.5, y = -35.5, size = 3.0, angle = 0, colour = "ivory") +
# Improve on the x and y axis labels
scale_x_continuous(breaks = seq(-70, -50, 10),
labels = scales::unit_format(suffix = "°E", sep = ""),
position = "top") +
scale_y_continuous(breaks = seq(35, 55, 10),
labels = scales::unit_format(suffix = "°N", sep = "")) +
labs(x = NULL, y = NULL) +
# Slightly shrink the plotting area
coord_cartesian(xlim = NWA_corners_sub[1:2], ylim = NWA_corners_sub[3:4], expand = F) +
# Use viridis colour scheme
scale_fill_viridis_c(name = "Temp.\n(°C)", option = "D", breaks = seq(0, 25, 5)) +
# Adjust the theme
theme_bw() +
theme(panel.border = element_rect(fill = NA, colour = "black", size = 1),
axis.text = element_text(size = 12, colour = "black"),
axis.ticks = element_line(colour = "black"))
fig_1_top
# The bottom figure (air)
fig_1_bottom <- ggplot(data = map_base, aes(x = lon, y = lat)) +
# The ocean temperature
geom_raster(data = var_mean_states, aes(fill = qt_clim)) +
# The land mass
geom_polygon(aes(group = group), fill = "grey70", colour = "black", size = 0.5, show.legend = FALSE) +
# The current vectors
# geom_segment(data = winds, aes(xend = lon + u * wind_uv_scalar, yend = lat + v * wind_uv_scalar),
# arrow = arrow(angle = 40, length = unit(winds$arrow_size, "cm"), type = "open"),
# linejoin = "mitre", size = 0.4) +
# The legend for the vector length
# geom_label(aes(x = 37.0, y = -38.0, label = "4.0 m/s\n"), size = 3, label.padding = unit(0.5, "lines")) +
# geom_segment(aes(x = 36.0, y = -38.3, xend = 38.0, yend = -38.3), linejoin = "mitre",
# arrow = arrow(angle = 40, length = unit(0.2, "cm"), type = "open")) +
# The sub/regions
# geom_polygon(data = NWA_coords, aes(group = region, fill = region, colour = region), alpha = 0.2) +
# South Atlantic Anticyclone
# annotate("text", label = "SOUTH\nATLANTIC\nANTICYCLONE", x = 13.5, y = -33.5, size = 3.0, angle = 0, colour = "ivory") +
# geom_curve(data = cyc_atlantic, aes(x = x, y = y, xend = xend, yend = yend), curvature = 0.2, colour = "ivory",
# arrow = arrow(angle = 40, type = "open", length = unit(0.25,"cm"))) +
# South Indian Anticyclone
# annotate("text", label = "SOUTH\nINDIAN\nANTICYCLONE", x = 36.5, y = -34.0, size = 3.0, angle = 0, colour = "ivory") +
# geom_curve(data = cyc_indian, aes(x = x, y = y, xend = xend, yend = yend), curvature = 0.2, colour = "ivory",
# arrow = arrow(angle = 40, type = "open", length = unit(0.25,"cm"))) +
# Westerlies
# annotate("text", label = "WESTERLIES", x = 22.5, y = -37.0, size = 3.0, angle = 0, colour = "ivory") +
# geom_curve(data = westerlies, aes(x = x, y = y, xend = xend, yend = yend), colour = "ivory",
# arrow = arrow(angle = 40, type = "open", length = unit(0.25,"cm")), curvature = -0.01) +
# Improve on the x and y axis labels
scale_x_continuous(breaks = seq(-70, -50, 10),
labels = scales::unit_format(suffix = "°E", sep = "")) +
scale_y_continuous(breaks = seq(35, 55, 10),
labels = scales::unit_format(suffix = "°N", sep = "")) +
labs(x = NULL, y = NULL) +
# Scale bar
# scaleBar(lon = 22.0, lat = -29.5, distanceLon = 200, distanceLat = 50, distanceLegend = 90, dist.unit = "km",
# arrow.length = 100, arrow.distance = 130, arrow.North.size = 3,
# legend.colour = "ivory", arrow.colour = "ivory", N.colour = "ivory") +
# Slightly shrink the plotting area
coord_cartesian(xlim = NWA_corners_sub[1:2], ylim = NWA_corners_sub[3:4], expand = F) +
# Use viridis colour scheme
scale_fill_viridis_c(name = "Net\ndownward\nheat flux", option = "A") +
# Adjust the theme
theme_bw() +
theme(panel.border = element_rect(fill = NA, colour = "black", size = 1),
axis.text = element_text(size = 12, colour = "black"),
axis.ticks = element_line(colour = "black"))
fig_1_bottom
# Convert the figures to grobs
fig_1_top_grob <- ggplotGrob(fig_1_top)
# fb_inset_grob <- ggplotGrob(fb_inset)
fig_1_bottom_grob <- ggplotGrob(fig_1_bottom)
# Stick them together
fig_1 <- ggplot() +
# First set the x and y axis values so we know what the ranges are
# in order to make it easier to place our facets
# coord_equal(xlim = c(1, 10), ylim = c(1, 10), expand = F) +
# Then we place our facetsover one another using the coordinates we created
annotation_custom(fig_1_top_grob,
xmin = 1, xmax = 10, ymin = 5.5, ymax = 10) +
# annotation_custom(fb_inset_grob,
# xmin = 3.5, xmax = 5.5, ymin = 7.2, ymax = 8.8) +
annotation_custom(fig_1_bottom_grob,
xmin = 1, xmax = 10, ymin = 1, ymax = 5.5)
fig_1
# save
# ggsave(plot = fig_1, filename = "graph/fig_1.pdf", height = 8, width = 8)
In these next figures we want to show the results of the SOM. These figures will contain 12 panels each and we will need to cleverly combine certain variables so as to limit the number of figures we will create.
# Load data packet
all_anom <- readRDS("data/packet_all_anom.Rda")
# Load SOM packet for anomaly data
som_all_anom <- readRDS("data/som_all_anom.Rda")
# Determine node index
node_index_all_anom <- event_node_index(all_anom, som_all_anom)
# Create and save mean synoptic states per node
node_mean_all_anom <- som_unpack_mean(all_anom, som_all_anom)
# From the SOM vignette
som_node_visualise <- function(sub_var = "sst_anom", viridis_option = "D"){
# Subset data
node_mean_all_anom_sub <- node_mean_all_anom %>%
filter(var == sub_var) %>%
mutate(lon = plyr::round_any(lon, 0.25),
lat = plyr::round_any(lat, 0.25)) %>%
group_by(node, lon, lat, var) %>%
summarise(val = mean(val, na.rm = T))
# Create plot
som_panel_plot <- ggplot(node_mean_all_anom_sub, aes(x = lon, y = lat)) +
# geom_point(aes(colour = val)) +
geom_raster(aes(fill = val)) +
geom_polygon(data = map_base, aes(group = group), show.legend = F) +
geom_label(data = node_index_all_anom, aes(x = -60, y = 35, label = paste0("n = ",count))) +
# geom_polygon(data = NWA_coords, aes(group = region, fill = region, colour = region), alpha = 0.1) +
coord_cartesian(xlim = NWA_corners_sub[1:2],
ylim = NWA_corners_sub[3:4],
expand = F) +
scale_fill_gradient2(low = "blue", high = "red") +
# scale_colour_viridis_c(option = viridis_option) +
labs(x = NULL, y = NULL, fill = sub_var) +
facet_wrap(~node, ncol = 4) +
theme(legend.position = "bottom")
return(som_panel_plot)
}
This figure needs to provide a detailed breakdown of the meta data behind the synoptic states being clustered into the 12 node panels. This means that we want to be able to show, primarily, during which seasons the MHWs in each node were occurring. This is shown effectively in Figure 7 of Oliver et al. (2018). But it would also be good to show other meta data, such as MHW metrics, as seen in Figure 5 of Schlegel et al. (2017). It may be that we want both. Or it may be that the metric summary could be done via a table.
### TO DO
# Calculate season based on peak of event
# Left join tables for event number, sub/region, node
# Create visuals for the nodes
# Load data packet
all_anom <- readRDS("data/packet_all_anom.Rda")
# Load SOM packet for anomaly data
som_all_anom <- readRDS("data/som_all_anom.Rda")
# Determine node index
node_index_all_anom <- event_node_index(all_anom, som_all_anom) %>%
mutate(event_no = as.numeric(event_no))
# MHW season of (peak) occurrence and other meta-data
NAPA_MHW_meta <- NAPA_MHW_event %>%
mutate(month_peak = lubridate::month(date_peak, label = T),
season_peak = case_when(month_peak %in% c("Jan", "Feb", "Mar") ~ "Winter",
month_peak %in% c("Apr", "May", "Jun") ~ "Spring",
month_peak %in% c("Jul", "Aug", "Sep") ~ "Summer",
month_peak %in% c("Oct", "Nov", "Dec") ~ "Autumn"),
sub_region = as.character(sub_region)) %>%
left_join(node_index_all_anom, by = c("region", "sub_region", "event_no"))
# Proportion of MHWs in each season in each node
node_prop_info <- NAPA_MHW_meta %>%
dplyr::select(region:event_no, month_peak:count) %>%
group_by(node, season_peak) %>%
mutate(node_season_prop = round(n()/count, 2)) %>%
select(season_peak:node_season_prop) %>%
unique() %>%
ungroup()
# Fill in the blanks
node_prop_grid <- expand.grid(unique(node_prop_info$season_peak), 1:12) %>%
dplyr::rename(season_peak = Var1, node = Var2) %>%
mutate(season_peak = as.character(season_peak)) %>%
# left_join(NWA_coords, by = "") %>%
left_join(node_prop_info, by = c("node", "season_peak")) %>%
mutate(count = replace_na(count, 0),
node_season_prop = replace_na(node_season_prop, 0))
# Proportion of MHWs in each season in each region
region_prop_info <- NAPA_MHW_meta %>%
dplyr::select(region:event_no, month_peak:count) %>%
group_by(node, region) %>%
mutate(region_node_prop = round(n()/count, 2)) %>%
select(region, node, count, region_node_prop) %>%
unique() %>%
ungroup() #%>%
# right_join(data.frame(node = 1:12), by = "node")
# right_join(NWA_coords, by = "region")
# Fill in the blanks
region_prop_grid <- expand.grid(unique(region_prop_info$region), 1:12) %>%
dplyr::rename(region = Var1, node = Var2) %>%
mutate(region = as.character(region)) %>%
left_join(NWA_coords, by = "region") %>%
left_join(region_prop_info, by = c("region", "node")) %>%
mutate(count = replace_na(count, 0),
region_node_prop = replace_na(region_node_prop, 0))
# Join node info to region coordinates to keep ggplot happy
# NWA_coords_more <- left_join(NWA_coords, region_prop_info)
# som_season_runner <- ggplot()
som_season_plot <- ggplot() +
# geom_point(aes(colour = val)) +
# geom_raster(aes(fill = val)) +
geom_polygon(data = map_base, aes(group = group, x = lon, y = lat), show.legend = F) +
geom_polygon(data = region_prop_grid, aes(group = region, x = lon, y = lat, fill = region_node_prop), colour = "black") +
geom_label(data = region_prop_grid, aes(x = -60, y = 35, label = paste0("n = ",count))) +
# geom_label(data = filter(node_prop_grid, season_peak == "Winter"),
# aes(x = -60, y = 35, fill = node_season_prop, label = "Winter"), colour = "white") +
# geom_label(data = filter(node_prop_grid, season_peak == "Spring"),
# aes(x = -55, y = 35, fill = node_season_prop, label = "Spring"), colour = "white") +
# geom_label(data = filter(node_prop_grid, season_peak == "Summer"),
# aes(x = -50, y = 35, fill = node_season_prop, label = "Summer"), colour = "white") +
# geom_label(data = filter(node_prop_grid, season_peak == "Autumn"),
# aes(x = -45, y = 35, fill = node_season_prop, label = "Autumn"), colour = "white") +
# geom_label(data = node_index_all_anom, aes(x = -60, y = 35, label = paste0("n = ",count))) +
# geom_polygon(data = NWA_coords, aes(group = region, fill = region, colour = region), alpha = 0.1) +
coord_cartesian(xlim = NWA_corners_sub[1:2],
ylim = NWA_corners_sub[3:4],
expand = F) +
scale_fill_distiller(palette = "BuPu", direction = -1) +
# scale_fill_viridis_c(option = "C") +
# scale_colour_viridis_c(option = viridis_option) +
labs(x = NULL, y = NULL, fill = "Proportion of events\nper region per node") +
facet_wrap(~node, ncol = 4) +
theme(legend.position = "bottom")
som_season_plot
ggsave(som_season_plot, filename = "output/som_season_plot.pdf", height = 12, width = 13)
The following code is for creating meta-data visualisations of the MHW metrics for each node.
# Calculate the season during the peak of the event
# Join tables that have sub/region + season + node
# Think of a way to visualise this information
# Or just copy Eric
# Calculate mean and median per node for plotting
node_h_lines <- NAPA_MHW_meta %>%
group_by(node) %>%
summarise(mean_int_cum = mean(intensity_cumulative, na.rm = T),
median_int_cum = median(intensity_cumulative, na.rm = T))
# Create the figure
som_lolli_plot <- ggplot(data = NAPA_MHW_meta, aes(x = date_peak, y = intensity_cumulative)) +
geom_lolli() +
geom_point(aes(colour = season_peak)) +
geom_label(aes(x = as.Date("2007-01-01"), y = 450, label = paste0("n = ", count,"/",length(node))),
size = 3, label.padding = unit(0.5, "lines")) +
geom_hline(data = node_h_lines, aes(yintercept = mean_int_cum), linetype = "dashed") +
# geom_hline(data = node_h_lines, aes(yintercept = median_int_cum), linetype = "dotted") +
facet_wrap(~node) +
labs(x = "", y = "Cummulative intensity (°Cxdays)", colour = "Season") #+
# theme_grey() +
# scale_y_continuous(expand = c(0, 100)) +
# theme(strip.background = element_rect(fill = NA),
# panel.border = element_rect(fill = NA, colour = "black", size = 1),
# axis.text = element_text(size = 12, colour = "black"),
# axis.ticks = element_line(colour = "black"))
# som_lolli_plot
ggsave(som_lolli_plot, filename = "output/som_lolli_plot.pdf", height = 9, width = 10)
This figure should summarise what all of the other figures have shown by using arrows going form one direction to the other across the 12 panels of the SOM. It may make sense to put the bullet points that would make up Table 1 into the panels of this figure.
This table will show a synopsis of what each node appears to portray. It will be primarily modelled after Table 4 of Oliver et al. (2018).
# Node 1: Warm pulse of GS near NS coast. Shallowing mixed layer, low wind stress, and strong negative heat flux. Mostly gm and ss, almost no nfs. Almost entirely summer and autumn from 2013 - 2016. Mostly smaller evets but a few are massive.
# Node 2: Cold GS with warm LC caused by positive heat flux, low wind stress, and shallow mixed layer. Mostly cbs with some gsl and no mab. Occurred in only 199 in two pulses in spring and summer (June - October). Normal intensity but short duration.
# Node 3: Calm sea state with some positive heatflux into the LC causing events. Shallower mixed layer everywhere. Mostly nfs with progressively fewer events in regions down the coast. Almost none in ls. Smaller events with a couple of large ones. All seasons from 1999 - 2014.
# Node 4: Extremely shallow mixed layer with a strong positive heatflux and low wind stress. Mostly nfs with progressively fewer events further away. Smaller events. Autumn, Winter, and Spring from 1999 - 2014.
# Node 5: Slightly shallow slightly fast push of the GS into the coast becoming slightly deeper near WHOI before coming back away from the coast and chilling out. The core of the pulse has negative heatflux but the surrounding GS has a strong positive heatflux and snall wind stress. Almost exclusively occurs in mab with only a bit everywhere else. Smallish events with a few massive ones. All seasons from 2003 - 2015.
# Node 6: Slightly warmer LS and LC with cooler GS. Minor poitive heat flux into LS and large positive heat flux into GS. Normal mixed layer with low wind stress over the LS and high over the GS. Mostly in the ls with a bit in the mab with almost none elsewhere. Occurred over 1999 - 2010 in spring and summer. Smaller events that have not been increasing over time.
# Node 7: Warm waters from LS to LC to GSL and a cold GS. Strong downward heat flux over northern waters and negative flux over GS. Shallow northern waters with low wind stress while high stress over GS. Equally high in ls and nfs. A bit in cbs but almost none elsewhere. Spring - Autumn from 2000 - 2014. 2006 was a particularly strong year. Events are overall not particularly large.
# Node 8: Warm northern waters with a cold GS. Strong positive flux over LS with weaker positive flux over GSL and negative over GS. Very shallow LS and very deep GS. Affects all northern waters but highest in gsl and ls. No events in mab and almost none in gm. Almost always Autumn and Winter from 2006 - 2013. Some more intense events later on with 2010/11 being a larger year.
# Node 9: Similar to node 5. Strong nearshore GS pulse. Strong negative flux over LS and GS but positive over the rest of the Atlantic. Very strong wind stress over LS and eastern part of Atlantic, weak over the warm heat flux area of the Atlantic. Extremely deep LS and shallow GS. Occurred over 2002 - 2016 for winter and spring, events began occurring in Autumn from 2013. Evens becoming rather intense as time progresses with some massive ones. Increasing in intensity in most regions.
# Node 10: Very unstable mostly cold GS with warm GM and SS waters. Negative heat flux into shelf waters and positive into GS. High wind stress over LS and low over shelf waters. Deep GS and GM waters but shallow over SS. Spread out over most regions with fewest events in mab and nfs. A few tiny events from 2009 - 2011 but really got going from 2012 - 2013. Spring of 2013 was small while Autumn/WInter of 2012/13 was noteworthy.
# Node 11: Energetic but normal temperature GS with warm inshore waters and slightly warm LS. Positive heat flux into GS and LS but negative into inshore waters. High wind stress above LS and a bit over central AO, but negative everywhere else. Very deep mixed layer next to coast in MAB but relatively normal everywhere else. Relatively equivalent occurrence in all regions. Occurred only from July - October, 2012. A few decent sized events. Mean max intensity is decent.
# Node 12: Warm inshore and LS waters with cold GS and AO. GS is moving fast and consistent. Negative heatflux into GS and inshore waters, slightly positive into LS and AO. High wind stress over GS and AO, negative over inshore waters and LS. Very deep mixed layer along coast in mab and very shallow along coast in ls. Mostly events occurring in gsl, but also in other northern areas. Occurred every even year from 2008 to 2014 from ~June - September. Relatively small (short) events but with decent max intensities.
It may be good to create a reference multi-panel figure for each event, as seen in Schlegel et al. (2017). But given that there are nearly 700 events being considered, this is likely too much. Perhaps showing the top 100 or some sort of meaningful reduction
# Create synoptic figure for each event
# Load SACTN data
load("~/data/SACTN/AHW/SACTN_clims.Rdata")
load("data/SACTN/SACTN_events.Rdata")
load("setupParams/SACTN_site_list.Rdata")
# The files for loading
event_idx <- data.frame(event = dir("data/SOM", full.names = TRUE),
x = length(dir("data/SOM")))
# Create a synoptic atlas figure for each MHW
system.time(plyr::ddply(event_idx, c("event"), synoptic.fig, .progress = "text")) # 539 seconds
Oliver, E. C., Lago, V., Hobday, A. J., Holbrook, N. J., Ling, S. D., and Mundy, C. N. (2018). Marine heatwaves off eastern tasmania: Trends, interannual variability, and predictability. Progress in oceanography 161, 116–130.
Schlegel, R. W., Oliver, E. C., Perkins-Kirkpatrick, S., Kruger, A., and Smit, A. J. (2017). Predominant atmospheric and oceanic patterns during coastal marine heatwaves. Frontiers in Marine Science 4, 323.
sessionInfo()
R version 3.6.1 (2019-07-05)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 16.04.5 LTS
Matrix products: default
BLAS: /usr/lib/openblas-base/libblas.so.3
LAPACK: /usr/lib/libopenblasp-r0.2.18.so
locale:
[1] LC_CTYPE=en_CA.UTF-8 LC_NUMERIC=C
[3] LC_TIME=en_CA.UTF-8 LC_COLLATE=en_CA.UTF-8
[5] LC_MONETARY=en_CA.UTF-8 LC_MESSAGES=en_CA.UTF-8
[7] LC_PAPER=en_CA.UTF-8 LC_NAME=C
[9] LC_ADDRESS=C LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_CA.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] bindrcpp_0.2.2 FNN_1.1.2.1 akima_0.6-2
[4] tidync_0.2.1 heatwaveR_0.3.6.9004 data.table_1.11.6
[7] yasomi_0.3 proxy_0.4-22 e1071_1.7-0
[10] lubridate_1.7.4 ncdf4_1.16 forcats_0.3.0
[13] stringr_1.3.1 dplyr_0.7.6 purrr_0.2.5
[16] readr_1.1.1 tidyr_0.8.1 tibble_1.4.2
[19] ggplot2_3.0.0 tidyverse_1.2.1 jsonlite_1.6
loaded via a namespace (and not attached):
[1] Rcpp_0.12.18 lattice_0.20-35 class_7.3-14
[4] foreach_1.4.4 assertthat_0.2.0 rprojroot_1.3-2
[7] digest_0.6.16 R6_2.2.2 cellranger_1.1.0
[10] plyr_1.8.4 backports_1.1.2 evaluate_0.11
[13] httr_1.3.1 pillar_1.3.0 rlang_0.2.2
[16] lazyeval_0.2.1 readxl_1.1.0 ncmeta_0.0.4
[19] rstudioapi_0.7 whisker_0.3-2 R.utils_2.7.0
[22] R.oo_1.22.0 rmarkdown_1.10 htmlwidgets_1.3
[25] munsell_0.5.0 broom_0.5.0 compiler_3.6.1
[28] modelr_0.1.2 pkgconfig_2.0.2 htmltools_0.3.6
[31] tidyselect_0.2.4 workflowr_1.1.1 codetools_0.2-15
[34] doMC_1.3.5 viridisLite_0.3.0 crayon_1.3.4
[37] withr_2.1.2 R.methodsS3_1.7.1 grid_3.6.1
[40] nlme_3.1-137 gtable_0.2.0 git2r_0.23.0
[43] magrittr_1.5 scales_1.0.0 cli_1.0.0
[46] stringi_1.2.4 sp_1.3-1 xml2_1.2.0
[49] iterators_1.0.10 tools_3.6.1 glue_1.3.0
[52] RNetCDF_1.9-1 maps_3.3.0 hms_0.4.2
[55] parallel_3.6.1 yaml_2.2.0 colorspace_1.3-2
[58] rvest_0.3.2 plotly_4.9.0 knitr_1.20
[61] bindr_0.1.1 haven_1.1.2
This reproducible R Markdown analysis was created with workflowr 1.1.1