diff --git a/README.Rmd b/README.Rmd index a0f74decda1dfa18be67ee12d631180d7b0fcd29..b8e481940826a20ea2e05c4f5d0d44f665ecb5bc 100644 --- a/README.Rmd +++ b/README.Rmd @@ -21,12 +21,16 @@ knitr::opts_chunk$set( <!-- badges: end --> -L'objectif du package {data.captages} est de faciliter l'actualisation des lots de données suivants dans une base de données PostgreSQL régionale : +L'objectif du package {data.captages} est de faciliter l'actualisation des lots de données suivants dans une base de données PostgreSQL locale : - **Captages** : source ARS - **Captages en eau potable** : source ARS -- **Stations de mesure des qualités des nappes d'eau souterraine (ESO)** : sources ARS + [API Hub'eau Qualité des nappes d'eau souterraine](https://hubeau.eaufrance.fr/page/api-qualite-nappes) -- **Stations de mesures physicochimique sur des cours d'eau et plan d'eau (ESU)** : sources ARS + [API Hub'eau Qualité des cours d'eau](https://hubeau.eaufrance.fr/page/api-qualite-cours-deau) +- **Stations de mesure des qualités des nappes d'eau souterraine** : source [API Hub'eau Qualité des nappes d'eau souterraine](https://hubeau.eaufrance.fr/page/api-qualite-nappes) +- **Stations de mesures physicochimique sur des cours d'eau et plan d'eau** : source [API Hub'eau Qualité des cours d'eau](https://hubeau.eaufrance.fr/page/api-qualite-cours-deau) +- **Stations de mesure eau souterraine (ESO)** : source ARS + Hub'eau +- **Stations de mesures eau de surface d'eau (ESU)** : source ARS + Hub'eau + +La documentation du package est consultable sur ce site : https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/data.captages/ ## Installation @@ -40,7 +44,7 @@ remotes::install_git("https://gitlab-forge.din.developpement-durable.gouv.fr/dre Le package peut être chargé ainsi : -```{r example} +```{r example, eval=FALSE} library(data.captages) ``` diff --git a/README.md b/README.md index 35e27ed51bbc2a0b4aa4fedd7873ab376f258e6e..01e7ce8bc0e69d0ec83724e8dc7284e64d262651 100644 --- a/README.md +++ b/README.md @@ -13,17 +13,23 @@ experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](h <!-- badges: end --> L’objectif du package {data.captages} est de faciliter l’actualisation -des lots de données suivants dans une base de données PostgreSQL -régionale : +des lots de données suivants dans une base de données PostgreSQL locale +: - **Captages** : source ARS - **Captages en eau potable** : source ARS -- **Stations de mesure des qualités des nappes d’eau souterraine (ESO)** - : sources ARS + [API Hub’eau Qualité des nappes d’eau +- **Stations de mesure des qualités des nappes d’eau souterraine** : + source [API Hub’eau Qualité des nappes d’eau souterraine](https://hubeau.eaufrance.fr/page/api-qualite-nappes) - **Stations de mesures physicochimique sur des cours d’eau et plan - d’eau (ESU)** : sources ARS + [API Hub’eau Qualité des cours + d’eau** : source [API Hub’eau Qualité des cours d’eau](https://hubeau.eaufrance.fr/page/api-qualite-cours-deau) +- **Stations de mesure eau souterraine (ESO)** : source ARS + Hub’eau +- **Stations de mesures eau de surface d’eau (ESU)** : source ARS + + Hub’eau + +La documentation du package est consultable sur ce site : +<https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/data.captages/> ## Installation diff --git a/dev/config_fusen.yaml b/dev/config_fusen.yaml index 6af84571fd5e237d1ba869d8fec659980735d7cd..df9a30ed502210efe8e01dc3a8ba9e5444d2c659 100644 --- a/dev/config_fusen.yaml +++ b/dev/config_fusen.yaml @@ -42,10 +42,10 @@ flat_update_hubeau_qualite_nappe_station.Rmd: state: active R: [] tests: [] - vignettes: vignettes/mise-a-jour-des-stations-hub-eau-eau-souterraine--eso-.Rmd + vignettes: vignettes/mise-a-jour-des-stations-hub-eau-nappes-d-eau-souterraine.Rmd inflate: flat_file: dev/flat_update_hubeau_qualite_nappe_station.Rmd - vignette_name: Mise à jour des stations Hub'eau eau souterraine (ESO) + vignette_name: Mise à jour des stations Hub'eau nappes d'eau souterraine open_vignette: true check: true document: true @@ -55,10 +55,10 @@ flat_update_hubeau_qualite_rivieres_station_pc.Rmd: state: active R: [] tests: [] - vignettes: vignettes/mise-a-jour-des-stations-hub-eau-eau-de-surface--esu-.Rmd + vignettes: vignettes/mise-a-jour-des-stations-hub-eau-cours-d-eau-et-plan-d-eau.Rmd inflate: flat_file: dev/flat_update_hubeau_qualite_rivieres_station_pc.Rmd - vignette_name: Mise à jour des stations Hub'eau eau de surface (ESU) + vignette_name: Mise à jour des stations Hub'eau cours d'eau et plan d'eau open_vignette: true check: true document: true @@ -68,10 +68,23 @@ flat_update_station_eso.Rmd: state: active R: [] tests: [] - vignettes: vignettes/mise-a-jour-des-stations-eau-souterraine--eso-.Rmd + vignettes: vignettes/mise-a-jour-des-stations-eso.Rmd inflate: flat_file: dev/flat_update_station_eso.Rmd - vignette_name: Mise à jour des stations eau souterraine (ESO) + vignette_name: Mise à jour des stations ESO + open_vignette: true + check: true + document: true + overwrite: ask +flat_update_station_esu.Rmd: + path: dev/flat_update_station_esu.Rmd + state: active + R: [] + tests: [] + vignettes: vignettes/mise-a-jour-des-stations-esu.Rmd + inflate: + flat_file: dev/flat_update_station_esu.Rmd + vignette_name: Mise à jour des stations ESU open_vignette: true check: true document: true diff --git a/dev/flat_functions.Rmd b/dev/flat_functions.Rmd index 76781e2577375c5efcb4a379e12da30511894760..d25193e54c2a54df22e4d7e260d72b6440415757 100644 --- a/dev/flat_functions.Rmd +++ b/dev/flat_functions.Rmd @@ -83,10 +83,10 @@ test_that("create_hubeau_geom works correctly", { expect_equal(sf::st_crs(hubeau_sf)$epsg, 2154) # Vérifier que les coordonnées sont transformées (différentes des originales) - original_coords <- st_as_sf(hubeau_qualite_rivieres_station_pc, - coords = c("geometry.coordinates1", "geometry.coordinates2"), - crs = sf::st_crs("urn:ogc:def:crs:OGC:1.3:CRS84")) - expect_false(all(st_coordinates(original_coords) == st_coordinates(hubeau_sf))) + original_coords <- sf::st_as_sf(hubeau_qualite_rivieres_station_pc, + coords = c("geometry.coordinates1", "geometry.coordinates2"), + crs = sf::st_crs("urn:ogc:def:crs:OGC:1.3:CRS84")) + expect_false(all(sf::st_coordinates(original_coords) == sf::st_coordinates(hubeau_sf))) }) ``` diff --git a/dev/flat_update_captage.Rmd b/dev/flat_update_captage.Rmd index bd7f9dd4093822baf32e76cb2d0e777339383fa8..d3ea710d7fe433dba170272672a9b7f5c5f50659 100644 --- a/dev/flat_update_captage.Rmd +++ b/dev/flat_update_captage.Rmd @@ -8,6 +8,7 @@ editor_options: ```{r development, include=FALSE} library(testthat) library(readxl) +library(lubridate) library(dplyr) library(utils) library(collectr) @@ -21,6 +22,10 @@ library(glue) pkgload::load_all(export_all = FALSE) ``` +# Objectif + +Actualiser **la table des captages de la région** (`captages.n_captage_p_r52`) à partir d'un tableur au format Excel transmis annuellement par l'ARS. + # Chargement du lot de données L'export transmis par l'ARS est importé ainsi que la date du fichier (qui sera utilisée ultérieurement comme métadonnée) : @@ -37,6 +42,18 @@ last_modified_date <- format(file.info(file_path)$ctime,"%d/%m/%Y") # Lire le fichier Excel dans un dataframe data <- readxl::read_excel(file_path) + +# Vérifier le type de données dans la colonne "INS - Début d'usage - Date" +str(data) + +# Convertir la colonne "INS - Début d'usage - Date" en numérique +data <- data |> + mutate(`INS - Début d'usage - Date` = as.numeric(`INS - Début d'usage - Date`)) + +# Convertir les valeurs numériques en dates +data <- data |> + mutate(`INS - Début d'usage - Date` = as.Date(`INS - Début d'usage - Date`, origin = "1899-12-30")) + ``` # Renommage des champs @@ -79,8 +96,7 @@ table_de_passage_bss_000 <- datalibaba::importer_data( # Mise à jour du code BSS -Les anciens codes BSS de l'export transmis par l'ARS sont remplacés par les nouveaux codes -issus de la table de passage fournie par le BRGM lorsque la jointure est possible : +Les anciens codes BSS de l'export transmis par l'ARS sont remplacés par les nouveaux codes issus de la table de passage fournie par le BRGM lorsque la jointure est possible : ```{r update-code-bss, eval=FALSE} captage_bss <- captage |> @@ -133,7 +149,6 @@ collectr::check_structure_table(connexion, # Création d'un dataframe avec les enregistrements sans coordonnées ou des coordonées erronées Filtrage des enregistrements sans coordonnées valides (avec une valeur NA, 1 ou 3) : - ```{r rows-without-geom, eval=FALSE} # Créer un nouveau dataframe avec les lignes sans coordonnées valides captage_sans_geom <- captage_bss |> @@ -155,7 +170,6 @@ cat("Le fichier captage_sans_geom.csv a été enregistré avec succès.\n") # Encodage de la géométrie Suppression des enregistrements sans coordonnées valides avant encodage : - ```{r create-geom, eval=FALSE} # Supprimer les lignes sans coordonnées du dataframe d'origine captage_with_xy <- captage_bss |> @@ -183,6 +197,7 @@ n_captage_p_r52 <- dplyr::bind_rows(captage_geom, captage_sans_geom) 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(connexion, + database = "si_eau", table_name = "n_captage_p_r52", schema = "captages", new_schema = "zz_archives") diff --git a/dev/flat_update_captage_ep.Rmd b/dev/flat_update_captage_ep.Rmd index 8dc27bf11851caa284d4cd3adc2e53ea628f6649..d79ea174af099325d178e42a86bca1e79dddd00f 100644 --- a/dev/flat_update_captage_ep.Rmd +++ b/dev/flat_update_captage_ep.Rmd @@ -18,6 +18,10 @@ library(glue) pkgload::load_all(export_all = FALSE) ``` +# Objectif + +Actualiser **la table des captages en eau potable de la région** (`captages.n_captage_eau_potable_p_r52`) à partir de la table des captages de l'ARS (`captages.n_captage_p_r52`). + # Chargement de la table des captages ```{r load-captage, eval=FALSE} @@ -28,6 +32,15 @@ n_captage_p_r52 <- datalibaba::importer_data(db = "si_eau", # Filtre sur les captages en eau potable +Les enregistrements correspondant aux valeurs suivantes pour les usages sont sélectionnés : + +- `AEP` : ADDUCTION COLLECTIVE PUBLIQUE +- `ALI` : ACTIVITE AGRO ALIMENTAIRE +- `CND` : EAU CONDITIONNEE +- `PRV` : ADDUCTION COLLECTIVE PRIVEE + +Source : table `captages.n_captage_usage_direct` + ```{r filter-captage-ep, eval=FALSE} n_captage_eau_potable_p_r52 <- n_captage_p_r52 |> dplyr::filter(usage_captage %in% c('AEP', 'PRV', 'ALI', 'CND')) diff --git a/dev/flat_update_hubeau_qualite_nappe_station.Rmd b/dev/flat_update_hubeau_qualite_nappe_station.Rmd index f483a151569e60d08ee9706d0a9fe5b31f906d36..dbc6389b97cdeeb5e425ec643e5072c93688c540 100644 --- a/dev/flat_update_hubeau_qualite_nappe_station.Rmd +++ b/dev/flat_update_hubeau_qualite_nappe_station.Rmd @@ -1,5 +1,5 @@ --- -title: "Mise à jour des stations Hub'eau eau souterraine (ESO)" +title: "Mise à jour des stations Hub'eau nappes d'eau souterraine" output: html_document editor_options: chunk_output_type: console @@ -31,24 +31,8 @@ hubeau_qualite_nappes_stations <- hubeau::get_qualite_nappes_stations(num_depart # Création d'un champs de géométrie ```{r create-the-geom, eval=FALSE} -# Convertir le dataframe en objet sf -hubeau_sf <- sf::st_as_sf(hubeau_qualite_nappes_stations, - coords = c("geometry.coordinates1", "geometry.coordinates2"), - crs = sf::st_crs("urn:ogc:def:crs:OGC:1.3:CRS84")) -``` - -```{r add-the_geom, eval=FALSE} -# Renommer la colonne geometry en the_geom -hubeau_sf <- hubeau_sf |> dplyr::rename( - geometry_type = geometry.type, - geometry_crs_type = geometry.crs.type, - geometry_crs_properties_name = geometry.crs.properties.name, - the_geom = geometry) -``` - -```{r set-srid, eval=FALSE} -# Changer le SRID de the_geom à 2154 (EPSG:2154) -hubeau_sf <- sf::st_transform(hubeau_sf, 2154) +# Création de la géométrie +hubeau_sf <- create_hubeau_geom(hubeau_qualite_nappes_stations) ``` # Publication de la table actualisée @@ -203,6 +187,6 @@ datalibaba::post_dico_attr( ```{r development-inflate, eval=FALSE} # Run but keep eval=FALSE to avoid infinite loop # Execute in the console directly -fusen::inflate(flat_file = "dev/flat_update_hubeau_qualite_nappe_station.Rmd", vignette_name = "Mise à jour des stations Hub'eau eau souterraine (ESO)") +fusen::inflate(flat_file = "dev/flat_update_hubeau_qualite_nappe_station.Rmd", vignette_name = "Mise à jour des stations Hub'eau nappes d'eau souterraine") ``` diff --git a/dev/flat_update_hubeau_qualite_rivieres_station_pc.Rmd b/dev/flat_update_hubeau_qualite_rivieres_station_pc.Rmd index 6e4fec0519a581dc65a9c942f6f57292dca0ba71..5fe437a3e8409444f70395036fdae2d90e5019eb 100644 --- a/dev/flat_update_hubeau_qualite_rivieres_station_pc.Rmd +++ b/dev/flat_update_hubeau_qualite_rivieres_station_pc.Rmd @@ -1,5 +1,5 @@ --- -title: "Mise à jour des stations Hub'eau eau de surface (ESU)" +title: "Mise à jour des stations Hub'eau cours d'eau et plan d'eau" output: html_document editor_options: chunk_output_type: console @@ -19,7 +19,7 @@ pkgload::load_all(export_all = FALSE) # Objectif -Actualiser les **stations de mesures physicochimique sur des cours d'eau et plan d'eau (eau de surface : ESU)** à partir de l'[API Hub'eau "Qualité des cours d'eau"](https://hubeau.eaufrance.fr/page/api-qualite-cours-deau) dans une base de données PostgreSQL. +Actualiser les **stations de mesures physicochimique sur des cours d'eau et plan d'eau** à partir de l'[API Hub'eau "Qualité des cours d'eau"](https://hubeau.eaufrance.fr/page/api-qualite-cours-deau) dans une base de données PostgreSQL. # Récupération des données @@ -31,24 +31,25 @@ hubeau_qualite_rivieres_station_pc <- hubeau::get_qualite_rivieres_station_pc(co # Création d'un champs de géométrie ```{r create-the-geom, eval=FALSE} -# Convertir le dataframe en objet sf -hubeau_sf <- sf::st_as_sf(hubeau_qualite_rivieres_station_pc, - coords = c("geometry.coordinates1", "geometry.coordinates2"), - crs = sf::st_crs("urn:ogc:def:crs:OGC:1.3:CRS84")) +# Création de la géométrie +hubeau_sf <- create_hubeau_geom(hubeau_qualite_rivieres_station_pc) ``` -```{r add-the_geom, eval=FALSE} -# Renommer la colonne geometry en the_geom -hubeau_sf <- hubeau_sf |> dplyr::rename( - geometry_type = geometry.type, - geometry_crs_type = geometry.crs.type, - geometry_crs_properties_name = geometry.crs.properties.name, - the_geom = geometry) -``` - -```{r set-srid, eval=FALSE} -# Changer le SRID de the_geom à 2154 (EPSG:2154) -hubeau_sf <- sf::st_transform(hubeau_sf, 2154) +# Remplacement des caractères accentués impactés par un problème d'encodage +Dans la variable `libelle_station` : +```{r replace-encoding-problems, eval=FALSE} +# Remplacer <e0> par À dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<e0>", "À", hubeau_sf$libelle_station) +# Remplacer <e0> par À dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<c0>", "À", hubeau_sf$libelle_station) +# Remplacer <c8> par È dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<c8>", "È", hubeau_sf$libelle_station) +# Remplacer <c8> par È dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<c9>", "É", hubeau_sf$libelle_station) +# Remplacer <c8> par È dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<c2>", "Â", hubeau_sf$libelle_station) +# Remplacer <c8> par È dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<d4>", "Ô", hubeau_sf$libelle_station) ``` # Archivage de la version précédente de la table @@ -160,6 +161,6 @@ datalibaba::post_dico_attr( ```{r development-inflate, eval=FALSE} # Run but keep eval=FALSE to avoid infinite loop # Execute in the console directly -fusen::inflate(flat_file = "dev/flat_update_hubeau_qualite_rivieres_station_pc.Rmd", vignette_name = "Mise à jour des stations Hub'eau eau de surface (ESU)") +fusen::inflate(flat_file = "dev/flat_update_hubeau_qualite_rivieres_station_pc.Rmd", vignette_name = "Mise à jour des stations Hub'eau cours d'eau et plan d'eau") ``` diff --git a/dev/flat_update_station_eso.Rmd b/dev/flat_update_station_eso.Rmd index 84ff8a9b7ca437e591cca8b2e5be047c7a0993f6..bc677b174911291b9685be1a06623514c69602c5 100644 --- a/dev/flat_update_station_eso.Rmd +++ b/dev/flat_update_station_eso.Rmd @@ -1,12 +1,11 @@ --- -title: "Mise à jour des stations eau souterraine (ESO)" +title: "Mise à jour des stations ESO" output: html_document editor_options: chunk_output_type: console --- -```{r development, include=FALSE} -library(testthat) +```{r development} library(datalibaba) library(dplyr) library(sf) @@ -18,17 +17,24 @@ library(collectr) pkgload::load_all(export_all = FALSE) ``` +# Objectif + +Actualiser les **stations de mesure eau de souterraine (ESO)** à partir des tables suivantes dans une base de données PostgreSQL : +- `qualite_nappes_eau_souterraine.hubeau_qualite_nappes_stations` (source : Hub'eau) +- `captages.n_captage_p_r52` (source : ARS) + # Chargement des lot de données source -Stations de mesure des qualités des nappes d'eau souterraine (ESO): +## Stations de mesure des qualités des nappes d'eau souterraine (ESO) ```{r load-hubeau_qualite_nappes_stations, eval=FALSE} data_hubeau <- datalibaba::importer_data( table = "hubeau_qualite_nappes_stations", - schema = "stations", + schema = "qualite_nappes_eau_souterraine", db = "si_eau") ``` -Captages ARS ESO : +## Captages ARS ESO +Chargement de la table des captages en filtrant sur la nature de l'eau du captage et le début du `code_bss` : ```{r load_captages_ars_eso, eval=FALSE} data_ars <- datalibaba::importer_data( table = "n_captage_p_r52", @@ -42,9 +48,7 @@ Suppression des géométries vides : data_ars_with_geom = data_ars[!sf::st_is_empty(data_ars),,drop=FALSE] ``` -# Sélection des captages ARS différents de Hub'eau - - +Sélection des captages ARS différents de Hub'eau : ```{r select-captages-ars-not-hubeau, eval=FALSE} # Effectuer l'opération anti_join après avoir supprimé la géométrie data_ars_not_hubeau <- data_ars_with_geom |> @@ -202,6 +206,7 @@ station_eso <- station_eso |> ``` ```{r update-codes-sise-eaux, eval=FALSE} +# Supprimer l'objet géométrie du dataframe data_ars data_ars <- data_ars |> sf::st_drop_geometry() @@ -317,6 +322,6 @@ datalibaba::post_dico_attr(dico = station_eso_comments, ```{r development-inflate, eval=FALSE} # Run but keep eval=FALSE to avoid infinite loop # Execute in the console directly -fusen::inflate(flat_file = "dev/flat_update_station_eso.Rmd", vignette_name = "Mise à jour des stations eau souterraine (ESO)") +fusen::inflate(flat_file = "dev/flat_update_station_eso.Rmd", vignette_name = "Mise à jour des stations ESO") ``` diff --git a/dev/flat_update_station_esu.Rmd b/dev/flat_update_station_esu.Rmd index 3ac9b43c8c6f74422aa95833fc7e0b881174ece3..00cf99b839d1c7d0a630a790aaa9e3a304190525 100644 --- a/dev/flat_update_station_esu.Rmd +++ b/dev/flat_update_station_esu.Rmd @@ -73,36 +73,39 @@ names(data_ars_not_hubeau) <- gsub("\\.x$", "", Renommage des variables, ajout du code SISE-Eaux et de la source, sélection des variables : ```{r consolidate-stations_hubeau, eval=FALSE} -stations_eso_hubeau <- data_hubeau |> - dplyr::rename(code_station = bss_id, - libelle_station = nom_commune, - date_creation = date_debut_mesure, - code_commune = code_insee) |> - dplyr::mutate(code_sise_eaux = "", - source = "HUBEAU") |> - dplyr::select(code_station,code_sise_eaux,libelle_station,date_creation, - source,code_commune,the_geom) +stations_esu_hubeau <- data_hubeau |> + dplyr::mutate(source = "HUBEAU") |> + dplyr::select(code_station, + libelle_station, + date_creation, + source, + code_masse_eau = code_masse_deau, + code_eu_masse_eau = code_eu_masse_deau, + code_commune, + the_geom) + +# Convertir les dates de la variable date_creation +stations_esu_hubeau$date_creation <- as.Date(stations_esu_hubeau$date_creation) ``` # Consolidation des stations ARS Renommage des variables, ajout de la source, sélection des variables : ```{r consolidate-stations_ars, eval=FALSE} -stations_eso_ars <- data_ars_not_hubeau |> - dplyr::rename(code_station = code_bss, - code_sise_eaux = code_captage, +stations_esu_ars <- data_ars_not_hubeau |> + dplyr::rename(code_station = code_captage, libelle_station = nom_captage, date_creation = date_etat_installation, code_commune = code_commune_captage) |> dplyr::mutate(source = "ARS") |> - dplyr::select(code_station,code_sise_eaux,libelle_station,date_creation, + dplyr::select(code_station,libelle_station,date_creation, source,code_commune,the_geom) ``` # Fusion des deux dataframes ```{r merge-stations, eval=FALSE} -station_eso <- dplyr::bind_rows(stations_eso_hubeau, stations_eso_ars) +station_esu <- dplyr::bind_rows(stations_esu_hubeau, stations_esu_ars) ``` # Ajout du `code_sage` par station @@ -116,17 +119,17 @@ n_sage_r52 <- datalibaba::importer_data( ) ``` -Requête spatiale pour la jointure du `code_sage` dans `station_eso` : +Requête spatiale pour la jointure du `code_sage` dans `station_esu` : ```{r update-code-sage, eval=FALSE} # Réaliser une jointure spatiale -station_eso <- station_eso |> +station_esu <- station_esu |> 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 : ```{r get-station-duplicates-code_sage, eval=FALSE} # Compter les occurrences de chaque code_station -doublons_stations_code_sage <- station_eso |> +doublons_stations_code_sage <- station_esu |> dplyr::group_by(code_station) |> dplyr::tally(name = "n") |> dplyr::filter(n > 1) @@ -137,7 +140,7 @@ doublons_stations_code_sage <- doublons_stations_code_sage |> # Joindre les informations additionnelles doublons_stations_code_sage <- doublons_stations_code_sage |> - dplyr::left_join(station_eso, by = "code_station") |> + dplyr::left_join(station_esu, by = "code_station") |> dplyr::left_join(n_sage_r52, by = c("code_sage" = "code")) |> dplyr::select(code_station, n, libelle_station, code_sage, nom, the_geom.x) @@ -147,13 +150,13 @@ print(doublons_stations_code_sage) Suppression des doublons : ```{r delete-station-duplicates-code-sage, eval=FALSE} -station_eso <- station_eso |> +station_esu <- station_esu |> dplyr::group_by(code_station, the_geom) |> dplyr::slice(1) |> dplyr::ungroup() ``` Ajout de la valeur `SAGE00000` si la valeur de `code_sage` est NA : ```{r replace-code-sage-na, eval=FALSE} -station_eso <- station_eso |> +station_esu <- station_esu |> dplyr::mutate(code_sage = tidyr::replace_na(code_sage, "SAGE00000")) ``` @@ -168,10 +171,10 @@ n_bassin_versant_specifique_loire_bretagne <- datalibaba::importer_data( ) ``` -Requête spatiale pour la jointure des champs `code_bassin_versant`, `code_masse_eau`, `code_eu_masse_eau` dans `station_eso` : +Requête spatiale pour la jointure des champs `code_bassin_versant`, `code_masse_eau`, `code_eu_masse_eau` dans `station_esu` : ```{r update-codes-bassin-versant-masse-eau, eval=FALSE} # Réaliser une jointure spatiale -station_eso <- station_eso |> +station_esu <- station_esu |> sf::st_join(n_bassin_versant_specifique_loire_bretagne |> dplyr::select(code_bassin_versant = code_bassin_versant_specifique, code_masse_eau, @@ -179,6 +182,16 @@ station_eso <- station_eso |> join = sf::st_within, left = TRUE) ``` +Fusion des variables pour conserver un maximum de valeurs : +```{r merge-variables, eval=FALSE} +# Fusionner les variables code_masse_eau.x et code_masse_eau.y, code_eu_masse_eau.x et code_eu_masse_eau.y +station_esu <- station_esu |> + mutate(code_masse_eau = coalesce(code_masse_eau.x, code_masse_eau.y), + code_eu_masse_eau = coalesce(code_eu_masse_eau.x, code_eu_masse_eau.y)) |> + select(-code_masse_eau.x, -code_masse_eau.y, -code_eu_masse_eau.x, -code_eu_masse_eau.y) # Supprimer les colonnes inutiles +``` + + # Ajout du `captage_prioriaire` par station Chargement de la table des captages prioritaires de la région : @@ -193,64 +206,15 @@ r_captage_prioritaire_r52 <- datalibaba::importer_data( Ajout de la variable captage_prioritaire ```{r update-captage-prioriaire, eval=FALSE} # Alimenter la variable en vérifiant la présence du `code_station` dans `r_captage_prioritaire_r52` -station_eso <- station_eso |> +station_esu <- station_esu |> dplyr::mutate(captage_prioritaire = - code_station %in% r_captage_prioritaire_r52$code_bss) -``` - -# Mise à jour du code_sise_eaux à partir des données ARS - -Remplacer les valeurs vides dans `code_station` par NA dans `station_eso` : -```{r na-code-sise-eaux, eval=FALSE} -station_eso <- station_eso |> - dplyr::mutate(code_sise_eaux = dplyr::if_else(code_sise_eaux == "", NA_character_, code_sise_eaux)) -``` - - -```{r update-codes-sise-eaux, eval=FALSE} -data_ars <- data_ars |> - sf::st_drop_geometry() - -# Réaliser une jointure attributaire -station_eso <- station_eso |> - dplyr::left_join(data_ars, by = c("code_station" = "code_bss")) |> - dplyr::mutate(code_sise_eaux = ifelse(is.na(code_sise_eaux), code_captage, code_sise_eaux)) |> - dplyr::select(-code_captage) # Supprime la colonne code_captage -``` - -Identification des doublons générés par la jointure de récupération des `code_sise_eaux` : -```{r get-station-duplicates-code-sise-eaux, eval=FALSE} -# Compter les occurrences de chaque code_station -doublons_stations_code_sise_eaux <- station_eso |> - dplyr::group_by(code_station) |> - dplyr::tally(name = "n") |> - dplyr::filter(n > 1) - -# Supprimer l'objet géométrique pour pouvoir exécuter la jointure attributaire - doublons_stations_code_sise_eaux <- doublons_stations_code_sise_eaux |> - sf::st_drop_geometry() - station_eso_sans_geom <- station_eso |> sf::st_drop_geometry() - -# Joindre les informations additionnelles -doublons_stations_code_sise_eaux <- doublons_stations_code_sise_eaux |> - dplyr::left_join(station_eso_sans_geom, by = "code_station") |> - dplyr::select(code_station, n, code_sise_eaux, libelle_station) - -# Visualiser les doublons -print(doublons_stations_code_sise_eaux) -``` - -Suppression des doublons : -```{r delete-station-duplicates-code-sise-eaux, eval=FALSE} -station_eso <- station_eso |> - dplyr::group_by(code_station, the_geom) |> dplyr::slice(1) |> dplyr::ungroup() + code_station %in% r_captage_prioritaire_r52$code_sise_eaux) ``` # Sélection des variables à conserver dans le dataframe final -```{r select-station-eso-variables, eval=FALSE} -station_eso <- station_eso |> +```{r select-station-esu-variables, eval=FALSE} +station_esu <- station_esu |> dplyr::select(code_station, - code_sise_eaux, libelle_station, date_creation, source, @@ -270,7 +234,7 @@ La version précédente de l'export est stockée dans un schéma d'archive : connexion <- datalibaba::connect_to_db(db = "si_eau") collectr::archive_table(connexion, database = "si_eau", - table_name = "station_eso", + table_name = "station_esu", schema = "stations", new_schema = "zz_archives") ``` @@ -278,7 +242,7 @@ collectr::archive_table(connexion, # Récupération des commentaires de la version précédente de la table ```{r get-comments-old-table, eval=FALSE} -station_eso_comments <- datalibaba::get_table_comments(table = "station_eso", +station_esu_comments <- datalibaba::get_table_comments(table = "station_esu", schema = "stations", db = "si_eau") |> dplyr::filter(!is.na(nom_col)) |> @@ -290,8 +254,8 @@ station_eso_comments <- datalibaba::get_table_comments(table = "station_eso", La table actualisée écrase la précédente version : ```{r publish-new-table, eval=FALSE} -datalibaba::poster_data(data = station_eso, - table = "station_eso", +datalibaba::poster_data(data = station_esu, + table = "station_esu", schema = "stations", db = "si_eau", pk = "code_station", @@ -303,8 +267,8 @@ datalibaba::poster_data(data = station_eso, ```{r publish-new-table-comment, eval=FALSE} date_today <- format(Sys.time(), format = "%d/%m/%Y") datalibaba::commenter_table( - comment = glue::glue("Table des stations de mesure des eaux de souterraines (source : Hub'eau + ARS, ", date_today, ")"), - table = "station_eso", + comment = glue::glue("Table des stations de mesure des eaux de surface (ESU) (source : Hub'eau + ARS, ", date_today, ")"), + table = "station_esu", schema = "stations", db = "si_eau" ) @@ -313,8 +277,8 @@ datalibaba::commenter_table( # Publication des commentaires des champs de la table actualisée ```{r publish-new-fields-comments, eval=FALSE} -datalibaba::post_dico_attr(dico = station_eso_comments, - table = "station_eso", +datalibaba::post_dico_attr(dico = station_esu_comments, + table = "station_esu", schema = "stations", db = "si_eau" ) @@ -324,6 +288,6 @@ datalibaba::post_dico_attr(dico = station_eso_comments, options(rmarkdown.html_vignette.check_title = FALSE) # Run but keep eval=FALSE to avoid infinite loop # Execute in the console directly -fusen::inflate(flat_file = "dev/flat_update_station_esU.Rmd", vignette_name = "Mise à jour des stations ESU") +fusen::inflate(flat_file = "dev/flat_update_station_esu.Rmd", vignette_name = "Mise à jour des stations ESU") ``` diff --git a/tests/testthat/test-create_hubeau_geom.R b/tests/testthat/test-create_hubeau_geom.R index 52119b713a4350c1a87623e41777f40712fec914..1605ba88c7b5cf31c4b4f12a03aa0d4cdbce7c08 100644 --- a/tests/testthat/test-create_hubeau_geom.R +++ b/tests/testthat/test-create_hubeau_geom.R @@ -1,5 +1,33 @@ # WARNING - Generated by {fusen} from dev/flat_functions.Rmd: do not edit by hand -test_that("my_fun works", { +# Définir une dataframe de test +hubeau_qualite_rivieres_station_pc <- data.frame( + geometry.coordinates1 = c(2.2945, 2.2955), + geometry.coordinates2 = c(48.8584, 48.8585), + geometry.type = c("Point", "Point"), + geometry.crs.type = c("name", "name"), + geometry.crs.properties.name = c("urn:ogc:def:crs:OGC:1.3:CRS84", "urn:ogc:def:crs:OGC:1.3:CRS84") +) +test_that("create_hubeau_geom works correctly", { + # Exécuter la fonction + hubeau_sf <- create_hubeau_geom(hubeau_qualite_rivieres_station_pc) + + # Vérifier que le résultat est un objet sf + expect_s3_class(hubeau_sf, "sf") + + # Vérifier que les colonnes sont correctement renommées + expect_true("geometry_type" %in% names(hubeau_sf)) + expect_true("geometry_crs_type" %in% names(hubeau_sf)) + expect_true("geometry_crs_properties_name" %in% names(hubeau_sf)) + expect_true("the_geom" %in% names(hubeau_sf)) + + # Vérifier que le SRID est correctement transformé + expect_equal(sf::st_crs(hubeau_sf)$epsg, 2154) + + # Vérifier que les coordonnées sont transformées (différentes des originales) + original_coords <- sf::st_as_sf(hubeau_qualite_rivieres_station_pc, + coords = c("geometry.coordinates1", "geometry.coordinates2"), + crs = sf::st_crs("urn:ogc:def:crs:OGC:1.3:CRS84")) + expect_false(all(sf::st_coordinates(original_coords) == sf::st_coordinates(hubeau_sf))) }) diff --git a/vignettes/mise-a-jour-des-captages-ars.Rmd b/vignettes/mise-a-jour-des-captages-ars.Rmd index 22bdeba497c28d17bff85829db52dccffb1189a3..b8254b294c15bb9cac0612a8dd0ebbf1db4a2a2c 100644 --- a/vignettes/mise-a-jour-des-captages-ars.Rmd +++ b/vignettes/mise-a-jour-des-captages-ars.Rmd @@ -20,6 +20,11 @@ library(data.captages) <!-- WARNING - This vignette is generated by {fusen} from dev/flat_update_captage.Rmd: do not edit by hand --> +# Objectif + +Actualiser **la table des captages de la région** (`captages.n_captage_p_r52`) à partir d'un tableur au format Excel transmis annuellement par l'ARS. + + # Chargement du lot de données L'export transmis par l'ARS est importé ainsi que la date du fichier (qui sera utilisée ultérieurement comme métadonnée) : @@ -37,6 +42,18 @@ last_modified_date <- format(file.info(file_path)$ctime,"%d/%m/%Y") # Lire le fichier Excel dans un dataframe data <- readxl::read_excel(file_path) + +# Vérifier le type de données dans la colonne "INS - Début d'usage - Date" +str(data) + +# Convertir la colonne "INS - Début d'usage - Date" en numérique +data <- data |> + mutate(`INS - Début d'usage - Date` = as.numeric(`INS - Début d'usage - Date`)) + +# Convertir les valeurs numériques en dates +data <- data |> + mutate(`INS - Début d'usage - Date` = as.Date(`INS - Début d'usage - Date`, origin = "1899-12-30")) + ``` # Renommage des champs @@ -81,8 +98,7 @@ table_de_passage_bss_000 <- datalibaba::importer_data( # Mise à jour du code BSS -Les anciens codes BSS de l'export transmis par l'ARS sont remplacés par les nouveaux codes -issus de la table de passage fournie par le BRGM lorsque la jointure est possible : +Les anciens codes BSS de l'export transmis par l'ARS sont remplacés par les nouveaux codes issus de la table de passage fournie par le BRGM lorsque la jointure est possible : ```{r update-code-bss, eval = FALSE} @@ -126,7 +142,6 @@ collectr::check_structure_table(connexion, Filtrage des enregistrements sans coordonnées valides (avec une valeur NA, 1 ou 3) : - ```{r rows-without-geom, eval = FALSE} # Créer un nouveau dataframe avec les lignes sans coordonnées valides captage_sans_geom <- captage_bss |> @@ -149,7 +164,6 @@ cat("Le fichier captage_sans_geom.csv a été enregistré avec succès.\n") Suppression des enregistrements sans coordonnées valides avant encodage : - ```{r create-geom, eval = FALSE} # Supprimer les lignes sans coordonnées du dataframe d'origine captage_with_xy <- captage_bss |> @@ -179,6 +193,7 @@ 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(connexion, + database = "si_eau", table_name = "n_captage_p_r52", schema = "captages", new_schema = "zz_archives") diff --git a/vignettes/mise-a-jour-des-captages-en-eau-potable.Rmd b/vignettes/mise-a-jour-des-captages-en-eau-potable.Rmd index a12c3766c58c10254c650e6a365177a1a04a7948..42dac77177f65c87fa6825aa732c6742a4bc090c 100644 --- a/vignettes/mise-a-jour-des-captages-en-eau-potable.Rmd +++ b/vignettes/mise-a-jour-des-captages-en-eau-potable.Rmd @@ -20,6 +20,11 @@ library(data.captages) <!-- WARNING - This vignette is generated by {fusen} from dev/flat_update_captage_ep.Rmd: do not edit by hand --> +# Objectif + +Actualiser **la table des captages en eau potable de la région** (`captages.n_captage_eau_potable_p_r52`) à partir de la table des captages de l'ARS (`captages.n_captage_p_r52`). + + # Chargement de la table des captages ```{r load-captage, eval = FALSE} @@ -30,6 +35,16 @@ n_captage_p_r52 <- datalibaba::importer_data(db = "si_eau", # Filtre sur les captages en eau potable +Les enregistrements correspondant aux valeurs suivantes pour les usages sont sélectionnés : + +- `AEP` : ADDUCTION COLLECTIVE PUBLIQUE +- `ALI` : ACTIVITE AGRO ALIMENTAIRE +- `CND` : EAU CONDITIONNEE +- `PRV` : ADDUCTION COLLECTIVE PRIVEE + +Source : table `captages.n_captage_usage_direct` + + ```{r filter-captage-ep, eval = FALSE} n_captage_eau_potable_p_r52 <- n_captage_p_r52 |> dplyr::filter(usage_captage %in% c('AEP', 'PRV', 'ALI', 'CND')) diff --git a/vignettes/mise-a-jour-des-stations-eau-souterraine--eso-.Rmd b/vignettes/mise-a-jour-des-stations-eso.Rmd similarity index 93% rename from vignettes/mise-a-jour-des-stations-eau-souterraine--eso-.Rmd rename to vignettes/mise-a-jour-des-stations-eso.Rmd index 7a66e6ea888750d0dd3e6a9a517a187b9121e1f7..3e88122e12ecf69b017794c2777378ecdc361ab2 100644 --- a/vignettes/mise-a-jour-des-stations-eau-souterraine--eso-.Rmd +++ b/vignettes/mise-a-jour-des-stations-eso.Rmd @@ -1,8 +1,8 @@ --- -title: "Mise à jour des stations eau souterraine (ESO)" +title: "Mise à jour des stations ESO" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{mise-a-jour-des-stations-eau-souterraine--eso-} + %\VignetteIndexEntry{mise-a-jour-des-stations-eso} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- @@ -20,18 +20,27 @@ library(data.captages) <!-- WARNING - This vignette is generated by {fusen} from dev/flat_update_station_eso.Rmd: do not edit by hand --> +# Objectif + +Actualiser les **stations de mesure eau de souterraine (ESO)** à partir des tables suivantes dans une base de données PostgreSQL : +- `qualite_nappes_eau_souterraine.hubeau_qualite_nappes_stations` (source : Hub'eau) +- `captages.n_captage_p_r52` (source : ARS) + + # Chargement des lot de données source -Stations de mesure des qualités des nappes d'eau souterraine (ESO): +## Stations de mesure des qualités des nappes d'eau souterraine (ESO) ```{r load-hubeau_qualite_nappes_stations, eval = FALSE} data_hubeau <- datalibaba::importer_data( table = "hubeau_qualite_nappes_stations", - schema = "stations", + schema = "qualite_nappes_eau_souterraine", db = "si_eau") ``` -Captages ARS ESO : +## Captages ARS ESO + +Chargement de la table des captages en filtrant sur la nature de l'eau du captage et le début du `code_bss` : ```{r load_captages_ars_eso, eval = FALSE} data_ars <- datalibaba::importer_data( @@ -47,7 +56,7 @@ Suppression des géométries vides : data_ars_with_geom = data_ars[!sf::st_is_empty(data_ars),,drop=FALSE] ``` -# Sélection des captages ARS différents de Hub'eau +Sélection des captages ARS différents de Hub'eau : ```{r select-captages-ars-not-hubeau, eval = FALSE} # Effectuer l'opération anti_join après avoir supprimé la géométrie @@ -218,6 +227,7 @@ station_eso <- station_eso |> ``` ```{r update-codes-sise-eaux, eval = FALSE} +# Supprimer l'objet géométrie du dataframe data_ars data_ars <- data_ars |> sf::st_drop_geometry() diff --git a/vignettes/mise-a-jour-des-stations-esu.Rmd b/vignettes/mise-a-jour-des-stations-esu.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..c43949cf368686db5fc75e306561559e948a23c9 --- /dev/null +++ b/vignettes/mise-a-jour-des-stations-esu.Rmd @@ -0,0 +1,306 @@ +--- +title: "Mise à jour des stations ESU" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{mise-a-jour-des-stations-esu} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(data.captages) +``` + +<!-- WARNING - This vignette is generated by {fusen} from dev/flat_update_station_esu.Rmd: do not edit by hand --> + +# Objectif + +Actualiser les **stations de mesure eau de surface (ESU)** à partir des tables suivantes dans une base de données PostgreSQL : +- `qualite_cours_d_eau.hubeau_qualite_rivieres_station_pc` (source : Hub'eau) +- `captages.n_captage_p_r52` (source : ARS) + + +# Chargement des lot de données source + +Stations de mesures physicochimique sur des cours d'eau et plan d'eau (ESU) : + +```{r load-hubeau_qualite_rivieres_station_pc, eval = FALSE} +data_hubeau <- datalibaba::importer_data( + table = "hubeau_qualite_rivieres_station_pc", + schema = "qualite_cours_d_eau", + db = "si_eau") +``` + +Captages ARS ESU : + +```{r load_captages_ars_eso, eval = FALSE} +data_ars <- datalibaba::importer_data( + table = "n_captage_p_r52", + schema = "captages", + db = "si_eau") |> + dplyr::filter(nature_eau_captage == 'ESU') +``` + +Suppression 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 de Hub'eau + +```{r select-captages-ars-not-hubeau, eval = FALSE} +# Effectuer l'opération anti_join après avoir supprimé la géométrie +data_ars_not_hubeau <- data_ars_with_geom |> + sf::st_drop_geometry() |> + dplyr::anti_join(data_hubeau, by = c("code_captage" = "code_station")) + +# Récupérer les géométries par jointure avec stations_esu_ars +data_ars_not_hubeau <- data_ars_not_hubeau |> + dplyr::left_join(data_ars, by = "code_captage") + +# Désélectionner toutes les variables finissant par .y dans la jointure +data_ars_not_hubeau <- dplyr::select(data_ars_not_hubeau, + -ends_with(".y")) + +# Renommer toutes les variables en supprimant le suffixe .x +names(data_ars_not_hubeau) <- gsub("\\.x$", "", + names(data_ars_not_hubeau)) +``` + +# Consolidation des stations Hub'eau + +Renommage des variables, ajout du code SISE-Eaux et de la source, sélection des variables : + +```{r consolidate-stations_hubeau, eval = FALSE} +stations_esu_hubeau <- data_hubeau |> + dplyr::mutate(source = "HUBEAU") |> + dplyr::select(code_station, + libelle_station, + date_creation, + source, + code_masse_eau = code_masse_deau, + code_eu_masse_eau = code_eu_masse_deau, + code_commune, + the_geom) + +# Convertir les dates de la variable date_creation +stations_esu_hubeau$date_creation <- as.Date(stations_esu_hubeau$date_creation) +``` + +# Consolidation des stations ARS + +Renommage des variables, ajout de la source, sélection des variables : + +```{r consolidate-stations_ars, eval = FALSE} +stations_esu_ars <- data_ars_not_hubeau |> + dplyr::rename(code_station = code_captage, + libelle_station = nom_captage, + date_creation = date_etat_installation, + code_commune = code_commune_captage) |> + dplyr::mutate(source = "ARS") |> + dplyr::select(code_station,libelle_station,date_creation, + source,code_commune,the_geom) +``` + +# Fusion des deux dataframes + +```{r merge-stations, eval = FALSE} +station_esu <- dplyr::bind_rows(stations_esu_hubeau, stations_esu_ars) +``` + +# Ajout du `code_sage` par station + +Chargement de la table des SAGE en Pays de la Loire : + +```{r load-sage, eval = FALSE} +n_sage_r52 <- datalibaba::importer_data( + table = "n_sage_r52", + schema = "zonages_de_gestion", + db = "si_eau" +) +``` + +Requête spatiale pour la jointure du `code_sage` dans `station_esu` : + +```{r update-code-sage, eval = FALSE} +# Réaliser une jointure spatiale +station_esu <- station_esu |> + 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 : + +```{r get-station-duplicates-code_sage, eval = FALSE} +# Compter les occurrences de chaque code_station +doublons_stations_code_sage <- station_esu |> + dplyr::group_by(code_station) |> + dplyr::tally(name = "n") |> + dplyr::filter(n > 1) + +# Supprimer l'objet géométrique pour pouvoir exécuter la jointure attributaire +doublons_stations_code_sage <- doublons_stations_code_sage |> + sf::st_drop_geometry() + +# Joindre les informations additionnelles +doublons_stations_code_sage <- doublons_stations_code_sage |> + dplyr::left_join(station_esu, by = "code_station") |> + dplyr::left_join(n_sage_r52, by = c("code_sage" = "code")) |> + dplyr::select(code_station, n, libelle_station, code_sage, nom, the_geom.x) + +# Visualiser les doublons +print(doublons_stations_code_sage) +``` + +Suppression des doublons : + +```{r delete-station-duplicates-code-sage, eval = FALSE} +station_esu <- station_esu |> + dplyr::group_by(code_station, the_geom) |> dplyr::slice(1) |> dplyr::ungroup() +``` + +Ajout de la valeur `SAGE00000` si la valeur de `code_sage` est NA : + +```{r replace-code-sage-na, eval = FALSE} +station_esu <- station_esu |> + dplyr::mutate(code_sage = tidyr::replace_na(code_sage, "SAGE00000")) +``` + +# Ajout des champs `code_bassin_versant`, `code_masse_eau`, `code_eu_masse_eau` par station + +Chargement de la table des bassins versants du bassin Loire-Bretagne : + +```{r load-bassin-versant, eval = FALSE} +n_bassin_versant_specifique_loire_bretagne <- datalibaba::importer_data( + table = "n_bassin_versant_specifique_loire_bretagne", + schema = "sandre", + db = "si_eau" +) +``` + +Requête spatiale pour la jointure des champs `code_bassin_versant`, `code_masse_eau`, `code_eu_masse_eau` dans `station_esu` : + +```{r update-codes-bassin-versant-masse-eau, eval = FALSE} +# Réaliser une jointure spatiale +station_esu <- station_esu |> + sf::st_join(n_bassin_versant_specifique_loire_bretagne |> + dplyr::select(code_bassin_versant = code_bassin_versant_specifique, + code_masse_eau, + code_eu_masse_eau), + join = sf::st_within, left = TRUE) +``` + +Fusion des variables pour conserver un maximum de valeurs : + +```{r merge-variables, eval = FALSE} +# Fusionner les variables code_masse_eau.x et code_masse_eau.y, code_eu_masse_eau.x et code_eu_masse_eau.y +station_esu <- station_esu |> + mutate(code_masse_eau = coalesce(code_masse_eau.x, code_masse_eau.y), + code_eu_masse_eau = coalesce(code_eu_masse_eau.x, code_eu_masse_eau.y)) |> + select(-code_masse_eau.x, -code_masse_eau.y, -code_eu_masse_eau.x, -code_eu_masse_eau.y) # Supprimer les colonnes inutiles +``` + +# Ajout du `captage_prioriaire` par station + +Chargement de la table des captages prioritaires de la région : + +```{r load-captage-prioritaire, eval = FALSE} +r_captage_prioritaire_r52 <- datalibaba::importer_data( + table = "r_captage_prioritaire_r52", + schema = "captages", + db = "si_eau" +) +``` + +Ajout de la variable captage_prioritaire + +```{r update-captage-prioriaire, eval = FALSE} +# Alimenter la variable en vérifiant la présence du `code_station` dans `r_captage_prioritaire_r52` +station_esu <- station_esu |> + dplyr::mutate(captage_prioritaire = + code_station %in% r_captage_prioritaire_r52$code_sise_eaux) +``` + +# Sélection des variables à conserver dans le dataframe final + +```{r select-station-esu-variables, eval = FALSE} +station_esu <- station_esu |> + dplyr::select(code_station, + libelle_station, + date_creation, + source, + code_masse_eau, + code_eu_masse_eau, + code_commune, + code_sage, + code_bassin_versant, + captage_prioritaire, + the_geom) +``` + +# 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} +connexion <- datalibaba::connect_to_db(db = "si_eau") +collectr::archive_table(connexion, + database = "si_eau", + table_name = "station_esu", + schema = "stations", + new_schema = "zz_archives") +``` + +# Récupération des commentaires de la version précédente de la table + +```{r get-comments-old-table, eval = FALSE} +station_esu_comments <- datalibaba::get_table_comments(table = "station_esu", + schema = "stations", + db = "si_eau") |> + dplyr::filter(!is.na(nom_col)) |> + dplyr::select(nom_col, commentaire) |> + dplyr::arrange(nom_col) +``` + +# Publication de la table actualisée + +La table actualisée écrase la précédente version : + +```{r publish-new-table, eval = FALSE} +datalibaba::poster_data(data = station_esu, + table = "station_esu", + schema = "stations", + db = "si_eau", + pk = "code_station", + overwrite = TRUE) +``` + +# Publication de la description de la table actualisée + +```{r publish-new-table-comment, eval = FALSE} +date_today <- format(Sys.time(), format = "%d/%m/%Y") +datalibaba::commenter_table( + comment = glue::glue("Table des stations de mesure des eaux de surface (ESU) (source : Hub'eau + ARS, ", date_today, ")"), + table = "station_esu", + schema = "stations", + db = "si_eau" +) +``` + +# Publication des commentaires des champs de la table actualisée + +```{r publish-new-fields-comments, eval = FALSE} +datalibaba::post_dico_attr(dico = station_esu_comments, + table = "station_esu", + schema = "stations", + db = "si_eau" +) +``` + diff --git a/vignettes/mise-a-jour-des-stations-hub-eau-eau-de-surface--esu-.Rmd b/vignettes/mise-a-jour-des-stations-hub-eau-cours-d-eau-et-plan-d-eau.Rmd similarity index 83% rename from vignettes/mise-a-jour-des-stations-hub-eau-eau-de-surface--esu-.Rmd rename to vignettes/mise-a-jour-des-stations-hub-eau-cours-d-eau-et-plan-d-eau.Rmd index 48570a9101a1da739d8e69fc3088f446ad67f67f..1b3a94a774cc583f8ab96e72582c8d97684d2924 100644 --- a/vignettes/mise-a-jour-des-stations-hub-eau-eau-de-surface--esu-.Rmd +++ b/vignettes/mise-a-jour-des-stations-hub-eau-cours-d-eau-et-plan-d-eau.Rmd @@ -1,8 +1,8 @@ --- -title: "Mise à jour des stations Hub'eau eau de surface (ESU)" +title: "Mise à jour des stations Hub'eau cours d'eau et plan d'eau" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{mise-a-jour-des-stations-hub-eau-eau-de-surface--esu-} + %\VignetteIndexEntry{mise-a-jour-des-stations-hub-eau-cours-d-eau-et-plan-d-eau} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- @@ -22,7 +22,7 @@ library(data.captages) # Objectif -Actualiser les **stations de mesures physicochimique sur des cours d'eau et plan d'eau (eau de surface : ESU)** à partir de l'[API Hub'eau "Qualité des cours d'eau"](https://hubeau.eaufrance.fr/page/api-qualite-cours-deau) dans une base de données PostgreSQL. +Actualiser les **stations de mesures physicochimique sur des cours d'eau et plan d'eau** à partir de l'[API Hub'eau "Qualité des cours d'eau"](https://hubeau.eaufrance.fr/page/api-qualite-cours-deau) dans une base de données PostgreSQL. # Récupération des données @@ -36,24 +36,27 @@ hubeau_qualite_rivieres_station_pc <- hubeau::get_qualite_rivieres_station_pc(co # Création d'un champs de géométrie ```{r create-the-geom, eval = FALSE} -# Convertir le dataframe en objet sf -hubeau_sf <- sf::st_as_sf(hubeau_qualite_rivieres_station_pc, - coords = c("geometry.coordinates1", "geometry.coordinates2"), - crs = sf::st_crs("urn:ogc:def:crs:OGC:1.3:CRS84")) +# Création de la géométrie +hubeau_sf <- create_hubeau_geom(hubeau_qualite_rivieres_station_pc) ``` -```{r add-the_geom, eval = FALSE} -# Renommer la colonne geometry en the_geom -hubeau_sf <- hubeau_sf |> dplyr::rename( - geometry_type = geometry.type, - geometry_crs_type = geometry.crs.type, - geometry_crs_properties_name = geometry.crs.properties.name, - the_geom = geometry) -``` - -```{r set-srid, eval = FALSE} -# Changer le SRID de the_geom à 2154 (EPSG:2154) -hubeau_sf <- sf::st_transform(hubeau_sf, 2154) +# Remplacement des caractères accentués impactés par un problème d'encodage + +Dans la variable `libelle_station` : + +```{r replace-encoding-problems, eval = FALSE} +# Remplacer <e0> par À dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<e0>", "À", hubeau_sf$libelle_station) +# Remplacer <e0> par À dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<c0>", "À", hubeau_sf$libelle_station) +# Remplacer <c8> par È dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<c8>", "È", hubeau_sf$libelle_station) +# Remplacer <c8> par È dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<c9>", "É", hubeau_sf$libelle_station) +# Remplacer <c8> par È dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<c2>", "Â", hubeau_sf$libelle_station) +# Remplacer <c8> par È dans la colonne libelle_station +hubeau_sf$libelle_station <- gsub("<d4>", "Ô", hubeau_sf$libelle_station) ``` # Archivage de la version précédente de la table diff --git a/vignettes/mise-a-jour-des-stations-hub-eau-eau-souterraine--eso-.Rmd b/vignettes/mise-a-jour-des-stations-hub-eau-nappes-d-eau-souterraine.Rmd similarity index 92% rename from vignettes/mise-a-jour-des-stations-hub-eau-eau-souterraine--eso-.Rmd rename to vignettes/mise-a-jour-des-stations-hub-eau-nappes-d-eau-souterraine.Rmd index 422ddb82bfd31c450c81e4349ec872db6f959f84..cdd8d75221d03ec4633582354f82856b9073a006 100644 --- a/vignettes/mise-a-jour-des-stations-hub-eau-eau-souterraine--eso-.Rmd +++ b/vignettes/mise-a-jour-des-stations-hub-eau-nappes-d-eau-souterraine.Rmd @@ -1,8 +1,8 @@ --- -title: "Mise à jour des stations Hub'eau eau souterraine (ESO)" +title: "Mise à jour des stations Hub'eau nappes d'eau souterraine" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{mise-a-jour-des-stations-hub-eau-eau-souterraine--eso-} + %\VignetteIndexEntry{mise-a-jour-des-stations-hub-eau-nappes-d-eau-souterraine} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- @@ -36,24 +36,8 @@ hubeau_qualite_nappes_stations <- hubeau::get_qualite_nappes_stations(num_depart # Création d'un champs de géométrie ```{r create-the-geom, eval = FALSE} -# Convertir le dataframe en objet sf -hubeau_sf <- sf::st_as_sf(hubeau_qualite_nappes_stations, - coords = c("geometry.coordinates1", "geometry.coordinates2"), - crs = sf::st_crs("urn:ogc:def:crs:OGC:1.3:CRS84")) -``` - -```{r add-the_geom, eval = FALSE} -# Renommer la colonne geometry en the_geom -hubeau_sf <- hubeau_sf |> dplyr::rename( - geometry_type = geometry.type, - geometry_crs_type = geometry.crs.type, - geometry_crs_properties_name = geometry.crs.properties.name, - the_geom = geometry) -``` - -```{r set-srid, eval = FALSE} -# Changer le SRID de the_geom à 2154 (EPSG:2154) -hubeau_sf <- sf::st_transform(hubeau_sf, 2154) +# Création de la géométrie +hubeau_sf <- create_hubeau_geom(hubeau_qualite_nappes_stations) ``` # Publication de la table actualisée