Sutelktosios taršos poveikio vandens telkiniams apžvalga (papildyta)
Parengė vyr. specialistas Svajūnas Plungė
el. p. svajunas.plunge@aaa.am.lt
Hidrografinio tinklo skyrius, Aplinkos apsaugos agentūra
el. p. svajunas.plunge@aaa.am.lt
Hidrografinio tinklo skyrius, Aplinkos apsaugos agentūra
2020 Kovo 30 d.
Įvadas
Vandens telkinio būklę iš esmės nulemia jo baseine esantys taršos šaltiniai, kurie skirstomi į paskliduosius ir sutektuosius. Pasklidieji apima žemės ūkio veiklą, nesurenkamas lietaus nuotekas, atmosferinę taršos depoziciją. Sutelktoji paviršinio vandens tarša patenka iš miestų nuotekų valyklų, pramonės įmonių, žuvivaisos telkinių, lietaus nuotekų išleistuvų. Šiandien didžioji dalis vandens telkinių Lietuvoje kenčia nuo pasklidosios žemės ūkio taršos (apie žemės ūkio sukeliamą vandens taršą galima pasiskaityti Aplinkos apsaugos agentūros ataskaitoje apie žemės ūkio poveikį). Tačiau nors sutelktosios taršos šaltinių poveikis vandens telkiniams pastarąjį dešimtmetį atnaujinant nuotekų valyklas buvo sumažintas, jis visgi išliko svarbiu faktoriumi tam tikruose telkiniuose ir nulemia jų blogą būklę. Ypač mažesnėse upėse, kurių vandeningumas mažesnis, sutelktoji tarša turi įtakos tam, kad nėra pasiekiami vandensaugos tikslai. Sutelktosios taršos poveikio vandens telkiniams apžvalga yra skirta apžvelgti pokyčius, susijusius su sutelktosios vandens taršos poveikio pokyčiais Lietuvoje. Taip pat išskirti vandens telkinius, reikšmingai veikiamus sutelktųjų šaltinių, ir identifikuoti pačius šaltinius. Galiausiai svarbu palyginti analizės metu gautus rezultatus su rezultatais, pateiktais ankstesniuose Upių baseinų rajonų valdymo planuose, ir palyginti pokyčius, įvykusius išskirtuose vandens telkiniuose, kuriuose yra rizika laiku arba apskritai nepasiekti geros būklės (toliau - rizikos vandens telkiniuose) dėl reikšmingo sutelktosios taršos poveikio. Ši analizė reikalinga įvertinti, kurie vandens taršos šaltiniai yra svarbūs ir kokių priemonių reiktų imtis, kad pasiekti gerą vandens telkinių būklę.
Apžvalga pateikta interaktyvia forma, kuri sudaro galimybę lengviau ir greičiau surasti reikiamą informaciją. Be to ši forma leidžia pateikti ir daugiau informacijos, neišplečiant puslapių skaičiaus. Pati ataskaita paruošta naudojantis R Markdown technologija, o programinis kodas paruoštas R kalba. Ataskaitoje pateikiamas R kodas, naudotas sugeneruoti ataskaitos rezultatus, ir naudotų įvesties lentelių pavyzdžiai. Tikimės, kad leidinys bus naudingas norintiems susipažinti su sutelktosios vandens taršos aktualia informacija.
Darbo seka
Šioje ataskaitoje bei jos prieduose priede 1a, priede 1b, priede 1c, yra pateikiama informacija įvairiais pjūviais apie Lietuvos sutelktąją taršą ir sutelktosios taršos poveikį, jos pagrindinius šaltinius atskiriems vandens telkiniams. Ši medžiaga paruošta, kad būtų galima tiek apžvelgti bendrą Lietuvos situaciją. Taip pat, kad galima pasižiūrėti atskirų vandens telkinių problematiką įvertinant sutelktosios taršos poveikį kiekvienam telkiniui atskirai.
Darbas buvo atliktas sekančia seka:
- Pirmiausia buvo sukurta metodika nuotekų duomenų spagų užpildymui ir ja naudojantis užpildytos esamos duomenų spragos. Tai buvo labai svarbu, kad būtų galima atlikti analizes.
- Susiejant vandens tenkinių stebėsenos ir sutelktosios taršos vandens telkinių baseinuose duomenis buvo paruošta “krūvių plotui” metodika, kuri leido išskirti ypatingai stipriai sutelktosios taršos veikiamus vandens telkinius pagal į jų baseiną patenkančią apkrovą.
- Praplėsti “įtariamų” vandens telkinių sąrašą buvo paruošta “nuotekų koncentracijos” metodika. Ši metodika susiejo vandens kokybės stebėsenos duomenis ir nuotekų išleistuvų sukuriamą potencialią koncentraciją vandens telkiniuose (sutelktoji taršos apkrova padalinta upės vandens debitui).
- Apžvelgti sutelktųjų šaltinių apkrovų pokyčiai anksčiau išskirtuose rizikos vandens telkiniuose.
- Sudarytas bendras “įtariamų” vandens telkinių sąrašas išskirtų pagal “krūvio plotui”, “nuotekų koncentracijos” metodikas, ir išskirtų ankstesniame UBR planų ruošimo cikle. Sąrašas buvo papildytas ežerais ir tvenkiniais, kurie buvo atrinkti kaip galimai veikiami nuotekų šaltinių Aplinkos apsaugos agentūros atliktame “Žmogaus veiklos poveikio ežerų ir tvenkinių vandens kokybei preliminariame vertinime”. Kiekvienam šio sąrašo vandens telkiniui buvo paruošta detali stebėsenos rezultatų, šaltinių ir poveikio vertinimo medžiaga.
- Paruošta galutinio rizikos įvertinimo metodika, kuri panaudodama sugeneruotą detalią informaciją vandens telkiniams įvertino rizika dėl sutelktosios taršos ir suskirstė analizuotus telkinius į 4 grupes: rizikos, potencialios rizikos, mažai tikėtikos rizikos ir nerizikos.
- Galiausiai pateikti bendri įvertinimų rezultatai ir pateikti pagrindiniai nuotekų taršos šaltiniai išskirtiems rizikos vandens telkiniams bei darbo išvados.
1. Duomenų spragų užpildymas
Skaičiavimams buvo naudoti nuotekų išleidėjų pateikiami išleidimo į gamtinę aplinką duomenys, renkami Aplinkos apsaugos agentūroje. Surinkti duomenys apima laiko periodą nuo 1997 iki 2018 m. ir yra išsamus šaltinis apie sutelktąją paviršinio vandens taršą. Tačiau didelė dalis nuotekų išleidėjų, ypač ankstesniais metais, pateikė tik vieną ar kitą vandens telkinių būklei svarbų teršalų parametrą. Norint turėti kiek galima pilnesnes patenkančių teršalų apkrovas, duomenų spragos buvo užpildytos panaudojant nuotekų duomenų bazėje esančių panašiausių nuotekų išleidėjų išleidžiamų teršalų koncentracijų medianas. Žemiau esančioje lentelėje pateikiamas “žalių” duomenų pavyzdys.
library(tidyverse)
data <- read.csv("000_table.csv") %>% arrange(UNIPSCODE, Name)
glimpse(data[,c("UNIPSCODE", "Name", "BOD7", "NH4", "NO2", "NO3", "Ntot", "PO4", "Ptot", "SS")])## Observations: 34,951
## Variables: 10
## $ UNIPSCODE <fct> 1997_1.0, 1997_1.0, 1997_1.0, 1997_1.0, 1997_1.0, 19...
## $ Name <fct> "110012450 Akcine bendrove \"GRIGISKES\"", "11005384...
## $ BOD7 <dbl> 7.5900, 1.8400, 2.1505, 8.0155, 8.7400, 40.2500, NA,...
## $ NH4 <dbl> NA, 0.26, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ NO2 <dbl> NA, 0.009, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N...
## $ NO3 <dbl> NA, 1.32, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ Ntot <dbl> NA, 1.5, 1.8, NA, 13.1, 19.0, NA, 6.8, NA, 49.0, NA,...
## $ PO4 <dbl> NA, 0.02, NA, NA, NA, NA, NA, 0.80, NA, NA, NA, NA, ...
## $ Ptot <dbl> NA, 0.03, 0.00, NA, 0.37, 3.40, NA, NA, NA, 5.50, NA...
## $ SS <dbl> 13.10, 9.35, 7.12, 16.46, 17.40, 30.00, 14.50, 17.00...Žemiau esančiose keturiose lentelėse pateikiama, kaip pasikeitė trūkstamų parametrų skaičius po kiekvienos duomenų spragų užpildymo iteracijos. Tam, kad lengviau būtų suprantama lentelėse pateikta informacija, toliau pateikiamas pavyzdinis paaiškinimas, kaip buvo užpildytos duomenų spragos. Tas pats principas taikomas ir kitų vandens kokybės parametrų spragoms užpildyti.
Pirmoje lentelėje parodyta, kad “žaliuose” duomenyse 25652 eilutėse trūksta nitratų (lentelėje pažymėta NO3) parametrų verčių (viso duomenyse yra 34951 duomenų eilutės). Pirmoje iteracijoje duomenų sragos medianinėmis reikšmėmis buvo užpildytos panaudojant duomenis iš tokio paties tipo, tų pačių metų ir tos pačios klasės, pagal paskaičiuotą gyventojų ekvivalentą (GE_class), nuotekų išleistuvų. Tai leido sumažinti trūkstamų nitratų duomenų iki 12761 eilučių. Antroje iteracijoje likusios duomenų spragos buvo užpildytos medianinėmis reikšmėmis, panaudojant duomenis iš tokio paties tipo ir tų pačių metų nuotekų išleistuvų. Tai leido sumažinti trūkstamų nitratų duomenų eilučių iki 11577. Galiausiai paskutinėje iteracijoje likusios duomenų spragos buvo užpildytos medianinėmis reikšmėmis, panaudojant duomenis iš tokio paties tipo nuotekų išleistuvų, neišskiriant jų pagal metus ar gyventojų ekvivalento klases.
n_remove_few <- 12
param <- list('BOD7', 'NH4', 'NO2', 'NO3', 'Ntot', 'PO4', 'Ptot', 'SS')
data$X.1 <- NULL
data[,unlist(param)][data[,unlist(param)] == 0] <- NA
remove_col <- "mean"
leave_col <- "median"
####Creating lookup table#######
to_summary <- data %>%
select(-c(UNIPSCODE, PS_CODE, Name, Y, X, River, GE)) %>%
gather(Param, Value, -c(PTYPE,Year, Discharge, GE_class)) %>%
drop_na(Value) %>%
group_by(PTYPE, Year, GE_class, Param) %>%
summarise(mean = round(mean(Value), 3), median = round(median(Value), 3), n = n()) %>%
filter(n > n_remove_few)
to_summary_noGE <- data %>%
select(-c(UNIPSCODE, PS_CODE, Name, Y, X, River, GE, GE_class)) %>%
gather(Param, Value, -c(PTYPE,Year, Discharge)) %>%
drop_na(Value) %>%
group_by(PTYPE, Year, Param) %>%
summarise(mean = round(mean(Value), 3), median = round(median(Value), 3), n = n()) %>%
filter(n > n_remove_few)
to_summary_noGE_noYear <- data %>%
select(-c(UNIPSCODE, PS_CODE, Name, Y, X, River, GE, GE_class, Year)) %>%
gather(Param, Value, -c(PTYPE, Discharge)) %>%
drop_na(Value) %>%
group_by(PTYPE, Param) %>%
summarise(mean = round(mean(Value), 3), median = round(median(Value), 3), n = n()) %>%
filter(n > n_remove_few)
to_fill_na<- to_summary %>%
select(-c(remove_col, n)) %>%
spread(Param, leave_col)
to_fill_na_noGE <- to_summary_noGE %>%
select(-c(remove_col, n)) %>%
spread(Param, leave_col)
to_fill_na_noGE_noYear <- to_summary_noGE_noYear %>%
select(-c(remove_col, n)) %>%
spread(Param, leave_col)
remove_nas <- function(df, param){
for (i in param){
x <- paste(i, "x", sep=".")
y <- paste(i, "y", sep=".")
df[i] = df[x]
df[is.na(df[i]), i] = df[is.na(df[i]), y]
df[x] <- NULL
df[y] <- NULL
}
return(df)
}
count_nas <- function(df){
na_count <- sapply(df, function(y) sum(length(which(is.na(y)))))
na_count <- data.frame(na_count)
print (t(na_count))
}
count_nas(data)## UNIPSCODE PS_CODE Name Year Y X River PTYPE Discharge BOD7 NH4
## na_count 0 0 0 0 0 0 0 0 0 3800 24537
## NO2 NO3 Ntot PO4 Ptot SS GE GE_class
## na_count 24606 25652 20507 25037 20424 2798 7467 0data_na_filled <- merge(data, to_fill_na, by=c("PTYPE","Year", "GE_class"))
d <- remove_nas(data_na_filled, param)
count_nas(d)## PTYPE Year GE_class UNIPSCODE PS_CODE Name Y X River Discharge
## na_count 0 0 0 0 0 0 0 0 0 0
## GE BOD7 NH4 NO2 NO3 Ntot PO4 Ptot SS
## na_count 7465 0 12044 11520 12761 2499 13484 2509 5data_na_filled2 <- merge(d, to_fill_na_noGE, by=c("PTYPE","Year"))
d2 <- remove_nas(data_na_filled2, param)
count_nas(d2)## PTYPE Year GE_class UNIPSCODE PS_CODE Name Y X River Discharge
## na_count 0 0 0 0 0 0 0 0 0 0
## GE BOD7 NH4 NO2 NO3 Ntot PO4 Ptot SS
## na_count 7465 0 10913 10380 11577 2493 13396 2495 5data_na_filled3 <- merge(d2, to_fill_na_noGE_noYear, by=c("PTYPE"))
d3 <- remove_nas(data_na_filled3, param)
count_nas(d3)## PTYPE Year GE_class UNIPSCODE PS_CODE Name Y X River Discharge
## na_count 0 0 0 0 0 0 0 0 0 0
## GE BOD7 NH4 NO2 NO3 Ntot PO4 Ptot SS
## na_count 7465 0 0 0 0 0 0 0 0###Extra correction for the coordinates
##for Rokiskio suris
d3$X[d3$PS_CODE==1730004]=598422
d3$Y[d3$PS_CODE==1730004]=6201318
##for Siauliu WWTP
d3$X[d3$PS_CODE==1290001]=458007
d3$Y[d3$PS_CODE==1290001]=6205597
##for Ignalina nuclear plant
d3$X[d3$PS_CODE==1300004]=661048
d3$Y[d3$PS_CODE==1300004]=6166851Žemiau pateiktas lentelės fragmentas po duomenų užpildymo. Palyginus ją su “žalių” duomenų lentele, matoma, kad nebeliko tuščių (NA) verčių.
glimpse(d3[,c("UNIPSCODE", "Name", "BOD7", "NH4", "NO2", "NO3", "Ntot", "PO4", "Ptot", "SS")] %>% arrange(UNIPSCODE, Name))## Observations: 34,589
## Variables: 10
## $ UNIPSCODE <fct> 1997_1.0, 1997_1.0, 1997_1.0, 1997_1.0, 1997_1.0, 19...
## $ Name <fct> "110012450 Akcine bendrove \"GRIGISKES\"", "11005384...
## $ BOD7 <dbl> 7.5900, 1.8400, 2.1505, 8.0155, 8.7400, 40.2500, 9.2...
## $ NH4 <dbl> 2.50, 0.26, 2.50, 0.55, 3.18, 4.30, 0.55, 0.55, 0.55...
## $ NO2 <dbl> 0.064, 0.009, 0.064, 0.020, 0.088, 0.150, 0.020, 0.0...
## $ NO3 <dbl> 1.320, 1.320, 1.320, 0.741, 1.540, 3.600, 0.741, 0.7...
## $ Ntot <dbl> 7.3, 1.5, 1.8, 8.6, 13.1, 19.0, 8.6, 6.8, 8.6, 49.0,...
## $ PO4 <dbl> 0.580, 0.020, 0.580, 0.056, 1.000, 1.950, 0.056, 0.8...
## $ Ptot <dbl> 0.675, 0.030, 0.675, 0.667, 0.370, 3.400, 0.667, 0.6...
## $ SS <dbl> 13.10, 9.35, 7.12, 16.46, 17.40, 30.00, 14.50, 17.00...2. Taršos krūvių sąryšis su vandens kokybės monitoringo duomenimis
Aplinkos apsaugos agentūroje yra kaupiami nuotekų išleidėjų vandens taršos duomenys. Šiuos duomenis agregavus vandens telkinių baseinams, įmanoma įvertinti, ar sutelktosios taršos poveikis vandens telkiniui per metus padidėjo ar sumažėjo. Siekiant įvertinti minėtos taršos reikšmingumą ir atskirti sutelktosios vandens taršos reikšmingai veikiamus vandens telkinius, buvo sukurta “krūvio plotui” metodika, kuri atitinkamai leido įvertinti ar sutelktųjų šaltinių tarša vandens telkinyje daro reikšmingą poveikį vandens telkinio būklei.
Žemiau pateikiama įvesties duomenų struktūra. Pirmoje lentelėje pateikiami sutelktosios taršos suminiai krūvių duomenys, suskaičiuoti vandens kokybės monitoringo stočių baseinams. Su "_l" kodu yra bendras metinis krūvis kg, o "_l_a" pateikiami krūviai kg kvardatiniam baseino kilometrui. Antroje lentelėje pateikiami vandens kokybės monitoringo rezultatai.
##Paruošia reikalingas bibliotekas
library(ggplot2)
library(lubridate)
library(ggpmisc)
maps_to_show <- c(1, 2, 3, 5, 6, 7, 8)
##Paima nuotekų agregavimo monitoringo stotims ir vandens kokybės monitoringo duomenis
mst_wwtp_load <- read.csv("loads_for_mst_per_year.csv")[,-1]
mon_data <- read.table("WQObs.txt", header = TRUE, sep="\t", stringsAsFactors = FALSE,)[-1, ]
## "_l" kodas reiškia suminį krūvį, "_l_a" reiškia sumini krūvį ploto vienetui, t.y. kvadratiniam kilometrui
glimpse(mst_wwtp_load)## Observations: 13,833
## Variables: 21
## $ MST <fct> R1278, R297, R297, R297, R297, R297, R297, R297, R...
## $ AREA <dbl> 34.51415, 162.94043, 162.94043, 162.94043, 162.940...
## $ Year <int> 2005, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 20...
## $ Discharge <dbl> 2.0, 271.0, 426.0, 282.0, 274.0, 322.0, 322.0, 357...
## $ BOD7_l <dbl> 72.000, 1869.900, 3832.800, 3112.350, 3708.820, 40...
## $ NH4_l <dbl> 48.0000, 3035.2000, 3491.3250, 2579.2500, 3428.350...
## $ NO2_l <dbl> 0.07000, 48.78000, 77.25000, 42.62100, 46.33200, 3...
## $ NO3_l <dbl> 0.2800, 491.8650, 777.4200, 399.8410, 357.5000, 33...
## $ Ntot_l <dbl> 58.000, 2547.400, 3357.000, 1770.635, 3105.400, 19...
## $ PO4_l <dbl> 11.2000, 642.2700, 822.0300, 734.1560, 520.5920, 6...
## $ Ptot_l <dbl> 12.6000, 325.2000, 472.4550, 261.8670, 219.3690, 1...
## $ SS_l <dbl> 56.000, 1598.900, 12603.000, 3112.255, 35822.315, ...
## $ BOD7_l_a <dbl> 2.086, 11.476, 23.523, 19.101, 22.762, 24.939, 16....
## $ NH4_l_a <dbl> 1.391, 18.628, 21.427, 15.829, 21.041, 20.848, 19....
## $ NO2_l_a <dbl> 0.002, 0.299, 0.474, 0.262, 0.284, 0.205, 0.209, 0...
## $ NO3_l_a <dbl> 0.008, 3.019, 4.771, 2.454, 2.194, 2.085, 2.351, 3...
## $ Ntot_l_a <dbl> 1.680, 15.634, 20.603, 10.867, 19.058, 12.200, 11....
## $ PO4_l_a <dbl> 0.325, 3.942, 5.045, 4.506, 3.195, 3.988, 4.908, 5...
## $ Ptot_l_a <dbl> 0.365, 1.996, 2.900, 1.607, 1.346, 1.097, 2.247, 1...
## $ SS_l_a <dbl> 1.623, 9.813, 77.347, 19.101, 219.849, 62.180, 19....
## $ Discharge_a <dbl> 0.058, 1.663, 2.614, 1.731, 1.682, 1.976, 1.976, 2...glimpse(mon_data)## Observations: 26,792
## Variables: 15
## $ StationID <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2...
## $ Date <chr> "1996.01.09", "1996.02.12", "1996.03.05", "1996.04.0...
## $ Flow <chr> "100", "150", "121", "136", "421", "192", "176", "12...
## $ SS <chr> "6", "8", "16", "9", "31", "25", "28", "32", "29", "...
## $ DO <chr> "7.7", "7.6", "6.3", "7.9", "9.2", "11.7", "11", "10...
## $ BOD7 <chr> "3.8", "3.7", "3.9", "3.7", "5.4", "7", "6.8", "6.2"...
## $ NH4.N <chr> "0.14", "0.42", "0.42", "0.36", "0.48", "0.49", "0.4...
## $ NO2.N <chr> "0.013", "0.012", "0.018", "0.012", "0.009", "0.008"...
## $ NO3.N <chr> "0.2", "0.7", "1.5", "0.85", "1.2", "0.45", "0.55", ...
## $ N.mineral <chr> "0.353", "1.132", "1.938", "1.222", "1.689", "0.948"...
## $ N.total <chr> "", "1.7", "", "", "2", "", "1.7", "", "", "1.2", ""...
## $ PO4.P <chr> "0.048", "0.02", "0.07", "0.075", "0.04", "0.01", "0...
## $ P.total <chr> "", "0.04", "", "", "0.11", "", "0.07", "", "", "0.1...
## $ N.Org <chr> "", "0.568", "", "", "0.311", "", "0.662", "", "", "...
## $ P.Org <chr> "", "0.02", "", "", "0.07", "", "0.05", "", "", "0.0...Krūvio plotui metodika
Sutelktosios taršos reikšmingumo įvertinimo metodika apima šiuo žingsnius:
- Suskaičiuojama suminė metinė tarša (taršos apkrovos kg) iš sutelktųjų šaltinių vandens telkinio baseine.
- Metinės suminės sutelktosios taršos apkrovos perskaičiuojamos vandens telkinio baseino plotui (km2). Tai reikalinga siekiant nustatyti santykinį dydį, kurį naudojant būtų galima palyginti vandens telkinių taršos intensyvumą. Šiuo atveju baseino plotas yra grubi vandeningumo aproksimacija, nes didesnis baseino plotas yra tiesiogiai proporcingas surenkamam išnešamam baseino vandens kiekiui. Kadangi Lietuvoje klimatas, kritulių kiekis ir geologinė sandara yra santykinai homogeniški, tokia metodika yra galima, kitu atveju reikėtų suskaičiuoti taršos apkrovas vandens telkinių išnešamam vandens kiekiui. Ši metodika leidžia suskaičiuoti taršos kriterijus, kurie nepriklauso nuo metų vandeningumo ir kurie yra lengvai suskaičiuojami, bet kokiai upės ar upelio daliai. Žemiau pateiktas grafikas pateikia ryšį ir jo stiprumą tarp upių baseinų plotų ir debito.
- Suskaičiuojama tiesinė regresija apibūdinti ryšiui tarp suminių apkrovų plotui ir metinių koncentracijų vidurkių monitoringo stotyse. Labai žemos koncentracijos pašalinamos prieš vertinimą, nes jos nėra jautrios mažiems apkrovų pokyčiams.
- Pasinaudojant regresinėmis lygtimis buvo suskaičiuota maksimali galima apkrova baseino plotui, kuri dar nedarytų reikšmingo poveikio vandens telkiniui. Iš regresinių lygčių pagal atitinkamo vandens kokybės parametro aukščiausią geros būklės klasės intervalo koncentraciją išskaičiuota didžiausia suminė teršalų apkrova ploto vienetui, kuri dar reikšmingai nepablogintų vandens telkinio būklės (iki vidutinės būklės).
- Remiantis didžiausia apkrova ploto vienetui, buvo išskirti sutelktųjų taršos šaltinių galimai reikšmingai veikiami vandens telkiniai.
- Buvo įvertinta kaip kito tokių telkinių skaičius nuo pat 1997 m. iki 2018 m.
- Konkrečių potencialiai probleminių nuotekų išleistuvų identifikavimui panaudoti 2016-2018 m. duomenys. Interaktyviuose žemėlapiuose pateikti sutelktosios taršos potencialiai reikšmingai veikiami vandens telkiniai ir atitinkamai potencieliai reikšmingi sutelktosios taršos šaltiniai, kurių dalis bendroje vandens telkinio sutelktosios taršos apkrovoje yra didesnė nei 10 %.
AREA_YIELD<- read_csv("AREA_YIELD.csv")[,-1]
ggplot(AREA_YIELD, aes(x=AREA, y =YIELD_TOTAL))+geom_point()+
geom_smooth(method='lm', formula= y~x)+
stat_poly_eq(formula = y~x,
aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")),
parse = TRUE)+
labs(y="Sumodeliuotas debitas m3/s", x = "Baseino plotas km2")+
ggtitle("Vandens debito ir ploto ryšys", subtitle = "Ryšys tarp baseino ploto ir sumodeliuoto vandens debito vandens kokybės monitoringo vietose")+
labs(caption = "(Grafike pateikiami metiniai duomenys monitoringo stotims nuo 1997 iki 2018 m.)")+
theme_light()
Regresijų rezultatai
Vertinant regresijos rezultatus, aiškiai matoma, kad monitoringo rezultatų sąryšį su sutelktųjų šaltinių apkrovomis galima nustatyti BDS7, amonio azoto, nitritinio azoto, bendro azoto, fosfatinio fosforo ir bendro fosforo parametrams. Nitratinis azotas ir suspenduotos dalelės nekoreliuoja su išleidžiamų nuotekų apkrovomis. BDS7 ir fosfatinio fosforo koreliacija yra silpnesnė palyginti su kitais parametrais. Jų determinacijos koeficientas apie 0,35, o kitų parametrų determinacijos koeficientas yra virš 0,5, išskyrus bendrą azotą, kurio determinacijos koeficientas 0,66.
##Paruošia monitoringo duomenis
mon_data$Date <- ymd(mon_data$Date)
mon_data[,3:15] <- as.numeric(unlist(mon_data[,3:15]))
mon_data$StationID <- sub("^", "R", mon_data[grepl("^[0-9]", mon_data$StationID),"StationID"])
mon_data$Year <- lubridate::year(mon_data$Date)
mon_d <- mon_data %>%
select(-Date) %>%
group_by(StationID, Year) %>%
summarise_all(mean, na.rm = TRUE)
##Apjungia abi lenteles
mst_wwtp_load$MST <- as.character(mst_wwtp_load$MST)
mon_wwtpl <- mon_d%>% inner_join(mst_wwtp_load, by = c("StationID" = "MST", "Year" = "Year"))
##Pavadimų sąrašai iteracijai
conc_list <- c("BOD7", "NH4.N", "NO2.N", "NO3.N", "N.total", "PO4.P", "P.total", "SS")
load_list <- c("BOD7_l_a", "NH4_l_a", "NO2_l_a", "NO3_l_a", "Ntot_l_a", "PO4_l_a", "Ptot_l_a", "SS_l_a")
x_names <- c("BDS7 mgO2/l", "NH4 mgN/l", "NO2 mgN/l", "NO3 mgN/l",
"Bendras azotas mgN/l", "PO4 mgP/l", "Bendras fosforas mgP/l", "Suspenduotos medžiagos mg/l")
y_names0 <- c("BDS7", "NH4-N", "NO2-N", "NO3-N", "Bendras azotas", "PO4-P", "Bendras fosforas", "Suspenduotos medžiagos")
y_names <- paste0(y_names0, " krūvis kg vienam km2")
##Išfiltruoja metus ir minimaliai veikiamus vandens telkinius
mon_wwtpl_plot <- mon_wwtpl %>% filter(Year>=1997, Discharge_a >10)
##Sukuria reikiamus regresijų grafikus
for (i in 1:length(conc_list)){
if (conc_list[i]=="NH4.N"){
mon_wwtpl_plot2 <- mon_wwtpl_plot %>% filter(NH4.N > 0.1)
}else if(conc_list[i]=="PO4.P"){
mon_wwtpl_plot2 <- mon_wwtpl_plot %>% filter(PO4.P > 0.05)
}else if(conc_list[i]=="P.total"){
mon_wwtpl_plot2 <- mon_wwtpl_plot %>% filter(P.total > 0.15)
}else{
mon_wwtpl_plot2 <- mon_wwtpl_plot
}
gr <- ggplot(mon_wwtpl_plot2, aes_string(x= conc_list[i], y=load_list[i])) +
geom_point()+
geom_smooth(method='lm', formula= y~x)+
stat_poly_eq(formula = y ~ x,
aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")),
parse = TRUE)+
labs(y=y_names[i], x = x_names[i])+
ggtitle(y_names0[i], subtitle = "Ryšys tarp vandens kokybės monitoringo ir sutelktųjų šaltinių suminio krūvio")+
labs(caption = "(Grafike pateikiami metiniai duomenys monitoringo stotims nuo 1997 iki 2018 m.)")+
theme_light()
print(gr)
}
Išskaičiuoti kriterijai atskirti sutelktosios taršos veikiamus vandens telkinius
Regresijos lygtys buvo panaudotos išskaičiuoti kriterijus sutelktosios taršos reikšmingai veikiamiems vandens telkiniams identifikuoti. Žemiau esančiame lange pateikiamos minimalios sutelktųjų taršos šaltinių apkrovų reikšmės kada laikoma, kad vandens telkinys reiškingai yra veikiamas sutelktosios taršos.
####Suskaičiuoti atkirtimo ribas
BOD_tr <- -50.7 + 92.3 * 3.3
NH4_tr <- 149 + 89.1 * 0.2
Ntot_tr <- -120 + 126 * 3
PO4_tr <- 14.9 + 76 * 0.09
Ptot_tr <- 5.83 + 91.6 * 0.14
ltr <- c(BOD_tr, NH4_tr, Ntot_tr, PO4_tr, Ptot_tr)
ltr_names <- c(1, 2, 5, 6, 7)
for (i in 1:length(ltr_names)){
print (paste0(y_names0[ltr_names[i]], " atkirtimo riba ", ltr[i], " krūvis kg vienam km2"))
}## [1] "BDS7 atkirtimo riba 253.89 kruvis kg vienam km2"
## [1] "NH4-N atkirtimo riba 166.82 kruvis kg vienam km2"
## [1] "Bendras azotas atkirtimo riba 258 kruvis kg vienam km2"
## [1] "PO4-P atkirtimo riba 21.74 kruvis kg vienam km2"
## [1] "Bendras fosforas atkirtimo riba 18.654 kruvis kg vienam km2"Sutelktosios taršos veikiamų vandens telkinių skaičius pagal skirtingus kriterijus
Išskaičiuoti sutelktosios taršos reikšmingumo kriterijai buvo panaudoti įvertinti, kaip kito bendras poveikis vandens telkiniams pagal skirtingus parametrus. Žemiau pateiktame grafike galima matyti, kad nuotekų valyklų atnaujinimas turėjo gana reikšmingą poveikį mažinant rizikos vandens telkinių skaičių. Pagal BDS7 parametrą veikiamų vandens telkinių skaičius per 1997-2018 metų periodą sumažėjo nuo 19 iki 3. Pagal bendrą fosforą nuo 25 iki 8. Pagal fosfatų fosforą nuo vidutiniškai 30 periodo pradžioje iki 6. Tarša amonio azotu, nors ir nenuosekliai kisdama, sumažėjo daugiau nei du kartus, lyginant periodo pradžią ir pabaigą. Nuotekų valyklų atnaujinimas beveik nepaveikė tik bendro azoto reikšmingai paveiktų vandens telkinių skaičiaus. Pagal suminį įvertinimą reikšmingai paveiktų vandens telkinių skaičius sumažėjo perpus, lyginant pediodo pradžią ir pabaigą (1997-2002 m. vidutiniškai 34, o 2013-2018 m. vidutiniškai 17). Verta paminėti, kad amonio azoto ir fosfatinio fosforo grafikuose matomi staigūs pokyčiai iš esmės yra sąlygoti matuojamų parametrų trūkumu ir nepatikimomis vertėmis “žaliuose” duomenyse. Šiuo atveju duomenų spragų užpildymo algoritmas neleido ištaisyti duomenyse esančių problemų. Tačiau bendros tendencijos vis dėlto yra labai aiškios.
####Parenkame
loads <- read.csv("loads.csv")
loads$X <- NULL
####Neatitinkančių kriterijų vandens telkinių skaičius pagal skirtingus metus
changes_with_overlimit<- loads %>%
filter (Discharge_a > 10, Year >= 1996)%>%
mutate(BDS7 = ifelse(BOD7_l_a>BOD_tr, 1, 0),
`NH4-N` = ifelse(NH4_l_a>NH4_tr, 1, 0),
`Bendras azotas` = ifelse(Ntot_l_a>Ntot_tr, 1, 0),
`PO4-P` = ifelse(PO4_l_a>PO4_tr, 1, 0),
`Bendras fosforas` = ifelse(Ptot_l_a>Ptot_tr, 1, 0)) %>%
mutate(Suminis = ifelse (BDS7 == 1 | `NH4-N` == 1 | `Bendras azotas` == 1 | `PO4-P` == 1 | `Bendras fosforas` == 1, 1, 0)) %>%
filter(Suminis > 0) %>%
select(Year, BDS7, `NH4-N`, `Bendras azotas`, `PO4-P`, `Bendras fosforas`, Suminis) %>%
group_by(Year) %>%
summarise_all(sum) %>%
gather("Parameter", "WB_number", - Year)
###Grafiko generavimas
ggplot(changes_with_overlimit, aes(x=Year, y = WB_number))+
geom_line(color="blue", size=0.5)+
facet_wrap(~Parameter) +
labs(y="Vandens telkinių skaičius neatitinkantis kriterijų", x = "Metai")+
theme_light()
Vandens telkiniu, kuriems tenka galimai per dideles teršalu iš sutelktosios taršos šaltiniu apkrovos, skaicius.
Sutelktieji šaltiniai darantys reikšmingą poveikį vandens telkiniams
Šioje apžvalgoje pagal aukščiau pateiktą metodiką buvo ne tik įvertintas bendras sutelktosios taršos poveikio mastas, bet ir išskirti konkretūs nuotekų išleistuvai, darantys reikšmingą poveikį atskiriems vandens telkiniams. Kadangi tarp skirtingų metų tarša kinta, apžvalgoje atskirai pateikiami paskutiniejį trys metai (2016-2018 m.), kuriems apžvalgos rašymo metu yra surinkti duomenys. Šis skyrelis neskirtas pateikti, kurie nuotekų išleistuvai ar valyklos tiesiogiai atsakingi už vandens telkinių blogą būklę. Juo norima pateikti bendrą apžvalga, kuri būtų pagrindas detalesnei analizei, išsiaiškinant nuotekų išleistuvų tikrąjį poveikį ir kokių priemonių reikėtų imtis ar ne, norint pagerinti vandens telkinių būklę.
2016 m. reikšmingi sutelktieji šaltiniai
2016 m. kaip reikšmingai veikiančios vandens telkinius buvo įvertintos Elektrėnų, Akmenės, Rokiškio sūrio, Šiaulių, Rokiškio ir Radviliškio nuotekų valyklos. Kiti nuotekų išleistuvai nėra miestų ar pramonės nuotekų valymo įrenginiai. Tai arba žuvininkytės tvenkiniai, miestų lietaus nuotekų išleistuvai arba pramonės įmonių išleistuvai.
Žemiau esančios lentelės santrumpų reikšmės:
- VT kodas - Vandens telkinio kodas.
- VT tipas - Vandens telkinio tipas.
- NI kodas - Nuotekų išleistuvo kodas.
- Telkinio p. - Telkinio, į kurį išleidžiamos nuotekos, pavadinimas.
- GE - Gyventojų ekvivalentas suskaičiuotas nuotekų išleistuvui pagal Nuotekų reklamento metodiką.
- DCHpr - Procentinė dalis suminių nuotekų kiekio, kuri patenka į vandens telkinį iš pateikiamo nuotekų išleistuvo.
- BODpr - Procentinė dalis suminio BDS7 kiekio, kuris patenka į vandens telkinį iš pateikiamo nuotekų išleistuvo.
- NH4pr - Procentinė dalis suminio amonio azoto kiekio, kuris patenka į vandens telkinį iš pateikiamo nuotekų išleistuvo.
- NTpr - Procentinė dalis suminio bendro azoto kiekio, kuris patenka į vandens telkinį iš pateikiamo nuotekų išleistuvo.
- PO4pr - Procentinė dalis suminio fosfatinio fosforo kiekio, kuris patenka į vandens telkinį iš pateikiamo nuotekų išleistuvo.
- PTpr - Procentinė dalis suminio bendro fosforo kiekio, kuris patenka į vandens telkinį iš pateikiamo nuotekų išleistuvo.
Lentelėje procentinės dalies duomenys pateikiami tik parametrams, kurie peržengia aukščiau paskaičiuotus reikšmingos sutelktosios taršos kriterijus.
Kitoje lentelėje pateikta daugiau informacijos apie pačius nuotekų išleistuvus, t.y. nuotekų išleidėjo pavadinimas ir išleistuvo tipas.
###Pakrauname papildomas bibliotekas ir duomenis
library(DT)
report <- read.csv("WWTP_assessed.csv")[,-1]
report$GE[report$GE == 0] <- NA
wwtp_all <- read_csv("000_Summary.csv")[,-1] %>%
select(`Isleistuvo kodas`, Metai, `Nuoteku valymo budai`, `Papildomo valymo budai`) %>%
distinct()
#Sulietuvinu upių pavadinimus kur reikia
report$River <- gsub("Bezdone", "Bezdonė", report$River)
report$River <- gsub("Smeltale", "Smeltalė", report$River)
report$River <- gsub("Ganse", "Gansė", report$River)
report$River <- gsub("Kulpe", "Kulpė", report$River)
report$River <- gsub("Zizma", "Žižma", report$River)
report$River <- gsub("Varene", "Varėnė", report$River)
report$River <- gsub("Laukupe", "Laukupė", report$River)
report$River <- gsub("Obele", "Obelė", report$River)
report$River <- gsub("Svaige", "Svaigė", report$River)
report$River <- gsub("Tenze", "Tenžė", report$River)
report$River <- gsub("Svaige", "Svaigė", report$River)
#Sulietuvinu nuotekų išleistuvų pavadinimus kur reikia
report$Name <- gsub("Akcine", "Akcinė", report$Name)
report$Name <- gsub("akcine", "akcinė", report$Name)
report$Name <- gsub("bendrove", "bendrovė", report$Name)
report$Name <- gsub("Uzdaroji", "Uždaroji", report$Name)
report$Name <- gsub("Daugu zuvis", "Daugų žuvis", report$Name)
report$Name <- gsub("Silo Pavezupis", "Šilo Pavėžupis", report$Name)
report$Name <- gsub("Radviliskio", "Radviliškio", report$Name)
report$Name <- gsub("ROKISKIO SURIS", "ROKIŠKIO SŪRIS", report$Name)
report$Name <- gsub("Rokiskio", "Rokiškio", report$Name)
report$Name <- gsub("ELEKTRENU KOMUNALINIS UKIS", "ELEKTRĖNŲ KOMUNALINIS ŪKIS", report$Name)
report$Name <- gsub("savivaldybes", "savivaldybės", report$Name)
report$Name <- gsub("seniunija", "seniūnija", report$Name)
report$Name <- gsub("Akmenes", "Akmenės", report$Name)
report$Name <- gsub("Siauliu", "Šiaulių", report$Name)
report$Name <- gsub("TRAKU", "TRAKŲ", report$Name)
report$Name <- gsub("Pravieniskiu", "Pravieniškių", report$Name)
report$Name <- gsub("Telsiu", "Telšių", report$Name)
#Sulietuvinu išleistuvų tipus kur reikia
report$PTYPE <- gsub("kitokios paskirties (nurodyti)", "kitokios paskirties", report$PTYPE)
report$PTYPE <- gsub("miestu", "miestų", report$PTYPE)
report$PTYPE <- gsub("gyvenamuju", "gyvenamųjų", report$PTYPE)
report$PTYPE <- gsub("vietoviu", "vietovių", report$PTYPE)
report$PTYPE <- gsub("No info", "nėra informacijos", report$PTYPE)
report$PTYPE <- gsub("pavirsiniu", "paviršinių", report$PTYPE)
report$PTYPE <- gsub("pramones (gamybos ar kitu komerciniu) imoniu NVI, isskyrus", "pramonės (gamybos ar kitų komercinių) įmonių NVI, išskyrus", report$PTYPE)
r <- report %>% select(-c(Name, PTYPE, GE_class, X, Y, SUMtr)) %>%
rename(`VT kodas` = WB,
`VT tipas` = WB_TYPE,
`NI kodas` = PS_CODE,
`Telkinio p.` = River) %>%
mutate(`VT tipas` = ifelse(`VT tipas` == "R", "Upė", "Ežeras"))
r_names <- report %>% select(c(PS_CODE, Name, PTYPE, River, Year)) %>%
left_join(wwtp_all, by=c("PS_CODE"="Isleistuvo kodas", "Year"="Metai")) %>%
rename(`NI kodas` = PS_CODE,
`Isleidejo pav.` = Name,
`Isleistuvo tipas` = PTYPE,
`Nuoteku valymo budai` = `Nuoteku valymo budai`,
`Papildymo valymo budai` = `Papildomo valymo budai`,
`Telkinio p.` = River)
r_names[r_names=="nan"] <- "--"
##Funkcija lentelėms pateikti
create_dt <- function(x,y=""){
DT::datatable(x,
extensions = 'Buttons',
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff', 'font-size': '80%'});",
"}"),
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
lengthMenu = list(c(10,25,50,-1),
c(10,25,50,"All"))), caption = y, height = "100%")
}
table_pr <- function(year){
r201x <- r %>% filter (Year == year) %>% select(-Year)
create_dt(r201x)
}
table_names <- function(year){
r201x_names <- r_names %>% filter (Year == year) %>% select(-Year) %>% distinct()
create_dt(r201x_names)
}
table_pr(2016)table_names(2016)Žemiau esančiame žemėlapyje pateikiami išskirti 2016 m. reikšmingi nuotekų išleistuvai. Mėlyni burbuliukai pateikia tų išleistuvų lokaciją. Užėjus ant jų ir paspaudus, gaunama išsami informacija apie nuotekų išleistuvų poveikį. Žemėlapyje taip pat raudona linija pažymimi vandens telkiniai, kurie yra reikšmingai veikiami išskirtų nuotekų išleistuvų. Galiausiai žemėlapyje pateikiamos ir monitoringo stočių vietos, esančios veikiamose vandens telkiniuose. Jos pateikiamos oranžiniais ir žaliais apskritimais. Oranžiniais apskritimais žymimos monitoringo vietos, kuriose vandens telkinio būklė pagal analizuotus parametrus nėra gera, o žaliais tos vietos, kuriose būklė yra gera. Paspausdus ant apskritimo, gaunama informacija pagal kiekvieną vandens kokybės parametrą. Pateikiama vidutinė būklė 2014-2018 m. periodu.
library(leaflet)
library(sf)
# library(rstudioapi)
library(tidyverse)
library(readxl)
####Reading data
r_cood <- read.csv("WWTP_assessed.csv")[,-1] %>% select(PS_CODE, X, Y) %>% distinct()
wb_mon <- read.csv("WB_assessed_su_bukle.csv")[,-1]
rwb <- sf::st_read(dsn = "GISDATA.gdb", layer = "WB_line_150420", quiet = TRUE)
lwb <- sf::st_read(dsn = "GISDATA.gdb", layer = "WB_Lakes_150420", quiet = TRUE)
mon_st <- sf::st_read(dsn = "GISDATA.gdb", layer = "monitoringas_bendras_20150525", quiet = TRUE)
mon_st1 <- mon_st %>% select(NAME, MS_CD)
wb_st <- read_excel("upiu_telkiniu_bukle_atnaujinta.xlsx", sheet="upes_2014_2018_vidurkis") %>% select(st_kodas, vt_kodas, n_bendras, po4_p, p_bendras, bds7_bukle, p_b_bukle, p_po4_bukle, n_b_bukle, nh4_n_bukle, no3_n_bukle)
r0 <- r %>% left_join(r_cood, by = c("NI kodas"="PS_CODE")) %>% left_join(wb_st, by = c("VT kodas"="vt_kodas"))
# rwb_s <- st_simplify(rwb, preserveTopology = TRUE, dTolerance = 100)
# lwb_s <- st_simplify(lwb, preserveTopology = TRUE, dTolerance = 100)
# st_crs(rwb_s) = 3346
# st_crs(lwb_s) = 3346
st_crs(mon_st1) = 3346
r0.sf <- st_as_sf(r0, coords = c("X", "Y"), crs = 3346)
rwb_wgs <- st_transform(rwb, 4326)
rwb_wgs$WBriver_code <- sub("^", "LT", rwb_wgs$WBriver_code)
lwb_wgs <- st_transform(lwb, 4326)
r_wgs <- st_transform(r0.sf, 4326)
mon_st_wgs <- st_transform(mon_st1, 4326)
wb_mon1 <- wb_mon %>% mutate(bukle = ifelse((grepl("gera", bds7_bukle)|is.na(bds7_bukle))&
(grepl("gera", nh4_n_bukle)|is.na(nh4_n_bukle))&
(grepl("gera", n_b_bukle)|is.na(n_b_bukle))&
(grepl("gera", p_po4_bukle)|is.na(p_po4_bukle))&
(grepl("gera", p_b_bukle)|is.na(p_b_bukle)), "gera", "bloga")) %>%
mutate(bukle = ifelse((is.na(bds7_bukle)&
is.na(nh4_n_bukle)&
is.na(n_b_bukle)&
is.na(p_po4_bukle)&
is.na(p_b_bukle)), NA, bukle))
mon_st_wgs_map <- mon_st_wgs %>% inner_join(wb_mon1, by = c("MS_CD" = "st_kodas"))
pal <- colorFactor(c("darkorange2", "forestgreen"), domain = c("bloga", "gera"))
map <- function(year){
gc <- rwb_wgs %>%
leaflet() %>%
addTiles (group = "OSM (numatytas)")%>%
addProviderTiles(providers$CartoDB.Positron, group = "CartoDB") %>%
addProviderTiles(providers$Esri.WorldImagery, group = "ESRI ortofoto") %>%
# addPolylines(weight = 2, opacity = 0.5, label = ~paste("Vandens telkinio kodas", rwb_wgs$WBriver_code)) %>%
addLayersControl(
baseGroups = c("OSM (numatytas)", "CartoDB", "ESRI ortofoto"))
# gc <- gc %>% addPolygons(data = lwb_wgs, color = "blue", weight = 1, smoothFactor = 0.5, opacity = 1.0, fillOpacity = 0.5,
# label = ~paste("Vandens telkinio kodas", lwb_wgs$EU_CD))
r201x <- r_wgs %>% filter (Year == year) %>% select(-Year)
gc <- gc %>% addMarkers(data=r201x, popup = paste("NI kodas", r201x$`NI kodas`, "<br>",
"VT kodas:", r201x$`VT kodas`, "<br>",
"VT tipas:", r201x$`VT tipas`, "<br>",
"Telkinio p:", r201x$`Telkinio p`, "<br>",
"GE:", r201x$GE, "<br>",
"Nuotėkų kiekio dalis:", r201x$DCHpr, "<br>",
"BDS7 krūvio dalis:", r201x$BODpr, "<br>",
"NH4-N krūvio dalis:", r201x$NH4pr, "<br>",
"B. azoto krūvio dalis:", r201x$NTpr, "<br>",
"PO4-P krūvio dalis:", r201x$PO4pr, "<br>",
"B. fosforo krūvio dalis:", r201x$PTpr, "<br>",
"Mon. st.:", r201x$st_kodas, "<br>",
"BDS7 būklė:", r201x$bds7_bukle, "<br>",
"NH4-N būklė:", r201x$nh4_n_bukle, "<br>",
"B. azoto būklė:", r201x$n_b_bukle, "<br>",
"PO4-P būklė:", r201x$p_po4_bukle, "<br>",
"B. fosforo būklė:", r201x$p_b_bukle, "<br>"), label = ~paste("NI kodas", r201x$`NI kodas`))
r201x$geometry <- NULL
rwb_wgs201x <- rwb_wgs %>% right_join(filter(r201x, `VT tipas`=="Upė"), by = c("WBriver_code"="VT kodas")) %>% select(WBriver_code)
lwb_wgs201x <- lwb_wgs %>% right_join(filter(r201x, `VT tipas`=="Ežeras"), by = c("EU_CD"="VT kodas")) %>% select(EU_CD)
gc <- gc %>% addPolylines(data=rwb_wgs201x, weight = 3, opacity = 1, color ="red", label = ~paste("Vandens telkinio kodas",rwb_wgs201x$WBriver_code))
gc <- gc %>% addPolygons(data=lwb_wgs201x, weight = 2, smoothFactor = 0.5, opacity = 1, color ="red", label = ~paste("Vandens telkinio kodas", lwb_wgs201x$EU_CD))
mon_st_wgs_map201x <- mon_st_wgs_map %>% filter(Year==year)
gc <- gc %>% addCircleMarkers(data = mon_st_wgs_map201x, color = ~pal(bukle), stroke = FALSE, fillOpacity = 0.8, popup = paste("Mon. st. pavadinimas:", mon_st_wgs_map201x$NAME, "<br>",
"Mon. st. kodas:", mon_st_wgs_map201x$MS_CD, "<br>",
"VT kodas:", mon_st_wgs_map201x$WB, "<br>",
"VT tipas:", mon_st_wgs_map201x$WB_TYPE, "<br>",
"BDS7 būklė:", mon_st_wgs_map201x$bds7_bukle, "<br>",
"NH4-N būklė:", mon_st_wgs_map201x$nh4_n_bukle, "<br>",
"Nb būklė:", mon_st_wgs_map201x$n_b_bukle, "<br>",
"PO4-P būklė:", mon_st_wgs_map201x$p_po4_bukle, "<br>",
"Fb būklė:", mon_st_wgs_map201x$p_b_bukle, "<br>"), label = ~paste("Mon. stotis:", mon_st_wgs_map201x$NAME))
gc
}
if (1 %in% maps_to_show){
map(2016)
}2017 m. reikšmingi sutelktieji šaltiniai
Jei 2016 m. reikšmingų nuotekų valyklų išleistuvų sąrašą sudarė 6 išleistuvai, tai 2017 m. - 10. 2017 m. prie nuotekų valyklų išleistuvų, reikšmingai veikiančių vandens telkinių būklę, papildomai prisidėjo Kretingos, Telšių, Trakų ir Pravieniškių pataisos kolonijos nuotekų valyklų išleistuvai.
table_pr(2017)table_names(2017)if(2 %in% maps_to_show){
map(2017)
}2018 m. reikšmingi sutelktieji šaltiniai
2018 m. į reikšmingų nuotekų valyklų išleistuvų sąrašą nebepateko Pravieniškių ir Kretingos nuotekų valyklos. Šįkart šį sąrašą sudarė Telšių, Elektrėnų, Trakų, Akmenės, Rokiškio sūrio, Šiaulių, Rokiškio ir Radviliškio miestų nuotekų valyklos.
table_pr(2018)table_names(2018)if(3 %in% maps_to_show){
map(2018)
}3. Taršos koncentracijų sąryšis su vandens kokybės monitoringo duomenimis
Nors sutelktoji tarša ploto vienete buvo pasirinktas kaip pirmasis taršos kriterijus atskirti reiškingai sutelktosios taršos veikiamus vandens telkinius, taip pat buvo pabandyta įvertinti kitą galimą kriterijų. T.y. sutelktosios taršos suminis kiekis upės vandenyje išreikštas per sukuriamą koncentraciją (paskirstyta upės debitui) vandens telkinyje. Šis kriterijus panaudotas, kad kiek galima labiau (kiek tai yra prasminga) būtų praplėstas “įtariamųjų” vandens telkinių sąrašas vėlesniai detaliai analizei.
Nuotekų koncentracijos metodika
Išskirti reikšmingas sutelktųjų šaltinių sukuriamas taršos koncentracijas buvo panaudoti sumodeliuoti vandens debitai toms upių vietoms kur buvo atlikamas vandens kokybės monitoringas. Ten kur sumodeliuotas upės debitas nebuvo prieinamas buvo panaudota baseino ploto ir vandes debito sąryšio lygtis sugeneruota krūvio plotui metodikoje. Sumodeliuoti ar suskaičiuoti debitai buvo panaudoti paskaičiuoti tik sutelktųjų šaltinių sukuriamas koncentracijas vandens telkiniuose (pasitelkiant prielaidą, kad nėra taršos sulaikymo). Tuomet regresijomis buvo įvertintas sutelktųjų šaltinių sukuriamų koncentracijų ir vandens kokybės monitoringo vertinimo rezultatų ryšys. Parametrams, kuriems buvo pakankamai stipri koreliacija tarp monitoringo ir skaičiavimo rezultatų, buvo suformuoti kriterijai. Remiantys jais buvo atrinkti nuotekų išleistuvai.
Regresijų rezultatai ir suformuoti kriterijai
Žemiau esančiose regresijų grafikuose matome, kad tik amonio, fosfatų ir bendro fosforo parametrai stipriau koreliuoja su tarša atnešama iš sutelktųjų šaltinių. Jų determinacijos koeficientas yra apie 0,4. Labai silpnai koreliuoja bendras azotas ir BDS7, kiti parametrai neturi koreliacijos.
Q_CA_ID <- read_excel("aData3.xls", sheet = "a") %>% select(CATCHMENTID, Year, YIELD_TOTAL)
# riv_seg <- sf::st_read(dsn = "C:/Users/laptop/Dropbox/catchmentData.gdb", layer = "riverSegments", quiet = TRUE)
# mon <- sf::st_read(dsn = "C:/Users/laptop/Dropbox/Nuotekos UBRams/CALCULATION/Report R markdown/GISDATA.gdb", layer = "monitoringas_bendras_20150525", quiet = TRUE)
# mon_ca <- st_join(mon, riv_seg, join =st_is_within_distance, dist = 50)
# st_geometry(mon_ca) <- NULL
# mon_ca_j <- mon_ca %>% select(MS_CD, catchmentID)
# write.csv(mon_ca_j, "mon_ca_j.csv")
mon_ca_j <- read.csv("mon_ca_j.csv")[,-1]
mst_wwtp_load_add <- mst_wwtp_load %>% left_join(mon_ca_j, by = c("MST"="MS_CD")) %>% left_join(Q_CA_ID, by= c("catchmentID"="CATCHMENTID","Year")) %>% select(-load_list) %>%
mutate(yield1kcm = ((YIELD_TOTAL*60*60*24*365.25)/1000)) %>%
mutate(BOD7_l_q = BOD7_l/yield1kcm,
NH4_l_q = NH4_l/yield1kcm,
NO2_l_q= NO2_l/yield1kcm,
NO3_l_q = NO3_l/yield1kcm,
Ntot_l_q = Ntot_l/yield1kcm,
PO4_l_q = PO4_l/yield1kcm,
Ptot_l_q= Ptot_l/yield1kcm,
SS_l_q=SS_l/yield1kcm)
mon_wwtpl_add <- mon_d%>% inner_join(mst_wwtp_load_add, by = c("StationID" = "MST", "Year" = "Year"))
##Pavadimų sąrašai iteracijai
q_list <- c("BOD7_l_q", "NH4_l_q", "NO2_l_q", "NO3_l_q", "Ntot_l_q", "PO4_l_q", "Ptot_l_q", "SS_l_q")
y_names_q <- paste0(y_names0, " konc. iš nuotėkų")
##Išfiltruoja metus ir minimaliai veikiamus vandens telkinius
mon_wwtpl_add1 <- mon_wwtpl_add %>% filter(StationID != "R566",Year>=1997, Discharge_a >1)
##Sukuria reikiamus regresijų grafikus
for (i in 1:length(conc_list)){
if (conc_list[i]=="NH4.N"){
mon_wwtpl_add2 <- mon_wwtpl_add1 %>% filter(NH4_l_q > 0.01, NH4.N>0.2)
}else if(conc_list[i]=="BOD7"){
mon_wwtpl_add2 <- mon_wwtpl_add1 %>% filter(BOD7_l_q > 0.01, BOD7>3.3)
}else if(conc_list[i]=="N.total"){
mon_wwtpl_add2 <- mon_wwtpl_add1 %>% filter(Ntot_l_q > 0.01, N.total>3)
}else if(conc_list[i]=="PO4.P"){
mon_wwtpl_add2 <- mon_wwtpl_add1 %>% filter(PO4_l_q >0.01, PO4.P>0.09)
}else if(conc_list[i]=="P.total"){
mon_wwtpl_add2 <- mon_wwtpl_add1 %>% filter(Ptot_l_q>0.01, P.total>0.14)
}else if(conc_list[i]=="NO2.N"){
mon_wwtpl_add2 <- mon_wwtpl_add1 %>% filter(NO2_l_q>0.01)
}else if(conc_list[i]=="NO3.N"){
mon_wwtpl_add2 <- mon_wwtpl_add1 %>% filter(NO3_l_q>0.01)
}else if(conc_list[i]=="SS"){
mon_wwtpl_add2 <- mon_wwtpl_add1 %>% filter(SS_l_q>0.01)
}else{
mon_wwtpl_add2 <- mon_wwtpl_add1
}
gr <- ggplot(mon_wwtpl_add2, aes_string(x= conc_list[i], y=q_list[i])) +
geom_point()+
geom_smooth(method='lm', formula= y~x)+
stat_poly_eq(formula = y ~ x,
aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")),
parse = TRUE)+
labs(y=y_names_q[i], x = x_names[i])+
ggtitle(y_names0[i], subtitle = "Ryšys tarp vandens kokybės monitoringo ir sutelktųjų šaltinių suminio krūvio")+
labs(caption = "(Grafike pateikiami metiniai duomenys monitoringo stotims nuo 1997 iki 2018 m.)")+
theme_light()
print(gr)
}
Iš gautų regresinių lygčių buvo paskaičiuoti kriterijai atskirti sutelktosios taršos reikšmingai veikiamus vandens telkinius. Šie kriterijai buvo palyginti su geros būklės vandens telkinių koncentracijų ribomis. Žemiau gauti rezultatai rodo, kad tik amonio, fosfatų ir bendro fosforo parametrų kriterijai atskirti reiškmingai veikiamus telkinius turėtų prasmę. Nes kiti parametrai koreliuoja labai silpnai ir jų paskaičiuotos reikšmingos koncentracijos būtų labai žemos, palyginant su geros būklės koncentracija. Kas leidžia daryti prielaida, kad sutelktieji šaltiniai paprasčiausiai nėra taip svarbūs šiems parametrams. Kitais žodžiai mažos sutelktųjų šaltinių atnešamos koncentracijos (išskirtos kaip reiškingos) visiškai neturėtų įtakos vandens telkinio būklei, todėl prasmės taikyti jas jas nėra. Svarbūs kriterijai yra amonis, kuris turėtų sudaryti daugiau kaip 40% , fosfatų fosforas - 27%, o bendras fosforas - 20% geros būklės koncentracijos, kad vandens telkinys būtų pripažintas reiškingai veikiamas sutelktosios taršos. Šie kriterijai yra mažesni nei “geros” būklės koncentracijos, nes vandens telkiniuose tarša atiteka ir iš kitų šaltinių (pasklidųjų, tarptautinių, paviršinio vandens). Todėl reikšmingai neigiamai paveikti vandens telkinį, kad patektų į rizikos grupę, užtenka mažesnių koncentracijų.
####Suskaičiuoti atkirtimo ribas
good_wq <- c(3.3, 0.2, 3, 0.09, 0.14)
BOD_tr_q <- -0.157 + 0.097 * good_wq[1]
NH4_tr_q <- 0.0604 + 0.1 * good_wq[2]
Ntot_tr_q <- -0.00427 + 0.0528 * good_wq[3]
PO4_tr_q <- 0.0195 + 0.0552 * good_wq[4]
Ptot_tr_q <- 0.02 + 0.058 * good_wq[5]
ltr_q <- c(BOD_tr_q, NH4_tr_q, Ntot_tr_q, PO4_tr_q, Ptot_tr_q)
ltr_names_q <- c(1, 2, 5, 6, 7)
for (i in 1:length(ltr_names_q)){
print (paste0(y_names0[ltr_names_q[i]], " atkirtimo riba ", ltr_q[i], " koncentracija iš sutelktųjų šaltinių. Tai sudaro ", round((ltr_q[i]/good_wq[i])*100,1), "% geros vandens telkinių būklės koncentracijos"))
}## [1] "BDS7 atkirtimo riba 0.1631 koncentracija iš sutelktuju šaltiniu. Tai sudaro 4.9% geros vandens telkiniu bukles koncentracijos"
## [1] "NH4-N atkirtimo riba 0.0804 koncentracija iš sutelktuju šaltiniu. Tai sudaro 40.2% geros vandens telkiniu bukles koncentracijos"
## [1] "Bendras azotas atkirtimo riba 0.15413 koncentracija iš sutelktuju šaltiniu. Tai sudaro 5.1% geros vandens telkiniu bukles koncentracijos"
## [1] "PO4-P atkirtimo riba 0.024468 koncentracija iš sutelktuju šaltiniu. Tai sudaro 27.2% geros vandens telkiniu bukles koncentracijos"
## [1] "Bendras fosforas atkirtimo riba 0.02812 koncentracija iš sutelktuju šaltiniu. Tai sudaro 20.1% geros vandens telkiniu bukles koncentracijos"Atrinkti vandens telkiniai
Pagal krūvio plotui metodika buvo išskirti kaip reikšmingai veikiami 36 vandens telkiniai iš visų 1183. Vandens telkiniai buvo priskirti į “įtariamųjų” sąrašą, jei jie bent kartą viršijo pagal krūvio plotui metodika nustatytas ribas 2015-2018 m. periodu. Išskirti vandens telkiniai yra pateikti žemiau.
# library(sqldf)
# ##Pakraunami modeliavimo duomenys
# wb_q<- read_excel("WB_modelling_loads_all_years.xlsx", sheet = "all") %>% select(`WB code`, Year, `Ave. water flow m3/s`)
# wb_q$`WB code`<- sub("^", "LT", wb_q$`WB code`)
# ##Pakraunami monitoringo duomenys
# mon_eval<- read_excel("upiu_telkiniu_bukle_atnaujinta.xlsx", sheet = "upes_2014_2018_vidurkis") %>%
# select(vt_kodas, p_b_bukle, p_po4_bukle, nh4_n_bukle) %>%
# rename(`NH4-N` = nh4_n_bukle,
# `PO4-P` = p_po4_bukle,
# `B. fosforas` = p_b_bukle) %>%
# drop_na(vt_kodas)
#
# ##Pakraunami krūvių vandens telkiniams duomenys
# wb_wwtp_load <- read.csv("loads_for_wb_per_year.csv")[,-1]
# wb_wwtp_load$WLINE <- as.character(wb_wwtp_load$WLINE)
# wb_wwtp_load$WPOLIGON <- as.character(wb_wwtp_load$WPOLIGON)
#
# ##Atskiriami vandens telkiniai jau identifikuoti probleminiais
# WB_identified <- r %>% select(`VT kodas`) %>% distinct()
#
# ##Atskiriami nauji probleminiai vandens telkiniai
# wb_wwtp_load_clean <- wb_wwtp_load %>%
# mutate(`WB code`= ifelse(is.na(WLINE), 0, WLINE)) %>%
# left_join(wb_q, by = c("WB code", "Year")) %>%
# mutate(`Ave. water flow m3/s` = ifelse(is.na(`Ave. water flow m3/s`), 0.01576 * AREA, `Ave. water flow m3/s`)) %>%
# left_join(mon_eval, by = c("WB code"="vt_kodas")) %>%
# filter(Year>2014) %>%
# select(-c(BOD7_l, NO2_l, NO3_l, Ntot_l, SS_l)) %>%
# mutate(yield1kcm = ((`Ave. water flow m3/s`*60*60*24*365.25)/1000)) %>%
# mutate(NH4_l_q = NH4_l/yield1kcm,
# PO4_l_q = PO4_l/yield1kcm,
# Ptot_l_q = Ptot_l/yield1kcm) %>%
# filter((NH4_l_q > NH4_tr_q) |
# (PO4_l_q > PO4_tr_q)|
# (Ptot_l_q > Ptot_tr_q))
# # %>%
# # filter((NH4_l_q > NH4_tr_q & !grepl("gera", `NH4-N`))|
# # (PO4_l_q > PO4_tr_q & !grepl("gera", `PO4-P`))|
# # (Ptot_l_q > Ptot_tr_q & !grepl("gera", `B. fosforas`))) %>%
# # filter(!`WB code` %in% WB_identified$`VT kodas`)
# ##Pakraunami upių topografiniai ir modeliuojamu baseinų ir vandens telkinių sąryšio duomenys
# topo <- read.csv("river_network.csv")
# caid_wb <- read.csv("catch_id_wb.csv", sep=";", stringsAsFactors=FALSE)
# topo$edges <- gsub("\\[|\\]", "", topo$edges)
# ca_wb_topo <- caid_wb %>% left_join(topo, by = "ID")
# ####Sujungiamos lentelės WB, EDGES, WWTPs
# wb_id_tr <- sqldf("SELECT l.*, r.*
# FROM wb_wwtp_load_clean as l
# INNER JOIN ca_wb_topo as r
# on l.WLINE = r.WLINE OR l.WPOLIGON = r.WPOLIGON") %>%
# mutate(WB = ifelse(grepl('^LT', WLINE), WLINE, WPOLIGON),
# WB_TYPE = ifelse(grepl('^LT', WLINE), "R", "L")) %>%
# select(-c(starts_with('WLINE'), starts_with('WPOLIGON'), starts_with('AREA..')))
# ###Pakraunami papildomi duomenys
# ca <- sf::st_read(dsn = "C:/Users/laptop/Dropbox/Nuotekos UBRams/CALCULATION/PS_DATA.gdb", layer = "catchments", quiet = TRUE)
# data <- read.csv("filled_data.csv", stringsAsFactors=FALSE)[,-1]
# param0 <- c('BOD7', 'NH4', 'NO2', 'NO3', 'Ntot', 'PO4', 'Ptot', 'SS')
# ##Suskaičiuojamas išleistuvų krūvis
# for (i in param0){
# l <- paste(i, "l", sep="_")
# data[l] = data[i]*data["Discharge"]
# }
# ##Priskiriamas baseinėlio kodas nuotėkų išleistuvui
# ca[ ,c("group_id", "river", "lake", "wline", "wpolygon", "RBDID", "RBID", "SUbunit", "Shape_Length", "Shape_Area")] <- list(NULL)
# data$GE_class <- as.factor(data$GE_class)
# data <- data %>%
# group_by(PTYPE, UNIPSCODE, PS_CODE, Name, Year, River, X, Y) %>%
# summarise_all(funs(if(is.numeric(.)) sum(., na.rm = TRUE) else first(.))) %>%
# ungroup()
# data.sf <- st_as_sf(data, coords = c("X", "Y"), crs = 3346)
# d_with_cid<- st_join(data.sf, ca)
# df <- d_with_cid[, !colnames(d_with_cid) %in% param0]
# df$geometry <- NULL
# ##Atrenkami išleistuvai darantys poveikį išskirtiems vandens telkiniams
# wb_tr_wwtp = data.frame()
# for (wb in unique(wb_id_tr$WB)){
# wb_edges_list <- wb_id_tr$edges[wb_id_tr$WB == wb]
# wb_edges_vector <- as.numeric(unlist(str_extract_all(wb_edges_list, "[\\.0-9e-]+")))
# d1 <- df %>% select(-UNIPSCODE) %>%
# filter(Year %in% unique(wb_id_tr$Year)) %>%
# filter(ID %in% wb_edges_vector)
# d1$WB = wb
# wb_tr_wwtp <- bind_rows(wb_tr_wwtp, d1)
# }
# ##Paruošiami skaičiai kokią dalį taršos kiekvienas išleistuvas išleidžia
# WB_table_assess <- wb_id_tr %>%
# select(-edges) %>%
# full_join(wb_tr_wwtp, by = c("WB", "Year"), suffix = c(".WB", ".WWTP")) %>%
# mutate(DCHpr = round((Discharge.WWTP/Discharge.WB)*100, 2),
# NH4pr = round((NH4_l.WWTP/NH4_l.WB)*100, 2),
# PO4pr = round((PO4_l.WWTP/PO4_l.WB)*100, 2),
# PTpr = round((Ptot_l.WWTP/Ptot_l.WB)*100, 2))
# WB_table_assess_report <- WB_table_assess %>%
# select(c(WB, WB_TYPE, PS_CODE, Name, PTYPE, River, GE, GE_class, Year, DCHpr, NH4pr, PO4pr, PTpr)) %>%
# filter(DCHpr>=10) %>%
# arrange(desc(WB_TYPE,WB,DCHpr))
# XY <- data %>% select(X, Y, Year, PS_CODE, River)
# WB_table_assess_coord <- WB_table_assess_report %>%
# left_join(XY, by = c("Year", "PS_CODE", "River"))
# ##Išsaugomi rezultatai
# write.csv(WB_table_assess_coord, "WWTP_assessed2.csv")
# wb_status2 <- read_excel("upiu_telkiniu_bukle_atnaujinta.xlsx", sheet="upes_2014_2018_vidurkis")
# WB_table_assess_coord_status <- WB_table_assess_coord %>% left_join(wb_status2, by = c("WB"="vt_kodas")) %>%
# select(-c(pavadinimas, o2, bds7, nh4_n, no3_n, n_bendras, po4_p, p_bendras))
#
# write.csv(WB_table_assess_coord_status, "WWTP_assessed_su_bukle2.csv")
##"WWTP_assessed_su_bukle_all.csv" išsaugoti visi vandens telkiniai (ir pasikartojanty su pirma metodika)
##write.csv(WB_table_assess_coord_status, "WWTP_assessed_su_bukle_all.csv")
report2 <- read.csv("WWTP_assessed2.csv")[,-1] %>% distinct()
#Sulietuvinu upių pavadinimus kur reikia
report2$River <- gsub("ez", "ež", report2$River)
report2$River <- gsub("Svaige", "Svaigė", report2$River)
report2$River <- gsub("Dovine", "Dovinė", report2$River)
report2$River <- gsub("Rase", "Rasė", report2$River)
report2$River <- gsub("Mera - Kuna", "Mera - Kuna", report2$River)
report2$River <- gsub("Jure", "Jūrė", report2$River)
report2$River <- gsub("Varene", "Varenė", report2$River)
report2$River <- gsub("Obele", "Obelė", report2$River)
report2$River <- gsub("Ganse", "Gansė", report2$River)
report2$River <- gsub("Sesuvis", "Šešuvis", report2$River)
report2$River <- gsub("Kulpe", "Kulpė", report2$River)
report2$River <- gsub("Svaige", "Svaigė", report2$River)
report2$River <- gsub("Kirsinas", "Kiršinas", report2$River)
report2$River <- gsub("Zizma", "Žižma", report2$River)
report2$River <- gsub("Vijole", "Vijolė", report2$River)
#Sulietuvinu nuotekų išleistuvų pavadinimus kur reikia
report2$Name <- gsub("Akcine", "Akcinė", report2$Name)
report2$Name <- gsub("akcine", "akcinė", report2$Name)
report2$Name <- gsub("AKCINE", "AKCINĖ", report2$Name)
report2$Name <- gsub("bendrove", "bendrovė", report2$Name)
report2$Name <- gsub("BENDROVE", "BENDROVĖ", report2$Name)
report2$Name <- gsub("Uzdaroji", "Uždaroji", report2$Name)
report2$Name <- gsub("UZDAROJI", "UŽDAROJI", report2$Name)
report2$Name <- gsub("Daugu zuvis", "Daugų žuvis", report2$Name)
report2$Name <- gsub("Radviliskio", "Radviliškio", report2$Name)
report2$Name <- gsub("SVENTJONIS", "ŠVENTJONIS", report2$Name)
report2$Name <- gsub("Silo Pavezupis", "Šilo Pavėžupis", report2$Name)
report2$Name <- gsub("ARMOLE", "ARMOLĖ", report2$Name)
report2$Name <- gsub("Telsiu", "Telšių", report2$Name)
report2$Name <- gsub("Zuvininkystes tarnyba prie Lietuvos Respublikos zemes ukio ministerijos", "Žuvininkystės tarnyba prie Lietuvos Respublikos žemės ūkio ministerijos", report2$Name)
report2$Name <- gsub("Joniskio", "Joniškio", report2$Name)
report2$Name <- gsub("Sakiu", "Šakių", report2$Name)
report2$Name <- gsub("Kazlu", "Kazlų", report2$Name)
report2$Name <- gsub("Kursenu", "Kuršėnų", report2$Name)
report2$Name <- gsub("Nemezio", "Nemėžio", report2$Name)
report2$Name <- gsub("Siauliu", "Šiaulių", report2$Name)
report2$Name <- gsub("Raseiniu", "Raseinių", report2$Name)
report2$Name <- gsub("zuvininkyste", "žuvininkystė", report2$Name)
#Sulietuvinu išleistuvų tipus kur reikia
report2$PTYPE <- gsub("kitokios paskirties (nurodyti)", "kitokios paskirties", report2$PTYPE)
report2$PTYPE <- gsub("miestu", "miestų", report2$PTYPE)
report2$PTYPE <- gsub("gyvenamuju", "gyvenamųjų", report2$PTYPE)
report2$PTYPE <- gsub("vietoviu", "vietovių", report2$PTYPE)
report2$PTYPE <- gsub("No info", "nėra informacijos", report2$PTYPE)
report2$PTYPE <- gsub("pavirsiniu", "paviršinių", report2$PTYPE)
report2$PTYPE <- gsub("pramones (gamybos ar kitu komerciniu) imoniu NVI, isskyrus", "pramonės (gamybos ar kitų komercinių) įmonių NVI, išskyrus", report2$PTYPE)
wb_mon2 <- read.csv("WWTP_assessed_su_bukle2.csv")[,-1] %>% select(WB, WB_TYPE, st_kodas, bds7_bukle, nh4_n_bukle, n_b_bukle, p_po4_bukle, p_b_bukle, Year)
report2$GE[report2$GE == 0] <- NA
r2 <- report2 %>% select(-c(Name, PTYPE, GE_class, X, Y)) %>%
rename(`VT kodas` = WB,
`VT tipas` = WB_TYPE,
`NI kodas` = PS_CODE,
`Telkinio p.` = River) %>%
mutate(`VT tipas` = ifelse(`VT tipas` == "R", "Upė", "Ežeras"))
r_names2 <- report2 %>% select(c(PS_CODE, Name, PTYPE, River, Year)) %>%
left_join(wwtp_all, by=c("PS_CODE"="Isleistuvo kodas", "Year"="Metai")) %>%
rename(`NI kodas` = PS_CODE,
`Isleidejo pav.` = Name,
`Isleistuvo tipas` = PTYPE,
`Nuoteku valymo budai` = `Nuoteku valymo budai`,
`Papildymo valymo budai` = `Papildomo valymo budai`,
`Telkinio p.` = River)
r_names2[r_names2=="nan"] <- "--"
table_pr2 <- function(year){
r201x <- r2 %>% filter (Year == year) %>% select(-Year)
create_dt(r201x)
}
table_names2 <- function(year){
r201x_names <- r_names2 %>% filter (Year == year) %>% select(-Year) %>% distinct()
create_dt(r201x_names)
}
##Sudaro upių vandens telkinių sąrašą (kodas ir pavadinimas).
rwb_n <- rwb %>% select(WBriver_code, upes_pavadinimas)
st_geometry(rwb_n) <- NULL
rwb_n$WBriver_code <- sub("^", "LT", rwb_n$WBriver_code)
rwb_n <- rwb_n %>% distinct() %>% rename(CD = WBriver_code,
VT_VARDAS = upes_pavadinimas) %>% filter(!VT_VARDAS %in% c("LT9999", "LT9998"))
rwb_n$CD <- as.character(rwb_n$CD)
rwb_n$VT_VARDAS<- as.character(rwb_n$VT_VARDAS)
##Sudaro ežerų vandens telkinių sąrašą (kodas ir pavadinimas).
lwb_n <- lwb %>% select(EU_CD, NAME_LT)
st_geometry(lwb_n) <- NULL
lwb_n<- lwb_n %>% distinct() %>% rename(CD = EU_CD,
VT_VARDAS = NAME_LT)
lwb_n$CD <- as.character(lwb_n$CD)
lwb_n$VT_VARDAS<- as.character(lwb_n$VT_VARDAS)
##Bendras sąrašas
wb_names <- bind_rows(rwb_n, lwb_n)
rwb_n1 <- rwb_n %>% mutate(TIPAS = "U")
lwb_n1 <- lwb_n %>% mutate(TIPAS = "E")
wb_names_type <- bind_rows(rwb_n1, lwb_n1)
wb_names_r <- r %>% select(`VT kodas`, `VT tipas`) %>% distinct() %>% left_join(wb_names, by =c("VT kodas"="CD")) %>% arrange(desc(`VT tipas`), VT_VARDAS)
wb_names_r2 <- r2 %>% select(`VT kodas`, `VT tipas`) %>% distinct() %>% left_join(wb_names, by =c("VT kodas"="CD")) %>% arrange(VT_VARDAS)
wb_names_r ## VT kodas VT tipas VT_VARDAS
## 1 LT300111811 Upe Agluona
## 2 LT120106701 Upe Aliosa
## 3 LT120102901 Upe Bezdone
## 4 LT110104311 Upe Dusmena
## 5 LT300101302 Upe Ganse
## 6 LT122102123 Upe Indraja
## 7 LT410102102 Upe Kulpe
## 8 LT410102103 Upe Kulpe
## 9 LT410102104 Upe Kulpe
## 10 LT420100502 Upe Laukupe
## 11 LT120105901 Upe Moluvenu upelis
## 12 LT420100012 Upe Nemunelis
## 13 LT420100013 Upe Nemunelis
## 14 LT150104103 Upe Pilve
## 15 LT150104104 Upe Pilve
## 16 LT100114372 Upe Praviena
## 17 LT200103101 Upe Smeltale
## 18 LT200103102 Upe Smeltale
## 19 LT121103362 Upe Spengla
## 20 LT121103361 Upe Spengla
## 21 LT300113264 Upe Sruoja
## 22 LT300108321 Upe Tausalas
## 23 LT200105802 Upe Tenže
## 24 LT120102921 Upe Trinkulis
## 25 LT160107712 Upe Upe
## 26 LT300113103 Upe Varduva
## 27 LT300113104 Upe Varduva
## 28 LT110104202 Upe Varene
## 29 LT140200011 Upe Ventos perkasas
## 30 LT120104201 Upe Vilnia
## 31 LT120104202 Upe Vilnia
## 32 LT110104251 Upe Žižma
## 33 LT112030205 Ežeras Didžiulis
## 34 LT230050271 Ežeras Kivyliu tvenkinys
## 35 LT341050062 Ežeras Petraiciu
## 36 LT112140430 Ežeras SpenglasNuotekų koncentracijų metodika leido išskirti 123 vandens telkinius, kurie gali būti reikšmingai veikiami sutelktosios vandens taršos. Šie vandens telkiniai buvo priskirti į “įtariamųjų” sąrašą taip pat, jei jie bent kartą viršijo pagal nuotekų koncentracijos metodikos nustatytas ribas 2015-2018 m. periodu. Išskirti vandens telkiniai yra pateikiami žemiau.
wb_names_r2## VT kodas VT tipas VT_VARDAS
## 1 LT300111811 Upe Agluona
## 2 LT200104103 Upe Akmena - Dane
## 3 LT120106701 Upe Aliosa
## 4 LT122101133 Upe Audra
## 5 LT400101941 Upe Audruve
## 6 LT130109401 Upe Barupe
## 7 LT120102901 Upe Bezdone
## 8 LT113050171 Ežeras Bubliu tvenkinys
## 9 LT300106103 Upe Dabikine
## 10 LT300106102 Upe Dabikine
## 11 LT410105104 Upe Daugyvene
## 12 LT410105102 Upe Daugyvene
## 13 LT110104701 Upe Derežnycia
## 14 LT112030205 Ežeras Didžiulis
## 15 LT150101901 Upe Dovine
## 16 LT121103201 Upe Dubinga
## 17 LT140100012 Upe Dubysa
## 18 LT110104311 Upe Dusmena
## 19 LT410105393 Upe Ežerele
## 20 LT300101302 Upe Ganse
## 21 LT122102123 Upe Indraja
## 22 LT130107481 Upe Jaugila
## 23 LT100115103 Upe Jiesia
## 24 LT100115104 Upe Jiesia
## 25 LT100115102 Upe Jiesia
## 26 LT170108521 Upe Judre
## 27 LT230050282 Ežeras Juodeikiu tvenkinys
## 28 LT410112631 Upe Juodupe
## 29 LT150104663 Upe Jure
## 30 LT120104291 Upe Kena
## 31 LT230050271 Ežeras Kivyliu tvenkinys
## 32 LT410104303 Upe Kruoja
## 33 LT410102102 Upe Kulpe
## 34 LT410102103 Upe Kulpe
## 35 LT410102104 Upe Kulpe
## 36 LT420100502 Upe Laukupe
## 37 LT120108702 Upe Laukysta
## 38 LT120109402 Upe Lomena
## 39 LT110101401 Upe Lukna
## 40 LT121102802 Upe Mera - Kuna
## 41 LT121102803 Upe Mera - Kuna
## 42 LT121102804 Upe Mera - Kuna
## 43 LT120105901 Upe Moluvenu upelis
## 44 LT410100014 Upe Muša
## 45 LT410100013 Upe Muša
## 46 LT120105221 Upe Nemeža
## 47 LT420100012 Upe Nemunelis
## 48 LT420100013 Upe Nemunelis
## 49 LT120100012 Upe Neris
## 50 LT120100013 Upe Neris
## 51 LT130100015 Upe Nevežis
## 52 LT410105191 Upe Niauduva
## 53 LT410104443 Upe Obele
## 54 LT130107703 Upe Obelis
## 55 LT110050351 Ežeras Pajiesio tvenkinys
## 56 LT112030180 Ežeras Papis
## 57 LT112230020 Ežeras Paštys
## 58 LT300108253 Upe Patekla
## 59 LT300108251 Upe Patekla
## 60 LT341050062 Ežeras Petraiciu
## 61 LT150104103 Upe Pilve
## 62 LT150104104 Upe Pilve
## 63 LT300106651 Upe Pragalvys
## 64 LT100114372 Upe Praviena
## 65 LT112230018 Ežeras Rašai
## 66 LT122103262 Upe Raše
## 67 LT120105182 Upe Rudamina
## 68 LT121100381 Upe Rudine
## 69 LT230050140 Ežeras Sablauskiu tvenkinys
## 70 LT160108292 Upe Šaltuona
## 71 LT160108293 Upe Šaltuona
## 72 LT160108291 Upe Šaltuona
## 73 LT112230017 Ežeras Sartai
## 74 LT150100014 Upe Šešupe
## 75 LT150100015 Upe Šešupe
## 76 LT150100016 Upe Šešupe
## 77 LT160107302 Upe Šešuvis
## 78 LT160107303 Upe Šešuvis
## 79 LT400102691 Upe Sidabra
## 80 LT150107201 Upe Siesartis
## 81 LT115040124 Ežeras Simno ežeras
## 82 LT100700021 Upe Skirvyte
## 83 LT160108462 Upe Šlyna
## 84 LT500102741 Upe Smalva
## 85 LT550030107 Ežeras Smalvas
## 86 LT200103101 Upe Smeltale
## 87 LT200103102 Upe Smeltale
## 88 LT300102102 Upe Šona
## 89 LT121103362 Upe Spengla
## 90 LT121103361 Upe Spengla
## 91 LT112140430 Ežeras Spenglas
## 92 LT300113264 Upe Sruoja
## 93 LT100113703 Upe Streva
## 94 LT100113704 Upe Streva
## 95 LT100113705 Upe Streva
## 96 LT122100015 Upe Šventoji
## 97 LT122100017 Upe Šventoji
## 98 LT122100016 Upe Šventoji
## 99 LT300108321 Upe Tausalas
## 100 LT200105802 Upe Tenže
## 101 LT120102921 Upe Trinkulis
## 102 LT160107712 Upe Upe
## 103 LT300111702 Upe Vadakstis
## 104 LT300113103 Upe Varduva
## 105 LT300113104 Upe Varduva
## 106 LT300113105 Upe Varduva
## 107 LT110104201 Upe Varene
## 108 LT110104203 Upe Varene
## 109 LT110104202 Upe Varene
## 110 LT300100015 Upe Venta
## 111 LT300100018 Upe Venta
## 112 LT300100017 Upe Venta
## 113 LT300100016 Upe Venta
## 114 LT300100014 Upe Venta
## 115 LT140200011 Upe Ventos perkasas
## 116 LT110103201 Upe Verseka
## 117 LT410102121 Upe Vijole
## 118 LT120104201 Upe Vilnia
## 119 LT120104202 Upe Vilnia
## 120 LT122103102 Upe Vyžuona
## 121 LT122103101 Upe Vyžuona
## 122 LT110104251 Upe Žižma
## 123 LT110101442 Upe Žvirgžder0 <- report2 %>% select(-c(Name, PTYPE, GE_class)) %>%
rename(`VT kodas` = WB,
`VT tipas` = WB_TYPE,
`NI kodas` = PS_CODE,
`Telkinio p.` = River) %>%
mutate(`VT tipas` = ifelse(`VT tipas` == "R", "Upė", "Ežeras")) %>%
left_join(wb_st, by = c("VT kodas"="vt_kodas")) %>%
select(-c(n_bendras, po4_p, p_bendras))
r0.sf <- st_as_sf(r0, coords = c("X", "Y"), crs = 3346)
lwb_wgs <- st_transform(lwb, 4326)
r_wgs <- st_transform(r0.sf, 4326)
wb_mon1 <- wb_mon2 %>% mutate(bukle = ifelse((grepl("gera", bds7_bukle)|is.na(bds7_bukle))&
(grepl("gera", nh4_n_bukle)|is.na(nh4_n_bukle))&
(grepl("gera", n_b_bukle)|is.na(n_b_bukle))&
(grepl("gera", p_po4_bukle)|is.na(p_po4_bukle))&
(grepl("gera", p_b_bukle)|is.na(p_b_bukle)), "gera", "bloga")) %>%
mutate(bukle = ifelse((is.na(bds7_bukle)&
is.na(nh4_n_bukle)&
is.na(n_b_bukle)&
is.na(p_po4_bukle)&
is.na(p_b_bukle)), NA, bukle))
mon_st_wgs_map <- mon_st_wgs %>% inner_join(wb_mon1, by = c("MS_CD" = "st_kodas"))
pal <- colorFactor(c("darkorange2", "forestgreen"), domain = c("bloga", "gera"))
map2 <- function(year){
gc <- rwb_wgs %>%
leaflet() %>%
addTiles (group = "OSM (numatytas)")%>%
addProviderTiles(providers$CartoDB.Positron, group = "CartoDB") %>%
addProviderTiles(providers$Esri.WorldImagery, group = "ESRI ortofoto") %>%
# addPolylines(weight = 2, opacity = 0.5, label = ~paste("Vandens telkinio kodas", rwb_wgs$WBriver_code)) %>%
addLayersControl(
baseGroups = c("OSM (numatytas)", "CartoDB", "ESRI ortofoto"))
# gc <- gc %>% addPolygons(data = lwb_wgs, color = "blue", weight = 1, smoothFactor = 0.5, opacity = 1.0, fillOpacity = 0.5,
# label = ~paste("Vandens telkinio kodas", lwb_wgs$EU_CD))
r201x <- r_wgs %>% filter (Year == year) %>% select(-Year)
gc <- gc %>% addMarkers(data=r201x, popup = paste("NI kodas", r201x$`NI kodas`, "<br>",
"VT kodas:", r201x$`VT kodas`, "<br>",
"VT tipas:", r201x$`VT tipas`, "<br>",
"Telkinio p:", r201x$`Telkinio p`, "<br>",
"GE:", r201x$GE, "<br>",
"Nuotėkų kiekio dalis:", r201x$DCHpr, "<br>",
"NH4-N krūvio dalis:", r201x$NH4pr, "<br>",
"PO4-P krūvio dalis:", r201x$PO4pr, "<br>",
"B. fosforo krūvio dalis:", r201x$PTpr, "<br>",
"Mon. st.:", r201x$st_kodas, "<br>",
"BDS7 būklė:", r201x$bds7_bukle, "<br>",
"NH4-N būklė:", r201x$nh4_n_bukle, "<br>",
"B. azoto būklė:", r201x$n_b_bukle, "<br>",
"PO4-P būklė:", r201x$p_po4_bukle, "<br>",
"B. fosforo būklė:", r201x$p_b_bukle, "<br>"), label = ~paste("NI kodas", r201x$`NI kodas`))
r201x$geometry <- NULL
rwb_wgs201x <- rwb_wgs %>% right_join(filter(r201x, `VT tipas`=="Upė"), by = c("WBriver_code"="VT kodas")) %>% select(WBriver_code)
lwb_wgs201x <- lwb_wgs %>% right_join(filter(r201x, `VT tipas`=="Ežeras"), by = c("EU_CD"="VT kodas")) %>% select(EU_CD)
gc <- gc %>% addPolylines(data=rwb_wgs201x, weight = 3, opacity = 1, color ="red", label = ~paste("Vandens telkinio kodas",rwb_wgs201x$WBriver_code))
gc <- gc %>% addPolygons(data=lwb_wgs201x, weight = 2, smoothFactor = 0.5, opacity = 1, color ="red", label = ~paste("Vandens telkinio kodas", lwb_wgs201x$EU_CD))
mon_st_wgs_map201x <- mon_st_wgs_map %>% filter(Year==year)
gc <- gc %>% addCircleMarkers(data = mon_st_wgs_map201x, color = ~pal(bukle), stroke = FALSE, fillOpacity = 0.8, popup = paste("Mon. st. pavadinimas:", mon_st_wgs_map201x$NAME, "<br>",
"Mon. st. kodas:", mon_st_wgs_map201x$MS_CD, "<br>",
"VT kodas:", mon_st_wgs_map201x$WB, "<br>",
"VT tipas:", mon_st_wgs_map201x$WB_TYPE, "<br>",
"BDS7 būklė:", mon_st_wgs_map201x$bds7_bukle, "<br>",
"NH4-N būklė:", mon_st_wgs_map201x$nh4_n_bukle, "<br>",
"Nb būklė:", mon_st_wgs_map201x$n_b_bukle, "<br>",
"PO4-P būklė:", mon_st_wgs_map201x$p_po4_bukle, "<br>",
"Fb būklė:", mon_st_wgs_map201x$p_b_bukle, "<br>"), label = ~paste("Mon. stotis:", mon_st_wgs_map201x$NAME))
gc
}2018 m. išskirti nuotekų šaltiniai ir jų veikiami vandens telkiniai
Pagal nuotekų koncentracijos metodiką buvo išskirta gana daug vandens telkinių ir juos įtakojančių sutelktosios vandens taršos šaltinių. Gauti rezultatai buvo įkomponuoti galutiniame vandens telkinių rizikos vertinime. Todėl šiame skyrelyje rezultatai detaliau neanalizuojami, o yra pateikiamas, kaip pavyzdys, 2018 m. (paskutiniųjų, kuriems prieinami duomenys, ataskaitos ruošimo metu) rezultatai. T.y. pagal nuotekų koncentracijos metodiką išskirti vandens telkiniai ir jiems priskirti pagrindiniai sutelktosios taršos šaltiniai. Detalesni duomenys lentelėse ir žemėlapyje pateikti norint suteikti galimybę susipažinti su gautais rezultatais.
table_pr2(2018)table_names2(2018)map2(2018)4. Sutelktosios taršos apkrovų pokytis rizikos vandens telkinių baseinuose
Ankstesniuose Upių baseinų rajonų (toliau - UBR) valdymo planuose taip pat buvo įvertintas sutelktosios taršos poveikis vandens telkiniams. Norint įvairiapusiškai įvertinti sutelktosios taršos poveikį, yra svarbu palyginti, kaip kito sutelktosios taršos apkrovos rizikos vandens telkiniuose, išskirtuose dėl sutelktosios taršos poveikio. Palyginimui buvo panaudota UBR vandymo planų 4 priedo “Taršos šaltiniai ir taršos mažinimo priemonės” 17 lentelė, kurioje pateikiami rizikos vandens telkiniai ir priežastys, dėl kurių jie laikomi rizikos telkiniais. Tam tikslui panaudoti 2012-2014 m. duomenys.
Remiantis sutelktosios taršos šaltinių duomenimis, buvo suskaičiuota vidutinė metinė atitinkamų teršalų suminė apkrova į rizikos vandens telkinį trimis skirtingais periodais. 2006-2008 m. periodas reprezentuoja UBR pirmų valdymo planų rengimo laikotarpį (lentelėje pavadinta 1 UBR PR.). 2012-2014 m. atitinka antrąjį periodą (2 UBR PR.), o 2016-2018 m. laikotarpis - trečiąjį planavimo periodą (3 UBR PR.). Siekiant įvertinti teršalų apkrovos santykinį pokytį, buvo paskaičiuoti procentiniai pokyčiai tarp skirtingų periodų. Lentelėse taip pat pateikiami vandens būklės (vandens būklė ir vandens kokybė ataskaitoje naudojami kaip sinonimai) įvertinimai pagal atitinkamus parametrus rizikos vandens telkiniuose esančiose monitoringo tyrimų vietose.
Šis skyrelis yra skirtas apžvelgti ankstesniame UBR cikle išskirtus vandens telkinius ir pokyčius juose įvykusius paskutiniame periode. Visi ankstesniame UBR cikle išskirti vandens telkiniai buvo įtraukti į “įtariamųjų” vandens telkinių sąrašą, kuriam buvo atliktas detalus rizikos vertinimas.
Bendro fosforo apkrovų pokytis
Pagal bendrojo fosforo vandens kokybės parametrą apkrovos į vandens telkinius, lyginant pirmą UBR planavimo periodą su trečiu, sumažėjo 27 ir padidėjo 8 vandens telkiniuose iš 35, o antrą UBR planavimo periodą lyginant su trečiu - apkrovos sumažėjo 18 ir padidėjo 17 vandens telkinių iš 35. Tačiau pagal monitoringo rezultatus, gera arba labai gera vandens kokybė (būklė lentelėje) pagal 2014-2018 m. monitoringo rezultatus pagal bendrą fosforą priskirta tik 7 vandens telkiniams - tiek pat, kiek buvo ir 2007-2013 m. periodu. Trejų vandens telkinių baseinuose stebimas gana žymus sutelktosios taršos padidėjimas, lyginant 1 ir 3 periodus, tačiau tai gali būti susiję su tuo, kad ankstesniame periode kai kurie stambūs šaltiniai nebuvo arba buvo nepakankamai tiksliai apskaitomi.
library(sf)
library(tidyverse)
library(DT)
loads <- read.csv("loads.csv")
loads$X <- NULL
rwb <- sf::st_read(dsn = "GISDATA.gdb", layer = "WB_line_150420", quiet = TRUE)
library(readxl)
eval <- read_excel("UBR_EVALUATION.xlsx", sheet="evalutation")
st_geometry(rwb) <- NULL
rwb_join <- rwb %>% select(WBriver_code, upes_pavadinimas) %>% distinct() %>% rename(`Upe` = upes_pavadinimas)
WB_at_risk <- eval %>% filter (.[[10]]>2) %>% select(`Vandens telkinio kodas`, `NH4-N 12-14`,
`BDS7 12-14`, `PO4 12-14`, `BP 12-14`) %>%
rename(WLINE=`Vandens telkinio kodas`)
Important_WWTP <- eval %>% select(`Vandens telkinio kodas`, 9, 16)
PARAMETRAI= c("BDS7", "NH4-N", "NO2-N", "B. azotas", "PO4-P", "B. fosforas")
PARAM = c('BOD7_l', 'NH4_l', 'NO2_l', 'Ntot_l', 'PO4_l', 'Ptot_l')
lookup = data.frame(PARAM, PARAMETRAI)
lookup <- data.frame(lapply(lookup, as.character), stringsAsFactors=FALSE)
WB_at_risk_join<- WB_at_risk %>% rename(`VT KODAS`=WLINE,
BDS7 = `BDS7 12-14`,
`NH4-N` = `NH4-N 12-14`,
`PO4-P` = `PO4 12-14`,
`B. fosforas` = `BP 12-14`) %>%
gather(PARAMETRAI,RIZIKOS,-`VT KODAS`)
wb_st<- read.csv("wb_status.csv")[,-1]
loads_WB_at_risk <- loads %>%
inner_join(WB_at_risk, by = "WLINE") %>%
mutate(RBMP = ifelse(Year >=2006 & Year <= 2008, 1, ifelse(Year>=2012 & Year <=2014, 2, ifelse(Year>=2016, 3, 0)))) %>%
select(WLINE, BOD7_l, NH4_l, NO2_l, NO3_l, Ntot_l, PO4_l, Ptot_l, RBMP) %>%
group_by(WLINE, RBMP) %>%
summarize_all(sum) %>%
filter(RBMP!=0) %>%
gather("PARAM", "VALUE", -c(WLINE, RBMP)) %>%
spread(RBMP, VALUE) %>%
mutate(`Pokytis % tarp 1 ir 2` = round(((`2`-`1`)/`1`)*100, 0),
`Pokytis % tarp 2 ir 3` = round(((`3`-`2`)/`2`)*100, 0),
`Pokytis % tarp 1 ir 3` = round(((`3`-`1`)/`1`)*100, 0)) %>%
filter(!PARAM %in% c("NO3_l")) %>%
left_join(lookup, by = "PARAM") %>%
select(-PARAM) %>%
mutate(`1` = round (`1`/3, 0),
`2`= round (`2`/3, 0),
`3` = round (`3`/3, 0)) %>%
rename (`VT KODAS`= WLINE,
`1 UBR PR.` = `1`,
`2 UBR PR.` = `2`,
`3 UBR PR.` = `3`) %>%
left_join(WB_at_risk_join, by = c("VT KODAS", "PARAMETRAI")) %>%
left_join(rwb_join, by=c("VT KODAS"="WBriver_code")) %>%
filter(RIZIKOS =="+") %>%
select(-RIZIKOS) %>%
left_join(Important_WWTP, by = c("VT KODAS"="Vandens telkinio kodas"))
loads_WB_at_risk$`VT KODAS` <- sub("^", "LT", loads_WB_at_risk$`VT KODAS`)
loads_WB_at_risk <- loads_WB_at_risk %>%
left_join(wb_st, by = c("VT KODAS"="vt_kodas", "PARAMETRAI")) %>%
select(-c(upes_pavadinimas, pavadinimas)) %>%
rename(`Mon. st.`= st_kodas,
Bukle = STATUS)
loads_WB_at_risk <- loads_WB_at_risk[,c(9,1,8,2,3,4,5,6,7,11,12,10,13)]
#papildymas sena būkle
loads_WB_at_risk <- loads_WB_at_risk %>% rename("Bukle 2014-2018" = Bukle)
bukle2007.2013 <- openxlsx::read.xlsx("upiu_telkiniu_bukle_atnaujinta.xlsx", sheet = "upes_2007_2013_vidurkis") %>%
select(`vt_kodas`,`st_kodas`, `bds7_bukle`,`p_b_bukle`,`p_po4_bukle`,`nh4_n_bukle`) %>%
rename(`NH4-N` = `nh4_n_bukle`,`PO4-P` = `p_po4_bukle`,`B. fosforas` = `p_b_bukle`,`BDS7` = `bds7_bukle`, `VT KODAS` = `vt_kodas`, `Mon. st.` = `st_kodas`) %>%
pivot_longer(-c(`VT KODAS`, `Mon. st.`), names_to = "PARAMETRAI", values_to = "Bukle 2007-2013")
loads_WB_at_risk <- loads_WB_at_risk %>% left_join(bukle2007.2013, by = c("VT KODAS", "Mon. st.", "PARAMETRAI")) %>% distinct()
loads_WB_at_risk <- loads_WB_at_risk[,c(1:12,14,13)]
#išimu nereprezentatyvias stotis
loads_WB_at_risk <- loads_WB_at_risk %>% filter(`Mon. st.` != "R1249") %>% filter(`Mon. st.` != "R247") %>%
filter(`Mon. st.` != "R73")
#NA vertes pakeičiu brūkšniu ir vieną taršos šaltinį pakeičiu dėl gramatinės klaidos
loads_WB_at_risk <- loads_WB_at_risk %>% mutate_at(vars(`Mon. st.`:`Bukle 2014-2018`), ~replace(., is.na(.), "-"))
# loads_WB_at_risk[loads_WB_at_risk$`Taršos šaltiniai` == "Žuvininkys-tės tvenkiniai (Šilavotas)",10] <- "Žuvininkystės tvenkiniai (Šilavotas)"
table_wb <- function(param){
loads_WB_at_risk_x <- loads_WB_at_risk %>% filter (PARAMETRAI == param) %>% select(-PARAMETRAI, -12, -10)
create_dt(loads_WB_at_risk_x)
}
table_wb("B. fosforas")Žemiau esančioje lentelėje pateikiama informacija apie išskirtų rizikos vandens telkinių būklę, nustatytą UBR antro periodo metu, ir šio įvertinimo priežastis, pagrindiniai sutelktosios taršos šaltiniai 2012 - 2014 m. periodu. Ši lentelė pateikiama papildant suminės taršos pokyčių lenteles, kad būtų įmanoma įvertinti priskyrimo rizikos vandens telkiniams priežastis.
add_table <- eval %>% select(`Vandens telkinio kodas`, Upė, `Būklė/ potencialas 12-14`, `Taršos šaltiniai`,`Išvada/ priskyrimas rizikos grupei`) %>% filter(`Būklė/ potencialas 12-14`>2)
add_table$`Vandens telkinio kodas` <- sub("^", "LT", add_table$`Vandens telkinio kodas`)
add_table <- add_table[,c(2,1,3,4,5)]
create_dt(add_table)Žemiau pateikiamas žemėlapis, padedantis lokalizuoti rizikos vandens telkiniams priskirtus vandens telkinius. Spalva pavaizduotas taršos apkrovų sumažėjimas tarp antro ir trečio UBR valdymo planų rengimo periodo. Užėjus ant vandens telkinio ir paspaudus gaunama daugiau informacijos. Taip pat žemėlapyje pateikiama vidutinė būklė 2014-2018 m. periodu monitoringo vietose, kurios reprezentuoja rizikos vandens telkinius. Mėlyna taškelių spalva rodo labai gerą, žalia - gerą būklę, geltona - vidutinę, oranžinė - blogą, o raudona - labai blogą vandens telkinio būklę pagal žemėlapyje ir skyrelyje nurodytą parametrą. Daugiau informacijos galima gauti paspaudus ant atitinkamos monitoringo vietos.
Iš žemėlapio galime daryti išvadą, kad daugelyje vietų sutelktosios taršos krūviai (taršos krūviai ir apkrovos ataskaitoje naujojami kaip sinonimai) sumažėjo, tačiau nebūtinai tai tuo pačiu mastu sumažino rizikos vandens telkinių skaičių.
rwb_wgs_select <- rwb_wgs %>% select(upes_pavadinimas, WBriver_code) %>% inner_join(loads_WB_at_risk, by = c("WBriver_code"="VT KODAS"))
rwb_wgs_s_join <- rwb_wgs_select %>% select(upes_pavadinimas, WBriver_code, PARAMETRAI)
st_geometry(rwb_wgs_s_join) <- NULL
wb_status <- read_excel("upiu_telkiniu_bukle_atnaujinta.xlsx", sheet="upes_2014_2018_vidurkis") %>%
select(st_kodas, pavadinimas, vt_kodas, bds7_bukle, p_b_bukle, p_po4_bukle, nh4_n_bukle) %>%
rename(BDS7 = bds7_bukle,
`NH4-N` = nh4_n_bukle,
`PO4-P` = p_po4_bukle,
`B. fosforas` = p_b_bukle) %>%
gather(PARAMETRAI, STATUS, -c(st_kodas, pavadinimas,vt_kodas)) %>%
inner_join(rwb_wgs_s_join, by = c("vt_kodas"="WBriver_code", "PARAMETRAI")) %>%
mutate(STATUS = ifelse(startsWith(STATUS,"vid"), "vidutine", STATUS)) %>%
distinct() %>%
left_join(bukle2007.2013, by = c("vt_kodas"="VT KODAS", "st_kodas"="Mon. st.", "PARAMETRAI")) %>%
rename(STATUS_BEFORE = `Bukle 2007-2013`)
write.csv(wb_status, "wb_status.csv")
mon_wb_status <- mon_st_wgs %>%
right_join(wb_status, by = c("MS_CD"="st_kodas")) %>%
select(-NAME)
map_wb <- function(param){
rwb_wgs_select_x <- rwb_wgs_select %>% filter (PARAMETRAI == param)
wb_status_x <- mon_wb_status %>% filter (PARAMETRAI == param)
bins <- c(-Inf, -50, -20, 0, 20, 50, Inf)
labels <- c("<-50%", "-50 - -20%", "-20 - 0%", "0 - 20%", "20 - 50%", ">50%")
pal <- colorBin(c("darkgreen","forestgreen","olivedrab3","gold","orange","orangered3"), domain = rwb_wgs_select_x$`Pokytis % tarp 2 ir 3`, bins = bins)
pal2 <- colorFactor(c("orange","green","red","blue","yellow"), domain = c("bloga", "gera", "labai bloga", "labai gera", "vidutine"))
gc <- rwb_wgs_select_x %>%
leaflet() %>%
addTiles (group = "OSM")%>%
addProviderTiles(providers$CartoDB.Positron, group = "CartoDB") %>%
addProviderTiles(providers$Esri.WorldImagery, group = "ESRI ortofoto") %>%
addPolylines(color = ~pal(`Pokytis % tarp 2 ir 3`), weight = 4, opacity = 1, popup = ~paste("Vandens telkinio pavadinimas:", rwb_wgs_select_x$upes_pavadinimas, "<br>",
"Vandens telkinio kodas:", rwb_wgs_select_x$WBriver_code, "<br>",
"Vid. krūvis kg 2006-2008 m.:", rwb_wgs_select_x$`1 UBR PR.`, "<br>",
"Vid. krūvis kg 2012-2014 m.:", rwb_wgs_select_x$`2 UBR PR.`, "<br>",
"Vid. krūvis kg 2016-2018 m.:", rwb_wgs_select_x$`3 UBR PR.`, "<br>",
"Pokytis % tarp 1 ir 2 periodo:", rwb_wgs_select_x$`Pokytis % tarp 1 ir 2`, "<br>",
"Pokytis % tarp 2 ir 3 periodo:", rwb_wgs_select_x$`Pokytis % tarp 2 ir 3`, "<br>",
"Pokytis % tarp 1 ir 3 periodo:", rwb_wgs_select_x$`Pokytis % tarp 1 ir 3`, "<br>",
"Taršos šaltiniai:", rwb_wgs_select_x$`Taršos šaltiniai`, "<br>",
"Priskirimo UBR 2 pr. rizikos grupei priežąstis:",
rwb_wgs_select_x$`Išvada/ priskyrimas rizikos grupei`, "<br>"), label = ~paste("Vandens telkinio kodas:", rwb_wgs_select_x$WBriver_code)) %>%
addLayersControl(
baseGroups = c("CartoDB (numatytas)", "OSM", "ESRI ortofoto"))
gc <- gc %>% addLegend(pal = pal, values = ~`Pokytis % tarp 2 ir 3`, opacity = 0.8, labFormat = function(type, cuts, p) {
paste0(labels)
},title = ~paste(param, "<br>",
"Apkrovų pokytis %", "<br>",
"Tarp 2 ir 3 periodo", "<br>"),
position = "bottomleft")
gc <- gc %>% addCircleMarkers(data = wb_status_x, radius = 7, color = ~pal2(STATUS), stroke = FALSE, fillOpacity = 0.5, popup = paste("Mon. st. pavadinimas:", wb_status_x$pavadinimas, "<br>",
"Mon. st. kodas:", wb_status_x$MS_CD, "<br>",
"VT kodas:", wb_status_x$vt_kodas, "<br>",
"VT pavadinimas:", wb_status_x$upes_pavadinimas, "<br>",
"Parametras:", wb_status_x$PARAMETRAI, "<br>",
"Vid. būklė 2007-2013 m.:", wb_status_x$STATUS_BEFORE, "<br>",
"Vid. būklė 2014-2018 m.:", wb_status_x$STATUS, "<br>"), label = ~paste("Mon. stotis:", wb_status_x$pavadinimas))
gc
}
if (5 %in% maps_to_show){
map_wb("B. fosforas")
}Fosfatinio fosforo apkrovų pokytis
Pagal fosfatinio fosforo vandens kokybės parametrą gera būklė stebima 11 iš 39 išskirtų rizikos vandens telkinių. Visuose juose fosfatinio fosforo apkrovos reikšmingai sumažėjo (tarp pirmo ir trečio UBR periodo) arba bent jau nepasikeitė. Tik 4 vandens telkiniuose suminiai sutelktosios taršos krūviai padidėjo. Norint išsiaiškinti priežastis, reikėtų detaliai įvertinti kiekvieno rizikos vandens telkinio baseino apkrovas iš sutelktųjų taršos šaltinių. Manytina, kad problemos susijusios ne tiek su duomenų trūkumais, kiek su vandens telkinių tarša, nes juose būklė neatitiko geros. Likusiuose vandens telkiniuose nors suminės fosfatinio fosforo taršos apkrovos ir mažėjo, visgi vandens telkinių būklė juose nepasiekė vandensaugos tikslų. Tarp antro ir trečio UBR periodo tarša sumažėjo 16 vandens telkiniuose, o padidėjo 18.
table_wb("PO4-P")if (6 %in% maps_to_show){
map_wb("PO4-P")
}Amonio azoto apkrovų pokytis
Pagal amonio azoto parametrą gera ir labai gera būklė buvo stebima 17 iš 23 praeitame UBR planavimo laikotarpyje išskirtų pagal šį parametrą rizikos vandens telkinių. 9 iš jų suminės taršos apkrovos sumažėjo tarp antro iš trečio UBR periodų, tačiau 13 apkrovos padidėjo, iš kurių 4 - reikšmingai. Yra telkinių, kur sutelktosios taršos apkrovos tarp 1 ir 3 UBR planavimo periodų išaugo labai stipriai. Tai gali būti susiję su ankstesnių laikotarpių duomenų problemomis, kai nebuvo apskaityti visi šaltiniai ar šaltiniams priskirtos netinkamos koordinatės, dėl kurių jų tarša nebuvo susumuota skaičiuojant bendras apkrovas. Vienaip ar kitaip šiuos atvejus būtina įvertinti atskirai. Tačiau labai svarbu pažymėti, kad tik 6 iš 23 praeitame UBR planavimo periode išskirtų rizikos vandens telkinių pagal amonio azoto parametrą neatitinka geros būklės. Tai, amonio azoto atžvilgiu stebima geresnė situacija, lyginant su fosforo junginiais.
table_wb("NH4-N")if (7 %in% maps_to_show){
map_wb("NH4-N")
}Organinių medžiagų išreikštų per BDS7 apkrovų pokytis
Lengvai skaidžios organinės taršos (matuojamos BDS7 parametru) kiekiai taip pat reikšmingai sumažėjo atnaujinant nuotekų valymo įrengimus. 13 iš 20 rizikos vandens telkinių dabar monitoringo vietose fiksuojama labai gera ar gera vandens telkinių būklė. 14 telkinių suminiai organinės taršos krūviai į vandens telkinių baseinus sumažėjo, lyginant 2 ir 3 UBR planavimo laikotarpių situacijas. 6 vandens telkinių baseinuose apkrovos tarp 2 ir 3 UBR planavimo laikotarpių padidėjo, tačiau dviejuose yra fiksuojama gera būklė.
table_wb("BDS7")5-7. Galutinis vandens telkinių rizikos įvertinimas
Krūvio plotui, nuotekų koncentracijos metodikos padėjo išskirti “įtariamų” vandens telkinių sąrašą, kuriems buvo atliktas individualus rizikos vertinimas. Prie šio sąrašo dar buvo pridėti vandens telkiniai, kurie buvo įvertinti kaip rizikos dėl sutelktosio taršos ankstesniame UBR planų ruošimo cikle ir ežerai bei tvenkiniai, kurie buvo atrinkti kaip galimai veikiami nuotekų šaltinių Aplinkos apsaugos agentūros atliktame “Žmogaus veiklos poveikio ežerų ir tvenkinių vandens kokybei preliminariame vertinime”. Kiekvienam iš “įtariamų” vandens telkinių saraše buvo paruoštos:
- santraukos dėl kokių priežąsčių vandens telkinys atsidūrė sąraše;
- parengtas vandens telkinio baseino, jo pagrindinių taršos šaltinių, vandens stebėjimo stočių lokalizacijos žemėlapis;
- vandens kokybės stebėsianos rezultatų grafikai kiekvienai vandens stebėsenos vietai priskirtai vandens telkiniui;
- vandens kokybės įvertinimas 2010-2013 ir 2014-2018 m. periodais;
- suminio metinio sutelktosios taršos krūvio vandens telkinio baseinui grafikai BDS7, amonio azotui, bendram azotui, fosfatų fosforui, bendram fosforui (reikšmingi parametrai pagal krūvio plotui metodiką) ir nuotekų kiekiui;
- suminės metinės nuotekų koncentracijos (suminis nuotekų krūvis vandens telkinio baseinui padalintas upės debitui) grafikai amonio azotui, fosfatų fosforui, bendram fosforui (reikšmingi parametrai pagal nuotekų koncentracijos metodiką) ir upės debitas;
- nuotekų išleistuvų taršos kiekių atnešamų į vandens telkinių baseiną 2018 m. pasiskirstymo representacija arba grafikas rodantis, kuri dalis sutelktosios taršos patenkančios į vandens telkinį yra sukuriama atskirame šaltinyje;
- pagrindiniuose (t.y. sukuriančiose daugiau nei 1% sutelktosios vandens telkinio taršos) 2018 m. nuotekų išleistuvuose matuojamų parametrų suvestinė;
- svarbiausių išleistuvų (t.y. sukuriančiose daugiau nei 10% sutelktosios vandens telkinio taršos) 2014-2018 m. išleidžiamų koncetracijų palyginimo grafikai su kitais išleistuvais išleidžiančiais tokio tipo nuotekas.
- lentelė su detalia informacija apie pagrindinius (t.y. sukuriančius daugiau nei 10% sutelktosios vandens telkinio taršos) nuotekų šaltinius 2018 m.;
- lentelė apie stambiausių (t.y. sukuriančius daugiau nei 10% sutelktosios vandens telkinio taršos) nuotekų išleistuvų atnešamos sutelktosios vandens telkinio taršos pasiskirstymą skirtingiems parametrams 2016-2018 m.;
- taršos pasiskirstymo tarp visų vandens telkinio šaltinių skritulinės diagramos grafikai bendram azotui ir bendram fosforui sudaryti naudojantis modeliavimo rezultatais.
Visa paruošta ypač detali medžiaga “įtariamiems” vandens telkiniams yra pateikiama šios ataskaitos priede 1a, priede 1b ir priede 1c. Trys priedai iš esmės yra vienas priedas, bet sukarpytas į tris dalis, kad dokumentai būtų patogūs naudotis ir nestrigtų dėl savo didelių apimčių. Visas dokumentas sukarpytas pagal abėcėlę, todėl vandens telkinius prieduose rasite pateiktus abėcėlės tvarka. Priede 1a yra pateikiama informacija nuo Aguonos upės iki Luknos upės (vandens telkiniai nuo A iki L), Priede 1b yra pateikiama informacija nuo Makesto ežero iki Šiladžio upelio (vandens telkiniai nuo M iki S), o Priede 1c yra pateikiama informacija nuo Simno ežero iki Žvirgždės upelio (nuo S iki Ž).
Ši, kiekvienam vandens telkiniui, paruošta informacija leido greitai įvertinti kiekvieno “įtariamo” vandens telkinio sutelktosios taršos problemas įvairiais pjūviais. Tačiau pagrindinė problema buvo kaip susisteminti visą šią informaciją ir padaryti iš jos išvadas, kurių svarbiausia ar vandens telkinys turėtų būti priskirtas prie rizikos vandens telkinių grupės ar ne. Šiai problemai išspręsti buvo sukurta rizikos įvertinimo metodika.
Rizikos įvertinimo metodika
Sukurta rizikos įvertinimo metodika rėmėsi multikriterinės analizės ir ekspertinio vertinimo principais. Buvo paruoštas algoritmas, kuris įvertino vandens telkinio stebėsemos rezultatų ir taršos charakteristikas pagal skirtingus kriterijus. Kiekvienas atitikimas tam tikram kriterijui buvo įvertintas nuo -3 (ne rizika) iki +3 (rizika) taškų. Visi taškai gauti įvertinus visus kriterijus buvo susumuoti ir gautas bendras rezultatas taškais, kuris nurodė vandens telkinio riziką. Kuo didesnis teigiamas skaičius tuo didesnė rizika, kuo didesnis neigiamas - tuo mažesnė rizika. Pagal įvertinimą taškai vandens telkiniai suskirtyti į keturias grupes:
- Rizikos vandens telkiniai. Tai yra tokie vandens telkiniai, kurie yra reiškingai neigiamai veikiami sutelktosios taršos šaltinių ir dėl kurių įvertinimo kylą mažiausiai abejonių.
- Potencialiai rizikos vandens telkiniai. Tai yra tokie vandens telkiniai, kurie yra galimai reikšmingai neigiamai veikiami sutelktosios taršos šaltinių, tačiau norint tai įvertinti trūksta vandens kokybės stebėsenos ar/ir nuotekų išleistuvų matavimų. Tai pat galimai skirtingi duomenų šaltiniai vienas kitam prieštarauja.
- Mažai tikėtinos rizikos vandens telkiniai. Tai yra tokie vandens telkiniai, kurie labiausiai tikėtina, kad nėra reikšmingai veikiami sutelktosios taršos. Norint tiksliau įvertinti reiktų papildomų vandens kokybės stebėsenos ar/ir nuotekų išleistuvų matavimų.
- Ne rizikos vandens telkiniai. Tai yra tokie vandens telkiniai, kurie yra nėra reiškingai neigiamai veikiami sutelktosios taršos šaltinių.
Pagrindiniai vertinimo kriterijų svorių paskirstymo principai išdėstyti žemiau:
- daugiausia reišmingumo suteikti vandens telkinio stebėsenos rezultams, kurie indikuoja sutelktąją taršą (3 taškai);
- vidutinį reikšmingumą suteikti vandens telkinio stebėsenos rezultatų pokyčiui tarp skirtingų periodų ir kriterijams dėl kurių vandens telkinys buvo priskirtas “įtariamųjų” grupei (2 taškai);
- visi kiti kriterijai (1 taškas).
- kriterijai, kurie galimai rodo didesnę tikimybę, kad vandens telkinys yra reikšmingai veikiamas sutelktosios taršos yra įvertinti teigiamais taškais, o kurie rodo mažesnę - neigiamais taškais.
Vertinimo metodikos kriterijai ir svoriai
Metodikoje buvo naudoti sekantys kriterijai ir jų svoriai:
- Pastaruoju metu stebėsenos rezultatai rodo sutelktosios taršos poveikį – +3 taškai.
- Vertinant šį kriterijų buvo analizuotas 2014-2018 m. periodas. Atitikimas kriterijui priimtas, jei pagal amonio azoto, fosfatų fosforo ir bendro fosforo parametrus vandens kokybės įvertinimas buvo prastesnis nei “geros” būklės.
- Pastaruoju metu stebėsenos rezultatai nerodo sutelktosios taršos poveikio – -3 taškai.
- Vertinant šį kriterijų buvo analizuotas 2014-2018 m. periodas. Atitikimas kriterijui priimtas, jei pagal amonio azoto, fosfatų fosforo ir bendro fosforo parametrus vandens kokybės įvertinimas buvo neprastesnis nei “geros” būklės.
- Pastaruoju metu vandens telkinių stebėsenos rezultatai, rodantys sutelktosios taršos poveikį, prastėja – +2 taškai.
- Vertinant šį kriterijų buvo lygintas vandens kokybės įvertinimas 2010-2013 ir 2014-2018 m. periodais. Atitikimas kriterijui priimtas, jei pagal amonio azoto, fosfatų fosforo ir bendro fosforo parametrus įvertinimai buvo prastesnį 2014-2018 m. periode.
- Pastaruoju metu vandens telkinių stebėsenos rezultatai, rodantys sutelktosios taršos poveikį, gerėja – -1 taškas.
- Vertinant šį kriterijų buvo lygintas vandens kokybės įvertinimas 2010-2013 ir 2014-2018 m. periodais. Atitikimas kriterijui priimtas, jei pagal amonio azoto, fosfatų fosforo ir bendro fosforo parametrus įvertinimai buvo geresni 2014-2018 m. periode.
- Pastaruoju metu nebuvo atlikta vandens telkinio stebėsena – +1 taškas.
- Vertinant šį kriterijų buvo analizuotas 2014-2018 m. periodas. Atitikimas kriterijui priimtas, jei 2014-2018 m. periodui nėra vandens kokybės įvertinimo.
- Svarbiausiuose išleistuvuose nėra matuojami vandens kokybei įvertinti reikalingi parametrai – +1 taškas.
- Atitikimas kriterijui priimtas, jei dviejuose didžiausiose nuotekų išleistuvuose (kurių kiekvienas atskirai išleidžia, ne mažiau nei 20% bendros vandens telkinio sutelktosios taršos) matuojama mažiau nei 2/3 vandens kokybei įvertinti reikalingų parametrų.
- Svarbiausi išleistuvai nevykdo veiklos, kurį galėtų pabloginti vandens telkinio būklės parametrus – -1 taškas.
- Atitikimas kriterijui priimtas, jei dviejuose didžiausiose nuotekų išleistuvuose (kurių kiekvienas atskirai išleidžia, ne mažiau nei 20% bendros vandens telkinio sutelktosios taršos) išleidžiamų nuotekų rūšis yra pažymėta kaip “paviršinės nuotekos” arba “aušinimo vanduo”.
- Svarbiausi išleistuvi yra toli nuo vandens telkinio (daugiau nei 5 km.) – -1 taškas.
- Atitikimas kriterijui priimtas, jei du didžiausi nuotekų išleistuvai (kurių kiekvienas atskirai išleidžia, ne mažiau nei 20% bendros vandens telkinio sutelktosios taršos) lokalizacija yra daugiau nei už 5 kilometrų nuo vandens telkinio.
- Pastaraisiais metais buvo reikšmingai sumažinti nuotekų kiekiai išleidžiami į vandens telkinį – -1 taškas.
- Vertinant šį kriterijų buvo lygintas bendras nuotekų kiekis patenkantis į vandens telkinį 2010-2012 ir 2016-2018 m. periodais. Atitikimas kriterijui priimtas, jei nuotekų kiekiai 2010-2012 m. periode buvo 10% didesni.
- Pastaraisiais metais buvo reikšmingai padidinti nuotekų kiekiai į vandens telkinį – +1 taškas.
- Vertinant šį kriterijų buvo lygintas bendras nuotekų kiekis patenkantis į vandens telkinį 2010-2012 ir 2016-2018 m. periodais. Atitikimas kriterijui priimtas, jei nuotekų kiekiai 2016-2018 m. periode buvo 10% didesni.
- Azoto ir fosforo prietaka iš nuotekų sudaro daugiau nei ketvirtį visos vandens telkinio maistmedžiagių prietakos. – +2 taškai.
- Vertinant šį kriterijų buvo naudoti 2014-2018 m. modeliavimo duomenys. Vandens telkinio tarša maistmedžiagėmis patenkanti iš nuotekų šaltinių palyginta su kitų šaltinių tarša. Atitikimas kriterijui priimtas, jei nuotekų šaltiniai tiek bendro azoto, tiek bendro fosforo atveju sudarė daugiau 25% visos vandens telkinio baseino taršos maistmedžiagėmis.
- Fosforo prietaka iš nuotekų sudaro daugiau nei ketvirtį visos vandens telkinio fosforo prietakos. – +1 taškas.
- Vertinant šį kriterijų buvo naudoti 2014-2018 m. modeliavimo duomenys. Vandens telkinio tarša maistmedžiagėmis patenkanti iš nuotekų šaltinių palyginta su kitų šaltinių tarša. Atitikimas kriterijui priimtas, jei nuotekų šaltiniai bendro fosforo atveju sudarė daugiau 25% visos vandens telkinio baseino taršos fosforu.
- Azoto prietaka iš nuotekų sudaro daugiau nei ketvirtį visos vandens telkinio azoto prietakos. – +1 taškas.
- Vertinant šį kriterijų buvo naudoti 2014-2018 m. modeliavimo duomenys. Vandens telkinio tarša maistmedžiagėmis patenkanti iš nuotekų šaltinių palyginta su kitų šaltinių tarša. Atitikimas kriterijui priimtas, jei nuotekų šaltiniai bendro azoto atveju sudarė daugiau 25% visos vandens telkinio baseino taršos azotu.
- Azoto ir fosforo prietaka iš nuotekų sudaro mažiau nei dešimtadalį visos vandens telkinio maistmedžiagių prietakos. – -1 taškai.
- Vertinant šį kriterijų buvo naudoti 2014-2018 m. modeliavimo duomenys. Vandens telkinio tarša maistmedžiagėmis patenkanti iš nuotekų šaltinių palyginta su kitų šaltinių tarša. Atitikimas kriterijui priimtas, jei nuotekų šaltiniai tiek bendro azoto, tiek bendro fosforo atveju sudarė mažiau nei 10% visos vandens telkinio baseino taršos maistmedžiagėmis.
- Abi metodikos rodo, kad vandens telkinys yra veikiamas sutelktosios taršos – +2 taškai.
- Atitikimas kriterijui priimtas, jei vandens telkinys pažymėtas kaip rizikos pagal krūvio plotui ir nuotekų koncentracijos metodikas.
- Vandens telkinys išskirtas kaip reikšmingai veikiamas sutelktosios taršos ankstesniame UBR planų ruošimo cikle – +2 taškai.
- Atitikimas kriterijui priimtas, jei vandens telkinys pažymėtas kaip rizikos dėl sutelktosios taršos ankstesniame UBR planų ruošimo cikle.
- Vandens telkinys nebuvo išskirtas kaip reikšmingai veikiamas sutelktosios taršos ankstesniame UBR planų ruošimo cikle – -1 taškai.
- Atitikimas kriterijui priimtas, jei vandens telkinys nebuvo išskirytas kaip rizikos ankstesniame UBR planų ruošimo cikle.
Taškinių įverčių priskyrimas kategorijoms:
- ‘RIZIKOS’
- Vandens telkinys priskirtas šiai kategorijai, jeigu įvertinimo metu surinko 5 ir daugiau taškų.
- ‘POTENCIALIAI RIZIKOS’
- Vandens telkinys priskirtas šiai kategorijai, jeigu įvertinimo metu surinko nuo 1 iki 4 taškų.
- ‘MAŽAI TIKĖTINA RIZIKA’
- Vandens telkinys priskirtas šiai kategorijai, jeigu įvertinimo metu surinko nuo -3 iki 0 taškų.
- ‘NE RIZIKOS’
- Vandens telkinys priskirtas šiai kategorijai, jeigu įvertinimo metu surinko -4 ir mažiau taškų.
Galutiniai įvertinimo rezultatai
Žemiau yra pateikiamas galutinių įvertinimų pasiskirtymo grafikas pagal 4 grupes.
“Rizikos” vandens telkinių grupei buvo priskirti 47 iš 174 visų vertintų “įtariamų” vandens telkinių. “Potencialiai rizikos” grupei buvo priskirti 32. “Mažai tikėtinos rizikos” grupei buvo priskirti 59, o “ne rizikos” grupei - 36.
Žemiau pateikiama vertintų vandens telkinių lentelė ir galutinis vandens telkinių įvertinimas pagal rizikos įvertinimo metodiką.
Reikšmė lentelėje:
- CASE1 - Vandens telkiniai atrinkti pagal krūvio plotui metodiką.
- CASE2 - Vandens telkiniai atrinkti pagal nuotekų koncentracijos metodiką.
- CASE3 - Vandens telkiniai atrinkti ankstesniame UBR periode.
- CASE4 - Vandens telkiniai atrinkti “Žmogaus veiklos poveikio ežerų ir tvenkinių vandens kokybei preliminariame vertinime”.
risk_lakes0 <- read_xlsx("potencialios_rizikos_ez_vt_2.xlsx", sheet = 1) %>%
filter(`Išleistuvo.pavojus`=="TAIP") %>%
select(2, 1) %>%
rename(`VT kodas`= vt_kodas,
VT_VARDAS = `Ežeras`) %>%
mutate(CASE1 = "Ne",
CASE2 = "Ne",
CASE3 = "Ne",
CASE4 = "Taip",
TIPAS = "Ežeras / Tvenkinys")
list_of_lakes <- risk_lakes0$`VT kodas`
wb_names_r1x0 <- read.csv("wb_names_r1x.csv")[,-1] %>%
rename(`VT kodas`=VT.kodas) %>%
arrange(VT_VARDAS) %>%
mutate(CASE4 = ifelse(`VT kodas` %in% list_of_lakes, "Taip", "Ne"))
remove_lakes <- wb_names_r1x0 %>%
filter(CASE4 =="Taip") %>%
select(1)
risk_lakes <- risk_lakes0 %>%
filter(!`VT kodas` %in% remove_lakes$`VT kodas`)
wb_names_r1x <- bind_rows(wb_names_r1x0, risk_lakes) %>%
select(VT_VARDAS, `VT kodas`, TIPAS, CASE1, CASE2, CASE3, CASE4) %>%
arrange(VT_VARDAS) %>%
left_join(rslt, by = c("VT kodas"="VT_kodas")) %>%
rename(`Taškai` = Points,
`Įvertinimas` = Result)
saveRDS(wb_names_r1x, "final_result.rds")
create_dt(wb_names_r1x, "Detaliai vertinti vandens telkiniai ir įvertinimo rezultatai")Pagrindiniai sutelktieji šaltiniai rizikos vandens telkiniuose
Kiekvienam vandens telkiniui, priskirtam rizikos ar potencialios rizikos grupei, buvo atrinkti pagrindiniai nuotekų šaltiniai sąlygojantys neigiamą poveikį vandens telkiniui. Ruošiant šį sąrašą buvo atrinkti tik 2018 m. nuotekų išleistuvai, kurie atnešė ne mažesnę nei 1/5 dalį visos sutelktosios vandens telkinio taršos. Šie nuotekų išleistuvai ir išleidėjai yra didžiausią neigiamą poveikį vandens telkiniams darantys sutelktosios taršos šaltiniai. Galvojant apie priemones suprantama prioritetas turi būti skirtas rizikos grupei priskirtiems vandens telkiniams ir juos veikiantiems nuotekų šaltiniams. Visas svarbiausių nuotekų išleistuvų sąrašas pateikiamas lentelėje žemiau.
##Funkcija sujunti vandens telkinių kodus
remove_wline_wpoligon <- function(df){
df$WLINE <- as.character(df$WLINE)
df$WPOLIGON <- as.character(df$WPOLIGON)
df <- df %>%
mutate(WB = ifelse(grepl('^LT', WLINE), WLINE, WPOLIGON)) %>%
select(-c(WLINE, WPOLIGON))
return(df)
}
##Pakrauname vandens telkinians priklausančių baseinėlių informaciją
ca_wb_topo <- read.csv("ca_wb_topo.csv")[,-1]
ca_wb_topo <- remove_wline_wpoligon(ca_wb_topo)
##Pakrauname sutelktųjų šaltinių informaciją ir priklausomybė baseinėliams
wwtp_nid <- read.csv("wwtp_nid.csv")[,-1]
##Pakrauname suskaičiuotus kruvius vandens telkiniuose
loads <- read.csv("loads.csv")
loads$X <- NULL
loads_ult <- loads
loads_ult$WLINE <- sub("^", "LT", loads_ult$WLINE)
loads_ult <- remove_wline_wpoligon(loads_ult)
##Pakrauname informacija apie nuotekų išleistuvus
wwtp_all <- read_csv("000_Summary.csv")[,-1] %>%
select(`Isleistuvo kodas`, Metai, `Nuoteku valymo budai`, `Papildomo valymo budai`) %>%
distinct()
wwtp_2018 <- wwtp_all %>% filter(Metai == 2018) %>% rename(`NI kodas`=`Isleistuvo kodas`)
wwtp_2018$`Nuoteku valymo budai`[wwtp_2018$`Nuoteku valymo budai` %in% "nan"] <- "--"
wwtp_2018$`Papildomo valymo budai`[wwtp_2018$`Papildomo valymo budai` %in% "nan"] <- "--"
table_wwtps <- function(WBs){
wb_info <- ca_wb_topo %>% filter(WB == WBs)
wb_edges_vector <- as.numeric(unlist(str_extract_all(wb_info$edges, "[\\.0-9e-]+")))
wb_wwtp <- wwtp_nid %>% filter(ID %in% wb_edges_vector) %>%
mutate(WB=WBs)%>%
full_join(loads_ult, by = c("WB", "Year"), suffix = c(".WWTP", ".WB")) %>%
mutate(DCHpr = round((Discharge.WWTP/Discharge.WB)*100, 2),
BODpr = round((BOD7_l.WWTP/BOD7_l.WB)*100, 2),
NH4pr = round((NH4_l.WWTP/NH4_l.WB)*100, 2),
NTpr = round((Ntot_l.WWTP/Ntot_l.WB)*100, 2),
PO4pr = round((PO4_l.WWTP/PO4_l.WB)*100, 2),
PTpr = round((Ptot_l.WWTP/Ptot_l.WB)*100, 2)) %>%
select(c(Name, PTYPE, PS_CODE, GE, Year, DCHpr, BODpr, NH4pr, NTpr, PO4pr, PTpr)) %>%
filter(DCHpr>=0 | BODpr> 0 | NH4pr > 0 | NTpr>0 | PO4pr>0 | PTpr>0) %>%
arrange(desc(Year), desc(DCHpr)) %>%
rename(`Isleidejo pav.`=Name, `Isleidejo tipas`=PTYPE, `NI kodas`=PS_CODE, Metai=Year) %>%
mutate(Sum = (BODpr + NH4pr + NTpr + PO4pr + PTpr)/5)
wb_wwtp$`Isleidejo pav.` <- gsub('[0-9]+', '', wb_wwtp$`Isleidejo pav.`)
wb_wwtp$`Isleidejo pav2.` <- paste('NI ',wb_wwtp$`NI kodas`, ' ', wb_wwtp$`Isleidejo pav.`)
wb_wwtp_final <- wb_wwtp %>%
filter(Metai==2018) %>%
select(`Isleidejo pav.`, `NI kodas`, Sum) %>%
filter (Sum > 20) %>%
left_join(wwtp_2018, by = "NI kodas") %>%
select(-Metai) %>%
mutate(Sum = round(Sum, 0)) %>%
rename(`Sutelktos tarsos dalis VT %`= Sum)
return (wb_wwtp_final)
}
risk_wb <- wb_names_r1x %>%
filter(`Įvertinimas` %in% c("RIZIKOS", "POTENCIALIAI RIZIKOS")) %>%
arrange(desc(`Įvertinimas`)) %>%
select(`VT_VARDAS`, `VT kodas`, `Įvertinimas`)
risk_wb_sources <- NULL
for (i in risk_wb$`VT kodas`){
table_selected <- table_wwtps(i)
if (dim(table_selected)[1] != 0){
table_selected$`VT kodas` <- i
risk_wb_sources <- bind_rows(table_selected, risk_wb_sources)
}
}
risk_wb_sources_final <- risk_wb %>%
left_join(risk_wb_sources, by = "VT kodas")
saveRDS(risk_wb_sources_final, "final_result_wwtps.rds")
create_dt(risk_wb_sources_final, "Pagrindiniai nuotekų išleistuvai rizikos ir potencialios rizikos vandens telkiuose 2018 m.")Išvados
Į nuotekų šaltinių poveikį vandens telkiniui galima žvelgti iš įvairių kampų, kas nebūtinai leidžia suformuoti vienareikšmiškas išvadas. Tačiau tai yra svarbu norint susidaryti bendrą vaizdą apie esančias vandens telkinio problemas ir matyti kur yra informacijos trūkumas. Todėl šioje apžvalgoje buvo pabandyta pateikti kiek įmanoma daugiau informacijos įvairiais pjūviais tiek šalies mastu, tiek atskirų vandens telkinių. Taip pat pateikta informacija galiausiai buvo susisteminta panaudojant apžvalgai sukurta rizikos vertinimo metodiką. Galiausiai gautas vienas rizikos įvertinimas apimamtis visą spektrą pateiktų grafikų, lentelių, žemėlapių apie vandens telkinį. Šis įvertinimas galbūt nėra visais atvejais idealiai tinkantis, tačiau jis leidžia greitai prioretizuoti vandens telkinius, kuriems pirmiausia turi būti skiriamas dėmesys, o kuriems antroje vietoje. Tuo tarpu detali informacija pateikta ataskaitoje ir jos prieduose leidžia greitai pamatyti nuotekų poveikio vandens telkiniui vaizdą iš arti ir išsiaiškinti, kuriuose vietose yra problemos. Todėl ši apžvalga yra skirta ne tik pateikti išvadas, kurie vandens telkiniai yra rizikos grupėje, bet ir būti puikiu šaltiniu toliau nagrinėjant nuotekų šaltinių poveikio vandens telkiniams problemas.
Iš šio darbo rezultatų galima suformuoti sekančias išvadas:
Daug labai svarbių nuotekų šaltinių nematuoja vandens telkinių poveikio vertinimui reikalingų vandens taršos parametrų. Dalyje didelių komunalinių nuotekų išleistuvų yra matuojami tik trys parametrais (BDS7, bendras azotas, bendras fosforas), kito tipo nuotekas išleidžiančiose išleistuvuose dar mažiau, bet blogiausia situacija yra su žuvininkystės vandens telkiniais, kurie tipiniu atveju savo išleistuvuose matuota tik suspenduotas daleles. Dažnai šie nuotekų išleidėjai yra didžiausi vandens telkiniuose ir apie jų realų poveikį mes galime tik spėlioti. Todėl labai svarbu, kad atnaujinant Upių baseinų rajonų planus į tai būtų atkreiptas pakankamas dėmesys. Vandens telkinių būklei poveikį galinčiuose daryti išleistuvuose turi būti nustatyti reikalavimai daryti detalią išleidžiamo vandens taršos stebėseną.
Dalyje vertinamų vandens telkinių taip pat nebuvo jokių vandens kokybės telkinių stebėsenos duomenų, kartais net abiejais 2010-2013 ir 2014-2018 m. periodais (t.y. 2010-2018 nebuvo daroma vandens kokybės stebėsena). Taip pat atskirais atvejais šiuose vandens telkiniuose, net ir svarbiausiuose nuotekų išleistuvuose nebuvo rinkti reikalingi vandens taršos duomenys. Todėl, kad ir kokias išvadas būtų galima gauti atliekant rizikos vertinimą, pagrindinė priemonė tokiems vandens telkiniams turėtų būti vandens stebėsenos atlikimas ir vandens kokybės parametrų matavimas nuotekų išleistuvuose. Tai yra primaloma informacija vandens telkinių poveikiui įvertinti.
Bendrai vertinant nuotekų poveikio vandens telkiniams situaciją Lietuvos mąstu galima daryti išvadą, kad tarp pirmų (2006-2008 m.) ir antrų (2012-2014 m.) Upių baseinų rajonų (UBR) planų rengimo periodų įvyko reikšmingas nuotekų poveikio sumažėjimas dėl didelio investavimo į nuotekų valyklų modernizavimą. Tačiau tarp antrų bei trečių UBR planų rengimo periodų tokių svarbesnių pokyčių nesimato, nors bendrai paėmus nuotekų tarša išlaiko mažėjimo tendencijas.
Atlikus regresinę analizę, skirtą susieti nuotekų apkrovas ir vandens telkinių stebėsenos rezultatus, labiausiai jautrūs nuotekų poveikiui buvo fosfatinio fosforo, bendro fosforo ir amonio azoto parametrai. Jie rizikos vertinime buvo naudojami kaip pagrindiniai atskiriant telkinius, kuriuose galimai yra sutelktosios taršos problemų.
Iš viso rizikos vertinimui buvo atrinkta 174 “įtariamų” vandens telkinių grupė. Šis vandens telkinių sąrašas buvo išskirtas panaudojant sukurtas metodikas. Taip pat prie “įtariamų” vandens telkinių sąrašo buvo pridėti ankstesniame UBR planų ruošimo periode išskirti rizikos vandens telkiniai dėl sutelktosios taršos poveikio bei preliminariame ežerų vertinime išskirti vandens telkiniai. Įvertinus visą “įtariamų” vandens telkinių sąrašą “rizikos” grupei buvo priskirti 47. Potencialios rizikos grupei buvo priskirti 32. Mažai tikėtinos rizikos grupei buvo priskirti 59, o nerizikos grupei - 36.
Iš 38 vandens telkinių išskirtų “Žmogaus veiklos poveikio ežerų ir tvenkinių vandens kokybei preliminariame vertinime” 21 priskirtas “ne rizikos” grupei, o dar 8 - “mažai tikėtinos rizikos”. Tik 4 vandens telkiniai priskirti “potencialios rizikos” rizikos ir 5 “rizikos” grupei.
Iš viso šiame darbe atliktame rizikos vertinime, kaip rizikos dėl nuotekų taršos buvo identifikuoti 47 vandens telkiniai, iš kurių 35 vandens telkiniai jau buvo identifikuoti kaip rizikos dėl tos pačios priežąsties antrame UBR planų rengimo etape (viso buvo identifikuoti 48 vandens telkiniai). 9 vandens telkiniai anksčiau priskirti rizikos vandens telkiniams dabar buvo priskirti “mažai tikėtinos rizikos” grupei, o likę 4 - “potencialiai rizikos” grupei.
Vertinant rizikos vandens telkinių skaičių tarp antro ir trečio UBR planų rengimo periodų negalima daryti išvados, kad rizikos vandens telkinių skaičius dėl sutelktosios taršos sumažėjo ar padidėjo. Jis iš esmės liko labai panašus (48 anksčiau ir 47 dabar). Mažoje dalyje vandens telkinių būklė pagerėjo, tačiau papildoma vandens telkinių stebėsenos ir nuotekų šaltinių informacija leido identifikuoti papildomus vandens telkinius priskirtinus “rizikos” vandens telkinių grupei.