-
Notifications
You must be signed in to change notification settings - Fork 0
/
heatmaps.Rmd
103 lines (85 loc) · 6.27 KB
/
heatmaps.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
---
output: word_document
---
Suwannee River discharge is known to influence salinity in Suwannee Sound (Orlando et al. 1993) and lags between Suwannee River discharge and oyster counts have been observed (Moore et al. 2020). River discharge is essentially a second "treatment" in this restoration project (after the rebuilding of the reef) because it is the freshwater from the Suwannee River that Lone Cabbage Reef is thought to detain thus possibly promoting lower salinity. River discharge patterns in the Suwanee River basin may be changing over decadal scales due to changing climate, as is hypothesized for large rivers in the Gulf of Mexico (Neupane et al. 2019). For the period of record for the USGS Wilcox gauge (02323500) which begins in October 1930, we created a "heat map" that demonstrates for each month and year the deviation in river discharge (as a percentage) from the period of record average.
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library("waterData")
library("hydroTSM")
library("zoo")
require("plot.matrix")
library("RColorBrewer")
```
```{r, include= FALSE, warning=FALSE, message=FALSE, comment=FALSE}
#station to analyze
station = '02358000'
#get site name to use in plot titles and such
stinfo = siteInfo(station)
#read entire time series
dis = importDVs(staid=station,code='00060',stat='00003', sdate= "1922-07-01")
#get some date components
dis$year = as.numeric(strftime(dis$dates,format="%Y"))
dis$month = as.numeric(strftime(dis$dates,format="%m"))
#dataset starts on 1922-07-01
#ends on 2020-10-04
#make dataset from epochs restrict from October 1957 to October 2020
disE = dis[dis$dates>='1922-07-01' & dis$dates<='2021-01-01',]
#get monthly sum, mean, sd, and var
#discharge
disE.mo = aggregate(val~month+year,data=disE,FUN = function(x) c(mean(x,na.rm=T),sd(x,na.rm=T),var(x,na.rm=T),sum(x)))
disE.mo = do.call('data.frame',disE.mo)
names(disE.mo)[3:6] = c('avg','sd','var','sumflow')
disE.mo$yrmo = disE.mo$year+(disE.mo$month-0.5)/12
#value just by month
disE.month = aggregate(val~month,data=disE,FUN = function(x) c(mean(x,na.rm=T),sd(x,na.rm=T),var(x,na.rm=T),sum(x)))
disE.month = do.call('data.frame',disE.month)
names(disE.month)[2:5] = c('avg','sd','var','sumflow')
#calculate how far each month average is from the overall average - absolute difference
for(i in 1:nrow(disE.mo)){
m = disE.mo$month[i]
disE.mo$diff[i] = disE.mo$avg[i] - disE.month$avg[disE.month$month == m]
disE.mo$diff_percent[i] = ((disE.mo$avg[i] - disE.month$avg[disE.month$month == m])/disE.month$avg[disE.month$month == m])*100
}
library(reshape2)
dis_mat = dcast(disE.mo, year ~ month, value.var = "diff")
dis_mat2 = as.matrix(dis_mat[,2:ncol(dis_mat)], dimnames = list(rownames = dis_mat$year, colnames = colnames(dis_mat)))
rownames(dis_mat2) <- dis_mat$year
#create matrix for percentage
dis_per = dcast(disE.mo, year ~ month, value.var = "diff_percent")
dis_per2 = as.matrix(dis_per[,2:ncol(dis_per)], dimnames = list(rownames = dis_mat$year, colnames = colnames(dis_mat)))
rownames(dis_per2) <- dis_per$year
```
```{r , echo=FALSE, warning=FALSE, message=FALSE, comment=FALSE}
col2 <- brewer.pal(9, "Blues") #for the +%s
col3 <- brewer.pal(11, "RdBu") #red is - blue is +
colAll <- c(col3[1], col3[2], col3[3], col3[6], col2[4:7], col3[10],col2[8:9], col3[11], "#042333ff")
par(oma=c(0.5,0.5,0.5,3))
plot(dis_per2, xlab = "Month", ylab = "Year",
breaks = c(-100, -50, -25, -10, 10, 50, 100, 150, 200, 250, 300, 350, 400, 450),
main = "Discharge",
axis.row = list(las = 2),
col = colAll, na.col = "black")
```
Figure 1. Heat map of Suwannee River deviations in mean daily discharge by year and month from USGS Wilcox gauge (02322500) for the period of record measured as deviation from the average by month for period of record. White color for a given month and year is a month when river discharge is similar (with +/- 10%) to the period of record average, while blue to dark blue colors represent increasing discharge levels deviating as a percentage from the long-term average. Red to dark red colors conversely equal increasingly low discharge levels (below the period of record average). The black colors are months when data are not available.
```{r, echo=FALSE, warning=FALSE, message=FALSE, comment=FALSE}
include_years <- as.character(as.numeric(2005:2021))
dis_per20052021 <- dis_per2[include_years, ]
par(oma=c(0.5,0.5,0.5,3))
plot(dis_per20052021, xlab = "Month", ylab = "Year",
breaks = c(-100, -50, -25, -10, 10, 50, 100, 150, 200, 250, 300, 350, 400, 450),
main = "Discharge",
axis.row = list(las = 2),
col = colAll, na.col = "black")
```
Figure 2. Heat map of Suwannee River deviations in mean daily discharge by year and month from USGS Wilcox gauge (02323500) for 2005-2021 measured as deviation from the average by month for period of record. White color for a given month and year is a month when river discharge is similar (with +/- 10%) to the period of record average, while blue to dark blue colors represent increasing discharge levels deviating as a percentage from the long-term average. Red to dark red colors conversely equal increasingly low discharge levels (below the period of record average). The black colors are months when data are not available.
```{r, echo=FALSE, warning=FALSE, message=FALSE, comment=FALSE}
include_years <- as.character(as.numeric(2018:2021))
dis_per20182020 <- dis_per2[include_years, ]
par(oma=c(0.5,0.5,0.5,3))
plot(dis_per20182020, xlab = "Month", ylab = "Year",
breaks = c(-100, -50, -25, -10, 10, 50, 100, 150, 200, 250, 300, 350, 400, 450),
main = "Discharge",
axis.row = list(las = 2),
col = colAll, na.col = "black")
```
Figure 3. Heat map of Suwannee River deviations in mean daily discharge by year and month from USGS Wilcox gauge (02323500) for 2018-2021 measured as deviation from the average by month for period of record. White color for a given month and year is a month when river discharge is similar (with +/- 10%) to the period of record average, while blue to dark blue colors represent increasing discharge levels deviating as a percentage from the long-term average. Red to dark red colors conversely equal increasingly low discharge levels (below the period of record average). The black colors are months when data are not available.