Chargement des librairies

library(stats)
library(sf)
library(dbscan)
library(mapview)
library(factoextra)
library(ggplot2)
library(readxl)
library (openxlsx)
library(tidyverse)
library(naniar)
library(SpatialPosition)
library(cartography)
library(fastpot)

Ce document présente l’ensemble des étapes du traitement de la base PTZ en vue de la création des indicateurs harmonisés. Tous les traitements sont entrepris à partir de l’échantillon original de la base de données, tel qu’il a été réceptionné par l’équipe de recherche. Chaque utilisateur disposant du même jeu de données à la possibilité de jouer intégralement les scripts proposés.

Nettoyage des données

#Import des données
PTZ_Brute <- read.delim("CASSMIR_NoOpenDataRaws/Base_PTZ_2016.txt", stringsAsFactors=FALSE, encoding = "UTF-8")
# Se référer au dictionnaire de la base PTZ pour les indications de nettoyage
BasePTZ <- PTZ_Brute %>% 
  filter (csen == "V",vtpr<450000 & vtpr>vtpp+vtpz, vtto>762 & vtto<350000 & tegp<16, vtto<450000 & vtto >7600, vtpp>762 & vtpp<350000, nppr <=10, nper <=10,
          dtpp > 24 & dtpp <480, vt1e>15 &  vt1e <2287, ddpp < 60) %>% 
  # Filtrage avec conditions préconisées pour utilisation de PTZ, voir dico PTZ
  filter ( tope != 3) %>% # on exclut les opérations qui concernent de la construction individuelle sans achat de terrain
  filter(dept==75 |dept==91 | dept==92| dept==93 | dept==94 | dept==95 | dept==77 | dept==78, an>=1996) # Selection terrain et années d'études de 1996 à 2016
  
  # Recodage sur le code communal de Paris pour obtenir arrondissement
BasePTZ$cpfl <- as.character(BasePTZ$cpfl)
BasePTZ$cins <- as.character(BasePTZ$cins)

BasePTZ <-BasePTZ %>%
  mutate(cpfl = case_when(cpfl >= 75001 & cpfl < 76000 ~ 
                            str_replace_all(cpfl, "750","751"), 
                          TRUE ~ cpfl))

BasePTZ <-BasePTZ %>%
  mutate(cins = case_when((cins == 75056 | cins == 75000) & cpfl >=75101 ~ cpfl, 
                        TRUE ~ cins))
BasePTZ <-BasePTZ %>%
  mutate(cins = case_when(cins >= 75001 & cins < 76000 ~ 
                            str_replace_all(cins, "750","751"), 
                          TRUE ~ cpfl)) %>%
  filter(!is.na(cins), cins != 75156, (cins >75000 & cins < 96000))

# Effectif 
EffectifBasePTZ <- length(BasePTZ$cins)

Préparation et mise en forme des données issues de la base PTZ

# Filtrage et sélection des données
BasePTZ <- BasePTZ %>% 
  select (iden, cins,csen,ccsp,vtto,vtpr,vtpz,vtpp,an,tegp,age, napp, tysu, tope, nppr, dtpp, vt1e, rani, rann,revl,emem, stol, timm) 
# La variable cins remplace la variable cins dans l'échantillon anonymisé

Le champ d’investigation des prix

Variables

  • vtto ; nom complet : Montant de l’opération immobilière (en euro) avec un emprunt PTZ ; valeurs des attributs : série continue ; remarque : Variable d’origine de la base PTZ

Script sur les prix

PTZ_Prices <-  BasePTZ %>% 
  select(iden, an, cins, vtto ) # Les variables spatiales et temporelles sont inclues ici.

Le champ d’investigation des acquéreurs-vendeurs

Variables préparées

  • Typ_AcqPtz ; nom complet : Type d’acquéreur pour une opération avec un emprunt PTZ ; valeurs des attributs : “TYP1”, “TYP2” ; remarque : la nature des acquéreurs est nécessairement “personnes physiques” (PPH).

  • CSP_AcqPtz ; nom complet : catégorie socio-professionnelle de l’acquéreur pour une opération avec un emprunt PTZ (en 8 postes) ; valeurs des attributs : “PCS1”, “PCS2”, “PCS3”, “PCS4”, “PCS5”, “PCS6”, “PCS6”, “PCS8”.

  • rann ; nom complet : Revenus nets total à l’année N du ménage acquéreur pour une opération avec un emprunt PTZ ; valeurs des attributs : série continue (en années) ; remarque : Variable d’origine de la base PTZ

  • age ; nom complet : Age de l’acquéreur pour une opération avec un emprunt PTZ ; valeurs des attributs : série continue (en années) ; remarque : Variable d’origine de la base PTZ

  • Tranche_Age_AcqPtz ; nom complet : Tranche d’âge d’appartenance de l’acquéreur pour une opération avec un emprunt PTZ ; valeurs des attributs : “AGE1”, “AGE2”, “AGE3” ; remarque : Informations valables pour Typ_Acq = “TYP1”, sinon \(NA\).

  • SitMatri_AcqPtz ; nom complet : Situation matrimoniale de l’acquéreur avec un emprunt PTZ ; valeurs des attributs : “CEL”, “CONJU”, “DIV”

  • StatutOccupation ; nom complet : Statut d’occupation du logement actuel de l’acquéreur qui réalise une opération avec PTZ ; valeurs des attributs : “HLM”, “PRIV”, “PROP”, “PAREN”, “AUTR” ; remarque : A partir de novembre 1997 les propriétaires ne peuvent plus bénéficier du PTZ, en dehors de cas spécifiques classés dans la catégorie “AUTR”. Voir dictionnaire de la base PTZ pour les détails.

“HLM” = Locatif HLM, “PRIV” = Locatif privé, “PROP” = Propriétaire, “AUTR” = Autre

PTZ_ACVE <-  BasePTZ %>% 
  select(iden, an, rani, rann, ccsp, age, emem, stol)

# Type et CSP des acquéreurs avec un emprunt PTZ
PTZ_ACVE <- PTZ_ACVE %>%
  mutate(Type_Acq = case_when( ccsp >= 1 & ccsp<= 69 ~"TYP1",
ccsp >= 70 & ccsp<= 90 ~ "TYP2"),
CSP_Acq = case_when(ccsp == 10 ~ "PCS1",
                    ccsp >= 20 & ccsp < 30 ~ "PCS2",
                    ccsp >= 30 & ccsp < 40 ~ "PCS3",
                    ccsp >= 40 & ccsp < 50 ~ "PCS4",
                    ccsp >= 50 & ccsp < 60 ~ "PCS5",
                    ccsp >= 60 & ccsp < 70 ~ "PCS6",
                    ccsp >= 70 & ccsp < 80 ~ "PCS6",
                    ccsp == 80 ~ "PCS8"))

# Tranche Age parmi les actifs emprunteurs PTZ
PTZ_ACVE <- PTZ_ACVE %>%
mutate (Tranche_Age_Acq = case_when(Type_Acq == "TYP1" & (age >= 18 & age < 30) ~ "AGE1",
                             Type_Acq == "TYP1" & (age >= 30 & age < 50) ~ "AGE2",
                             Type_Acq == "TYP1" & age >= 50 ~ "AGE3"))

# Etat matrimonial de l'emprunteur PTZ
PTZ_ACVE <- PTZ_ACVE %>%
  mutate(SitMatri_Acq =  case_when (emem == "1" | emem == "5" ~ "CONJU", 
          emem == "2"| emem == "3" ~ "DIV",
emem == "4" ~ "CEL" ))

# Statut d'occupation  du logement actuel de l'acquéreur qui réalise une opération avec PTZ
PTZ_ACVE <- PTZ_ACVE %>%
  mutate(StatutOccupation =  case_when (stol == "1"  ~ "HLM", 
          stol =="2" ~ "PRIV",
stol == "3" ~ "PROP", 
stol == "4" ~ "PAREN", 
stol == "5" | stol == "6" | stol == "7" | stol == "8" | stol == "9" ~ "AUTR"))

Le champ d’investigation des régimes d’achat et type de mutation du bien

Les variables sur les régimes d’achat et types de mutation du bien préparées à partir de la base PTZ

  • vtpr ; nom complet : Montant de l’ensemble des prêts pour l’opération immobilière avec un emprunt PTZ (PTZ + autres prêts) ; valeurs des attributs : série continue ; remarque : Variable d’origine de la base PTZ

  • vt1e ; nom complet : Montant de la première mensualité pour l’opération immobilière avec un emprunt PTZ ; valeurs des attributs : série continue ; remarque : Variable d’origine de la base PTZ

  • vtpz ; nom complet : Montant du PTZ pour l’opération immobilière avec un emprunt PTZ ; valeurs des attributs : série continue ; remarque : Variable d’origine de la base PTZ

  • vtpp ; nom complet : Montant du prêt principal pour l’opération immobilière avec un emprunt PTZ ; valeurs des attributs : série continue ; remarque : Variable d’origine de la base PTZ

  • tegp ; nom complet : Taux effectif général du prêt principal pour l’opération immobilière avec un emprunt PTZ ; valeurs des attributs : série continue ; remarque : Variable d’origine de la base PTZ

  • dtpp ; nom complet : Durée totale (en mois) du prêt principal pour l’opération immobilière avec un emprunt PTZ ; valeurs des attributs : série continue ; remarque : Variable d’origine de la base PTZ

  • TypeOperationPTZ ; nom complet : Type d’opération avec un emprunt PTZ ; valeurs des attributs :“NEUF”, “FON”, “REN”, “AUTR” ; remarque : Pour comprendre les évolutions des effectifs par type d’opération il est nécessaire d’étudier les évolutions des modalités d’accès au dispositif PTZ.

  • Nature_PretPrincipal ; nom complet : Nature du prêt principal qui accompagne un emprunt PTZ ; valeurs des attributs :“CONV”, “LIB”,“AUTR”.

-TypeGarantie ; nom complet : Type de garantie sur le prêt principal accompagnant le PTZ ; valeurs des attributs : “N”, “HYPO”, “CAUT”, “AUTR”.

  • FinVenteLog ; nom complet : Revente d’un logement pour le financement de l’acquisition du bien ; valeurs des attributs : “O”, “N”.
PTZ_PURCHMUT <-  BasePTZ %>% 
  select(iden, vtpr, vtpz, vtpp, tegp, napp, tysu, tope,dtpp,vt1e, revl)

# Type d'opération consécutive au prêt PTZ
PTZ_PURCHMUT <- PTZ_PURCHMUT %>%
  mutate(TypeOperationPTZ =  case_when (tope == "1"  ~ "NEUF", 
          tope =="2" ~ "FON",
tope == "4" ~ "REN", TRUE ~ "AUTR" ))

# Nature du prêt principal accompagnant le PTZ pour financer l'opération
PTZ_PURCHMUT <- PTZ_PURCHMUT %>%
  mutate(Nature_PretPrincipal = case_when (napp>=1 & napp<=5 ~ "CONV",
                  napp==6 |  napp==7 ~ "LIB",
                  TRUE ~ "AUTR"))

# Type de garantie sur le prêt principal accompagnant le PTZ pour financer l'opération        
PTZ_PURCHMUT <- PTZ_PURCHMUT %>%
  mutate( TypeGarantie = case_when(tysu==0 ~ "N", 
                                    tysu==1 ~ "HYPO",
                                    tysu==2 ~ "CAUT", 
                                    tysu==3 ~ "CAUT2",
                                    TRUE ~ "AUTR"))

# Revente d'un logement pour le financement de l'acquisition du bien
PTZ_PURCHMUT <- PTZ_PURCHMUT %>%
  mutate(FinVenteLog = case_when(revl== "O" ~ "O", 
                              revl=="N" ~ "N"))

Le champ d’investigation des types de biens immobiliers

Les variables

  • Nature_Bien ; nom complet : nature du bien immobilier de l’opération avec emprunt PTZ ; valeurs des attributs : “MAI”, “APP”

  • TypBien ; nom complet : Type de bien immobilier de l’opération avec emprunt PTZ ; valeurs des attributs : “MAI4”, “APP4”, “MAI2”, “APP2”,“MAI3”, “APP3”, “MAI1”, “APP1” ; remarques : Informations valables pour timm & nppr != \(NA\).

“MAI1” = Petite maison de moins de 3 pièces, “MAI2” = Maison taille standard entre 3 et 5 pièces, “MAI3” = Maison taille standard entre 6 et 7 pièces, “MAI4” = Grande maison de plus de 7 pièces.

“APP1” = Petit appartement de moins de 2 pièces, APP2 = Appartement taille standard entre 2 et 3 pièces, “APP3” = Appartement taille standard entre 4 et 6 pièces, “APP4” = Gand appartement de plus de 6 pièces.

PTZ_TB <-  BasePTZ %>% 
  select(iden, timm, nppr)

# Type d'opération consécutive au prêt PTZ
PTZ_TB <- PTZ_TB %>%
  mutate(Nature_Bien =  case_when (timm == "1"  ~ "MAI", 
          timm =="2" ~ "APP")) 


PTZ_TB <- PTZ_TB %>%
  mutate(TypBien = case_when(timm == "1" & nppr > 7 ~ "MAI4" , timm == "2" & nppr > 6 ~ "APP4",  # Aucun appartement dans la base correspond à cette catégorie
timm == "1" & ( nppr >= 3 & nppr  <= 5) ~ "MAI2",
timm == "1" & ( nppr >= 6 & nppr  <= 7) ~ "MAI3",
 timm == "2" & ( nppr >= 2 & nppr  <= 3) ~ "APP2",
timm == "2" & ( nppr >= 4 & nppr  <= 6) ~ "APP3", 
timm == "1" &  nppr < 3 ~ "MAI1", 
timm == "2" & nppr  < 2 ~ "APP1" ))
PTZ_ReadyForOp <- left_join(PTZ_Prices, PTZ_ACVE %>% select (-an), by = "iden") %>%
  left_join(.,PTZ_PURCHMUT, by = "iden")%>%
  left_join(.,PTZ_TB, by = "iden")

#Rename variable "année"
PTZ_ReadyForOp <- PTZ_ReadyForOp %>% rename(annee = an) 

Production de la base de données à références spatiales

Préparation des données sur les prix

#### Prix pour l'ensemble des biens #######
ComPricesAll_PTZ <- PTZ_ReadyForOp %>%
  filter(!is.na(vtto))%>%
  group_by(annee,cins)  %>%
  summarise(n_operation_PTZ= length(which(!is.na(iden))),
            P_PX_M= mean(vtto),
            P_PX_Q2= median(vtto),
            P_PX_SD= sd(vtto))%>%
              filter(n_operation_PTZ>=5)%>%
              select(-n_operation_PTZ)

Préparation des données sur les acquéreurs-vendeurs

# Type d'Acquéreurs, en pourcentage par commune et par année
ComTypAcq_PTZ <- PTZ_ReadyForOp %>% 
  group_by(annee,cins)  %>%
  summarise(P_AC_TOT= length(which(!is.na(Type_Acq))),
            # Type d'acquereur
            P_AC_PPH_TYP_TYP1=(length(which(Type_Acq=="TYP1"))/P_AC_TOT)*100,
            `P_AC_PPH_TYP_TYP2`=(length(which(Type_Acq=="TYP2"))/P_AC_TOT)*100) %>% 
  filter(P_AC_TOT >= 5)


# Pourcentage des acquéreurs par CSP
ComAcqCSP_PTZ<- PTZ_ReadyForOp %>% 
              filter(!is.na(CSP_Acq)) %>%
              count(cins, annee, CSP_Acq) %>%
              group_by(cins, annee) %>%
              mutate( NAcq = sum(n)) %>%
              spread(CSP_Acq, n, fill = 0) %>% 
              filter(NAcq >= 5)  %>%
              mutate_at(4:ncol(.), funs((./NAcq)*100)) %>%
              rename_at(4:ncol(.), list( ~paste0("P_AC_PPH_",.)))

ComAcqCSP_PTZ <- ComAcqCSP_PTZ %>%
  select(-NAcq)


#Age 
# Mesures de centralité et de dispersion : moyenne, médiane, écart-type
## Acquéreurs
ComAcqAge_PTZ <- PTZ_ReadyForOp %>% 
  filter(!is.na(age)) %>%
  group_by(cins, annee) %>%
  summarise( NAcq = length(which(!is.na(iden))),
             M = mean(age),
             Q2 = median(age),
             SD = sd(age))%>%
  filter(NAcq>= 5)  %>%
  rename_at(4:ncol(.), list( ~paste0("P_AC_PPH_AGE_",.)))

ComAcqAge_PTZ <- ComAcqAge_PTZ %>%
  select(-NAcq)

# Pourcentage par tranches d'âge. Ces tranches ont été uniquement établies pour la population active. 
## Acquéreurs, la population de référence est l'ensemble des personnes physiques, avec âge renseigné.
ComAcqTrancAge_PTZ <- PTZ_ReadyForOp %>% 
  filter(Type_Acq== "TYP1" & !is.na(age)) %>%
  count(cins, annee, Tranche_Age_Acq) %>%
  ungroup %>%
  group_by(cins, annee) %>%
  mutate( NAcq = sum(n, na.rm=TRUE)) %>%
  spread(Tranche_Age_Acq, n, fill = 0) %>% 
  filter(NAcq >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NAcq)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("P_AC_TYP1_",.)))

ComAcqTrancAge_PTZ <- ComAcqTrancAge_PTZ %>%
  select(-NAcq)

# Pourcentage par situation matrimoniale
ComAcqSitMatri_PTZ <- PTZ_ReadyForOp %>% 
  filter( !is.na(SitMatri_Acq)) %>%
  count(cins, annee, SitMatri_Acq) %>%
  group_by(cins, annee) %>%
  mutate( NAcq = sum(n)) %>%
  spread(SitMatri_Acq, n, fill = 0) %>% 
  filter(NAcq >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NAcq)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("P_AC_PPH_MATRI_",.)))

ComAcqSitMatri_PTZ <- ComAcqSitMatri_PTZ %>%
  select(-NAcq)

# Pourcentage Statut d'occupation du logement actuel de l'acquéreur qui réalise une opération avec PTZ 
##NB : A partir de novembre 1997 les propriétaires ne peuvent plus bénéficier du PTZ, en dehors de cas spécifiques.

ComAcqStatOccup_PTZ <- PTZ_ReadyForOp %>% 
  filter( !is.na(StatutOccupation)) %>%
  count(cins, annee, StatutOccupation) %>%
  group_by(cins, annee) %>%
  mutate( NAcq = sum(n)) %>%
  spread(StatutOccupation, n, fill = 0) %>% 
  filter(NAcq >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NAcq)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("P_AC_PPH_STATOCC_",.)))

ComAcqStatOccup_PTZ <- ComAcqStatOccup_PTZ %>%
  select(-NAcq)

# Jointure PTZ # 

CommunesAcq_PTZ<- full_join (ComTypAcq_PTZ, 
           ComAcqCSP_PTZ, 
           by= c("cins","annee")) %>%
  full_join (., 
             ComAcqAge_PTZ, 
             by= c("cins","annee")) %>%
  full_join (., 
             ComAcqTrancAge_PTZ, 
             by= c("cins","annee")) %>%
  full_join (., 
             ComAcqSitMatri_PTZ, 
             by= c("cins","annee"))  %>%
  full_join (., 
             ComAcqStatOccup_PTZ, 
             by= c("cins","annee")) 

Préparation des données sur les régimes d’achat et types de mutation du bien

#### Montants des crédits (prêts principaux et ensemble des prêts),  Type de crédit, garanties sur le pret, et type d'opération #######
CommunesPTZ_PurchMut <- PTZ_ReadyForOp %>%
  group_by(annee,cins)  %>%
  summarise(n_operation_PTZ= length(which(!is.na(cins))),
            # Nature du pret principal
            P_AC_PPH_TYPCRED_LIB=(length(which(Nature_PretPrincipal=="LIB"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPCRED_CONV =(length(which(Nature_PretPrincipal=="CONV"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPCRED_AUTR =(length(which(Nature_PretPrincipal=="AUTR"))/n_operation_PTZ)*100,
            # Type de garantie du crédit
             P_AC_PPH_GARCRED_HYPO  =(length(which(TypeGarantie=="HYPO"))/n_operation_PTZ)*100,
            P_AC_PPH_GARCRED_CAUT =(length(which(TypeGarantie=="CAUT"))/n_operation_PTZ)*100,
            P_AC_PPH_GARCRED_N =(length(which(TypeGarantie=="N"))/n_operation_PTZ)*100,
            # Type d'opération
            P_AC_PPH_TYPOP_NEUF = (length(which(TypeOperationPTZ=="NEUF"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPOP_FON = (length(which(TypeOperationPTZ=="FON"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPOP_REN = (length(which(TypeOperationPTZ=="REN"))/n_operation_PTZ)*100,
            # Montants prêts principaux
            P_AC_PPH_MTCREDPP_M= mean(vtpp),
            P_AC_PPH_MTCREDPP_Q2 = median(vtpp),
            P_AC_PPH_MTCREDPP_SD= sd(vtpp),
            # Montants tous prêts 
            P_AC_PPH_MTCREDPR_M= mean(vtpr),
            P_AC_PPH_MTCREDPR_Q2 = median(vtpr),
            P_AC_PPH_MTCREDPR_SD= sd(vtpr),
            # LTV 
            P_AC_PPH_LTV_M= mean((vtpr/vtto)*100),
            P_AC_PPH_LTV_Q2 = median((vtpr/vtto)*100),
            P_AC_PPH_LTV_SD= sd((vtpr/vtto)*100))%>%
  filter(n_operation_PTZ>=5 ) %>% # Condition à 5 transactions minimum
  select(-n_operation_PTZ)

Préparation des données sur les types de biens

# Nature des biens, en pourcentage par commune et par année
ComNatBiens_PTZ <- PTZ_ReadyForOp %>% 
              filter(!is.na(Nature_Bien)) %>%
              count(cins, annee, Nature_Bien) %>%
              group_by(cins, annee) %>%
              mutate( NAcq = sum(n)) %>%
              spread(Nature_Bien, n, fill = 0) %>% 
              filter(NAcq >= 5)  %>%
              mutate_at(4:ncol(.), funs((./NAcq)*100)) %>%
              rename_at(4:ncol(.), list( ~paste0("P_IMMO_NAT_",.)))%>%
  select(-NAcq)

# Types des biens, en pourcentage par commune et par année
ComTypBiens_PTZ <- PTZ_ReadyForOp %>% 
              filter(!is.na(TypBien)) %>%
              count(cins, annee, TypBien) %>%
              group_by(cins, annee) %>%
              mutate( NAcq = sum(n)) %>%
              spread(TypBien, n, fill = 0) %>% 
              filter(NAcq >= 5)  %>%
              mutate_at(4:ncol(.), funs((./NAcq)*100)) %>%
              rename_at(4:ncol(.), list( ~paste0("P_IMMO_TYP_",.)))%>%
  select(-NAcq)

###################### Jointure  ################

CommunesHousingTypes_PTZ<- full_join (ComNatBiens_PTZ, 
                                  ComTypBiens_PTZ, 
                                  by = c("cins","annee")) 

CommunesHousingTypes_PTZ$cins<-as.character(CommunesHousingTypes_PTZ$cins)


### Jointure des tables PTZ ###

CASSMIR_CommunesPTZ <-  full_join (ComPricesAll_PTZ, CommunesAcq_PTZ,
                                    by = c("cins","annee")) %>%
  full_join (., CommunesPTZ_PurchMut, 
                                  by = c("cins","annee"))%>%
  full_join (., CommunesHousingTypes_PTZ, 
                                  by = c("cins","annee"))  

# Verification
# CASSMIR_CommunesPTZ<-CASSMIR_CommunesPTZ%>%
#   select(-'P_AC_TYP1_<NA>')%>%
#   rename(P_IMMO_APP = P_IMMO_NAT_APP)%>%
#   rename(P_IMMO_MAI = P_IMMO_NAT_MAI)

Production de la base de données sur les groupes de population acquéreurs-vendeurs

Préparation des données sur les prix

### Appariement des Prix avec données PTZ

### Groupe pop par CSP ###
PricesPTZ_Social <-  PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(n_operation_PTZ=length(which(!is.na(iden))),
    M = mean(vtto),
            Q1 = quantile(vtto,0.25),
            Q2 = quantile(vtto,0.5),
            Q3 = quantile(vtto,0.75),
            SD = sd(vtto)) %>%
   filter(n_operation_PTZ>=20)%>%
              select(-n_operation_PTZ) %>%
  rename_at(3:ncol(.), list( ~paste0("P_PX_",.))) 

### Groupe pop par Generation ###

PricesPTZ_Generation <-  PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%  
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(n_operation_PTZ=length(which(!is.na(iden))),
            M = mean(vtto),
            Q1 = quantile(vtto,0.25),
            Q2 = quantile(vtto,0.5),
            Q3 = quantile(vtto,0.75),
            SD = sd(vtto)) %>%
   filter(n_operation_PTZ>=20)%>%
              select(-n_operation_PTZ) %>%
  rename_at(3:ncol(.), list( ~paste0("P_PX_",.))) 

Préparation des données sur les acquereurs vendeurs

### Groupe pop par CSP ###

# Acquéreurs totaux par CSP
TotPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs,.drop = T) %>%
  filter(n >=20)  %>%
  rename(P_AC_TOT = n)

# Type d'Acquéreurs
TypAcqPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Type_Acq,.drop = T) %>%
  spread(Type_Acq, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_TYP_",.)))

#  Age des acquéreurs avec PTZ
AgePTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs), !is.na(age)) %>% # voir conditions d'utilisations données PTZ (Dico PTZ)
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(age),
            Q1 = quantile(age, 0.25, na.rm = T),
            Q2 = quantile(age,0.5, na.rm = T),
            Q3 = quantile(age,0.75, na.rm = T),
            SD = sd(age)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_AGE_",.)))

#  par tranches d'âge. Ces tranches ont été uniquement établies pour la population active. 
## Acquéreurs, la population de référence est l'ensemble des personnes physiques, avec âge renseigné.


TranAgePTZ_Social<- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs),!is.na(Tranche_Age_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(Tranche_Age_Acq,.drop = T) %>%
  spread(Tranche_Age_Acq, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_TYP1_",.)))

#  Revenus total net du ménage des acquéreurs avec PTZ
RevenusPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs), rann > rani & rann <600000) %>% # voir conditions d'utilisations données PTZ (Dico PTZ)
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(rann),
            Q1 = quantile(rann, 0.25, na.rm = T),
            Q2 = quantile(rann,0.5, na.rm = T),
            Q3 = quantile(rann,0.75, na.rm = T),
            SD = sd(rann)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_REV_",.)))

# Statut d'occupation du logement actuel de l'acquéreur qui réalise une opération avec PTZ 
##NB : A partir de novembre 1997 les propriétaires ne peuvent plus bénéficier du PTZ, en dehors de cas spécifiques.

AcqStatOccupPTZ_Social <- PTZ_ReadyForOp %>% 
  mutate(Acquereurs = CSP_Acq ) %>%
  filter( !is.na(StatutOccupation),!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(StatutOccupation,.drop = T) %>%
  spread(StatutOccupation, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_STATOCC_",.)))

# Situation matrimoniale
AcqSitMatriPTZ_Social <- PTZ_ReadyForOp %>% 
  mutate(Acquereurs = CSP_Acq ) %>%
  filter( !is.na(SitMatri_Acq),!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(SitMatri_Acq,.drop = T) %>%
  spread(SitMatri_Acq, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_MATRI_",.)))

# Jointure des tables PTZ Social

BuyersPTZ_Social <- left_join(TotPTZ_Social, 
                             TypAcqPTZ_Social,
                                           by = c("Acquereurs", "annee")) %>%
  left_join(., 
            AgePTZ_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            TranAgePTZ_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            RevenusPTZ_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            AcqStatOccupPTZ_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            AcqSitMatriPTZ_Social,
            by = c("Acquereurs", "annee")) 

### Groupe pop par Génération ###


# Acquéreurs totaux par Generation
TotPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%  
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%count(Acquereurs,.drop = T) %>%
  filter(n >=20)  %>%
  rename(P_AC_TOT = n)


# Type d'Acquéreurs par Generation
TypeAcqPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%  
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Type_Acq,.drop = T) %>%
  spread(Type_Acq, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_",.)))

# CSP des Acquéreurspar Generation
CSP_PTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%  
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(CSP_Acq,.drop = T) %>%
  spread(CSP_Acq, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_",.)))

#  Age des acquéreurs avec PTZ
AgePTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(age)) %>% # voir conditions d'utilisations données PTZ (Dico PTZ)
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(age),
            Q1 = quantile(age, 0.25, na.rm = T),
            Q2 = quantile(age,0.5, na.rm = T),
            Q3 = quantile(age,0.75, na.rm = T),
            SD = sd(age)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_AGE_",.)))


#  Revenus total net du ménage des acquéreurs avec PTZ
RevenusPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), rann > rani & rann <600000) %>% # voir conditions d'utilisations données PTZ (Dico PTZ)
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(rann),
            Q1 = quantile(rann, 0.25, na.rm = T),
            Q2 = quantile(rann,0.5, na.rm = T),
            Q3 = quantile(rann,0.75, na.rm = T),
            SD = sd(rann)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_REV_",.)))

# Statut d'occupation du logement actuel de l'acquéreur qui réalise une opération avec PTZ 
##NB : A partir de novembre 1997 les propriétaires ne peuvent plus bénéficier du PTZ, en dehors de cas spécifiques.

AcqStatOccupPTZ_Generation <- PTZ_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter( !is.na(StatutOccupation),!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(StatutOccupation,.drop = T) %>%
  spread(StatutOccupation, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_STATOCC_",.)))

# Situation matrimoniale
AcqSitMatriPTZ_Generation <- PTZ_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter( !is.na(SitMatri_Acq),!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(SitMatri_Acq,.drop = T) %>%
  spread(SitMatri_Acq, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_MATRI_",.)))

# Jointure des tables PTZ Generation

BuyersPTZ_Generation <- left_join(TotPTZ_Generation, 
                             TypeAcqPTZ_Generation,
                             by = c("Acquereurs", "annee")) %>%
    left_join(., 
            CSP_PTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            AgePTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            RevenusPTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            AcqStatOccupPTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            AcqSitMatriPTZ_Generation,
            by = c("Acquereurs", "annee")) 

Préparation des données sur les régimes d’achat et types de mutation du bien

### Groupe Social par CSP ###

# Agregation sur les variables de types de prêt principal et Type de bien (Ancien/neuf)acheté
PretPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(n_operation_PTZ= length(which(!is.na(Acquereurs))),
            # Nature du pret principal
            P_AC_PPH_TYPCRED_LIB=(length(which(Nature_PretPrincipal=="LIB"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPCRED_CONV=(length(which(Nature_PretPrincipal=="CONV"))/n_operation_PTZ)*100,            
            # Type de garantie du crédit
            P_AC_PPH_GARCRED_HYPO  =(length(which(TypeGarantie=="HYPO"))/n_operation_PTZ)*100,
            P_AC_PPH_GARCRED_CAUT =(length(which(TypeGarantie=="CAUT"))/n_operation_PTZ)*100,
            P_AC_PPH_GARCRED_N =(length(which(TypeGarantie=="N"))/n_operation_PTZ)*100,
            # Type d'opération
            P_AC_PPH_TYPOP_NEUF = (length(which(TypeOperationPTZ=="NEUF"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPOP_FON= (length(which(TypeOperationPTZ=="FON"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPOP_REN= (length(which(TypeOperationPTZ=="REN"))/n_operation_PTZ)*100) %>%
  select(-n_operation_PTZ)
            

#  Taux effectif global (TEG)
TEG_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(tegp),
            Q1 = quantile(tegp, 0.25, na.rm = T),
            Q2 = quantile(tegp,0.5, na.rm = T),
            Q3 = quantile(tegp,0.75, na.rm = T),
            SD = sd(tegp)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_TEG_",.))) 

#  Durée Crédits
DurCredit_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(dtpp),
            Q1 = quantile(dtpp, 0.25, na.rm = T),
            Q2 = quantile(dtpp,0.5, na.rm = T),
            Q3 = quantile(dtpp,0.75, na.rm = T),
            SD = sd(dtpp)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_DURPRET_",.))) 

#  Montant PTZ
MtPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(vtpz),
            Q1 = quantile(vtpz, 0.25, na.rm = T),
            Q2 = quantile(vtpz,0.5, na.rm = T),
            Q3 = quantile(vtpz,0.75, na.rm = T),
            SD = sd(vtpz)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_MTPTZ_",.)))

#  Montant total TTC de l'opération
MtOperationPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(vtto),
            Q1 = quantile(vtto, 0.25, na.rm = T),
            Q2 = quantile(vtto,0.5, na.rm = T),
            Q3 = quantile(vtto,0.75, na.rm = T),
            SD = sd(vtto)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_PX_",.)))

#  Montant tous prêts de l'opération
MtPretsPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(vtpr),
            Q1 = quantile(vtpr, 0.25, na.rm = T),
            Q2 = quantile(vtpr,0.5, na.rm = T),
            Q3 = quantile(vtpr,0.75, na.rm = T),
            SD = sd(vtpr)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_MTCREDPR_",.)))

#  Montant prêt principal de l'opération
MtPretsPrincipalPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(vtpp),
            Q1 = quantile(vtpp, 0.25, na.rm = T),
            Q2 = quantile(vtpp,0.5, na.rm = T),
            Q3 = quantile(vtpp,0.75, na.rm = T),
            SD = sd(vtpp)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_MTCREDPP_",.)))

#  LTV de l'opération
LTVPTZ_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  mutate(LTV = (vtpr / vtto)*100 ) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(LTV),
            Q1 = quantile(LTV, 0.25, na.rm = T),
            Q2 = quantile(LTV,0.5, na.rm = T),
            Q3 = quantile(LTV,0.75, na.rm = T),
            SD = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_LTV_",.)))

# Revente d'un logement pour financer l'acquisition
RevLog_Social <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs,FinVenteLog,.drop = T) %>%
  spread(FinVenteLog, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_REVLOG_",.)))

##### Jointure des tables ####

PurchaseAndMutationAcqPTZ_Social <- 
  left_join(PretPTZ_Social,TEG_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            DurCredit_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtPTZ_Social,
            by = c("Acquereurs", "annee")) %>% 
  left_join(., 
            MtPretsPrincipalPTZ_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtPretsPTZ_Social,
            by = c("Acquereurs", "annee")) %>% 
  left_join(., 
            LTVPTZ_Social,
            by = c("Acquereurs", "annee")) %>% 
  left_join(., 
            RevLog_Social,
            by = c("Acquereurs", "annee"))

### Groupe Generation ###

# Agregation sur les variables de types de prêt principal et Type de bien (Ancien/neuf)acheté
PretPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(n_operation_PTZ= length(which(!is.na(Acquereurs))),
           P_AC_PPH_TYPCRED_LIB=(length(which(Nature_PretPrincipal=="LIB"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPCRED_CONV=(length(which(Nature_PretPrincipal=="CONV"))/n_operation_PTZ)*100,            
            # Type de garantie du crédit
            P_AC_PPH_GARCRED_HYPO  =(length(which(TypeGarantie=="HYPO"))/n_operation_PTZ)*100,
            P_AC_PPH_GARCRED_CAUT =(length(which(TypeGarantie=="CAUT"))/n_operation_PTZ)*100,
            P_AC_PPH_GARCRED_N =(length(which(TypeGarantie=="N"))/n_operation_PTZ)*100,
            # Type d'opération
            P_AC_PPH_TYPOP_NEUF = (length(which(TypeOperationPTZ=="NEUF"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPOP_FON= (length(which(TypeOperationPTZ=="FON"))/n_operation_PTZ)*100,
            P_AC_PPH_TYPOP_REN= (length(which(TypeOperationPTZ=="REN"))/n_operation_PTZ)*100) %>%
  select(-n_operation_PTZ)

#  Taux effectif global (TEG)
TEG_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(tegp),
            Q1 = quantile(tegp, 0.25, na.rm = T),
            Q2 = quantile(tegp,0.5, na.rm = T),
            Q3 = quantile(tegp,0.75, na.rm = T),
            SD = sd(tegp)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_TEG_",.))) 

#  Durée Crédits principal
DurCredit_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(dtpp),
            Q1 = quantile(dtpp, 0.25, na.rm = T),
            Q2 = quantile(dtpp,0.5, na.rm = T),
            Q3 = quantile(dtpp,0.75, na.rm = T),
            SD = sd(dtpp)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_DURPRET_",.))) 

#  Montant PTZ
MtPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(vtpz),
            Q1 = quantile(vtpz, 0.25, na.rm = T),
            Q2 = quantile(vtpz,0.5, na.rm = T),
            Q3 = quantile(vtpz,0.75, na.rm = T),
            SD = sd(vtpz)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_MTPTZ_",.)))

# #  Montant total TTC de l'opération
# MtOperationPTZ_Generation <- PTZ_ReadyForOp %>%
#   mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
#   filter(!is.na(Acquereurs)) %>%
#   group_by(Acquereurs, annee) %>%
#   summarise(NTotal = length(which(!is.na(Acquereurs))),
#             M = mean(vtto),
#             Q1 = quantile(vtto, 0.25, na.rm = T),
#             Q2 = quantile(vtto,0.5, na.rm = T),
#             Q3 = quantile(vtto,0.75, na.rm = T),
#             SD = sd(vtto)) %>%
#   filter(NTotal >= 20) %>%
#   select (-NTotal) %>%
#   rename_at(3:ncol(.), list( ~paste0("P_PX_",.)))

#  Montant tous prêts de l'opération
MtPretsPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(vtpr),
            Q1 = quantile(vtpr, 0.25, na.rm = T),
            Q2 = quantile(vtpr,0.5, na.rm = T),
            Q3 = quantile(vtpr,0.75, na.rm = T),
            SD = sd(vtpr)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_MTCREDPR_",.)))


#  Montant prêt principal de l'opération
MtPretsPrincipalPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(vtpp),
            Q1 = quantile(vtpp, 0.25, na.rm = T),
            Q2 = quantile(vtpp,0.5, na.rm = T),
            Q3 = quantile(vtpp,0.75, na.rm = T),
            SD = sd(vtpp)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_MTCREDPP_",.)))

#  LTV de l'opération
LTVPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  mutate(LTV = (vtpr / vtto)*100 ) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(LTV),
            Q1 = quantile(LTV, 0.25, na.rm = T),
            Q2 = quantile(LTV,0.5, na.rm = T),
            Q3 = quantile(LTV,0.75, na.rm = T),
            SD = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_LTV_",.)))

# Revente d'un logement pour achat du bien
RevLog_Generation <-PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs,  annee) %>%
  count(Acquereurs,FinVenteLog) %>%
  spread(FinVenteLog, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_PPH_REVLOG_",.)))

##### Jointure des tables ####

PurchaseAndMutationAcqPTZ_Generation <- 
  left_join(PretPTZ_Generation,TEG_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            DurCredit_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtPTZ_Generation,
            by = c("Acquereurs", "annee")) %>% 
  left_join(., 
            MtPretsPrincipalPTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtPretsPTZ_Generation,
            by = c("Acquereurs", "annee")) %>% 
  left_join(., 
            LTVPTZ_Generation,
            by = c("Acquereurs", "annee")) %>% 
  left_join(., 
            RevLog_Generation,
            by = c("Acquereurs", "annee"))

Préparation des données sur les types de biens

# Tables groupes Social
## Nature des biens (maisons/appartements)
  NatBienPTZ_Social <-PTZ_ReadyForOp %>%
    mutate(Acquereurs = CSP_Acq ) %>%  
    filter(!is.na(Acquereurs)) %>%
    group_by(Acquereurs,  annee) %>%
    count(Acquereurs,Nature_Bien) %>%
    spread(Nature_Bien, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_IMMO_NAT_",.)))
## Types de biens
TypBienPTZ_Social <-PTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs,  annee) %>%
  count(Acquereurs,TypBien) %>%
  spread(TypBien, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_IMMO_TYP_",.)))

# Jointure
HousingTypesPTZ_Social <- left_join(NatBienPTZ_Social, TypBienPTZ_Social,
by = c("Acquereurs", "annee"))

# Tables groupes Generation
## Nature des biens (maisons/appartements)
NatBienPTZ_Generation <-PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs, Nature_Bien) %>%
  spread(Nature_Bien, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_IMMO_NAT_",.)))
## Types de biens
TypBienPTZ_Generation <- PTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS6", "PCS6", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs,TypBien) %>%
  spread(TypBien, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_IMMO_TYP_",.)))

# Jointure
HousingTypesPTZ_Generation <-  left_join(NatBienPTZ_Generation, TypBienPTZ_Generation,
by = c("Acquereurs", "annee"))

Jointures tables PTZ sur les groupes de population

# Tables Social
# Jointure tables acquéreurs
PTZ_GroupesPopAcquereur_Social <- left_join(PricesPTZ_Social, BuyersPTZ_Social,
by = c("Acquereurs", "annee")) %>%
      left_join(., PurchaseAndMutationAcqPTZ_Social,
by = c("Acquereurs", "annee")) %>%
  left_join(., HousingTypesPTZ_Social,
by = c("Acquereurs", "annee"))

PTZ_GroupesPopAcquereur_Social <- PTZ_GroupesPopAcquereur_Social %>% rename(Groupes = Acquereurs)
PTZ_GroupesPopAcquereur_Social$TypeGroupe <- "Social"

PTZ_GroupesPopAcquereur_Social<- PTZ_GroupesPopAcquereur_Social %>% relocate(TypeGroupe, .after = Groupes)

PTZ_GroupesPopAcquereur_Social$Parties <- "Acquereurs"
 PTZ_GroupesPopAcquereur_Social <- PTZ_GroupesPopAcquereur_Social %>% relocate(Parties, .after = TypeGroupe)
 
 # Tables Generation
# Jointure tables acquéreurs
PTZ_GroupesPopAcquereur_Generation <- left_join(PricesPTZ_Generation, BuyersPTZ_Generation,
by = c("Acquereurs", "annee")) %>%
      left_join(., PurchaseAndMutationAcqPTZ_Generation,
by = c("Acquereurs", "annee")) %>%
  left_join(., HousingTypesPTZ_Generation,
by = c("Acquereurs", "annee"))

PTZ_GroupesPopAcquereur_Generation <- PTZ_GroupesPopAcquereur_Generation %>% rename(Groupes = Acquereurs)
PTZ_GroupesPopAcquereur_Generation$TypeGroupe <- "Generationnel"

PTZ_GroupesPopAcquereur_Generation<- PTZ_GroupesPopAcquereur_Generation %>% relocate(TypeGroupe, .after = Groupes)

PTZ_GroupesPopAcquereur_Generation$Parties <- "Acquereurs"
 PTZ_GroupesPopAcquereur_Generation <- PTZ_GroupesPopAcquereur_Generation %>% relocate(Parties, .after = TypeGroupe)

  # Final R bind
PTZ_GroupesPopDataBase <- rbind(PTZ_GroupesPopAcquereur_Social, PTZ_GroupesPopAcquereur_Generation)












BD CASSMIR - licence CC-BY-NC