Odpływ powierzchniowy

Projekt 4.

---

Biblioteki…

library(tidyverse)
library(readxl)
library(magrittr)
library(lubridate)
library(DT)
library(forecast)
library(ggplot2)
library(gridExtra)

---

Dane

Wczytano dane z monitoringu hydrologicznego (w formacie xls), zawierające dzienne odpływy jednostkowe od 1970 roku.

odplyw_jednostkowy <- read_excel("C:/Users/admin/Desktop/STUDIA/II semestr/NOZ/4/Odpłw/odpływ-jednostkowy.xlsx")

---

Rok hydrologiczny

Dodano kolumnę z rokiem hydrologicznym, który w Polsce zaczyna się 1 listopada poprzedniego roku kalendarzowego.

rok <- vector("character", length = nrow(odplyw_jednostkowy))

  for (i in 1:nrow(odplyw_jednostkowy)) {
  rok[i] <- if(month(odplyw_jednostkowy$data[i])==11||month(odplyw_jednostkowy$data[i])==12){
    print(year(odplyw_jednostkowy$data[i])+1)
  }else{
   print(year(odplyw_jednostkowy$data[i]))
  }
}

dane <- cbind(odplyw_jednostkowy, rok)

---

Niżówki

Następnie dodano także kolumnę z podziałem niżówek.

colnames(dane) <- c("data", "q", "rok")

jaki_typ <- function(k){
    if(k < 10 && k >= 5){
      print("zwykla")
    }else if(k < 5){
      print("gleboka")
    }else{
      print("BRAK")
    }
}

nizowki <- vector("character", nrow(dane))

for (j in 1:nrow(dane)) 
{
  nizowki[j] <- jaki_typ(dane$q[j])
}

dane <- cbind(dane, nizowki)

---

Rezultat w postaci przygotowanych do analizy danych przedstawia tabela poniżej.

a <- datatable(dane, caption = "Dane") 
a

---

Statystyki

summary(dane)

##       data                           q                rok       
##  Min.   :1970-11-01 00:00:00   Min.   :  0.002   1972   :  366  
##  1st Qu.:1982-10-31 18:00:00   1st Qu.:  2.850   1976   :  366  
##  Median :1994-10-31 12:00:00   Median :  5.984   1980   :  366  
##  Mean   :1994-10-31 12:00:00   Mean   :  9.503   1984   :  366  
##  3rd Qu.:2006-10-31 06:00:00   3rd Qu.: 11.089   1988   :  366  
##  Max.   :2018-10-31 00:00:00   Max.   :838.361   1992   :  366  
##                                                  (Other):15336  
##     nizowki    
##  BRAK   :5046  
##  gleboka:7464  
##  zwykla :5022  
##                
##                
##                
## 

---

Analiza

dane %>% 
  group_by(rok) %>%
  summarise(mean = mean(q)) -> d

colnames(d) <- c("rok", "srednia")

d$rok <- as.character(d$rok)

ggplot(d, aes(rok, srednia))+
  geom_point(size = 3, shape = 18, color = "#67d68e")+
  coord_flip()+
  theme_minimal()+
  labs(title = "Średnia odpływu jednostkowego")

---

Podział niżówek

W analizowanej zlewni niżówka zwykła występuje, gdy odpływ jednostkowy przyjmuje wartości mniejsze od 10, zaś głęboka - od 5.

g <- filter(dane, nizowki=="gleboka")
z <- filter(dane, nizowki=="zwykla")


n1 <- ggplot(g, aes(q))+
  geom_area(stat = "bin", color = "#fa954d", fill = "#fa954d")+
  labs(title = "Głębokie")

n2 <- ggplot(z, aes(q))+
  geom_area(stat = "bin", color = "#7ea1d9", fill = "#7ea1d9")+
  labs(title = "Zwykłe")

grid.arrange(n1, n2, ncol=2)

---

Częstotliwość występowania określonych niżowek…

  ggplot(dane, aes(q, fill = nizowki)) +
  geom_density(position = "stack", alpha = 0.8, color = "grey")+
  xlim(0,25)+
  theme_minimal()

---

Kryterium - miesiące

dane %>% select(q, data) %>%
  group_by(year(data), month(data)) %>%
  summarise(mean_q = mean(q, na.rm=TRUE)) -> q_mean

colnames(q_mean) <- c("rok", "miesiac", "srednia")

Poniższe wykresy przedstawiają średnią wartość odpływu jednostkowego dla każdego miesiąca na przestrzeni lat.

w1<-ggplot(styczen, aes(x=rok, y=srednia, color=styczen_t))+
  geom_point()+
  labs(title = "Styczeń", colour= "typ")
  
w2<-ggplot(luty, aes(x=rok, y=srednia, color=luty_t))+
  geom_point()+
  labs(title = "Luty", colour= "typ")

w3<-ggplot(marzec, aes(x=rok, y=srednia, color=marzec_t))+
  geom_point()+
  labs(title = "Marzec", colour= "typ")
  
w4<-ggplot(kwiecien, aes(x=rok, y=srednia, color=kwiecien_t))+
  geom_point()+
  labs(title = "Kwiecień", colour= "typ")

w5<-ggplot(maj, aes(x=rok, y=srednia, color=maj_t))+
  geom_point()+
  labs(title = "Maj", colour= "typ")
  
w6<-ggplot(czerwiec, aes(x=rok, y=srednia, color=czerwiec_t))+
  geom_point()+
  labs(title = "Czerwiec", colour= "typ")

w7<-ggplot(lipiec, aes(x=rok, y=srednia, color=lipiec_t))+
  geom_point()+
  labs(title = "Lipiec", colour= "typ")
  
w8<-ggplot(sierpien, aes(x=rok, y=srednia, color=sierpien_t))+
  geom_point()+
  labs(title = "Sierpień", colour= "typ")

w9<-ggplot(wrzesien, aes(x=rok, y=srednia, color=wrzesien_t))+
  geom_point()+
  labs(title = "Wrzesień", colour= "typ")
  
w10<-ggplot(pazdziernik, aes(x=rok, y=srednia, color=pazdziernik_t))+
  geom_point()+
  labs(title = "Październik", colour= "typ")

w11<-ggplot(listopad, aes(x=rok, y=srednia, color=listopad_t))+
  geom_point()+
  labs(title = "Listopad", colour= "typ")
  
w12<-ggplot(grudzien, aes(x=rok, y=srednia, color=grudzien_t))+
  geom_point()+
  labs(title = "Grudzień", colour= "typ")


grid.arrange(w1, w2, w3, w4) 

grid.arrange(w5, w6, w7, w8)

grid.arrange(w9, w10, w11, w12)

---

Średnie kroczące

Sporządzono trzy wykresy obrazujące średnie miesięczne wartości odpływu jednostkowego w badanym okresie oraz dodano kolorową linię trendu ze średnią kroczącą – 1-roczną, 5-letnią oraz 10-letnią.

ts <- ts(q_mean[3], frequency = 12, start = c(1970,11), end = c(2018,10))

plot.ts(ts, col="darkgray", main = "1-roczna średnia krocząca wartości odpływu jednostkowego", 
        xlab="Rok", ylab="Odpływ jednostkowy")
lines(ma(ts, order = 12), col = "#fa954d", lwd=3)
grid(col = "lightgray", lty = "dotted",
     lwd = par("lwd"), equilogs = TRUE)

plot.ts(ts, col="darkgray", main = "5-letnia średnia krocząca wartości odpływu jednostkowego",
        xlab="Rok", ylab="Odpływ jednostkowy")
lines(ma(ts, order = 60), col = "#7ea1d9", lwd=3)
grid(col = "lightgray", lty = "dotted",
     lwd = par("lwd"), equilogs = TRUE)

plot.ts(ts, col="darkgray", main = "10-letnia średnia krocząca wartości odpływu jednostkowego",
        xlab="Rok", ylab="Odpływ jednostkowy")
lines(ma(ts, order = 120), col = "#67d68e", lwd=3)
grid(col = "lightgray", lty = "dotted",
     lwd = par("lwd"), equilogs = TRUE)

---

q_mean %>% 
  group_by(miesiac) %>%
  summarise(mean = mean(srednia)) -> q_mean2 

barplot(height=q_mean2$mean, names=q_mean2$miesiac , density=c(5,10,20,30,7), angle=45, col="#fa954d", 
           xlab = "Miesiące", ylab = "Średni odpływ jednostkowy", main = "Średnia wartość odpływu jednostkowego z podziałem na miesiące") 

---

Kryterium - dekady

ggplot(dekady, aes(dekady, srednia))+
  geom_point(size = 7, shape = 18, color = "#7ea1d9")+
  labs(y="Średnia wartość odpływu jednostkowego", x = "Dekady")+
  theme_minimal()

---

ggplot(t1, aes(rok, q, color = nizowki))+
  geom_jitter()+
  scale_y_continuous(expand=c(0,0), limits = c(0,20))+
  labs(title = "1 dekada")+
  theme_minimal()+
  scale_color_brewer(palette = "Set2")-> k1

ggplot(t2, aes(rok, q, color = nizowki))+
  geom_jitter()+
  scale_y_continuous(expand=c(0,0), limits = c(0,20))+
  labs(title = "2 dekada")+
  theme_minimal()+
  scale_color_brewer(palette = "Set2")-> k2

ggplot(t3, aes(rok, q, color = nizowki))+
  geom_jitter()+
  scale_y_continuous(expand=c(0,0), limits = c(0,20))+
  labs(title = "3 dekada")+
  theme_minimal()+
  scale_color_brewer(palette = "Set2")-> k3

ggplot(t4, aes(rok, q, color = nizowki))+
  geom_jitter()+
  scale_y_continuous(expand=c(0,0), limits = c(0,20))+
  labs(title = "4 dekada")+
  theme_minimal()+
  scale_color_brewer(palette = "Set2")-> k4

ggplot(t5, aes(rok, q, color = nizowki))+
  geom_jitter()+
  scale_y_continuous(expand=c(0,0), limits = c(0,20))+
  labs(title = "5 dekada")+
  theme_minimal()+
  scale_color_brewer(palette = "Set2")-> k5


k1

k2 

k3 

k4

k5