diff --git a/DESCRIPTION b/DESCRIPTION index c3fa61adc409803bc30d4aa4a713ecdf02016d09..b6f13d08c5f073d9857bcca48163232fc9b5f626 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,7 @@ VignetteBuilder: Remotes: git::https://gitlab-forge.din.developpement-durable.gouv.fr/dreal-pdl/csd/adl/collectr.git, git::https://gitlab-forge.din.developpement-durable.gouv.fr/dreal-pdl/csd/datalibaba.git -Config/fusen/version: 0.7.0 +Config/fusen/version: 0.7.1 Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 diff --git a/data.captages.Rproj b/data.captages.Rproj index 6a3ede2239ad87da09a17c21b42cb9bb5ea83810..3a69df816f4530af00b03df0cfdd26519be43fda 100644 --- a/data.captages.Rproj +++ b/data.captages.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: fb9951cd-dbf4-4a55-91c2-3361e5e32f5e RestoreWorkspace: No SaveWorkspace: No diff --git a/dev/0-dev_history.Rmd b/dev/0-dev_history.Rmd index b2403adb701eb2223114b3bb0d74f85367eec688..6c7266585ec56845bc70c4dd70fc55fb9eed5b69 100644 --- a/dev/0-dev_history.Rmd +++ b/dev/0-dev_history.Rmd @@ -100,7 +100,7 @@ gitlabr::use_gitlab_ci(type = "check-coverage-pkgdown") pkgload::load_all() # Generate documentation and deal with dependencies -attachment::att_amend_desc() +attachment::att_amend_desc(add_suggests = c("collectr", "datalibaba")) # Check the package devtools::check() diff --git a/dev/flat_update_r_station_mesure_p_r52.Rmd b/dev/flat_update_r_station_mesure_p_r52.Rmd index 97ee11f5ff831a80c605515ce91a4920e723e2ad..158875ef8f010615d31b5fa9d8cf74571ec107bf 100644 --- a/dev/flat_update_r_station_mesure_p_r52.Rmd +++ b/dev/flat_update_r_station_mesure_p_r52.Rmd @@ -5,20 +5,19 @@ editor_options: chunk_output_type: console --- -```{r development, include=FALSE} +```{r development} library(collectr) library(datalibaba) library(dplyr) library(nngeo) library(sf) +library(stringr) library(usethis) - ``` ```{r development-load} # Load already included functions if relevant pkgload::load_all(export_all = FALSE) - ``` # Objectif @@ -41,7 +40,6 @@ data_ars <- datalibaba::importer_data( schema = "captages", db = "si_eau", user = "admin") - ``` ## Stations de mesure des qualités des nappes d'eau souterraine (ESO) @@ -53,7 +51,6 @@ data_eso_hubeau <- datalibaba::importer_data( schema = "qualite_nappes_eau_souterraine", db = "si_eau", user = "admin") - ``` ## Stations de mesure de la qualité des eaux superficielles continentales (STQ) @@ -65,7 +62,6 @@ data_esu_sandre <- datalibaba::importer_data( schema = "sandre", db = "si_eau", user = "admin") - ``` # Consolidation dans des dataframes similaire @@ -94,14 +90,12 @@ stations_eso_hubeau <- data_eso_hubeau |> # Convertir les dates de la variable date_creation stations_eso_hubeau$date_creation <- as.Date(stations_eso_hubeau$date_creation) - ``` Remplacer les valeurs vides dans `code_sise_eaux` par NA dans `stations_eso_hubeau` : ```{r na_code_sise_eaux, eval=FALSE} stations_eso_hubeau <- stations_eso_hubeau |> dplyr::mutate(code_sise_eaux = dplyr::if_else(code_sise_eaux == "", NA_character_, code_sise_eaux)) - ``` Réaliser la jointure sur la variable `code_bss` : @@ -136,14 +130,12 @@ doublons_stations_code_sise_eaux <- doublons_stations_code_sise_eaux |> # Visualiser les doublons print(doublons_stations_code_sise_eaux) - ``` Suppression des doublons : ```{r delete_duplicates_code_sise_eaux, eval=FALSE} stations_eso_hubeau <- stations_eso_hubeau |> dplyr::group_by(code_bss, the_geom) |> dplyr::slice(1) |> dplyr::ungroup() - ``` ## Stations de mesure de la qualité des eaux superficielles continentales (STQ) @@ -166,7 +158,6 @@ stations_esu_sandre <- data_esu_sandre |> # Convertir les dates de la variable date_creation stations_esu_sandre$date_creation <- as.Date(stations_esu_sandre$date_creation) - ``` ## Captages ARS @@ -174,7 +165,6 @@ stations_esu_sandre$date_creation <- as.Date(stations_esu_sandre$date_creation) Suppression des captages ARS avec des géométries vides : ```{r delete-empty-geom, eval=FALSE} data_ars_with_geom = data_ars[!sf::st_is_empty(data_ars),,drop=FALSE] - ``` ## Sélection des captages ARS différents des stations ESO de Hub'eau et des stations ESU du SANDRE @@ -194,7 +184,6 @@ stations_ars_not_hubeau_sandre <- data_ars_with_geom |> # Renommer les colonnes pour supprimer le suffixe .x names(stations_ars_not_hubeau_sandre) <- gsub("\\.x$", "", names(stations_ars_not_hubeau_sandre)) - ``` ## Consolidation des stations ARS @@ -212,7 +201,6 @@ stations_ars <- stations_ars_not_hubeau_sandre |> source, code_commune = code_commune_captage, the_geom) - ``` ## Ajout du `code_masse_eau` pour les stations ARS @@ -225,7 +213,6 @@ n_bassin_versant_specifique_000 <- datalibaba::importer_data( db = "si_eau", user = "admin" ) - ``` Requête spatiale pour la jointure de la variable `code_masse_eau` @@ -236,15 +223,16 @@ stations_ars <- sf::st_as_sf(stations_ars, sf_column_name = "the_geom") # Réaliser une jointure spatiale pour le dataframe `stations_ars` stations_ars <- stations_ars |> sf::st_join(n_bassin_versant_specifique_000 |> - dplyr::select(code_masse_eau), join = sf::st_within, left = TRUE) - + dplyr::select(code_masse_eau), + join = sf::st_within, left = TRUE) ``` ## Fusion des trois dataframes ```{r merge_stations, eval=FALSE} -station_full <- dplyr::bind_rows(stations_eso_hubeau, stations_esu_sandre, stations_ars) - +station_full <- dplyr::bind_rows(stations_eso_hubeau, + stations_esu_sandre, + stations_ars) ``` # Intersection des stations ESU avec les SAGE de la région et les limites régionales @@ -273,7 +261,6 @@ Vérification des objets sf : station_full <- sf::st_as_sf(station_full) n_sage_r52 <- sf::st_as_sf(n_sage_r52) n_region_exp_r52 <- sf::st_as_sf(n_region_exp_r52) - ``` Création d'un polygone fusionnant SAGE et région : @@ -296,16 +283,14 @@ n_sage_r52_union <- sf::st_union(objets_combines) # Correction de la géométrie, pour s'assurer qu'elle est valide n_sage_r52_valid <- sf::st_make_valid(n_sage_r52_union) -# Suppresion des trous internes en récupérant uniquement la limite extérieure +# Suppression des trous internes en récupérant uniquement la limite extérieure n_sage_r52_limit <- nngeo::st_remove_holes(n_sage_r52_valid) - ``` Sélection des stations ESU présentes dans les SAGE et la région : ```{r st_intersects_stations_sage, eval=FALSE} # Filtrer les stations ESU présentes dans les SAGE de la région station_sage_r52 <- sf::st_filter(station_full, n_sage_r52_limit) - ``` # Ajout des variables manquantes nécessaires @@ -319,7 +304,6 @@ station_sage_r52 <- station_sage_r52 |> dplyr::arrange(code_commune) |> # Ajouter un ID incrémental dplyr::mutate(id_station = dplyr::row_number()) - ``` @@ -330,12 +314,15 @@ Cet ajout ne concerne que les stations ESU : station_sage_r52 <- station_sage_r52 |> dplyr::mutate( code_naiades = dplyr::case_when( - startsWith(code_sise_eaux, "044") ~ sub("^044", "BS", code_sise_eaux), - startsWith(code_sise_eaux, "049") ~ sub("^049", "BX", code_sise_eaux), - startsWith(code_sise_eaux, "053") ~ sub("^053", "CB", code_sise_eaux), - NA ~ code_sise_eaux # Remplacer les autres codes par NA - )) - + nature_eau == "ESU" & source == "ARS" & + stringr::str_detect(code_sise_eaux, "^044") ~ stringr::str_replace(code_sise_eaux, "^044", "BS"), + nature_eau == "ESU" & source == "ARS" & + stringr::str_detect(code_sise_eaux, "^049") ~ stringr::str_replace(code_sise_eaux, "^049", "BX"), + nature_eau == "ESU" & source == "ARS" & + stringr::str_detect(code_sise_eaux, "^053") ~ stringr::str_replace(code_sise_eaux, "^053", "CB"), + TRUE ~ NA_character_ # Met NA si aucun pattern ne correspond + ) + ) ``` ## Ajout de la variable `code_bassin_versant` @@ -347,7 +334,6 @@ station_sage_r52 <- station_sage_r52 |> sf::st_join(n_bassin_versant_specifique_000 |> dplyr::select(code_bassin_versant = code_bassin_versant_specifique), join = sf::st_within, left = TRUE) - ``` Identification des doublons générés par la superposition de périmètres dans la table des bassins versants : @@ -370,14 +356,12 @@ doublons_code_bassin_versant <- doublons_code_bassin_versant |> # Visualiser les doublons print(doublons_code_bassin_versant) - ``` Suppression des doublons (optionnel) : ```{r delete_duplicates_code_bassin_versant, eval=FALSE} station_sage_r52 <- station_sage_r52 |> dplyr::group_by(id_station, the_geom) |> dplyr::slice(1) |> dplyr::ungroup() - ``` ## Ajout de la variable `code_sage` @@ -390,14 +374,14 @@ n_sage_r52 <- datalibaba::importer_data( db = "si_eau", user = "admin" ) - ``` Requête spatiale pour la jointure du `code_sage` dans `station_sage_r52` : ```{r add_code_sage, eval=FALSE} # Réaliser une jointure spatiale station_sage_r52 <- station_sage_r52 |> - sf::st_join(n_sage_r52 |> dplyr::select(code_sage = code), join = sf::st_within, left = TRUE) + sf::st_join(n_sage_r52 |> dplyr::select(code_sage = code), + join = sf::st_within, left = TRUE) ``` Identification des doublons générés par la superposition de périmètres dans la table des SAGE : @@ -444,7 +428,6 @@ r_captage_prioritaire_r52 <- datalibaba::importer_data( db = "si_eau", user = "admin" ) - ``` Ajout de la variable captage_prioritaire @@ -480,7 +463,6 @@ r_station_mesure_p_r52 <- station_sage_r52 |> ) ``` - ## Création dynamique du nom de la table avec l'année en cours ```{r create_table_name, eval=FALSE} @@ -491,12 +473,12 @@ current_year <- format(Sys.Date(), "%Y") table_name <- paste0("r_station_mesure_p_", current_year, "_r52") ``` - ## Archivage de la version précédente de la table La version précédente de l'export est stockée dans un schéma d'archive : ```{r archive_old_table, eval=FALSE} -collectr::archive_table(database = "si_eau", +collectr::archive_table(host = Sys.getenv("server"), + database = "si_eau", table = table_name, schema = "stations", new_schema = "zz_archives", @@ -515,7 +497,6 @@ datalibaba::poster_data(data = r_station_mesure_p_r52, pk = "id_station", overwrite = TRUE, user = "admin") - ``` ## Mise à jour de la géométrie de la table `r_station_mesure_p_current_year_r52` @@ -540,7 +521,6 @@ DBI::dbExecute(connexion, constraint_query) # Fermeture de la connexion DBI::dbDisconnect(connexion) - ``` ## Ajout des commentaires de la table actualisée @@ -559,7 +539,6 @@ datalibaba::commenter_table( db = "si_eau", user = "admin" ) - ``` ### Description des champs de la table actualisée @@ -596,7 +575,6 @@ datalibaba::post_dico_attr(dico = comments, schema = "stations", db = "si_eau", user = "admin") - ``` ## Mise à jour du skeleton diff --git a/vignettes/mise-a-jour-des-stations-de-mesure.Rmd b/vignettes/mise-a-jour-des-stations-de-mesure.Rmd index 45490f7fe1afdd2d2c0006b7fe67ee8b8e7c29ea..a292cb1a2042a722576dc49ecb332154dcef01fd 100644 --- a/vignettes/mise-a-jour-des-stations-de-mesure.Rmd +++ b/vignettes/mise-a-jour-des-stations-de-mesure.Rmd @@ -45,7 +45,6 @@ data_ars <- datalibaba::importer_data( schema = "captages", db = "si_eau", user = "admin") - ``` @@ -60,7 +59,6 @@ data_eso_hubeau <- datalibaba::importer_data( schema = "qualite_nappes_eau_souterraine", db = "si_eau", user = "admin") - ``` @@ -75,7 +73,6 @@ data_esu_sandre <- datalibaba::importer_data( schema = "sandre", db = "si_eau", user = "admin") - ``` @@ -107,7 +104,6 @@ stations_eso_hubeau <- data_eso_hubeau |> # Convertir les dates de la variable date_creation stations_eso_hubeau$date_creation <- as.Date(stations_eso_hubeau$date_creation) - ``` @@ -117,7 +113,6 @@ Remplacer les valeurs vides dans `code_sise_eaux` par NA dans `stations_eso_hube stations_eso_hubeau <- stations_eso_hubeau |> dplyr::mutate(code_sise_eaux = dplyr::if_else(code_sise_eaux == "", NA_character_, code_sise_eaux)) - ``` @@ -158,7 +153,6 @@ doublons_stations_code_sise_eaux <- doublons_stations_code_sise_eaux |> # Visualiser les doublons print(doublons_stations_code_sise_eaux) - ``` @@ -168,7 +162,6 @@ Suppression des doublons : stations_eso_hubeau <- stations_eso_hubeau |> dplyr::group_by(code_bss, the_geom) |> dplyr::slice(1) |> dplyr::ungroup() - ``` @@ -194,7 +187,6 @@ stations_esu_sandre <- data_esu_sandre |> # Convertir les dates de la variable date_creation stations_esu_sandre$date_creation <- as.Date(stations_esu_sandre$date_creation) - ``` @@ -205,7 +197,6 @@ Suppression des captages ARS avec des géométries vides : #| eval: no data_ars_with_geom = data_ars[!sf::st_is_empty(data_ars),,drop=FALSE] - ``` @@ -227,7 +218,6 @@ stations_ars_not_hubeau_sandre <- data_ars_with_geom |> # Renommer les colonnes pour supprimer le suffixe .x names(stations_ars_not_hubeau_sandre) <- gsub("\\.x$", "", names(stations_ars_not_hubeau_sandre)) - ``` @@ -248,7 +238,6 @@ stations_ars <- stations_ars_not_hubeau_sandre |> source, code_commune = code_commune_captage, the_geom) - ``` @@ -264,7 +253,6 @@ n_bassin_versant_specifique_000 <- datalibaba::importer_data( db = "si_eau", user = "admin" ) - ``` @@ -278,8 +266,8 @@ stations_ars <- sf::st_as_sf(stations_ars, sf_column_name = "the_geom") # Réaliser une jointure spatiale pour le dataframe `stations_ars` stations_ars <- stations_ars |> sf::st_join(n_bassin_versant_specifique_000 |> - dplyr::select(code_masse_eau), join = sf::st_within, left = TRUE) - + dplyr::select(code_masse_eau), + join = sf::st_within, left = TRUE) ``` @@ -287,8 +275,9 @@ stations_ars <- stations_ars |> ```{r merge_stations} #| eval: no -station_full <- dplyr::bind_rows(stations_eso_hubeau, stations_esu_sandre, stations_ars) - +station_full <- dplyr::bind_rows(stations_eso_hubeau, + stations_esu_sandre, + stations_ars) ``` @@ -326,7 +315,6 @@ Vérification des objets sf : station_full <- sf::st_as_sf(station_full) n_sage_r52 <- sf::st_as_sf(n_sage_r52) n_region_exp_r52 <- sf::st_as_sf(n_region_exp_r52) - ``` @@ -352,9 +340,8 @@ n_sage_r52_union <- sf::st_union(objets_combines) # Correction de la géométrie, pour s'assurer qu'elle est valide n_sage_r52_valid <- sf::st_make_valid(n_sage_r52_union) -# Suppresion des trous internes en récupérant uniquement la limite extérieure +# Suppression des trous internes en récupérant uniquement la limite extérieure n_sage_r52_limit <- nngeo::st_remove_holes(n_sage_r52_valid) - ``` @@ -364,7 +351,6 @@ Sélection des stations ESU présentes dans les SAGE et la région : # Filtrer les stations ESU présentes dans les SAGE de la région station_sage_r52 <- sf::st_filter(station_full, n_sage_r52_limit) - ``` @@ -380,7 +366,6 @@ station_sage_r52 <- station_sage_r52 |> dplyr::arrange(code_commune) |> # Ajouter un ID incrémental dplyr::mutate(id_station = dplyr::row_number()) - ``` @@ -394,12 +379,15 @@ Cet ajout ne concerne que les stations ESU : station_sage_r52 <- station_sage_r52 |> dplyr::mutate( code_naiades = dplyr::case_when( - startsWith(code_sise_eaux, "044") ~ sub("^044", "BS", code_sise_eaux), - startsWith(code_sise_eaux, "049") ~ sub("^049", "BX", code_sise_eaux), - startsWith(code_sise_eaux, "053") ~ sub("^053", "CB", code_sise_eaux), - NA ~ code_sise_eaux # Remplacer les autres codes par NA - )) - + nature_eau == "ESU" & source == "ARS" & + stringr::str_detect(code_sise_eaux, "^044") ~ stringr::str_replace(code_sise_eaux, "^044", "BS"), + nature_eau == "ESU" & source == "ARS" & + stringr::str_detect(code_sise_eaux, "^049") ~ stringr::str_replace(code_sise_eaux, "^049", "BX"), + nature_eau == "ESU" & source == "ARS" & + stringr::str_detect(code_sise_eaux, "^053") ~ stringr::str_replace(code_sise_eaux, "^053", "CB"), + TRUE ~ NA_character_ # Met NA si aucun pattern ne correspond + ) + ) ``` @@ -414,7 +402,6 @@ station_sage_r52 <- station_sage_r52 |> sf::st_join(n_bassin_versant_specifique_000 |> dplyr::select(code_bassin_versant = code_bassin_versant_specifique), join = sf::st_within, left = TRUE) - ``` @@ -440,7 +427,6 @@ doublons_code_bassin_versant <- doublons_code_bassin_versant |> # Visualiser les doublons print(doublons_code_bassin_versant) - ``` @@ -450,7 +436,6 @@ Suppression des doublons (optionnel) : station_sage_r52 <- station_sage_r52 |> dplyr::group_by(id_station, the_geom) |> dplyr::slice(1) |> dplyr::ungroup() - ``` @@ -466,7 +451,6 @@ n_sage_r52 <- datalibaba::importer_data( db = "si_eau", user = "admin" ) - ``` @@ -476,7 +460,8 @@ Requête spatiale pour la jointure du `code_sage` dans `station_sage_r52` : # Réaliser une jointure spatiale station_sage_r52 <- station_sage_r52 |> - sf::st_join(n_sage_r52 |> dplyr::select(code_sage = code), join = sf::st_within, left = TRUE) + sf::st_join(n_sage_r52 |> dplyr::select(code_sage = code), + join = sf::st_within, left = TRUE) ``` @@ -535,7 +520,6 @@ r_captage_prioritaire_r52 <- datalibaba::importer_data( db = "si_eau", user = "admin" ) - ``` @@ -577,7 +561,6 @@ r_station_mesure_p_r52 <- station_sage_r52 |> ``` - ## Création dynamique du nom de la table avec l'année en cours ```{r create_table_name} #| eval: no @@ -590,14 +573,14 @@ table_name <- paste0("r_station_mesure_p_", current_year, "_r52") ``` - ## Archivage de la version précédente de la table La version précédente de l'export est stockée dans un schéma d'archive : ```{r archive_old_table} #| eval: no -collectr::archive_table(database = "si_eau", +collectr::archive_table(host = Sys.getenv("server"), + database = "si_eau", table = table_name, schema = "stations", new_schema = "zz_archives", @@ -619,7 +602,6 @@ datalibaba::poster_data(data = r_station_mesure_p_r52, pk = "id_station", overwrite = TRUE, user = "admin") - ``` @@ -646,7 +628,6 @@ DBI::dbExecute(connexion, constraint_query) # Fermeture de la connexion DBI::dbDisconnect(connexion) - ``` @@ -667,7 +648,6 @@ datalibaba::commenter_table( db = "si_eau", user = "admin" ) - ``` @@ -706,7 +686,6 @@ datalibaba::post_dico_attr(dico = comments, schema = "stations", db = "si_eau", user = "admin") - ```