-
Notifications
You must be signed in to change notification settings - Fork 1
/
velocity_white_paper.Rmd
89 lines (67 loc) · 3.63 KB
/
velocity_white_paper.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
---
title: "Fine scale velocity exploration for water quality drought synthesis"
author: "Elizabeth Stumpner"
date: "2022-12-15"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, message = FALSE)
```
```{r}
library(readr)
library(dplyr)
library(ggplot2)
library(lubridate)
library(ggbeeswarm)
library(DroughtData)
library(sf)
library(mapview)
library(stats)
```
# Overview
This is the velocity analysis for the Drought paper. The weekly velocity records are calculated from instantanous (15-min) records at four USGS flow stations. Stations include Cache at Ryer Island Ferry, San Joaquin River at Jersey Point, Middle River, and Old River at Bacon Island (see map below). The weekly velocity data is combined with dayflow parameters and drought classification in the DroughtData R package.
```{r}
load("data/vel_weekly_WP.RData")
lat_long <- read_csv('vel_coord.csv')
```
## Station map
Here is a map of the selected USGS stations flow stations in the Delta - from north to south the stations include Cache Slough (USGS 11455350 - inactive RYI station, 11455385 - active RYF station), Jersey Point (11337190), Old River at Bacon Island (11313405), and Middle River (11312676)
```{r}
lat_long_sf <- st_as_sf(lat_long, coords = c('LongitudeMeasure', 'LatitudeMeasure'), crs = 4326)
mapview(lat_long_sf, layer.name = "Velocity", cex=10, label = 'site')
```
## Compare 2020 + 2021 to other years - WQ White Paper
### Mean net velocity and maximum absolute velocity across stations
The 2020 and 2021 net velocities compare well to previous drought years. Breaking the data down by station show the Cache and Jersey net velocities are most always seaward and Middle and Old Rivers most always landward, except during wet periods of wet years.
The max. abs. tidal velocities in 2020 and 2021 are nearly identical to dry and critical years years except at Cache where they're slightly lower. With data faceted by station, a slight reduction in max. abs. tidal vel. range at Cache is observed in 2020 relative to other years.
```{r}
#zoom in
ann_text <- data.frame(Whitepaper = "Wet", station = c("Cache", "Jersey"),lab = "*", Yr_type = "Wet",
mean_net_vel = .7)
Vel_test = filter(vel_weekly_WP, mean_net_vel <0.7)
Vel_test2 = filter(vel_weekly_WP, mean_net_vel >= 0.7)
vel_wet = filter(vel_weekly_WP, station %in% c("Cache", "Jersey"), Yr_type == "Wet")
vel_a <- ggplot(Vel_test, aes(x=Whitepaper, y=mean_net_vel, fill=Yr_type))+
geom_boxplot()+
facet_wrap(~station, scales = "free_y") +
drt_color_pal_yrtype()+
labs(x = "Water year index", y = expression(paste("mean net vel. (", ft," ",s^-1, ")", sep="")), title = "A. mean net vel. across stations (2007 - 2022)") +
theme_bw()+
# ylim(-0.5, 0.7)+
geom_hline(yintercept=0, linetype='solid', col = 'black') +
scale_x_discrete(labels = c("Critical", "Dry", "Below\nNormal", "Wet","2020", "2021", "2022"))+
theme( legend.position = "none") +
geom_text(data = ann_text, aes(label = lab), color = "red", size = 8)
vel_a
ggsave("plots/whitepaper/vel_a.tiff", device = "tiff", width = 8, height = 6)
vel_b <- ggplot(vel_weekly_WP, aes(x=Whitepaper, y=max_abs_tidal, fill=Yr_type))+
geom_boxplot()+
facet_wrap(~station, scales = "free_y")+
drt_color_pal_yrtype()+
labs(x = "Water year index", y = expression(paste("max. abs. tidal vel. (", ft," ",s^-1, ")", sep="")), title = "B. max. abs. tidal vel. across stations (2007 - 2021)") +
scale_x_discrete(labels = c("Critical", "Dry", "Below\nNormal", "Wet","2020", "2021", "2022"))+
theme_bw()+
theme(legend.position = "none")
vel_b
ggsave("plots/whitepaper/vel_b.tiff", device = "tiff", width = 8, height = 6)
```