From 2c37f06b0dc16a86d9cdbf254c68809844a02315 Mon Sep 17 00:00:00 2001
From: "Daniel.Kalioudjoglou"
<daniel.kalioudjoglou@developpement-durable.gouv.fr>
Date: Wed, 26 Mar 2025 20:11:35 +0000
Subject: [PATCH] =?UTF-8?q?integration=20des=20donn=C3=A9es=20ptz=20depuis?=
=?UTF-8?q?=20serveur=20rstudio=20cgdd?=
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 +--
data-raw/chargement_ptz.R | 367 +++++++++++++++++++++++++----------
data-raw/cogification_ptz.R | 70 +------
data-raw/indicateur_ptz.R | 143 ++++++++++++++
7 files changed, 454 insertions(+), 206 deletions(-)
create mode 100644 data-raw/indicateur_ptz.R
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..25d80b0 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 = user)
# 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)
}
diff --git a/data-raw/chargement_ptz.R b/data-raw/chargement_ptz.R
index f67798a..829652d 100644
--- a/data-raw/chargement_ptz.R
+++ b/data-raw/chargement_ptz.R
@@ -1,12 +1,10 @@
-
-# chargement_ptz
-
+# chargement_ptz (1ere partie à exécuter sur le serveur Rstudiodu SDES)
# librairies --------------
-library(readxl)
library(tidyverse)
-library(tricky)
library(lubridate)
+library(COGiter)
+library(sf)
library(DBI)
library(RPostgreSQL)
library(datalibaba)
@@ -14,105 +12,264 @@ 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
+
+
+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
+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 ‘.’.
+base_intermediaire <- base_intermediaire %>%
+ # # 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 ~ 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 ~ 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)
+ 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 ~ 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)
+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é
+#
+
+# # 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)
+ # 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(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(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)
+ ) %>%
+ 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)), # 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
+ )
+
+# 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"))%>%
+ 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)
+
+
+# liste des communes de France
+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)) %>%
+ rename(depcom=DEPCOM) %>%
+ pivot_wider(names_from = variable, values_from = valeur)
+
+# 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 = "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"))
-# 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)
-
-
-# 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")
+# 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 fe76802..0317a79 100644
--- a/data-raw/cogification_ptz.R
+++ b/data-raw/cogification_ptz.R
@@ -1,72 +1,16 @@
-
-# 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())
+source("R/cogifier_it.R")
+source("R/poster_doc_post_cogifier.R")
-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"
- )
- )
-
-post_dico_attr(
- dico = comm_champ,
- db = "datamart",
- schema = "portrait_territoires",
- table = "cogifiee_ptz",
- user = "does"
-)
+# 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")
diff --git a/data-raw/indicateur_ptz.R b/data-raw/indicateur_ptz.R
new file mode 100644
index 0000000..4158041
--- /dev/null
+++ b/data-raw/indicateur_ptz.R
@@ -0,0 +1,143 @@
+# 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)
+library(tidyr)
+library(lubridate)
+library(COGiter)
+library(DBI)
+library(RPostgreSQL)
+library(datalibaba)
+library(googlesheets4)
+library(purrr)
+library(stringr)
+
+rm(list=ls())
+
+# chargement data -------------
+cogifiee_ptz <- importer_data(db = "datamart", schema = "portrait_territoires", table = "cogifiee_ptz")
+
+data_cogifiee <- pivot_longer(cogifiee_ptz,
+ cols = dtpp : vtto_neuf,
+ names_to = "variable",
+ values_to = "valeur") %>%
+ mutate_if(is.character,as.factor)
+
+## 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 ------------------------------------------------------------
+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))
+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
+
+# table des nombres
+data_ptz_B2 <- data_ptz_B %>%
+ filter (grepl("^n_",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")) %>%
+ 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(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
+ 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)
+ ) %>%
+ mutate(nombre_prets = case_when(
+ secret == 1 ~ NA,
+ TRUE ~ nombre_prets)
+ ) %>%
+ 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 = round(valeur/nombre_prets,0)) %>%
+ # 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"),
+ 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)
+
+# 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 = round(vtto_neuf/surh_neuf,0)) %>%
+ # mutate(prix_m2_op.neuf = na_if(prix_m2_op.neuf,NaN)) %>%
+ select(-vtto_neuf,-surh_neuf)
+
+# REGROUPEMENT DES DONNEES------------------------------------------------------------------------------------------
+
+indicateur_ptz <- data_indicateurs1 %>%
+ # left_join(data_publique,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")
+
+# 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