From 70074549abe748c12e8fed5a16897020e2b58a25 Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Fri, 20 Dec 2024 17:20:55 +0100 Subject: [PATCH 01/22] debut d ajout des nouveaux indicateurs --- data-raw/chargement_ptz.R | 341 +++++++++++++++++++++++++++----------- 1 file changed, 243 insertions(+), 98 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index f67798a..2168240 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -1,118 +1,263 @@ # chargement_ptz - # librairies -------------- -library(readxl) library(tidyverse) -library(tricky) library(lubridate) -library(DBI) -library(RPostgreSQL) -library(datalibaba) -library(googlesheets4) +library(COGiter) +library(sf) +# library(tricky) +# library(DBI) +# library(RPostgreSQL) +# library(datalibaba) +# library(googlesheets4) rm(list = ls()) +# indicateurs utilisés +# cpfl = code postal +# cins = code insee +# cdco = code commune déclaré +# lcom = libéllé commune +# timm = type d'immeuble (1 = individuel, 2 = collectif) +# tope = type d'opération (neuf/ancien) +# surh = surface habitable (dans l'ancien, surface avant travaux) +# vtto = montant total de l'opération +# vtpr = montant de l'ensemble des prets +# vtpz = montant du pret à taux zero +# durt = durée total du pret à taux zero +# vtpp = montant du pret principal +# dtpp = durée totale du pret principal (mois) + +# paramêtres +millesime = 2023 #millesime du fichier +annee_conservee = 2013 # on supprime les années antérieures -# chargement et calcul --------- -# chargement des données PTZ (Prêts à Taux Zéro) -------- -# fichier cree a partir d une requete geokit 3 : -# "Dossiers publics/geokit3/Regions Pays de la Loire/DREAL/INDICATEURS TER DATA LAB/gk3_ptz" -ptz <-bind_rows(read_excel("extdata/gk3_ptz.xlsx",sheet=1), - read_excel("extdata/gk3_ptz.xlsx",sheet=2), - read_excel("extdata/gk3_ptz.xlsx",sheet=3), - read_excel("extdata/gk3_ptz.xlsx",sheet=4)) - -names(ptz)<-c("depcom","date","typlog","etatlog","statutlog","valeur") -ptz$variable<-paste(substr(ptz$typlog,1,1),substr(ptz$etatlog,1,1),substr(ptz$statutlog,1,1),sep="") -ptz<-ptz %>% - select(depcom,date,variable,valeur) %>% - complete(date,depcom,variable) %>% - mutate_all(funs(ifelse(is.na(.),0,.))) - -ptz<-rbind( - cbind(aggregate(valeur~depcom+date,ptz,sum),variable="nb_ptz.total"), - cbind(aggregate(valeur~depcom+date,ptz[ptz$variable>100 & ptz$variable<200,],sum),variable="nb_ptz.individuel"), - cbind(aggregate(valeur~depcom+date,ptz[ptz$variable>200,],sum),variable="nb_ptz.collectif"), - cbind(aggregate(valeur~depcom+date,ptz[substr(ptz$variable,2,2)==1,],sum),variable="nb_ptz.ancien"), - cbind(aggregate(valeur~depcom+date,ptz[substr(ptz$variable,2,2)==2,],sum),variable="nb_ptz.neuf")) %>% - # 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) +BASE_PTZ_DHUP<- read_delim(paste0("/nfs/data/partage-PTZ-EPTZ/PTZ-EPTZ/BASE_PTZ_DHUP_",millesime,"_DREAL.csv"), + delim = ";", escape_double = FALSE, trim_ws = TRUE) -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = ptz, - db = "datamart", - schema = "portrait_territoires", - table = "source_ptz", - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("depcom", "date"), # déclaration d'une clé primaire sur la table postée : on ne doit pas avoir deux lignes avec à la fois le même code commune et la meme date - 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(ptz), c("depcom", "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, - "depcom", "Code INSEE de la commune", - "date", "Millesime" - ) +# suppression des années anciennes +base_intermediaire <- BASE_PTZ_DHUP %>% + filter (an >= annee_conservee) + +# application de filtres conformément aux recommandations +# Dans les statistiques du bilan annuel de la SGFGAS, les données ne respectant pas ces critères +# sont considérées comme inexploitables : elles sont renseignées avec un ‘.’. +base_intermediaire <- base_intermediaire %>% + # # le code de statut de l’enregistrement (csen) est ‘V’ (validé) + # filter (csen == "V") %>% + # # le nombre de pièces (nppr) est inférieur ou égal à 10 + # mutate(nppr = case_when( + # nppr > 10 ~ ".", + # TRUE ~ nppr)) %>% + # # la surface habitable (surh) est comprise entre 14 m2 et 350 m2 + # mutate(surh = case_when( + # surh < 14 ~ ".", + # surh > 350 ~ ".", + # TRUE ~ surh)) %>% + # # le nombre de personnes (nper) est inférieur ou égal à 10 + # mutate(nper = case_when( + # nper > 10 ~ ".", + # TRUE ~ nper)) %>% + # Pour les opérations de construction (avec ou sans l’achat du terrain, tope = 2 ou 3), + #si le type d’immeuble est collectif (timm=2), il est recommandé de le rectifier à individuel (timm=1) + mutate(timm = case_when( + timm == 2 & tope == 2 ~ 1, + timm == 2 & tope == 3 ~ 1, + TRUE ~ timm) ) +# #le montant de l’opération (vtto) doit être compris entre 7 600 € et 450 000 € +# mutate(vtto = case_when( #le montant de l’opération (vtto) doit être compris entre 7 600 € et 450 000 € +# vtto < 7600 ~ ".", +# vtto > 450000 ~ ".", +# TRUE ~ vtto)) %>% +# # le montant du prêt principal (vtpp) est compris entre 762 € et 350 000 € +# mutate(vtpp = case_when( # le montant du prêt principal (vtpp) est compris entre 762 € et 350 000 € +# vtpp < 762 ~ ".", +# vtpp > 350000 ~ ".", +# TRUE ~ vtpp)) %>% +# # le montant de chacun des autres prêts est inférieur à 350 000 € +# # +# # la durée des prêts (hors PTZ) est comprise entre 24 mois et 480 mois +# # +# # le montant des travaux (vttr) est inférieur au coût de l’opération +# # +# # le montant total des prêts (vtpr) est inférieur à 450 000 € et doit être supérieur à la somme des montants du prêt principal (vtpp) et du prêt à taux zéro (vtpz) +# # +# # le montant total de la première mensualité tous prêts confondus (vt1e) est comprise entre 15 € et 2 287 € +# # +# # le TEG du PTZ (tegz) est inférieur 12% +# # +# # les autres taux sont compris entre 1% et 12%, sauf à compter de 2017 où les taux peuvent être proche de 0% +# # +# # la durée du différé du prêt principal (ddpp) est inférieure à 60 mois +# # + +base <- base_intermediaire %>% + # cpfl = code postal , cins = code insee, cdco = code commune déclaré + # lcom = libéllé commune, timm = type logement (1 = individuel, 2 = collectif) + # tope = type d'opération : + # 1 : achat neuf + # 2 : Construction de maison individuelle (achat du terrain compris) + # 3 : Construction de maison individuelle (hors achat du terrain) + # 4 : Acquisition amélioration pour les acquisitions seules + # 5 : Transformation de locaux non destinés à l’habitation en logement + # 6 : Levée d’option en location-accession, pour le 1er locataire + # 7 : Acquisition d’un logement avec travaux de remise à neuf + select (cpfl,cins,cdco,lcom,timm,tope,an,surh,vtto,vtpr,vtpp,vtpz,dtpp,durt) %>% + mutate(type_logt = case_when( + timm == 1 ~ "individuel", + timm == 2 ~ "collectif", + TRUE ~ "type_non_renseigne"), + etat_logt = case_when( + tope %in% c(1,2,3) ~ "neuf", + tope %in% c(4,5,6,7) ~ "ancien", + TRUE ~ "etat_non_renseigne") + ) %>% + rename(code_insee = cins) %>% + arrange(code_insee) + +# dénombrement croisements type et état +ptz_detail <- base %>% + group_by(an,code_insee,type_logt,etat_logt) %>% + summarise(valeur = length(code_insee)) %>% + ungroup() %>% + mutate(variable = paste0("nb_ptz.",type_logt,".",etat_logt)) %>% + select(-type_logt,-etat_logt) + +# dénombrement par type +ptz_type <- base %>% + group_by(an,code_insee,type_logt) %>% + summarise(valeur = length(code_insee)) %>% + ungroup() %>% + mutate(variable = paste0("nb_ptz.",type_logt)) %>% + select(-type_logt) + +# dénombrement par état +ptz_etat <- base %>% + group_by(an,code_insee,etat_logt) %>% + summarise(valeur = length(code_insee)) %>% + ungroup() %>% + mutate(variable = paste0("nb_ptz.",etat_logt)) %>% + select(-etat_logt) + +# dénombrement total +ptz_total <- base %>% + group_by(an,code_insee) %>% + summarise(nb_ptz.total = length(code_insee), + vtto = sum(vtto)) + + +# Script modifié jusque là +# intégrer dans la formule ci dessus les autres variables + -## 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 = "source_ptz", 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", "Chargement des donn\u00e9es sur Geokit3") -## commentaires de la table -commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = "source_ptz", - user = "does") + + + + # ungroup() %>% + # mutate(variable="nb_ptz.total") + + +# recapitulatif +ptz <- bind_rows(ptz_detail,ptz_etat,ptz_type,ptz_total) %>% + select(DEPCOM=code_insee,an,variable,valeur) %>% + rename(date = an) %>% + mutate(date=make_date(date,12,31)) %>% + filter(!str_starts(DEPCOM,"97"),!str_starts(DEPCOM,"98")) + +rm(ptz_detail,ptz_etat,ptz_type,ptz_total, base, base_intermediaire) + +# liste des communes de France +liste_communes_france <- communes %>% select(DEPCOM) %>% pull() %>% as.character() + +ptz <- cogifier(ptz, epci = F, departements = F,regions = F, metro = F) %>% + select (depcom = CodeZone, date, variable, valeur) %>% + mutate(depcom = forcats::fct_drop(.data$depcom)) %>% #enlève les facteurs inutiles + mutate(depcom = fct_expand(depcom, liste_communes_france)) %>% + complete(depcom, date, variable, fill = list(valeur = 0)) %>% + filter(!str_starts(depcom,"97"),!str_starts(depcom,"98")) %>% + mutate(depcom = forcats::fct_drop(.data$depcom)) %>% #enlève les facteurs inutiles + pivot_wider(names_from = variable,values_from = valeur) + +save(ptz,file="ptz.RData") + +# # versement dans le sgbd/datamart.portrait_territoires ------------- +# poster_data(data = ptz, +# db = "datamart", +# schema = "portrait_territoires", +# table = "source_ptz", +# post_row_name = FALSE, +# overwrite = TRUE, +# droits_schema = TRUE, +# pk = c("depcom", "date"), # déclaration d'une clé primaire sur la table postée : on ne doit pas avoir deux lignes avec à la fois le même code commune et la meme date +# 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(ptz), c("depcom", "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, +# "depcom", "Code INSEE de la commune", +# "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 = "source_ptz", 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", "Chargement des donn\u00e9es sur Geokit3") +# +# ## commentaires de la table +# +# commenter_table(comment = metadata_source, +# db = "datamart", +# schema = "portrait_territoires", +# table = "source_ptz", +# user = "does") +# -- GitLab From d4ee954c47d717c94eefc0a7409c90fb7fff523e Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Fri, 24 Jan 2025 17:18:05 +0100 Subject: [PATCH 02/22] ajout des filtres sur les indicateurs --- data-raw/chargement_ptz.R | 87 +++++++++++++++++++++------------------ 1 file changed, 48 insertions(+), 39 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 2168240..b184f20 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -39,26 +39,27 @@ BASE_PTZ_DHUP<- read_delim(paste0("/nfs/data/partage-PTZ-EPTZ/PTZ-EPTZ/BASE_PTZ_ # suppression des années anciennes base_intermediaire <- BASE_PTZ_DHUP %>% - filter (an >= annee_conservee) + filter (an >= annee_conservee) %>% + # le code de statut de l’enregistrement (csen) est ‘V’ (validé) + filter (csen == "V") # application de filtres conformément aux recommandations # Dans les statistiques du bilan annuel de la SGFGAS, les données ne respectant pas ces critères # sont considérées comme inexploitables : elles sont renseignées avec un ‘.’. base_intermediaire <- base_intermediaire %>% - # # le code de statut de l’enregistrement (csen) est ‘V’ (validé) - # filter (csen == "V") %>% - # # le nombre de pièces (nppr) est inférieur ou égal à 10 + # # filtre sur le revenu annuel (rann) : non appliqué car indicateur non utilisé + # # le nombre de pièces (nppr) est inférieur ou égal à 10 : non appliqué car indicateur non utilisé # mutate(nppr = case_when( - # nppr > 10 ~ ".", - # TRUE ~ nppr)) %>% - # # la surface habitable (surh) est comprise entre 14 m2 et 350 m2 - # mutate(surh = case_when( - # surh < 14 ~ ".", - # surh > 350 ~ ".", - # TRUE ~ surh)) %>% - # # le nombre de personnes (nper) est inférieur ou égal à 10 + # nppr > 10 ~ NA, + # TRUE ~ nppr)) %>% + # la surface habitable (surh) est comprise entre 14 m2 et 350 m2 + mutate(surh = case_when( + surh < 14 ~ NA, + surh > 350 ~ NA, + TRUE ~ surh)) %>% + # # le nombre de personnes (nper) est inférieur ou égal à 10 : non appliqué car indicateur non utilisé # mutate(nper = case_when( - # nper > 10 ~ ".", + # nper > 10 ~ NA, # TRUE ~ nper)) %>% # Pour les opérations de construction (avec ou sans l’achat du terrain, tope = 2 ou 3), #si le type d’immeuble est collectif (timm=2), il est recommandé de le rectifier à individuel (timm=1) @@ -66,33 +67,41 @@ base_intermediaire <- base_intermediaire %>% timm == 2 & tope == 2 ~ 1, timm == 2 & tope == 3 ~ 1, TRUE ~ timm) - ) -# #le montant de l’opération (vtto) doit être compris entre 7 600 € et 450 000 € -# mutate(vtto = case_when( #le montant de l’opération (vtto) doit être compris entre 7 600 € et 450 000 € -# vtto < 7600 ~ ".", -# vtto > 450000 ~ ".", -# TRUE ~ vtto)) %>% -# # le montant du prêt principal (vtpp) est compris entre 762 € et 350 000 € -# mutate(vtpp = case_when( # le montant du prêt principal (vtpp) est compris entre 762 € et 350 000 € -# vtpp < 762 ~ ".", -# vtpp > 350000 ~ ".", -# TRUE ~ vtpp)) %>% -# # le montant de chacun des autres prêts est inférieur à 350 000 € -# # -# # la durée des prêts (hors PTZ) est comprise entre 24 mois et 480 mois -# # -# # le montant des travaux (vttr) est inférieur au coût de l’opération -# # + ) %>% +#le montant de l’opération (vtto) doit être compris entre 7 600 € et 450 000 € +mutate(vtto = case_when( #le montant de l’opération (vtto) doit être compris entre 7 600 € et 450 000 € + vtto < 7600 ~ NA, + vtto > 450000 ~ NA, + TRUE ~ vtto)) %>% +# le montant du prêt principal (vtpp) est compris entre 762 € et 350 000 € +mutate(vtpp = case_when( # le montant du prêt principal (vtpp) est compris entre 762 € et 350 000 € + vtpp < 762 ~ NA, + vtpp > 350000 ~ NA, + TRUE ~ vtpp)) %>% +# le montant de chacun des autres prêts est inférieur à 350 000 € + mutate(vtpz = case_when( # le montant du prêt à taux zéro (vtpz) est inférieur à 350 000 € + vtpz > 350000 ~ NA, + TRUE ~ vtpz)) %>% +# la durée des prêts (hors PTZ) est comprise entre 24 mois et 480 mois + mutate(dtpp = case_when( # la durée du prêt principal (dtpp) est compris entre 24 mois et 480 mois + dtpp < 24 ~ NA, + dtpp > 480 ~ NA, + TRUE ~ dtpp)) %>% +# le montant des travaux (vttr) est inférieur au coût de l’opération : non appliqué car indicateur non utilisé +# # # le montant total des prêts (vtpr) est inférieur à 450 000 € et doit être supérieur à la somme des montants du prêt principal (vtpp) et du prêt à taux zéro (vtpz) -# # -# # le montant total de la première mensualité tous prêts confondus (vt1e) est comprise entre 15 € et 2 287 € -# # -# # le TEG du PTZ (tegz) est inférieur 12% -# # -# # les autres taux sont compris entre 1% et 12%, sauf à compter de 2017 où les taux peuvent être proche de 0% -# # -# # la durée du différé du prêt principal (ddpp) est inférieure à 60 mois -# # +mutate(vtpr = case_when( + vtpr >= 450000 ~ NA, + vtpr < vtpp + vtpz ~ NA, + TRUE ~ vtpr)) +# le montant total de la première mensualité tous prêts confondus (vt1e) est comprise entre 15 € et 2 287 € : non appliqué car indicateur non utilisé +# +# le TEG du PTZ (tegz) est inférieur 12% : non appliqué car indicateur non utilisé +# +# les autres taux sont compris entre 1% et 12%, sauf à compter de 2017 où les taux peuvent être proche de 0% : non appliqué car indicateur non utilisé +# +# la durée du différé du prêt principal (ddpp) est inférieure à 60 mois : non appliqué car indicateur non utilisé +# base <- base_intermediaire %>% # cpfl = code postal , cins = code insee, cdco = code commune déclaré -- GitLab From fe10f38b34ad6dad6e1359aa8abddb1ea7124c3a Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Mon, 27 Jan 2025 17:15:36 +0100 Subject: [PATCH 03/22] creation des indicateurs en cours --- data-raw/chargement_ptz.R | 42 ++++++++++++++++++++++++++++++++------- 1 file changed, 35 insertions(+), 7 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index b184f20..92d16b1 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -133,20 +133,30 @@ ptz_detail <- base %>% summarise(valeur = length(code_insee)) %>% ungroup() %>% mutate(variable = paste0("nb_ptz.",type_logt,".",etat_logt)) %>% - select(-type_logt,-etat_logt) - + select(code_insee,an,variable,valeur) %>% + pivot_wider(names_from = variable , + values_from = valeur) + # dénombrement par type ptz_type <- base %>% group_by(an,code_insee,type_logt) %>% summarise(valeur = length(code_insee)) %>% ungroup() %>% mutate(variable = paste0("nb_ptz.",type_logt)) %>% - select(-type_logt) + select(code_insee,an,variable,valeur) %>% + pivot_wider(names_from = variable , + values_from = valeur) # dénombrement par état ptz_etat <- base %>% group_by(an,code_insee,etat_logt) %>% - summarise(valeur = length(code_insee)) %>% + summarise(valeur = length(code_insee), + n_vtto_par_etat = sum(!is.na(vtto)), + vtto_par_etat = sum(vtto,na.rm = TRUE) + + + + ) %>% ungroup() %>% mutate(variable = paste0("nb_ptz.",etat_logt)) %>% select(-etat_logt) @@ -155,9 +165,14 @@ ptz_etat <- base %>% ptz_total <- base %>% group_by(an,code_insee) %>% summarise(nb_ptz.total = length(code_insee), - vtto = sum(vtto)) - - + n_vtto = sum(!is.na(vtto)), + vtto = sum(vtto,na.rm = TRUE), + n_vtpr = sum(!is.na(vtpr)), + vtpr = sum(vtpr,na.rm = TRUE), + n_vtpz = sum(!is.na(vtpz)), + vtpz = sum(vtpz,na.rm = TRUE) + + ) # Script modifié jusque là # intégrer dans la formule ci dessus les autres variables @@ -171,6 +186,19 @@ ptz_total <- base %>% + + + + + +df<- data.frame(age = c(25,30,NA, 40,35, NA)) +df2 <- df %>% summarise(nb_total =sum(!is.na(age))) + + + + + + # ungroup() %>% # mutate(variable="nb_ptz.total") -- GitLab From 828d162780739259168a2b7afb23ad8a48322667 Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Wed, 29 Jan 2025 17:39:53 +0100 Subject: [PATCH 04/22] integration de tous les indicateurs --- data-raw/chargement_ptz.R | 97 +++++++++++++++++++++------------------ 1 file changed, 52 insertions(+), 45 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 92d16b1..1b613da 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -150,67 +150,74 @@ ptz_type <- base %>% # dénombrement par état ptz_etat <- base %>% group_by(an,code_insee,etat_logt) %>% - summarise(valeur = length(code_insee), - n_vtto_par_etat = sum(!is.na(vtto)), - vtto_par_etat = sum(vtto,na.rm = TRUE) - - - - ) %>% + summarise(valeur = length(code_insee) + ) %>% ungroup() %>% mutate(variable = paste0("nb_ptz.",etat_logt)) %>% + select(code_insee,an,variable,valeur) %>% + pivot_wider(names_from = variable , + values_from = valeur) + + + + + +# prix total de l'opération (vtto) et surface (surh), pour le neuf +# Ces 2 variables ne seront utilisées que pour le calcul du prix au m2 de l'opération. +# La surface dans l'ancien (surh) étant la surface avant travaux et non la surface des travaux, +# le prix au m2 de l'opération ne sera calculé que pour le neuf (à partir du prix total +# de l'opération (vtto)). On ne calcule donc ces 2 variables que pour le neuf. +# De plus, le prix au m2 ne sera calculé que lorsque les 2 valeurs seront présentes. On filtre pour enlever les cas comportant NA. +ptz_etat_neuf <- base %>% + filter(etat_logt == "neuf", + !is.na(surh), + !is.na(vtto)) %>% + group_by(an,code_insee,etat_logt) %>% + summarise(n_vtto_neuf = sum(!is.na(vtto)), # nombre de vtto et de surfaces + vtto_neuf = sum(vtto,na.rm = TRUE), # prix total des opérations + # n_surh_neuf = sum(!is.na(surh)), + surh_neuf = sum(surh,na.rm = TRUE) # surfaces totales des opérations + ) %>% + ungroup() %>% select(-etat_logt) # dénombrement total ptz_total <- base %>% group_by(an,code_insee) %>% summarise(nb_ptz.total = length(code_insee), - n_vtto = sum(!is.na(vtto)), - vtto = sum(vtto,na.rm = TRUE), - n_vtpr = sum(!is.na(vtpr)), - vtpr = sum(vtpr,na.rm = TRUE), - n_vtpz = sum(!is.na(vtpz)), - vtpz = sum(vtpz,na.rm = TRUE) - + # n_vtto = sum(!is.na(vtto)), # montant total des opérations: fait que pour le neuf + # vtto = sum(vtto,na.rm = TRUE), + n_vtpr = sum(!is.na(vtpr)), # nb de prets concernés par vtpr + vtpr = sum(vtpr,na.rm = TRUE), # valeur totale de l'ensemble des prets + n_vtpz = sum(!is.na(vtpz)), # nb de prets concernés par vtpz + vtpz = sum(vtpz,na.rm = TRUE), # valeur totale des ptz + n_vtpp = sum(!is.na(vtpp)), # nb de prets concernés par vtpp + vtpp = sum(vtpp,na.rm = TRUE), # valeur totale des prets principaux + n_durt = sum(!is.na(durt)), # nb de prets concernés par durt + durt = sum(durt,na.rm = TRUE), # durée totale des ptz + n_dtpp = sum(!is.na(dtpp)), # nb de prets concernés par dtpp + dtpp = sum(dtpp,na.rm = TRUE) # durée totale des prets principaux ) -# Script modifié jusque là -# intégrer dans la formule ci dessus les autres variables - - - - - - - - - - - - - - - - -df<- data.frame(age = c(25,30,NA, 40,35, NA)) -df2 <- df %>% summarise(nb_total =sum(!is.na(age))) - - +# recapitulatif +ptz <- ptz_detail %>% + left_join(ptz_type, by = c("code_insee","an")) %>% + left_join(ptz_etat, by = c("code_insee","an")) %>% + left_join(ptz_total, by = c("code_insee","an")) %>% + left_join(ptz_etat_neuf, by = c("code_insee","an")) %>% + rename(date = an, DEPCOM=code_insee) %>% + mutate(date=make_date(date,12,31)) %>% + filter(!str_starts(DEPCOM,"97"),!str_starts(DEPCOM,"98")) - # ungroup() %>% - # mutate(variable="nb_ptz.total") +# ptz <- ptz %>% +# select(DEPCOM=code_insee,an,variable,valeur) +rm(ptz_detail,ptz_etat,ptz_type,ptz_total,ptz_etat_neuf, base, base_intermediaire) -# recapitulatif -ptz <- bind_rows(ptz_detail,ptz_etat,ptz_type,ptz_total) %>% - select(DEPCOM=code_insee,an,variable,valeur) %>% - rename(date = an) %>% - mutate(date=make_date(date,12,31)) %>% - filter(!str_starts(DEPCOM,"97"),!str_starts(DEPCOM,"98")) +# fait jusque ici -rm(ptz_detail,ptz_etat,ptz_type,ptz_total, base, base_intermediaire) # liste des communes de France liste_communes_france <- communes %>% select(DEPCOM) %>% pull() %>% as.character() -- GitLab From f14b53281943db0ab1e1dd35192b33e6a88b885e Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Thu, 30 Jan 2025 13:43:46 +0100 Subject: [PATCH 05/22] fin de chargement et cogification --- data-raw/chargement_ptz.R | 18 +++--- data-raw/cogification_ptz.R | 111 +++++++++++++++++++----------------- 2 files changed, 65 insertions(+), 64 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 1b613da..6c8324c 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -7,10 +7,10 @@ library(lubridate) library(COGiter) library(sf) # library(tricky) -# library(DBI) -# library(RPostgreSQL) -# library(datalibaba) -# library(googlesheets4) +library(DBI) +library(RPostgreSQL) +library(datalibaba) +library(googlesheets4) rm(list = ls()) @@ -207,12 +207,8 @@ ptz <- ptz_detail %>% left_join(ptz_etat_neuf, by = c("code_insee","an")) %>% rename(date = an, DEPCOM=code_insee) %>% mutate(date=make_date(date,12,31)) %>% - filter(!str_starts(DEPCOM,"97"),!str_starts(DEPCOM,"98")) - - - -# ptz <- ptz %>% -# select(DEPCOM=code_insee,an,variable,valeur) + filter(!str_starts(DEPCOM,"97"),!str_starts(DEPCOM,"98"))%>% + pivot_longer(-c(DEPCOM, date), names_to = "variable", values_to = "valeur" ) rm(ptz_detail,ptz_etat,ptz_type,ptz_total,ptz_etat_neuf, base, base_intermediaire) @@ -231,7 +227,7 @@ ptz <- cogifier(ptz, epci = F, departements = F,regions = F, metro = F) %>% mutate(depcom = forcats::fct_drop(.data$depcom)) %>% #enlève les facteurs inutiles pivot_wider(names_from = variable,values_from = valeur) -save(ptz,file="ptz.RData") +save(ptz,file="ptz_chargement.RData") # # versement dans le sgbd/datamart.portrait_territoires ------------- # poster_data(data = ptz, diff --git a/data-raw/cogification_ptz.R b/data-raw/cogification_ptz.R index fe76802..5a5dcdf 100644 --- a/data-raw/cogification_ptz.R +++ b/data-raw/cogification_ptz.R @@ -11,62 +11,67 @@ library(datalibaba) rm(list = ls()) -source_ptz <- importer_data(db = "datamart", - schema = "portrait_territoires", - table = "source_ptz") +load("ptz_chargement.RData") +source_ptz <- ptz + +# source_ptz <- importer_data(db = "datamart", +# schema = "portrait_territoires", +# table = "source_ptz") cogifiee_ptz<-cogifier(source_ptz %>% rename(DEPCOM=depcom))%>% mutate_if(is.factor,as.character) -poster_data(data = cogifiee_ptz, - db = "datamart", - schema = "portrait_territoires", - table = "cogifiee_ptz", - pk = c("TypeZone", "Zone", "CodeZone", "date"), - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - user = "does") - -# commentaires de la table et des variables ------------- - -# récupération des commentaires de la table source -dico_var <- get_table_comments( - db = "datamart", - schema = "portrait_territoires", - table = "source_ptz", - user = "does") - -# commentaire de la table -comm_table <- filter(dico_var, is.na(nom_col)) %>% - pull(commentaire) %>% - gsub("\nCommentaire.*$", "", .) - -commenter_table( - comment = comm_table, - db = "datamart", - schema = "portrait_territoires", - table = "cogifiee_ptz", - user = "does" -) - -# commentaire des variables -comm_champ <- select(dico_var, nom_col, commentaire) %>% - filter(!is.na(nom_col), nom_col != "depcom") %>% - bind_rows( - tribble( - ~nom_col, ~commentaire, - "TypeZone", "Type de territoire", - "Zone", " Nom du territoire", - "CodeZone", "Code INSEE du territoire" - ) - ) +save(cogifiee_ptz,file="ptz_cogifiee.RData") -post_dico_attr( - dico = comm_champ, - db = "datamart", - schema = "portrait_territoires", - table = "cogifiee_ptz", - user = "does" -) +# poster_data(data = cogifiee_ptz, +# db = "datamart", +# schema = "portrait_territoires", +# table = "cogifiee_ptz", +# pk = c("TypeZone", "Zone", "CodeZone", "date"), +# post_row_name = FALSE, +# overwrite = TRUE, +# droits_schema = TRUE, +# user = "does") +# +# # commentaires de la table et des variables ------------- +# +# # récupération des commentaires de la table source +# dico_var <- get_table_comments( +# db = "datamart", +# schema = "portrait_territoires", +# table = "source_ptz", +# user = "does") +# +# # commentaire de la table +# comm_table <- filter(dico_var, is.na(nom_col)) %>% +# pull(commentaire) %>% +# gsub("\nCommentaire.*$", "", .) +# +# commenter_table( +# comment = comm_table, +# db = "datamart", +# schema = "portrait_territoires", +# table = "cogifiee_ptz", +# user = "does" +# ) +# +# # commentaire des variables +# comm_champ <- select(dico_var, nom_col, commentaire) %>% +# filter(!is.na(nom_col), nom_col != "depcom") %>% +# bind_rows( +# tribble( +# ~nom_col, ~commentaire, +# "TypeZone", "Type de territoire", +# "Zone", " Nom du territoire", +# "CodeZone", "Code INSEE du territoire" +# ) +# ) +# +# post_dico_attr( +# dico = comm_champ, +# db = "datamart", +# schema = "portrait_territoires", +# table = "cogifiee_ptz", +# user = "does" +# ) -- GitLab From 4e0ebdb56e16da9985d21025db6a043f842ec30c Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Mon, 3 Feb 2025 16:14:16 +0100 Subject: [PATCH 06/22] premiere etape secretisation --- data-raw/secret_ptz.R | 321 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 321 insertions(+) create mode 100644 data-raw/secret_ptz.R diff --git a/data-raw/secret_ptz.R b/data-raw/secret_ptz.R new file mode 100644 index 0000000..3e74057 --- /dev/null +++ b/data-raw/secret_ptz.R @@ -0,0 +1,321 @@ + +# secret_ptz + +# librairies ------------- +library(dplyr) +library(tidyr) +library(lubridate) +library(COGiter) +library(DBI) +library(RPostgreSQL) +library(datalibaba) +library(googlesheets4) + +rm(list=ls()) + + +# # chargement data ------------- +# cogifiee_ptz <- importer_data(db = "datamart", +# schema = "portrait_territoires", +# table = "cogifiee_ptz") +load("ptz_cogifiee.RData") + + +data_cogifiee<-pivot_longer(cogifiee_ptz, + cols = dtpp : vtto_neuf, + names_to = "variable", + values_to = "valeur") %>% + mutate_if(is.character,as.factor) + +data_ptz <- left_join(data_cogifiee, liste_zone, by= c("CodeZone","TypeZone","Zone")) %>% + left_join(epci %>% select(EPCI,NOM_EPCI), by = "EPCI") + + +## 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 +tranches_ptz <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", + sheet = "secret_ptz") +# +# +# data_ecln <- left_join(data_cogifiee, liste_zone, by= c("CodeZone","TypeZone","Zone")) %>% +# left_join(epci %>% select(EPCI,NOM_EPCI), by = "EPCI") + + +# distinction des données à secrétiser --------- + +# # listes des variables logt et promoteurs +# variables_logt <- tranches_ecln %>% +# pull(variable) +# variables_promoteurs <- tranches_ecln %>% +# pull(variable_associee) %>% +# unique() +# +# # table des nb promoteurs +# data_promoteurs <- data_ecln %>% +# filter (variable %in% variables_promoteurs) %>% +# rename(variable_associee=variable, nb_promoteurs=valeur) +# +# #table des données +# data_ecln_donnees <- data_ecln %>% +# filter (variable %in% variables_logt) +# +# data_ecln_donnees <- left_join(data_ecln_donnees, tranches_ecln, by= "variable") +# data_ecln_donnees <- left_join(data_ecln_donnees, data_promoteurs %>% +# select(TypeZone,CodeZone,date,variable_associee,nb_promoteurs), +# by= c("TypeZone","CodeZone","date", "variable_associee") ) + +# #liste des variables publiques ou non +# variables_publiques <- tranches_ecln %>% +# filter(secret=="0") %>% +# pull(variable) +# variables_non_publiques <- tranches_ecln %>% +# filter(secret !="0") %>% +# pull(variable) + + + +#table des données publiques +data_ptz_A <- data_cogifiee %>% + filter (grepl("^nb_ptz",variable)) + # select(TypeZone,Zone,CodeZone,date,variable,valeur) %>% + # mutate(valeur=as.character(valeur)) + +#table des données à secrétiser --------- +data_ptz_B <- data_cogifiee %>% + filter (!grepl("^nb_ptz",variable)) + +# distinction des données à secrétiser +# table des valeurs +data_ptz_B1 <- data_ptz_B %>% + filter (!grepl("^n_",variable)) +# table des nombres +data_ptz_B2 <- data_ptz_B %>% + filter (grepl("^n_",variable)) + + +# regroupement tables B1 et B2 ---------- +data_ptz_B1$variable_associe<- tranches_ptz$variable_associee[match(data_ptz_B1$variable,tranches_ptz$variable)] + + +# fait jusque ici + + +# secrétisation des données ----------- +secret_communes<-data_ptz_B %>% + 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_inf3=length(which(nb_promoteurs<3))) %>% #compte combien inférieur à 3 + mutate(A_rang=rank(nb_promoteurs, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs +secret_communes$A_sec<-case_when( + secret_communes$nb_promoteurs<3 ~ 1, #secret pour toutes les nb_promoteurs inférieurs à 3 + secret_communes$A_nb_inf3== 0 ~ 0, #enlève le secret si aucune des communes rang 1 et 2 inférieur à 3 + secret_communes$A_rang<3 ~ 1, #secret sur les 2 communes avec valeurs les plus basses + TRUE ~ 0) + +# secret induit, pour une meme categorie 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(categorie,Zone,date) %>% + mutate(B_nb_inf3=length(which(nb_promoteurs<3))) %>% #compte combien inférieur à 3 + mutate(B_rang=rank(nb_promoteurs, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs +secret_communes$B_sec<-case_when( + secret_communes$B_nb_inf3== 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) + +# masque le collectif pour une commune dont l'individuel a été masqué par le secret induit +secret_communes <- secret_communes %>% + mutate (somme_secrets = A_sec + B_sec) %>% + group_by(CodeZone,categorie,date) %>% #pour chaque commune + mutate(a_secretiser=length(which(somme_secrets>0))) # secretise toutes les donnes groupees + +# regroupement des secrets, masquage des valeurs +secret_communes<-secret_communes %>% + mutate(valeur=as.character(valeur)) +secret_communes$valeur<-case_when( + is.na(secret_communes$nb_promoteurs)~ "nc", + secret_communes$a_secretiser > 0 ~ "nc", #remplace valeur par "nc" si secret stat + TRUE ~ secret_communes$valeur) +secret_communes<-secret_communes %>% + ungroup() %>% + select(TypeZone,Zone,CodeZone,date,variable,valeur) + + +# secretisation des EPCI ----- + +secret_epci<- data_ecln_B %>% + filter(TypeZone =="Epci") + +# secret induit, pour une meme categorie 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(categorie,CodeZone,date) %>% + mutate(B_nb_inf3=length(which(nb_promoteurs<3))) %>% #compte combien inférieur à 3 + mutate(B_rang=rank(nb_promoteurs, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs +secret_epci$B_sec<-case_when( + secret_epci$valeur<3 ~ 1, #secret pour toutes les valeurs inférieures à 3 + secret_epci$B_nb_inf3== 0 ~ 0, #enlève le secret si aucune des communes rang 1 et 2 inférieur à 3 + 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( + is.na(secret_epci$nb_promoteurs)~ "nc", + 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) + + +# secretisation Départements et Régions ----- + +secret_dep_reg<- data_ecln_B %>% + filter(TypeZone %in% c("Régions","Départements")) + + + #table des données publiques departement et regions +public_dep_reg_A <- secret_dep_reg %>% + filter (!(variable %in% c("prix_total_des_ventes.collectif","prix_total_des_ventes.individuel","prix_total_des_ventes.total" ))) %>% + select(TypeZone,Zone,CodeZone,date,variable,valeur) %>% + mutate(valeur=as.character(valeur)) + + #table des données à secrétiser departement et regions +secret_dep_reg_B <- secret_dep_reg %>% + filter (variable %in% c("prix_total_des_ventes.collectif","prix_total_des_ventes.individuel","prix_total_des_ventes.total" )) + +#secret induit, pour une meme variable et une meme regioçn, pour ne pas retrouver la valeur d'un département +#en faisant la somme des partements + +secret_dep_reg_B1<-secret_dep_reg_B %>% + mutate(REG = as.character(REG)) %>% + group_by(variable,REG,TypeZone,date) %>% + mutate(A_nb_inf3=length(which(nb_promoteurs<3))) %>% #compte combien inférieur à 3 + mutate(A_rang=rank(nb_promoteurs, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs +secret_dep_reg_B1$A_sec<-case_when( + secret_dep_reg_B1$nb_promoteurs<3 ~ 1, #secret pour toutes les nb_promoteurs inférieurs à 3 + secret_dep_reg_B1$A_nb_inf3== 0 ~ 0, #enlève le secret si aucun des departements rang 1 et 2 inférieur à 3 + secret_dep_reg_B1$A_rang<3 ~ 1, #secret sur les 2 DEPARTEMENTS avec valeurs les plus basses + TRUE ~ 0) + + # secret induit, pour une meme categorie et un meme departement, pour ne pas retrouver la valeur d'une variable + # en faisant la somme des variables du departement +secret_dep1<-secret_dep_reg_B1 %>% + ungroup() %>% + group_by(categorie,TypeZone,CodeZone,date) %>% #groupe par categorie, zone et annee + mutate(B_nb_inf3=length(which(nb_promoteurs<3))) # compte le nombre de fois ou nb promoteurs <3 par groupe +secret_dep1$B_sec<-case_when( + secret_dep1$B_nb_inf3== 0 ~ 0, #enleve secret (affiche 0) si le nb de fois où groupe <3 est égal à 0 + TRUE ~ 1) #pour les autres, code 1 (secret) +# secret_dep1$C_sec<-case_when( +# secret_dep1$B_nb_inf3== 0 ~ 0, #enleve secret (affiche 0) si le nb de fois où groupe <3 est égal à 0 +# TRUE ~ 1) + +# masque le collectif pour un dep dont l'individuel a été masqué par le secret induit +secret_dep2 <- secret_dep1 %>% + mutate (somme_secrets = A_sec + B_sec) %>% + group_by(TypeZone,DEP,REG,categorie,date) %>% #pour chaque departement + mutate(a_secretiser=length(which(somme_secrets>0))) # secretise toutes les donnes groupees + + + + # regroupement des secrets, masquage des valeurs +secret_dep2<-secret_dep2 %>% + mutate(valeur=as.character(valeur)) +secret_dep2$valeur<-case_when( + is.na(secret_dep2$nb_promoteurs)~ "nc", + secret_dep2$a_secretiser > 0 ~ "nc", #remplace valeur par "nc" si secret stat + TRUE ~ secret_dep2$valeur) + +secret_dep2<-secret_dep2 %>% + ungroup() %>% + select(TypeZone,Zone,CodeZone,date,variable,valeur) + +# regroupement des zonages ------------ +secretise_ecln <-bind_rows(secret_communes,secret_epci,data_ecln_A,public_dep_reg_A,secret_dep2) + + +# remplace "nc" par NA +secretise_ecln$valeur<-na_if(secretise_ecln$valeur,"nc") + +secretise_ecln <- secretise_ecln %>% + mutate(valeur=as.numeric(valeur)) %>% + mutate_if(is.factor,as.character) %>% + pivot_wider(names_from = variable,values_from = valeur) + + +# versement dans le sgbd/datamart.portrait_territoires ------------- +poster_data(data = secretise_ecln, + db = "datamart", + schema = "portrait_territoires", + table = "secretise_ecln", + pk = c("TypeZone", "Zone", "CodeZone", "date"), + post_row_name = FALSE, + overwrite = TRUE, + droits_schema = TRUE, + user = "does") + +# commentaires de la table et des variables ------------- + +# récupération des commentaires de la table source +dico_var <- get_table_comments( + db = "datamart", + schema = "portrait_territoires", + table = "cogifiee_ecln", + user = "does") + +# commentaire de la table +comm_table <- filter(dico_var, is.na(nom_col)) %>% + pull(commentaire) %>% + gsub("\nCommentaire.*$", "", .) + +commenter_table( + comment = comm_table, + db = "datamart", + schema = "portrait_territoires", + table = "secretise_ecln", + user = "does" +) + +## 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 == "secret_ecln") %>% + # 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, + "TypeZone", "Type de territoire", + "Zone", " Nom du territoire", + "CodeZone", "Code INSEE du territoire", + "date", "Millesime" + ) + ) + +post_dico_attr( + dico = metadata_indicateur, + db = "datamart", + schema = "portrait_territoires", + table = "secretise_ecln", + user = "does" +) -- GitLab From 7cd38cca6af5ca8e789e991396ea54d1c53f570c Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Fri, 7 Feb 2025 17:47:44 +0100 Subject: [PATCH 07/22] secret communal --- data-raw/chargement_ptz.R | 17 ++++++++ data-raw/secret_ptz.R | 90 ++++++++++++++++++++++++++++++++++----- 2 files changed, 97 insertions(+), 10 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 6c8324c..19ffe4b 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -37,12 +37,17 @@ annee_conservee = 2013 # on supprime les années antérieures BASE_PTZ_DHUP<- read_delim(paste0("/nfs/data/partage-PTZ-EPTZ/PTZ-EPTZ/BASE_PTZ_DHUP_",millesime,"_DREAL.csv"), delim = ";", escape_double = FALSE, trim_ws = TRUE) +# base_2023 <- BASE_PTZ_DHUP %>% +# filter (an == 2023) + # suppression des années anciennes base_intermediaire <- BASE_PTZ_DHUP %>% filter (an >= annee_conservee) %>% # le code de statut de l’enregistrement (csen) est ‘V’ (validé) filter (csen == "V") + + # application de filtres conformément aux recommandations # Dans les statistiques du bilan annuel de la SGFGAS, les données ne respectant pas ces critères # sont considérées comme inexploitables : elles sont renseignées avec un ‘.’. @@ -103,6 +108,18 @@ mutate(vtpr = case_when( # la durée du différé du prêt principal (ddpp) est inférieure à 60 mois : non appliqué car indicateur non utilisé # +# filtres supplémentaires sur les montants +base_intermediaire <- base_intermediaire %>% + mutate(vtpr = case_when( + vtpr < vtpp ~ NA, + TRUE ~ vtpr)) %>% + mutate(vtpp = case_when( + vtpp < vtpz ~ NA, + TRUE ~ vtpp)) + + + + base <- base_intermediaire %>% # cpfl = code postal , cins = code insee, cdco = code commune déclaré # lcom = libéllé commune, timm = type logement (1 = individuel, 2 = collectif) diff --git a/data-raw/secret_ptz.R b/data-raw/secret_ptz.R index 3e74057..08f4329 100644 --- a/data-raw/secret_ptz.R +++ b/data-raw/secret_ptz.R @@ -27,8 +27,8 @@ data_cogifiee<-pivot_longer(cogifiee_ptz, values_to = "valeur") %>% mutate_if(is.character,as.factor) -data_ptz <- left_join(data_cogifiee, liste_zone, by= c("CodeZone","TypeZone","Zone")) %>% - left_join(epci %>% select(EPCI,NOM_EPCI), by = "EPCI") +# data_ptz <- left_join(data_cogifiee, liste_zone, by= c("CodeZone","TypeZone","Zone")) %>% +# left_join(epci %>% select(EPCI,NOM_EPCI), by = "EPCI") ## authentification google sheet grâce au .Renviron @@ -40,8 +40,7 @@ tranches_ptz <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwF sheet = "secret_ptz") # # -# data_ecln <- left_join(data_cogifiee, liste_zone, by= c("CodeZone","TypeZone","Zone")) %>% -# left_join(epci %>% select(EPCI,NOM_EPCI), by = "EPCI") + # distinction des données à secrétiser --------- @@ -77,13 +76,13 @@ tranches_ptz <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwF -#table des données publiques +#table des données publiques --------------------------------------------------------------- data_ptz_A <- data_cogifiee %>% filter (grepl("^nb_ptz",variable)) # select(TypeZone,Zone,CodeZone,date,variable,valeur) %>% # mutate(valeur=as.character(valeur)) -#table des données à secrétiser --------- +#table des données à secrétiser ------------------------------------------------------------ data_ptz_B <- data_cogifiee %>% filter (!grepl("^nb_ptz",variable)) @@ -91,18 +90,89 @@ data_ptz_B <- data_cogifiee %>% # table des valeurs data_ptz_B1 <- data_ptz_B %>% filter (!grepl("^n_",variable)) +data_ptz_B1$variable_associe<- tranches_ptz$variable_associee[match(data_ptz_B1$variable,tranches_ptz$variable)] +data_ptz_B1 <- data_ptz_B1 %>% + mutate(code_ident=paste(CodeZone,date,variable_associe)) #création d'une colonne pour identifier zone, année et variable + # table des nombres data_ptz_B2 <- data_ptz_B %>% - filter (grepl("^n_",variable)) - + filter (grepl("^n_",variable))%>% + mutate(code_ident=paste(CodeZone,date,variable)) #création d'une colonne pour identifier zone, année et variable # regroupement tables B1 et B2 ---------- -data_ptz_B1$variable_associe<- tranches_ptz$variable_associee[match(data_ptz_B1$variable,tranches_ptz$variable)] +data_ptz_B1$nombre_prets <- data_ptz_B2$valeur[match(data_ptz_B1$code_ident,data_ptz_B2$code_ident)] +data_ptz_B<-data_ptz_B1 %>% + select(-variable_associe,-code_ident) + +data_ptz_B <- left_join(data_ptz_B, liste_zone, by= c("CodeZone","TypeZone","Zone")) + +#secretisation des données à secrétiser ------------------------------------------------------------ + +# Communes +secret_communes<-data_ptz_B %>% + filter(TypeZone=="Communes") %>% + select(-DEP,-REG,-NATURE_EPCI) + +#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 %>% + mutate(nombre_prets2 = na_if(nombre_prets, 0)) %>% + group_by(variable,EPCI,date) %>% + mutate(A_nb_sup0_inf11=length(which(nombre_prets2<11)), #compte combien inférieur à 11 + A_rang=rank(nombre_prets2, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs + # valeur2 = valeur), + +# secret_communes<-secret_communes %>% +# mutate(valeur=as.character(valeur)) + +secret_communes$secret<-case_when( + secret_communes$nombre_prets2<11 ~ 1, #secret pour toutes les nb_obs inférieurs à 11 + secret_communes$EPCI == "ZZZZZZZZZ" ~ 0, # pas de secret induit pour les communes qui ne sont pas dans un epci + secret_communes$A_nb_sup0_inf11==1 & secret_communes$A_rang <3 ~ 1, #secret sur les 2 communes avec valeurs les plus basses + TRUE ~ 0) + +secret_communes2<-secret_communes %>% + ungroup() %>% + mutate(valeur = case_when( + secret == 1 ~ NA, + TRUE ~ valeur) + ) %>% + mutate(nombre_prets = case_when( + secret == 1 ~ NA, + TRUE ~ nombre_prets) + ) %>% + select(TypeZone,Zone,CodeZone,date,variable,valeur,nombre_prets) + +# fait jusque là + + + + + + +# autres zones (pas de secret induit calculé) +secret_grandes_zones<-data_nombres %>% + filter(TypeZone %in% c("Epci","Départements","Régions","France")) %>% + mutate(valeur2 = valeur,valeur=as.character(valeur)) +secret_grandes_zones$valeur <- case_when( + secret_grandes_zones$valeur2 < 11 ~ "nc", #secret sur les 2 communes avec valeurs les plus basses + TRUE ~ secret_grandes_zones$valeur) +secret_grandes_zones<- secret_grandes_zones %>% + ungroup() %>% + select(TypeZone,Zone,CodeZone,date,variable,valeur) -# fait jusque ici + + + mutate(valeur=as.character(valeur)) +data_ptz_B1$valeur <- case_when( + data_ptz_B1$valeur_associe=="nc" ~ "nc", #secretise si la valeur associee est secretisee + TRUE ~ data_ptz_B1$valeur) +data_ptz_B1<-data_ptz_B1 %>% + select(TypeZone,Zone,CodeZone,date,variable,valeur) + # secrétisation des données ----------- secret_communes<-data_ptz_B %>% filter(TypeZone=="Communes") -- GitLab From e341afac22f9cbb1750b4d26013823765f599ce7 Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Mon, 10 Feb 2025 15:31:44 +0100 Subject: [PATCH 08/22] secretisation et creation indicateurs --- data-raw/secret_ptz.R | 438 +++++++++++++----------------------------- 1 file changed, 129 insertions(+), 309 deletions(-) diff --git a/data-raw/secret_ptz.R b/data-raw/secret_ptz.R index 08f4329..42170c8 100644 --- a/data-raw/secret_ptz.R +++ b/data-raw/secret_ptz.R @@ -10,6 +10,8 @@ library(DBI) library(RPostgreSQL) library(datalibaba) library(googlesheets4) +library(purrr) +library(stringr) rm(list=ls()) @@ -27,10 +29,6 @@ data_cogifiee<-pivot_longer(cogifiee_ptz, values_to = "valeur") %>% mutate_if(is.character,as.factor) -# data_ptz <- left_join(data_cogifiee, liste_zone, by= c("CodeZone","TypeZone","Zone")) %>% -# left_join(epci %>% select(EPCI,NOM_EPCI), by = "EPCI") - - ## authentification google sheet grâce au .Renviron gs4_auth_configure(api_key = Sys.getenv("google_api_key")) gs4_deauth() @@ -38,49 +36,11 @@ gs4_deauth() ## chargement du référentiel indicateurs google sheet tranches_ptz <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", sheet = "secret_ptz") -# -# - - - -# distinction des données à secrétiser --------- - -# # listes des variables logt et promoteurs -# variables_logt <- tranches_ecln %>% -# pull(variable) -# variables_promoteurs <- tranches_ecln %>% -# pull(variable_associee) %>% -# unique() -# -# # table des nb promoteurs -# data_promoteurs <- data_ecln %>% -# filter (variable %in% variables_promoteurs) %>% -# rename(variable_associee=variable, nb_promoteurs=valeur) -# -# #table des données -# data_ecln_donnees <- data_ecln %>% -# filter (variable %in% variables_logt) -# -# data_ecln_donnees <- left_join(data_ecln_donnees, tranches_ecln, by= "variable") -# data_ecln_donnees <- left_join(data_ecln_donnees, data_promoteurs %>% -# select(TypeZone,CodeZone,date,variable_associee,nb_promoteurs), -# by= c("TypeZone","CodeZone","date", "variable_associee") ) - -# #liste des variables publiques ou non -# variables_publiques <- tranches_ecln %>% -# filter(secret=="0") %>% -# pull(variable) -# variables_non_publiques <- tranches_ecln %>% -# filter(secret !="0") %>% -# pull(variable) - - #table des données publiques --------------------------------------------------------------- -data_ptz_A <- data_cogifiee %>% - filter (grepl("^nb_ptz",variable)) - # select(TypeZone,Zone,CodeZone,date,variable,valeur) %>% - # mutate(valeur=as.character(valeur)) +data_publique <- data_cogifiee %>% + filter (grepl("^nb_ptz",variable)) %>% + pivot_wider(names_from = variable, values_from = valeur) #table des données à secrétiser ------------------------------------------------------------ data_ptz_B <- data_cogifiee %>% @@ -92,47 +52,43 @@ data_ptz_B1 <- data_ptz_B %>% filter (!grepl("^n_",variable)) data_ptz_B1$variable_associe<- tranches_ptz$variable_associee[match(data_ptz_B1$variable,tranches_ptz$variable)] data_ptz_B1 <- data_ptz_B1 %>% - mutate(code_ident=paste(CodeZone,date,variable_associe)) #création d'une colonne pour identifier zone, année et variable + mutate(code_ident=paste(TypeZone,CodeZone,date,variable_associe)) #création d'une colonne pour identifier zone, année et variable # table des nombres data_ptz_B2 <- data_ptz_B %>% filter (grepl("^n_",variable))%>% - mutate(code_ident=paste(CodeZone,date,variable)) #création d'une colonne pour identifier zone, année et variable + mutate(code_ident=paste(TypeZone,CodeZone,date,variable)) #création d'une colonne pour identifier zone, année et variable # regroupement tables B1 et B2 ---------- data_ptz_B1$nombre_prets <- data_ptz_B2$valeur[match(data_ptz_B1$code_ident,data_ptz_B2$code_ident)] data_ptz_B<-data_ptz_B1 %>% select(-variable_associe,-code_ident) -data_ptz_B <- left_join(data_ptz_B, liste_zone, by= c("CodeZone","TypeZone","Zone")) - -#secretisation des données à secrétiser ------------------------------------------------------------ - -# Communes -secret_communes<-data_ptz_B %>% - filter(TypeZone=="Communes") %>% - select(-DEP,-REG,-NATURE_EPCI) - -#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 %>% +data_ptz_B <- left_join(data_ptz_B, liste_zone, by= c("CodeZone","TypeZone","Zone")) %>% + mutate(DEP = map_chr(DEP, ~ paste(.x, collapse =","))) %>% # concatène les departements pour les Epci sur plusieurs départements + mutate(REG = map_chr(REG, ~ paste(.x, collapse =","))) %>% # concatène les régions pour les Epci sur plusieurs régions + mutate (zonage_supra = case_when( #affichage du zonage supra pour regroupements + TypeZone =="Communes" ~ EPCI, + TypeZone =="Epci" ~ DEP, + TypeZone =="Départements" ~ REG, + TypeZone =="Régions" ~ "FRANCE", + TRUE ~ NA)) + +#secret induit, pour une meme variable et un meme zonage supra, pour ne pas retrouver la valeur d'une zone +#en faisant la somme des autres zones +data_secret<-data_ptz_B %>% + select(-EPCI,-DEP,-REG,-NATURE_EPCI) %>% mutate(nombre_prets2 = na_if(nombre_prets, 0)) %>% - group_by(variable,EPCI,date) %>% + group_by(TypeZone,variable,zonage_supra,date) %>% mutate(A_nb_sup0_inf11=length(which(nombre_prets2<11)), #compte combien inférieur à 11 - A_rang=rank(nombre_prets2, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs - # valeur2 = valeur), - -# secret_communes<-secret_communes %>% -# mutate(valeur=as.character(valeur)) - -secret_communes$secret<-case_when( - secret_communes$nombre_prets2<11 ~ 1, #secret pour toutes les nb_obs inférieurs à 11 - secret_communes$EPCI == "ZZZZZZZZZ" ~ 0, # pas de secret induit pour les communes qui ne sont pas dans un epci - secret_communes$A_nb_sup0_inf11==1 & secret_communes$A_rang <3 ~ 1, #secret sur les 2 communes avec valeurs les plus basses - TRUE ~ 0) - -secret_communes2<-secret_communes %>% - ungroup() %>% + A_rang=rank(nombre_prets2, ties.method = "first")) %>% #classe pour repérer les 2 plus petites valeurs + mutate(secret = case_when( + nombre_prets2<11 ~ 1, #secret pour toutes les nb_obs inférieurs à 11 + zonage_supra == "ZZZZZZZZZ" ~ 0, # pas de secret induit pour les communes qui ne sont pas dans un epci + A_nb_sup0_inf11==1 & A_rang <3 ~ 1, #secret sur les 2 communes avec valeurs les plus basses + TRUE ~ 0)) %>% + ungroup() +data_secret <-data_secret %>% #remplacement par NA si secret mutate(valeur = case_when( secret == 1 ~ NA, TRUE ~ valeur) @@ -143,249 +99,113 @@ secret_communes2<-secret_communes %>% ) %>% select(TypeZone,Zone,CodeZone,date,variable,valeur,nombre_prets) -# fait jusque là - - +# création des indicateurs calculés------------------------------------------------------------------------------------------ +# cacul des indicateurs montant et durée moyens +data_indicateurs1 <- data_secret %>% + filter(variable != "surh_neuf" & variable != "vtto_neuf") %>% + mutate(valeur2 = valeur/nombre_prets) %>% + select(-valeur,-nombre_prets) %>% + mutate(variable=str_replace(variable,"dtpp","dur_moy_pp"), + variable=str_replace(variable,"durt","dur_moy_ptz"), + variable=str_replace(variable,"vtpp","mont_moy_pp"), + variable=str_replace(variable,"vtpz","mont_moy_ptz"), + variable=str_replace(variable,"vtpr","mont_moy_prets") + ) %>% + pivot_wider(names_from = variable, values_from = valeur2) - -# autres zones (pas de secret induit calculé) -secret_grandes_zones<-data_nombres %>% - filter(TypeZone %in% c("Epci","Départements","Régions","France")) %>% - mutate(valeur2 = valeur,valeur=as.character(valeur)) -secret_grandes_zones$valeur <- case_when( - secret_grandes_zones$valeur2 < 11 ~ "nc", #secret sur les 2 communes avec valeurs les plus basses - TRUE ~ secret_grandes_zones$valeur) -secret_grandes_zones<- secret_grandes_zones %>% - ungroup() %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur) - - +# cacul de l'indicateur prix au m2 de l'opération pour le neuf +data_indicateurs2 <- data_secret %>% + filter(variable %in% c("surh_neuf","vtto_neuf")) %>% + select(-nombre_prets) %>% + pivot_wider(names_from = variable, values_from = valeur) %>% + mutate(prix_m2_op.neuf = vtto_neuf/surh_neuf) %>% + select(-vtto_neuf,-surh_neuf) + # pivot_longer(-c(TypeZone,Zone,CodeZone,date), names_to = "variable", values_to = "valeur") +# REGROUPEMENT DES DONNEES------------------------------------------------------------------------------------------ +indicateur_ptz <- left_join(data_publique,data_indicateurs1,data_indicateurs2, by =c("TypeZone","Zone","CodeZone","date")) - mutate(valeur=as.character(valeur)) -data_ptz_B1$valeur <- case_when( - data_ptz_B1$valeur_associe=="nc" ~ "nc", #secretise si la valeur associee est secretisee - TRUE ~ data_ptz_B1$valeur) -data_ptz_B1<-data_ptz_B1 %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur) - -# secrétisation des données ----------- -secret_communes<-data_ptz_B %>% - 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_inf3=length(which(nb_promoteurs<3))) %>% #compte combien inférieur à 3 - mutate(A_rang=rank(nb_promoteurs, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs -secret_communes$A_sec<-case_when( - secret_communes$nb_promoteurs<3 ~ 1, #secret pour toutes les nb_promoteurs inférieurs à 3 - secret_communes$A_nb_inf3== 0 ~ 0, #enlève le secret si aucune des communes rang 1 et 2 inférieur à 3 - secret_communes$A_rang<3 ~ 1, #secret sur les 2 communes avec valeurs les plus basses - TRUE ~ 0) - -# secret induit, pour une meme categorie 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(categorie,Zone,date) %>% - mutate(B_nb_inf3=length(which(nb_promoteurs<3))) %>% #compte combien inférieur à 3 - mutate(B_rang=rank(nb_promoteurs, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs -secret_communes$B_sec<-case_when( - secret_communes$B_nb_inf3== 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) - -# masque le collectif pour une commune dont l'individuel a été masqué par le secret induit -secret_communes <- secret_communes %>% - mutate (somme_secrets = A_sec + B_sec) %>% - group_by(CodeZone,categorie,date) %>% #pour chaque commune - mutate(a_secretiser=length(which(somme_secrets>0))) # secretise toutes les donnes groupees - -# regroupement des secrets, masquage des valeurs -secret_communes<-secret_communes %>% - mutate(valeur=as.character(valeur)) -secret_communes$valeur<-case_when( - is.na(secret_communes$nb_promoteurs)~ "nc", - secret_communes$a_secretiser > 0 ~ "nc", #remplace valeur par "nc" si secret stat - TRUE ~ secret_communes$valeur) -secret_communes<-secret_communes %>% - ungroup() %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur) - - -# secretisation des EPCI ----- - -secret_epci<- data_ecln_B %>% - filter(TypeZone =="Epci") - -# secret induit, pour une meme categorie 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(categorie,CodeZone,date) %>% - mutate(B_nb_inf3=length(which(nb_promoteurs<3))) %>% #compte combien inférieur à 3 - mutate(B_rang=rank(nb_promoteurs, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs -secret_epci$B_sec<-case_when( - secret_epci$valeur<3 ~ 1, #secret pour toutes les valeurs inférieures à 3 - secret_epci$B_nb_inf3== 0 ~ 0, #enlève le secret si aucune des communes rang 1 et 2 inférieur à 3 - 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( - is.na(secret_epci$nb_promoteurs)~ "nc", - 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) - - -# secretisation Départements et Régions ----- -secret_dep_reg<- data_ecln_B %>% - filter(TypeZone %in% c("Régions","Départements")) - #table des données publiques departement et regions -public_dep_reg_A <- secret_dep_reg %>% - filter (!(variable %in% c("prix_total_des_ventes.collectif","prix_total_des_ventes.individuel","prix_total_des_ventes.total" ))) %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur) %>% - mutate(valeur=as.character(valeur)) - #table des données à secrétiser departement et regions -secret_dep_reg_B <- secret_dep_reg %>% - filter (variable %in% c("prix_total_des_ventes.collectif","prix_total_des_ventes.individuel","prix_total_des_ventes.total" )) - -#secret induit, pour une meme variable et une meme regioçn, pour ne pas retrouver la valeur d'un département -#en faisant la somme des partements - -secret_dep_reg_B1<-secret_dep_reg_B %>% - mutate(REG = as.character(REG)) %>% - group_by(variable,REG,TypeZone,date) %>% - mutate(A_nb_inf3=length(which(nb_promoteurs<3))) %>% #compte combien inférieur à 3 - mutate(A_rang=rank(nb_promoteurs, ties.method = "first")) #classe pour repérer les 2 plus petites valeurs -secret_dep_reg_B1$A_sec<-case_when( - secret_dep_reg_B1$nb_promoteurs<3 ~ 1, #secret pour toutes les nb_promoteurs inférieurs à 3 - secret_dep_reg_B1$A_nb_inf3== 0 ~ 0, #enlève le secret si aucun des departements rang 1 et 2 inférieur à 3 - secret_dep_reg_B1$A_rang<3 ~ 1, #secret sur les 2 DEPARTEMENTS avec valeurs les plus basses - TRUE ~ 0) - - # secret induit, pour une meme categorie et un meme departement, pour ne pas retrouver la valeur d'une variable - # en faisant la somme des variables du departement -secret_dep1<-secret_dep_reg_B1 %>% - ungroup() %>% - group_by(categorie,TypeZone,CodeZone,date) %>% #groupe par categorie, zone et annee - mutate(B_nb_inf3=length(which(nb_promoteurs<3))) # compte le nombre de fois ou nb promoteurs <3 par groupe -secret_dep1$B_sec<-case_when( - secret_dep1$B_nb_inf3== 0 ~ 0, #enleve secret (affiche 0) si le nb de fois où groupe <3 est égal à 0 - TRUE ~ 1) #pour les autres, code 1 (secret) -# secret_dep1$C_sec<-case_when( -# secret_dep1$B_nb_inf3== 0 ~ 0, #enleve secret (affiche 0) si le nb de fois où groupe <3 est égal à 0 -# TRUE ~ 1) - -# masque le collectif pour un dep dont l'individuel a été masqué par le secret induit -secret_dep2 <- secret_dep1 %>% - mutate (somme_secrets = A_sec + B_sec) %>% - group_by(TypeZone,DEP,REG,categorie,date) %>% #pour chaque departement - mutate(a_secretiser=length(which(somme_secrets>0))) # secretise toutes les donnes groupees - - - - # regroupement des secrets, masquage des valeurs -secret_dep2<-secret_dep2 %>% - mutate(valeur=as.character(valeur)) -secret_dep2$valeur<-case_when( - is.na(secret_dep2$nb_promoteurs)~ "nc", - secret_dep2$a_secretiser > 0 ~ "nc", #remplace valeur par "nc" si secret stat - TRUE ~ secret_dep2$valeur) - -secret_dep2<-secret_dep2 %>% - ungroup() %>% - select(TypeZone,Zone,CodeZone,date,variable,valeur) - -# regroupement des zonages ------------ -secretise_ecln <-bind_rows(secret_communes,secret_epci,data_ecln_A,public_dep_reg_A,secret_dep2) - - -# remplace "nc" par NA -secretise_ecln$valeur<-na_if(secretise_ecln$valeur,"nc") - -secretise_ecln <- secretise_ecln %>% - mutate(valeur=as.numeric(valeur)) %>% - mutate_if(is.factor,as.character) %>% - pivot_wider(names_from = variable,values_from = valeur) - - -# versement dans le sgbd/datamart.portrait_territoires ------------- -poster_data(data = secretise_ecln, - db = "datamart", - schema = "portrait_territoires", - table = "secretise_ecln", - pk = c("TypeZone", "Zone", "CodeZone", "date"), - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - user = "does") - -# commentaires de la table et des variables ------------- - -# récupération des commentaires de la table source -dico_var <- get_table_comments( - db = "datamart", - schema = "portrait_territoires", - table = "cogifiee_ecln", - user = "does") - -# commentaire de la table -comm_table <- filter(dico_var, is.na(nom_col)) %>% - pull(commentaire) %>% - gsub("\nCommentaire.*$", "", .) - -commenter_table( - comment = comm_table, - db = "datamart", - schema = "portrait_territoires", - table = "secretise_ecln", - user = "does" -) - -## 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 == "secret_ecln") %>% - # 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, - "TypeZone", "Type de territoire", - "Zone", " Nom du territoire", - "CodeZone", "Code INSEE du territoire", - "date", "Millesime" - ) - ) - -post_dico_attr( - dico = metadata_indicateur, - db = "datamart", - schema = "portrait_territoires", - table = "secretise_ecln", - user = "does" -) +# +# # versement dans le sgbd/datamart.portrait_territoires ------------- +# poster_data(data = indicateur_ptz, +# db = "datamart", +# schema = "portrait_territoires", +# table = "indicateur_ptz", +# pk = c("TypeZone", "Zone", "CodeZone", "date"), +# post_row_name = FALSE, +# overwrite = TRUE, +# droits_schema = TRUE, +# 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(indicateur_ptz), 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, +# "TypeZone", "Type de territoire", +# "Zone", " Nom du territoire", +# "CodeZone", "Code INSEE du territoire", +# "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_ptz", 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", "Chargement des donn\u00e9es sur serveur rstudio CGDD") +# +# ## commentaires de la table +# +# commenter_table(comment = metadata_source, +# db = "datamart", +# schema = "portrait_territoires", +# table = "indicateur_ptz", +# user = "does") +# +# rm(list=ls()) -- GitLab From d037062fb962ad3effb4897b80605040f6405c30 Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Tue, 18 Feb 2025 14:24:15 +0100 Subject: [PATCH 09/22] modifications et renommage du script --- data-raw/{secret_ptz.R => indicateur_ptz.R} | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) rename data-raw/{secret_ptz.R => indicateur_ptz.R} (97%) diff --git a/data-raw/secret_ptz.R b/data-raw/indicateur_ptz.R similarity index 97% rename from data-raw/secret_ptz.R rename to data-raw/indicateur_ptz.R index 42170c8..1de5257 100644 --- a/data-raw/secret_ptz.R +++ b/data-raw/indicateur_ptz.R @@ -127,10 +127,11 @@ data_indicateurs2 <- data_secret %>% # REGROUPEMENT DES DONNEES------------------------------------------------------------------------------------------ -indicateur_ptz <- left_join(data_publique,data_indicateurs1,data_indicateurs2, by =c("TypeZone","Zone","CodeZone","date")) - - +indicateur_ptz <- data_indicateurs1 %>% + # left_join(data_publique,by =c("TypeZone","Zone","CodeZone","date")) %>% + left_join(data_indicateurs2,by =c("TypeZone","Zone","CodeZone","date")) +save(indicateur_ptz,file="ptz_cogifiee.RData") # -- GitLab From 3bc93c99e17d9a1b10dc37041fa689e5ac5d41cc Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Thu, 27 Feb 2025 15:53:10 +0100 Subject: [PATCH 10/22] correction du chargement de la base --- data-raw/chargement_ptz.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 19ffe4b..29acf19 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -35,7 +35,7 @@ annee_conservee = 2013 # on supprime les années antérieures BASE_PTZ_DHUP<- read_delim(paste0("/nfs/data/partage-PTZ-EPTZ/PTZ-EPTZ/BASE_PTZ_DHUP_",millesime,"_DREAL.csv"), - delim = ";", escape_double = FALSE, trim_ws = TRUE) + delim = ";", escape_double = FALSE, locale = locale(decimal_mark = ","), trim_ws = TRUE) # base_2023 <- BASE_PTZ_DHUP %>% # filter (an == 2023) -- GitLab From 0d90ef6c665cc002d82584472e16c8d3c8ae4ec4 Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Fri, 28 Feb 2025 15:19:10 +0100 Subject: [PATCH 11/22] nettoyage des scripts et dernieres finitions --- data-raw/chargement_ptz.R | 14 -------------- data-raw/cogification_ptz.R | 2 -- data-raw/indicateur_ptz.R | 21 +++++++++------------ 3 files changed, 9 insertions(+), 28 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 29acf19..78c1992 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -1,4 +1,3 @@ - # chargement_ptz # librairies -------------- @@ -6,7 +5,6 @@ library(tidyverse) library(lubridate) library(COGiter) library(sf) -# library(tricky) library(DBI) library(RPostgreSQL) library(datalibaba) @@ -37,9 +35,6 @@ annee_conservee = 2013 # on supprime les années antérieures BASE_PTZ_DHUP<- read_delim(paste0("/nfs/data/partage-PTZ-EPTZ/PTZ-EPTZ/BASE_PTZ_DHUP_",millesime,"_DREAL.csv"), delim = ";", escape_double = FALSE, locale = locale(decimal_mark = ","), trim_ws = TRUE) -# base_2023 <- BASE_PTZ_DHUP %>% -# filter (an == 2023) - # suppression des années anciennes base_intermediaire <- BASE_PTZ_DHUP %>% filter (an >= annee_conservee) %>% @@ -47,7 +42,6 @@ base_intermediaire <- BASE_PTZ_DHUP %>% filter (csen == "V") - # application de filtres conformément aux recommandations # Dans les statistiques du bilan annuel de la SGFGAS, les données ne respectant pas ces critères # sont considérées comme inexploitables : elles sont renseignées avec un ‘.’. @@ -117,9 +111,6 @@ base_intermediaire <- base_intermediaire %>% vtpp < vtpz ~ NA, TRUE ~ vtpp)) - - - base <- base_intermediaire %>% # cpfl = code postal , cins = code insee, cdco = code commune déclaré # lcom = libéllé commune, timm = type logement (1 = individuel, 2 = collectif) @@ -176,9 +167,6 @@ ptz_etat <- base %>% values_from = valeur) - - - # prix total de l'opération (vtto) et surface (surh), pour le neuf # Ces 2 variables ne seront utilisées que pour le calcul du prix au m2 de l'opération. # La surface dans l'ancien (surh) étant la surface avant travaux et non la surface des travaux, @@ -229,8 +217,6 @@ ptz <- ptz_detail %>% rm(ptz_detail,ptz_etat,ptz_type,ptz_total,ptz_etat_neuf, base, base_intermediaire) -# fait jusque ici - # liste des communes de France liste_communes_france <- communes %>% select(DEPCOM) %>% pull() %>% as.character() diff --git a/data-raw/cogification_ptz.R b/data-raw/cogification_ptz.R index 5a5dcdf..6d099ea 100644 --- a/data-raw/cogification_ptz.R +++ b/data-raw/cogification_ptz.R @@ -1,7 +1,5 @@ - # cogification_ptz - # librairies ------ library(DBI) library(RPostgreSQL) diff --git a/data-raw/indicateur_ptz.R b/data-raw/indicateur_ptz.R index 1de5257..08efebf 100644 --- a/data-raw/indicateur_ptz.R +++ b/data-raw/indicateur_ptz.R @@ -1,5 +1,4 @@ - -# secret_ptz +# secret_ptz et creation des indicateurs # librairies ------------- library(dplyr) @@ -15,7 +14,6 @@ library(stringr) rm(list=ls()) - # # chargement data ------------- # cogifiee_ptz <- importer_data(db = "datamart", # schema = "portrait_territoires", @@ -37,10 +35,10 @@ gs4_deauth() tranches_ptz <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", sheet = "secret_ptz") -#table des données publiques --------------------------------------------------------------- -data_publique <- data_cogifiee %>% - filter (grepl("^nb_ptz",variable)) %>% - pivot_wider(names_from = variable, values_from = valeur) +# #table des données publiques -----pas utilisée pour les indicateurs---------------------------------------------------------- +# data_publique <- data_cogifiee %>% +# filter (grepl("^nb_ptz",variable)) %>% +# pivot_wider(names_from = variable, values_from = valeur) #table des données à secrétiser ------------------------------------------------------------ data_ptz_B <- data_cogifiee %>% @@ -99,13 +97,13 @@ data_secret <-data_secret %>% #remplacement par NA si secret ) %>% select(TypeZone,Zone,CodeZone,date,variable,valeur,nombre_prets) - # création des indicateurs calculés------------------------------------------------------------------------------------------ # cacul des indicateurs montant et durée moyens data_indicateurs1 <- data_secret %>% filter(variable != "surh_neuf" & variable != "vtto_neuf") %>% mutate(valeur2 = valeur/nombre_prets) %>% + # mutate(valeur2 = na_if(valeur2,NaN)) %>% select(-valeur,-nombre_prets) %>% mutate(variable=str_replace(variable,"dtpp","dur_moy_pp"), variable=str_replace(variable,"durt","dur_moy_ptz"), @@ -114,16 +112,15 @@ data_indicateurs1 <- data_secret %>% variable=str_replace(variable,"vtpr","mont_moy_prets") ) %>% pivot_wider(names_from = variable, values_from = valeur2) - + # cacul de l'indicateur prix au m2 de l'opération pour le neuf data_indicateurs2 <- data_secret %>% filter(variable %in% c("surh_neuf","vtto_neuf")) %>% select(-nombre_prets) %>% pivot_wider(names_from = variable, values_from = valeur) %>% mutate(prix_m2_op.neuf = vtto_neuf/surh_neuf) %>% + # mutate(prix_m2_op.neuf = na_if(prix_m2_op.neuf,NaN)) %>% select(-vtto_neuf,-surh_neuf) - # pivot_longer(-c(TypeZone,Zone,CodeZone,date), names_to = "variable", values_to = "valeur") - # REGROUPEMENT DES DONNEES------------------------------------------------------------------------------------------ @@ -131,7 +128,7 @@ indicateur_ptz <- data_indicateurs1 %>% # left_join(data_publique,by =c("TypeZone","Zone","CodeZone","date")) %>% left_join(data_indicateurs2,by =c("TypeZone","Zone","CodeZone","date")) -save(indicateur_ptz,file="ptz_cogifiee.RData") +save(indicateur_ptz,file="ptz_indicateur.RData") # -- GitLab From ef1beb51ecdd9d21676d722352b580eeddfd9c1a Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Fri, 28 Feb 2025 17:38:05 +0100 Subject: [PATCH 12/22] =?UTF-8?q?suppression=20des=20filtres=20suppl=C3=A9?= =?UTF-8?q?mentaires?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- data-raw/chargement_ptz.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 78c1992..b10d518 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -102,14 +102,14 @@ mutate(vtpr = case_when( # la durée du différé du prêt principal (ddpp) est inférieure à 60 mois : non appliqué car indicateur non utilisé # -# filtres supplémentaires sur les montants -base_intermediaire <- base_intermediaire %>% - mutate(vtpr = case_when( - vtpr < vtpp ~ NA, - TRUE ~ vtpr)) %>% - mutate(vtpp = case_when( - vtpp < vtpz ~ NA, - TRUE ~ vtpp)) +# # filtres supplémentaires sur les montants +# base_intermediaire <- base_intermediaire %>% +# mutate(vtpr = case_when( +# vtpr < vtpp ~ NA, +# TRUE ~ vtpr)) %>% +# mutate(vtpp = case_when( +# vtpp < vtpz ~ NA, +# TRUE ~ vtpp)) base <- base_intermediaire %>% # cpfl = code postal , cins = code insee, cdco = code commune déclaré -- GitLab From d291ca365d76f234cb5c3e5ceaa1a41b43fa5b4c Mon Sep 17 00:00:00 2001 From: Juliette Engelaere-Lefebvre <juliette.engelaere@developpement-durable.gouv.fr> Date: Fri, 28 Feb 2025 18:43:49 +0100 Subject: [PATCH 13/22] =?UTF-8?q?Modification=20des=20fonctions=20d'int?= =?UTF-8?q?=C3=A9raction=20avec=20le=20SGBD=20pour=20pouvoir=20choisir=20l?= =?UTF-8?q?e=20serveur=20de=20destination?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/cogifier_it.R | 6 +++--- R/poster_doc_post_cogifier.R | 11 +++++++---- R/poster_documenter_data.R | 34 +++++++++++++++++----------------- R/poster_documenter_ind.R | 29 +++++++++++++++-------------- 4 files changed, 42 insertions(+), 38 deletions(-) diff --git a/R/cogifier_it.R b/R/cogifier_it.R index 039df16..c9f73b8 100644 --- a/R/cogifier_it.R +++ b/R/cogifier_it.R @@ -2,7 +2,7 @@ library(dplyr) library(COGiter) library(datalibaba) -cogifier_it <- function(nom_source = "besoins_chaleur_cerema", ...){ +cogifier_it <- function(nom_source = "besoins_chaleur_cerema", user = "does", serveur = NULL, secret = FALSE, ...){ df_source <- importer_data(db = "datamart", schema = "portrait_territoires", table = paste0("source_", nom_source)) %>% @@ -18,8 +18,8 @@ cogifier_it <- function(nom_source = "besoins_chaleur_cerema", ...){ pk = c("TypeZone", "Zone", "CodeZone", "date"), post_row_name = FALSE, overwrite = TRUE, - droits_schema = TRUE, - user = "does") + droits_schema = !secret, + user = user) return(df_cogifie) } diff --git a/R/poster_doc_post_cogifier.R b/R/poster_doc_post_cogifier.R index 8913a8e..5d026d6 100644 --- a/R/poster_doc_post_cogifier.R +++ b/R/poster_doc_post_cogifier.R @@ -4,17 +4,18 @@ library(dplyr) # une fonction pour propager les commentaires de tables et de champs à la table cogifiée -poster_documenter_post_cogifier <- function(source = "combustible_principal_rp") { +poster_documenter_post_cogifier <- function(source = "combustible_principal_rp", user = "does", serveur = NULL) { # creation du nom des tables tbl_source <- paste0("source_", source) tbl_cogifiee <- paste0("cogifiee_", source) # récupération des commentaires de la table source dico_var <- get_table_comments( + server = serveur, db = "datamart", schema = "portrait_territoires", table = tbl_source, - user = "does") + user = user) # commentaire de la table comm_table <- filter(dico_var, is.na(nom_col)) %>% @@ -22,11 +23,12 @@ poster_documenter_post_cogifier <- function(source = "combustible_principal_rp") gsub("\nCommentaire.*$", "", .) commenter_table( + server = serveur, comment = comm_table, db = "datamart", schema = "portrait_territoires", table = tbl_cogifiee, - user = "does" + user = user ) # commentaire des variables @@ -43,10 +45,11 @@ poster_documenter_post_cogifier <- function(source = "combustible_principal_rp") post_dico_attr( dico = comm_champ, + server = serveur, db = "datamart", schema = "portrait_territoires", table = tbl_cogifiee, - user = "does" + user = user ) } diff --git a/R/poster_documenter_data.R b/R/poster_documenter_data.R index c719eca..924d10d 100644 --- a/R/poster_documenter_data.R +++ b/R/poster_documenter_data.R @@ -1,7 +1,7 @@ library(datalibaba) library(googlesheets4) -poster_documenter_it <- function(df = pop10, nom_table_sgbd = "source_pop_rgp_insee", +poster_documenter_it <- function(df = pop10, nom_table_sgbd = "source_pop_rgp_insee", user = "does", serveur = NULL, secret = FALSE, comm_source_en_plus = "T\u00e9l\u00e9chargement depuis...") { # Vérif clé primaire : une ligne par commune et par date @@ -13,15 +13,15 @@ poster_documenter_it <- function(df = pop10, nom_table_sgbd = "source_pop_rgp_in # CHARGEMENT de la table dans le SGBD - datalibaba::poster_data(data = df, - db = "datamart", - schema = "portrait_territoires", - table = nom_table_sgbd, - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("depcom", "date"), # déclaration d'une clé primaire sur la table postée : on ne doit pas avoir deux lignes avec à la fois le même code commune et la meme date - user = "does") + datalibaba::poster_data(data = df, server = serveur, + db = "datamart", + schema = "portrait_territoires", + table = nom_table_sgbd, + post_row_name = FALSE, + overwrite = TRUE, + droits_schema = !secret, + pk = c("depcom", "date"), # déclaration d'une clé primaire sur la table postée : on ne doit pas avoir deux lignes avec à la fois le même code commune et la meme date + user = user) # RECUPERATION DES METADONNEES @@ -65,9 +65,9 @@ poster_documenter_it <- function(df = pop10, nom_table_sgbd = "source_pop_rgp_in "V\u00e9rifier si df contient bien toutes les variables attendues et adpatez le r\u00e9f\u00e9rentiel des indicateurs au besoin.")) - ## Envoi des libellés de variable dans le SGBD + ## Envoi des libellés de variable en commentaire de champ dans le SGBD datalibaba::post_dico_attr(dico = metadata_indicateur, table = nom_table_sgbd, schema = "portrait_territoires", - db = "datamart", user = "does") + db = "datamart", user = user, server = serveur) ## Récupération des métadonnées de la source nom_sce <- stringr::str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% @@ -84,12 +84,12 @@ poster_documenter_it <- function(df = pop10, nom_table_sgbd = "source_pop_rgp_in ## commentaires de la table - datalibaba::commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = nom_table_sgbd, - user = "does") + db = "datamart", + server = serveur, + schema = "portrait_territoires", + table = nom_table_sgbd, + user = user) } diff --git a/R/poster_documenter_ind.R b/R/poster_documenter_ind.R index cacdb64..e124a62 100644 --- a/R/poster_documenter_ind.R +++ b/R/poster_documenter_ind.R @@ -2,7 +2,7 @@ library(datalibaba) library(googlesheets4) poster_documenter_ind <- function(df = indicateur_bimotor_menages, nom_table_sgbd = "indicateur_bimotor_menages", - comm_source_en_plus = "", nom_script_sce = NULL) { + comm_source_en_plus = "", nom_script_sce = NULL, user = "does", serveur = NULL, secret = FALSE) { # Vérif clé primaire : une ligne par commune et par date doublons <- df %>% @@ -14,14 +14,15 @@ poster_documenter_ind <- function(df = indicateur_bimotor_menages, nom_table_sgb # CHARGEMENT de la table dans le SGBD datalibaba::poster_data(data = df, - db = "datamart", - schema = "portrait_territoires", - table = nom_table_sgbd, - post_row_name = FALSE, - overwrite = TRUE, - droits_schema = TRUE, - pk = c("TypeZone", "CodeZone", "date"), # déclaration d'une clé primaire sur la table postée : on ne doit pas avoir deux lignes avec à la fois la même zone et la meme date - user = "does") + server = serveur, + db = "datamart", + schema = "portrait_territoires", + table = nom_table_sgbd, + post_row_name = FALSE, + overwrite = TRUE, + droits_schema = !secret, + pk = c("TypeZone", "CodeZone", "date"), # déclaration d'une clé primaire sur la table postée : on ne doit pas avoir deux lignes avec à la fois la même zone et la meme date + user = use) # RECUPERATION DES METADONNEES @@ -76,7 +77,7 @@ poster_documenter_ind <- function(df = indicateur_bimotor_menages, nom_table_sgb ## Envoi des libellés de variable dans le SGBD datalibaba::post_dico_attr(dico = metadata_indicateur, table = nom_table_sgbd, schema = "portrait_territoires", - db = "datamart", user = "does") + db = "datamart", server = serveur, user = user) ## Récupération des métadonnées de la source nom_sce <- stringr::str_replace(nom_script_sce, "chargement_|ref_|specifique_", "") %>% @@ -96,10 +97,10 @@ poster_documenter_ind <- function(df = indicateur_bimotor_menages, nom_table_sgb ## commentaires de la table datalibaba::commenter_table(comment = metadata_source, - db = "datamart", - schema = "portrait_territoires", - table = nom_table_sgbd, - user = "does") + db = "datamart", + schema = "portrait_territoires", + table = nom_table_sgbd, + user = user, server = serveur) } -- GitLab From da0aa7010d0eeec95c2f3322e4f356025f700cb1 Mon Sep 17 00:00:00 2001 From: Juliette Engelaere-Lefebvre <juliette.engelaere@developpement-durable.gouv.fr> Date: Fri, 28 Feb 2025 19:59:30 +0100 Subject: [PATCH 14/22] =?UTF-8?q?WIP=20:=20utilisation=20des=20fonctions?= =?UTF-8?q?=20de=20chargement=20et=20documentation=20des=20donn=C3=A9es=20?= =?UTF-8?q?sur=20ptz,=20pour=20=C3=A9change=20et=20pr=C3=A9sentation=20de?= =?UTF-8?q?=20l'adaptation=20au=20contexte=20du=20serveur=20SDES?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- data-raw/chargement_ptz.R | 113 +++++++---------------------- data-raw/cogification_ptz.R | 96 ++++++++----------------- data-raw/indicateur_ptz.R | 140 ++++++++++-------------------------- 3 files changed, 91 insertions(+), 258 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index b10d518..ef4ec49 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -1,4 +1,4 @@ -# chargement_ptz +# chargement_ptz (a exécuter dans sur le serveur du SDES) # librairies -------------- library(tidyverse) @@ -32,7 +32,7 @@ millesime = 2023 #millesime du fichier annee_conservee = 2013 # on supprime les années antérieures -BASE_PTZ_DHUP<- read_delim(paste0("/nfs/data/partage-PTZ-EPTZ/PTZ-EPTZ/BASE_PTZ_DHUP_",millesime,"_DREAL.csv"), +BASE_PTZ_DHUP <- read_delim(paste0("/nfs/data/partage-PTZ-EPTZ/PTZ-EPTZ/BASE_PTZ_DHUP_",millesime,"_DREAL.csv"), delim = ";", escape_double = FALSE, locale = locale(decimal_mark = ","), trim_ws = TRUE) # suppression des années anciennes @@ -219,88 +219,27 @@ rm(ptz_detail,ptz_etat,ptz_type,ptz_total,ptz_etat_neuf, base, base_intermediair # liste des communes de France -liste_communes_france <- communes %>% select(DEPCOM) %>% pull() %>% as.character() - -ptz <- cogifier(ptz, epci = F, departements = F,regions = F, metro = F) %>% - select (depcom = CodeZone, date, variable, valeur) %>% - mutate(depcom = forcats::fct_drop(.data$depcom)) %>% #enlève les facteurs inutiles - mutate(depcom = fct_expand(depcom, liste_communes_france)) %>% - complete(depcom, date, variable, fill = list(valeur = 0)) %>% - filter(!str_starts(depcom,"97"),!str_starts(depcom,"98")) %>% - mutate(depcom = forcats::fct_drop(.data$depcom)) %>% #enlève les facteurs inutiles - pivot_wider(names_from = variable,values_from = valeur) - -save(ptz,file="ptz_chargement.RData") - -# # versement dans le sgbd/datamart.portrait_territoires ------------- -# poster_data(data = ptz, -# db = "datamart", -# schema = "portrait_territoires", -# table = "source_ptz", -# post_row_name = FALSE, -# overwrite = TRUE, -# droits_schema = TRUE, -# pk = c("depcom", "date"), # déclaration d'une clé primaire sur la table postée : on ne doit pas avoir deux lignes avec à la fois le même code commune et la meme date -# 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(ptz), c("depcom", "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, -# "depcom", "Code INSEE de la commune", -# "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 = "source_ptz", 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", "Chargement des donn\u00e9es sur Geokit3") -# -# ## commentaires de la table -# -# commenter_table(comment = metadata_source, -# db = "datamart", -# schema = "portrait_territoires", -# table = "source_ptz", -# user = "does") -# +liste_communes_france <- communes %>% + filter(!str_starts(depcom,"97"), !str_starts(depcom,"98"))%>% + select(DEPCOM) %>% pull() %>% as.character() + +ptz <- passer_au_cog_a_jour(ptz, code_commune = DEPCOM, aggrege = TRUE, garder_info_supra = FALSE, na.rm = FALSE) %>% + mutate(DEPCOM = forcats::fct_drop(DEPCOM)) %>% # enlève les facteurs inutiles + mutate(DEPCOM = fct_expand(DEPCOM, liste_communes_france)) %>% + complete(DEPCOM, date, variable, fill = list(valeur = 0)) %>% + mutate(DEPCOM = as.character(DEPCOM)) %>% + pivot_wider(names_from = variable, values_from = valeur) + +# save(ptz, file="ptz_chargement.RData") + +# versement dans le sgbd EcoSQL/datamart.portrait_territoires ------------- + +source("R/poster_documenter_data.R", encoding = "UTF-8") +poster_documenter_it( + df = ptz, + nom_table_sgbd = "source_ptz", + comm_source_en_plus = "Données chargées depuis le serveur RStudio du SDES pour les DREALs", + secret = TRUE, + user = Sys.getenv("user_ecosql_stat"), + serveur = Sys.getenv("server_ecosql") +) \ No newline at end of file diff --git a/data-raw/cogification_ptz.R b/data-raw/cogification_ptz.R index 6d099ea..d56e03b 100644 --- a/data-raw/cogification_ptz.R +++ b/data-raw/cogification_ptz.R @@ -1,75 +1,35 @@ -# cogification_ptz +# cogification_ptz (a exécuter dans le contexte DREAL, tant que tout le datamart n'est pas passé sur EcoSQL) # librairies ------ -library(DBI) -library(RPostgreSQL) library(dplyr) library(COGiter) library(datalibaba) rm(list = ls()) - -load("ptz_chargement.RData") -source_ptz <- ptz - -# source_ptz <- importer_data(db = "datamart", -# schema = "portrait_territoires", -# table = "source_ptz") - -cogifiee_ptz<-cogifier(source_ptz %>% rename(DEPCOM=depcom))%>% - mutate_if(is.factor,as.character) - -save(cogifiee_ptz,file="ptz_cogifiee.RData") - -# poster_data(data = cogifiee_ptz, -# db = "datamart", -# schema = "portrait_territoires", -# table = "cogifiee_ptz", -# pk = c("TypeZone", "Zone", "CodeZone", "date"), -# post_row_name = FALSE, -# overwrite = TRUE, -# droits_schema = TRUE, -# user = "does") -# -# # commentaires de la table et des variables ------------- -# -# # récupération des commentaires de la table source -# dico_var <- get_table_comments( -# db = "datamart", -# schema = "portrait_territoires", -# table = "source_ptz", -# user = "does") -# -# # commentaire de la table -# comm_table <- filter(dico_var, is.na(nom_col)) %>% -# pull(commentaire) %>% -# gsub("\nCommentaire.*$", "", .) -# -# commenter_table( -# comment = comm_table, -# db = "datamart", -# schema = "portrait_territoires", -# table = "cogifiee_ptz", -# user = "does" -# ) -# -# # commentaire des variables -# comm_champ <- select(dico_var, nom_col, commentaire) %>% -# filter(!is.na(nom_col), nom_col != "depcom") %>% -# bind_rows( -# tribble( -# ~nom_col, ~commentaire, -# "TypeZone", "Type de territoire", -# "Zone", " Nom du territoire", -# "CodeZone", "Code INSEE du territoire" -# ) -# ) -# -# post_dico_attr( -# dico = comm_champ, -# db = "datamart", -# schema = "portrait_territoires", -# table = "cogifiee_ptz", -# user = "does" -# ) - +source("R/cogifier_it.R") +source("R/poster_doc_post_cogifier.R") + +# process sans SGBD +# load("ptz_chargement.RData") +# source_ptz <- ptz +# cogifiee_ptz <- cogifier(source_ptz) +# save(cogifiee_ptz, file="ptz_cogifiee.RData") + +# process SGBD + +# récupération des données sur EcoSQL +source_ptz <- importer_data(db = "datamart", schema = "portrait_territoires", table = "source_ptz") %>% + rename_with(.cols = any_of("depcom"), .fn = toupper) +# versement des données préparées sur le serveur du SDES sur SGBD DREAL +poster_documenter_it( + df = ptz, + nom_table_sgbd = "source_ptz", + comm_source_en_plus = "Données chargées depuis le serveur RStudio du SDES pour les DREALs", + secret = TRUE +) + +# cogification et versement des données cogifiées dans le SGBD +cogifier_it(nom_source = "ptz", secret = TRUE) + +# versement dans le sgbd/datamart.portrait_territoires et metadonnee ------------- +poster_documenter_post_cogifier(source = "ptz", user = Sys.getenv("user_ecosql_stat"), serveur = Sys.getenv("server_ecosql")) diff --git a/data-raw/indicateur_ptz.R b/data-raw/indicateur_ptz.R index 08efebf..7024a2c 100644 --- a/data-raw/indicateur_ptz.R +++ b/data-raw/indicateur_ptz.R @@ -1,4 +1,4 @@ -# secret_ptz et creation des indicateurs +# secret_ptz et creation des indicateurs (a exécuter dans le contexte DREAL, tant que tout le datamart n'est pas passé sur EcoSQL) # librairies ------------- library(dplyr) @@ -14,33 +14,36 @@ library(stringr) rm(list=ls()) -# # chargement data ------------- -# cogifiee_ptz <- importer_data(db = "datamart", -# schema = "portrait_territoires", -# table = "cogifiee_ptz") -load("ptz_cogifiee.RData") +# chargement data ------------- +cogifiee_ptz <- importer_data(db = "datamart", schema = "portrait_territoires", table = "cogifiee_ptz") +# load("ptz_cogifiee.RData") - -data_cogifiee<-pivot_longer(cogifiee_ptz, - cols = dtpp : vtto_neuf, - names_to = "variable", - values_to = "valeur") %>% +data_cogifiee <- pivot_longer(cogifiee_ptz, + cols = dtpp : vtto_neuf, + names_to = "variable", + values_to = "valeur") %>% mutate_if(is.character,as.factor) -## 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 -tranches_ptz <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277", - sheet = "secret_ptz") - -# #table des données publiques -----pas utilisée pour les indicateurs---------------------------------------------------------- -# data_publique <- data_cogifiee %>% -# filter (grepl("^nb_ptz",variable)) %>% +## création de la table de correspondance des variables de secrétisation (plus simple à comprendre pour le relecteur du code) +tranches_ptz <- tribble( + ~variable, ~variable_associee, + 'dtpp', 'n_dtpp', + 'durt', 'n_durt', + 'vtpp', 'n_vtpp', + 'vtpr', 'n_vtpr', + 'vtpz', 'n_vtpz', + 'vtto_neuf', 'n_vtto_neuf', + 'surh_neuf', 'n_vtto_neuf' + ) + + +# table des données publiques -----pas utilisée pour les indicateurs----------------------- +# data_publique <- data_cogifiee %>% +# filter(grepl("^nb_ptz", variable)) %>% # pivot_wider(names_from = variable, values_from = valeur) -#table des données à secrétiser ------------------------------------------------------------ + +# table des données à secrétiser ------------------------------------------------------------ data_ptz_B <- data_cogifiee %>% filter (!grepl("^nb_ptz",variable)) @@ -48,7 +51,7 @@ data_ptz_B <- data_cogifiee %>% # table des valeurs data_ptz_B1 <- data_ptz_B %>% filter (!grepl("^n_",variable)) -data_ptz_B1$variable_associe<- tranches_ptz$variable_associee[match(data_ptz_B1$variable,tranches_ptz$variable)] +data_ptz_B1$variable_associe <- tranches_ptz$variable_associee[match(data_ptz_B1$variable,tranches_ptz$variable)] data_ptz_B1 <- data_ptz_B1 %>% mutate(code_ident=paste(TypeZone,CodeZone,date,variable_associe)) #création d'une colonne pour identifier zone, année et variable @@ -128,82 +131,13 @@ indicateur_ptz <- data_indicateurs1 %>% # left_join(data_publique,by =c("TypeZone","Zone","CodeZone","date")) %>% left_join(data_indicateurs2,by =c("TypeZone","Zone","CodeZone","date")) -save(indicateur_ptz,file="ptz_indicateur.RData") - - -# -# # versement dans le sgbd/datamart.portrait_territoires ------------- -# poster_data(data = indicateur_ptz, -# db = "datamart", -# schema = "portrait_territoires", -# table = "indicateur_ptz", -# pk = c("TypeZone", "Zone", "CodeZone", "date"), -# post_row_name = FALSE, -# overwrite = TRUE, -# droits_schema = TRUE, -# 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(indicateur_ptz), 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, -# "TypeZone", "Type de territoire", -# "Zone", " Nom du territoire", -# "CodeZone", "Code INSEE du territoire", -# "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_ptz", 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", "Chargement des donn\u00e9es sur serveur rstudio CGDD") -# -# ## commentaires de la table -# -# commenter_table(comment = metadata_source, -# db = "datamart", -# schema = "portrait_territoires", -# table = "indicateur_ptz", -# user = "does") -# -# rm(list=ls()) +# save(indicateur_ptz, file="ptz_indicateur.RData") + +# versement dans le sgbd/datamart.portrait_territoires et metadonnées --------- +source("R/poster_documenter_ind.R", encoding = "UTF-8") +poster_documenter_ind( + df = indicateur_ptz, + nom_table_sgbd = "indicateur_ptz", + comm_source_en_plus = "Chargement des donn\u00e9es sur serveur rstudio CGDD" +) + -- GitLab From d695b700eaa8f38182690c5cc53fdac602b7c680 Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Mon, 3 Mar 2025 10:28:34 +0100 Subject: [PATCH 15/22] changements majuscules --- data-raw/chargement_ptz.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index ef4ec49..22e2aaf 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -220,14 +220,15 @@ rm(ptz_detail,ptz_etat,ptz_type,ptz_total,ptz_etat_neuf, base, base_intermediair # liste des communes de France liste_communes_france <- communes %>% - filter(!str_starts(depcom,"97"), !str_starts(depcom,"98"))%>% + filter(!str_starts(DEPCOM,"97"), !str_starts(DEPCOM,"98"))%>% select(DEPCOM) %>% pull() %>% as.character() ptz <- passer_au_cog_a_jour(ptz, code_commune = DEPCOM, aggrege = TRUE, garder_info_supra = FALSE, na.rm = FALSE) %>% mutate(DEPCOM = forcats::fct_drop(DEPCOM)) %>% # enlève les facteurs inutiles mutate(DEPCOM = fct_expand(DEPCOM, liste_communes_france)) %>% complete(DEPCOM, date, variable, fill = list(valeur = 0)) %>% - mutate(DEPCOM = as.character(DEPCOM)) %>% + mutate(DEPCOM = as.character(DEPCOM)) %>% + rename(depcom=DEPCOM) %>% pivot_wider(names_from = variable, values_from = valeur) # save(ptz, file="ptz_chargement.RData") @@ -242,4 +243,4 @@ poster_documenter_it( secret = TRUE, user = Sys.getenv("user_ecosql_stat"), serveur = Sys.getenv("server_ecosql") -) \ No newline at end of file +) -- GitLab From 0da5df5b232de72b1dbe975f06da269c1761e19e Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Mon, 3 Mar 2025 16:57:00 +0100 Subject: [PATCH 16/22] rectification import export --- data-raw/chargement_ptz.R | 2 +- data-raw/cogification_ptz.R | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 22e2aaf..9f68fab 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -241,6 +241,6 @@ poster_documenter_it( nom_table_sgbd = "source_ptz", comm_source_en_plus = "Données chargées depuis le serveur RStudio du SDES pour les DREALs", secret = TRUE, - user = Sys.getenv("user_ecosql_stat"), + user = "ecosql_stat", serveur = Sys.getenv("server_ecosql") ) diff --git a/data-raw/cogification_ptz.R b/data-raw/cogification_ptz.R index d56e03b..7bec224 100644 --- a/data-raw/cogification_ptz.R +++ b/data-raw/cogification_ptz.R @@ -18,8 +18,13 @@ source("R/poster_doc_post_cogifier.R") # process SGBD # récupération des données sur EcoSQL -source_ptz <- importer_data(db = "datamart", schema = "portrait_territoires", table = "source_ptz") %>% +source_ptz <- importer_data(db = "datamart", + schema = "portrait_territoires", + table = "source_ptz", + user = "ecosql_stat", + server = Sys.getenv("server_ecosql")) %>% rename_with(.cols = any_of("depcom"), .fn = toupper) + # versement des données préparées sur le serveur du SDES sur SGBD DREAL poster_documenter_it( df = ptz, -- GitLab From 9be85adbe560d12642ab20f1a34ed964ff6a299f Mon Sep 17 00:00:00 2001 From: "daniel.kalioudjoglou" <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Mon, 3 Mar 2025 17:03:38 +0100 Subject: [PATCH 17/22] nettoyage chargement --- data-raw/chargement_ptz.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 9f68fab..12f79d4 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -231,8 +231,6 @@ ptz <- passer_au_cog_a_jour(ptz, code_commune = DEPCOM, aggrege = TRUE, garder_i rename(depcom=DEPCOM) %>% pivot_wider(names_from = variable, values_from = valeur) -# save(ptz, file="ptz_chargement.RData") - # versement dans le sgbd EcoSQL/datamart.portrait_territoires ------------- source("R/poster_documenter_data.R", encoding = "UTF-8") -- GitLab From 804c48c24ed7baf26927f66517fbcbcff956d807 Mon Sep 17 00:00:00 2001 From: Daniel Kalioudjoglou <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Thu, 6 Mar 2025 09:18:57 +0100 Subject: [PATCH 18/22] poster sur serveur sgbd --- data-raw/cogification_ptz.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/data-raw/cogification_ptz.R b/data-raw/cogification_ptz.R index 7bec224..4cc643a 100644 --- a/data-raw/cogification_ptz.R +++ b/data-raw/cogification_ptz.R @@ -8,6 +8,7 @@ library(datalibaba) rm(list = ls()) source("R/cogifier_it.R") source("R/poster_doc_post_cogifier.R") +source("R/poster_documenter_data.R", encoding = "UTF-8") # process sans SGBD # load("ptz_chargement.RData") @@ -18,12 +19,12 @@ source("R/poster_doc_post_cogifier.R") # process SGBD # récupération des données sur EcoSQL -source_ptz <- importer_data(db = "datamart", +ptz <- importer_data(db = "datamart", schema = "portrait_territoires", table = "source_ptz", user = "ecosql_stat", - server = Sys.getenv("server_ecosql")) %>% - rename_with(.cols = any_of("depcom"), .fn = toupper) + server = Sys.getenv("server_ecosql")) + # rename_with(.cols = any_of("depcom"), .fn = toupper) # versement des données préparées sur le serveur du SDES sur SGBD DREAL poster_documenter_it( @@ -37,4 +38,5 @@ poster_documenter_it( cogifier_it(nom_source = "ptz", secret = TRUE) # versement dans le sgbd/datamart.portrait_territoires et metadonnee ------------- -poster_documenter_post_cogifier(source = "ptz", user = Sys.getenv("user_ecosql_stat"), serveur = Sys.getenv("server_ecosql")) +# poster_documenter_post_cogifier(source = "ptz", user = Sys.getenv("user_ecosql_stat"), serveur = Sys.getenv("server_ecosql")) +poster_documenter_post_cogifier(source = "ptz") -- GitLab From 28f6bb41180326d138a6fcd175541d41f8ca60cd Mon Sep 17 00:00:00 2001 From: Daniel Kalioudjoglou <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Thu, 6 Mar 2025 14:59:36 +0100 Subject: [PATCH 19/22] modification chargements sgbd --- data-raw/cogification_ptz.R | 3 ++- data-raw/indicateur_ptz.R | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/data-raw/cogification_ptz.R b/data-raw/cogification_ptz.R index 4cc643a..51d02ce 100644 --- a/data-raw/cogification_ptz.R +++ b/data-raw/cogification_ptz.R @@ -24,7 +24,8 @@ ptz <- importer_data(db = "datamart", table = "source_ptz", user = "ecosql_stat", server = Sys.getenv("server_ecosql")) - # rename_with(.cols = any_of("depcom"), .fn = toupper) +# %>% +# rename_with(.cols = any_of("depcom"), .fn = toupper) # versement des données préparées sur le serveur du SDES sur SGBD DREAL poster_documenter_it( diff --git a/data-raw/indicateur_ptz.R b/data-raw/indicateur_ptz.R index 7024a2c..956f115 100644 --- a/data-raw/indicateur_ptz.R +++ b/data-raw/indicateur_ptz.R @@ -129,7 +129,8 @@ data_indicateurs2 <- data_secret %>% indicateur_ptz <- data_indicateurs1 %>% # left_join(data_publique,by =c("TypeZone","Zone","CodeZone","date")) %>% - left_join(data_indicateurs2,by =c("TypeZone","Zone","CodeZone","date")) + left_join(data_indicateurs2,by =c("TypeZone","Zone","CodeZone","date")) %>% + mutate_if(is.factor,as.character) # save(indicateur_ptz, file="ptz_indicateur.RData") -- GitLab From 98693b046ba8fe732a8cc02e8b54c850b93a89a1 Mon Sep 17 00:00:00 2001 From: Daniel Kalioudjoglou <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Tue, 25 Mar 2025 11:23:17 +0100 Subject: [PATCH 20/22] modification methode de chargement des donnees --- data-raw/chargement_ptz.R | 33 ++++++++++++++++++++++++++++++++- data-raw/cogification_ptz.R | 27 --------------------------- data-raw/indicateur_ptz.R | 1 - 3 files changed, 32 insertions(+), 29 deletions(-) diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R index 12f79d4..829652d 100644 --- a/data-raw/chargement_ptz.R +++ b/data-raw/chargement_ptz.R @@ -1,4 +1,4 @@ -# chargement_ptz (a exécuter dans sur le serveur du SDES) +# chargement_ptz (1ere partie à exécuter sur le serveur Rstudiodu SDES) # librairies -------------- library(tidyverse) @@ -242,3 +242,34 @@ poster_documenter_it( user = "ecosql_stat", serveur = Sys.getenv("server_ecosql") ) + + +#------------------------------------------------------------------------------------------------------------------ +#------------------------------------------------------------------------------------------------------------------ +# 2e partie, à éxécuter sur le PC de bureau (hors serveur SDES) +#------------------------------------------------------------------------------------------------------------------ +#------------------------------------------------------------------------------------------------------------------ + +# librairies ------ +library(dplyr) +library(COGiter) +library(datalibaba) + +rm(list = ls()) +source("R/poster_documenter_data.R", encoding = "UTF-8") + +# récupération des données sur EcoSQL +ptz <- importer_data(db = "datamart", + schema = "portrait_territoires", + table = "source_ptz", + user = "ecosql_stat", + server = Sys.getenv("server_ecosql")) + +# versement des données sur SGBD DREAL +poster_documenter_it( + df = ptz, + nom_table_sgbd = "source_ptz", + comm_source_en_plus = "Données chargées depuis le serveur RStudio du SDES pour les DREALs", + secret = TRUE +) + diff --git a/data-raw/cogification_ptz.R b/data-raw/cogification_ptz.R index 51d02ce..0317a79 100644 --- a/data-raw/cogification_ptz.R +++ b/data-raw/cogification_ptz.R @@ -8,36 +8,9 @@ library(datalibaba) rm(list = ls()) source("R/cogifier_it.R") source("R/poster_doc_post_cogifier.R") -source("R/poster_documenter_data.R", encoding = "UTF-8") - -# process sans SGBD -# load("ptz_chargement.RData") -# source_ptz <- ptz -# cogifiee_ptz <- cogifier(source_ptz) -# save(cogifiee_ptz, file="ptz_cogifiee.RData") - -# process SGBD - -# récupération des données sur EcoSQL -ptz <- importer_data(db = "datamart", - schema = "portrait_territoires", - table = "source_ptz", - user = "ecosql_stat", - server = Sys.getenv("server_ecosql")) -# %>% -# rename_with(.cols = any_of("depcom"), .fn = toupper) - -# versement des données préparées sur le serveur du SDES sur SGBD DREAL -poster_documenter_it( - df = ptz, - nom_table_sgbd = "source_ptz", - comm_source_en_plus = "Données chargées depuis le serveur RStudio du SDES pour les DREALs", - secret = TRUE -) # cogification et versement des données cogifiées dans le SGBD cogifier_it(nom_source = "ptz", secret = TRUE) # versement dans le sgbd/datamart.portrait_territoires et metadonnee ------------- -# poster_documenter_post_cogifier(source = "ptz", user = Sys.getenv("user_ecosql_stat"), serveur = Sys.getenv("server_ecosql")) poster_documenter_post_cogifier(source = "ptz") diff --git a/data-raw/indicateur_ptz.R b/data-raw/indicateur_ptz.R index 956f115..4a54dae 100644 --- a/data-raw/indicateur_ptz.R +++ b/data-raw/indicateur_ptz.R @@ -16,7 +16,6 @@ rm(list=ls()) # chargement data ------------- cogifiee_ptz <- importer_data(db = "datamart", schema = "portrait_territoires", table = "cogifiee_ptz") -# load("ptz_cogifiee.RData") data_cogifiee <- pivot_longer(cogifiee_ptz, cols = dtpp : vtto_neuf, -- GitLab From fc1c99ac6a7d4da33ecc9ea124cf80ae64f60c6a Mon Sep 17 00:00:00 2001 From: Daniel Kalioudjoglou <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Tue, 25 Mar 2025 12:30:22 +0100 Subject: [PATCH 21/22] correction erreur dans fonction manque un r a user --- R/poster_documenter_ind.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/poster_documenter_ind.R b/R/poster_documenter_ind.R index e124a62..25d80b0 100644 --- a/R/poster_documenter_ind.R +++ b/R/poster_documenter_ind.R @@ -22,7 +22,7 @@ poster_documenter_ind <- function(df = indicateur_bimotor_menages, nom_table_sgb overwrite = TRUE, droits_schema = !secret, pk = c("TypeZone", "CodeZone", "date"), # déclaration d'une clé primaire sur la table postée : on ne doit pas avoir deux lignes avec à la fois la même zone et la meme date - user = use) + user = user) # RECUPERATION DES METADONNEES -- GitLab From 566e2d45aec9c921951ae90062d17fbcb205a5b3 Mon Sep 17 00:00:00 2001 From: Daniel Kalioudjoglou <daniel.kalioudjoglou@developpement-durable.gouv.fr> Date: Wed, 26 Mar 2025 10:09:52 +0100 Subject: [PATCH 22/22] Arrondi des donnees a l'entier --- data-raw/indicateur_ptz.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/data-raw/indicateur_ptz.R b/data-raw/indicateur_ptz.R index 4a54dae..4158041 100644 --- a/data-raw/indicateur_ptz.R +++ b/data-raw/indicateur_ptz.R @@ -104,7 +104,7 @@ data_secret <-data_secret %>% #remplacement par NA si secret # cacul des indicateurs montant et durée moyens data_indicateurs1 <- data_secret %>% filter(variable != "surh_neuf" & variable != "vtto_neuf") %>% - mutate(valeur2 = valeur/nombre_prets) %>% + mutate(valeur2 = round(valeur/nombre_prets,0)) %>% # mutate(valeur2 = na_if(valeur2,NaN)) %>% select(-valeur,-nombre_prets) %>% mutate(variable=str_replace(variable,"dtpp","dur_moy_pp"), @@ -120,7 +120,7 @@ data_indicateurs2 <- data_secret %>% filter(variable %in% c("surh_neuf","vtto_neuf")) %>% select(-nombre_prets) %>% pivot_wider(names_from = variable, values_from = valeur) %>% - mutate(prix_m2_op.neuf = vtto_neuf/surh_neuf) %>% + mutate(prix_m2_op.neuf = round(vtto_neuf/surh_neuf,0)) %>% # mutate(prix_m2_op.neuf = na_if(prix_m2_op.neuf,NaN)) %>% select(-vtto_neuf,-surh_neuf) -- GitLab