From 342b9aabecc635a0759e847ebca06eb41a5c8668 Mon Sep 17 00:00:00 2001 From: Juliette Engelaere-Lefebvre <juliette.engelaere@developpement-durable.gouv.fr> Date: Wed, 19 Jun 2024 13:54:57 +0200 Subject: [PATCH] suppression des scripts devenus inutiles --- data-raw/chargement_filocom.R | 365 ------------- data-raw/zz_agriculture_bio.R | 185 ------- ...zz_captage_prioritaire_protection_action.R | 500 ------------------ data-raw/zz_chargement_ocsge_auran.R | 312 ----------- data-raw/zz_cogification_ocsge_auran.R | 33 -- data-raw/zz_couverture_sage.R | 466 ---------------- data-raw/zz_etat_ecolo_cours_eau.R | 286 ---------- data-raw/zz_gestion_durable_foret.R | 186 ------- ...ur_captage_prioritaire_protection_action.R | 178 ------- data-raw/zz_ocsge_comparaison_auran_ddtm85.R | 212 -------- data-raw/zz_protection_naturelle.R | 349 ------------ data-raw/zz_secret_filocom.R | 203 ------- 12 files changed, 3275 deletions(-) delete mode 100644 data-raw/chargement_filocom.R delete mode 100644 data-raw/zz_agriculture_bio.R delete mode 100644 data-raw/zz_captage_prioritaire_protection_action.R delete mode 100644 data-raw/zz_chargement_ocsge_auran.R delete mode 100644 data-raw/zz_cogification_ocsge_auran.R delete mode 100644 data-raw/zz_couverture_sage.R delete mode 100644 data-raw/zz_etat_ecolo_cours_eau.R delete mode 100644 data-raw/zz_gestion_durable_foret.R delete mode 100644 data-raw/zz_indicateur_captage_prioritaire_protection_action.R delete mode 100644 data-raw/zz_ocsge_comparaison_auran_ddtm85.R delete mode 100644 data-raw/zz_protection_naturelle.R delete mode 100644 data-raw/zz_secret_filocom.R diff --git a/data-raw/chargement_filocom.R b/data-raw/chargement_filocom.R deleted file mode 100644 index 5ebb624..0000000 --- a/data-raw/chargement_filocom.R +++ /dev/null @@ -1,365 +0,0 @@ - -# chargement_filocom - -# librairies ------------- -library(tidyverse) -library(readxl) -library(DT) -library(tricky) -library(lubridate) -library(DBI) -library(RPostgreSQL) - -rm(list = ls()) - - -# millesimes à importer ---------- -millesimes <- c(2009,2011,2013,2015,2017) - - -# fonction ----------- -creer_millesimes<-function(millesimes){ - - #chargement des fichiers - Rapport1 <- read_excel(paste0("extdata/gk3_Filocom_regional_1_",millesimes,".xlsx"),sheet=1) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - gather(variable,valeur,nb_total_logements:revenu_brut_total) %>% - select(depcom,date,variable,valeur) - men1 <- read_excel(paste0("extdata/gk3_Filocom_regional_1_",millesimes,".xlsx"),sheet=2) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_menages_pourcent_de_revenus_plaf_hlm",pourcent_de_revenus_plaf_hlm_tranche_)) %>% - rename("valeur"="nb_total_de_menages_fiscaux") %>% - select(depcom,date,variable,valeur) - men2 <- read_excel(paste0("extdata/gk3_Filocom_regional_1_",millesimes,".xlsx"),sheet=3) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_menages_imposition_foyer_fiscal_principal",imposition_foyer_fiscal_principal)) %>% - rename("valeur"="nb_total_de_menages_fiscaux") %>% - select(depcom,date,variable,valeur) - log2_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_2_52_",millesimes,".xlsx"),sheet=1) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,type_de_logement)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log3_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_2_52_",millesimes,".xlsx"),sheet=2) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,"duree_occup_ou_vacance",duree_occup_ou_vacance_tranche_)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log4_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_2_52_",millesimes,".xlsx"),sheet=3) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,classement_cadastral)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log5_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_2_52_",millesimes,".xlsx"),sheet=4) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,"propriétaire",code_type_proprietaire)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log8_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_2_52_",millesimes,".xlsx"),sheet=5) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",type_de_logement)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log9_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_2_52_",millesimes,".xlsx"),sheet=6) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_mode_occupation",mode_occupation)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log10_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_2_52_",millesimes,".xlsx"),sheet=7) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_propriétaire",code_type_proprietaire)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - - log2_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_2_hr_",millesimes,".xlsx"),sheet=1) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,type_de_logement)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log3_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_2_hr_",millesimes,".xlsx"),sheet=2) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,"duree_occup_ou_vacance",duree_occup_ou_vacance_tranche_)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log4_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_2_hr_",millesimes,".xlsx"),sheet=3) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,classement_cadastral)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log5_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_2_hr_",millesimes,".xlsx"),sheet=4) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,"propriétaire",code_type_proprietaire)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log8_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_2_hr_",millesimes,".xlsx"),sheet=5) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",type_de_logement)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log9_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_2_hr_",millesimes,".xlsx"),sheet=6) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_mode_occupation",mode_occupation)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log10_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_2_hr_",millesimes,".xlsx"),sheet=7) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_propriétaire",code_type_proprietaire)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - - log1_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_3_52_",millesimes,".xlsx"),sheet=1) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,"construits",annee_de_construction_tranche_)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log6_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_3_52_",millesimes,".xlsx"),sheet=2) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_occupation",statut_occupation,nb_de_pieces)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log7_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_3_52_",millesimes,".xlsx"),sheet=3) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_occupation",statut_occupation,"construits",annee_de_construction_tranche_)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log11_52 <- read_excel(paste0("extdata/gk3_Filocom_regional_3_52_",millesimes,".xlsx"),sheet=4) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_construits",annee_de_construction_tranche_)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log1_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_3_hr_",millesimes,".xlsx"),sheet=1) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts",mode_occupation,"construits",annee_de_construction_tranche_)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log6_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_3_hr_",millesimes,".xlsx"),sheet=2) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_occupation",statut_occupation,nb_de_pieces)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log7_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_3_hr_",millesimes,".xlsx"),sheet=3) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_occupation",statut_occupation,"construits",annee_de_construction_tranche_)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - log11_hr <- read_excel(paste0("extdata/gk3_Filocom_regional_3_hr_",millesimes,".xlsx"),sheet=4) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_lgts_construits",annee_de_construction_tranche_)) %>% - rename("valeur"="nb_total_logements") %>% - select(depcom,date,variable,valeur) - rp1 <- read_excel(paste0("extdata/gk3_Filocom_regional_4_",millesimes,".xlsx"),sheet=1) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_res_principales_statut_occupation",statut_occupation)) %>% - rename("valeur"="nb_total_de_residences_principales") %>% - select(depcom,date,variable,valeur) - rp2 <- read_excel(paste0("extdata/gk3_Filocom_regional_4_",millesimes,".xlsx"),sheet=2) %>% - set_standard_names() %>% - rename(date = annee, - depcom = code_de_la_commune) %>% - mutate(variable=paste("nb_res_principales_de",nb_de_pieces)) %>% - rename("valeur"="nb_total_de_residences_principales") %>% - select(depcom,date,variable,valeur) - - filocom <- bind_rows(Rapport1,men1,men2,log8_52,log8_hr,log9_52,log9_hr,log2_52,log2_hr,log3_52,log3_hr,log4_52,log4_hr,rp1,log10_52,log10_hr,log5_52,log5_hr,log11_52, - log11_hr,log1_52,log1_hr,log7_52,log7_hr,rp2,log6_52,log6_hr) - rm(Rapport1,men1,men2,log8_52,log8_hr,log9_52,log9_hr,log2_52,log2_hr,log3_52,log3_hr,log4_52,log4_hr,rp1,log10_52,log10_hr,log5_52,log5_hr,log11_52, - log11_hr,log1_52,log1_hr,log7_52,log7_hr,rp2,log6_52,log6_hr) - - return(filocom) -} - -# calcul ------------ -filocom<-map_dfr(millesimes,~creer_millesimes(.x)) - -filocom <- filocom %>% - complete(depcom,date,variable,fill = list(valeur =0)) %>% - group_by(depcom,date,variable) %>% - summarise(valeur=sum(valeur,na.rm = TRUE)) %>% - spread(key = variable, value= valeur)%>% - set_standard_names() %>% - #ajout de nouvelles variables (regroupements) - mutate(nb_menages_pourcent_de_revenus_plaf_hlm_inferieur_60=nb_menages_pourcent_de_revenus_plaf_hlm_1_inferieur_ou_egal_a_30_+nb_menages_pourcent_de_revenus_plaf_hlm_2_de_30_a_60_inclus, - nb_menages_pourcent_de_revenus_plaf_hlm_sup_130=nb_menages_pourcent_de_revenus_plaf_hlm_5_de_130_a_150_inclus+nb_menages_pourcent_de_revenus_plaf_hlm_6_superieur_a_150_, - nb_menages_pourcent_de_revenus_plaf_hlm_non_rens_ou_sans_signification=nb_menages_pourcent_de_revenus_plaf_hlm_7_non_renseigne+nb_menages_pourcent_de_revenus_plaf_hlm_8_sans_signification, - nb_lgts_logements_vacants_duree_vacance_plus_3_ans=`nb_lgts_logements_vacants_duree_occup_ou_vacance_4_de_3_a_<_4_ans`+`nb_lgts_logements_vacants_duree_occup_ou_vacance_5_de_4_a_<_10_ans`+nb_lgts_logements_vacants_duree_occup_ou_vacance_6_10_ans_ou_plus, - nb_lgts_construits_avant_1949=nb_lgts_construits_1_avant_1915+nb_lgts_construits_2_de_1915_a_1948, - nb_lgts_construits_de_1949_a_1974=nb_lgts_construits_3_de_1949_a_1967+nb_lgts_construits_4_de_1968_a_1974, - nb_lgts_construits_de_1975_a_1989=nb_lgts_construits_5_de_1975_a_1981+nb_lgts_construits_6_de_1982_a_1989, - nb_lgts_residences_principales_construits_1949=nb_lgts_residences_principales_construits_1_avant_1915+nb_lgts_residences_principales_construits_2_de_1915_a_1948, - nb_lgts_residences_principales_construits_de_1949_a_1974=nb_lgts_residences_principales_construits_3_de_1949_a_1967+nb_lgts_residences_principales_construits_4_de_1968_a_1974, - nb_lgts_residences_principales_construits_de_1975_a_1989=nb_lgts_residences_principales_construits_5_de_1975_a_1981+nb_lgts_residences_principales_construits_6_de_1982_a_1989, - nb_lgts_logements_vacants_construits_avant_1949=nb_lgts_logements_vacants_construits_1_avant_1915+nb_lgts_logements_vacants_construits_2_de_1915_a_1948, - nb_lgts_logements_vacants_construits_de_1949_a_1974=nb_lgts_logements_vacants_construits_3_de_1949_a_1967+nb_lgts_logements_vacants_construits_4_de_1968_a_1974, - nb_lgts_logements_vacants_construits_de_1975_a_1989=nb_lgts_logements_vacants_construits_5_de_1975_a_1981, #+nb_lgts_logements_vacants_construits_6_de_1982_a_1989, - nb_lgts_occupation_proprietaire_occupant_construits_avant_1948=nb_lgts_occupation_proprietaire_occupant_construits_1_avant_1915+nb_lgts_occupation_proprietaire_occupant_construits_2_de_1915_a_1948, - nb_lgts_occupation_proprietaire_occupant_construits_de_1949_a_1974=nb_lgts_occupation_proprietaire_occupant_construits_3_de_1949_a_1967+nb_lgts_occupation_proprietaire_occupant_construits_4_de_1968_a_1974, - nb_lgts_occupation_proprietaire_occupant_construits_de_1975_a_1989=nb_lgts_occupation_proprietaire_occupant_construits_5_de_1975_a_1981+nb_lgts_occupation_proprietaire_occupant_construits_6_de_1982_a_1989, - nb_lgts_occupation_locatif_prive_construits_1_avant_1948=nb_lgts_occupation_locatif_prive_construits_1_avant_1915+nb_lgts_occupation_locatif_prive_construits_2_de_1915_a_1948, - nb_lgts_occupation_locatif_prive_construits_de_1949_a_1974=nb_lgts_occupation_locatif_prive_construits_3_de_1949_a_1967+nb_lgts_occupation_locatif_prive_construits_4_de_1968_a_1974, - nb_lgts_occupation_locatif_prive_construits_5_de_1975_a_1989=nb_lgts_occupation_locatif_prive_construits_5_de_1975_a_1981+nb_lgts_occupation_locatif_prive_construits_6_de_1982_a_1989 - ) %>% - select(depcom, date, - nb_total_de_menages_fiscaux, - nb_men_fisc_avec_revenu_brut_rens, - revenu_brut_total, - nb_menages_pourcent_de_revenus_plaf_hlm_inferieur_60, - nb_menages_pourcent_de_revenus_plaf_hlm_3_de_60_a_100_inclus, - nb_menages_pourcent_de_revenus_plaf_hlm_4_de_100_a_130_inclus, - nb_menages_pourcent_de_revenus_plaf_hlm_sup_130, - nb_menages_pourcent_de_revenus_plaf_hlm_non_rens_ou_sans_signification, - nb_menages_imposition_foyer_fiscal_principal_2_occupant_principal_non_imposable, - - nb_total_logements, - nb_lgts_collectif, - nb_lgts_individuel, - nb_lgts_mode_occupation_residences_principales, - nb_lgts_mode_occupation_residences_secondaires, - nb_lgts_mode_occupation_logements_vacants, - nb_lgts_logements_vacants_individuel, - nb_lgts_logements_vacants_collectif, - nb_lgts_logements_vacants_duree_vacance_plus_3_ans, - nb_lgts_logements_vacants_classement_cadastral_7_ou_8, - nb_lgts_residences_principales_classement_cadastral_7_ou_8, - nb_lgts_residences_principales_collectif, - nb_lgts_residences_principales_individuel, - nb_lgts_residences_principales_non_renseigne, - nb_res_principales_statut_occupation_proprietaire_occupant, - nb_res_principales_statut_occupation_autres, - nb_res_principales_statut_occupation_locatif_collectiv_territ, - nb_res_principales_statut_occupation_locatif_hlm_sem, - nb_res_principales_statut_occupation_locatif_prive, - nb_res_principales_statut_occupation_sans_signification, - nb_lgts_proprietaire_personne_physique, - nb_lgts_proprietaire_hlm_sem, - nb_lgts_proprietaire_collectivite_ter_, - nb_lgts_proprietaire_autres_pm, - nb_lgts_logements_vacants_proprietaire_personne_physique, - nb_lgts_logements_vacants_proprietaire_hlm_sem, - nb_lgts_logements_vacants_proprietaire_collectivite_ter_, - nb_lgts_logements_vacants_proprietaire_autres_pm, - nb_lgts_construits_avant_1949, - nb_lgts_construits_de_1949_a_1974, - nb_lgts_construits_de_1975_a_1989, - nb_lgts_construits_7_de_1990_a_1999, - nb_lgts_construits_8_apres_2000, - nb_lgts_construits_9_non_renseigne, - nb_lgts_residences_principales_construits_1949, - nb_lgts_residences_principales_construits_de_1949_a_1974, - nb_lgts_residences_principales_construits_de_1975_a_1989, - nb_lgts_residences_principales_construits_7_de_1990_a_1999, - nb_lgts_residences_principales_construits_8_apres_2000, - nb_lgts_residences_principales_construits_9_non_renseigne, - nb_lgts_logements_vacants_construits_avant_1949, - nb_lgts_logements_vacants_construits_de_1949_a_1974, - nb_lgts_logements_vacants_construits_de_1975_a_1989, - nb_lgts_logements_vacants_construits_7_de_1990_a_1999, - nb_lgts_logements_vacants_construits_8_apres_2000, - nb_lgts_logements_vacants_construits_9_non_renseigne, - nb_lgts_occupation_proprietaire_occupant_construits_avant_1948, - nb_lgts_occupation_proprietaire_occupant_construits_de_1949_a_1974, - nb_lgts_occupation_proprietaire_occupant_construits_de_1975_a_1989, - nb_lgts_occupation_proprietaire_occupant_construits_7_de_1990_a_1999, - nb_lgts_occupation_proprietaire_occupant_construits_8_apres_2000, - nb_lgts_occupation_proprietaire_occupant_construits_9_non_renseigne, - nb_lgts_occupation_locatif_prive_construits_1_avant_1948, - nb_lgts_occupation_locatif_prive_construits_de_1949_a_1974, - nb_lgts_occupation_locatif_prive_construits_5_de_1975_a_1989, - nb_lgts_occupation_locatif_prive_construits_7_de_1990_a_1999, - nb_lgts_occupation_locatif_prive_construits_8_apres_2000, - nb_lgts_occupation_locatif_prive_construits_9_non_renseigne, - nb_res_principales_de_1_piece, - nb_res_principales_de_2_pieces, - nb_res_principales_de_3_pieces, - nb_res_principales_de_4_pieces, - nb_res_principales_de_5_pieces, - nb_res_principales_de_6_pieces_ou_plus, - nb_lgts_occupation_proprietaire_occupant_1_piece, - nb_lgts_occupation_proprietaire_occupant_2_pieces, - nb_lgts_occupation_proprietaire_occupant_3_pieces, - nb_lgts_occupation_proprietaire_occupant_4_pieces, - nb_lgts_occupation_proprietaire_occupant_5_pieces, - nb_lgts_occupation_proprietaire_occupant_6_pieces_ou_plus, - nb_lgts_occupation_locatif_prive_1_piece, - nb_lgts_occupation_locatif_prive_2_pieces, - nb_lgts_occupation_locatif_prive_3_pieces, - nb_lgts_occupation_locatif_prive_4_pieces, - nb_lgts_occupation_locatif_prive_5_pieces, - nb_lgts_occupation_locatif_prive_6_pieces_ou_plus, - ) %>% - gather(variable,valeur,3:87) %>% - ungroup() %>% - filter(date>=2008) %>% - mutate(date=make_date(date,12,31)) %>% - mutate_if(is.character,as.factor) %>% - complete(depcom,date,variable,fill = list(valeur =0)) %>% - pivot_wider(names_from = variable,values_from = valeur) - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -drv <- dbDriver("PostgreSQL") -con_datamart <- dbConnect(drv, - dbname="datamart", - host=Sys.getenv("server"), - port=Sys.getenv("port"), - user=Sys.getenv("userid"), - password=Sys.getenv("pwd_does")) -postgresqlpqExec(con_datamart, "SET client_encoding = 'windows-1252'") - -dbWriteTable(con_datamart, c("portrait_territoires","source_filocom"), - filocom, row.names=FALSE, overwrite=TRUE) - -dbDisconnect(con_datamart) - -rm(list=ls()) diff --git a/data-raw/zz_agriculture_bio.R b/data-raw/zz_agriculture_bio.R deleted file mode 100644 index 0666a86..0000000 --- a/data-raw/zz_agriculture_bio.R +++ /dev/null @@ -1,185 +0,0 @@ - -# specifique_agriculture_bio est devenu zz_agriculture_bio depuis le 24/06/2022 pour être archivé - -# indicateur du CRTE - -# le site de l'Agence Bio permet de télécharger des données à l'EPCI de 2010 jusqu'à l'année n-2, -# en l'occurrence 2019 - -# librairies ------ -library(readxl) -library(tidyverse) -library(lubridate) -library(COGiter) -library(datalibaba) -library(googlesheets4) - - -# chargement des données et calcul ------------ -download.file(url = "https://www.agencebio.org/wp-content/uploads/2020/07/Donnees_EPCI_AgenceBio_2019.xlsx", - destfile = "extdata/Donnees_EPCI_AgenceBio_2019.xlsx") - -agri_bio_EPCI_2010_2019<-read_excel(path = "extdata/Donnees_EPCI_AgenceBio_2019.xlsx",sheet="PV_Evolution", - col_types = c("numeric","text","text","text", - "numeric","numeric","numeric","numeric","numeric","numeric","numeric") - ) %>% - filter(groupe_code=="ALL") %>% - select(-groupe_code,-groupe_libelle) %>% - rename(nb_exploitation_engagee_bio = nb_exp, - surface_terme_conversion_bio = SurfAB, - surface_conversion_1e_annee_bio = SurfC1, - surface_conversion_2e_annee_bio = SurfC2, - surface_conversion_3e_annee_bio = SurfC3, - surface_totale_conversion_bio = SurfC123, - surface_totale_engagee_bio = SurfBio) %>% - gather(key = "variable",value = "valeur",nb_exploitation_engagee_bio :surface_totale_engagee_bio) %>% - mutate(TypeZone="Epci") %>% - rename(date = annee,CodeZone = zone) %>% - mutate(date = dmy(paste("31-12",date,sep = "-"))) %>% - left_join(epci %>% select(EPCI,NOM_EPCI) %>% rename(CodeZone=EPCI,Zone=NOM_EPCI)) %>% - filter(!is.na(Zone)) %>% - mutate_if(is.character,as.factor) - -agri_bio_departement_2011_2019<-read_excel(path = "extdata/Donnees_Surfaces_Dept_depuis2011_AgenceBio.xlsx",sheet="DATA départements", - col_types = c("numeric","text","text","text","text","text","text", - "numeric","numeric","numeric","numeric","numeric","numeric","numeric") - ) %>% - filter(Code=="ALL") %>% - select(-Code,-Libelle,-Numero_Region,-libelle_Region) %>% - rename(nb_exploitation_engagee_bio = nb_exp, - surface_terme_conversion_bio = SurfAB, - surface_conversion_1e_annee_bio = SurfC1, - surface_conversion_2e_annee_bio = SurfC2, - surface_conversion_3e_annee_bio = SurfC3, - surface_totale_conversion_bio = SurfC123, - surface_totale_engagee_bio = SurfBio) %>% - gather(key = "variable",value = "valeur",nb_exploitation_engagee_bio :surface_totale_engagee_bio) %>% - mutate(TypeZone="Départements") %>% - rename(date = Annee,CodeZone = Numero_Dept,Zone=Libelle_Dept) %>% - mutate(date = dmy(paste("31-12",date,sep = "-"))) %>% - mutate_if(is.character,as.factor) - -agri_bio_region_2011_2019<-read_excel(path = "extdata/Donnees_Surfaces_Dept_depuis2011_AgenceBio.xlsx",sheet="DATA régions", - col_types = c("numeric","text","text","text","text", - "numeric","numeric","numeric","numeric","numeric","numeric","numeric") - ) %>% - filter(Code=="ALL") %>% - select(-Code,-Libelle) %>% - rename(nb_exploitation_engagee_bio = nb_exp, - surface_terme_conversion_bio = SurfAB, - surface_conversion_1e_annee_bio = SurfC1, - surface_conversion_2e_annee_bio = SurfC2, - surface_conversion_3e_annee_bio = SurfC3, - surface_totale_conversion_bio = SurfC123, - surface_totale_engagee_bio = SurfBio) %>% - gather(key = "variable",value = "valeur",nb_exploitation_engagee_bio :surface_totale_engagee_bio) %>% - mutate(TypeZone="Régions") %>% - rename(date = Annee,CodeZone = Numero_Region,Zone=libelle_Region) %>% - mutate(date = dmy(paste("31-12",date,sep = "-"))) %>% - mutate_if(is.character,as.factor) - -indicateur_agriculture_bio<-bind_rows(agri_bio_EPCI_2010_2019, - agri_bio_departement_2011_2019, - agri_bio_region_2011_2019) %>% - select(TypeZone,CodeZone,Zone,variable,valeur,date) %>% - mutate(valeur=ifelse(is.na(valeur),0,valeur)) %>% - pivot_wider(names_from = variable,values_from = valeur) - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = indicateur_agriculture_bio, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_agriculture_bio", - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("TypeZone", "CodeZone", "Zone", "date"), # déclaration d'une clé primaire sur la table postée - user = "does") - -# Descriptif de la source ------------- - -# Le descriptif de la source dans l'onglet sources du ggoglesheet du projet des indicateurs territoriaux était la suivant : -# Ces données de surfaces sont issues des contrôles annuels disponibles depuis 2011 que les organismes certificateurs agréés, -# réalisent dans les fermes et les entreprises de transformation, distribution engagées en bio. -# Comme une commune sur deux est concernée par le secret statistique des données (disposer d’au moins 3 exploitations), -# les données communales disponibles depuis 2019 ne sont pas prises en compte. -# Au niveau des EPCI, seules 2 sont couvertes par le secret statistique. - -# Nouveau descriptif : -# Ces données de surfaces sont issues des contrôles annuels disponibles depuis 2011 que les organismes certificateurs agréés, -# réalisent dans les fermes et les entreprises de transformation, distribution engagées en bio. -# Depuis la mise à jour du 6 décembre 2021, les données communales brutes sont disponibles. -# Deux sortes de table cohabitent donc sur le sgbd/datamart/portrait_territoires : -# - celles issue de chargment des données communales brutes à partir du millésime 2019 ; -# - celle issue des données à l'EPCI', au département ou à la région du millésime 2011 à 2019 (specifique_agriculture_bio) pour laquelle le secret statistique était invoqué. - -# Descriptif définitif depuis archivage sous le nom de zz_agriculture_bio.R -# Ces données de surfaces sont issues des contrôles annuels disponibles depuis 2011 que les organismes certificateurs agréés, -# réalisent dans les fermes et les entreprises de transformation, distribution engagées en bio. -# Depuis la mise à jour du 6 décembre 2021, les données communales brutes sont disponibles. -# Deux sortes de table cohabitent donc sur le sgbd/datamart/portrait_territoires : -# - celles issue de chargment des données communales brutes à partir du millésime 2019 ; -# - celle issue des données à l'EPCI', au département ou à la région du millésime 2011 à 2019 (zz_agriculture_bio) pour laquelle le secret statistique était invoqué au niveau communal et qui sont archivées de ce fait. - - -# METADONNEES (partie uniquement valable pour specifique_agriculture_bio) ------------------------------------ - -## On récupère la liste des variables qui sont à documenter dans le tableur google sheet à partir du jeu de données posté -var <- setdiff(names(indicateur_agriculture_bio), c("TypeZone", "CodeZone", "Zone", "date")) - -## récupération du nom du présent script source pour filtrer ensuite le référentiel des indicateurs -nom_script_sce <- rstudioapi::getActiveDocumentContext()$path %>% # utilisation de rstudioapi pour récupérer le nom du présent script - basename() %>% # on enlève le chemin d'accès pour ne garder que le nom du fichier - gsub(pattern = ".R$", "", .) # on enlève l'extension '.R' - -## authentification google sheet grâce au .Renviron -gs4_auth_configure(api_key = Sys.getenv("google_api_key")) -gs4_deauth() - -## chargement du référentiel indicateurs google sheet -metadata_indicateur <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "indicateurs") %>% - # on ne garde que les variables concernées par le présent script de chargement - filter(source == nom_script_sce) %>% - # on ajoute l'unité dans le libellé de la variable - mutate(libelle_variable = paste0(libelle_variable, " (unit\u00e9 : ", unite, ")")) %>% - select(variable, libelle_variable) %>% - # ajout des libellés pour date - bind_rows( - tribble( - ~variable, ~libelle_variable, - "date", "Millesime" - ) - ) - -## Vérification que la documentation des indicateurs est complète -all(var %in% metadata_indicateur$variable) # doit renvoyer TRUE - -## Envoi des libellés de variable dans le SGBD -post_dico_attr(dico = metadata_indicateur, - table = "specifique_agriculture_bio", - schema = "portrait_territoires", - db = "datamart", - user = "does") - -## Récupération des métadonnées de la source -nom_sce <- str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% - str_replace("indicateur_", "") %>% - str_replace("_cogiter|_cog$", "") - -metadata_source <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "sources") %>% - filter(source == nom_sce) %>% - mutate(com_table = paste0(source_lib, " - ", producteur, ".\n", descriptif_sources)) %>% - pull(com_table) %>% - # ajout de complement sur la généalogie - paste0(".\n", "T\u00e9l\u00e9chargement depuis le site de l\'Agence Bio https://www.agencebio.org/vos-outils/les-chiffres-cles/#-Allerplusloin") - -## commentaires de la table - -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_agriculture_bio", - user = "does") diff --git a/data-raw/zz_captage_prioritaire_protection_action.R b/data-raw/zz_captage_prioritaire_protection_action.R deleted file mode 100644 index 30a7e2e..0000000 --- a/data-raw/zz_captage_prioritaire_protection_action.R +++ /dev/null @@ -1,500 +0,0 @@ - -# zz_captage_prioritaire_protection_action - -# librairies ---------- -library(tidyverse) -library(glue) -library(sf) -library(mefa4) -library(mapview) -library(rgdal) -library(readxl) -library(COGiter) -library(lubridate) -library(datalibaba) -library(googlesheets4) - -rm(list=ls()) - - -# limites administratives ---------- -n_region_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_region_exp_r52") %>% - select(insee_reg,nom_reg) %>% - mutate(surf_region=st_area(the_geom)) - -n_departement_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_departement_exp_r52") %>% - select(insee_dep,nom) %>% - mutate(surf_departement=st_area(the_geom)) - -n_commune_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_commune_exp_r52") %>% - select(insee_com,nom,siren_epci) %>% - mutate(surf_commune=st_area(the_geom)) - -n_epci_zsup_r52<-importer_data(db = "consultation", - schema = "donnee_generique", - table = "n_epci_zsup_r52") %>% - select(siren_epci,dep_epci,nom_epci) %>% - mutate(surf_epci=st_area(the_geom)) - - -# listes communes, epci, départements et région Pays de la Loire ------- - -communes_pdl<-communes %>% - filter(REG== '52') %>% - select(DEPCOM,NOM_DEPCOM,EPCI) %>% - select(DEPCOM,NOM_DEPCOM) %>% - rename(CodeZone=DEPCOM,Zone=NOM_DEPCOM) - -epci_pdl<-epci %>% - unnest(REGIONS_DE_L_EPCI) %>% - filter(REGIONS_DE_L_EPCI == '52') %>% - select(EPCI,NOM_EPCI) %>% - rename(CodeZone=EPCI,Zone=NOM_EPCI) - -departements_pdl<-departements %>% - filter(REG=='52') %>% - select(DEP,NOM_DEP) %>% - rename(CodeZone=DEP,Zone=NOM_DEP) - -region_pdl<-regions %>% - filter(REG=='52') %>% - select(REG,NOM_REG) %>% - rename(CodeZone=REG,Zone=NOM_REG) - -territoire_pdl<-bind_rows(communes_pdl, - departements_pdl, - epci_pdl, - region_pdl) %>% - mutate_if(is.factor,as.character) - - -# stations, captages eau potable, captages prioritaires ------------ -station<-importer_data(db = "si_eau", - schema = "stations", - table = "station") - -captage_eau_potable_ars<-importer_data(db = "si_eau", - schema = "stations", - table = "captage_eau_potable_ars") - -captage_eau_potable_ars<-right_join(station %>% - select(code_station), - captage_eau_potable_ars, - by=c("code_station"="ins_code_national")) - -station_captage_prioritaire<-importer_data(db = "si_eau", - schema = "stations", - table = "r_station_captage_prioritaire_r52") - -station_captage_prioritaire<-station_captage_prioritaire %>% - select(code_station) %>% - mutate(code_station = as.character(code_station)) - -station_captage_prioritaire$code_station<- str_pad(station_captage_prioritaire$code_station, width = 9, pad = "0", side = "left") - -# verif<-semi_join(station_captage_prioritaire %>% -# select(code_station) %>% -# st_drop_geometry(), -# captage_eau_potable_ars %>% -# select(code_station) %>% -# st_drop_geometry()) # 47 obs : c'est bon -# rm(verif) - - -# captages prioritaires et plan d'actions --------- - -# selon srnp_dema courriel du 04/02/2021, les captages prioritaires ne possédant pas de Plan d'Actions sont : -# pour le 49 : la Rucette (049000394) ;le Longeron ;le Prieuré de la Madeleine (049000211) ;le Puits de la Fontaine Bourreau (049000479) ; -# pour le 85 : Sainte Germaine (085000184) - -# le longeron est une ancienne commune, maintenant Sèvremoine -# en fait Barrage des rivières (049000402) http://www.maine-et-loire.gouv.fr/les-captages-prioritaires-grenelle-a6180.html - -station_captage_prioritaire<-left_join(station_captage_prioritaire, - station %>% - st_drop_geometry() %>% - select(code_station,libelle_station)) %>% - mutate(plan_action=ifelse(code_station %notin% c("049000394","049000402","049000211","049000479","085000184"),"oui","non")) - - -# intersection captages prioritaires et territoires --------- -intersection_captage_prioritaire_commune<-st_intersection(station_captage_prioritaire,st_buffer(n_commune_exp_r52,0)) -# mapview(intersection_captage_prioritaire_commune,zcol=c("insee_com"),legend=F)+mapview(n_commune_exp_r52,alpha.regions=0) -intersection_captage_prioritaire_commune_2<-intersection_captage_prioritaire_commune %>% - st_drop_geometry() %>% - group_by(insee_com) %>% - mutate(nbre_captages_prioritaires=n()) %>% - ungroup() %>% - select(insee_com,nbre_captages_prioritaires) %>% - unique() %>% - right_join(n_commune_exp_r52 %>% - select(insee_com) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_prioritaires=ifelse(is.na(nbre_captages_prioritaires),0,nbre_captages_prioritaires)) %>% - mutate(TypeZone="Communes",variable="nbre_captages_prioritaires",date=today()) %>% - rename(CodeZone=insee_com,valeur=nbre_captages_prioritaires) - -intersection_captage_prioritaire_epci<-st_intersection(station_captage_prioritaire,st_buffer(n_epci_zsup_r52,0)) -# mapview(intersection_captage_prioritaire_epci,zcol=c("siren_epci"),legend=F)+mapview(n_epci_zsup_r52,alpha.regions=0) -intersection_captage_prioritaire_epci_2<-intersection_captage_prioritaire_epci %>% - st_drop_geometry() %>% - group_by(siren_epci) %>% - mutate(nbre_captages_prioritaires=n()) %>% - ungroup() %>% - select(siren_epci,nbre_captages_prioritaires) %>% - unique() %>% - right_join(n_epci_zsup_r52 %>% - select(siren_epci) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_prioritaires=ifelse(is.na(nbre_captages_prioritaires),0,nbre_captages_prioritaires)) %>% - mutate(TypeZone="Epci",variable="nbre_captages_prioritaires",date=today()) %>% - rename(CodeZone=siren_epci,valeur=nbre_captages_prioritaires) - -intersection_captage_prioritaire_departement<-st_intersection(station_captage_prioritaire,st_buffer(n_departement_exp_r52,0)) -# mapview(intersection_captage_prioritaire_departement,zcol=c("insee_dep"),legend=F)+mapview(n_departement_exp_r52,alpha.regions=0) -intersection_captage_prioritaire_departement_2<-intersection_captage_prioritaire_departement %>% - st_drop_geometry() %>% - group_by(insee_dep) %>% - mutate(nbre_captages_prioritaires=n()) %>% - ungroup() %>% - select(insee_dep,nbre_captages_prioritaires) %>% - unique() %>% - right_join(n_departement_exp_r52 %>% - select(insee_dep) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_prioritaires=ifelse(is.na(nbre_captages_prioritaires),0,nbre_captages_prioritaires)) %>% - mutate(TypeZone="Départements",variable="nbre_captages_prioritaires",date=today()) %>% - rename(CodeZone=insee_dep,valeur=nbre_captages_prioritaires) - -intersection_captage_prioritaire_region<-st_intersection(station_captage_prioritaire,st_buffer(n_region_exp_r52,0)) -# mapview(intersection_captage_prioritaire_region,zcol=c("insee_reg"),legend=F)+mapview(n_region_exp_r52,alpha.regions=0) -intersection_captage_prioritaire_region_2<-intersection_captage_prioritaire_region %>% - st_drop_geometry() %>% - mutate(nbre_captages_prioritaires=n()) %>% - select(insee_reg,nbre_captages_prioritaires)%>% - unique() %>% - mutate(TypeZone="Régions",variable="nbre_captages_prioritaires",date=today()) %>% - rename(CodeZone=insee_reg,valeur=nbre_captages_prioritaires) - -intersection_captage_prioritaire_territoire<-bind_rows(intersection_captage_prioritaire_commune_2, - intersection_captage_prioritaire_epci_2, - intersection_captage_prioritaire_departement_2, - intersection_captage_prioritaire_region_2) -rm(intersection_captage_prioritaire_commune_2, - intersection_captage_prioritaire_epci_2, - intersection_captage_prioritaire_departement_2, - intersection_captage_prioritaire_region_2) - - -# intersection captages prioritaires bénéficiant d'un plan d'actions et territoires ----------- -plan_action_commune<-intersection_captage_prioritaire_commune %>% - st_drop_geometry() %>% - filter(plan_action=="oui") %>% - group_by(insee_com) %>% - mutate(nbre_captages_prioritaires_avec_plan_actions=n()) %>% - ungroup() %>% - select(insee_com,nbre_captages_prioritaires_avec_plan_actions) %>% - unique() %>% - right_join(n_commune_exp_r52 %>% - select(insee_com) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_prioritaires_avec_plan_actions=ifelse(is.na(nbre_captages_prioritaires_avec_plan_actions),0,nbre_captages_prioritaires_avec_plan_actions)) %>% - mutate(TypeZone="Communes",variable="nbre_captages_prioritaires_avec_plan_actions",date=today()) %>% - rename(CodeZone=insee_com,valeur=nbre_captages_prioritaires_avec_plan_actions) - -plan_action_epci<-intersection_captage_prioritaire_epci %>% - st_drop_geometry() %>% - filter(plan_action=="oui") %>% - group_by(siren_epci) %>% - mutate(nbre_captages_prioritaires_avec_plan_actions=n()) %>% - ungroup() %>% - select(siren_epci,nbre_captages_prioritaires_avec_plan_actions) %>% - unique() %>% - right_join(n_epci_zsup_r52 %>% - select(siren_epci) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_prioritaires_avec_plan_actions=ifelse(is.na(nbre_captages_prioritaires_avec_plan_actions),0,nbre_captages_prioritaires_avec_plan_actions)) %>% - mutate(TypeZone="Epci",variable="nbre_captages_prioritaires_avec_plan_actions",date=today()) %>% - rename(CodeZone=siren_epci,valeur=nbre_captages_prioritaires_avec_plan_actions) - -plan_action_departement<-intersection_captage_prioritaire_departement %>% - st_drop_geometry() %>% - filter(plan_action=="oui") %>% - group_by(insee_dep) %>% - mutate(nbre_captages_prioritaires_avec_plan_actions=n()) %>% - ungroup() %>% - select(insee_dep,nbre_captages_prioritaires_avec_plan_actions) %>% - unique() %>% - right_join(n_departement_exp_r52 %>% - select(insee_dep) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_prioritaires_avec_plan_actions=ifelse(is.na(nbre_captages_prioritaires_avec_plan_actions),0,nbre_captages_prioritaires_avec_plan_actions)) %>% - mutate(TypeZone="Départements",variable="nbre_captages_prioritaires_avec_plan_actions",date=today()) %>% - rename(CodeZone=insee_dep,valeur=nbre_captages_prioritaires_avec_plan_actions) - -plan_action_region<-intersection_captage_prioritaire_region %>% - st_drop_geometry() %>% - filter(plan_action=="oui") %>% - mutate(nbre_captages_prioritaires_avec_plan_actions=n()) %>% - select(insee_reg,nbre_captages_prioritaires_avec_plan_actions)%>% - unique() %>% - mutate(TypeZone="Régions",variable="nbre_captages_prioritaires_avec_plan_actions",date=today()) %>% - rename(CodeZone=insee_reg,valeur=nbre_captages_prioritaires_avec_plan_actions) - -plan_action_territoire<-bind_rows(plan_action_commune, - plan_action_epci, - plan_action_departement, - plan_action_region) -rm(plan_action_commune, - plan_action_epci, - plan_action_departement, - plan_action_region) - - -# protection des captages -------------- -# r_ppcaptages_s_r52<-st_read(dsn_si_eau,query = "SELECT * FROM eau_potable.r_ppcaptages_s_r52") # 890 obs -r_ppcaptages_s_r52<-importer_data(db = "si_eau", - schema = "eau_potable", - table = "r_ppcaptages_s_r52") # 878 obs -protection_captage<-summarise(st_buffer(r_ppcaptages_s_r52,0),do_union = TRUE) - - -# intersections captages et protections (ppe ou ppi_ppr) --------- -captage_protege<-st_intersection(protection_captage,captage_eau_potable_ars) - - -# intersection captages protégés et territoires ------ -intersection_captage_protege_commune<-st_intersection(captage_protege,st_buffer(n_commune_exp_r52,0)) -# mapview(intersection_captage_protege_commune,zcol=c("insee_com"),legend=F)+mapview(n_commune_exp_r52,alpha.regions=0) -intersection_captage_protege_commune_2<-intersection_captage_protege_commune %>% - st_drop_geometry() %>% - group_by(insee_com) %>% - mutate(nbre_captages_proteges=n()) %>% - ungroup() %>% - select(insee_com,nbre_captages_proteges) %>% - unique() %>% - right_join(n_commune_exp_r52 %>% - select(insee_com) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_proteges=ifelse(is.na(nbre_captages_proteges),0,nbre_captages_proteges)) %>% - mutate(TypeZone="Communes",variable="nbre_captages_proteges",date=today()) %>% - rename(CodeZone=insee_com,valeur=nbre_captages_proteges) - -intersection_captage_protege_epci<-st_intersection(captage_protege,st_buffer(n_epci_zsup_r52,0)) -# mapview(intersection_captage_protege_epci,zcol=c("siren_epci"),legend=F)+mapview(n_epci_zsup_r52,alpha.regions=0) -intersection_captage_protege_epci_2<-intersection_captage_protege_epci %>% - st_drop_geometry() %>% - group_by(siren_epci) %>% - mutate(nbre_captages_proteges=n()) %>% - ungroup() %>% - select(siren_epci,nbre_captages_proteges) %>% - unique() %>% - right_join(n_epci_zsup_r52 %>% - select(siren_epci) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_proteges=ifelse(is.na(nbre_captages_proteges),0,nbre_captages_proteges)) %>% - mutate(TypeZone="Epci",variable="nbre_captages_proteges",date=today()) %>% - rename(CodeZone=siren_epci,valeur=nbre_captages_proteges) - -intersection_captage_protege_departement<-st_intersection(captage_protege,st_buffer(n_departement_exp_r52,0)) -# mapview(intersection_captage_protege_departement,zcol=c("insee_dep"),legend=F)+mapview(n_departement_exp_r52,alpha.regions=0) -intersection_captage_protege_departement_2<-intersection_captage_protege_departement %>% - st_drop_geometry() %>% - group_by(insee_dep) %>% - mutate(nbre_captages_proteges=n()) %>% - ungroup() %>% - select(insee_dep,nbre_captages_proteges) %>% - unique() %>% - right_join(n_departement_exp_r52 %>% - select(insee_dep) %>% - st_drop_geometry()) %>% - mutate(nbre_captages_proteges=ifelse(is.na(nbre_captages_proteges),0,nbre_captages_proteges)) %>% - mutate(TypeZone="Départements",variable="nbre_captages_proteges",date=today()) %>% - rename(CodeZone=insee_dep,valeur=nbre_captages_proteges) - -intersection_captage_protege_region<-st_intersection(captage_protege,st_buffer(n_region_exp_r52,0)) -# mapview(intersection_captage_protege_region,zcol=c("insee_reg"),legend=F)+mapview(n_region_exp_r52,alpha.regions=0) -intersection_captage_protege_region_2<-intersection_captage_protege_region %>% - st_drop_geometry() %>% - mutate(nbre_captages_proteges=n()) %>% - select(insee_reg,nbre_captages_proteges)%>% - unique() %>% - mutate(TypeZone="Régions",variable="nbre_captages_proteges",date=today()) %>% - rename(CodeZone=insee_reg,valeur=nbre_captages_proteges) - -intersection_captage_protege_territoire<-bind_rows(intersection_captage_protege_commune_2, - intersection_captage_protege_epci_2, - intersection_captage_protege_departement_2, - intersection_captage_protege_region_2) -rm(intersection_captage_protege_commune_2, - intersection_captage_protege_epci_2, - intersection_captage_protege_departement_2, - intersection_captage_protege_region_2) - - -# intersection protection et territoires ---------- -intersection_protection_captage_commune<-st_intersection(st_buffer(protection_captage,0),st_buffer(n_commune_exp_r52,0)) -# mapview(intersection_protection_captage_commune,col.regions = "red")+mapview(n_commune_exp_r52,alpha.regions=0) -# la carte intersection_protection_captage_commune n'affiche aucun polygone -intersection_protection_captage_commune_2<-intersection_protection_captage_commune %>% - mutate(surf_protection_captage=st_area(geom)) %>% - st_drop_geometry() %>% - group_by(insee_com) %>% - mutate(part_protection_captage=round(surf_protection_captage/surf_commune*100,digits = 2)) %>% - ungroup() %>% - right_join(n_commune_exp_r52 %>% - select(insee_com) %>% - st_drop_geometry()) %>% - select(insee_com,part_protection_captage) %>% - mutate(part_protection_captage=ifelse(is.na(part_protection_captage),0,part_protection_captage)) %>% - mutate(TypeZone="Communes",variable="part_protection_captage",date=today()) %>% - rename(CodeZone=insee_com,valeur=part_protection_captage) - -intersection_protection_captage_epci<-st_intersection(st_buffer(protection_captage,0),st_buffer(n_epci_zsup_r52,0)) -# mapview(intersection_protection_captage_epci)+mapview(n_epci_zsup_r52,alpha.regions=0) -# la carte intersection_protection_captage_epci n'affiche aucun polygone -intersection_protection_captage_epci_2<-intersection_protection_captage_epci %>% - mutate(surf_protection_captage=st_area(geom)) %>% - st_drop_geometry() %>% - group_by(siren_epci) %>% - mutate(part_protection_captage=round(surf_protection_captage/surf_epci*100,digits = 2)) %>% - ungroup() %>% - right_join(n_epci_zsup_r52 %>% - select(siren_epci,nom_epci) %>% - st_drop_geometry()) %>% - select(siren_epci,part_protection_captage) %>% - mutate(part_protection_captage=ifelse(is.na(part_protection_captage),0,part_protection_captage)) %>% - mutate(TypeZone="Epci",variable="part_protection_captage",date=today()) %>% - rename(CodeZone=siren_epci,valeur=part_protection_captage) - -intersection_protection_captage_departement<-st_intersection(st_buffer(protection_captage,0),st_buffer(n_departement_exp_r52,0)) -# mapview(intersection_protection_captage_departement)+mapview(n_departement_exp_r52,alpha.regions=0) -intersection_protection_captage_departement_2<-intersection_protection_captage_departement %>% - mutate(surf_protection_captage = st_area(geom)) %>% - st_drop_geometry() %>% - group_by(insee_dep) %>% - mutate(part_protection_captage = round(surf_protection_captage/surf_departement*100,digits = 2)) %>% - ungroup() %>% - right_join(n_departement_exp_r52 %>% - select(insee_dep,nom) %>% - st_drop_geometry()) %>% - select(insee_dep,part_protection_captage) %>% - mutate(part_protection_captage=ifelse(is.na(part_protection_captage),0,part_protection_captage)) %>% - mutate(TypeZone="Départements",variable="part_protection_captage",date=today()) %>% - rename(CodeZone=insee_dep,valeur=part_protection_captage) - -intersection_protection_captage_region<-st_intersection(st_buffer(protection_captage,0),st_buffer(n_region_exp_r52,0)) -# mapview(intersection_protection_captage_region)+mapview(n_region_exp_r52,alpha.regions=0) -intersection_protection_captage_region_2<-intersection_protection_captage_region %>% - mutate(surf_protection_captage=st_area(geom)) %>% - st_drop_geometry() %>% - mutate(part_protection_captage=round(surf_protection_captage/surf_region*100,digits = 2)) %>% - select(insee_reg,part_protection_captage) %>% - mutate(TypeZone="Régions",variable="part_protection_captage",date=today()) %>% - mutate(part_protection_captage=as.numeric(part_protection_captage)) %>% - rename(CodeZone=insee_reg,valeur=part_protection_captage) - -intersection_protection_captage_territoire<-bind_rows(intersection_protection_captage_commune_2, - intersection_protection_captage_epci_2, - intersection_protection_captage_departement_2, - intersection_protection_captage_region_2) -rm(intersection_protection_captage_commune_2, - intersection_protection_captage_epci_2, - intersection_protection_captage_departement_2, - intersection_protection_captage_region_2) - - -# assemblage ------------ -specifique_captage_prioritaire_protection_action<-bind_rows(intersection_captage_protege_territoire, - intersection_protection_captage_territoire, - intersection_captage_prioritaire_territoire, - plan_action_territoire) %>% - left_join(territoire_pdl) %>% - mutate_if(is.character,as.factor) %>% - select(TypeZone,CodeZone,Zone,date,variable,valeur) %>% - pivot_wider(names_from = variable,values_from = valeur) - - -# # carte ------------ -# mapview(n_region_exp_r52,alpha.regions=0,legend=F)+ -# mapview(r_ppcaptages_s_r52,col.regions="red")+ -# mapview(captage_eau_potable_ars)+ -# mapview(station_captage_prioritaire,col.regions="green",color="black") - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = specifique_captage_prioritaire_protection_action, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_captage_prioritaire_protection_action", - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("TypeZone", "CodeZone", "Zone", "date"), # déclaration d'une clé primaire sur la table postée - user = "does") - - -# METADONNEES------------------------------------ - -## On récupère la liste des variables qui sont à documenter dans le tableur google sheet à partir du jeu de données posté -var <- setdiff(names(specifique_captage_prioritaire_protection_action), c("TypeZone", "CodeZone", "Zone", "date")) - -## récupération du nom du présent script source pour filtrer ensuite le référentiel des indicateurs -nom_script_sce <- rstudioapi::getActiveDocumentContext()$path %>% # utilisation de rstudioapi pour récupérer le nom du présent script - basename() %>% # on enlève le chemin d'accès pour ne garder que le nom du fichier - gsub(pattern = ".R$", "", .) # on enlève l'extension '.R' - -## authentification google sheet grâce au .Renviron -gs4_auth_configure(api_key = Sys.getenv("google_api_key")) -gs4_deauth() - -## chargement du référentiel indicateurs google sheet -metadata_indicateur <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "indicateurs") %>% - # on ne garde que les variables concernées par le présent script de chargement - filter(source == nom_script_sce) %>% - # on ajoute l'unité dans le libellé de la variable - mutate(libelle_variable = paste0(libelle_variable, " (unit\u00e9 : ", unite, ")")) %>% - select(variable, libelle_variable) %>% - # ajout des libellés pour date - bind_rows( - tribble( - ~variable, ~libelle_variable, - "date", "Millesime" - ) - ) - -## Vérification que la documentation des indicateurs est complète -all(var %in% metadata_indicateur$variable) # doit renvoyer TRUE - -## Envoi des libellés de variable dans le SGBD -post_dico_attr(dico = metadata_indicateur, - table = "specifique_captage_prioritaire_protection_action", - schema = "portrait_territoires", - db = "datamart", - user = "does") - -## Récupération des métadonnées de la source -nom_sce <- str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% - str_replace("indicateur_", "") %>% - str_replace("_cogiter|_cog$", "") - -metadata_source <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "sources") %>% - filter(source == nom_sce) %>% - mutate(com_table = paste0(source_lib, " - ", producteur, ".\n", descriptif_sources)) %>% - pull(com_table) - -## commentaires de la table -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_captage_prioritaire_protection_action", - user = "does") - diff --git a/data-raw/zz_chargement_ocsge_auran.R b/data-raw/zz_chargement_ocsge_auran.R deleted file mode 100644 index df70771..0000000 --- a/data-raw/zz_chargement_ocsge_auran.R +++ /dev/null @@ -1,312 +0,0 @@ - -# chargement_ocsge_typologie_auran - -# librairies ------ -library(DBI) -library(RPostgreSQL) -library(dplyr) -library(tidyr) - -rm(list = ls()) - - -# chargement data ------------- -drv <- dbDriver("PostgreSQL") -con_datamart <- dbConnect(drv, - dbname="datamart", - host=Sys.getenv("server"), - port=Sys.getenv("port"), - user=Sys.getenv("userid"), - password=Sys.getenv("pwd_does")) -postgresqlpqExec(con_datamart, "SET client_encoding = 'windows-1252'") - -ocsge_pdl_couverture_usage_2013<-dbReadTable(con_datamart,c("portrait_territoires","ocsge_pdl_couverture_usage_2013")) - -ocsge_pdl_couverture_usage_2016<-dbReadTable(con_datamart,c("portrait_territoires","ocsge_pdl_couverture_usage_2016")) - -ocsge_pdl<-bind_rows(ocsge_pdl_couverture_usage_2013, - ocsge_pdl_couverture_usage_2016) - - -# définition typologie auran -------------- -# type_0 : Croisement non existant -# type_1 : Zones d’habitat, équipements, zones d’activités économiques et commerciales -# type_2 : Infrastructures routières, ferroviaires, portuaires, aéroportuaires et réseaux d’utilité publique -# type_3 : Activités d’extraction -# type_4 : Zones en transition -# type_5 : Bâtiments, serres et espaces artificialisés agricoles -# type_6 : Espaces agricoles non artificialisés -# type_7 : Bois et forêts -# type_8 : Autres espaces naturels -# type_9 : Surfaces en eau - - -# typologie des espaces ------- -ocsge_type <- select(ocsge_pdl, couverture, usage) %>% - distinct() %>% -mutate(type_espace = case_when( -usage == "US1.1" & couverture == "CS1.1.1.1" ~ "type_5", -usage == "US1.2" & couverture == "CS1.1.1.1" ~ "type_0", -usage == "US1.3" & couverture == "CS1.1.1.1" ~ "type_3", -usage == "US1.4" & couverture == "CS1.1.1.1" ~ "type_5", -usage == "US1.5" & couverture == "CS1.1.1.1" ~ "type_0", -usage == "US235" & couverture == "CS1.1.1.1" ~ "type_1", -usage == "US4.1.1" & couverture == "CS1.1.1.1" ~ "type_2", -usage == "US4.1.2" & couverture == "CS1.1.1.1" ~ "type_2", -usage == "US4.1.3" & couverture == "CS1.1.1.1" ~ "type_2", -usage == "US4.1.4" & couverture == "CS1.1.1.1" ~ "type_2", -usage == "US4.1.5" & couverture == "CS1.1.1.1" ~ "type_0", -usage == "US4.2" & couverture == "CS1.1.1.1" ~ "type_2", -usage == "US4.3" & couverture == "CS1.1.1.1" ~ "type_2", -usage == "US6.1" & couverture == "CS1.1.1.1" ~ "type_4", -usage == "US6.2" & couverture == "CS1.1.1.1" ~ "type_1", -usage == "US6.3" & couverture == "CS1.1.1.1" ~ "type_0", -usage == "US6.4" & couverture == "CS1.1.1.1" ~ "type_0", - -usage == "US1.1" & couverture == "CS1.1.1.2" ~ "type_5", -usage == "US1.2" & couverture == "CS1.1.1.2" ~ "type_0", -usage == "US1.3" & couverture == "CS1.1.1.2" ~ "type_3", -usage == "US1.4" & couverture == "CS1.1.1.2" ~ "type_5", -usage == "US1.5" & couverture == "CS1.1.1.2" ~ "type_0", -usage == "US235" & couverture == "CS1.1.1.2" ~ "type_1", -usage == "US4.1.1" & couverture == "CS1.1.1.2" ~ "type_2", -usage == "US4.1.2" & couverture == "CS1.1.1.2" ~ "type_2", -usage == "US4.1.3" & couverture == "CS1.1.1.2" ~ "type_2", -usage == "US4.1.4" & couverture == "CS1.1.1.2" ~ "type_2", -usage == "US4.1.5" & couverture == "CS1.1.1.2" ~ "type_0", -usage == "US4.2" & couverture == "CS1.1.1.2" ~ "type_2", -usage == "US4.3" & couverture == "CS1.1.1.2" ~ "type_2", -usage == "US6.1" & couverture == "CS1.1.1.2" ~ "type_4", -usage == "US6.2" & couverture == "CS1.1.1.2" ~ "type_1", -usage == "US6.3" & couverture == "CS1.1.1.2" ~ "type_0", -usage == "US6.4" & couverture == "CS1.1.1.2" ~ "type_0", - -usage == "US1.1" & couverture == "CS1.1.2.1" ~ "type_5", -usage == "US1.2" & couverture == "CS1.1.2.1" ~ "type_0", -usage == "US1.3" & couverture == "CS1.1.2.1" ~ "type_3", -usage == "US1.4" & couverture == "CS1.1.2.1" ~ "type_5", -usage == "US1.5" & couverture == "CS1.1.2.1" ~ "type_0", -usage == "US235" & couverture == "CS1.1.2.1" ~ "type_1", -usage == "US4.1.1" & couverture == "CS1.1.2.1" ~ "type_2", -usage == "US4.1.2" & couverture == "CS1.1.2.1" ~ "type_2", -usage == "US4.1.3" & couverture == "CS1.1.2.1" ~ "type_2", -usage == "US4.1.4" & couverture == "CS1.1.2.1" ~ "type_2", -usage == "US4.1.5" & couverture == "CS1.1.2.1" ~ "type_0", -usage == "US4.2" & couverture == "CS1.1.2.1" ~ "type_2", -usage == "US4.3" & couverture == "CS1.1.2.1" ~ "type_2", -usage == "US6.1" & couverture == "CS1.1.2.1" ~ "type_4", -usage == "US6.2" & couverture == "CS1.1.2.1" ~ "type_2", -usage == "US6.3" & couverture == "CS1.1.2.1" ~ "type_0", -usage == "US6.4" & couverture == "CS1.1.2.1" ~ "type_0", - -usage == "US1.1" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US1.2" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US1.3" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US1.4" & couverture == "CS1.1.2.2" ~ "type_5", -usage == "US1.5" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US235" & couverture == "CS1.1.2.2" ~ "type_1", -usage == "US4.1.1" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US4.1.2" & couverture == "CS1.1.2.2" ~ "type_2", -usage == "US4.1.3" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US4.1.4" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US4.1.5" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US4.2" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US4.3" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US6.1" & couverture == "CS1.1.2.2" ~ "type_4", -usage == "US6.2" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US6.3" & couverture == "CS1.1.2.2" ~ "type_0", -usage == "US6.4" & couverture == "CS1.1.2.2" ~ "type_0", - -usage == "US1.1" & couverture == "CS1.2.1" ~ "type_0", -usage == "US1.2" & couverture == "CS1.2.1" ~ "type_0", -usage == "US1.3" & couverture == "CS1.2.1" ~ "type_0", -usage == "US1.4" & couverture == "CS1.2.1" ~ "type_0", -usage == "US1.5" & couverture == "CS1.2.1" ~ "type_0", -usage == "US235" & couverture == "CS1.2.1" ~ "type_1", -usage == "US4.1.1" & couverture == "CS1.2.1" ~ "type_0", -usage == "US4.1.2" & couverture == "CS1.2.1" ~ "type_0", -usage == "US4.1.3" & couverture == "CS1.2.1" ~ "type_0", -usage == "US4.1.4" & couverture == "CS1.2.1" ~ "type_0", -usage == "US4.1.5" & couverture == "CS1.2.1" ~ "type_0", -usage == "US4.2" & couverture == "CS1.2.1" ~ "type_0", -usage == "US4.3" & couverture == "CS1.2.1" ~ "type_0", -usage == "US6.1" & couverture == "CS1.2.1" ~ "type_4", -usage == "US6.2" & couverture == "CS1.2.1" ~ "type_0", -usage == "US6.3" & couverture == "CS1.2.1" ~ "type_8", -usage == "US6.4" & couverture == "CS1.2.1" ~ "type_0", - -usage == "US1.1" & couverture == "CS1.2.2" ~ "type_9", -usage == "US1.2" & couverture == "CS1.2.2" ~ "type_0", -usage == "US1.3" & couverture == "CS1.2.2" ~ "type_3", -usage == "US1.4" & couverture == "CS1.2.2" ~ "type_5", -usage == "US1.5" & couverture == "CS1.2.2" ~ "type_0", -usage == "US235" & couverture == "CS1.2.2" ~ "type_9", -usage == "US4.1.1" & couverture == "CS1.2.2" ~ "type_2", -usage == "US4.1.2" & couverture == "CS1.2.2" ~ "type_0", -usage == "US4.1.3" & couverture == "CS1.2.2" ~ "type_0", -usage == "US4.1.4" & couverture == "CS1.2.2" ~ "type_9", -usage == "US4.1.4" & couverture == "CS1.2.2" ~ "type_0", -usage == "US4.2" & couverture == "CS1.2.2" ~ "type_0", -usage == "US4.3" & couverture == "CS1.2.2" ~ "type_2", -usage == "US6.1" & couverture == "CS1.2.2" ~ "type_0", -usage == "US6.2" & couverture == "CS1.2.2" ~ "type_0", -usage == "US6.3" & couverture == "CS1.2.2" ~ "type_9", -usage == "US6.4" & couverture == "CS1.2.2" ~ "type_0", - -usage == "US1.1" & couverture == "CS2.1.1.1" ~ "type_6", -usage == "US1.2" & couverture == "CS2.1.1.1" ~ "type_7", -usage == "US1.3" & couverture == "CS2.1.1.1" ~ "type_3", -usage == "US1.4" & couverture == "CS2.1.1.1" ~ "type_0", -usage == "US1.5" & couverture == "CS2.1.1.1" ~ "type_0", -usage == "US235" & couverture == "CS2.1.1.1" ~ "type_1", -usage == "US4.1.1" & couverture == "CS2.1.1.1" ~ "type_2", -usage == "US4.1.2" & couverture == "CS2.1.1.1" ~ "type_2", -usage == "US4.1.3" & couverture == "CS2.1.1.1" ~ "type_2", -usage == "US4.1.4" & couverture == "CS2.1.1.1" ~ "type_0", -usage == "US4.1.5" & couverture == "CS2.1.1.1" ~ "type_0", -usage == "US4.2" & couverture == "CS2.1.1.1" ~ "type_0", -usage == "US4.3" & couverture == "CS2.1.1.1" ~ "type_2", -usage == "US6.1" & couverture == "CS2.1.1.1" ~ "type_0", -usage == "US6.2" & couverture == "CS2.1.1.1" ~ "type_7", -usage == "US6.3" & couverture == "CS2.1.1.1" ~ "type_7", -usage == "US6.4" & couverture == "CS2.1.1.1" ~ "type_0", - -usage == "US1.1" & couverture == "CS2.1.1.2" ~ "type_6", -usage == "US1.2" & couverture == "CS2.1.1.2" ~ "type_7", -usage == "US1.3" & couverture == "CS2.1.1.2" ~ "type_3", -usage == "US1.4" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US1.5" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US235" & couverture == "CS2.1.1.2" ~ "type_1", -usage == "US4.1.1" & couverture == "CS2.1.1.2" ~ "type_2", -usage == "US4.1.2" & couverture == "CS2.1.1.2" ~ "type_2", -usage == "US4.1.3" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US4.1.4" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US4.1.5" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US4.2" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US4.3" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US6.1" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US6.2" & couverture == "CS2.1.1.2" ~ "type_0", -usage == "US6.3" & couverture == "CS2.1.1.2" ~ "type_7", -usage == "US6.4" & couverture == "CS2.1.1.2" ~ "type_0", - -usage == "US1.1" & couverture == "CS2.1.1.3" ~ "type_6", -usage == "US1.2" & couverture == "CS2.1.1.3" ~ "type_7", -usage == "US1.3" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US1.4" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US1.5" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US235" & couverture == "CS2.1.1.3" ~ "type_1", -usage == "US4.1.1" & couverture == "CS2.1.1.3" ~ "type_2", -usage == "US4.1.2" & couverture == "CS2.1.1.3" ~ "type_2", -usage == "US4.1.3" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US4.1.4" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US4.1.5" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US4.2" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US4.3" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US6.1" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US6.2" & couverture == "CS2.1.1.3" ~ "type_0", -usage == "US6.3" & couverture == "CS2.1.1.3" ~ "type_7", -usage == "US6.4" & couverture == "CS2.1.1.3" ~ "type_0", - -usage == "US1.1" & couverture == "CS2.1.2" ~ "type_6", -usage == "US1.2" & couverture == "CS2.1.2" ~ "type_8", -usage == "US1.3" & couverture == "CS2.1.2" ~ "type_3", -usage == "US1.4" & couverture == "CS2.1.2" ~ "type_0", -usage == "US1.5" & couverture == "CS2.1.2" ~ "type_0", -usage == "US235" & couverture == "CS2.1.2" ~ "type_1", -usage == "US4.1.1" & couverture == "CS2.1.2" ~ "type_2", -usage == "US4.1.2" & couverture == "CS2.1.2" ~ "type_2", -usage == "US4.1.3" & couverture == "CS2.1.2" ~ "type_2", -usage == "US4.1.4" & couverture == "CS2.1.2" ~ "type_0", -usage == "US4.1.5" & couverture == "CS2.1.2" ~ "type_0", -usage == "US4.2" & couverture == "CS2.1.2" ~ "type_2", -usage == "US4.3" & couverture == "CS2.1.2" ~ "type_2", -usage == "US6.1" & couverture == "CS2.1.2" ~ "type_0", -usage == "US6.2" & couverture == "CS2.1.2" ~ "type_8", -usage == "US6.3" & couverture == "CS2.1.2" ~ "type_8", -usage == "US6.4" & couverture == "CS2.1.2" ~ "type_0", - -usage == "US1.1" & couverture == "CS2.1.3" ~ "type_6", -usage == "US1.2" & couverture == "CS2.1.3" ~ "type_0", -usage == "US1.3" & couverture == "CS2.1.3" ~ "type_0", -usage == "US1.4" & couverture == "CS2.1.3" ~ "type_0", -usage == "US1.5" & couverture == "CS2.1.3" ~ "type_0", -usage == "US235" & couverture == "CS2.1.3" ~ "type_6", -usage == "US4.1.1" & couverture == "CS2.1.3" ~ "type_0", -usage == "US4.1.2" & couverture == "CS2.1.3" ~ "type_2", -usage == "US4.1.3" & couverture == "CS2.1.3" ~ "type_0", -usage == "US4.1.4" & couverture == "CS2.1.3" ~ "type_0", -usage == "US4.1.5" & couverture == "CS2.1.3" ~ "type_0", -usage == "US4.2" & couverture == "CS2.1.3" ~ "type_0", -usage == "US4.3" & couverture == "CS2.1.3" ~ "type_0", -usage == "US6.1" & couverture == "CS2.1.3" ~ "type_0", -usage == "US6.2" & couverture == "CS2.1.3" ~ "type_0", -usage == "US6.3" & couverture == "CS2.1.3" ~ "type_0", -usage == "US6.4" & couverture == "CS2.1.3" ~ "type_0", - -usage == "US1.1" & couverture == "CS2.2.1" ~ "type_6", -usage == "US1.2" & couverture == "CS2.2.1" ~ "type_0", -usage == "US1.3" & couverture == "CS2.2.1" ~ "type_3", -usage == "US1.4" & couverture == "CS2.2.1" ~ "type_6", -usage == "US1.5" & couverture == "CS2.2.1" ~ "type_0", -usage == "US235" & couverture == "CS2.2.1" ~ "type_1", -usage == "US4.1.1" & couverture == "CS2.2.1" ~ "type_2", -usage == "US4.1.2" & couverture == "CS2.2.1" ~ "type_2", -usage == "US4.1.3" & couverture == "CS2.2.1" ~ "type_2", -usage == "US4.1.4" & couverture == "CS2.2.1" ~ "type_2", -usage == "US4.1.5" & couverture == "CS2.2.1" ~ "type_0", -usage == "US4.2" & couverture == "CS2.2.1" ~ "type_2", -usage == "US4.3" & couverture == "CS2.2.1" ~ "type_2", -usage == "US6.1" & couverture == "CS2.2.1" ~ "type_4", -usage == "US6.2" & couverture == "CS2.2.1" ~ "type_8", -usage == "US6.3" & couverture == "CS2.2.1" ~ "type_8", -usage == "US6.4" & couverture == "CS2.2.1" ~ "type_0", - -usage == "US1.1" & couverture == "CS2.2.2" ~ "type_0", -usage == "US1.2" & couverture == "CS2.2.2" ~ "type_0", -usage == "US1.3" & couverture == "CS2.2.2" ~ "type_0", -usage == "US1.4" & couverture == "CS2.2.2" ~ "type_6", -usage == "US1.5" & couverture == "CS2.2.2" ~ "type_0", -usage == "US235" & couverture == "CS2.2.2" ~ "type_1", -usage == "US4.1.1" & couverture == "CS2.2.2" ~ "type_0", -usage == "US4.1.2" & couverture == "CS2.2.2" ~ "type_2", -usage == "US4.1.3" & couverture == "CS2.2.2" ~ "type_0", -usage == "US4.1.4" & couverture == "CS2.2.2" ~ "type_0", -usage == "US4.1.5" & couverture == "CS2.2.2" ~ "type_0", -usage == "US4.2" & couverture == "CS2.2.2" ~ "type_0", -usage == "US4.3" & couverture == "CS2.2.2" ~ "type_0", -usage == "US6.1" & couverture == "CS2.2.2" ~ "type_4", -usage == "US6.2" & couverture == "CS2.2.2" ~ "type_0", -usage == "US6.3" & couverture == "CS2.2.2" ~ "type_8", -usage == "US6.4" & couverture == "CS2.2.2" ~ "type_0", - -usage == "US235" & couverture == "CS2.1.1" ~ "type_1" -# cas du Bigne 44014 en 2013, CS2.1.1 décliné en CS2.1.1.1, CS2.1.1.2, CS2.1.1.3 -) -) - - -# calcul des indicateurs communaux ----------- -ocsge_auran <- ocsge_pdl %>% - left_join(ocsge_type) %>% - select(depcom = code_insee, date, variable = type_espace, valeur = surf_intersection_m2) %>% - group_by(date, depcom, variable) %>% - summarise(valeur = sum(valeur), .groups = "drop") %>% - mutate_if(is.character, as.factor) %>% - complete(depcom,date,variable,fill = list(valeur = 0)) %>% - pivot_wider(names_from = variable,values_from = valeur) - - -ocsge_auran_type_0<-filter(ocsge_auran,type_0 != 0) # 32 obs -save(ocsge_auran_type_0,file = "sysdata/ocsge_auran_type_0.Rdata") - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -dbWriteTable(con_datamart, - c("portrait_territoires","source_ocsge_auran"), - ocsge_auran, - row.names=FALSE, - overwrite=TRUE) - -dbDisconnect(con_datamart) - -rm(list=ls()) diff --git a/data-raw/zz_cogification_ocsge_auran.R b/data-raw/zz_cogification_ocsge_auran.R deleted file mode 100644 index 70d6ffc..0000000 --- a/data-raw/zz_cogification_ocsge_auran.R +++ /dev/null @@ -1,33 +0,0 @@ - -# cogification_ocsge_auran - -# librairies ------ -library(DBI) -library(RPostgreSQL) -library(dplyr) -library(COGiter) - -rm(list = ls()) - -drv <- dbDriver("PostgreSQL") -con_datamart <- dbConnect(drv, - dbname="datamart", - host=Sys.getenv("server"), - port=Sys.getenv("port"), - user=Sys.getenv("userid"), - password=Sys.getenv("pwd_does")) -postgresqlpqExec(con_datamart, "SET client_encoding = 'windows-1252'") - -source_ocsge_auran<-dbReadTable(con_datamart,c("portrait_territoires","source_ocsge_auran")) - -cogifiee_ocsge_auran<-cogifier(source_ocsge_auran %>% rename(DEPCOM=depcom)) - -dbWriteTable(con_datamart, - c("portrait_territoires","cogifiee_ocsge_auran"), - cogifiee_ocsge_auran, - row.names=FALSE, - overwrite=TRUE) - -dbDisconnect(con_datamart) - -rm(list=ls()) diff --git a/data-raw/zz_couverture_sage.R b/data-raw/zz_couverture_sage.R deleted file mode 100644 index 72f9578..0000000 --- a/data-raw/zz_couverture_sage.R +++ /dev/null @@ -1,466 +0,0 @@ - -# specifique_couverture_sage - -# librairies -------- -library(datalibaba) -library(tidyverse) -library(mapview) -library(COGiter) -library(sf) -library(units) -library(googlesheets4) - - -rm(list = ls()) - - -# chargement SAGE ------------ -n_sage_r52<-importer_data(db = "si_eau", - schema = "zonages_de_gestion", - table = "n_sage_r52") %>% - mutate(lb_etat=case_when(lb_etat=="Mis en oeuvre"~"mis_en_oeuvre", - lb_etat=="Élaboration"~"elaboration", - lb_etat=="Première révision"~"premiere_revision")) -# mapview(n_sage_r52,zol = c("nom"), color = "blue", alpha.regions = 0.5, legend = T) -# la couche géographique est de mauvaise qualité, car des limites de SAGE intersectent entre elles ! - - -# limites administratives ---------- - -n_commune_exp_r52 <- importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_commune_exp_r52") %>% - select(insee_com, nom_com = nom) %>% - mutate(surf_commune = st_area(the_geom)) - -n_epci_zsup_r52<-importer_data(db = "consultation", - schema = "donnee_generique", - table = "n_epci_zsup_r52") %>% - select(siren_epci, nom_epci) %>% - mutate(surf_epci = st_area(the_geom)) - -n_departement_exp_r52 <- importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_departement_exp_r52") %>% - select(insee_dep,nom_dep = nom) %>% - mutate(surf_departement = st_area(the_geom)) - -n_region_exp_r52 <- importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_region_exp_r52") %>% - select(insee_reg, nom_reg) %>% - mutate(surf_region = st_area(the_geom)) - - -# intersection communes ------------------ -etat_sage_communes<-st_intersection(st_buffer(n_sage_r52, 0), st_buffer(n_commune_exp_r52, 0)) -# mapview(etat_sage_communes) - -indicateur_etat_sage_communes<-etat_sage_communes %>% - mutate(surf_sage_intersect = st_area(the_geom)) %>% - st_drop_geometry() %>% - select(nom, code, lb_etat, insee_com, surf_commune, nom_com, surf_sage_intersect) %>% - group_by(nom_com, lb_etat) %>% - mutate(pourc = round(sum(surf_sage_intersect)/surf_commune*100, digits = 0)) %>% - ungroup() %>% - select(insee_com, nom_com, lb_etat, pourc) %>% - unique() %>% - group_by(insee_com) %>% - mutate(difference = as_units(100) - sum(pourc)) %>% - mutate(pourc = ifelse(difference<as_units(0) & lb_etat=="mis_en_oeuvre", pourc+difference, pourc)) %>% # traitement lié à la mauvaise qualité de la table n_sage_r52 - mutate(difference = ifelse(difference<as_units(0), as_units(0), difference)) %>% - ungroup() - -indicateur_etat_sage_communes <- bind_rows(indicateur_etat_sage_communes, - n_commune_exp_r52 %>% - st_drop_geometry() %>% - select(insee_com,nom_com) %>% - mutate(lb_etat="hors_sage") %>% - left_join(indicateur_etat_sage_communes %>% - select(insee_com,difference) %>% - unique()) - ) - -indicateur_etat_sage_communes<-indicateur_etat_sage_communes %>% - group_by(insee_com) %>% - mutate(pourc=ifelse(is.na(pourc),difference,pourc)) %>% - ungroup() %>% - select(-difference) %>% - filter(pourc>0) %>% - mutate(TypeZone="Communes") %>% - rename(CodeZone = insee_com) %>% - select(-nom_com) %>% - mutate_if(is.factor,as.character) - - -# intersection epci --------- -etat_sage_epci<-st_intersection(st_buffer(n_sage_r52,0),st_buffer(n_epci_zsup_r52,0)) -# mapview(etat_sage_epci) - -indicateur_etat_sage_epci<-etat_sage_epci %>% - mutate(surf_sage_intersect=st_area(the_geom)) %>% - st_drop_geometry() %>% - select(nom,code,lb_etat,siren_epci,nom_epci,surf_epci,surf_sage_intersect) %>% - group_by(siren_epci,lb_etat) %>% - mutate(pourc=round(sum(surf_sage_intersect)/surf_epci*100,digits = 0)) %>% - ungroup() %>% - select(siren_epci,nom_epci,lb_etat,pourc) %>% - unique() %>% - group_by(siren_epci) %>% - mutate(difference=as_units(100)-sum(pourc)) %>% - mutate(pourc=ifelse(difference<as_units(0) & lb_etat=="mis_en_oeuvre",pourc+difference,pourc)) %>% - mutate(difference=ifelse(difference<as_units(0),as_units(0),difference)) %>% - ungroup() - -indicateur_etat_sage_epci<-bind_rows(indicateur_etat_sage_epci, - n_epci_zsup_r52 %>% - st_drop_geometry() %>% - select(siren_epci,nom_epci) %>% - mutate(lb_etat="hors_sage") %>% - left_join(indicateur_etat_sage_epci %>% - select(siren_epci,difference) %>% - unique()) - ) - -indicateur_etat_sage_epci<-indicateur_etat_sage_epci %>% - group_by(siren_epci) %>% - mutate(pourc=ifelse(is.na(pourc),difference,pourc)) %>% - ungroup() %>% - select(-difference) %>% - filter(pourc>0) %>% - mutate(TypeZone="Epci") %>% - rename(CodeZone = siren_epci) %>% - select(-nom_epci) %>% - mutate_if(is.factor,as.character) - - -# intersection départements ------------------ -etat_sage_departements<-st_intersection(st_buffer(n_sage_r52,0),st_buffer(n_departement_exp_r52,0)) -# mapview(etat_sage_departements) - -indicateur_etat_sage_departements<-etat_sage_departements %>% - mutate(surf_sage_intersect=st_area(the_geom)) %>% - st_drop_geometry() %>% - select(nom,code,lb_etat,insee_dep,surf_departement,nom_dep,surf_sage_intersect) %>% - group_by(insee_dep,lb_etat) %>% - mutate(pourc=round(sum(surf_sage_intersect)/surf_departement*100,digits = 0)) %>% - ungroup() %>% - select(insee_dep,nom_dep,lb_etat,pourc) %>% - unique() %>% - group_by(insee_dep) %>% - mutate(difference=as_units(100)-sum(pourc)) %>% - mutate(pourc=ifelse(difference<as_units(0) & lb_etat=="mis_en_oeuvre",pourc+difference,pourc)) %>% - mutate(difference=ifelse(difference<as_units(0),as_units(0),difference)) %>% - ungroup() - -indicateur_etat_sage_departements<-bind_rows(indicateur_etat_sage_departements, - n_departement_exp_r52 %>% - st_drop_geometry() %>% - select(insee_dep,nom_dep) %>% - mutate(lb_etat="hors_sage") %>% - left_join(indicateur_etat_sage_departements %>% - select(insee_dep,difference) %>% - unique()) - ) - -indicateur_etat_sage_departements<-indicateur_etat_sage_departements %>% - group_by(insee_dep) %>% - mutate(pourc=ifelse(is.na(pourc),difference,pourc)) %>% - ungroup() %>% - select(-difference) %>% - filter(pourc>0) %>% - mutate(TypeZone = "Départements") %>% - rename(CodeZone = insee_dep) %>% - select(-nom_dep) %>% - mutate_if(is.factor,as.character) - - -# intersection région ------------- -etat_sage_regions<-st_intersection(st_buffer(n_sage_r52,0),st_buffer(n_region_exp_r52,0)) -# mapview(etat_sage_regions)! - -indicateur_etat_sage_regions<-etat_sage_regions %>% - mutate(surf_sage_intersect = st_area(the_geom)) %>% - st_drop_geometry() %>% - select(nom,code,lb_etat,insee_reg,surf_region,surf_sage_intersect) %>% - group_by(lb_etat) %>% - mutate(pourc = round(sum(surf_sage_intersect)/surf_region*100,digits = 0)) %>% - ungroup() %>% - select(insee_reg,lb_etat,pourc) %>% - unique() %>% - mutate(difference = as_units(100)-sum(pourc)) - -indicateur_etat_sage_regions<-bind_rows(indicateur_etat_sage_regions, - n_region_exp_r52 %>% - st_drop_geometry() %>% - select(insee_reg) %>% - mutate(lb_etat="hors_sage") %>% - left_join(indicateur_etat_sage_regions %>% - select(insee_reg,difference) %>% - unique()) - ) - -indicateur_etat_sage_regions<-indicateur_etat_sage_regions %>% - mutate(pourc=ifelse(is.na(pourc),difference,pourc)) %>% - select(-difference) %>% - mutate(TypeZone = "Régions") %>% - rename(CodeZone = insee_reg) %>% - mutate_if(is.factor,as.character) %>% - filter(!is.na(lb_etat)) - - -# addition des tables -------- -indicateur_couverture_sage<-bind_rows(indicateur_etat_sage_communes, - indicateur_etat_sage_epci, - indicateur_etat_sage_departements, - indicateur_etat_sage_regions) %>% - mutate_if(is.character,as.factor) %>% - mutate(date=as.Date("2022-01-01")) %>% - rename(variable = lb_etat, valeur = pourc) - -indicateur_couverture_sage<-mutate(indicateur_couverture_sage,variable=case_when(variable=="mis_en_oeuvre"~ "pourcentage_territoire_couvert_par_sage_mis_en_oeuvre", - variable=="elaboration"~"pourcentage_territoire_couvert_par_sage_en_cours_d_elaboration", - variable=="premiere_revision"~"pourcentage_territoire_couvert_par_sage_en_premiere_revision", - variable=="hors_sage"~"pourcentage_territoire_hors_sage")) %>% - mutate_if(is.character,as.factor) - -# selon SIGLOIRE, mise à jour en continue (tâche planifiée se déclenche tous les 1er du mois), donc 2022-01-01 -# Zones d'application des Schémas d'aménagement et de gestion des eaux (SAGE) en Pays de la Loire -# https://catalogue.sigloire.fr/geonetwork/srv/fre/catalog.search;jsessionid=4BFDBE635A3699F7CC8151B1827679CE#/metadata/98864cf0-d06b-11de-b18a-00004f6210c3 - - -rm(indicateur_etat_sage_communes, - indicateur_etat_sage_epci, - indicateur_etat_sage_departements, - indicateur_etat_sage_regions) - - -# ajout du champs Zone avec COGiter ------------ -communes_pdl<-communes %>% - filter(REG== '52') %>% - select(DEPCOM,NOM_DEPCOM,EPCI) %>% - select(DEPCOM,NOM_DEPCOM) %>% - rename(CodeZone=DEPCOM,Zone=NOM_DEPCOM) # 1238 obs - -epci_pdl<-epci %>% - unnest(REGIONS_DE_L_EPCI) %>% - filter(REGIONS_DE_L_EPCI == '52') %>% - select(EPCI,NOM_EPCI) %>% - rename(CodeZone=EPCI,Zone=NOM_EPCI) # 71 obs - -departements_pdl<-departements %>% - filter(REG=='52') %>% - select(DEP,NOM_DEP) %>% - rename(CodeZone=DEP,Zone=NOM_DEP) - -region_pdl<-regions %>% - filter(REG=='52') %>% - select(REG,NOM_REG) %>% - rename(CodeZone=REG,Zone=NOM_REG) - -territoire_pdl<-bind_rows(communes_pdl, - departements_pdl, - epci_pdl, - region_pdl) %>% - mutate_if(is.factor,as.character) - -indicateur_couverture_sage<-left_join(indicateur_couverture_sage,territoire_pdl) %>% - mutate_if(is.character,as.factor) %>% - select(TypeZone,CodeZone,Zone,date,variable,valeur) %>% - filter(!is.na(variable)) - -specifique_couverture_sage<-indicateur_couverture_sage %>% - pivot_wider(names_from = variable,values_from = valeur, values_fill = 0) %>% - mutate(pourcentage_territoire_couvert_par_sage_mis_en_oeuvre = ifelse(is.na(pourcentage_territoire_couvert_par_sage_mis_en_oeuvre),0,pourcentage_territoire_couvert_par_sage_mis_en_oeuvre), - pourcentage_territoire_couvert_par_sage_en_cours_d_elaboration = ifelse(is.na(pourcentage_territoire_couvert_par_sage_en_cours_d_elaboration),0,pourcentage_territoire_couvert_par_sage_en_cours_d_elaboration), - # pourcentage_territoire_couvert_par_sage_en_premiere_revision = ifelse(is.na(pourcentage_territoire_couvert_par_sage_en_premiere_revision),0,pourcentage_territoire_couvert_par_sage_en_premiere_revision), - pourcentage_territoire_hors_sage = ifelse(is.na(pourcentage_territoire_hors_sage),0,pourcentage_territoire_hors_sage)) %>% - mutate(pourcentage_territoire_couvert_par_sage_en_premiere_revision = 0) - - -# table de passage territoire/SAGE ---------- - -ref_table_passage_communes_sage<-etat_sage_communes %>% - st_drop_geometry() %>% - mutate_if(is.factor,as.character) %>% - mutate(TypeZone = "Communes") %>% - select(TypeZone,insee_com,nom_com,code,nom,lb_etat) %>% - rename(CodeZone = insee_com, - Zone = nom_com, - code_sage = code, - nom_sage = nom, - etat_d_avancement_sage = lb_etat) - -ref_table_passage_epci_sage<-etat_sage_epci %>% - st_drop_geometry() %>% - mutate_if(is.factor,as.character) %>% - mutate(TypeZone = "Epci") %>% - select(TypeZone,siren_epci,nom_epci,code,nom,lb_etat) %>% - rename(CodeZone = siren_epci, - Zone = nom_epci, - code_sage = code, - nom_sage = nom, - etat_d_avancement_sage = lb_etat) - -ref_table_passage_departements_sage<-etat_sage_departements %>% - st_drop_geometry() %>% - mutate_if(is.factor,as.character) %>% - mutate(TypeZone = "Départements") %>% - select(TypeZone,insee_dep,nom_dep,code,nom,lb_etat) %>% - rename(CodeZone = insee_dep, - Zone = nom_dep, - code_sage = code, - nom_sage = nom, - etat_d_avancement_sage = lb_etat) - -ref_table_passage_regions_sage<-etat_sage_regions %>% - st_drop_geometry() %>% - mutate_if(is.factor,as.character) %>% - mutate(TypeZone = "Régions") %>% - select(TypeZone,insee_reg,code,nom,lb_etat) %>% - mutate(Zone = "Pays de la Loire") %>% - rename(CodeZone = insee_reg, - code_sage = code, - nom_sage = nom, - etat_d_avancement_sage = lb_etat) %>% - select(TypeZone,CodeZone,Zone,everything()) - -ref_table_passage_territoire_sage<-bind_rows(ref_table_passage_communes_sage, - ref_table_passage_epci_sage, - ref_table_passage_departements_sage, - ref_table_passage_regions_sage) %>% - mutate_if(is.character,as.factor) %>% - mutate(date=as.Date("2022-01-01")) - -rm(etat_sage_epci, - etat_sage_communes, - etat_sage_departements, - etat_sage_regions, - ref_table_passage_communes_sage, - ref_table_passage_epci_sage, - ref_table_passage_departements_sage, - ref_table_passage_regions_sage) - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = specifique_couverture_sage, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_couverture_sage", - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("TypeZone", "CodeZone", "Zone", "date"), # déclaration d'une clé primaire sur la table postée - user = "does") - - -# METADONNEES------------------------------------ - -## On récupère la liste des variables qui sont à documenter dans le tableur google sheet à partir du jeu de données posté -var <- setdiff(names(specifique_couverture_sage), c("TypeZone", "CodeZone", "Zone", "date")) - -## récupération du nom du présent script source pour filtrer ensuite le référentiel des indicateurs -nom_script_sce <- rstudioapi::getActiveDocumentContext()$path %>% # utilisation de rstudioapi pour récupérer le nom du présent script - basename() %>% # on enlève le chemin d'accès pour ne garder que le nom du fichier - gsub(pattern = ".R$", "", .) # on enlève l'extension '.R' - -## authentification google sheet grâce au .Renviron -gs4_auth_configure(api_key = Sys.getenv("google_api_key")) -gs4_deauth() - -## chargement du référentiel indicateurs google sheet -metadata_indicateur <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "indicateurs") %>% - # on ne garde que les variables concernées par le présent script de chargement - filter(source == nom_script_sce) %>% - # on ajoute l'unité dans le libellé de la variable - mutate(libelle_variable = paste0(libelle_variable, " (unit\u00e9 : ", unite, ")")) %>% - select(variable, libelle_variable) %>% - # ajout des libellés pour date - bind_rows( - tribble( - ~variable, ~libelle_variable, - "date", "Millesime" - ) - ) - -## Vérification que la documentation des indicateurs est complète -all(var %in% metadata_indicateur$variable) # doit renvoyer TRUE - -## Envoi des libellés de variable dans le SGBD -post_dico_attr(dico = metadata_indicateur, - table = "specifique_couverture_sage", - schema = "portrait_territoires", - db = "datamart", - user = "does") - -## Récupération des métadonnées de la source -nom_sce <- str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% - str_replace("indicateur_", "") %>% - str_replace("_cogiter|_cog$", "") - -metadata_source <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "sources") %>% - filter(source == nom_sce) %>% - mutate(com_table = paste0(source_lib, " - ", producteur, ".\n", descriptif_sources)) %>% - pull(com_table) - -## commentaires de la table -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_couverture_sage", - user = "does") - - -# versement de la table de passage et métadonnées ---------------- -poster_data(data = ref_table_passage_territoire_sage, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_table_passage_territoire_sage", - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("TypeZone", "CodeZone", "Zone", "code_sage", "nom_sage", "date"), # déclaration d'une clé primaire sur la table postée - user = "does") - -var <- setdiff(names(ref_table_passage_territoire_sage), c("TypeZone", "CodeZone", "Zone", "date")) -nom_script_sce <- "specifique_table_passage_territoire_sage" - -metadata_indicateur <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "indicateurs") %>% - filter(source == nom_script_sce) %>% - mutate(libelle_variable = paste0(libelle_variable, " (unit\u00e9 : ", unite, ")")) %>% - select(variable, libelle_variable) %>% - bind_rows( - tribble( - ~variable, ~libelle_variable, - "date", "Millesime" - ) - ) - -## Vérification que la documentation des indicateurs est complète -all(var %in% metadata_indicateur$variable) # doit renvoyer TRUE - -## Envoi des libellés de variable dans le SGBD -post_dico_attr(dico = metadata_indicateur, - table = "specifique_table_passage_territoire_sage", - schema = "portrait_territoires", - db = "datamart", - user = "does") - -## Récupération des métadonnées de la source -nom_sce <- "table_passage_territoire_sage" - -metadata_source <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "sources") %>% - filter(source == nom_sce) %>% - mutate(com_table = paste0(source_lib, " - ", producteur, ".\n", descriptif_sources)) %>% - pull(com_table) - -## commentaires de la table -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_table_passage_territoire_sage", - user = "does") diff --git a/data-raw/zz_etat_ecolo_cours_eau.R b/data-raw/zz_etat_ecolo_cours_eau.R deleted file mode 100644 index 5dc73c9..0000000 --- a/data-raw/zz_etat_ecolo_cours_eau.R +++ /dev/null @@ -1,286 +0,0 @@ - -# specifique_etat_ecologique_cours_eau - -# librairies -------- -library(readxl) -library(tidyverse) -library(datalibaba) -library(sf) -library(mapview) -library(COGiter) -library(googlesheets4) - -rm(list = ls()) - - -# chargement des données de l'Agence de l'eau Loire-Bretagne ------- -# le fichier Etat_Ecologique_cours_d_eau_2017_RESUME.xlsx a été récupéré sur le site de l'agence de l'eau Loire-Bretagne : -# https://donnees-documents.eau-loire-bretagne.fr/home/donnees/etat-2017-cours-deau.html -# https://donnees-documents.eau-loire-bretagne.fr/files/live/mounts/midas/Donnees-et-documents/Etat_Ecologique_cours_d_.92166786379235 -# un 2e onglet a été créé, ne conservant que les données utiles et renommant les champs -# état écologique des masses d’eau superficielles, hors masse d'eau de transition et plans d'eau ! -# état calculé avec les données 2015 à 2017 - -download.file(url = "https://donnees-documents.eau-loire-bretagne.fr/files/live/mounts/midas/Donnees-et-documents/Etat_Ecologique_cours_d_.92166786379235", - destfile = "extdata/Etat_Ecologique_cours_d_eau_2017_RESUME.xlsx") -# attention, le fichier téléchargé par cette commande peut être corrompu et ne pas être lisible - -etat_ecolo_cours_eau_2017<-read_excel(path = "extdata/Etat_Ecologique_cours_d_eau_2017_RESUME.xlsx", - sheet="Etat Cours d'eau", - skip = 5, - col_names = TRUE) - -etat_ecolo_cours_eau_2017<-etat_ecolo_cours_eau_2017 %>% - select(code_masse_d_eau = `code de la masse d'eau`, - nom_masse_d_eau = `Nom de la masse d'eau`, - cours_d_eau = `Cours d'eau`, - type_masse_d_eau = `Type de la masse d'eau`, - type_FR_masse_d_eau = `Type_FR de la masse d'eau`, - commision_territoriale = `commision territoriale`, - SAGE, - region_principale = `Region principale`, - regions_concernees = `Région(s) concernée(s)`, - departement_principal = `Département principal`, - departements_concernes = `Département(s) concerné(s)`, - etat_ecologique_valide = `État Écologique validé`, - niveau_de_confiance_valide = `Niveau de confiance validé`, - etat_ecologique_calcule = `État Écologique calculé`, - etat_biologique = `État Biologique`, - etat_physico_chimie_generale = `État physico-chimie générale`, - etat_polluants_specifiques = `État Polluants spécifiques`, - code_station_retenue_biologie_physico_chimie = `Station retenue...37`, - libelle_station_biologie_physico_chimie = Libellé...38, - code_station_retenue_polluants_specifiques = `Station retenue...39`, - libelle_station_retenue_polluants_specifiques = Libellé...40) - - - -n_masse_eau_bassin_versant_loire_bretagne <- importer_data(db = "si_eau", - schema = "hydrographie", - table = "n_masse_eau_bassin_versant_loire_bretagne") - -etat_ecolo_cours_eau_2017_geo<-right_join(n_masse_eau_bassin_versant_loire_bretagne, - etat_ecolo_cours_eau_2017 %>% - select(code_masse_d_eau, - nom_masse_d_eau,SAGE, - etat_ecologique_valide), - by=c("cd_eu_masse_eau"="code_masse_d_eau")) - - -# limites administratives ---------- -n_region_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_region_exp_r52") %>% - select(insee_reg,nom_reg) %>% - mutate(surf_region=st_area(the_geom)) - -n_departement_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_departement_exp_r52") %>% - select(insee_dep,nom) %>% - rename(nom_dep = nom) %>% - mutate(surf_departement=st_area(the_geom)) - -n_commune_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_commune_exp_r52") %>% - select(insee_com,nom,siren_epci) %>% - rename(nom_com = nom) %>% - mutate(surf_commune=st_area(the_geom)) - -n_epci_zsup_r52<-importer_data(db = "consultation", - schema = "donnee_generique", - table = "n_epci_zsup_r52") %>% - select(siren_epci,dep_epci,nom_epci) %>% - mutate(surf_epci=st_area(the_geom)) - - -# intersection des bassins versants de masse d'eau et des communes ------------- -etat_ecolo_cours_eau_2017_com<-st_intersection(st_buffer(etat_ecolo_cours_eau_2017_geo, 0), - st_buffer(n_commune_exp_r52, 0)) %>% - select(-c(superficie,shape_lenght,shape_area)) %>% - mutate(surf_me = st_area(the_geom)) - -# calcul de l'indicateur -# 1 :très bon ; 2 : bon ; 3 : moyen ; 4 : médiocre ; 5 : mauvais - -indicateur_etat_ecolo_cours_eau_com <- etat_ecolo_cours_eau_2017_com %>% - st_drop_geometry() %>% - group_by(insee_com, nom_com) %>% - mutate(surface_be_me = ifelse(etat_ecologique_valide<3, surf_me, 0)) %>% - summarise(surface_be_me = sum(surface_be_me), surf_commune = max(surf_commune)) %>% - mutate(indicateur = round(surface_be_me/surf_commune*100, digits = 1)) %>% - ungroup() - -indicateur_etat_ecolo_cours_eau_com<-left_join(n_commune_exp_r52, indicateur_etat_ecolo_cours_eau_com) %>% - select(-surf_commune) %>% - st_drop_geometry() %>% - mutate(indicateur = ifelse(is.na(indicateur), 0, indicateur)) %>% - mutate(TypeZone = "Communes", date = as.Date("2017-12-31"), variable = "part_cours_eau_bon_etat") %>% - rename(Zone = nom_com, CodeZone = insee_com, valeur = indicateur) %>% - mutate_if(is.character,as.factor) %>% - select(TypeZone, CodeZone, Zone, variable, valeur, date) - - -# intersection des bassins versants de masse d'eau et des EPCI ------------- -etat_ecolo_cours_eau_2017_epci <- st_intersection(st_buffer(etat_ecolo_cours_eau_2017_geo, 0), - st_buffer(n_epci_zsup_r52, 0)) %>% - select(-c(superficie,shape_lenght,shape_area)) %>% - mutate(surf_me = st_area(the_geom)) - -# calcul de l'indicateur -# 1 :très bon ; 2 : bon ; 3 : moyen ; 4 : médiocre ; 5 : mauvais - -indicateur_etat_ecolo_cours_eau_epci <- etat_ecolo_cours_eau_2017_epci %>% - st_drop_geometry() %>% - group_by(siren_epci, nom_epci) %>% - mutate(surface_be_me = ifelse(etat_ecologique_valide<3, surf_me, 0)) %>% - summarise(surface_be_me = sum(surface_be_me), surf_epci = max(surf_epci)) %>% - mutate(indicateur = round(surface_be_me/surf_epci*100, digits = 1)) %>% - ungroup() - -indicateur_etat_ecolo_cours_eau_epci<-left_join(n_epci_zsup_r52,indicateur_etat_ecolo_cours_eau_epci) %>% - select(-surf_epci) %>% - st_drop_geometry() %>% - mutate(indicateur = ifelse(is.na(indicateur),0,indicateur)) %>% - mutate(TypeZone = "Epci",date = as.Date("2017-12-31"), variable = "part_cours_eau_bon_etat") %>% - rename(Zone = nom_epci,CodeZone = siren_epci, valeur = indicateur) %>% - mutate_if(is.character,as.factor) %>% - select(TypeZone,CodeZone,Zone,variable,valeur,date) - - -# intersection des bassins versants de masse d'eau et des départements ------------------ -etat_ecolo_cours_eau_2017_dept <- st_intersection(st_buffer(etat_ecolo_cours_eau_2017_geo, 0), - st_buffer(n_departement_exp_r52, 0)) %>% - select(-c(superficie,shape_lenght,shape_area)) %>% - mutate(surf_me = st_area(the_geom)) - -# calcul de l'indicateur -# 1 :très bon ; 2 : bon ; 3 : moyen ; 4 : médiocre ; 5 : mauvais - -indicateur_etat_ecolo_cours_eau_dept <- etat_ecolo_cours_eau_2017_dept %>% - st_drop_geometry() %>% - group_by(insee_dep,nom_dep) %>% - mutate(surface_be_me = ifelse(etat_ecologique_valide<3, surf_me, 0)) %>% - summarise(surface_be_me = sum(surface_be_me), surf_departement = max(surf_departement)) %>% - mutate(indicateur = round(surface_be_me/surf_departement*100, digits = 1)) %>% - ungroup() %>% - select(insee_dep, nom_dep, indicateur) %>% - unique() - -indicateur_etat_ecolo_cours_eau_dept<-left_join(n_departement_exp_r52, indicateur_etat_ecolo_cours_eau_dept) %>% - select(-surf_departement) %>% - st_drop_geometry() %>% - mutate(indicateur = ifelse(is.na(indicateur), 0, indicateur)) %>% - mutate(TypeZone = "Départements", date = as.Date("2017-12-31"), variable = "part_cours_eau_bon_etat") %>% - rename(Zone = nom_dep, CodeZone = insee_dep, valeur = indicateur) %>% - mutate_if(is.character,as.factor) %>% - select(TypeZone, CodeZone, Zone, variable, valeur, date) - - -# intersection des bassins versants de masse d'eau et de la région -etat_ecolo_cours_eau_2017_region <- st_intersection(st_buffer(etat_ecolo_cours_eau_2017_geo, 0), - st_buffer(n_region_exp_r52, 0)) %>% - select(-c(superficie,shape_lenght, shape_area)) %>% - mutate(surf_me = st_area(the_geom)) - -# calcul de l'indicateur -# 1 :très bon ; 2 : bon ; 3 : moyen ; 4 : médiocre ; 5 : mauvais - -indicateur_etat_ecolo_cours_eau_region <- etat_ecolo_cours_eau_2017_region %>% - st_drop_geometry() %>% - filter(etat_ecologique_valide<3) %>% - mutate(indicateur = round(sum(surf_me)/surf_region*100, digits = 1)) %>% - select(insee_reg, nom_reg, indicateur) %>% - unique() - -indicateur_etat_ecolo_cours_eau_region <- left_join(n_region_exp_r52, indicateur_etat_ecolo_cours_eau_region) %>% - select(-surf_region) %>% - st_drop_geometry() %>% - mutate(indicateur = ifelse(is.na(indicateur), 0, indicateur)) %>% - mutate(TypeZone = "Régions", date = as.Date("2017-12-31"), variable = "part_cours_eau_bon_etat") %>% - rename(Zone = nom_reg, CodeZone = insee_reg, valeur = indicateur) %>% - mutate_if(is.character, as.factor) %>% - select(TypeZone, CodeZone, Zone, variable, valeur, date) - - -# compilation communes, EPCI, départements, région --------- -indicateur_etat_ecolo_cours_eau<-bind_rows(indicateur_etat_ecolo_cours_eau_com, - indicateur_etat_ecolo_cours_eau_epci, - indicateur_etat_ecolo_cours_eau_dept, - indicateur_etat_ecolo_cours_eau_region) - -specifique_etat_ecolo_cours_eau<-pivot_wider(indicateur_etat_ecolo_cours_eau, - names_from = variable, - values_from = valeur) - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = specifique_etat_ecolo_cours_eau, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_etat_ecolo_cours_eau", - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("TypeZone", "CodeZone", "Zone", "date"), # déclaration d'une clé primaire sur la table postée - user = "does") - - -# METADONNEES------------------------------------ - -## On récupère la liste des variables qui sont à documenter dans le tableur google sheet à partir du jeu de données posté -var <- setdiff(names(specifique_etat_ecolo_cours_eau), c("TypeZone", "CodeZone", "Zone", "date")) - -## récupération du nom du présent script source pour filtrer ensuite le référentiel des indicateurs -nom_script_sce <- rstudioapi::getActiveDocumentContext()$path %>% # utilisation de rstudioapi pour récupérer le nom du présent script - basename() %>% # on enlève le chemin d'accès pour ne garder que le nom du fichier - gsub(pattern = ".R$", "", .) # on enlève l'extension '.R' - -## authentification google sheet grâce au .Renviron -gs4_auth_configure(api_key = Sys.getenv("google_api_key")) -gs4_deauth() - -## chargement du référentiel indicateurs google sheet -metadata_indicateur <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "indicateurs") %>% - # on ne garde que les variables concernées par le présent script de chargement - filter(source == nom_script_sce) %>% - # on ajoute l'unité dans le libellé de la variable - mutate(libelle_variable = paste0(libelle_variable, " (unit\u00e9 : ", unite, ")")) %>% - select(variable, libelle_variable) %>% - # ajout des libellés pour date - bind_rows( - tribble( - ~variable, ~libelle_variable, - "date", "Millesime" - ) - ) - -## Vérification que la documentation des indicateurs est complète -all(var %in% metadata_indicateur$variable) # doit renvoyer TRUE - -## Envoi des libellés de variable dans le SGBD -post_dico_attr(dico = metadata_indicateur, - table = "specifique_etat_ecolo_cours_eau", - schema = "portrait_territoires", - db = "datamart", - user = "does") - -## Récupération des métadonnées de la source -nom_sce <- str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% - str_replace("indicateur_", "") %>% - str_replace("_cogiter|_cog$", "") - -metadata_source <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "sources") %>% - filter(source == nom_sce) %>% - mutate(com_table = paste0(source_lib, " - ", producteur, ".\n", descriptif_sources)) %>% - pull(com_table) - -## commentaires de la table -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_etat_ecolo_cours_eau", - user = "does") diff --git a/data-raw/zz_gestion_durable_foret.R b/data-raw/zz_gestion_durable_foret.R deleted file mode 100644 index 952a3f2..0000000 --- a/data-raw/zz_gestion_durable_foret.R +++ /dev/null @@ -1,186 +0,0 @@ -# specifique_gestion_durable_foret - -# librairies ------- -library(readxl) -library(tidyverse) -library(lubridate) -library(mefa4) -library(COGiter) -library(datalibaba) - -rm(list = ls()) - - -# chargement des données du CRPF ---------------- -# données élaborées par le Centre Régional de la Propriété Forestière (CRPF) à partir d'une requête spatiale EPCI - -# Au titre du Code Forestier 5 documents sont considérés comme des Documents de Gestion Durable. -# En l'occurrence, pour l'exercice demandé, il est donc légitime de les additionner. - -# PSG = plan simple de gestion (pour les forêts > 25 ha) --> garantie de gestion durable -# PSG volontaire = idem pour forêts de 10 à 25 ha --> garantie de gestion durable -# RTG = règlement type de gestion, càd pour des surfaces < 25 ha -# adhésion à un règlement type établi par un gestionnaire habilité pour cela, -# la plupart du temps une coopérative --> garantie de gestion durable -# CBPS = code de bonnes pratiques sylvicoles (forêts < 25 ha) : adhésion à des principes de gestion durable -# devant être respectés --> présomption de garantie de gestion durable -# CBPS+ = idem assorti d'un programme de coupes et travaux spécifique à la forêt concernée --> présomption de garantie de gestion durable - -# Les chiffres ne concernent donc que la forêt privée. Celle-ci représente 90% de la forêt des Pays de la Loire. -# Les forêts publiques sont, sauf exception, gérées par l'ONF sur la base d'un aménagement forestier, -# constituant, lui aussi, une garantie de gestion durable. - -# Le pourcentage de gestion durable en forêt publique est -# donc proche de 100% (aux forêts en cours de renouvellement d'aménagement si latence, -# ou aux forêts nouvellement acquises par des collectivités près). - -# La surface forestière de référence retenue, nécessaire pour obtenir un pourcentage, -# est celle de la BD Forêt de l'IGN du moment, même si l'on sait qu'elle est fluctuante. - -# Corrections à la main de la ligne 271 du fichier .xlsx : -# de la ligne 271 : CBPS+ au lieu de CBPS déjà renseigné pour CC du Val de Sarthe -# et de la ligne 91 : Obligatoire (plus de 25 ha) au lieu de PSG - nouveau seuil 2011 pour CC Châteaubriant-Derval - -crpf_dgd_epci<-read_excel(path = "extdata/DGDpar EPCI_Copie de stat_pdl_epci.xlsx") - - -# traitement des données ---------- -crpf_dgd_epci_total<-crpf_dgd_epci %>% - filter(!is.na(`Proportion de forêt sous DGD (%)`)) %>% - rename(NOM_EPCI=EPCI, - surface_gestion_durable = `Surface DGD (ha)`, - surface_totale_foret = `Surface forêt (BD Forêt v2) (ha)`, - pourcentage_foret_geree_durablement = `Proportion de forêt sous DGD (%)`) - -liste_EPCI<-crpf_dgd_epci_total %>% - select(NOM_EPCI) - -crpf_dgd_epci_detail<-crpf_dgd_epci %>% - select(-c(`Surface forêt (BD Forêt v2) (ha)`,`Proportion de forêt sous DGD (%)`)) %>% - mutate(EPCI=case_when(EPCI=="Volontaire (moins de 25 ha)"~"PSG_volontaire", - EPCI=="Obligatoire (plus de 25 ha)"~"PSG_obligatoire", - T~EPCI)) %>% - filter(EPCI!="PSG") %>% - rename(surface_ha=`Surface DGD (ha)`) %>% - mutate(NOM_EPCI=ifelse(EPCI %in% unique(liste_EPCI$NOM_EPCI),EPCI,NA)) %>% - mutate(NOM_EPCI=ifelse(is.na(NOM_EPCI),lag(NOM_EPCI),NOM_EPCI)) %>% # pas très élégant - mutate(NOM_EPCI=ifelse(is.na(NOM_EPCI),lag(NOM_EPCI),NOM_EPCI)) %>% - mutate(NOM_EPCI=ifelse(is.na(NOM_EPCI),lag(NOM_EPCI),NOM_EPCI)) %>% - mutate(NOM_EPCI=ifelse(is.na(NOM_EPCI),lag(NOM_EPCI),NOM_EPCI)) %>% - mutate(NOM_EPCI=ifelse(is.na(NOM_EPCI),lag(NOM_EPCI),NOM_EPCI)) %>% - filter(EPCI %notin% unique(liste_EPCI$NOM_EPCI)) %>% - rename(document_gestion_durable=EPCI) %>% - complete(document_gestion_durable,NOM_EPCI,fill = list(surface_ha =0)) %>% - pivot_wider(names_from = document_gestion_durable,values_from = surface_ha) - -crpf_dgd_epci<-left_join(crpf_dgd_epci_detail,crpf_dgd_epci_total) - - -# renommage des EPCI en référence aux EPCI du package COGiter ---------- -epci_pdl<-epci %>% filter(grepl(52,REGIONS_DE_L_EPCI)) -x<-inner_join(liste_EPCI,epci) # 60 obs -y<-anti_join(liste_EPCI,epci) # 10 obs - -crpf_dgd_epci<-crpf_dgd_epci %>% - mutate(NOM_EPCI=case_when(NOM_EPCI=="CA Agglomération du Choletais"~ "CA du Choletais", - NOM_EPCI=="CA de la Presqu'île de Guérande Atlantique (CAP ATLANTIQUE)"~"CA de la Presqu'île de Guérande Atlantique (Cap Atlantique)", - NOM_EPCI=="CA La Roche sur Yon - Agglomération"~"CA La Roche-sur-Yon Agglomération", - NOM_EPCI=="CA Laval Agglomération"~"CA de Laval Agglomération", - NOM_EPCI=="CC du Pays de Fontenay-Vendée"~"CC Pays de Fontenay-Vendée", - NOM_EPCI=="CC du Pays de Pontchâteau St-Gildas-des-Bois"~"CC du Pays de Pontchâteau Saint-Gildas-des-Bois", - NOM_EPCI=="CC du Pays de St Gilles-Croix-de-Vie"~"CC du Pays de Saint-Gilles-Croix-de-Vie", - NOM_EPCI=="CC du Sud Estuaire"~"CC du Sud-Estuaire", - NOM_EPCI=="CC Maine Coeur de Sarthe"~"CC Maine Cœur de Sarthe", - NOM_EPCI=="CC Terres de Montaigu, CC Montaigu-Rocheservière"~"CC Terres-de-Montaigu, communauté de communes Montaigu-Rocheservière", - T~NOM_EPCI)) - -x<-semi_join(crpf_dgd_epci,epci_pdl) # 70 obs -y<-anti_join(epci_pdl,crpf_dgd_epci) # CC de l'Île de Noirmoutier - - -# ajout de l'EPCI CC de l'Île de Noirmoutier -------- -# consultation du sgdb avec QGIS : consultation/foret/n_foret_prive_dgd_s_r52 et n_foret_publique_2009_s_r52 -# aucune forêt privée (avec un document de gestion forestière durable) ou publique pour CC de l'Île de Noirmoutier - -specifique_gestion_durable_foret<-left_join(epci_pdl %>% select(EPCI,NOM_EPCI),crpf_dgd_epci) - - -# finalisation de la table en format large ---------- -specifique_gestion_durable_foret<-crpf_dgd_epci %>% - left_join(epci_pdl) %>% - gather(key = "variable",value = "valeur",CBPS:pourcentage_foret_geree_durablement) %>% - mutate(valeur=ifelse(is.na(valeur),0,valeur)) %>% - mutate(TypeZone="Epci") %>% - rename(CodeZone = EPCI,Zone=NOM_EPCI) %>% - mutate(date = dmy("01-01-2021")) %>% - mutate_if(is.character,as.factor) %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur) %>% - pivot_wider(names_from = variable,values_from = valeur) - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = specifique_gestion_durable_foret, - table = "specifique_gestion_durable_foret", - schema = "portrait_territoires", - db = "datamart", - user = "does", - overwrite = TRUE) - - -# METADONNEES------------------------------------ - -## On récupère la liste des variables qui sont à documenter dans le tableur google sheet à partir du jeu de données posté -var <- setdiff(names(specifique_gestion_durable_foret), c("TypeZone", "CodeZone", "Zone", "date")) - -## récupération du nom du présent script source pour filtrer ensuite le référentiel des indicateurs -nom_script_sce <- rstudioapi::getActiveDocumentContext()$path %>% # utilisation de rstudioapi pour récupérer le nom du présent script - basename() %>% # on enlève le chemin d'accès pour ne garder que le nom du fichier - gsub(pattern = ".R$", "", .) # on enlève l'extension '.R' - -## authentification google sheet grâce au .Renviron -gs4_auth_configure(api_key = Sys.getenv("google_api_key")) -gs4_deauth() - -## chargement du référentiel indicateurs google sheet -metadata_indicateur <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "indicateurs") %>% - # on ne garde que les variables concernées par le présent script de chargement - filter(source == nom_script_sce) %>% - # on ajoute l'unité dans le libellé de la variable - mutate(libelle_variable = paste0(libelle_variable, " (unit\u00e9 : ", unite, ")")) %>% - select(variable, libelle_variable) %>% - # ajout des libellés pour date - bind_rows( - tribble( - ~variable, ~libelle_variable, - "date", "Millesime" - ) - ) - -## Vérification que la documentation des indicateurs est complète -all(var %in% metadata_indicateur$variable) # doit renvoyer TRUE - -## Envoi des libellés de variable dans le SGBD -post_dico_attr(dico = metadata_indicateur, - table = "specifique_gestion_durable_foret", - schema = "portrait_territoires", - db = "datamart", - user = "does") - -## Récupération des métadonnées de la source -nom_sce <- str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% - str_replace("indicateur_", "") %>% - str_replace("_cogiter|_cog$", "") - -metadata_source <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "sources") %>% - filter(source == nom_sce) %>% - mutate(com_table = paste0(source_lib, " - ", producteur, ".\n", descriptif_sources)) %>% - pull(com_table) - -## commentaires de la table -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_gestion_durable_foret", - user = "does") diff --git a/data-raw/zz_indicateur_captage_prioritaire_protection_action.R b/data-raw/zz_indicateur_captage_prioritaire_protection_action.R deleted file mode 100644 index 20571ec..0000000 --- a/data-raw/zz_indicateur_captage_prioritaire_protection_action.R +++ /dev/null @@ -1,178 +0,0 @@ - -# indicateur_captage_prioritaire_protection_action - -# librairies ---------- -library(datalibaba) -library(tidyverse) -library(sf) -library(lubridate) -library(googlesheets4) - -rm(list=ls()) - - -# limites administratives ---------- - -n_commune_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_commune_exp_r52") %>% - select(insee_com, nom_com = nom) %>% - mutate(surf_commune = st_area(the_geom)) - -n_epci_zsup_r52<-importer_data(db = "consultation", - schema = "donnee_generique", - table = "n_epci_zsup_r52") %>% - select(siren_epci, nom_epci) %>% - mutate(surf_epci = st_area(the_geom)) - -n_departement_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_departement_exp_r52") %>% - select(insee_dep, nom_dep = nom) %>% - mutate(surf_departement = st_area(the_geom)) - -n_region_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_region_exp_r52") %>% - select(insee_reg, nom_reg) %>% - mutate(surf_region = st_area(the_geom)) - - -# protection des captages -------------- -r_ppcaptages_s_r52 <- importer_data(db = "si_eau", - schema = "eau_potable", - table = "r_ppcaptages_s_r52") # 878 obs -protection_captage <- summarise(st_buffer(r_ppcaptages_s_r52, 0), do_union = TRUE) - - -# intersection protection et territoires ---------- - -intersection_protection_captage_commune <- st_intersection(st_buffer(protection_captage, 0), st_buffer(n_commune_exp_r52, 0)) - -intersection_protection_captage_commune_2 <- intersection_protection_captage_commune %>% - mutate(surf_protection_captage = st_area(geom)) %>% - st_drop_geometry() %>% - group_by(insee_com, nom_com) %>% - mutate(part_protection_captage = round(surf_protection_captage/surf_commune*100, digits = 2)) %>% - ungroup() %>% - right_join(n_commune_exp_r52 %>% st_drop_geometry()) %>% - select(insee_com, nom_com, part_protection_captage) %>% - mutate(part_protection_captage = ifelse(is.na(part_protection_captage), 0, part_protection_captage)) %>% - mutate(TypeZone = "Communes", date = today()) %>% - rename(CodeZone = insee_com, Zone = nom_com) - -intersection_protection_captage_epci <- st_intersection(st_buffer(protection_captage, 0), st_buffer(n_epci_zsup_r52, 0)) - -intersection_protection_captage_epci_2 <- intersection_protection_captage_epci %>% - mutate(surf_protection_captage = st_area(geom)) %>% - st_drop_geometry() %>% - group_by(siren_epci, nom_epci) %>% - mutate(part_protection_captage = round(surf_protection_captage/surf_epci*100, digits = 2)) %>% - ungroup() %>% - right_join(n_epci_zsup_r52 %>% st_drop_geometry()) %>% - select(siren_epci, nom_epci, part_protection_captage) %>% - mutate(part_protection_captage = ifelse(is.na(part_protection_captage), 0, part_protection_captage)) %>% - mutate(TypeZone = "Epci", date=today()) %>% - rename(CodeZone = siren_epci, Zone = nom_epci) - -intersection_protection_captage_departement <- st_intersection(st_buffer(protection_captage, 0), st_buffer(n_departement_exp_r52, 0)) - -intersection_protection_captage_departement_2 <- intersection_protection_captage_departement %>% - mutate(surf_protection_captage = st_area(geom)) %>% - st_drop_geometry() %>% - group_by(insee_dep, nom_dep) %>% - mutate(part_protection_captage = round(surf_protection_captage/surf_departement*100, digits = 2)) %>% - ungroup() %>% - right_join(n_departement_exp_r52 %>% st_drop_geometry()) %>% - select(insee_dep, nom_dep, part_protection_captage) %>% - mutate(part_protection_captage = ifelse(is.na(part_protection_captage), 0, part_protection_captage)) %>% - mutate(TypeZone="Départements", date=today()) %>% - rename(CodeZone = insee_dep, Zone = nom_dep) - -intersection_protection_captage_region <- st_intersection(st_buffer(protection_captage, 0), st_buffer(n_region_exp_r52, 0)) - -intersection_protection_captage_region_2 <- intersection_protection_captage_region %>% - mutate(surf_protection_captage = st_area(geom)) %>% - st_drop_geometry() %>% - mutate(part_protection_captage = round(surf_protection_captage/surf_region*100, digits = 2)) %>% - select(insee_reg, nom_reg, part_protection_captage) %>% - mutate(TypeZone="Régions", date=today()) %>% - mutate(part_protection_captage = as.numeric(part_protection_captage)) %>% - rename(CodeZone = insee_reg, Zone = nom_reg) - -intersection_protection_captage_territoire<-bind_rows(intersection_protection_captage_commune_2, - intersection_protection_captage_epci_2, - intersection_protection_captage_departement_2, - intersection_protection_captage_region_2) %>% - select(TypeZone, CodeZone, Zone, date, part_protection_captage) - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = intersection_protection_captage_territoire, - db = "datamart", - schema = "portrait_territoires", - table = "indicateur_captage_prioritaire_protection_action", - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("TypeZone", "Zone", "CodeZone", "date"), # déclaration d'une clé primaire sur la table postée - user = "does") - - -# METADONNEES------------------------------------ - -## On récupère la liste des variables qui sont à documenter dans le tableur google sheet à partir du jeu de données posté -var <- setdiff(names(intersection_protection_captage_territoire), c("TypeZone", "Zone", "CodeZone", "date")) - -## récupération du nom du présent script source pour filtrer ensuite le référentiel des indicateurs -nom_script_sce <- rstudioapi::getActiveDocumentContext()$path %>% # utilisation de rstudioapi pour récupérer le nom du présent script - basename() %>% # on enlève le chemin d'accès pour ne garder que le nom du fichier - gsub(pattern = ".R$", "", .) # on enlève l'extension '.R' - -## authentification google sheet grâce au .Renviron -gs4_auth_configure(api_key = Sys.getenv("google_api_key")) -gs4_deauth() - -## chargement du référentiel indicateurs google sheet -metadata_indicateur <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "indicateurs") %>% - # on ne garde que les variables concernées par le présent script de chargement - filter(source == nom_script_sce) %>% - # on ajoute l'unité dans le libellé de la variable - mutate(libelle_variable = paste0(libelle_variable, " (unit\u00e9 : ", unite, ")")) %>% - select(variable, libelle_variable) %>% - # ajout des libellés pour depcom et date - bind_rows( - tribble( - ~variable, ~libelle_variable, - "date", "Millesime" - ) - ) - -## Vérification que la documentation des indicateurs est complète -all(var %in% metadata_indicateur$variable) # doit renvoyer TRUE - -## envoi des libellés de variable dans le SGBD -post_dico_attr(dico = metadata_indicateur, - table = "indicateur_captage_prioritaire_protection_action", - schema = "portrait_territoires", - db = "datamart", - user = "does") - -## récupération des métadonnées de la source -nom_sce <- str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% - str_replace("indicateur_", "") %>% - str_replace("_cogiter|_cog$", "") - -metadata_source <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "sources") %>% - filter(source == nom_sce) %>% - mutate(com_table = paste0(source_lib, " - ", producteur, ".\n", descriptif_sources)) %>% - pull(com_table) - -## commentaires de la table -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "indicateur_captage_prioritaire_protection_action", - user = "does") diff --git a/data-raw/zz_ocsge_comparaison_auran_ddtm85.R b/data-raw/zz_ocsge_comparaison_auran_ddtm85.R deleted file mode 100644 index 2e55d84..0000000 --- a/data-raw/zz_ocsge_comparaison_auran_ddtm85.R +++ /dev/null @@ -1,212 +0,0 @@ - -# ocsge_comparaison_auran_ddtm85 - -# comparaison entre nomenclatures ddtm 85 et auran - -# librairies ------ -library(DBI) -library(RPostgreSQL) -library(dplyr) -library(COGiter) -library(tidyr) - -rm(list = ls()) - -# chargement data ---------- -drv <- dbDriver("PostgreSQL") -con_datamart <- dbConnect(drv, - dbname="datamart", - host=Sys.getenv("server"), - port=Sys.getenv("port"), - user=Sys.getenv("userid"), - password=Sys.getenv("pwd_does")) -postgresqlpqExec(con_datamart, "SET client_encoding = 'windows-1252'") - -cogifiee_ocsge_ddtm85<-dbReadTable(con_datamart,c("portrait_territoires","cogifiee_ocsge")) - -cogifiee_ocsge_auran<-dbReadTable(con_datamart,c("portrait_territoires","cogifiee_ocsge_auran")) - - -# comparaison espaces artificialisés --------- -espace_artificialise_ddtm85<-select(cogifiee_ocsge_ddtm85,TypeZone,Zone,CodeZone,date, - espace_artificialise_ddtm85=espace_artificialise) - -espace_artificialise_auran<-cogifiee_ocsge_auran %>% - group_by(TypeZone,Zone,CodeZone,date) %>% - mutate(espace_artificialise=type_1+type_2+type_3+type_4+type_5) %>% - ungroup() %>% - select(TypeZone,Zone,CodeZone,date,espace_artificialise_auran=espace_artificialise) - -comparaison_espace_espace_artificialise_auran_ddtm85<-inner_join(espace_artificialise_auran, - espace_artificialise_ddtm85) %>% - mutate(espace_artificialise_auran_ha=round(espace_artificialise_auran/10000,digits = 2), # conversion en ha - espace_artificialise_ddtm85_ha=round(espace_artificialise_ddtm85/10000,digits = 2)) %>% - mutate(difference_ha = espace_artificialise_auran_ha - espace_artificialise_ddtm85_ha) %>% - select(-espace_artificialise_auran,-espace_artificialise_ddtm85) %>% - filter(TypeZone != "France") %>% - mutate_if(is.character,as.factor) - - -# comparaison espaces agricoles ---------- -espace_agricole_ddtm85<-select(cogifiee_ocsge_ddtm85,TypeZone,Zone,CodeZone,date, - espace_agricole_ddtm85=espace_agricole) - -espace_agricole_auran<-select(cogifiee_ocsge_auran,TypeZone,Zone,CodeZone,date, - espace_agricole_auran=type_6) - -comparaison_espace_agricole_auran_ddtm85<-inner_join(espace_agricole_auran, - espace_agricole_ddtm85) %>% - mutate(espace_agricole_auran_ha=round(espace_agricole_auran/10000,digits = 2), # conversion en ha - espace_agricole_ddtm85_ha=round(espace_agricole_ddtm85/10000,digits = 2)) %>% - mutate(difference_ha = espace_agricole_auran_ha - espace_agricole_ddtm85_ha) %>% - select(-espace_agricole_auran,-espace_agricole_ddtm85) %>% - filter(TypeZone != "France") %>% - mutate_if(is.character,as.factor) - - -# comparaison espaces naturels boisés -------------- -espace_naturel_boise_ddtm85<-select(cogifiee_ocsge_ddtm85,TypeZone,Zone,CodeZone,date, - espace_naturel_boise_ddtm85=surface_naturelle_boisee) - -espace_naturel_boise_auran<-select(cogifiee_ocsge_auran,TypeZone,Zone,CodeZone,date, - espace_naturel_boise_auran=type_7) - -comparaison_espace_naturel_boise_auran_ddtm85<-inner_join(espace_naturel_boise_auran, - espace_naturel_boise_ddtm85) %>% - mutate(espace_naturel_boise_auran_ha=round(espace_naturel_boise_auran/10000,digits = 2), # conversion en ha - espace_naturel_boise_ddtm85_ha=round(espace_naturel_boise_ddtm85/10000,digits = 2)) %>% - mutate(difference_ha = espace_naturel_boise_auran_ha - espace_naturel_boise_ddtm85_ha) %>% - select(-espace_naturel_boise_auran,-espace_naturel_boise_ddtm85) %>% - filter(TypeZone != "France") %>% - mutate_if(is.character,as.factor) - - -# comparaison autres espaces naturels ------------- -autre_espace_naturel_ddtm85<-select(cogifiee_ocsge_ddtm85,TypeZone,Zone,CodeZone,date, - autre_espace_naturel_ddtm85=autre_surface_naturelle) - -autre_espace_naturel_auran<-select(cogifiee_ocsge_auran,TypeZone,Zone,CodeZone,date, - autre_espace_naturel_auran=type_8) - -comparaison_autre_espace_naturel_auran_ddtm85<-inner_join(autre_espace_naturel_auran, - autre_espace_naturel_ddtm85) %>% - mutate(autre_espace_naturel_auran_ha=round(autre_espace_naturel_auran/10000,digits = 2), # conversion en ha - autre_espace_naturel_ddtm85_ha=round(autre_espace_naturel_ddtm85/10000,digits = 2)) %>% - mutate(difference_ha = autre_espace_naturel_auran_ha - autre_espace_naturel_ddtm85_ha) %>% - select(-autre_espace_naturel_auran,-autre_espace_naturel_ddtm85) %>% - filter(TypeZone != "France") %>% - mutate_if(is.character,as.factor) - - -# comparaison surfaces en eau ----------- -surface_en_eau_ddtm85<-select(cogifiee_ocsge_ddtm85,TypeZone,Zone,CodeZone,date, - surface_en_eau_ddtm85=surface_en_eau) - -surface_en_eau_auran<-select(cogifiee_ocsge_auran,TypeZone,Zone,CodeZone,date, - surface_en_eau_auran=type_9) - -comparaison_surface_en_eau_auran_ddtm85<-inner_join(surface_en_eau_auran, - surface_en_eau_ddtm85) %>% - mutate(surface_en_eau_auran_ha=round(surface_en_eau_auran/10000,digits = 2), # conversion en ha - surface_en_eau_ddtm85_ha=round(surface_en_eau_ddtm85/10000,digits = 2)) %>% - mutate(difference_ha = surface_en_eau_auran_ha - surface_en_eau_ddtm85_ha) %>% - select(-surface_en_eau_auran,-surface_en_eau_ddtm85) %>% - filter(TypeZone != "France") %>% - mutate_if(is.character,as.factor) - - -# sauvegarde ---------- -save(comparaison_espace_espace_artificialise_auran_ddtm85, - comparaison_espace_agricole_auran_ddtm85, - comparaison_espace_naturel_boise_auran_ddtm85, - comparaison_autre_espace_naturel_auran_ddtm85, - comparaison_surface_en_eau_auran_ddtm85, - file = "sysdata/ocsge_comparaison_auran_ddtm85.RData") - - -# graphiques niveau régional ------------ -ocsge_ddtm85<-pivot_longer(cogifiee_ocsge_ddtm85, - cols = a_definir:surface_naturelle_boisee, - names_to = "variable", - values_to = "valeur") %>% - filter(variable != "a_definir") - -ocsge_auran<-cogifiee_ocsge_auran %>% - group_by(TypeZone,Zone,CodeZone,date) %>% - mutate(espace_artificialise=type_1+type_2+type_3+type_4+type_5) %>% - ungroup() %>% - select(-c(type_1,type_2,type_3,type_4,type_5)) %>% - rename(espace_agricole=type_6, - surface_naturelle_boisee=type_7, - autre_surface_naturelle=type_8, - surface_en_eau=type_9) %>% - select(-type_0) %>% - select(TypeZone,Zone,CodeZone,date, - autre_surface_naturelle, - espace_agricole, - espace_artificialise, - surface_en_eau, - surface_naturelle_boisee) %>% - gather(key = "variable",value = "valeur",autre_surface_naturelle:surface_naturelle_boisee) - -# donut de la typologie de l'ocsge -library(leaflet) -library(highcharter) -library(htmlwidgets) - -typologie_ocsge<- ocsge_ddtm85 %>% - select(variable) %>% - unique() - -factpal_ocsge_typologie <- colorFactor(palette = c("green", "#FFFF00", "#FF9900", "blue","#006600"), - levels = typologie_ocsge$variable, - reverse = FALSE) -# Levels: -# autre surface naturelle, -# espace agricole, -# espace artificialisé, -# surface en eau, -# surface naturelle boisée - -couleur_ocsge_typologie<-factpal_ocsge_typologie(typologie_ocsge$variable) - -mil<-2013 -modele<-"auran" - -if(modele=="ddtm85"){ - ocsge_modele<-ocsge_ddtm85 -} -if(modele=="auran"){ - ocsge_modele<-ocsge_auran -} - -data_donut_oscge<-ocsge_modele %>% - group_by(TypeZone,Zone,CodeZone,date) %>% - mutate(somme_superficie_typologie = sum(valeur)) %>% - ungroup() %>% - mutate(pourcentage_superficie_typologie = round(valeur/somme_superficie_typologie*100,digits = 1)) %>% - filter(date ==paste0(mil,"-06-30")) %>% - select(-c(valeur,somme_superficie_typologie)) %>% - rename(valeur = pourcentage_superficie_typologie) %>% - filter(TypeZone == "Régions") %>% - filter(CodeZone == "52") - -hc<-hchart(data_donut_oscge, - type = "pie", - hcaes(x = variable,y = valeur)) %>% - hc_title(text = paste0("Typologie de l'occupation des sols selon modèle ",modele),align = "left") %>% - hc_subtitle(text = paste0("au 30 juin ",mil),align = "left") %>% - hc_tooltip(headerFormat = '', - pointFormat = '<b>{point.variable}<b><br/>{point.y} %') %>% - hc_plotOptions(pie = list(innerSize = '50%')) %>% - hc_colors(colors = couleur_ocsge_typologie) %>% - hc_exporting(enabled = TRUE, - buttons = list(contextButton = list(menuItems = c("downloadPNG", "downloadJPEG","downloadPDF", "downloadCSV" ))) - ) -hc - -saveWidget(hc, file=paste0("extdata/donut_ocsge_",modele,"_",mil,".html"), selfcontained=FALSE) - - - - diff --git a/data-raw/zz_protection_naturelle.R b/data-raw/zz_protection_naturelle.R deleted file mode 100644 index cd171ff..0000000 --- a/data-raw/zz_protection_naturelle.R +++ /dev/null @@ -1,349 +0,0 @@ - -# specifique_protection_naturelle - -# librairies ---------- -library(datalibaba) -library(tidyverse) -library(sf) -# library(mapview) -library(COGiter) -library(googlesheets4) - -rm(list=ls()) - - -# chargement des données du SGBD ------ -n_enp_rnn_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_rnn_s_r52") -n_enp_rnr_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_rnr_s_r52") -n_enp_rb_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_rb_s_r52") -n_enp_apb_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_apb_s_r52") -n_enp_apg_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_apg_s_r52") -n_enp_rcfs_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_rcfs_s_r52") -n_enp_scl_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_scl_s_r52") -n_enp_pnr_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_pnr_s_r52") -n_enp_pnr_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "r_site_natura_2000_table_r52") -n_enp_ramsar_s_r52 <- importer_data(db = "consultation", - schema = "nature_paysage_biodiversite", - table = "n_enp_ramsar_s_r52") - -r_patrimoine_mondial_r52 <- importer_data(db = "consultation", - schema = "site_paysage", - table = "r_patrimoine_mondial_r52") - -# limites administratives -n_region_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_region_exp_r52") %>% - select(insee_reg,nom_reg) %>% - mutate(surf_region=st_area(the_geom)) - -n_departement_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_departement_exp_r52") %>% - select(insee_dep,nom) %>% - rename(nom_dep = nom) %>% - mutate(surf_departement=st_area(the_geom)) - -n_commune_exp_r52<-importer_data(db = "referentiels", - schema = "adminexpress", - table = "n_commune_exp_r52") %>% - select(insee_com,nom,siren_epci) %>% - rename(nom_com = nom) %>% - mutate(surf_commune=st_area(the_geom)) - -n_epci_zsup_r52<-importer_data(db = "consultation", - schema = "donnee_generique", - table = "n_epci_zsup_r52") %>% - select(siren_epci,dep_epci,nom_epci) %>% - mutate(surf_epci=st_area(the_geom)) - - -# import de shp pour sites CEN ------------- -# courriel de Thomas OBE du 2021-01-28 :les sites acquis et gérés des CEN ne remontent pas obligatoirement par la base DREAL, -# ils vont directement sur la base INPN du Museum. On les trouve sur leur site avec les surfaces correspondantes. -# On peut faire une demande pour obtenir les couches SIG. -# Ou alors directement au CEN, le directeur est Franck Boitard : f.boitard@cenpaysdelaloire.fr -# Envoie de la couche nationale (shp) disponible fin 2020 sur le site INPN, mais peut-être pas tout à fait complète -# (quelques sites peuvent avoir été ajoutés en 2020 et non encore saisis dans la base, à la marge). - -download.file(url = "https://inpn.mnhn.fr/docs/Shape/cen.zip", destfile = "extdata/cen.zip") -unzip(zipfile = 'extdata/cen.zip',exdir = "extdata") -n_epn_scen_s_000 <- st_read(dsn="extdata/scen2018_12",layer='N_ENP_SCEN_S_000') - - -# protections fortes --------- -x<-st_union(n_enp_rnn_s_r52 %>% select(id_local),n_enp_rnr_s_r52 %>% select(id_local)) -x <- summarise(x,do_union = TRUE) -x<-st_union(x,n_enp_rb_s_r52 %>% select(id_local)) -x <- summarise(x,do_union = TRUE) -x<-st_union(x,n_enp_apb_s_r52%>% select(id_local)) -x <- summarise(x,do_union = TRUE) -protection_forte<-st_union(x,n_enp_apg_s_r52 %>% select(id_local)) -protection_forte <- summarise(protection_forte, do_union = TRUE) -rm(x) - - -# protections 'élargies' --------- -x<-st_union(protection_forte,n_enp_rcfs_s_r52 %>% select(id_local)) -x <- summarise(x,do_union = TRUE) -x<-st_union(x,st_buffer(n_enp_scl_s_r52%>% select(id_local),0)) -x <- summarise(x,do_union = TRUE) -x<-st_union(x,st_buffer(n_epn_scen_s_000 %>% select(ID_LOCAL),0)) -x <- summarise(x,do_union = TRUE) -x<-st_union(x,n_enp_pnr_s_r52 %>% select(id_local)) -x <- summarise(x,do_union = TRUE) -x<-st_union(x,r_site_natura_2000_table_r52 %>% select(id_mnhn)) -x <- summarise(x,do_union = TRUE) # très très long -x<-st_union(x,n_enp_ramsar_s_r52 %>% select(id_local)) -x <- summarise(x,do_union = TRUE) -protection_elargie<-st_union(x,r_patrimoine_mondial_r52 %>% select(id_bien)) -protection_elargie <- summarise(protection_elargie,do_union = TRUE) -rm(x) - - -# intersection des protections fortes et des territoires --------- -indicateur_protection_forte_commune <- st_intersection(st_buffer(protection_forte, 0), - st_buffer(n_commune_exp_r52, 0)) %>% - mutate(surf_protection_forte = st_area(the_geom)) %>% - mutate(part_protection_forte = round(surf_protection_forte/surf_commune*100, digits = 2)) %>% - st_drop_geometry() %>% - right_join(n_commune_exp_r52 %>% - st_drop_geometry() %>% - select(insee_com, nom_com, surf_commune)) %>% - select(insee_com, nom_com, part_protection_forte) %>% - mutate(part_protection_forte = ifelse(is.na(part_protection_forte), 0, part_protection_forte)) %>% - rename(CodeZone = insee_com, Zone = nom_com, valeur = part_protection_forte) %>% - mutate(TypeZone = "Communes", date = as.Date("2022-01-01"), variable="part_protection_forte") - -indicateur_protection_forte_epci <- st_intersection(st_buffer(protection_forte,0), - st_buffer(n_epci_zsup_r52,0)) %>% - mutate(surf_protection_forte = st_area(the_geom)) %>% - mutate(part_protection_forte = round(surf_protection_forte/surf_epci*100, digits = 2)) %>% - st_drop_geometry() %>% - right_join(n_epci_zsup_r52 %>% - st_drop_geometry() %>% - select(siren_epci, nom_epci, surf_epci)) %>% - select(siren_epci, nom_epci, part_protection_forte) %>% - mutate(part_protection_forte = ifelse(is.na(part_protection_forte), 0, part_protection_forte)) %>% - rename(CodeZone = siren_epci, Zone = nom_epci, valeur = part_protection_forte) %>% - mutate(TypeZone = "Epci", date=as.Date("2022-01-01"), variable = "part_protection_forte") - -indicateur_protection_forte_departement <- st_intersection(st_buffer(protection_forte, 0), - st_buffer(n_departement_exp_r52, 0)) %>% - mutate(surf_protection_forte = st_area(the_geom)) %>% - mutate(part_protection_forte = round(surf_protection_forte/surf_departement*100, digits = 2)) %>% - st_drop_geometry() %>% - right_join(n_departement_exp_r52 %>% - st_drop_geometry() %>% - select(insee_dep, nom_dep, surf_departement)) %>% - select(insee_dep, nom_dep, part_protection_forte) %>% - mutate(part_protection_forte = ifelse(is.na(part_protection_forte), 0, part_protection_forte)) %>% - rename(CodeZone = insee_dep, Zone = nom_dep, valeur = part_protection_forte) %>% - mutate(TypeZone = "Départements", date = as.Date("2022-01-01"), variable = "part_protection_forte") - -indicateur_protection_forte_region <- st_intersection(st_buffer(protection_forte, 0), - st_buffer(n_region_exp_r52, 0)) %>% - mutate(surf_protection_forte = st_area(the_geom)) %>% - mutate(part_protection_forte = round(surf_protection_forte/surf_region*100, digits = 2)) %>% - st_drop_geometry() %>% - right_join(n_region_exp_r52 %>% - st_drop_geometry() %>% - select(insee_reg, nom_reg, surf_region)) %>% - select(insee_reg, nom_reg, part_protection_forte) %>% - mutate(part_protection_forte = ifelse(is.na(part_protection_forte), 0, part_protection_forte)) %>% - rename(CodeZone = insee_reg, Zone = nom_reg, valeur = part_protection_forte) %>% - mutate(TypeZone = "Régions", date = as.Date("2022-01-01"), variable = "part_protection_forte") - - -# intersection des protections élargies et des territoires --------- -indicateur_protection_elargie_commune <- st_intersection(st_buffer(protection_elargie, 0), - st_buffer(n_commune_exp_r52, 0)) %>% - mutate(surf_protection_elargie = st_area(the_geom)) %>% - mutate(part_protection_elargie = round(surf_protection_elargie/surf_commune*100, digits = 2)) %>% - st_drop_geometry() %>% - right_join(n_commune_exp_r52 %>% - st_drop_geometry() %>% - select(insee_com, nom_com, surf_commune)) %>% - select(insee_com, nom_com, part_protection_elargie) %>% - mutate(part_protection_elargie = ifelse(is.na(part_protection_elargie), 0, part_protection_elargie)) %>% - rename(CodeZone = insee_com, Zone = nom_com, valeur = part_protection_elargie) %>% - mutate(TypeZone = "Communes", date = as.Date("2022-01-01"), variable = "part_protection_elargie") - -indicateur_protection_elargie_epci <- st_intersection(st_buffer(protection_elargie, 0), - st_buffer(n_epci_zsup_r52, 0)) %>% - mutate(surf_protection_elargie = st_area(the_geom)) %>% - mutate(part_protection_elargie = round(surf_protection_elargie/surf_epci*100, digits = 2)) %>% - st_drop_geometry() %>% - right_join(n_epci_zsup_r52 %>% - st_drop_geometry() %>% - select(siren_epci, nom_epci, surf_epci)) %>% - select(siren_epci, nom_epci, part_protection_elargie) %>% - mutate(part_protection_elargie = ifelse(is.na(part_protection_elargie), 0, part_protection_elargie)) %>% - rename(CodeZone = siren_epci, Zone = nom_epci, valeur = part_protection_elargie) %>% - mutate(TypeZone = "Epci", date = as.Date("2022-01-01"), variable = "part_protection_elargie") - -indicateur_protection_elargie_departement <- st_intersection(st_buffer(protection_elargie, 0), - st_buffer(n_departement_exp_r52, 0)) %>% - mutate(surf_protection_elargie = st_area(the_geom)) %>% - mutate(part_protection_elargie = round(surf_protection_elargie/surf_departement*100, digits = 2)) %>% - st_drop_geometry() %>% - right_join(n_departement_exp_r52 %>% - st_drop_geometry() %>% - select(insee_dep, nom_dep, surf_departement)) %>% - select(insee_dep, nom_dep, part_protection_elargie) %>% - mutate(part_protection_elargie = ifelse(is.na(part_protection_elargie), 0, part_protection_elargie)) %>% - rename(CodeZone = insee_dep, Zone = nom_dep, valeur = part_protection_elargie) %>% - mutate(TypeZone = "Départements", date = as.Date("2022-01-01"), variable = "part_protection_elargie") - -indicateur_protection_elargie_region <- st_intersection(st_buffer(protection_elargie, 0), - st_buffer(n_region_exp_r52, 0)) %>% - mutate(surf_protection_elargie = st_area(the_geom)) %>% - mutate(part_protection_elargie = round(surf_protection_elargie/surf_region*100, digits = 2)) %>% - st_drop_geometry() %>% - right_join(n_region_exp_r52 %>% - st_drop_geometry() %>% - select(insee_reg, nom_reg, surf_region)) %>% - select(insee_reg, nom_reg, part_protection_elargie) %>% - mutate(part_protection_elargie = ifelse(is.na(part_protection_elargie), 0, part_protection_elargie)) %>% - rename(CodeZone = insee_reg, Zone = nom_reg, valeur=part_protection_elargie) %>% - mutate(TypeZone = "Régions", date = as.Date("2022-01-01"), variable="part_protection_elargie") - - -# compilation ------- -indicateur_protection_naturelle<-bind_rows(indicateur_protection_forte_commune, - indicateur_protection_forte_epci, - indicateur_protection_forte_departement, - indicateur_protection_forte_region, - indicateur_protection_elargie_commune, - indicateur_protection_elargie_epci, - indicateur_protection_elargie_departement, - indicateur_protection_elargie_region) %>% - mutate_if(is.character,as.factor) - - -# correction/vérification du champs Zone avec COGiter ------------ -communes_pdl <- communes %>% - filter(REG == '52') %>% - select(DEPCOM, NOM_DEPCOM) %>% - rename(CodeZone = DEPCOM, Zone = NOM_DEPCOM) # 1235 obs - -epci_pdl <- epci %>% - unnest(REGIONS_DE_L_EPCI) %>% - filter(REGIONS_DE_L_EPCI == '52') %>% - select(EPCI, NOM_EPCI) %>% - rename(CodeZone = EPCI, Zone = NOM_EPCI) # 71 obs - -departements_pdl <- departements %>% - filter(REG == '52') %>% - select(DEP, NOM_DEP) %>% - rename(CodeZone = DEP, Zone = NOM_DEP) - -region_pdl <- regions %>% - filter(REG == '52') %>% - select(REG, NOM_REG) %>% - rename(CodeZone = REG, Zone = NOM_REG) - -territoire_pdl <- bind_rows(communes_pdl, - departements_pdl, - epci_pdl, - region_pdl) %>% - mutate_if(is.factor,as.character) - -specifique_protection_naturelle<-indicateur_protection_naturelle %>% - select(-Zone) %>% - left_join(territoire_pdl) %>% - mutate_if(is.character,as.factor) %>% - select(TypeZone, CodeZone, Zone, variable, valeur, date) - -specifique_protection_naturelle <- pivot_wider(specifique_protection_naturelle, - names_from = variable, - values_from = valeur) - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = specifique_protection_naturelle, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_protection_naturelle", - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("TypeZone", "CodeZone", "Zone", "date"), # déclaration d'une clé primaire sur la table postée - user = "does") - - -# METADONNEES------------------------------------ - -## On récupère la liste des variables qui sont à documenter dans le tableur google sheet à partir du jeu de données posté -var <- setdiff(names(specifique_protection_naturelle), c("TypeZone", "CodeZone", "Zone", "date")) - -## récupération du nom du présent script source pour filtrer ensuite le référentiel des indicateurs -nom_script_sce <- rstudioapi::getActiveDocumentContext()$path %>% # utilisation de rstudioapi pour récupérer le nom du présent script - basename() %>% # on enlève le chemin d'accès pour ne garder que le nom du fichier - gsub(pattern = ".R$", "", .) # on enlève l'extension '.R' - -## authentification google sheet grâce au .Renviron -gs4_auth_configure(api_key = Sys.getenv("google_api_key")) -gs4_deauth() - -## chargement du référentiel indicateurs google sheet -metadata_indicateur <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "indicateurs") %>% - # on ne garde que les variables concernées par le présent script de chargement - filter(source == nom_script_sce) %>% - # on ajoute l'unité dans le libellé de la variable - mutate(libelle_variable = paste0(libelle_variable, " (unit\u00e9 : ", unite, ")")) %>% - select(variable, libelle_variable) %>% - # ajout des libellés pour date - bind_rows( - tribble( - ~variable, ~libelle_variable, - "date", "Millesime" - ) - ) - -## Vérification que la documentation des indicateurs est complète -all(var %in% metadata_indicateur$variable) # doit renvoyer TRUE - -## Envoi des libellés de variable dans le SGBD -post_dico_attr(dico = metadata_indicateur, - table = "specifique_protection_naturelle", - schema = "portrait_territoires", - db = "datamart", - user = "does") - -## Récupération des métadonnées de la source -nom_sce <- str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% - str_replace("indicateur_", "") %>% - str_replace("_cogiter|_cog$", "") - -metadata_source <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "sources") %>% - filter(source == nom_sce) %>% - mutate(com_table = paste0(source_lib, " - ", producteur, ".\n", descriptif_sources)) %>% - pull(com_table) - -## commentaires de la table -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "specifique_protection_naturelle", - user = "does") diff --git a/data-raw/zz_secret_filocom.R b/data-raw/zz_secret_filocom.R deleted file mode 100644 index 81bd9f8..0000000 --- a/data-raw/zz_secret_filocom.R +++ /dev/null @@ -1,203 +0,0 @@ - -# secret_filocom - -# librairies --------- -library(dplyr) -library(tidyr) -library(lubridate) -library(COGiter) -library(DBI) -library(RPostgreSQL) - -rm(list=ls()) - - -# chargement data ------------- -drv <- dbDriver("PostgreSQL") -con_datamart <- dbConnect(drv, - dbname="datamart", - host=Sys.getenv("server"), - port=Sys.getenv("port"), - user=Sys.getenv("userid"), - password=Sys.getenv("pwd_does")) -postgresqlpqExec(con_datamart, "SET client_encoding = 'windows-1252'") - -cogifiee_filocom<-dbReadTable(con_datamart,c("portrait_territoires","cogifiee_filocom")) - -data_cogifiee<-pivot_longer(cogifiee_filocom, - cols = nb_lgts_collectif : revenu_brut_total, - names_to = "variable", - values_to = "valeur") - -tranches <- read.csv2('metadata/table_liens_indicateurs.csv', as.is = TRUE, encoding = "UTF-8" ) %>% - filter(source=="chargement_filocom") %>% - select(famille,sous_indicateur,prise_en_compte_famille_pour_secret) %>% - rename(variable=sous_indicateur) %>% - mutate(lign=as.character(row_number())) -tranches$famille<-case_when( - tranches$prise_en_compte_famille_pour_secret == 0 ~ tranches$lign , #numérote les cellules qui ne sont pas dans des familles pour qu'elles soient toutes différentes les unes des autres - TRUE ~ tranches$famille) - - -# enlèvement des zonages inutiles ---------- -data_filocom <- data_cogifiee %>% - # mutate(date=as.character(year(date))) %>% - filter(Zone!="Ille-et-Vilaine") %>% - filter(Zone!="Orne") %>% - filter(Zone!="Morbihan") %>% - filter(Zone!="Bretagne") %>% - filter(Zone!="Normandie") %>% - #enleve les EPCI hors région - left_join(epci%>% rename("CodeZone"="EPCI")) %>% - select(-NATURE_EPCI,-NOM_EPCI) %>% - filter(REGIONS_DE_L_EPCI!="28") %>% - filter(REGIONS_DE_L_EPCI!="53") %>% - select(-REGIONS_DE_L_EPCI,-DEPARTEMENTS_DE_L_EPCI) %>% - #enlève les communes hors EPCI région - left_join(communes %>% rename("CodeZone"="DEPCOM")) %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur,EPCI,NOM_EPCI,REGIONS_DE_L_EPCI) %>% - filter(REGIONS_DE_L_EPCI!="28") %>% - filter(REGIONS_DE_L_EPCI!="53") %>% - select(-REGIONS_DE_L_EPCI) %>% - mutate(TypeZone=as.character(TypeZone), - Zone=as.character(Zone), - NOM_EPCI=as.character(NOM_EPCI), - CodeZone=as.character(CodeZone), - EPCI=as.character(EPCI)) %>% - left_join(tranches) - -# ajout du nom et du code EPCI pour les EPCI ---------- -data_filocom$NOM_EPCI<-case_when( - data_filocom$TypeZone=="Régions" ~ "", - data_filocom$TypeZone=="Départements" ~ "", - data_filocom$TypeZone=="Epci" ~ data_filocom$Zone, - TRUE ~ data_filocom$NOM_EPCI) -data_filocom$EPCI<-case_when( - data_filocom$TypeZone=="Régions" ~ "", - data_filocom$TypeZone=="Départements" ~ "", - data_filocom$TypeZone=="Epci" ~ data_filocom$CodeZone, - TRUE ~ data_filocom$EPCI) - - -# secretisation des communes ----------- -secret_communes<-data_filocom %>% - filter(TypeZone=="Communes") - -#secret induit, pour une meme variable et un meme epci, pour ne pas retrouver la valeur d'une commune -#en faisant la somme des communes - -secret_communes<-secret_communes %>% - group_by(variable,EPCI,date) %>% - mutate(A_nb_inf11=length(which(valeur<11))) %>% #compte combien inférieur à 11 - mutate(A_rang=rank(valeur, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs -secret_communes$A_sec<-case_when( - secret_communes$valeur<11 ~ 1, #secret pour toutes les valeurs inférieures à 11 - secret_communes$A_nb_inf11== 0 ~ 0, #enlève le secret si aucune des communes rang 1 et 2 inférieur à 11 - secret_communes$A_rang<3 ~ 1, #secret sur les 2 communes avec valeurs les plus basses - TRUE ~ 0) - -#secret induit, pour une meme famille et une meme commune, pour ne pas retrouver la valeur d'une variable -#en faisant la somme des variables de la commune - -secret_communes<-secret_communes %>% - group_by(famille,Zone,date) %>% - mutate(B_nb_inf11=length(which(valeur<11))) %>% #compte combien inférieur à 11 - mutate(B_rang=rank(valeur, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs -secret_communes$B_sec<-case_when( - secret_communes$B_nb_inf11== 0 ~ 0, #enlève le secret si aucune des communes rang 1 et 2 inférieur à 11 - secret_communes$B_rang<3 ~ 1, #secret sur les 2 communes avec valeurs les plus basses - TRUE ~ 0) - -# regroupement des secrets, masquage des valeurs -secret_communes<-secret_communes %>% - mutate(valeur=as.character(valeur)) -secret_communes$valeur<-case_when( - secret_communes$B_sec== 1 ~ "nc", #remplace valeur par "nc" si secret stat - secret_communes$A_sec== 1 ~ "nc", #remplace valeur par "nc" si secret stat - TRUE ~ secret_communes$valeur) -secret_communes<-secret_communes %>% - ungroup() %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur,EPCI,NOM_EPCI) - - -# secretisation des EPCI --------- -secret_epci<- data_filocom %>% - filter(TypeZone =="Epci") - -#secret induit, pour une meme famille et un meme epci, pour ne pas retrouver la valeur d'une variable -#en faisant la somme des variables de l'Epci - -secret_epci<-secret_epci %>% - group_by(famille,Zone,date) %>% - mutate(B_nb_inf11=length(which(valeur<11))) %>% #compte combien inférieur à 11 - mutate(B_rang=rank(valeur, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs -secret_epci$B_sec<-case_when( - secret_epci$valeur<11 ~ 1, #secret pour toutes les valeurs inférieures à 11 - secret_epci$B_nb_inf11== 0 ~ 0, #enlève le secret si aucune des communes rang 1 et 2 inférieur à 11 - secret_epci$B_rang<3 ~ 1, #secret sur les 2 communes avec valeurs les plus basses - TRUE ~ 0) - -# regroupement des secrets, masquage des valeurs -secret_epci<-secret_epci %>% - mutate(valeur=as.character(valeur)) -secret_epci$valeur<-case_when( - secret_epci$B_sec== 1 ~ "nc", #remplace valeur par "nc" si secret stat - TRUE ~ secret_epci$valeur) -secret_epci<-secret_epci %>% - ungroup() %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur,EPCI,NOM_EPCI) - - -# secretisation des départements et régions ---------- -secret_region_departements<- data_filocom %>% - filter(TypeZone %in% c("Régions","Départements")) -secret_region_departements$A_sec<-case_when( - secret_region_departements$valeur < 11 ~ 1, #secret pour toutes les valeurs inférieures à 11 - TRUE ~ 0) -secret_region_departements<-secret_region_departements %>% - mutate(valeur=as.character(valeur)) -secret_region_departements$valeur<-case_when( - secret_region_departements$A_sec== 1 ~ "nc", #remplace valeur par "nc" si secret stat - TRUE ~ secret_region_departements$valeur) -secret_region_departements<-secret_region_departements %>% - ungroup() %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur,EPCI,NOM_EPCI) - - -# regroupement des zonages -------------- -filocom_secretise<-bind_rows(secret_region_departements,secret_epci,secret_communes) %>% - mutate(code_date=paste(CodeZone,date)) #création d'une colonne pour identifier zone et année - - -# selection des zones avec revenu renseigné, de moins de 11 ménages ou secrétisé ------------ -# par secret induit, pour secretisation du montant -revenu_secret<-filocom_secretise %>% - filter(variable=="nb_men_fisc_avec_revenu_brut_rens",valeur=="nc") %>% - pull(code_date) - - -# secretisation du montant des revenus quand moins de 11 ménages ---------- -filocom_secretise$valeur<-case_when( - filocom_secretise$code_date %in% revenu_secret ~ "nc", #remplace valeur par "nc" si secret stat - TRUE ~ filocom_secretise$valeur) - - -# remplace "nc" par NA -filocom_secretise$valeur<-na_if(filocom_secretise$valeur,"nc") - -data_cogifiee <- filocom_secretise %>% - mutate(valeur=as.numeric(valeur)) %>% - mutate_if(is.character,as.factor) %>% - select(-EPCI,-NOM_EPCI,-code_date) #enleve les colonnes inutiles - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -secretise_filocom<-data_cogifiee %>% - pivot_wider(names_from = variable,values_from = valeur) - -dbWriteTable(con_datamart, c("portrait_territoires","secretise_filocom"), - secretise_filocom, row.names=FALSE, overwrite=TRUE) - -dbDisconnect(con_datamart) - -rm(list=ls()) -- GitLab