création de data-raw/prepa_referentiel.R pour enlever de data-raw/prepa_data.R...

création de data-raw/prepa_referentiel.R pour enlever de data-raw/prepa_data.R ce qui ne doit pas être recalculé à chaque actualisation

actualisation des données avec la nouvelle table des stations ESO

R/fct_preparation_data.R

@@ -56,12 +56,12 @@ prepa_station_PDL_fct <- function(station){
 #' @return Un dataframe.
 #'
 #' @export
-#' @importFrom dplyr inner_join rename select
+#' @importFrom dplyr filter inner_join rename select
 #' @importFrom sf st_drop_geometry
-prepa_nitrates_fct <- function(station){
+prepa_nitrates_fct <- function(station_code_nature_eau){
   nitrates_esu_ou_eso <- nitrates %>%
     dplyr::inner_join(
-      station %>% sf::st_drop_geometry(),
+      station_pdl %>% dplyr::filter(code_nature_eau == station_code_nature_eau) %>% sf::st_drop_geometry(),
       by = c("code_station")
     ) %>%
     dplyr::rename(

data-raw/prepa_referentiel.R

+
+library(nitrates.pdl)
+
+rm(list=ls())
+
+
+# élaboration de la table des bassins versants des Pays de la Loire -----
+
+# table des bassins versants de la France métropolitaine
+n_bassin_versant_specifique_000 <- datalibaba::importer_data(
+  db = "si_eau",
+  schema = "sandre",
+  table = "n_bassin_versant_specifique_000"
+  ) # 10341 obs
+# mapview::mapview(n_bassin_versant_specifique_000)
+
+# table de la région administrative des Pays de la Loire
+n_region_exp_r52 <- datalibaba::importer_data(
+  db = "referentiels",
+  schema = "adminexpress",
+  table = "n_region_exp_r52"
+  )
+
+# intersection des deux
+n_bassin_versant_specifique_r52_strict <- sf::st_intersection(
+  sf::st_buffer(n_bassin_versant_specifique_000, 0),
+  sf::st_buffer(n_region_exp_r52, 0)
+  ) # 463 obs
+# mapview::mapview(n_bassin_versant_specifique_r52_strict)
+
+# table des bassins versants de Loire-Bretagne
+n_bassin_versant_specifique_loire_bretagne <- datalibaba::importer_data(
+  db = "si_eau",
+  schema = "sandre",
+  table = "n_bassin_versant_specifique_loire_bretagne"
+  ) # 2038 obs
+
+# mapview::mapview(n_bassin_versant_specifique_loire_bretagne,col.regions = "blue", alpha.regions = 0.4) +
+#   mapview::mapview(n_bassin_versant_specifique_r52_strict, col.regions = "red", alpha.regions = 0.2)
+
+# 6 bassins versants sont délaissés par cette table au Nord-Ouest du département de la Mayenne :
+unique(
+  dplyr::anti_join(
+    n_bassin_versant_specifique_r52_strict %>% sf::st_drop_geometry(),
+    n_bassin_versant_specifique_loire_bretagne %>% sf::st_drop_geometry(),
+    by = c("code_eu_masse_eau")
+    )$code_eu_masse_eau
+  )
+# [1] "FRHR297" "FRHR347-I9143000" "FRHR347" "FRHR347-I91-0420" "FRHR347-I9141500" "FRHR347-I9150600"
+
+# conclusion : la table des bassins versants de Loire-Bretagne ne peut pas constituer un référentiel pour le présent projet
+
+# autre problème  :
+# FRGR0465 et FRGR1402 ont le même nom : "LE SARTHON ET SES AFFLUENTS DEPUIS LA SOURCE JUSQU'A LA CONFLUENCE AVEC LA SARTHE"
+`%notin%` <- Negate(`%in%`)
+n_bassin_versant_specifique_r52_strict_1 <- n_bassin_versant_specifique_r52_strict %>%
+  dplyr::select(code_eu_masse_eau, nom_bassin_versant_specifique) %>%
+  dplyr::filter(code_eu_masse_eau %notin% c("FRGR0465", "FRGR1402"))
+n_bassin_versant_specifique_r52_strict_2 <- n_bassin_versant_specifique_r52_strict %>%
+  dplyr::select(code_eu_masse_eau, nom_bassin_versant_specifique) %>%
+  dplyr::filter(code_eu_masse_eau %in% c("FRGR0465", "FRGR1402")) %>%
+  dplyr::mutate(
+    nom_bassin_versant_specifique = ifelse(
+      code_eu_masse_eau == "FRGR1402",
+      "LE SARTHON DEPUIS LA SOURCE JUSQU'A LA CONFLUENCE AVEC LA SARTHE",
+      nom_bassin_versant_specifique
+      )
+    )
+masse_eau_bassin_versant_PDL <- dplyr::bind_rows(
+  n_bassin_versant_specifique_r52_strict_1,
+  n_bassin_versant_specifique_r52_strict_2
+  ) %>%
+  dplyr::mutate_if(is.factor,as.character) %>%
+  dplyr::rename(
+    code_bassin_versant = code_eu_masse_eau,
+    nom_bassin_versant = nom_bassin_versant_specifique
+    )
+rm(n_bassin_versant_specifique_r52_strict_1, n_bassin_versant_specifique_r52_strict_2)
+
+# encore un problème pour FRHR347 dont le nom est ainsi écrit :	"L'Airon de sa source au confluent de la Sélune (ex"
+masse_eau_bassin_versant_PDL <- masse_eau_bassin_versant_PDL %>%
+  dplyr::mutate(
+    nom_bassin_versant = ifelse(
+      code_bassin_versant == "FRHR347",
+      "L'Airon de sa source au confluent de la Sélune (exclu)",
+      nom_bassin_versant
+      )
+    )
+# mapview::mapview(masse_eau_bassin_versant_PDL)
+
+masse_eau_bassin_versant_PDL_simplifiee <- rmapshaper::ms_simplify(masse_eau_bassin_versant_PDL, keep = .05)
+
+
+# formatage de la table des SAGE -----------
+n_sage_r52 <- datalibaba::importer_data(
+  db = "si_eau",
+  schema = "zonages_de_gestion",
+  table = "n_sage_r52"
+  ) # 24 obs
+
+n_sage_r52 <- n_sage_r52 %>%
+  dplyr::rename(
+    nom_sage = nom,
+    code_sage = code
+    ) %>%
+  dplyr::mutate(nom_sage = as.character(nom_sage)) %>%
+  dplyr::mutate(
+    nom_sage = ifelse(
+      nom_sage == "AUZANCE VERTONNE ET COURS D'EAU CÔTIERS",
+      "AUZANCE VERTONNE ET COURS D'EAU COTIERS",
+      nom_sage
+      )
+    ) # 24 obs
+# mapview::mapview(n_sage_r52)
+
+
+# correspondance entre bassins versants et SAGE --------
+correspondance_sage_bassin_versant_0 <- sf::st_intersection(
+  sf::st_buffer(masse_eau_bassin_versant_PDL %>% dplyr::mutate(surface_bv = sf::st_area(the_geom)), 0),
+  sf::st_buffer(n_sage_r52 %>% dplyr::select(nom_sage, code_sage), 0)
+  ) %>%
+  dplyr::select(code_sage, nom_sage, code_bassin_versant, nom_bassin_versant, surface_bv) %>%
+  dplyr::mutate(
+    surf_int = sf::st_area(the_geom),
+    pourc = round(surf_int/surface_bv*100, digits = 0)
+    ) # 787 obs
+correspondance_sage_bassin_versant_0$pourc <- units::drop_units(correspondance_sage_bassin_versant_0$pourc)
+correspondance_sage_bassin_versant_1 <- correspondance_sage_bassin_versant_0 %>%
+  dplyr::filter(pourc > 25) # 450 obs
+
+liste_bv_corr <- unique(correspondance_sage_bassin_versant_1$code_bassin_versant) # 450 obs
+
+# mapview::mapview(correspondance_sage_bassin_versant_1, col.regions = "blue", alpha.regions = 0.4) +
+#   mapview::mapview(masse_eau_bassin_versant_PDL,  col.regions = "yellow", alpha.regions = 0.2)
+
+# bassins versants hors correspondance
+bv_hors_correspondance <- masse_eau_bassin_versant_PDL %>%
+  dplyr::filter(code_bassin_versant %notin% liste_bv_corr) # 13 obs
+unique(bv_hors_correspondance$code_bassin_versant)
+# [1] "FRGR0007E" "FRGR0007F" "FRGR2214"  "FRGR1026"  "FRGR0532"  "FRGC47" "FRGR2207" "FRGR2223"  "FRGR0525"  "FRGR2127"  "FRGR2188"
+# [12] "FRGR0007D" "FRHR297"
+# les treize bassins versants sont HORS SAGE
+
+code_bassin_versant <- c(
+  "FRGR0007E", "FRGR0007F", "FRGR2214", "FRGR1026",  "FRGR0532",
+  "FRGC47",  "FRGR2207", "FRGR2223", "FRGR0525", "FRGR2127",
+  "FRGR2188", "FRGR0007D", "FRHR297"
+  )
+code_sage <- c(
+  "SAGE00000", "SAGE00000", "SAGE00000", "SAGE00000", "SAGE00000",
+  "SAGE00000", "SAGE00000", "SAGE00000", "SAGE00000", "SAGE00000",
+  "SAGE00000", "SAGE00000", "SAGE00000"
+  )
+
+correspondance_sage_bassin_versant_2 <- cbind(code_bassin_versant, code_sage) %>%
+  as.data.frame() %>%
+  dplyr::left_join(
+    n_sage_r52 %>%
+      dplyr::select(code_sage, nom_sage) %>%
+      sf::st_drop_geometry()
+    ) %>%
+  dplyr::left_join(masse_eau_bassin_versant_PDL %>% sf::st_drop_geometry()) %>%
+  dplyr::mutate(nom_sage = ifelse(is.na(nom_sage), "HORS SAGE", nom_sage)) # 13 obs
+
+# table des correspondances SAGE/bassins versants complétée
+correspondance_sage_bassin_versant <- dplyr::bind_rows(
+  correspondance_sage_bassin_versant_1 %>%
+    dplyr::select(code_sage, nom_sage, code_bassin_versant, nom_bassin_versant) %>%
+    sf::st_drop_geometry(),
+  correspondance_sage_bassin_versant_2
+  ) # 463 obs
+
+# vérification s'il y a encore un bassin hors correspondance avec un ou plusieurs SAGE
+bv_hors_correspondance_2 <- dplyr::anti_join(
+  masse_eau_bassin_versant_PDL,
+  correspondance_sage_bassin_versant,
+  by = c("code_bassin_versant")
+  ) # 0 obs
+
+
+# stations de mesure -----------
+station_esu <- datalibaba::importer_data(
+  db = "si_eau",
+  schema = "stations",
+  table = "station_esu"
+  )  # 1130 obs
+
+station_eso <- datalibaba::importer_data(
+  db = "si_eau",
+  schema = "stations",
+  table = "station_eso"
+  ) # 2034 obs
+
+# mention du département, et restriction au périmètre régional et aux géométries définies
+station_esu_PDL <- prepa_station_PDL_fct(station_esu) # 1130 obs
+station_eso_PDL <- prepa_station_PDL_fct(station_eso) # 2027 obs
+
+station <- dplyr::bind_rows(
+  station_esu,
+  station_eso %>% dplyr::select(-code_sise_eaux)
+  ) # 3164 obs
+
+station_pdl <- dplyr::bind_rows(
+  station_esu_PDL %>%
+    dplyr::mutate(code_nature_eau = "ESU") %>%
+    dplyr::mutate(
+      etoile = ifelse(startsWith(libelle_station,"* A"), "oui", "non")
+    ) %>%
+    dplyr::filter(etoile == "non") %>% # élimination de stations qui ne se rattachent à aucun prélèvement
+    dplyr::select(-etoile),
+  station_eso_PDL %>% dplyr::mutate(code_nature_eau = "ESO") %>% dplyr::select(-code_sise_eaux)
+  ) # 3149 obs
+
+
+# un peu de ménage ---------
+rm(
+  correspondance_sage_bassin_versant_0, correspondance_sage_bassin_versant_1, liste_bv_corr,
+  bv_hors_correspondance, code_bassin_versant, code_sage, correspondance_sage_bassin_versant_2,
+  bv_hors_correspondance_2
+  )
+
+
+# création de listes pour l'application RShiny ----
+Sage <- prepa_Sage_fct(correspondance_sage_bassin_versant)
+BassinVersant <- prepa_BassinVersant_fct(correspondance_sage_bassin_versant)
+Station <- prepa_Station_fct(station_pdl)
+NatureEau <- prepa_NatureEau_fct(station_pdl)
+
+
+# sauvegarde et documentation ----------
+usethis::use_data(
+  Sage,
+  BassinVersant,
+  Station,
+  NatureEau,
+  correspondance_sage_bassin_versant,
+  overwrite = TRUE
+  )
+# utilitaires.ju::use_data_doc("Sage", description = "liste des SAGE de la région des Pays de la Loire", source = "DREAL")
+# utilitaires.ju::use_data_doc("BassinVersant", description = "liste des bassins versants de la région des Pays de la Loire", source = "DREAL")
+# utilitaires.ju::use_data_doc("Station", description = "liste des stations de la région des Pays de la Loire", source = "DREAL")
+# utilitaires.ju::use_data_doc("NatureEau", description = "mentions ESU pour les eaux superficielles et ESO pour les eaux souterraines", source = "DREAL")
+# utilitaires.ju::use_data_doc("correspondance_sage_bassin_versant", description = "correspondance entre les SAGE et les bassins versants qui y sont inclus en totalité ou en partie pour la région des Pays de la Loire", source = "DREAL")
+
+# formatage des tables avec coordonnées géographiques
+n_region_exp_r52 <- sf::st_transform(n_region_exp_r52,"+proj=longlat + datum=WGS84")
+n_sage_r52 <- sf::st_transform(n_sage_r52,"+proj=longlat + datum=WGS84")
+masse_eau_bassin_versant_PDL <- sf::st_transform(masse_eau_bassin_versant_PDL,"+proj=longlat + datum=WGS84")
+masse_eau_bassin_versant_PDL_simplifiee <- sf::st_transform(masse_eau_bassin_versant_PDL_simplifiee,"+proj=longlat + datum=WGS84")
+
+station_pdl <- sf::st_transform(station_pdl,crs = ("+proj=longlat +datum=WGS84 +no_defs"))
+station_pdl <- sf::st_cast(station_pdl, "POINT")
+
+usethis::use_data(
+  n_region_exp_r52,
+  n_sage_r52,
+  masse_eau_bassin_versant_PDL,
+  masse_eau_bassin_versant_PDL_simplifiee,
+  station_pdl,
+  overwrite = TRUE
+  )
+# utilitaires.ju::use_data_doc("n_region_exp_r52", description = "géodataframe de la région des Pays de la Loire", source = "DREAL")
+# utilitaires.ju::use_data_doc("n_sage_r52", description = "géodataframe des SAGE de la région des Pays de la Loire", source = "DREAL")
+# utilitaires.ju::use_data_doc("masse_eau_bassin_versant_PDL", description = "géodataframe des bassins versants de la région des Pays de la Loire", source = "DREAL")
+# utilitaires.ju::use_data_doc("masse_eau_bassin_versant_PDL_simplifiee", description = "géodataframe simplifié des bassins versants de la région des Pays de la Loire", source = "DREAL")
+# utilitaires.ju::use_data_doc("station_pdl", description = "géodataframe des stations de mesures de la région des Pays de la Loire", source = "DREAL")
+
+
+
+
+
+

man/prepa_nitrates_fct.Rd

@@ -4,7 +4,7 @@
 \alias{prepa_nitrates_fct}
 \title{prepa_nitrates_fct}
 \usage{
-prepa_nitrates_fct(station)
+prepa_nitrates_fct(station_code_nature_eau)
 }
 \arguments{
 \item{station}{les tables des stations ESU ou ESO}