-
Notifications
You must be signed in to change notification settings - Fork 0
/
figures.Rmd
628 lines (537 loc) · 31.3 KB
/
figures.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
---
title: "Figure and table creation"
author: "Robert Schlegel"
date: "2019-06-10"
output: workflowr::wflow_html
editor_options:
chunk_output_type: console
csl: FMars.csl
bibliography: MHWNWA.bib
---
```{r global_options, include = FALSE}
knitr::opts_chunk$set(fig.width = 8, fig.align = 'center',
echo = TRUE, warning = FALSE, message = FALSE,
eval = TRUE, tidy = FALSE)
```
## Introduction
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 @Oliver2018tasmania (https://www.sciencedirect.com/science/article/pii/S0079661117303336) and @Schlegel2017predominant (https://www.frontiersin.org/articles/10.3389/fmars.2017.00323/full).
```{r libraries}
# Insatll from GitHub
# .libPaths(c("~/R-packages", .libPaths()))
# devtools::install_github("fabrice-rossi/yasomi")
# Load packages and functions from the central functions script
source("code/functions.R")
# Packages used in this vignette
# library(jsonlite, lib.loc = "../R-packages/")
library(tidyverse) # Base suite of functions
library(lubridate) # For convenient date manipulation
library(data.table) # For working with massive dataframes
# library(yasomi, lib.loc = "../R-packages/") # The SOM package of choice due to PCI compliance
# library(ncdf4) # For opening and working with NetCDF files
# library(scales) # For scaling data before running SOM
# 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")
# 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: This was created in a previous version of the polygon-prep vignette
bathy <- readRDS("data/NWA_bathy_lowres.Rda")
```
## Figure 1
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.
```{r old-code, eval=FALSE}
### TO DO
# Gulf Stream curved vector
# Halifax labelled point
# Text "Labrador Sea"
# Text: "Labrador Current"
# Improve bathymetry contours
# Look into the new ggfriendly method
# One panel should contain current vectors
# And the other panel should contain bathymetry contours
# Load all climatology files
# NB: There are three slightly different coordinate schemes at play
OISST_sst_clim <- readRDS("data/OISST_sst_clim.Rda") %>%
mutate(lon = lon-0.125, lat = lat+0.125) %>%
dplyr::rename(sst_clim = seas)
GLORYS_mld_clim <- readRDS("data/GLORYS_mld_clim.Rda") %>%
dplyr::rename(mld_clim = seas)
GLORYS_u_clim <- readRDS("data/GLORYS_u_clim.Rda") %>%
dplyr::rename(u_clim = seas)
GLORYS_v_clim <- readRDS("data/GLORYS_v_clim.Rda") %>%
dplyr::rename(v_clim = seas)
ERA5_qnet_clim <- readRDS("data/ERA5_qnet_clim.Rda") %>%
mutate(lon = ifelse(lon > 180, lon-360, lon)) %>%
dplyr::rename(qnet_clim = seas)
ERA5_t2m_clim <- readRDS("data/ERA5_t2m_clim.Rda") %>%
mutate(lon = ifelse(lon > 180, lon-360, lon)) %>%
dplyr::rename(t2m_clim = seas)
ERA5_u_clim <- readRDS("data/ERA5_u_clim.Rda") %>%
mutate(lon = ifelse(lon > 180, lon-360, lon)) %>%
dplyr::rename(u10_clim = seas)
ERA5_v_clim <- readRDS("data/ERA5_v_clim.Rda") %>%
mutate(lon = ifelse(lon > 180, lon-360, lon)) %>%
dplyr::rename(v10_clim = seas)
# Combine into one object
# ALL_clim <- left_join(ERA5_qnet_clim, ERA5_t2m_clim, by = c("lon", "lat", "doy"))
system.time(
ALL_clim <- purrr::reduce(list(ERA5_qnet_clim, ERA5_t2m_clim,
ERA5_v_clim, ERA5_u_clim,
GLORYS_mld_clim, GLORYS_v_clim,
GLORYS_u_clim, OISST_sst_clim), left_join, by = c("lon", "lat", "doy"))
) # 64 seconds
# Mean variable states
system.time(
var_mean_states <- ALL_clim %>%
dplyr::select(-doy) %>%
group_by(lon, lat) %>%
summarise_all(.funs = "mean") %>%
ungroup() %>%
arrange(lon, lat)
) # 2 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),]
var_mean_states_sub <- var_mean_states %>%
filter(lon %in% lon_sub, lat %in% lat_sub) %>%
group_by(lon, lat) %>%
mutate(arrow_size = abs(u_clim)+abs(v_clim),
arrow_size = ifelse(is.na(arrow_size), 0, arrow_size)) %>%
ungroup() %>%
arrange(lon, lat)
# Creating dynamic arrow sizes does not work as ggplot cannot match up the vectors correctly
var_mean_states_sub$arrow_size <- 0.1
# 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 = var_mean_states_sub, aes(xend = lon + u_clim * current_uv_scalar,
yend = lat + v_clim * current_uv_scalar),
arrow = arrow(angle = 40, length = unit(var_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_x_continuous(breaks = seq(-70, -50, 10),
labels = c("70°W", "60°W", "50°W"),
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[1:2], ylim = NWA_corners[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 land mass
geom_polygon(aes(group = group), fill = "grey70", colour = "black", size = 0.5, show.legend = FALSE) +
# The net downward heatflux
geom_raster(data = var_mean_states, aes(fill = qnet_clim), alpha = 0.9) +
# The current vectors
geom_segment(data = var_mean_states_sub, aes(xend = lon + u10_clim * current_uv_scalar,
yend = lat + v10_clim * current_uv_scalar),
arrow = arrow(angle = 40, length = unit(var_mean_states_sub$arrow_size, "cm"), type = "open"),
linejoin = "mitre", size = 0.4, alpha = 0.3) +
# 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 = c("70°W", "60°W", "50°W")) +
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[1:2], ylim = NWA_corners[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
# NB: This is still a bit of a mess...
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 facets over one another using the coordinates we created
annotation_custom(fig_1_top_grob,
xmin = 1, xmax = 9.5, 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)
```
## Figure 2
The 12 nodes showing the SST and U+V current vectors.
```{r fig-2, eval=FALSE}
# Load SOM results
som_packet <- readRDS("data/som_nolab.Rda")
# Cast the data wide
som_data_wide <- som_packet$data %>%
spread(var, val) %>%
mutate(mld_anom_cut = cut(mld_anom, breaks = seq(-0.5, 0.5, 0.1)))
# Reduce wind/ current vectors
lon_sub <- seq(min(som_data_wide$lon), max(som_data_wide$lon), by = 1)
lat_sub <- seq(min(som_data_wide$lat), max(som_data_wide$lat), by = 1)
# currents <- currents[(currents$lon %in% lon_sub & currents$lat %in% lat_sub),]
som_data_sub <- som_data_wide %>%
filter(lon %in% lon_sub, lat %in% lat_sub) %>%
mutate(arrow_size = 0.1)
# Creating dynamic arrow sizes does not work as ggplot cannot match up the vectorscorrectly
# Establish the vector scalar for the currents
current_uv_scalar <- 2
# Establish the vector scalar for the wind
wind_uv_scalar <- 0.5
# The figure
fig_2 <- ggplot(data = som_data_wide, aes(x = lon, y = lat)) +
# The ocean temperature
geom_raster(aes(fill = sst_anom)) +
# 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 = som_data_sub, aes(xend = lon + u_anom * current_uv_scalar,
yend = lat + v_anom * current_uv_scalar),
arrow = arrow(angle = 40, length = unit(som_data_sub$arrow_size, "cm"), type = "open"),
linejoin = "mitre", size = 0.4, alpha = 0.8) +
# The land mass
geom_polygon(data = map_base, aes(group = group), alpha = 0.8,
fill = "grey70", colour = "black", size = 0.5, show.legend = FALSE) +
# Scale labels
scale_x_continuous(breaks = seq(-70, -50, 10),
labels = c("70°W", "60°W", "50°W"),
position = "top") +
scale_y_continuous(breaks = c(40, 50),
labels = scales::unit_format(suffix = "°N", sep = "")) +
labs(x = NULL, y = NULL) +
# Slightly shrink the plotting area
coord_cartesian(xlim = c(min(som_data_wide$lon), max(som_data_wide$lon)),
ylim = c(min(som_data_wide$lat), max(som_data_wide$lat)),
expand = F) +
# Use diverging gradient
scale_fill_gradient2(name = "SST\nanom. (°C)", low = "blue", high = "red") +
# 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")) +
facet_wrap(~node)
fig_2
```
## Figure 3
The 12 nodes showing surface air temperatures and U+V surface wind vectors.
```{r fig-3, eval=FALSE}
fig_3 <- ggplot(data = som_data_wide, aes(x = lon, y = lat)) +
# The surface air temperature anomaly
geom_raster(aes(fill = t2m_anom)) +
# The land mass
geom_polygon(data = map_base, aes(group = group), alpha = 0.9,
fill = NA, colour = "black", size = 0.5, show.legend = FALSE) +
# The wind vectors
geom_segment(data = som_data_sub, aes(xend = lon + u10_anom * wind_uv_scalar,
yend = lat + v10_anom * wind_uv_scalar),
arrow = arrow(angle = 40, length = unit(som_data_sub$arrow_size, "cm"), type = "open"),
linejoin = "mitre", size = 0.4, alpha = 0.4) +
# Better scale labels
scale_x_continuous(breaks = seq(-70, -50, 10),
labels = c("70°W", "60°W", "50°W"),
position = "top") +
scale_y_continuous(breaks = c(40, 50),
labels = scales::unit_format(suffix = "°N", sep = "")) +
labs(x = NULL, y = NULL) +
# Trim plotting area
coord_cartesian(xlim = c(min(som_data_wide$lon), max(som_data_wide$lon)),
ylim = c(min(som_data_wide$lat), max(som_data_wide$lat)),
expand = F) +
# Use diverging gradient
scale_fill_gradient2(name = "Air temp.\nanom. (°C)", low = "blue", high = "red") +
# 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")) +
facet_wrap(~node)
fig_3
```
## Figure 4
The 12 nodes showing net downward heatflux and mixed layer depth (MLD). Note that each pixels MLD has already been scaled to one before running the SOM.
```{r fig-4, eval=FALSE}
fig_4 <- ggplot(data = som_data_wide, aes(x = lon, y = lat)) +
# Net downward heat flux anomaly
geom_raster(aes(fill = qnet_anom)) +
# The MLD contours
geom_contour(aes(z = round(mld_anom, 1), colour = ..level..), size = 0.5) +
# The land mass
geom_polygon(data = map_base, aes(group = group), alpha = 0.8,
fill = NA, colour = "black", size = 0.5, show.legend = FALSE) +
# Colour scale
scale_fill_gradient2("Net downward\nheat flux\nanom. (W/m2)", low = "blue", high = "red") +
scale_colour_gradient2(low = "green", high = "yellow") +
# Better scale labels
scale_x_continuous(breaks = seq(-70, -50, 10),
labels = c("70°W", "60°W", "50°W"),
position = "top") +
scale_y_continuous(breaks = c(40, 50),
labels = scales::unit_format(suffix = "°N", sep = "")) +
labs(x = NULL, y = NULL) +
# Trim plotting area
coord_cartesian(xlim = c(min(som_data_wide$lon), max(som_data_wide$lon)),
ylim = c(min(som_data_wide$lat), max(som_data_wide$lat)),
expand = F) +
# 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")) +
facet_wrap(~node)
fig_4
```
## Figure 5
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 @Oliver2018tasmania. But it would also be good to show other meta data, such as MHW metrics, as seen in Figure 5 of @Schlegel2017predominant. It may be that we want both. Or it may be that the metric summary could be done via a table.
```{r seasonal-info-fig, eval=FALSE}
### TO DO
# Left join tables for event number, sub/region, node
# Create visuals for the nodes
# Load SOM packet for labrador exclusion data
som_nolab <- readRDS("data/som_nolab.Rda")
# MHW season of (peak) occurrence and other meta-data
OISST_MHW_meta <- OISST_MHW_event %>%
left_join(som_nolab$info, by = c("region", "event_no"))
# Grid of complete node x season matrix
node_prop_grid <- expand.grid(seq(1:12), c("Summer", "Autumn", "Winter", "Spring"),
stringsAsFactors = F) %>%
dplyr::rename(node = Var1, season_peak = Var2)
# Proportion of MHWs in each season in each node
node_prop_info <- OISST_MHW_meta %>%
dplyr::select(region:event_no, node:season_peak) %>%
group_by(node, season_peak) %>%
mutate(node_season_prop = round(n()/count, 2)) %>%
select(node, count, season_peak:node_season_prop) %>%
unique() %>%
na.omit() %>%
right_join(node_prop_grid, by = c("node", "season_peak")) %>%
mutate(node_season_prop = ifelse(is.na(node_season_prop), 0, node_season_prop)) %>%
# Fill holes in count column created by right_join
group_by(node) %>%
mutate(count = max(count, na.rm = T)) %>%
ungroup()
# Grid of complete node x season matrix
region_prop_grid <- expand.grid(seq(1:12), unique(OISST_MHW_meta$region),
stringsAsFactors = F) %>%
dplyr::rename(node = Var1, region = Var2)
# Proportion of MHWs in each season in each region
region_prop_info <- OISST_MHW_meta %>%
dplyr::select(region:event_no, node:season_peak) %>%
group_by(node, region) %>%
mutate(region_node_prop = round(n()/count, 2)) %>%
select(region, node, count, region_node_prop) %>%
unique() %>%
ungroup() %>%
right_join(region_prop_grid, by = c("node", "region")) %>%
mutate(region_node_prop = ifelse(is.na(region_node_prop), 0, region_node_prop)) %>%
# Fill holes in count column created by right_join
group_by(node) %>%
mutate(count = max(count, na.rm = T)) %>%
ungroup()
# 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)) %>%
filter(region != "ls")
# Create labels for number of states per region per node
region_prop_label <- region_prop_grid %>%
group_by(region, node, count, region_node_prop) %>%
summarise(lon = mean(lon), lat = mean(lat)) %>%
mutate(count_region_node = round(count*region_node_prop))
# 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(data = region_prop_grid, 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_polygon(aes(group = region, fill = region_node_prop), colour = "black") +
geom_label(data = region_prop_label, aes(label = count_region_node)) +
geom_label(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[1:2],
ylim = NWA_corners[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)
```
## Figure 6
The following code is for creating meta-data visualisations of the MHW metrics for each node.
```{r extra-info-fig, eval=FALSE}
# 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)
```
## Figure 7
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.
## Table 1
This table will show a synopsis of what each node appears to portray. It will be primarily modelled after Table 4 of @Oliver2018tasmania.
```{r interpretation-table, eval=FALSE}
# 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.
```
## Appendix
### Figures
It may be good to create a reference multi-panel figure for each event, as seen in @Schlegel2017predominant. 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
```{r appendix-fig, eval=FALSE}
# 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
```