Skip to content
Snippets Groups Projects
Commit d3f3ba90 authored by Franck.Gaspard's avatar Franck.Gaspard
Browse files

modifications mineures de create_datamart.R et create_geo_datamart.R à...

modifications mineures de create_datamart.R et create_geo_datamart.R à l'occasion de la relance du calcul des Rdata de l'application indicateurs territoriaux
parent dad9ab93
No related branches found
No related tags found
No related merge requests found
...@@ -5,18 +5,21 @@ library(tidyverse) ...@@ -5,18 +5,21 @@ library(tidyverse)
library(furrr) library(furrr)
library(COGiter) library(COGiter)
library(googlesheets4) library(googlesheets4)
# remotes::install_github("pachevalier/tricky")
library(tricky) library(tricky)
library(formattable) library(formattable)
rm(list = ls()) rm(list = ls())
# paramètre régional -------- # paramètre régional --------
code_reg <- "52" code_reg <- "52"
# chargement des metadonnees Lecture des tables ---------------- # chargement des metadonnees Lecture des tables ----------------
gs4_auth_configure(api_key = Sys.getenv("google_api_key")) gs4_auth_configure(api_key = Sys.getenv("google_api_key"))
gs4_deauth() gs4_deauth()
# Indicateurs à charger : lecture du référentiel des indicateurs # indicateurs à charger : lecture du référentiel des indicateurs
metadata_donnee_0 <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", metadata_donnee_0 <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277",
sheet = "indicateurs", col_types = "cccccccccclcl") %>% sheet = "indicateurs", col_types = "cccccccccclcl") %>%
filter(secret != "oui") %>% # on peut ajouter ici un filtre thématique type PLH ou CRTE filter(secret != "oui") %>% # on peut ajouter ici un filtre thématique type PLH ou CRTE
...@@ -54,7 +57,7 @@ metadata_theme_0 <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM ...@@ -54,7 +57,7 @@ metadata_theme_0 <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM
distinct() %>% distinct() %>%
mutate(across(everything(), as.factor)) mutate(across(everything(), as.factor))
# Décomposition des indicateurs : lecture et mise en forme de la table des familles de répartition de chaque indicateur # décomposition des indicateurs : lecture et mise en forme de la table des familles de répartition de chaque indicateur
liens_indicateurs <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", liens_indicateurs <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277",
sheet = "table_liens_indicateurs") %>% sheet = "table_liens_indicateurs") %>%
mutate(indicateur = tolower(indicateur)) %>% mutate(indicateur = tolower(indicateur)) %>%
...@@ -83,7 +86,6 @@ croisement_arborescence_0 <- croisement_arborescence_00 %>% ...@@ -83,7 +86,6 @@ croisement_arborescence_0 <- croisement_arborescence_00 %>%
arrange(as.numeric(index)) arrange(as.numeric(index))
# chargement des données en base ------------------------ # chargement des données en base ------------------------
con <- connect_to_db(db = "datamart", user = "does") con <- connect_to_db(db = "datamart", user = "does")
...@@ -95,8 +97,8 @@ telechargement <- function(x) { ...@@ -95,8 +97,8 @@ telechargement <- function(x) {
pivot_longer(cols = -c(TypeZone, Zone, CodeZone, date), names_to = "variable", values_to = "valeur") %>% pivot_longer(cols = -c(TypeZone, Zone, CodeZone, date), names_to = "variable", values_to = "valeur") %>%
filtrer_cog(reg = code_reg) %>% filtrer_cog(reg = code_reg) %>%
mutate(table_sgbd = x) # on ajoute le nom de la table pour la recherche d'incohérence entre données téléchargées et référentiel d'indicateurs mutate(table_sgbd = x) # on ajoute le nom de la table pour la recherche d'incohérence entre données téléchargées et référentiel d'indicateurs
}
}
# découverte des tables effectivement en base # découverte des tables effectivement en base
indicateurs <- list_tables(con, "portrait_territoires") indicateurs <- list_tables(con, "portrait_territoires")
...@@ -127,7 +129,7 @@ save(result_0, file = "data/result_0.RData") ...@@ -127,7 +129,7 @@ save(result_0, file = "data/result_0.RData")
# load("data/result_0.RData") # load("data/result_0.RData")
# # Pour mémoire : modif tables particulières, pour éviter de tout recharger en TT, ici exemple avec la 13e dchets ademe # # Pour mémoire : modif tables particulières, pour éviter de tout recharger en TT, ici exemple avec la 13e déchets ademe
# load("data/result_0.RData") # load("data/result_0.RData")
# result_old <- result_0 # result_old <- result_0
# result_table <- indicateurs_filtre$indicateurs[13] %>% map_dfr(~ telechargement(.x)) # result_table <- indicateurs_filtre$indicateurs[13] %>% map_dfr(~ telechargement(.x))
...@@ -137,7 +139,6 @@ save(result_0, file = "data/result_0.RData") ...@@ -137,7 +139,6 @@ save(result_0, file = "data/result_0.RData")
# rm(result_old, result_table) # rm(result_old, result_table)
# calcul de result = base complete des données disponibles, metadata : base des métadonnées associée et metadata_theme ----------------- # calcul de result = base complete des données disponibles, metadata : base des métadonnées associée et metadata_theme -----------------
result_1 <- result_0 %>% # ensembles des données téléchargées du datamart result_1 <- result_0 %>% # ensembles des données téléchargées du datamart
...@@ -150,14 +151,14 @@ result_1 <- result_0 %>% # ensembles des données téléchargées du datamart ...@@ -150,14 +151,14 @@ result_1 <- result_0 %>% # ensembles des données téléchargées du datamart
# ajout des familles indicateurs/sous-indicateurs # ajout des familles indicateurs/sous-indicateurs
left_join(liens_indicateurs, by = c("variable" = "sous_indicateur")) left_join(liens_indicateurs, by = c("variable" = "sous_indicateur"))
# Vérification des indicateur écartés par la jointure inner_join : a balayer pour être certains qu'on enlève pas d'indicateurs à tort # vérification des indicateur écartés par la jointure inner_join : a balayer pour être certains qu'on enlève pas d'indicateurs à tort
indicateurs_omis <- result_0 %>% # ensembles des données téléchargées du datamart indicateurs_omis <- result_0 %>% # ensembles des données téléchargées du datamart
# ajout des métadonnées associées : libellé, unités, secret, source # ajout des métadonnées associées : libellé, unités, secret, source
anti_join(metadata_donnee_0 %>% select(-source) , by = "variable") %>% anti_join(metadata_donnee_0 %>% select(-source) , by = "variable") %>%
select(table_sgbd, variable) %>% select(table_sgbd, variable) %>%
distinct() distinct()
# Peaufinage de la base de données des indicateurs # peaufinage de la base de données des indicateurs
result <- result_1 %>% result <- result_1 %>%
select(-table_sgbd) %>% select(-table_sgbd) %>%
mutate(across(where(is.character), as.factor)) mutate(across(where(is.character), as.factor))
...@@ -165,7 +166,7 @@ result <- result_1 %>% ...@@ -165,7 +166,7 @@ result <- result_1 %>%
result$valeur <- formattable(result$valeur, digits = 2, format = "f", decimal.mark = ",", big.mark = " ") result$valeur <- formattable(result$valeur, digits = 2, format = "f", decimal.mark = ",", big.mark = " ")
# Table présentation des variables pour les sélecteurs de l'application ---- # table présentation des variables pour les sélecteurs de l'application ----
base_indic <- result %>% base_indic <- result %>%
select(variable, libelle_variable, unite, source_propre, source_libelle) %>% select(variable, libelle_variable, unite, source_propre, source_libelle) %>%
distinct() %>% distinct() %>%
...@@ -176,6 +177,7 @@ base_indic <- result %>% ...@@ -176,6 +177,7 @@ base_indic <- result %>%
distinct() %>% distinct() %>%
mutate_if(is.factor, as.character) mutate_if(is.factor, as.character)
# liste des choix des indicateurs et des mailles dans menu de sélection d'un indicateur de la page de téléchargement ---------- # liste des choix des indicateurs et des mailles dans menu de sélection d'un indicateur de la page de téléchargement ----------
choices_indicateurs <- base_indic %>% choices_indicateurs <- base_indic %>%
pull(libelle_variable) %>% pull(libelle_variable) %>%
...@@ -189,6 +191,7 @@ choices_mailles <- result %>% ...@@ -189,6 +191,7 @@ choices_mailles <- result %>%
sort() %>% sort() %>%
as.character() as.character()
# liste des unités --------------- # liste des unités ---------------
ronds_propor <- c("GWh", "ha", "hab", "km", "ktep", "kW", "m\u00b2", "MWh", "nombre de visites", "teqCO2", "tonnes", ronds_propor <- c("GWh", "ha", "hab", "km", "ktep", "kW", "m\u00b2", "MWh", "nombre de visites", "teqCO2", "tonnes",
"ugbta", "unite", "uta", "kWhep/an", "GWh/an", "kWh/an", "\u20ac", "kWh/degr\u00e9-jour") "ugbta", "unite", "uta", "kWhep/an", "GWh/an", "kWh/an", "\u20ac", "kWh/degr\u00e9-jour")
...@@ -212,8 +215,9 @@ save(result, ...@@ -212,8 +215,9 @@ save(result,
DBI::dbDisconnect(con) DBI::dbDisconnect(con)
rm(con) rm(con)
# test verif intégrité datamart
# Des éventuels libellés de zones absents ? # test verif intégrité datamart ---
# des éventuels libellés de zones absents ?
filter(result, is.na(Zone)) %>% select(variable, source_propre) %>% distinct() filter(result, is.na(Zone)) %>% select(variable, source_propre) %>% distinct()
# des dates mal spécifiées ? # des dates mal spécifiées ?
result$date %>% unique() result$date %>% unique()
...@@ -46,4 +46,7 @@ liste_DEP <- creer_vect_terr(dep) ...@@ -46,4 +46,7 @@ liste_DEP <- creer_vect_terr(dep)
liste_EPCI <- creer_vect_terr(epc) liste_EPCI <- creer_vect_terr(epc)
liste_COM <- creer_vect_terr(com) liste_COM <- creer_vect_terr(com)
save(com, epc, dep, reg, liste_REG, liste_DEP, liste_EPCI, liste_COM, file = "data/geo.RData") #, version = 2 # pour un déploiement web, utiliser RData à jour, pour intranet, RData version 2 save(com, epc, dep, reg, liste_REG, liste_DEP, liste_EPCI, liste_COM, file = "data/geo.RData",
# version = 2 # pour un déploiement web, utiliser RData à jour, pour intranet, RData version 2
)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment