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)

Nettoyage des données issues de la base BIEN

Des opérations successives sont réalisées afin d’obtenir un échantillon stabilisé de données individuelles sur les transactions immobilières. Les données originelles réceptionnées ne sont pas d’une qualité optimale. Nous avons estimé qu’un contrôle de l’information sur certaines variables importantes étaient nécessaires, nous amenant à ne retenir que les transactions qui répondent aux conditions établies sur des attributs définis. Les étapes successives sont récapitulées dans les points suivants.

# Import des données
# Selection du fichier le plus recent
 LastFile <- list.files("CASSMIR_Outputs",pattern =  "BIENSampleForTest",full.names = T) %>% 
  enframe(name = NULL) %>% 
  bind_cols(pmap_df(., file.info)) %>% 
  filter(mtime==max(mtime)) %>% 
  pull(value)
 
Sample_BIENForTest <- read.csv2(paste0(LastFile), stringsAsFactors=FALSE)

# import des données géométriques VoronoiForCommunes que nous appelon Com_sf
 LastFile <- list.files("CASSMIR_Outputs",pattern =  "OutputFictifSpace",full.names = T) %>% 
  enframe(name = NULL) %>% 
  bind_cols(pmap_df(., file.info)) %>% 
  filter(mtime==max(mtime)) %>% 
  pull(value)
 
Com_sf<- st_read(LastFile, quiet = TRUE, layer = "VoronoiForCommunes")

Filtrage sur le prix et l’année

Dans un premier temps, les transactions qui ne possèdent pas d’informations sur l’année et sur les prix sont écartées. Ces transactions ne représentent qu’un faible volume. Par ailleurs, afin d’éviter des prix aberrants, notamment par l’intrusion de transactions déguisées pour des raisons fiscales sur la donation, les transactions rentrant dans les 0.005% de la distribution des prix sont écartées. Enfin, quelques transactions ont été retirées de l’échantillon car elles présentaient des erreurs de saisie sur les prix, identifiables par le caractère anormalement élevé des prix.

# Programme filtrage sur le prix et l'année 
## Etape 1
# On favorise ici un filtrage détaillé par étapes
Sample_BIENForTest$REQ_PRIX <- as.numeric(Sample_BIENForTest$REQ_PRIX)
BIEN_filt1 <- Sample_BIENForTest%>%
  dplyr::filter(!is.na(REQ_PRIX)) %>% # filtrage sur indication des prix (nominaux nets vendeurs)    
  filter (annee >= 1996 & annee <= 2012) %>% # filtrage sur années 
  filter(REQ_PRIX > quantile(Sample_BIENForTest$REQ_PRIX, 0.0005, na.rm=T))   # filtrage sur distribution des prix (on exclue les biens les moins onéreux, possibilité de transactions déguisées) 

Filtrage sur le géoréférencement

Une forte valeur ajoutée de la base BIEN est l’information géographique à l’adresse, à partir de coordonnées X,Y. Toutes les transactions avec des coordonnées géographiques non renseignées sont retirées de l’échantillon. Ceci représente plus de 60 000 transactions, soit environ 5% de transactions écartées pour chacune des années. Avec ce contrôle sur l’information géographique, chaque transaction a le bénéfice de correspondre à un point localisé dans l’espace.

Pour la Version 2 de la BD Cassmir, une étape de contrôle et d’amélioration des informations de localisation par coordonnées géographique a été réalisée. Cette dernière, puisqu’elle demande de recourir à des informations réelles sur la localisation des biens, n’est pas présente dans l’exemple reproductible.

# Programme filtrage sur le géoréférencement
BIEN_filt1$X_fictif<- as.numeric(BIEN_filt1$X_fictif)
BIEN_filt1$Y_fictif<- as.numeric(BIEN_filt1$Y_fictif)
BIEN_filt2 <- BIEN_filt1 %>%
filter(!is.na(X_fictif) & !is.na(Y_fictif))# Filtrage sur les coord. 

Filtrage sur les types de biens

L’exclusion de logements spécifiques

Après avoir sélectionné les transactions sur la base de la localisation, un troisième temps de la sélection sert à écarter les produits immobiliers qui reposent sur des marchés spécifiques en lien avec une activité économique ou sur des niches très particulières. Les transactions qui concernent des appartements : les ateliers d’artiste, les chambres de service, les greniers destinés à être aménagés et les logements de gardien faisant office de loge sont exclues. Pour les maisons : les tours et moulins, les fermes et les maisons rurales sont également exclues. Le stock de biens écartés sur cette sélection est néanmoins pas très important. Il reste que les informations à partir des variables sur les types d’appartements et surtout les types de maisons ne sont pas systématiquement présentes dans la base BIEN. Il y a donc un risque de retrouver dans l’exploitation des données, sans pouvoir l’appréhender, certaines catégories de logements exclus.

  # Exclusions des ateliers d'artiste, chambres de service, greniers,logements de gardien.
BIEN_filt3 <- BIEN_filt2 %>%
  dplyr::filter (is.na(TYPAP) | TYPAP!="AT" & TYPAP!="CH"& TYPAP!="GR"& TYPAP!="LG")
  
# Exclusions des tours et moulins, fermes, châteaux et grandes propriétés et maisons rurales.
BIEN_filt3 <- BIEN_filt3 %>%
dplyr::filter (is.na(TYPMAI) |TYPMAI!="DI" & TYPMAI!="FE"& TYPMAI!="GP"& TYPMAI!="RU")

Ecarter les biens isolés

La démarche de sélection sur les attributs ne répond pas intégralement à la nécessité de disposer un échantillon stabilisé. Un algorithme de classification par densité est utilisé afin d’exclure les transactions trop isolées ou avec des coordonnées géographiques potentiellement tronquées.

Pour ne retenir que les transactions qui nous intéressent, cest-à-dire non isolées, un algorithme de classification par densité est utilisé : le Density Based Spatial Clustering of Applications with Noise. Le principe de cette classification est simple. Un cluster est créé quand l’algorithme estime une densité minimum d’objets géographiques. Lorsque des objets sont isolés, l’algorithme les considère comme des outliers. Le nombre de clusters d’insiders en sortie est relatif à l’ensemble des zones avec une densité

Pour obtenir les clusters une matrice de distance est calculée et deux paramètres dépendants sont intégrés aux modalités du partitionnement. Le premier paramètre est celui de la taille minimale des clusters (nombre de voisins), dit paramètre \(K\). Le second paramètre est l’estimation d’une distance du voisinage, dit epsilon (\(\varepsilon\)). On doit alors s’interroger sur le nombre de points observés (\(K\)) dans un voisinage le plus proche (\(\varepsilon\)) pour définir un cluster. Si le nombre de voisins (\(K\)) est trop grand - et la distance (\(\varepsilon\)) trop petite - il est probable qu’il y aura peu de clusters en dehors du grand cluster de l’unité urbaine parisienne, ce qui nous renverrait au problème posé par une délimitation d’un marché urbain selon une typologie communale et nous conduirait à rejeter beaucoup de transactions de l’analyse. Au contraire si le nombre de voisins (\(K\)) est trop faible - et la distance (\(\varepsilon\)) trop grande -, on retrouverait presque un cluster pour chaque transaction. Il faut donc trouver un compromis, c’est-à-dire des valeurs intermédiaires pour \(K\) et \(\varepsilon\). En faisant varier le nombre minimum de plus proches voisins (\(K\)) pour chaque année, un nombre de cinq voisins par année apparait comme approprié et ne fluctuant pas dans le temps. Ce choix du nombre minimum de voisins a été renforcé au regard des règles d’utilisation des données BIEN, interdisant la communication de données pour une agrégation inférieure à cinq transactions, qui nous incitent à prendre comme valeur du paramètre \(K\) un nombre de 5 voisins. Au regard de la distribution des rangs sur le tirage des couples des cinq plus proches voisins, une distance euclidienne de 1000 mètres coupe la distribution à un point de rupture bien identifiable avec de très faibles variations dans le temps, et on utilisera donc cette valeur pour le paramètre \(\varepsilon\).

Trois configurations de la répartition du semis de points sont retenues. Un cluster est formé s’il contient au minimum cinq transactions (\(K\)). Son périmètre s’arrête dès lors qu’aucune des transactions à un voisin à moins de 1000 mètres (\(\varepsilon\))(configuration A). Si une transaction n’a qu’un seul plus proche voisin à moins de 1000 mètres (\(\varepsilon\)) mais que celui-ci a un autre voisin en-dessous du seuil de distance (\(\varepsilon\)), lui-même attaché à un cluster de plusieurs voisins alors le périmètre du cluster s’étend de proche en proche (configuration B). Finalement une valeur est jugée aberrante si elle ne dépend pas d’un voisinage au minimum de cinq voisins (\(K\)) dont la distance entre chaque voisin est inférieure à 1000 mètres(\(\varepsilon\)) (Configuration C).

## On garde l'ID, les années et les coordonnées
semis_BIEN <- BIEN_filt3[,c("ID_new","annee","X_fictif","Y_fictif")]

## Création de tableau pour récupérer les résultats
tableau_RECUP<- semis_BIEN
row.names(tableau_RECUP)<-tableau_RECUP$ID_new

tableau.db=list()

# Boucle sur le semis de points pour obtenir les résulats de DBSCAN

for (year in unique(semis_BIEN$annee)) {
  show(year)

## Tester le rayon idéal des cercles avec une distance de 1000m
  
  kNNdistplot(semis_BIEN[semis_BIEN$annee==year,c(3,4)], k =  5)
  abline(h = 1000, lty = 2)
  
## Algoriithme DBSCAN sur coordonnées
  res.db <- dbscan::dbscan(semis_BIEN[semis_BIEN$annee==year,c(3,4)], 1000,5,borderPoints = T)

res.db$ID_new<-row.names(semis_BIEN[semis_BIEN$annee==year,])

  show("dbscan ok")

##Stockage résultats   
  
  tableau.db[[as.character(year)]]<- res.db
  show("tab ok")
  
  tableau_RECUP$cluster[semis_BIEN$annee==year]<-res.db$cluster
}


#Code exemple pour la visualisation des clusters
## Nécessite package factoextra
# fviz_cluster(as(tableau.db[["2008"]],'dbscan_fast'), semis_BIEN_df[semis_BIEN_df$annee==2008,c(3,4)],
#              stand = TRUE,
#              show.clust.cent = F, ellipse = TRUE, ellipse.type = "convex",
#              labelsize = 0,  geom = "point",repel = F, 
#              pointsize =0.1 , outlier.color = "red",main = 2012,
#              ellipse.alpha = 0.2, setguides = FALSE)+
#    theme(legend.position="none", axis.text.x = element_blank(),axis.text.y = element_blank(),axis.ticks = element_blank())+
#   geom_point(size=0.1)

#Recodage cluster en variable binaire
tableau_RECUP$typeVar<- 
ifelse (tableau_RECUP$cluster==0,  "Transactions écartées : en dehors d'un cluster",ifelse (tableau_RECUP$cluster>=1 , "Transactions retenues : à l'intérieur d'un cluster", NA ))


##Visualisation des résultats avec le package ggplot2 puis export de la figure
dev.off()
st=format(Sys.time(), "%d%m%Y")
NomFichier = paste("partitionnementEspaceFictif_",st, sep = "")
FormatFichier = ".png"

png(file = paste0("CASSMIR_Outputs/fig/",NomFichier,FormatFichier))

ggplot(tableau_RECUP, aes(X_fictif, Y_fictif, group= typeVar),xlab=F, ylab=F) +
  geom_point(aes(color = typeVar ),size=0.1, show.legend =T) + 
  labs(x=NULL, y=NULL)+
  coord_quickmap(xlim=range(tableau_RECUP$X_fictif),ylim=range(tableau_RECUP$Y_fictif))+
  facet_wrap(~annee,ncol = 3, nrow = 4)+ 
  theme(axis.text.x = element_blank(),axis.text.y = element_blank(),axis.ticks = element_blank())+
  labs(title = "Partitionnement", x= NULL, y= NULL)+
  labs(caption = "Sources : BD BIEN (non redressée) ; Réalisation : Thibault Le Corre")

dev.off()

## Jointure

semis_BIEN<- left_join (semis_BIEN, tableau_RECUP[,c("ID_new","cluster")], by = "ID_new")

##Géovisualisation des résidus à écarter
 # semis_BIEN%>%
 #  filter(cluster== 0)%>%
 #  mapview(zcol = "annee", burst = TRUE)

## Jointure finale
BIEN_Filt4 <- tableau_RECUP[,c("ID_new","cluster")]%>%
  filter(cluster!= 0)%>%
  left_join(BIEN_filt3,tableau_RECUP, by = "ID_new")%>%
  select (- cluster)

Logiquement, le nombre de transactions écartées avec la méthode DBSCAN est nettement plus conséquent dans les espaces périphériques, sans toutefois exclure des transactions qui reposeraient uniquement du fait de leur appartenance à des communes rurales ou péri-urbaines.

Reconnaître les opérations vendues par les promoteurs immobiliers

Une autre opération préalable à la constitution de l’échantillon des données individuelles relève de l’identification des ventes issues de la promotion immobilière. Alors que la base BIEN renseigne les catégories de vendeurs de types personnes morales, l’identification des vendeurs en tant que promoteurs immobiliers n’est pas directement détectable.

Pour repérer ces ventes opérées par la promotion immobilière plusieurs, sélections sont effectuées.

Premièrement, seules les transactions avec des personnes morales de type Entreprise ou de type SCI comme vendeurs sont susceptibles d’être des ventes issues de la promotion immobilière.

Deuxièmement les biens vendus sont strictement neufs (moins de cinq ans).

Troisièmement, nous considérons qu’une opération immobilière promotionnelle est intrinsèquement associée à plusieurs ventes dans un temps restreint, à l’inverse de particuliers sous un régime juridique SCI qui vendront un nombre réduit de biens, parfois étalés dans le temps. Une vente de la promotion s’accompagne donc nécessairement d’autres ventes de biens similaires la même année.

De la même manière que les transactions retenues ont été sélectionnées en fonction de la densité des transactions dans un voisinage proche avec l’algorithme DBSCAN, les transactions qualifiées comme issues d’opérations promotionnelles sont celles avec une grappe de transactions semblables (en distinguant maison et appartement) dans un voisinage restreint. A partir des conditions établies précédemment, on fait alors l’hypothèse que les ventes de la promotion immobilière concernent celles correspondant à trois transactions minimums distantes de 300 mètres maximum. Si cette manière de faire permet de qualifier des ventes issuent de la promotion immobilière, elle ne permet pas d’identifier les achats réalisés par les promoteurs (prospection foncière et achat d’un bien pour rénovation et densification). Dans notre échantillon, les promoteurs ne sont donc jamais acquéreurs.

Promo <- as.data.frame(BIEN_Filt4) %>%
  filter (REQ_ANC=="2", QUALITE_VE== "EN" |  QUALITE_VE== "SC")

which(colnames(Promo)=="REQTYPBIEN" ) #permet de trouver le numéro d'une colonne dans df.
# Sélection des variables d'intérêt
Promo <- Promo[,c("ID_new","annee","REQTYPBIEN", "X_fictif","Y_fictif")]

## Création de tableau pour récupérer les résultats
## attention, des objets précédents sont écrasés.
# Opération sur les appartements
Promo_App <- Promo%>%
  filter(REQTYPBIEN=="AP")
  
tableau_RECUP_PromoApp<- Promo_App
row.names(tableau_RECUP_PromoApp)<-tableau_RECUP_PromoApp$ID_new

tableau.db=list()

# Boucle sur le semis de points pour obtenir les résulats de DBSCAN

for (year in unique(Promo_App$annee)) {
  show(year)

## Algorithme DBSCAN sur coordonnées
  res.db <- dbscan::dbscan(Promo_App[Promo_App$annee==year,c(4,5)], 300,3,borderPoints = T)
### On retient comme paramètres trois transactions pour une distance de 300M

  res.db$ID_new<-row.names(Promo_App[Promo_App$annee==year,])

  show("dbscan ok")

##Stockage résultats   
  
  tableau.db[[as.character(year)]]<- res.db
  show("tab ok")
  
  tableau_RECUP_PromoApp$cluster[Promo_App$annee==year]<-res.db$cluster
}


# Opération sur les maisons

Promo_MA <- Promo%>%
  filter(REQTYPBIEN=="MA")
  
tableau_RECUP_PromoMA<- Promo_MA
row.names(tableau_RECUP_PromoMA)<-tableau_RECUP_PromoMA$ID

tableau.db=list()

# Boucle sur le semis de points pour obtenir les résulats de DBSCAN

for (year in unique(Promo_MA$annee)) {
  show(year)

## Algorithme DBSCAN sur coordonnées
  res.db <- dbscan::dbscan(Promo_MA[Promo_MA$annee==year,c(4,5)], 300,3,borderPoints = T)
### On retient comme paramètres trois transactions pour une distance de 300M

  res.db$ID_new<-row.names(Promo_MA[Promo_MA$annee==year,])

  show("dbscan ok")

##Stockage résultats   
  
  tableau.db[[as.character(year)]]<- res.db
  show("tab ok")
  
  tableau_RECUP_PromoMA$cluster[Promo_MA$annee==year]<-res.db$cluster
}

# Collage tableau sur appartements et tableau sur maison
tableau_RECUP <- bind_rows(tableau_RECUP_PromoApp, tableau_RECUP_PromoMA)
#Recodage cluster en variable binaire
tableau_RECUP$typeVarPromo<- 
ifelse (tableau_RECUP$cluster==0,  "NON_PROMO",ifelse (tableau_RECUP$cluster>=1 , "PROMO", NA ))

table(tableau_RECUP$typeVarPromo, tableau_RECUP$REQTYPBIEN)

#
BIEN_Filt5 <- left_join (BIEN_Filt4, tableau_RECUP [,c("ID_new","typeVarPromo")])

Redressement

La dernière opération, concernant la préparation de l’échantillon, implique la duplication de certaines transactions. En effet, les données à notre disposition sont elles-mêmes un échantillon de la base BIEN qui comporte uniquement 50% des transactions initialement répertoriées dans BIEN pour les communes de plus de 10 000 habitants en 2011.

La dernière opération concernant le nettoyage de l’échantillon implique la duplication de certaines transactions. En effet, pour chaque commune de plus de 10 000 habitants, le stock de transactions annuelles dans les données réceptionnées est deux fois plus faible que le stock enregistré dans la base BIEN. Pour éviter des effets liés à cet échantillonage, les transactions sont dupliquées pour les communes de plus de 10 000 habitants.

Pour l’exemple, nous créons un tableau de données avec des valeurs randomisées pour établir un stock de population fictifpour chacun d’entre eux.

# table fictive pour le nombre d'habitants par polygone de Voronoï
# On prend des valeurs de 1000 à 15000
popCom<- data.frame(replicate(2,sample(1000:15000,80,rep=TRUE)))

popCom$VoronoiID<- row.names(popCom)
popCom <- popCom%>%
  rename (POPULATION = X2)%>%
  select(-X1)

popCom$VoronoiID<-as.character(popCom$VoronoiID)
Com_sf$VoronoiID<-as.character(Com_sf$VoronoiID)

ComPop_sf<- left_join(Com_sf, popCom, by = "VoronoiID")
 ## Transformation du data frame de l'étape précédente en objet spatial

BIEN_Filt5_sf <- st_as_sf(BIEN_Filt5,
                     
                     coords = c("X_fictif", "Y_fictif"),
                     
                     agr = "constant",
                     
                     stringsAsFactors = FALSE)


#Jointure Transaction-Communes
COM_BIEN<-st_join(ComPop_sf, BIEN_Filt5_sf, join = st_contains, left=T)%>%
  filter(!is.na(ID_new))

#Duplication des lignes appartenant à une commune >= 10000 habitants (Insee).
COM_BIEN <- rbind(COM_BIEN,
      COM_BIEN %>% 
        filter(POPULATION>=10000))

# Repassage en data frame, données BIEN uniquement et ordre par numéro ID croissant
COM_BIEN <-  as.data.frame(COM_BIEN[,c(3:ncol(COM_BIEN))])%>%
  select(-"geom") %>%
  arrange(ID_new)

# Recuperation des X et Y
COM_BIEN<- left_join(COM_BIEN,BIEN_Filt5[,c("ID_new", "X_fictif", "Y_fictif")], by = "ID_new")

# Echantillon BIEN nettoyé
Sample_BIEN_clean <- COM_BIEN

# Génération de nouveaux identifiants pour la variable : "ID_new" afin d'éviter des opérations contraintes par la duplication des identifiants (par exemple des jointures). 
Sample_BIEN_clean$ID_new <- row.names(Sample_BIEN_clean)

Nettoyage des données issues de la base PTZ

#Import des données
# Selection du fichier le plus recent
 LastFile <- list.files("CASSMIR_Outputs",pattern =  "PTZSampleForTest",full.names = T) %>% 
  enframe(name = NULL) %>% 
  bind_cols(pmap_df(., file.info)) %>% 
  filter(mtime==max(mtime)) %>% 
  pull(value)

PTZSampleForTest <- read.csv2(paste0(LastFile), stringsAsFactors=FALSE)
# Se référer au dictionnaire de la base PTZ pour les indications de nettoyage
BaseSample_PTZ <- PTZSampleForTest %>% 
  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 populations qui concernent de la construction individuelle sans achat de terrain

Préparation et mise en forme des données brutes

L’étape suivante prépare les données individuelles issues de la base BIEN et PTZ à partir d’une série d’opérations qui traitent les informations initiales dans l’objectif de les adapter à la production de données agrégées. Ces opérations sont de trois niveaux.

Le premier est un traitement minimal avec des variables d’origine qui ne nécessitent pas d’opérations spécifiques de préparation des données individuelles. Dans cette section nous présenterons spécifiquement les variables issues du deuxième et troisième niveau d’opération sur les données brutes.

Le deuxième est un traitement intermédiaire : les informations sur les données individuelles sont réorganisées et requalifiées pour facilite l’opération d’agrégation des informations. Il peut s’agir par exemple d’un travail de mise en forme de l’information par du recodage et la création de nouvelles variables.

Le troisième est un enrichissement des données individuelles : des opérations plus complexes (spatiales et attributaires) sont entreprises sur les données individuelles pour enregistrer de nouvelles informations.

Tous les traitements ne changent pas le modèle des données individuelles mais certaines relations sont interdites, notamment en ce qui concerne des informations sur les types d’acquéreurs-vendeurs dans la base BIEN. Par exemple, le sexe, l’âge et la catégorie socio-professionnelle d’appartenance sont des informations qui caractérisent des personnes physiques mais pas des personnes morales dont les valeurs de ces attributs correspondront à la valeur \(NA\). L’ensemble des opérations sont décrites à partir des principaux champs qui délimitent notre objet d’étude pour définir l’état du marché. La préparation des données suit le cheminement des quatre champs d’investigation : le prix, les acquéreurs-vendeurs, les régimes d’achat et de mutation, les types de biens. La préparation des données concerne néanmoins que les trois derniers champs d’investigation, à ce stade aucun traitement spécifique de préparation n’est effectué sur les prix.

Sample_BIEN_select <- Sample_BIEN_clean %>%
  select(ID_new, annee, X_fictif, Y_fictif, QUALITE_VE, QUALITE_AC, CSP_AC, CSP_VE, ANNAIS_AC, ANNAIS_VE, PRESCREDIT, MTCRED, REQ_VALUE, SITMAT_AC, SITMAT_VE, SEXE_AC, SEXE_VE, TYPMUTPREC, DATMUTPREC, REQTYPBIEN, NBRPIECE, REQ_EPOQU, REQ_ANC, REQ_PRIX, REQ_PM2, NUMCOM_AC, PADEPT_AC, typeVarPromo)
# Filtrage et sélection des données
BaseSample_PTZ <- BaseSample_PTZ %>% 
  select (ID_new, VoronoiID,csen,ccsp,vtto,vtpr,vtpz,vtpp,an,tegp,age, napp, tysu, tope, nppr, dtpp, vt1e, rani, rann,revl,emem, stol, timm) 
# La variable VoronoiID remplace la variable cins dans l'échantillon anonymisé

Le champ d’investigation des prix

Plusieurs indicateurs de prix sont disponibles dans la base CASSMIR. Sur le plan spatial on y retrouve des variables générales résumant la distribution des prix nominaux nets de vente des logements (moyenne, médiane, ecart-type) pour les maisons et appartements, et au \(m^2\) pour les appartements. Par ailleurs, ces indicateurs de centralité et de dispersion sont déclinés selon différentes catégories de types de biens immobiliers afin de pouvoir prendre en compte les effets de structure sur les dynamiques locales des prix. En ce qui concerne les groupes de population, Chaque groupe possède des indicateurs annuels de centralité et de dispersion pour les prix d’achat et les prix de vente.

Le principe est donc de produire des indicateurs sur les prix des logements sur le marché de gré à gré. Les différences terminoligiques entre “valeur du logement” et “prix d’achat/vente” sont conceptuellement et méthodologiquement importantes.

La première expression désigne une valeur monétaire attribuée à un logement sans que celui-ci soit soumis à un échange marchand, avec une évolution régulière selon la fréquence des estimations réalisées (annuelles ou trimestrielles par exemple). La méthode privilégiée dans ces estimations, est d’attribuer des valeurs de références, dites hédonistes, sur un ensemble de caractéristiques des biens au sein d’une zone géographique assumée comme homogène. Les valeurs de de référence sont estimées à partir des prix de vente de biens modèles, de par leurs caractéristiques et aménités environnantes (variables). L’attribution des valeurs pour chaque variable sélectionnée permet de d’attribuer une valeur à l’ensemble du parc de logements. Cette méthode est par exemple utilisée pour la production des indices Notaires-Insee.

La seconde expression, “les prix de vente”, désigne le prix nominal net vendeur sur lequel une offre (le vendeur) et une demande (l’acquéreur) ont conclu un accord pour le transfert de droits de propriété d’un bien immobilier et de sa surface foncière associée (droits de propriété défini par usus, fructus, abusus). Contrairement à la “valeur d’un bien”, un “prix de vente” appelle obligatoirement l’intervention du marché pour la réalisation d’une transaction effective. “Le prix de vente” est alors moins une affaire de valeurs référentielles homogènes, mais de flux monétaires réalisés entre des acteurs sociaux. De manière agrégée, l’évolution des prix de vente témoigne de l’évolution du marché, structurée par des dynamiques locales (sur la structure des biens échangés, les profils des acquéreurs et vendeurs…), territoriale (métropolisation, marginalisation…) comme macro (politique monétaire, politique du logement, système redistributif).

La production des indicateurs sur les prix nécessitent de considérer les biens de type maisons et de type appartements. En effet, en ce qui concerne les appartements, surreprésentés dans les centres urbains, il est d’usage de pratiquer une comparaison locale à partir d’un indicateur synthétique des prix au \(m^2\). Pour les indicateurs de prix sur les maisons, surreprésentées en périphérie, ils sont d’abord traités à partir du prix nominal, car la différence entre la surface habitable et la surface foncière totale rend difficile des comparaisons sur les prix au \(m^2\). Dans notre cas, nous procédons de la façon suivante : des indicateurs sur les prix nominaux nets vendeurs sont produits en agrégeant ensemble les valeurs des transactions sur les maisons et appartements ; des indicateurs sur les prix nominaux nets vendeurs sont produits en agrégeant uniquement les valeurs des transactions sur les maisons ; des indicateurs sur les prix nominaux nets vendeurs sont produits en agrégeant uniquement les valeurs des transactions sur les appartements ; des indicateurs sur les prix au \(m^2\) sont produits en agrégeant uniquement les valeurs des transactions sur les appartements.

Variables préparées à partir de la base BIEN

  • REQ_PRIX ; nom complet : Montant de la transaction en euro ; remarque : Variable d’origine de la base BIEN

  • REQ_PM2 ; nom complet : Prix du \(m^2\) ; remarque : Variable d’origine de la base BIEN

Variables préparées à partir de la base PTZ

  • 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

Scripts sur les prix

Sample_BIEN_Prices <-  Sample_BIEN_select %>% 
  select(ID_new, annee, X_fictif, Y_fictif, REQ_PRIX, REQ_PM2 ) # Les variables spatiales et temporelles sont inclues ici.
Sample_PTZ_Prices <-  BaseSample_PTZ %>% 
  select(ID_new, an, VoronoiID, vtto ) # Les variables spatiales et temporelles sont inclues ici.

Le champ d’investigation des acquéreurs-vendeurs

La base CASSMIR est propice à la réalisation d’analyses sur les parties de la vente. En effet, elle recense différents indicateurs sur les caractéristiques des acquéreurs et des vendeurs. Les acquéreurs et vendeurs peuvent être de deux nature différentes : les personnes morales et les personnes physiques (individus appartenant à des ménages, hors régime SCI). La variables sur les types d’acquéreurs et de vendeurs précise si ces personnes morales sont de caractère privé (Entreprises, marchands de biens, Société Civile Immobilière) ou de caractère public (Administrations publiques, Offices HLM). Les ventes par des promoteurs (identifiées précédemment) entre également dans la catégorie de type personne morale. Les types de personnes physiques se déclinent en fonction du statut professionnel avec des ménages actifs et des ménages retraités et inactifs. Rappel : le terme de ménage est une appellation générique qui doit être interprété ici comme l’individu renseigné dans l’acte notarial qui représente un ménage. Les caractéristiques du ménage sont donc intégralement inférées à partir des caractéristiques de l’individu représentatif. En ce qui concerne les ménages actifs, trois tranches d’âge sont définies : les ménages actifs entre 18 et 30 ans, les ménages actifs entre 30 et 50 ans et les ménages actifs de plus de 50 ans. Par définition, les ménages retraités ont un âge avancé (plus de 60 ans). Les ménages inactifs (intégrés dans la même catégorie que les ménages retraités) sont des ménages qui n’excercent pas d’activité professionnelle (période de chômage compris) et ne perçoivent pas de pension de retraites. Ces ménages inactifs sont surreprésentés aux deux extrémités de la pyramide d’âge : chez les jeunes et chez les personnes âgées. Les ménages retraités et inactifs s’assimilent par des revenus éventuels qui ne sont pas perçus par une activité professionnelle (au moment de la transaction), à l’inverse des ménages actifs.

D’autres variables traitées permettent de compléter la caractérisation des unités spatiales en entrant par le profil des acquéreurs et vendeurs. Dans ce cadre, la situation matrimoniale des ménages est prise en compte à partir de trois qualités : acquéreurs-vendeurs en célibat au moment de la transaction, acquéreurs-vendeurs en Couple (mariés, pacsés, remariés), acquéreurs-vendeurs divorcés (non remariés) ou veufs. Le genre des acquéreurs-vendeurs entre également dans l’analyse, selon un critère d’hommes ou de femmes. Par ailleurs, des informations sont ajoutées sur le régime de mutation du stock de biens mis en vente par les vendeurs, permettant de savoir si les vendeurs vendent un bien qu’ils ont obtenu par acquistion, héritage, donation, achat de parts partagés. Enfin, des indicateurs sur la durée de détention du bien sont ajoutés afin d’identifier le turn-over du stock immobilier sur le marché en prenant des tranches de cinq années jusqu’à 20 ans de détention : de 0 à 5 ans, de 5 à 10 ans, de 10 à 15 ans, de 15 à 20 ans, plus de 20 ans.

Une variable permet d’estimer “la portée géographique du marché”, qui se définie comme l’aire d’attraction qu’excerce un espace sur les acquéreurs. Plus la localisation des investissements est éloignée de l’origine géographique des acquéreurs, plus la portée géographique est importante. Les portées géographiques se déclinent en quatre catégories. La première correspond aux acquisitions effectuées dans la même commune de résidence ou dans une commune limitrophe de la commune de résidence de l’acquéreur, la portée est alors considérée comme local (marché local). La seconde correspond aux acquisitions effectuées dans une autre commune d’Île-de-France de la commune de résidence de l’acquéreur ou d’une de ses communes limitrophes, il s’agit d’un marché qui excerce une attraction régionale. La troisième correspond à des acquéreurs résidants dans d’autres régions françaises (hors IDF), il s’agit d’un marché à portée nationale. Enfin, la quatrième correspond à des acquéreurs résidants dans d’autres pays, il s’agit d’un marché à portée internationale. L’objectif réside à créer une variable avec des valeurs indicatives des quatre catégories précédemment citées. Cela nécessite plusieurs opérations sur les attributs des données BIEN et un traitement spatial afin d’obtenir une matrice de voisinage entre unités spatiales limitrophes : les opérations ne sont pas disponibles dans l’exemple reproductible à partir de l’échantillon et de l’espace fictif, se reporter vers l’onglet concernant les traitements sur la base BIEN.

La base de données PTZ concerne uniquement des données sur une population d’acquéreurs personne physique (ménage) avec un prêt PTZ en complément d’un prêt principal. Il n’y a pas d’informations disponbibles concernant les vendeurs des biens immobiliers. Par ailleurs, il n’existe pas d’informations sur le genre de l’acqéreurs. Il est nénamons possible d’apparier et d’harmoniser avec les données de la base BIEN, la CSP d’appartenance, l’âge et la situation matrimoniale. En outre il permet de produire des indicateurs intéressants sur les revenus et le statut d’occupation des acquéreurs.

Variables préparées à partir de la base BIEN

  • Nat_Acq ; nom complet : nature des acquéreurs ; valeurs des attributs : “PPH”, “PMO”

PPH = Personne Physique appartenant à un ménage , PMO = Personne Morale

  • Nat_Ve ; nom complet : nature des vendeurs ; valeurs des attributs : “PPH”, “PMO”

  • Typ_Acq ; nom complet : Type d’acquéreur ; valeurs des attributs : “TYP4”, “TYP3”, “TYP1”, “TYP2” ; remarque : les valeurs “TYP4” et “TYP3” sont uniquement valables pour Nat_Acq = “PMO” ; les valeurs “TYP1”, “TYP2” sont uniquement valables pour Nat_Acq = “PPH”

TYP1 = “Personne Physique de type Actif (au sens d’emploi occupé)”, TYP2 = “Personne Physique de type Retraité ou Inactif”, TYP3 = Personne Morale de type Entreprise, Marchand de biens et Société (dont société civile immobilière), TYP4 = “Personne Morale de type Administration publique ou Organisme HLM”

  • Typ_Ve ; nom complet : Type de vendeur ; valeurs des attributs : “TYP5”, “TYP4”, “TYP3”, “TYP1”, “TYP2” ; remarque : les valeurs “TYP5”, TYP4" et “TYP3” sont uniquement valables pour Nat_Ve = “PMO” ; les valeurs “TYP1”, “TYP2” sont uniquement valables pour Nat_Ve = “PPH”.

TYP5 = Personne morale identifiée comme promoteur immobilier

  • CSP_Acq ; nom complet : catégorie socio-professionnelle de l’acquéreur (en 8 postes) ; valeurs des attributs : “PCS1”, “PCS2”, “PCS3”, “PCS4”, “PCS5”, “PCS6”, “PCS7”, “PCS8” ; remarque : Informations valables pour Nat_Acq = “PPH”, sinon \(NA\).

PCS1 = Agriculteur exploitant, PCS2 = Artisans, commerçants et chefs d’entreprise , PCS3 = Cadres et professions intellectuelles supérieures, PCS4 = Professions intermédiaires, PCS5 = Employés, PCS6 = Ouvriers, PCS7 = Retraités, PCS8 = Autres personnes sans activité professionnelle (inactifs)

  • CSP_Ve ; nom complet : catégorie socio-professionnelle du vendeur (en 8 postes) ; valeurs des attributs : “PCS1”, “PCS2”, “PCS3”, “PCS4”, “PCS5”, “PCS6”, “PCS7”, “PCS8” ; remarque : Informations valables pour Nat_Ve = “PPH”, sinon \(NA\).

  • Age_Acq ; nom complet : Age de l’acquéreur ; valeurs des attributs : série continue (en années) ; remarque : Informations valables pour Nat_Acq = “PPH”, sinon \(NA\).

  • Age_Ve ; nom complet : Age du vendeur ; valeurs des attributs : série continue (en années) ; remarque : Informations valables pour Nat_Ve = “PPH”, sinon \(NA\).

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

“AGE1” = Tranche d’âge d’appartenance entre 18 et 30 ans, “AGE2” = Tranche d’âge d’appartenance entre 30 et 50 ans, AGE3 = Tranche d’âge d’appartenance de 50 ans et plus.

  • Tranche_Age_Ve ; nom complet : Tranche d’âge d’appartenance du vendeur ; valeurs des attributs : “AGE1”, “AGE2”, “AGE3” ; remarque : Informations valables pour Typ_Ve = “TYP1”, sinon \(NA\).

  • SitMatri_Acq ; nom complet : Situation matrimoniale de l’acquéreur ; valeurs des attributs : “CEL”, “CONJU”, “DIV” ; remarque : Informations valables pour Nat_Acq = “PPH”, sinon \(NA\).

“CEL” = Célibataire, “CONJU” = Vie Conjugale“, DIV” = Divorcé ou veuvage

  • SitMatri_Ve ; nom complet : Situation matrimoniale du vendeur ; valeurs des attributs : “CEL”, “CONJU”, “DIV” ; remarque : Informations valables pour Nat_ve = “PPH”, sinon \(NA\).

  • Sexe_Acq ; nom complet : Sexe de l’acquéreur ; valeurs des attributs : “H”, “F” ; remarque : Informations valables pour Nat_Acq = “PPH”, sinon \(NA\).

H = Homme, F = Femme

  • Sexe_Ve ; nom complet : Sexe du vendeur ; valeurs des attributs : “H”, “F” ; remarque : Informations valables pour Nat_Ve = “PPH”, sinon \(NA\).

  • Provenance_Acq ; nom complet : Provenance des acquéreurs selon leur origine résidentielle; valeurs des attributs : “LOC”, “REG”, “NAT”, “INTER”; remarque : Informations valables pour Nat_Acq = “PPH”, sinon \(NA\). Le code relatif à la production de cette variable n’est pas présenté ici. Pour des raisons de confidentialité, certaines informations nécessaires ne sont pas disponibles dans l’échantillon anonymisé, se reporter au code source sur le jeu complet de l’échantillon des données BIEN pour la présentation du code source.

“LOC” = Locale, “REG” = Regionale, “NAT” = Nationale, “INTER” = Internationale

Les variables sur les acquéreurs-vendeurs préparées à partir de la base PTZ

  • 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 des personnes physiques.

  • 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”, “PCS7”, “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”, “HebergParental”, “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” = AUTR

Scripts de préparation des données sur les acquéreurs-vendeurs

Sample_BIEN_ACVE <- as.data.frame(Sample_BIEN_select) %>%
  select(ID_new, annee,QUALITE_VE,QUALITE_AC, CSP_AC, CSP_VE, ANNAIS_AC, ANNAIS_VE, SITMAT_AC,SITMAT_VE, SEXE_AC, SEXE_VE, typeVarPromo) 

# Préparation des données sur les acquéreurs
Sample_BIEN_ACVE <- Sample_BIEN_ACVE %>%
  mutate(Nature_Acq = case_when(QUALITE_AC == "AD" | QUALITE_AC == "SO" |QUALITE_AC== "PR" |  QUALITE_AC== "EN"  |  QUALITE_AC== "SC" ~  "PMO", !is.na(CSP_AC) ~ "PPH"),
        Type_Acq = case_when(QUALITE_AC == "AD" | QUALITE_AC == "SO" ~ "TYP4", QUALITE_AC== "PR" |  QUALITE_AC== "EN"  |  QUALITE_AC== "SC" ~  "TYP3", 
                          CSP_AC >= 1 & CSP_AC<= 69 ~"TYP1",
                          CSP_AC >= 70 & CSP_AC<= 90 ~ "TYP2"),
        CSP_Acq = case_when(CSP_AC == 10 ~ "PCS1",
                           CSP_AC >= 20 & CSP_AC < 30 ~ "PCS2",
                            CSP_AC >= 30 & CSP_AC < 40 ~ "PCS3",
                            CSP_AC >= 40 & CSP_AC < 50 ~ "PCS4",
                           CSP_AC >= 50 & CSP_AC < 60 ~ "PCS5",
                           CSP_AC >= 60 & CSP_AC < 70 ~ "PCS6",
                           CSP_AC >= 70 & CSP_AC < 80 ~ "PCS7",
                           CSP_AC == 80 ~ "PCS8"))

# Préparation des données sur les vendeurs
Sample_BIEN_ACVE <- Sample_BIEN_ACVE %>%
  mutate(Nature_Ve = case_when(QUALITE_VE == "AD" | QUALITE_VE == "SO" |QUALITE_VE== "PR" |  QUALITE_VE== "EN"  |  QUALITE_VE== "SC" ~  "PMO", !is.na(CSP_VE) ~ "PPH"),
        Type_Ve = case_when( typeVarPromo == "PROMO" ~ "TYP5", (typeVarPromo != "PROMO" | is.na(typeVarPromo)) & (QUALITE_VE == "AD" | QUALITE_VE == "SO") ~ "TYP4", (typeVarPromo != "PROMO" | is.na(typeVarPromo)) & (QUALITE_VE== "PR" |  QUALITE_VE== "EN"  |  QUALITE_VE== "SC") ~  "TYP3",
                          CSP_VE >= 1 & CSP_VE<= 69 ~"TYP1",
                          CSP_VE >= 70 & CSP_VE<= 90 ~ "TYP2"),
        CSP_Ve = case_when(CSP_VE == 10 ~ "PCS1",
                           CSP_VE >= 20 & CSP_VE < 30 ~ "PCS2",
                            CSP_VE >= 30 & CSP_VE < 40 ~ "PCS3",
                            CSP_VE >= 40 & CSP_VE < 50 ~ "PCS4",
                           CSP_VE >= 50 & CSP_VE < 60 ~ "PCS5",
                           CSP_VE >= 60 & CSP_VE < 70 ~ "PCS6",
                           CSP_VE >= 70 & CSP_VE < 80 ~ "PCS7",
                           CSP_VE == 80 ~ "PCS8"))


# Age des actifs 
Sample_BIEN_ACVE <- Sample_BIEN_ACVE %>%
  mutate(Age_Acq = annee - ANNAIS_AC,
        Age_Ve = annee - ANNAIS_VE,
        Tranche_Age_Acq = case_when( Type_Acq == "TYP1" & (Age_Acq >= 18 & Age_Acq < 30) ~ "AGE1",
  Type_Acq == "TYP1" & (Age_Acq >= 30 & Age_Acq < 50) ~ "AGE2",
   Type_Acq == "TYP1" & Age_Acq >= 50 ~ "AGE3"),
 Tranche_Age_Vendeur = case_when( Type_Ve == "TYP1" & (Age_Ve >=18 & Age_Ve < 30) ~ "AGE1",
  Type_Ve == "TYP1" & (Age_Ve >= 30 & Age_Ve < 50) ~ "AGE2",
   Type_Ve == "TYP1" & Age_Ve >= 50 ~ "AGE3")) 

# Situation matrimoniale
Sample_BIEN_ACVE <- Sample_BIEN_ACVE %>%
  mutate( SitMatri_Acq =  case_when( Nature_Acq == "PPH" & (SITMAT_AC == "M" | SITMAT_AC == "P" |SITMAT_AC == "R") ~ "CONJU",
                            Nature_Acq == "PPH" & (SITMAT_AC == "D"| SITMAT_AC == "V") ~ "DIV",
                            Nature_Acq == "PPH" & (SITMAT_AC == "C") ~ "CEL" ),
SitMatri_VE =  case_when(Nature_Ve == "PPH" & (SITMAT_VE == "M" | SITMAT_VE == "P" | SITMAT_VE == "R") ~ "CONJU",
                            Nature_Ve == "PPH" & (SITMAT_VE == "D"| SITMAT_VE == "V") ~ "DIV",
                            Nature_Ve == "PPH" & (SITMAT_VE == "C") ~ "CEL" ))
  

# Sexe des acquéreurs et vendeurs pour personnes physiques
Sample_BIEN_ACVE<- Sample_BIEN_ACVE%>%
  mutate (Sexe_Acq = case_when (
    Nature_Acq == "PPH"  &
    SEXE_AC == "F" ~ "F", 
    Nature_Acq == "PPH" &
    SEXE_AC == "M" ~ "H"), 
    Sexe_Ve = case_when (
    Nature_Ve == "PPH" &
    SEXE_VE == "F" ~ "F", 
    Nature_Ve == "PPH" &
    SEXE_VE == "M" ~ "H"))

Sample_BIEN_ACVE <- Sample_BIEN_ACVE %>%
  select(ID_new, Nature_Acq, Nature_Ve, Type_Acq, Type_Ve,CSP_Acq, CSP_Ve,Age_Acq, Age_Ve,Tranche_Age_Acq, Tranche_Age_Vendeur,SitMatri_Acq, SitMatri_VE, Sexe_Acq, Sexe_Ve)

Sample_BIEN_ACVE$Provenance_Acq <- "Info_Non_Disponible"
Sample_PTZ_ACVE <-  BaseSample_PTZ %>% 
  select(ID_new, an, rani, rann, ccsp, age, emem, stol)

# Type et CSP des acquéreurs avec un emprunt PTZ
Sample_PTZ_ACVE <- Sample_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 ~ "PCS7",
                    ccsp == 80 ~ "PCS8"))

# Tranche Age parmi les actifs emprunteurs PTZ
Sample_PTZ_ACVE <- Sample_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
Sample_PTZ_ACVE <- Sample_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
Sample_PTZ_ACVE <- Sample_PTZ_ACVE %>%
  mutate(StatutOccupation =  case_when (stol == "1"  ~ "HLM", 
          stol =="2" ~ "PRIV",
stol == "3" ~ "PROP", 
stol == "4" ~ "HebergParental", 
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

Le troisième champ d’investigation thématique porte sur les régimes d’achat et les types de mutation des biens. Les régimes d’achat se définissent à partir de l’origine du capital mobilisé et de ses modalités d’accès pour réaliser un investissement immobilier (acquisition). S’attarder sur les régimes d’achat permet ainsi d’approcher les modalités d’accès différenciées à l’investissement immobilier selon les territoires et les groupes de population. Le second point concerne les types de mutation des biens, c’est à dire un ensemble de caractéristique qui renseignent les modalités de changement de propriétaires d’un bien.

La base CASSMIR offre des informations inédites concernant les deux points du champ d’investigation. D’une part, elle possède de nombreux indicateurs sur le financement de l’investissement permettant de caractériser les groupes de population et les profils des unités spatiales (présence d’un crédit à l’achat, montant du crédit, Loan-to-Value…) et des modalités du financement pour les groupes de population (durée du prêt principal, taux effectif général du prêt, types de prêts…). D’autre part, elle possède des indicateurs sur le type de mutation des biens, et notamment, pour les groupes de population, des indicateurs sur les plus ou moins value réalisées par les vendeurs en fonction de la durée de détention des biens.

Les variables sur le régime d’achat et type de mutation préparées à partir de la base BIEN

  • PresCred_Acq ; nom complet : Présence du crédit à l’achat (caractéristique unique à l’acquéreur) ; valeurs des attributs : “O”, “OSUP”, “N” ; remarques : Informations valables pour Nat_Acq = “PPH”, sinon \(NA\). Il existe des informations lacunaires sur le crédit. En effet, par exemple la base BIEN renseigne la présence et les montants des prêts contractés sous une garantie hypothècaires, et N ceux contractés avec une garantie par une société de cautionnement. Or, ces derniers sont devenus majoritaires au cours des années 2000. Ceci est également valable en ce qui concerne l’information sur la présence d’un crédit, représentée par une variable booléenne (O pour oui, N pour non). En d’autres termes, la présence d’un crédit est confirmé lorsqu’il s’agit d’un prêt hypothécaire. Quand les données renvoient à une acquisition sans crédit, cela signifie que ni un prêt (principal) hypothécaiire ou sous caution n’a été utilisé à l’achat. Enfin, quand les données renvoient à aucune information (cellules vides) cela suppose que les acquéreurs ont bien acquis le bien par crédit mais qu’il s’agit certainement d’un prêt sous caution, cette information ayant été confirmée par les services producteurs des données. Il subsiste toutefois dans les données une part minoritaire de cellules vides qui peuvent être un défaut d’informations délivrés par les notaires. Malheureusement nous ne possédons aucun moyen de vérification systématique afin de contrôler et ne retenir que les transactions dont la cellule vide supposerait la présence d’un crédit sous caution. Dès lors, trois modalités de valeurs indiquent la présence d’un crédit : “O”, “OSUP” (si renseigné comme NA), “N”.

“O” = Oui, “OSUP” = Oui supposé, “N” = Non

  • TypePret_Acq ; nom complet : Type de prêt immobilier utilisé à l’achat ; valeurs des attributs : “CAUT”, “HYPO” ; remarques : Informations valables pour Nat_Acq = “PPH” & PresCred_Acq != “N”, sinon \(NA\). Les attributs sur le type de prêt sont définis de la manière suivante : si présence d’un crédit = “O”, alors type de prêt = “HYPO” ; si présence d’un crédit = “OSUP”, alors type de prêt = “CAUT”.

“HYPO” = Hypothécaire, “CAUT” = Caution

  • MTCRED ; nom complet : Montant du crédit en euros (caractéristique unique à l’acquéreur) ; remarques : Variable d’origine de la base BIEN ; Informations valables pour Nat_Acq = “PPH”

  • TypMutPrec ; nom complet : Type de mutation précédente du bien vendu (caractéristique unique au vendeur) ; valeurs des attributs : “ACQI”, “PART”, “HERIT” ; remarque : Informations valables pour Nat_ve = “PPH”, sinon \(NA\).

“ACQI” = Acquisition, “PART” = Partage, “HERIT” = Héritage et donation

  • Duree_Detention_Ve ; nom complet : Durée de détention du bien par le vendeur (en années, caractéristique unique au vendeur) ; valeurs des attributs : série continue (de 0 à 150 ans); remarque : Informations valables pour Nat_ve = “PPH”, sinon \(NA\).

  • Tranche_Duree_Detention_Ve ; nom complet : Tranche d’appartenance du vendeur sur la durée de détention du bien (en années, caractéristique unique au vendeur) ; valeurs des attributs : “DET1”, “DET2”, “DET3”, “DET4”, “DET5” ; remarque : Informations valables pour Duree_Detention_Ve != \(NA\), sinon \(NA\).

“DET1” = Tranche d’appartenance de 0 à 5 ans, “DET2” = Tranche d’appartenance de 5 à 10 ans, “DET3” = Tranche d’appartenance de 10 à 15 ans, “DET4” = Tranche d’appartenance de 15 à 20 ans, “DET5” = Tranche d’appartenance de 20 ans et plus.

-REQ_VALUE ; nom complet : plus ou moins value réalisée par le vendeur ; valeurs des attributs : série continue. Variable d’origine de la base BIEN, Informations valables pour Nat_Acq = “PPH”

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”.

Scripts de préparation des données sur les régimes d’achat et type de mutation

Sample_BIEN_PURCHMUT <- as.data.frame(Sample_BIEN_select) %>% 
  select(ID_new, annee, TYPMUTPREC, DATMUTPREC, PRESCREDIT, MTCRED, REQ_VALUE)

# Présence d'un crédit

Sample_BIEN_PURCHMUT <- Sample_BIEN_PURCHMUT %>%
  mutate(PresCred_Acq = case_when((PRESCREDIT != "O" & PRESCREDIT != "N")  ~ "OSUP", 
                    PRESCREDIT == "O" ~ "O",
                    PRESCREDIT == "N" ~ "N" )) 

# Type de prêt
Sample_BIEN_PURCHMUT <- Sample_BIEN_PURCHMUT %>%
  mutate(TypePret_Acq = case_when (PresCred_Acq ==  "OSUP" ~ "CAUT", 
                    PRESCREDIT == "O" ~ "HYPO")) 


# Type de mutation précédente du bien : distinction entre mutation à tire gratuit et à titre onéreux (uniquement personnes physiques)
Sample_BIEN_PURCHMUT <- Sample_BIEN_PURCHMUT %>%
  mutate(TypMutPrec_VE = case_when(
    TYPMUTPREC == "A"~"ACQI",
    TYPMUTPREC == "P"~"PART",
    (TYPMUTPREC == "S" | TYPMUTPREC == "D") ~ "HERIT" ))
                                 
# Turn-over : durée de détention du bien, uniquement sur personnes physiques
# Convertir le format date en format numérique en retenant l'année de la transaction
Sample_BIEN_PURCHMUT$Annee_MUTPREC <- as.numeric(substr(Sample_BIEN_PURCHMUT$DATMUTPREC, start = 7, stop = 10))
#Opération pour informations avec espace entre charactères
Sample_BIEN_PURCHMUT$Annee_MUTPREC<- ifelse(Sample_BIEN_PURCHMUT$Annee_MUTPREC<1000, as.numeric(substr(Sample_BIEN_PURCHMUT$DATMUTPREC, start = 6, stop = 10)),Sample_BIEN_PURCHMUT$Annee_MUTPREC)

Sample_BIEN_PURCHMUT$Duree_Detention_Ve <- Sample_BIEN_PURCHMUT$annee - Sample_BIEN_PURCHMUT$Annee_MUTPREC

Sample_BIEN_PURCHMUT<- Sample_BIEN_PURCHMUT%>%
  mutate (Duree_Detention_Ve = ifelse (Duree_Detention_Ve <= 150, Duree_Detention_Ve, NA))

Sample_BIEN_PURCHMUT <- Sample_BIEN_PURCHMUT%>%
  mutate (Tranche_DureeDetention_Ve = case_when (
  Duree_Detention_Ve >= 0 & Duree_Detention_Ve < 5 ~ "DET1",
  Duree_Detention_Ve >= 5 & Duree_Detention_Ve < 10 ~ "DET2",
Duree_Detention_Ve >= 10 & Duree_Detention_Ve < 15 ~ "DET3",
Duree_Detention_Ve >= 15 & Duree_Detention_Ve < 20 ~ "DET4",
Duree_Detention_Ve >= 20 ~ "DET5"))

Sample_BIEN_PURCHMUT <- Sample_BIEN_PURCHMUT %>%
  select(ID_new, PresCred_Acq, TypePret_Acq, MTCRED, TypMutPrec_VE, Duree_Detention_Ve,Tranche_DureeDetention_Ve, REQ_VALUE)
Sample_PTZ_PURCHMUT <-  BaseSample_PTZ %>% 
  select(ID_new, vtpr, vtpz, vtpp, tegp, napp, tysu, tope,dtpp,vt1e, revl)

# Type d'opération consécutive au prêt PTZ
Sample_PTZ_PURCHMUT <- Sample_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
Sample_PTZ_PURCHMUT <- Sample_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        
Sample_PTZ_PURCHMUT <- Sample_PTZ_PURCHMUT %>%
  mutate( TypeGarantie = case_when(tysu==0 ~ "N", 
                                    tysu==1 ~ "HYPO",
                                    tysu==2 ~ "CAUT", 
                                    tysu==3 ~ "CautionPersonnelle",
                                    TRUE ~ "AUTR"))

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

Le champ d’investigation des types de biens immobiliers

Les indicateurs sur les types de biens dans CASSMIR sont de deux natures différentes. On retrouve d’abord des indicateurs sur la répartition des maisons et des appartements déclinés sur différentes catégories établies en fonction du nombre de pièces (petit, standard, grand). Ces catégories construites sont également utilisées pour détailler les niveaux de prix locaux et par groupes de population. Ensuite, d’autres indicateurs mettent en évidence la répartition du parc échangé selon la période de production des logements.

Les variables sur les types de biens immobiliers préparées à partir de la base BIEN

  • TypBien ; nom complet : Type de bien immobilier concerné par la transaction ; valeurs des attributs : “MAI4”, “APP4”, “MAI2”, “MAI3”, “APP2”, “APP3”, “MAI1”, “APP1” ; remarques : Informations valables pour REQTYPBIEN & NBRPIECE != \(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

  • Anciennete ; nom complet : Ancienneté du bien immobilier concerné par la transaction ; valeurs des attributs : “MAI_ANC1”, “MAI_ANC2”, “MAI_ANC3”; “MAI_ANC4”; “MAI_ANC5”; “MAI_ANC6”; “MAI_ANC7”, “MAI_ANC8”, “APP_ANC1”, “APP_ANC2”, “APP_ANC3”, “APP_ANC4”, “APP_ANC5”, “APP_ANC6”, “APP_ANC7”, “APP_ANC8”, “MAI_ANC9”, “APP_ANC9” ; remarques : Informations valables pour REQTYPBIEN & REQ_ANC & REQ_EPOQU != \(NA\). Un logement “neuf” correspond à un logement construit/rénové moins de 5 ans avant la transaction (habité ou N)

“ANC1” = Epoque de construction avant 1850, “ANC2” = Epoque de construction entre 1850 et 1913, “ANC3” = Epoque de construction entre 1914 et 1947, “ANC4” = Epoque de construction entre 1948 et 1969, “ANC5” = Epoque de construction entre 1970 et 1980, “ANC6” = Epoque de construction entre 1981 et 1991, “ANC7” = Epoque de construction entre 1992 et 2000, “ANC8” = Epoque de construction après 2000, “ANC9” = Epoque de construction de moins de 5 ans au moment de l’achat (bien neuf)

Les variables sur les types de biens immobiliers préparées à partir de la base PTZ

  • 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

Scripts de préparation des données sur les type de biens immobiliers

Sample_BIEN_TBTaille <- as.data.frame (Sample_BIEN_select) %>%
  select(ID_new, REQTYPBIEN, NBRPIECE) %>%
  mutate(TypBien = case_when(REQTYPBIEN == "MA" & NBRPIECE > 7 ~ "MAI4" , REQTYPBIEN == "AP" & NBRPIECE > 6 ~ "APP4",  
REQTYPBIEN == "MA" & ( NBRPIECE >= 3 & NBRPIECE  <= 5) ~ "MAI2",
REQTYPBIEN == "MA" & ( NBRPIECE >= 6 & NBRPIECE  <= 7) ~ "MAI3",
 REQTYPBIEN == "AP" & ( NBRPIECE >= 2 & NBRPIECE  <= 3) ~ "APP2",
REQTYPBIEN == "AP" & ( NBRPIECE >= 4 & NBRPIECE  <= 6) ~ "APP3", 
REQTYPBIEN == "MA" &  NBRPIECE < 3 ~ "MAI1", 
REQTYPBIEN == "AP" & NBRPIECE  < 2 ~ "APP1" ))


Sample_BIEN_TBAnciennete <- as.data.frame (Sample_BIEN_select) %>%
  select(ID_new, REQTYPBIEN, REQ_ANC , REQ_EPOQU) %>%
  mutate(Anciennete = case_when(REQTYPBIEN == "MA" & REQ_ANC == 1 & REQ_EPOQU == "A" ~ "MAI_ANC1",
                                REQTYPBIEN == "MA" & REQ_ANC == 1 & REQ_EPOQU == "B" ~ "MAI_ANC2",
                                REQTYPBIEN == "MA" & REQ_ANC == 1 & REQ_EPOQU == "C" ~ "MAI_ANC3", 
                                REQTYPBIEN == "MA" & REQ_ANC == 1 & REQ_EPOQU == "D" ~ "MAI_ANC4",
                                REQTYPBIEN == "MA" & REQ_ANC == 1 & REQ_EPOQU == "E" ~ "MAI_ANC5",
                                REQTYPBIEN == "MA" & REQ_ANC == 1 & REQ_EPOQU == "F" ~ "MAI_ANC6",
                                 REQTYPBIEN == "MA" & REQ_ANC == 1 & REQ_EPOQU == "G" ~ "MAI_ANC7",
                                 REQTYPBIEN == "MA" & REQ_ANC == 1 & ( REQ_EPOQU == "H" | REQ_EPOQU == "I")  ~ "MAI_ANC8",
                                 REQTYPBIEN == "AP" & REQ_ANC == 1 & REQ_EPOQU == "A" ~ "APP_ANC1",
                                REQTYPBIEN == "AP" & REQ_ANC == 1 & REQ_EPOQU == "B" ~ "APP_ANC2",
                                REQTYPBIEN == "AP" & REQ_ANC == 1 & REQ_EPOQU == "C" ~ "APP_ANC3", 
                                REQTYPBIEN == "AP" & REQ_ANC == 1 & REQ_EPOQU == "D" ~ "APP_ANC4",
                                REQTYPBIEN == "AP" & REQ_ANC == 1 & REQ_EPOQU == "E" ~ "APP_ANC5",
                                REQTYPBIEN == "AP" & REQ_ANC == 1 & REQ_EPOQU == "F" ~ "APP_ANC6",
                                 REQTYPBIEN == "AP" & REQ_ANC == 1 & REQ_EPOQU == "G" ~ "APP_ANC7",
                                 REQTYPBIEN == "AP" & REQ_ANC == 1 & ( REQ_EPOQU == "H" | REQ_EPOQU == "I")  ~ "APP_ANC8",
                                REQTYPBIEN == "MA" & REQ_ANC == 2 ~ "MAI_ANC9",
                                 REQTYPBIEN == "AP" & REQ_ANC == 2 ~ "APP_ANC9"))


Sample_BIEN_TB <- full_join(Sample_BIEN_TBTaille[, c("ID_new", "REQTYPBIEN", "TypBien")], Sample_BIEN_TBAnciennete[,c("ID_new", "Anciennete")], by = "ID_new")
Sample_PTZ_TB <-  BaseSample_PTZ %>% 
  select(ID_new, timm, nppr)

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


Sample_PTZ_TB <- Sample_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" ))

Jointure des quatres tables données BIEN et PTZ

SampleBIEN_ReadyForOp <- left_join(Sample_BIEN_Prices, Sample_BIEN_ACVE, by = "ID_new") %>%
  left_join(.,Sample_BIEN_PURCHMUT, by = "ID_new")%>%
  left_join(.,Sample_BIEN_TB, by = "ID_new")
SamplePTZ_ReadyForOp <- left_join(Sample_PTZ_Prices, Sample_PTZ_ACVE %>% select (-an), by = "ID_new") %>%
  left_join(.,Sample_PTZ_PURCHMUT, by = "ID_new")%>%
  left_join(.,Sample_PTZ_TB, by = "ID_new")

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

A ce stade, nous obtenons deux échantillons de données individuelles nettoyés et préparés pour l’agrégation par unités spatiales et par groupes de population. Cette agrégation permet d’obtenir des tableaux d’informations statistiques, dont les agrégats spatiaux/groupes de population caractérisés, constituent désormais les individus, et ce pour chaque année. Les variables font l’objet d’une transposition d’un format long vers un format large afin de faciliter la présentation et la manipulation des fichiers de la base de données.

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

La déclinaison de la base par entrée spatiale de la première version du projet CASSMIR se décline à trois niveaux d’agrégation qui permettent une analyse fine et multi-scalaires des structures spatiales du marché en Île-de-France : le niveau communal, le niveau du carroyage Insee 1km de côté, le niveau du carroyage Insee 200m de côté.

Explication des traitements pour l’agrégation et l’interpolation spatiale des données

Ce travail nécessite des opérations d’agrégation. Sur le plan spatial, les indicateurs seront produits par des opérations d’agrégation des données individuelles sur trois niveaux scalaires : des indicateur locaux agrégés à partir du maillage adminsitratif des communes (maillage de Voronoï pour l’exemplification) ; des indicateurs locaux agrégés au niveau de la grille Insee sur les carreaux de 1Km de côté ; des indicateurs locaux agrégés au niveau de la grille Insee sur les carreaux de 200m de côté. Sur le plan temporel, les opérations en vue de produire des indicateurs s’effectueront à partir d’une agrégation annuelle des données individuelles, en fonction des années renseignées dont on dipose l’information.

Les informations individuelles issues de la BD PTZ ne permettent qu’une agrégation au niveau des unités spatiales d’appartenance renseignées (communes). Toutes les informations correspondent à minima à une agrégation sur cinq observations individuelles (sur un pas de temps annuel) de chacune des deux bases d’origine.

En fonction des échelles, des particularités existent quant à la production des indicateurs. En ce qui concerne les indicateurs produits sur le maillage administratif (communes), ils font suite à un traitement simple des données individuelles, c’est à dire en réalisant des mesures standards de centralité et de dispersion des valeurs (moyennes, médianes, écart-type). Tous les résulats renseignés sont strictement basés sur 5 références minimums pour chaque unité spatiale et par année. Pour les unités spatiales qui dérogent à ce niveau miminal de l’information de référence, les valeurs des champs renvoient à \(NA\).

En ce qui concerne les valeurs des indicateurs produits sur les carroyages, elles sont isssues d’un calcul à partir d’un modèle de potentiels gravitationnels sur les données individuelles en utilisant la fonction du package SpatialPosition . Cette méthode est basée sur l’hypothèse qu’il existe des phénomènes d’interaction entre des valeurs proches. Elle présente ici trois avantages. Premièrement, elle permet d’assurer une complétude spatiale de l’information par une interpolation qui attribue des valeurs là où les données de références sont manquantes. Deuxièmement elle lève les obligations d’un seuil minimal de référence pour la livraison d’un indicateur local. En effet, les valeurs des unités spatiales sont des valeurs modélisées qui ne permettent aucune ingénérie inversée. Plus précisément, le modèle par potentiels permet d’inférer la valeur d’un objet géographique, comme une unité spatiale zonale régulière (carreau), avec peu ou dépourvue d’informations, en fonction des valeurs de son voisinage, pondérées par le poids et la distance de celui-ci. Ces deux avantages de la méthode ne nous dispensent pas de n’étudier que les zones effectives du marché, c’est à dire en attribuant de l’information uniquement aux unités spatiales où des transactions ont été réalisées durant la période étudiée. De plus, le calcul par potentiels étant pondéré par le nombre d’individus statistiques, les indicateurs produits à partir de valeurs continues s’assimilent à des valeurs potentielles moyennes. Enfin, le troisième avantage est la possibilité de générer des cartes avec des informations lissées à deux échelles, permettant de faciliter une lecture géographique des structures régionales (carreaux 1km) et locales (carreaux 200m) du marché immobilier.

# Paramètres de la fonction sur les carreaux 200m
fun = "e"
span = 500
beta = 2
limit = 1000
# check number of cores : 
#parallel::detectCores(all.tests = FALSE, logical = FALSE)-1
ncl = 3

# Affichage de la fonction utilisée avec ses paramètres
fp_curve(fun = "e", span = span, beta = beta, limit = limit)

# Paramètres de la fonction sur les carreaux 1km
fun = "e"
span = 3000
beta = 2
limit = 6000
# check number of cores : 
#parallel::detectCores(all.tests = FALSE, logical = FALSE)-1
ncl = 3

# Affichage de la fonction utilisée avec ses paramètres
fp_curve(fun = "e", span = span, beta = beta, limit = limit)

#### Potentiels avec fastpot #####

# datasf : objet de classe sf
# Years : Vecteur sur les années (datasf$annee)
# VarPopEtudie : Variable catégorielle sur la population étudiée 
# Catégories : catégories de la variable de la  population étudiée 
#VarStock1 : Variable de stock sur la catégorie étudiée 
# VarStock2 : Variable de stock totale de la population étduiée
# Resultat : Chaine de charactère, nom à donner à l'objet sf en sortie

# La variable de l'identifiant spatial doit se nommer "Carreau_ID" 
# La variable sur l'année de la transaction doit se nommer "annee"
# Mask : objet Sf, équivalent de Unknowpts dans fonction mcStewart (spatialPosition)
# DistSpan = Span de la fonction pour le calcul des potentiels


FastPotentialsYearsAndProfils <- function(datasf, Mask, DistSpan, Years, Limit, Categories, VarStock1, VarStock2){
  require(fastpot)
  # Tableau recuperation des résultats
  Resultat <<- data.frame(Carreau_ID = NA, annee = NA, Profil = NA, Potential= NA) 
  
  # Résultat ecriture non scientifique
  options(scipen = 999)
  
  # Boucles Potentiels pour chaque année et chaque profil
  for (cetteanneeLa in Years) {
    print(cetteanneeLa)
    
    Transacs <- datasf %>% filter(annee ==cetteanneeLa)
    
    for (ceProfilLa in Categories){
      print(ceProfilLa)
      
      Transacs_2<- Transacs %>%
        filter(Profil == ceProfilLa)
    

 # Transacs_2 <- left_join(Mask, as.data.frame(Transacs_2)%>%
 #                           select(Carreau_ID, NAcqTotal, NAcq), by= "Carreau_ID")

pts <- st_centroid(Transacs_2) 
Maskpts <- st_centroid(Mask) 

pot <- fp_fastpot(x = pts, y = Maskpts, var = c(VarStock1, VarStock2),
                 fun = "e", span = DistSpan, beta = 2, limit = Limit,  verbose = TRUE)
      
testPot <- (pot[,1] / pot[,2])*100

testPot <- as.data.frame(testPot) %>%
  rename(Potential = testPot) %>%
        bind_cols(.,Mask[,c("Carreau_ID")])
      
stewart <-  as.data.frame(testPot) %>%
        select(Carreau_ID, Potential)
      
    
      # Récupération de l'année
      
      stewart$annee <- cetteanneeLa
      
      # Récupération de la catégorie (Profil)
      
      stewart$Profil <- ceProfilLa
      
      # Récupération des résultats
      
      Resultat <<- bind_rows(Resultat, stewart)
      
    } 
    
  } 
  return(Resultat) 
  print(Resultat)
}



FastPotentialsYears <- function(datasf, Mask, DistSpan, Years, Limit,  VarStock1, VarStock2){
  require(fastpot)

  # Tableau recuperation des résultats
  Resultat <<- data.frame(Carreau_ID = NA, annee = NA, Potential= NA) 
  
  # Résultat ecriture non scientifique
  options(scipen = 999)
  
  # Boucles Potentiels pour chaque année et chaque profil
  for (cetteanneeLa in Years) {
    print(cetteanneeLa)
    
    Transacs <- datasf %>% filter(annee ==cetteanneeLa)
      
    
      pts <- st_centroid(Transacs) 
      Maskpts <- st_centroid(Mask) 
      
      pot <- fp_fastpot(x = pts, y = Maskpts, var = c(VarStock1, VarStock2),
                        fun = "e", span = DistSpan, beta = 2, limit = Limit,  verbose = TRUE)
      
      testPot <- (pot[,1] / pot[,2])
      
      testPot <- as.data.frame(testPot) %>%
        rename(Potential = testPot) %>%
        bind_cols(.,Mask[,c("Carreau_ID")])
      
      stewart <-  as.data.frame(testPot) %>%
        select(Carreau_ID, Potential)
      
      
      # Récupération de l'année
      
      stewart$annee <- cetteanneeLa
      
     
      # Récupération des résultats
      
      Resultat <<- bind_rows(Resultat, stewart)
      
    } 
  return(Resultat) 
  print(Resultat)  
  } 

Préparation des géométries

 LastFile <- list.files("CASSMIR_Outputs",pattern =  "FictifSpace",full.names = T) %>% 
  enframe(name = NULL) %>% 
  bind_cols(pmap_df(., file.info)) %>% 
  filter(mtime==max(mtime)) %>% 
  pull(value)

Grid200 <- st_read(paste0(LastFile), quiet = TRUE, layer = "grid200")
Grid1k <- st_read(paste0(LastFile), quiet = TRUE, layer = "grid1km")

FictifCommunes <- st_read(paste0(LastFile), quiet = TRUE, layer = "VoronoiForCommunes")

### SampleGeoBIEN_sf
SampleGeoBIEN_sf <- SampleBIEN_ReadyForOp %>%
  select(ID_new, X_fictif, Y_fictif) %>% # On garde uniquement les variables d'intérêts
st_as_sf(.,coords = c("X_fictif", "Y_fictif"),agr = "constant", stringsAsFactors = FALSE) 
  # Passage en objet spatial SF 

### Jointures spatiales
FictifGrid1kmJoinBIEN<- st_join(Grid1k,  SampleGeoBIEN_sf, join = st_contains, left=T)

FictifGrid200JoinBIEN<- st_join(Grid200, SampleGeoBIEN_sf, join = st_contains, left=T)

### Filtrage sur le nombre de transactions : on garde uniquement "l'espace du marché"
FictifMarketSpaceGrid1km<- FictifGrid1kmJoinBIEN%>% 
  group_by(Carreau_ID) %>%
  summarise (N_TotalTransacs = length(which(ID_new != "NA"))) %>%
  filter(N_TotalTransacs >= 1) %>% 
  select(Carreau_ID, geom)
FictifMarketSpaceGrid1km$Carreau_ID<- as.character(FictifMarketSpaceGrid1km$Carreau_ID)

FictifMarketSpaceGrid200m<- FictifGrid200JoinBIEN%>% 
  group_by(Carreau_ID) %>%
  summarise (N_TotalTransacs = length(which(ID_new != "NA"))) %>%
  filter(N_TotalTransacs >= 1) %>% 
  select(Carreau_ID, geom)
FictifMarketSpaceGrid200m$Carreau_ID<- as.character(FictifMarketSpaceGrid200m$Carreau_ID)

# Factor vers character pour ID

FictifCommunes$VoronoiID<-as.character(FictifCommunes$VoronoiID)

FictifMarketSpaceGrid1km$Carreau_ID <- as.character(FictifMarketSpaceGrid1km$Carreau_ID)

FictifMarketSpaceGrid200m$Carreau_ID <- as.character(FictifMarketSpaceGrid200m$Carreau_ID)

Préparation des objets pour le traitement spatial

BIEN_Prices <- SampleBIEN_ReadyForOp %>%
  st_as_sf(.,coords = c("X_fictif", "Y_fictif"),agr = "constant", stringsAsFactors = FALSE) %>%
  select(ID_new,  annee, REQTYPBIEN, TypBien, REQ_PRIX, REQ_PM2)

BIEN_BuyerSeller <- SampleBIEN_ReadyForOp %>%
  st_as_sf(.,coords = c("X_fictif", "Y_fictif"),agr = "constant", stringsAsFactors = FALSE) %>%
  select(ID_new,  annee, Nature_Acq, Type_Acq,CSP_Acq, Nature_Ve,   Type_Ve, CSP_Ve, Sexe_Acq, Sexe_Ve, Age_Acq, Age_Ve, Tranche_Age_Acq, Tranche_Age_Vendeur, SitMatri_Acq, SitMatri_VE,Provenance_Acq)

BIEN_PURCHMUT <- SampleBIEN_ReadyForOp %>%
  st_as_sf(.,coords = c("X_fictif", "Y_fictif"),agr = "constant", stringsAsFactors = FALSE) %>%
  select(ID_new, annee, Nature_Acq, Nature_Ve, REQ_PRIX, MTCRED, REQ_VALUE, Duree_Detention_Ve, Tranche_DureeDetention_Ve, TypMutPrec_VE, PresCred_Acq, TypePret_Acq)

BIEN_HousingTypes <- SampleBIEN_ReadyForOp %>%
  st_as_sf(.,coords = c("X_fictif", "Y_fictif"),agr = "constant", stringsAsFactors = FALSE) %>%
  select(ID_new, annee, TypBien, Anciennete)

Préparation des données sur les prix

Script sur les communes

# Jointure spatiale
ComJoinBIEN<- st_join(FictifCommunes, BIEN_Prices, join = st_contains, left=T)

# passage en dataframe
ComJoinBIEN <- as.data.frame(ComJoinBIEN) %>%
  select(-geom)

####### Prix Nominaux pour l'ensemble des maisons et appartements ########
ComPricesAll <- ComJoinBIEN %>% 
  filter(!is.na(REQ_PRIX)) %>% 
  group_by(VoronoiID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            Moyen = mean (REQ_PRIX, na.rm = T),
            Median = median (REQ_PRIX, na.rm = T),
            EcartType = sd (REQ_PRIX, na.rm = T)) %>%
  filter(NTotal >= 5) 

ComPricesAll <- ComPricesAll %>%
  select(-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.)))

####### Prix Nominaux pour l'ensemble des maisons ########
ComPricesHouses <- ComJoinBIEN %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>% 
  group_by(VoronoiID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            Moyen = mean (REQ_PRIX, na.rm = T),
            Median = median (REQ_PRIX, na.rm = T),
            EcartType = sd (REQ_PRIX, na.rm = T)) %>%
  filter(NTotal >= 5) 

ComPricesHouses <- ComPricesHouses %>%
  select(-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI_",.)))

####### Prix Nominaux pour l'ensemble des Appartements ########
ComPricesAppart <- ComJoinBIEN %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>% 
  group_by(VoronoiID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            Moyen = mean (REQ_PRIX, na.rm = T),
            Median = median (REQ_PRIX, na.rm = T),
            EcartType = sd (REQ_PRIX, na.rm = T)) %>%
  filter(NTotal >= 5) 

ComPricesAppart <- ComPricesAppart %>%
  select(-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP_",.)))

####### Prix au m² pour l'ensemble des Appartements ########
ComPM2Appart <- ComJoinBIEN %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>% 
  group_by(VoronoiID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            Moyen = mean (REQ_PM2, na.rm = T),
            Median = median (REQ_PM2, na.rm = T),
            EcartType = sd (REQ_PM2, na.rm = T)) %>%
  filter(NTotal >= 5) 

ComPM2Appart <- ComPM2Appart %>%
  select(-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_APP_",.)))


###### Prix nominaux par types de biens #####
ComPricesTypBien <- ComJoinBIEN %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>% 
  group_by(VoronoiID, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            Moyen = mean (REQ_PRIX, na.rm = T),
            Median = median (REQ_PRIX, na.rm = T),
            EcartType = sd (REQ_PRIX, na.rm = T)) %>%
  filter(NTotal >= 5) 


ComPricesTypBien <- ComPricesTypBien %>%
  select(-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "TypBienPrix", TypBien, Mesure, sep="_") %>%
  spread(TypBienPrix, 4)%>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.)))

###### Prix au m² par types de biens quand appartement #####
ComPM2TypAppart <- ComJoinBIEN %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>% 
  group_by(VoronoiID, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            Moyen = mean (REQ_PM2, na.rm = T),
            Median = median (REQ_PM2, na.rm = T),
            EcartType = sd (REQ_PM2, na.rm = T)) %>%
  filter(NTotal >= 5) 

ComPM2TypAppart <- ComPM2TypAppart %>%
  select(-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "TypAppartPm2", TypBien, Mesure, sep="_") %>%
  spread(TypAppartPm2, 4)%>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.)))

######### Jointure ############
CommunesPrices_BIEN <- full_join (ComPricesAll, 
                             ComPricesAppart, 
                             by = c("VoronoiID","annee")) %>%
  full_join (., ComPricesHouses, 
             by = c("VoronoiID","annee")) %>%
  full_join (., ComPricesTypBien, 
             by = c("VoronoiID","annee")) %>%
  full_join (., ComPM2Appart, 
             by = c("VoronoiID","annee")) %>%
  full_join (., ComPM2TypAppart, 
             by = c("VoronoiID","annee")) %>%
  left_join(FictifCommunes[,c("VoronoiID")],., by= "VoronoiID")

######################################

#### Variables à partir des données de la base PTZ #######

#### Prix pour l'ensemble des biens #######
ComPricesAll_PTZ <- SamplePTZ_ReadyForOp %>%
  filter(!is.na(vtto))%>%
  group_by(annee,VoronoiID)  %>%
  summarise(n_operation_PTZ= length(which(!is.na(VoronoiID))),
            P_PX_Moyen= mean(vtto),
            P_PX_Median= median(vtto),
            P_PX_EcartType= sd(vtto))%>%
              filter(n_operation_PTZ>=5)%>%
              select(-n_operation_PTZ)

######### Jointure finale ############
ComPricesAll_PTZ$VoronoiID<-as.character(ComPricesAll_PTZ$VoronoiID)
CommunesPrices <- full_join (CommunesPrices_BIEN, 
                             ComPricesAll_PTZ, 
                             by = c("VoronoiID","annee")) 

Script sur les carreaux 1km

# Jointure Spatiale
Grid1kmJoinBIEN<- st_join(FictifMarketSpaceGrid1km, BIEN_Prices, join = st_contains, left=T)

# passage en dataframe
Grid1kmJoinBIEN <- as.data.frame(Grid1kmJoinBIEN) %>%
  select(-geom)

####### Prix Nominaux Potentiels pour les maisons ########

# Gestion des données
Grid1kmPricesAll<- Grid1kmJoinBIEN %>% 
  filter(!is.na(REQ_PRIX)) %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PRIX, na.rm = T)) 

# Remise en format Sf
Grid1kmPricesAll <- left_join(FictifMarketSpaceGrid1km, Grid1kmPricesAll, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmPricesAll$annee)
annees <- sort(annees[!is.na(annees)])

# Calcul des potentiels 
FastPotentialsYears   (datasf = Grid1kmPricesAll,
                       Mask = FictifMarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumPrix",
                       VarStock2 = "NTotal")  

Gr1km_PotentialAllPrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_Moyen = Potential)

####### Prix Nominaux pour l'ensemble des maisons ########

# Gestion des données
Grid1kmPricesHouse<- Grid1kmJoinBIEN %>% 
  filter(!is.na(REQ_PRIX)& REQTYPBIEN == "MA") %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PRIX, na.rm = T)) 

# Remise en format Sf
Grid1kmPricesHouse <- left_join(FictifMarketSpaceGrid1km, Grid1kmPricesHouse, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmPricesHouse$annee)
annees <- sort(annees[!is.na(annees)])

# Calcul des potentiels 
FastPotentialsYears   (datasf = Grid1kmPricesHouse,
                       Mask = FictifMarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumPrix",
                       VarStock2 = "NTotal")  

Gr1km_PotentialHousePrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_MAI_Moyen = Potential)

####### Prix Nominaux pour l'ensemble des appartements ########

# Gestion des données
Grid1kmPricesAppart<- Grid1kmJoinBIEN %>% 
  filter(!is.na(REQ_PRIX)& REQTYPBIEN == "AP") %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PRIX, na.rm = T)) 


# Remise en format Sf
Grid1kmPricesAppart <- left_join(FictifMarketSpaceGrid1km, Grid1kmPricesAppart, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmPricesAppart$annee)
annees <- sort(annees[!is.na(annees)])

# Calcul des potentiels 
FastPotentialsYears   (datasf = Grid1kmPricesAppart,
                       Mask = FictifMarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumPrix",
                       VarStock2 = "NTotal")  

Gr1km_PotentialAppartPrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_APP_Moyen = Potential)


####### Prix au m2 pour l'ensemble des appartements ########

# Gestion des données
Grid1kmPricesAppart<- Grid1kmJoinBIEN %>% 
  filter(!is.na(REQ_PM2)& REQTYPBIEN == "AP") %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PM2, na.rm = T)) 

# Remise en format Sf
Grid1kmPricesAppart <- left_join(FictifMarketSpaceGrid1km, Grid1kmPricesAppart, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmPricesAppart$annee)
annees <- sort(annees[!is.na(annees)])

# Calcul des potentiels 
FastPotentialsYears   (datasf = Grid1kmPricesAppart,
                       Mask = FictifMarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumPrix",
                       VarStock2 = "NTotal")  

Gr1km_PotentialAppartPM2<- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PM_APP_Moyen = Potential)

####### Prix nominaux par types de biens ########

#Gestion des données
Grid1kmPricesTypBiens<- Grid1kmJoinBIEN %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>% 
  group_by(Carreau_ID, annee, TypBien) %>%
  summarise(N = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PRIX, na.rm = T)) %>%
  rename( Profil = TypBien)

# Remise en format Sf
Grid1kmPricesTypBiens <- left_join(FictifMarketSpaceGrid1km, Grid1kmPricesTypBiens, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmPricesTypBiens$annee)
annees <- sort(annees[!is.na(annees)])

# List profil types de biens
Profils <- unique(Grid1kmPricesTypBiens$Profil)
Profils <- sort(Profils[!is.na(Profils)]) # On enelève la catégorie des NA


# Calcul des potentiels 
FastPotentialsYearsAndProfils   (datasf = Grid1kmPricesTypBiens,
                                 Mask = FictifMarketSpaceGrid1km,
                                 DistSpan = 3000, 
                                 Years = annees, Limit = 6000,
                                 Categories = Profils,
                                 VarStock1 = "SumPrix",
                                 VarStock2 = "N")  

Gr1km_PotentialTypBiensPrices <- Resultat %>%
  mutate ( Potential = (Potential / 100)) %>% 
  # La fonction renvoie à des pourcentage : diviser par 100 pour obtenir les prix potentiels calculés
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 


####### Prix au M2 pour par types d'appartements ########

#Gestion des données
Grid1kmPM2TypBiens<- Grid1kmJoinBIEN %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP" & !is.na(TypBien)) %>% 
  group_by(Carreau_ID, annee, TypBien) %>%
  summarise(N = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PM2, na.rm = T)) %>%
  rename( Profil = TypBien)

# Remise en format Sf
Grid1kmPM2TypBiens <- left_join(FictifMarketSpaceGrid1km, Grid1kmPM2TypBiens, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmPM2TypBiens$annee)
annees <- sort(annees[!is.na(annees)])

# List profil types de biens
Profils <- unique(Grid1kmPM2TypBiens$Profil)
Profils <- sort(Profils[!is.na(Profils)])

# Calcul des potentiels 
FastPotentialsYearsAndProfils   (datasf = Grid1kmPM2TypBiens,
                                 Mask = FictifMarketSpaceGrid1km,
                                 DistSpan = 3000, 
                                 Years = annees, Limit = 6000,
                                 Categories = Profils,
                                 VarStock1 = "SumPrix",
                                 VarStock2 = "N")  

Gr1km_PotentialTypBiensPM2 <- Resultat %>%
  mutate ( Potential = (Potential / 100)) %>% 
  # La fonction renvoie à des pourcentage : diviser par 100 pour obtenir les prix potentiels calculés
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 


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

Grid1kmPrices <- full_join (Gr1km_PotentialAllPrices, 
                            Gr1km_PotentialAppartPrices, 
                            by = c("Carreau_ID","annee")) %>%
  full_join (., Gr1km_PotentialHousePrices, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr1km_PotentialAppartPM2, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr1km_PotentialTypBiensPrices, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr1km_PotentialTypBiensPM2, 
             by = c("Carreau_ID","annee")) %>%
  left_join(FictifMarketSpaceGrid1km,., by = "Carreau_ID")

Script sur les carreaux 200m

# Jointure Spatiale
Grid200mJoinBIEN<- st_join(FictifMarketSpaceGrid200m, BIEN_Prices, join = st_contains, left=T)

# passage en dataframe
Grid200mJoinBIEN <- as.data.frame(Grid200mJoinBIEN) %>%
  select(-geom)

####### Prix Nominaux Potentiels pour les maisons ########

# Gestion des données
Grid200mPricesAll<- Grid200mJoinBIEN %>% 
  filter(!is.na(REQ_PRIX)) %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PRIX, na.rm = T)) 

# Remise en format Sf
Grid200mPricesAll <- left_join(FictifMarketSpaceGrid200m, Grid200mPricesAll, by = "Carreau_ID")

# List années
annees <- unique(Grid200mPricesAll$annee)
annees <- sort(annees[!is.na(annees)])

# Calcul des potentiels 
FastPotentialsYears   (datasf = Grid200mPricesAll,
                       Mask = FictifMarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumPrix",
                       VarStock2 = "NTotal")  

Gr200m_PotentialAllPrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_Moyen = Potential)


####### Prix Nominaux pour l'ensemble des maisons ########

# Gestion des données
Grid200mPricesHouse<- Grid200mJoinBIEN %>% 
  filter(!is.na(REQ_PRIX)& REQTYPBIEN == "MA") %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PRIX, na.rm = T)) 

# Remise en format Sf
Grid200mPricesHouse <- left_join(FictifMarketSpaceGrid200m, Grid200mPricesHouse, by = "Carreau_ID")

# List années
annees <- unique(Grid200mPricesHouse$annee)
annees <- sort(annees[!is.na(annees)])

# Calcul des potentiels 
FastPotentialsYears   (datasf = Grid200mPricesHouse,
                       Mask = FictifMarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumPrix",
                       VarStock2 = "NTotal")  

Gr200m_PotentialHousePrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_MAI_Moyen = Potential)

####### Prix Nominaux pour l'ensemble des appartements ########
## Gestion des données
Grid200mPricesAppart<- Grid200mJoinBIEN %>% 
  filter(!is.na(REQ_PRIX)& REQTYPBIEN == "AP") %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PRIX, na.rm = T)) 


# Remise en format Sf
Grid200mPricesAppart <- left_join(FictifMarketSpaceGrid200m, Grid200mPricesAppart, by = "Carreau_ID")

# List années
annees <- unique(Grid200mPricesAppart$annee)
annees <- sort(annees[!is.na(annees)])

# Calcul des potentiels 
FastPotentialsYears   (datasf = Grid200mPricesAppart,
                       Mask = FictifMarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumPrix",
                       VarStock2 = "NTotal")  

Gr200m_PotentialAppartPrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_APP_Moyen = Potential)

####### Prix au m2 pour l'ensemble des appartements ########

# Gestion des données
Grid200mPricesAppart<- Grid200mJoinBIEN %>% 
  filter(!is.na(REQ_PM2)& REQTYPBIEN == "AP") %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PM2, na.rm = T)) 

# Remise en format Sf

Grid200mPricesAppart <- left_join(FictifMarketSpaceGrid200m, Grid200mPricesAppart, by = "Carreau_ID")

# List années
annees <- unique(Grid200mPricesAppart$annee)
annees <- sort(annees[!is.na(annees)])

# Calcul des potentiels 
FastPotentialsYears   (datasf = Grid200mPricesAppart,
                       Mask = FictifMarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumPrix",
                       VarStock2 = "NTotal")  

Gr200m_PotentialAppartPM2<- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PM_APP_Moyen = Potential)

####### Prix nominaux par types de biens ########

# Gestion des données
Grid200mPricesTypBiens<- Grid200mJoinBIEN %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>% 
  group_by(Carreau_ID, annee, TypBien) %>%
  summarise(N = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PRIX, na.rm = T)) %>%
  rename( Profil = TypBien)

# Remise en format Sf
Grid200mPricesTypBiens <- left_join(FictifMarketSpaceGrid200m, Grid200mPricesTypBiens, by = "Carreau_ID")

# List années
annees <- unique(Grid200mPricesTypBiens$annee)
annees <- sort(annees[!is.na(annees)])

# List profil types de biens
Profils <- unique(Grid200mPricesTypBiens$Profil)
Profils <- sort(Profils[!is.na(Profils)]) # On enelève la catégorie des NA


# Calcul des potentiels 
FastPotentialsYearsAndProfils   (datasf = Grid200mPricesTypBiens,
                                 Mask = FictifMarketSpaceGrid200m,
                                 DistSpan = 500, 
                                 Years = annees, Limit = 1000,
                                 Categories = Profils,
                                 VarStock1 = "SumPrix",
                                 VarStock2 = "N")  

Gr200m_PotentialTypBiensPrices <- Resultat %>%
  mutate ( Potential = (Potential / 100)) %>% 
  # La fonction renvoie à des pourcentage : diviser par 100 pour obtenir les prix potentiels calculés
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

####### Prix au M2 pour par types d'appartements ########

######## Gestion des données
Grid200mPM2TypBiens<- Grid200mJoinBIEN %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP" & !is.na(TypBien)) %>% 
  group_by(Carreau_ID, annee, TypBien) %>%
  summarise(N = length(which(!is.na(ID_new))),
            SumPrix = sum (REQ_PM2, na.rm = T)) %>%
  rename( Profil = TypBien)

# Remise en format Sf
Grid200mPM2TypBiens <- left_join(FictifMarketSpaceGrid200m, Grid200mPM2TypBiens, by = "Carreau_ID")

# List années
annees <- unique(Grid200mPM2TypBiens$annee)
annees <- sort(annees[!is.na(annees)])

# List profil types de biens
Profils <- unique(Grid200mPM2TypBiens$Profil)
Profils <- sort(Profils[!is.na(Profils)])

# Calcul des potentiels 
FastPotentialsYearsAndProfils   (datasf = Grid200mPM2TypBiens,
                                 Mask = FictifMarketSpaceGrid200m,
                                 DistSpan = 500, 
                                 Years = annees, Limit = 1000,
                                 Categories = Profils,
                                 VarStock1 = "SumPrix",
                                 VarStock2 = "N")  

Gr200m_PotentialTypBiensPM2 <- Resultat %>%
  mutate ( Potential = (Potential / 100)) %>% 
  # La fonction renvoie à des pourcentage : diviser par 100 pour obtenir les prix potentiels calculés
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 


############ Jointure #############
Grid200mPrices <- full_join (Gr200m_PotentialAllPrices, 
                             Gr200m_PotentialAppartPrices, 
                             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr200m_PotentialHousePrices, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr200m_PotentialAppartPM2, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr200m_PotentialTypBiensPrices, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr200m_PotentialTypBiensPM2, 
             by = c("Carreau_ID","annee")) %>%
  left_join(FictifMarketSpaceGrid200m,., by = "Carreau_ID")

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

Script sur les communes

# Jointure spatiale
ComJoinBIEN<- st_join(FictifCommunes, BIEN_BuyerSeller, join = st_contains, left=T)

# passage en dataframe
ComJoinBIEN <- as.data.frame(ComJoinBIEN) %>%
  select(-geom)

#### Social ####
# Total des acquéreurs toutes catégories confondues et Nature des acquéreurs, en pourcentage par commune et par année
ComNatAcq <- ComJoinBIEN %>% 
  filter(!is.na(ID_new)) %>%
  count(VoronoiID , annee, Nature_Acq) %>%
  group_by(VoronoiID, annee) %>%
  mutate( B_AC_TOT = sum(n, na.rm=TRUE)) %>%
  spread(Nature_Acq, n, fill = 0 ) %>% 
  filter(B_AC_TOT >= 5)  %>%
  mutate_at(4:ncol(.), funs((./B_AC_TOT)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_NAT_",.)))


# Total des vendeurs et nature des vendeurs, en pourcentage par commune et par année
ComNatVe <- ComJoinBIEN %>% 
   filter(!is.na(ID_new)) %>%
  count(VoronoiID , annee, Nature_Ve) %>%
  group_by(VoronoiID , annee) %>%
  mutate(B_VE_TOT = sum(n, na.rm=TRUE)) %>%
  spread(Nature_Ve, n, fill = 0) %>% 
  filter(B_VE_TOT >= 5)  %>%
  mutate_at(4:ncol(.), funs((./B_VE_TOT)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_NAT_",.)))

ComNatVe <- ComNatVe %>%
  select(-`B_VE_NAT_<NA>`)

# Détails de la "nature" des acquéreurs et vendeurs par "type"
# Uniquement les informations avec info != NA sur la nature des acquéreurs-vendeurs sont retenues ; Seuil >= 5 transactions.
# Type d'Acquéreurs, en pourcentage par commune et par année
ComTypeAcq <- ComJoinBIEN %>% 
  filter(!is.na(Nature_Acq)) %>%
  count(VoronoiID, annee, Type_Acq) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTypeAcq = sum(n)) %>%
  spread(Type_Acq, n, fill = 0) %>% 
  filter(NTypeAcq >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTypeAcq)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_TYP_",.)))

ComTypeAcq <- ComTypeAcq %>%
  select(-NTypeAcq)

# Type de Vendeurs, en pourcentage par commune et par année
ComTypeVe <- ComJoinBIEN %>% 
  filter(!is.na(Nature_Ve)) %>%
  count(VoronoiID, annee, Type_Ve ) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTypeVe  = sum(n)) %>%
  spread(Type_Ve , n, fill = 0) %>% 
  filter(NTypeVe  >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTypeVe )*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_TYP_",.)))

ComTypeVe <- ComTypeVe %>%
  select(-NTypeVe)

# Pourcentage des acquéreurs par CSP, population personnes physiques
ComAcqCSP_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH") %>%
  count(VoronoiID, annee, CSP_Acq) %>%
  group_by(VoronoiID, annee) %>%
  mutate( B_AC_MEN_TOT = sum(n)) %>%
  spread(CSP_Acq, n, fill = 0) %>% 
  filter(B_AC_MEN_TOT >= 5)  %>%
  mutate_at(4:ncol(.), funs((./B_AC_MEN_TOT)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_CSP_",.)))


# Pourcentage des vendeurs par CSP, population personnes physiques
ComVeCSP_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Ve== "PPH") %>%
  count(VoronoiID, annee, CSP_Ve) %>%
  ungroup %>%
  group_by(VoronoiID, annee) %>%
  mutate( B_VE_MEN_TOT = sum(n)) %>%
  spread(CSP_Ve, n, fill = 0) %>% 
  filter(B_VE_MEN_TOT >= 5)  %>%
  mutate_at(4:ncol(.), funs((./B_VE_MEN_TOT)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_CSP_",.)))

# Jointure des résultats
CommunesAcqVE_Social<- full_join(ComNatAcq, ComNatVe , by= c("VoronoiID", "annee")) %>%
  full_join(.,ComTypeAcq, by= c("VoronoiID","annee")) %>%
  full_join(.,ComTypeVe, by= c("VoronoiID","annee")) %>%
  full_join(.,ComAcqCSP_PrivateIndiv, by= c("VoronoiID","annee")) %>%
  full_join(.,ComVeCSP_PrivateIndiv, by= c("VoronoiID","annee"))


#### Sexe ####
# Acquéreurs, Pourcentage selon Sexe, population personnes physiques
ComAcqSexe_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Acq== "PPH" & !is.na(Sexe_Acq)) %>%
  count(VoronoiID, annee, Sexe_Acq) %>%
  ungroup %>%
  group_by(VoronoiID, annee) %>%
  mutate( NAcqMenages = sum(n)) %>%
  spread(Sexe_Acq, n, fill = 0) %>% 
  filter(NAcqMenages >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NAcqMenages)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_SEX_",.)))

ComAcqSexe_PrivateIndiv <- ComAcqSexe_PrivateIndiv %>%
  select(-NAcqMenages)

## Vendeurs, Pourcentage Sexe, population personnes physiques
ComVeSexe_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Ve== "PPH" & !is.na(Sexe_Ve)) %>%
  count(VoronoiID, annee, Sexe_Ve) %>%
  ungroup %>%
  group_by(VoronoiID, annee) %>%
  mutate( NVemenages = sum(n)) %>%
  spread(Sexe_Ve, n, fill = 0) %>% 
  filter(NVemenages >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NVemenages)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_SEX_",.)))

ComVeSexe_PrivateIndiv <- ComVeSexe_PrivateIndiv %>%
  select(-NVemenages)

# Jointure
CommunesAcqVE_Sexe <- full_join (ComAcqSexe_PrivateIndiv, 
                                 ComVeSexe_PrivateIndiv,  
                                 by= c("VoronoiID","annee"))

############ Age ##############################################

# Mesures de centralité et de dispersion : moyenne, médiane, écart-type
## Acquéreurs
ComAcqAge_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Acq== "PPH" & !is.na(Age_Acq)) %>%
  group_by(VoronoiID, annee) %>%
  summarise( NAcqMenages = length(which(!is.na(ID_new))),
  Moyen = mean(Age_Acq),
  Median = median(Age_Acq),
  EcartType = sd(Age_Acq))%>%
  filter(NAcqMenages >= 5)  %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_AGE_",.)))

ComAcqAge_PrivateIndiv <- ComAcqAge_PrivateIndiv %>%
  select(-NAcqMenages)

## vendeurs
ComVeAge_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Ve== "PPH" & !is.na(Age_Ve)) %>%
  group_by(VoronoiID, annee) %>%
  summarise( NVeMenages = length(which(!is.na(ID_new))),
             Moyen = mean(Age_Ve),
             Median = median(Age_Ve),
             EcartType = sd(Age_Ve))%>%
  filter(NVeMenages >= 5)  %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_AGE_",.)))

ComVeAge_PrivateIndiv <- ComVeAge_PrivateIndiv %>%
  select(-NVeMenages)

# 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_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Type_Acq== "TYP1" & !is.na(Age_Acq)) %>%
  count(VoronoiID, annee, Tranche_Age_Acq) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NAcqMenages = sum(n, na.rm=TRUE)) %>%
  spread(Tranche_Age_Acq, n, fill = 0) %>% 
  filter(NAcqMenages >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NAcqMenages)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_MOC_AGE_",.)))

ComAcqTrancAge_PrivateIndiv <- ComAcqTrancAge_PrivateIndiv %>%
  select(-NAcqMenages, -`B_AC_MOC_AGE_<NA>`)

## Vendeurs, la population de référence est l'ensemble des personnes physiques. avec âge renseigné.
ComVeTrancAge_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Ve== "PPH" & !is.na(Age_Ve)) %>%
  count(VoronoiID, annee, Tranche_Age_Vendeur) %>%
  ungroup %>%
  group_by(VoronoiID, annee) %>%
  mutate( NVeMenages = sum(n)) %>%
  spread(Tranche_Age_Vendeur, n, fill = 0) %>% 
  filter(NVeMenages >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NVeMenages)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_MOC_AGE_",.)))

ComVeTrancAge_PrivateIndiv <- ComVeTrancAge_PrivateIndiv %>%
  select(-NVeMenages,- `B_VE_MOC_AGE_<NA>`)

# Jointure
CommunesAcqVE_Age <- full_join (ComAcqAge_PrivateIndiv, 
                                ComVeAge_PrivateIndiv, 
                                by= c("VoronoiID","annee")) %>%
              full_join (., 
                         ComAcqTrancAge_PrivateIndiv, 
             by= c("VoronoiID","annee")) %>%
  full_join (., 
             ComVeTrancAge_PrivateIndiv, 
             by= c("VoronoiID","annee"))


###################### Situation Matrimoniale ##########################

# Pourcentage par situation matrimoniale, uniquement personnes physiques avec information sur la situation matrimoniale 
# Acquéreurs
ComAcqSitMatri_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Acq== "PPH" & !is.na(SitMatri_Acq)) %>%
  count(VoronoiID, annee, SitMatri_Acq) %>%
  ungroup %>%
  group_by(VoronoiID, annee) %>%
  mutate( NAcqMenages = sum(n)) %>%
  spread(SitMatri_Acq, n, fill = 0) %>% 
  filter(NAcqMenages >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NAcqMenages)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_MATRI_",.)))

ComAcqSitMatri_PrivateIndiv <- ComAcqSitMatri_PrivateIndiv %>%
  select(-NAcqMenages)

# Vendeurs
ComVeSitMatri_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Ve== "PPH" & !is.na(SitMatri_VE)) %>%
  count(VoronoiID, annee, SitMatri_VE) %>%
  ungroup %>%
  group_by(VoronoiID, annee) %>%
  mutate( NVeMenages = sum(n)) %>%
  spread(SitMatri_VE, n, fill = 0) %>% 
  filter(NVeMenages >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NVeMenages)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_MATRI_",.)))


ComVeSitMatri_PrivateIndiv <- ComVeSitMatri_PrivateIndiv %>%
  select(-NVeMenages)

# Jointure
CommunesAcqVE_SitMatri <- full_join (ComAcqSitMatri_PrivateIndiv, 
                                 ComVeSitMatri_PrivateIndiv,  
                                 by= c("VoronoiID","annee"))

####### Acquéreurs selon l'origine résidentielle########

ComPortee <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH", !is.na(Provenance_Acq)) %>%
  count(VoronoiID, annee, Provenance_Acq) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTotal = sum(n)) %>%
  spread(Provenance_Acq, n, fill = 0) %>% 
  filter(NTotal >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTotal)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_ORIGIN_",.)))

CommunesMarketScope <- ComPortee %>%
  select(-NTotal)

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

CommunesAcqVE_BIEN<- full_join (CommunesAcqVE_Social, 
                           CommunesAcqVE_Age, 
                           by = c("VoronoiID","annee")) %>%
  full_join (., CommunesAcqVE_Sexe, 
             by = c("VoronoiID","annee")) %>%
  full_join (., CommunesAcqVE_SitMatri, 
             by = c("VoronoiID","annee")) %>%
   full_join (., CommunesMarketScope, 
             by = c("VoronoiID","annee"))

######################################

#### Variables à partir des données de la base PTZ #######

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


# Pourcentage des acquéreurs par CSP
ComAcqCSP_PTZ<- SamplePTZ_ReadyForOp %>% 
              filter(!is.na(CSP_Acq)) %>%
              count(VoronoiID, annee, CSP_Acq) %>%
              group_by(VoronoiID, 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_MEN_CSP_",.)))

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

#Age 
# Mesures de centralité et de dispersion : moyenne, médiane, écart-type
## Acquéreurs
ComAcqAge_PTZ <- SamplePTZ_ReadyForOp %>% 
  filter(!is.na(age)) %>%
  group_by(VoronoiID, annee) %>%
  summarise( NAcq = length(which(!is.na(ID_new))),
             Moyen = mean(age),
             Median = median(age),
             EcartType = sd(age))%>%
  filter(NAcq>= 5)  %>%
  rename_at(4:ncol(.), list( ~paste0("P_AC_MEN_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 <- SamplePTZ_ReadyForOp %>% 
  filter(Type_Acq== "TYP1" & !is.na(age)) %>%
  count(VoronoiID, annee, Tranche_Age_Acq) %>%
  ungroup %>%
  group_by(VoronoiID, 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_MOC_AGE_",.)))

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

# Pourcentage par situation matrimoniale
ComAcqSitMatri_PTZ <- SamplePTZ_ReadyForOp %>% 
  filter( !is.na(SitMatri_Acq)) %>%
  count(VoronoiID, annee, SitMatri_Acq) %>%
  group_by(VoronoiID, 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_MEN_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 <- SamplePTZ_ReadyForOp %>% 
  filter( !is.na(StatutOccupation)) %>%
  count(VoronoiID, annee, StatutOccupation) %>%
  group_by(VoronoiID, 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_MEN_STATOCC_",.)))

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

# Jointure PTZ # 

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

###################### Jointure finale ################

CommunesAcq_PTZ$VoronoiID <- as.character(CommunesAcq_PTZ$VoronoiID)
CommunesAcqVE<- full_join (CommunesAcqVE_BIEN, 
                           CommunesAcq_PTZ, 
                           by = c("VoronoiID","annee"))

Script sur les carreaux 1km

# Jointure Spatiale
Grid1kmJoinBIEN<- st_join(FictifMarketSpaceGrid1km, BIEN_BuyerSeller, join = st_contains, left=T)

# passage en dataframe
Grid1kmJoinBIEN <- as.data.frame(Grid1kmJoinBIEN) %>%
  select(-geom)

######### Nature des acquéreurs-vendeurs ##############
######## Gestion des données

# Données Acquéreurs
Grid1kmNatAcq <- Grid1kmJoinBIEN %>%
  filter(!is.na(Nature_Acq)) %>%
  count(Carreau_ID, annee, Nature_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Nature_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_NAT_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid1kmNatVe <- Grid1kmJoinBIEN %>%
  filter(!is.na(Nature_Ve)) %>%
  count(Carreau_ID, annee, Nature_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Nature_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_NAT_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

# Remise en format Sf
Grid1kmNatAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmNatAcq, by = "Carreau_ID")

Grid1kmNatVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmNatVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmNatAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  vendeurs
ProfilsAcq <- unique(Grid1kmNatAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid1kmNatVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])

# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid1kmNatAcq,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr1km_PotentialNatAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid1kmNatVe,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal") 

Gr1km_PotentialNatVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr1km_PotentialNat_ACVE  <- full_join(Gr1km_PotentialNatAcq,
                                      Gr1km_PotentialNatVe,
                                      by= c("Carreau_ID", "annee"))


###### Type des acquéreurs-vendeurs #####
######## Gestion des données
# Données Acquéreurs
Grid1kmTypeAcq <- Grid1kmJoinBIEN %>%
  filter(!is.na(Nature_Acq)) %>%
  count(Carreau_ID, annee, Type_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Type_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_TYP_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid1kmTypeVe <- Grid1kmJoinBIEN %>%
  filter(!is.na(Nature_Ve)) %>%
  count(Carreau_ID, annee, Type_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Type_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_TYP_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

# Remise en format Sf
Grid1kmTypeAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmTypeAcq, by = "Carreau_ID")

Grid1kmTypeVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmTypeVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmTypeAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  vendeurs
ProfilsAcq <- unique(Grid1kmTypeAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid1kmTypeVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])

# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid1kmTypeAcq,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  


Gr1km_PotentialTypeAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       

## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid1kmTypeVe,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

Gr1km_PotentialTypeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr1km_PotentialType_ACVE  <- full_join(Gr1km_PotentialTypeAcq,
                                        Gr1km_PotentialTypeVe,
                                        by= c("Carreau_ID", "annee"))

##### Catégories socio-professionnelles des acquéreurs-vendeurs #####

# Uniquement sur population des personnes physiques 
##Gestion des données
# Données Acquéreurs
Grid1kmCSPAcq <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq == "PPH") %>%
  count(Carreau_ID, annee, CSP_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(CSP_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_CSP_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid1kmCSPVe <- Grid1kmJoinBIEN %>%
  filter(Nature_Ve == "PPH") %>%
  count(Carreau_ID, annee, CSP_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(CSP_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_CSP_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

# Remise en format Sf
Grid1kmCSPAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmCSPAcq, by = "Carreau_ID")

Grid1kmCSPVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmCSPVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmCSPAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  vendeurs
ProfilsAcq <- unique(Grid1kmCSPAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid1kmCSPVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])


# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid1kmCSPAcq,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr1km_PotentialCSPAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid1kmCSPVe,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

Gr1km_PotentialCSPVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr1km_PotentialCSPVe$Carreau_ID<-as.character(Gr1km_PotentialCSPVe$Carreau_ID)
Gr1km_PotentialCSP_ACVE  <- full_join(Gr1km_PotentialCSPAcq,
                                       Gr1km_PotentialCSPVe,
                                       by= c("Carreau_ID", "annee"))


# Jointure intermediaire pour les variables sociales 
Gr1km_PotentialCSP_Social  <- full_join(Gr1km_PotentialNat_ACVE,
                                         Gr1km_PotentialType_ACVE,
                                         by= c("Carreau_ID", "annee")) %>%
  full_join (., Gr1km_PotentialCSP_ACVE,  by= c("Carreau_ID", "annee"))

###### Sexe des acquéreurs-vendeurs ####

# Uniquement sur population des personnes physiques 
# Gestion des données
# Données Acquéreurs
Grid1kmSexeAcq <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq == "PPH"& !is.na(Sexe_Acq)) %>%
  count(Carreau_ID, annee, Sexe_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Sexe_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_SEX_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid1kmSexeVe <- Grid1kmJoinBIEN %>%
  filter(Nature_Ve == "PPH" & !is.na(Sexe_Ve)) %>%
  count(Carreau_ID, annee, Sexe_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Sexe_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_SEX_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmSexeAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmSexeAcq, by = "Carreau_ID")

Grid1kmSexeVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmSexeVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmSexeAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  vendeurs
ProfilsAcq <- unique(Grid1kmSexeAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid1kmSexeVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])


# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid1kmSexeAcq,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr1km_PotentialSexeAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid1kmSexeVe,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal") 

Gr1km_PotentialSexeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr1km_PotentialSexe_ACVE  <- full_join(Gr1km_PotentialSexeAcq,
                                        Gr1km_PotentialSexeVe,
                                        by= c("Carreau_ID", "annee"))


#######Age des acquéreurs-vendeurs #######

# Uniquement sur population des personnes physiques 
##### Première opération : age potentiel moyen des acquéreurs-vendeurs
######## Gestion des données
# Données Acquéreurs
Grid1kmAgeAcq <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq == "PPH" & !is.na(Age_Acq)) %>%
  group_by(Carreau_ID, annee) %>%
  summarise (NAcqTotal = length(which(!is.na(ID_new))),
             SumAge = sum(Age_Acq)) %>%
  rename_at(4:ncol(.), list( ~paste0("PrivIndivAcq_",.)))

# Données Vendeurs
Grid1kmAgeVe <- Grid1kmJoinBIEN %>%
  filter(Nature_Ve == "PPH" & !is.na(Age_Ve)) %>%
  group_by(Carreau_ID, annee) %>%
  summarise (NVeTotal = length(which(!is.na(ID_new))),
             SumAge = sum(Age_Ve)) %>%
  rename_at(4:ncol(.), list( ~paste0("PrivIndivVe_",.)))

# Remise en format Sf
Grid1kmAgeAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmAgeAcq, by = "Carreau_ID")

Grid1kmAgeVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmAgeVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmAgeAcq$annee)
annees <- sort(annees[!is.na(annees)])

##############################
# Calcul des potentiels pour les acquéreurs
FastPotentialsYears(datasf = Grid1kmAgeAcq,
                    DistSpan = 3000, 
                    Mask = FictifMarketSpaceGrid1km,
                    Years = annees,
                    Limit = 6000,
                    VarStock1 = "PrivIndivAcq_SumAge",
                    VarStock2 = "NAcqTotal") 

Gr1km_PotentialAgeAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_MEN_AGE_Moyen = Potential)


# Calcul des potentiels pour les vendeurs
FastPotentialsYears(datasf = Grid1kmAgeVe,
                    DistSpan = 3000, 
                    Mask = FictifMarketSpaceGrid1km,
                    Years = annees,
                    Limit = 6000,
                    VarStock1 = "PrivIndivVe_SumAge",
                    VarStock2 = "NVeTotal") 

Gr1km_PotentialAgeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_VE_MEN_AGE_Moyen = Potential)

# Jointure
Gr1km_PotentialAgeMoye_ACVE  <- full_join(Gr1km_PotentialAgeAcq,
                                           Gr1km_PotentialAgeVe,
                                           by= c("Carreau_ID", "annee"))

######Tranches d'âge ####
# Pourcentage par tranches d'âge. Ces tranches ont été uniquement établies pour la population active. 
######## Gestion des données ####
# Données Acquéreurs
Grid1kmTrancAgeAcq <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq== "PPH" & !is.na(Tranche_Age_Acq)) %>%
  count(Carreau_ID, annee, Tranche_Age_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Tranche_Age_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MOC_AGE_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

EffectifGrid1kmTrancAgeAcq <- sum(Grid1kmTrancAgeAcq$NAcq)

# Données Vendeurs
Grid1kmTrancAgeVe <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq== "PPH" & !is.na(Tranche_Age_Vendeur))%>%
  count(Carreau_ID, annee, Tranche_Age_Vendeur) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Tranche_Age_Vendeur, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MOC_AGE_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

EffectifGrid1kmTrancAgeVe <- sum(Grid1kmTrancAgeVe$NVe)

# Remise en format Sf
Grid1kmTrancAgeAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmTrancAgeAcq, by = "Carreau_ID")

Grid1kmTrancAgeVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmTrancAgeVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmTrancAgeAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  acquéreurs
ProfilsAcq <- unique(Grid1kmTrancAgeAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
ProfilsAcq <- ProfilsAcq[-c(4)] # On enelève la catégorie des NA
# List profil  vendeurs
ProfilsVe <- unique(Grid1kmTrancAgeVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])
ProfilsVe <-ProfilsVe[-c(4)] # On enelève la catégorie des NA

##############################
# Calcul des potentiels

## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid1kmTrancAgeAcq,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr1km_PotentialTrancAgeAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid1kmTrancAgeVe,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal") 

Gr1km_PotentialTrancAgeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr1km_PotentialTrancAge_ACVE  <- full_join(Gr1km_PotentialTrancAgeAcq,
                                            Gr1km_PotentialTrancAgeVe,
                                            by= c("Carreau_ID", "annee"))

# Jointure Age et tranche Age 

Gr1km_PotentialAge_ACVE  <- full_join(Gr1km_PotentialAgeMoye_ACVE,
                                       Gr1km_PotentialTrancAge_ACVE,
                                       by= c("Carreau_ID", "annee"))

###################### Situation Matrimoniale ##########################

# Pourcentage par situation matrimoniale, uniquement personnes physiques avec information sur la situation matrimoniale 

######## Gestion des données
# Données Acquéreurs
Grid1kmSitMatriAcq <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq== "PPH" & !is.na(SitMatri_Acq)) %>%
  count(Carreau_ID, annee, SitMatri_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(SitMatri_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("PrivIndivAcq_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

EffectifGrid1kmSitMatriAcq <- sum(Grid1kmSitMatriAcq$NAcq)

# Données Vendeurs
Grid1kmSitMatriVe <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq== "PPH" & !is.na(SitMatri_VE))%>%
  count(Carreau_ID, annee, SitMatri_VE) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(SitMatri_VE, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("PrivIndivVe_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

EffectifGrid1kmSitMatriVe <- sum(Grid1kmSitMatriVe$NVe)

# Remise en format Sf
Grid1kmSitMatriAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmSitMatriAcq, by = "Carreau_ID")

Grid1kmSitMatriVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmSitMatriVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmSitMatriAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  acquéreurs
ProfilsAcq <- unique(Grid1kmSitMatriAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid1kmSitMatriVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])

##############################
# Calcul des potentiels

## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid1kmSitMatriAcq,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr1km_PotentialSitMatriAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid1kmSitMatriVe,
                              DistSpan = 3000, 
                              Mask = FictifMarketSpaceGrid1km,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 6000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal") 

Gr1km_PotentialSitMatriVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr1km_PotentialSitMatri_ACVE  <- full_join(Gr1km_PotentialSitMatriAcq,
                                            Gr1km_PotentialSitMatriVe,
                                            by= c("Carreau_ID", "annee"))


####### Acquéreurs selon l'origine résidentielle########

 
######## Gestion des données
Grid1kmPortee <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq == "PPH", !is.na(Provenance_Acq))%>%
  count(Carreau_ID, annee, Provenance_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Provenance_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_ORIGIN_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmPortee <- left_join(FictifMarketSpaceGrid1km, Grid1kmPortee, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmPortee$annee)
annees <- sort(annees[!is.na(annees)])

# List profil 
ProfilsAcq <- unique(Grid1kmPortee$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)]) # On enlève la catégorie des NA

##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid1kmPortee,
                              Mask = FictifMarketSpaceGrid1km,
                              DistSpan = 3000, 
                              Categories = ProfilsAcq, 
                              Years = annees, Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  


Gr1km_PotentialPortee <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)

Grid1kmMarketScope <- Gr1km_PotentialPortee %>%
  left_join(FictifMarketSpaceGrid1km,., by= "Carreau_ID")


###################### Jointure finale et Export ################

Grid1kmAcqVe <- full_join (Gr1km_PotentialCSP_Social, 
                            Gr1km_PotentialAge_ACVE, 
                            by = c("Carreau_ID","annee")) %>%
  full_join (., Gr1km_PotentialSexe_ACVE, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr1km_PotentialSitMatri_ACVE, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Grid1kmMarketScope, 
             by = c("Carreau_ID","annee")) %>%
  left_join(FictifMarketSpaceGrid1km,., by = "Carreau_ID")

Script sur les carreaux 200m

# Jointure Spatiale
Grid200mJoinBIEN<- st_join(FictifMarketSpaceGrid200m, BIEN_BuyerSeller, join = st_contains, left=T)

# passage en dataframe
Grid200mJoinBIEN <- as.data.frame(Grid200mJoinBIEN) %>%
  select(-geom)

##################### Nature des acquéreurs-vendeurs #################

######## Gestion des données

# Données Acquéreurs
Grid200mNatAcq <- Grid200mJoinBIEN %>%
  filter(!is.na(Nature_Acq)) %>%
  count(Carreau_ID, annee, Nature_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Nature_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_NAT_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 


# Données Vendeurs
Grid200mNatVe <- Grid200mJoinBIEN %>%
  filter(!is.na(Nature_Ve)) %>%
  count(Carreau_ID, annee, Nature_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Nature_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_NAT_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

# Remise en format Sf
Grid200mNatAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mNatAcq, by = "Carreau_ID")

Grid200mNatVe <- left_join(FictifMarketSpaceGrid200m, Grid200mNatVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mNatAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  vendeurs
ProfilsAcq <- unique(Grid200mNatAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid200mNatVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])


# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid200mNatAcq,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr200m_PotentialNatAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       

## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid200mNatVe,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal") 

Gr200m_PotentialNatVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr200m_PotentialNat_ACVE  <- full_join(Gr200m_PotentialNatAcq,
                                       Gr200m_PotentialNatVe,
                                       by= c("Carreau_ID", "annee"))


######## Type des acquéreurs-vendeurs #######

#Gestion des données
# Données Acquéreurs
Grid200mTypeAcq <- Grid200mJoinBIEN %>%
  filter(!is.na(Nature_Acq)) %>%
  count(Carreau_ID, annee, Type_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Type_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_TYP_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid200mTypeVe <- Grid200mJoinBIEN %>%
  filter(!is.na(Nature_Ve)) %>%
  count(Carreau_ID, annee, Type_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Type_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_TYP_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

# Remise en format Sf
Grid200mTypeAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mTypeAcq, by = "Carreau_ID")

Grid200mTypeVe <- left_join(FictifMarketSpaceGrid200m, Grid200mTypeVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mTypeAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  vendeurs
ProfilsAcq <- unique(Grid200mTypeAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid200mTypeVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])

##############################
# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid200mTypeAcq,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr200m_PotentialTypeAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       

## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid200mTypeVe,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

Gr200m_PotentialTypeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr200m_PotentialType_ACVE  <- full_join(Gr200m_PotentialTypeAcq,
                                        Gr200m_PotentialTypeVe,
                                        by= c("Carreau_ID", "annee"))


####### Catégories socio-professionnelles des acquéreurs-vendeurs ######
# Uniquement sur population des personnes physiques 
# Gestion des données
# Données Acquéreurs
Grid200mCSPAcq <- Grid200mJoinBIEN %>%
  filter(Nature_Acq == "PPH") %>%
  count(Carreau_ID, annee, CSP_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(CSP_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_CSP_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid200mCSPVe <- Grid200mJoinBIEN %>%
  filter(Nature_Ve == "PPH") %>%
  count(Carreau_ID, annee, CSP_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(CSP_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_CSP_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

# Remise en format Sf
Grid200mCSPAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mCSPAcq, by = "Carreau_ID")

Grid200mCSPVe <- left_join(FictifMarketSpaceGrid200m, Grid200mCSPVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mCSPAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  vendeurs
ProfilsAcq <- unique(Grid200mCSPAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid200mCSPVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])

# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid200mCSPAcq,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr200m_PotentialCSPAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       

## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid200mCSPVe,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

Gr200m_PotentialCSPVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr200m_PotentialCSP_ACVE  <- full_join(Gr200m_PotentialCSPAcq,
                                       Gr200m_PotentialCSPVe,
                                       by= c("Carreau_ID", "annee"))

# Jointure intermediaire pour les variables sociales 
Gr200m_PotentialCSP_Social  <- full_join(Gr200m_PotentialNat_ACVE,
                                         Gr200m_PotentialType_ACVE,
                                         by= c("Carreau_ID", "annee")) %>%
  full_join (., Gr200m_PotentialCSP_ACVE,  by= c("Carreau_ID", "annee"))

###### Sexe des acquéreurs-vendeurs ######

# Uniquement sur population des personnes physiques 
# Gestion des données
# Données Acquéreurs
Grid200mSexeAcq <- Grid200mJoinBIEN %>%
  filter(Nature_Acq == "PPH"& !is.na(Sexe_Acq)) %>%
  count(Carreau_ID, annee, Sexe_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Sexe_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_SEX_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid200mSexeVe <- Grid200mJoinBIEN %>%
  filter(Nature_Ve == "PPH" & !is.na(Sexe_Ve)) %>%
  count(Carreau_ID, annee, Sexe_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Sexe_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_SEX_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

# Remise en format Sf
Grid200mSexeAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mSexeAcq, by = "Carreau_ID")

Grid200mSexeVe <- left_join(FictifMarketSpaceGrid200m, Grid200mSexeVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mSexeAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  vendeurs
ProfilsAcq <- unique(Grid200mSexeAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid200mSexeVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])

# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid200mSexeAcq,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr200m_PotentialSexeAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       

## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid200mSexeVe,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal") 

Gr200m_PotentialSexeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr200m_PotentialSexe_ACVE  <- full_join(Gr200m_PotentialSexeAcq,
                                        Gr200m_PotentialSexeVe,
                                        by= c("Carreau_ID", "annee"))


####### Age des acquéreurs-vendeurs #######
# Uniquement sur population des personnes physiques 
## Première opération : age potentiel moyen des acquéreurs-vendeurs
# Gestion des données
# Données Acquéreurs
Grid200mAgeAcq <- Grid200mJoinBIEN %>%
  filter(Nature_Acq == "PPH" & !is.na(Age_Acq)) %>%
  group_by(Carreau_ID, annee) %>%
  summarise (NAcqTotal = length(which(!is.na(ID_new))),
             SumAge = sum(Age_Acq)) %>%
  rename_at(4:ncol(.), list( ~paste0("PrivIndivAcq_",.)))

# Données Vendeurs
Grid200mAgeVe <- Grid200mJoinBIEN %>%
  filter(Nature_Ve == "PPH" & !is.na(Age_Ve)) %>%
  group_by(Carreau_ID, annee) %>%
  summarise (NVeTotal = length(which(!is.na(ID_new))),
             SumAge = sum(Age_Ve)) %>%
  rename_at(4:ncol(.), list( ~paste0("PrivIndivVe_",.)))

# Remise en format Sf
Grid200mAgeAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mAgeAcq, by = "Carreau_ID")

Grid200mAgeVe <- left_join(FictifMarketSpaceGrid200m, Grid200mAgeVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mAgeAcq$annee)
annees <- sort(annees[!is.na(annees)])

##############################
# Calcul des potentiels pour les acquéreurs
FastPotentialsYears(datasf = Grid200mAgeAcq,
                    DistSpan = 500, 
                    Mask = FictifMarketSpaceGrid200m,
                    Years = annees,
                    Limit = 1000,
                    VarStock1 = "PrivIndivAcq_SumAge",
                    VarStock2 = "NAcqTotal") 

Gr200m_PotentialAgeAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_MEN_AGE_Moyen = Potential)


# Calcul des potentiels pour les vendeurs
FastPotentialsYears(datasf = Grid200mAgeVe,
                    DistSpan = 500, 
                    Mask = FictifMarketSpaceGrid200m,
                    Years = annees,
                    Limit = 1000,
                    VarStock1 = "PrivIndivVe_SumAge",
                    VarStock2 = "NVeTotal") 

Gr200m_PotentialAgeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_VE_MEN_AGE_Moyen = Potential)

# Jointure
Gr200m_PotentialAgeMoye_ACVE  <- full_join(Gr200m_PotentialAgeAcq,
                                           Gr200m_PotentialAgeVe,
                                           by= c("Carreau_ID", "annee"))

######Tranches d'âge ####
# Pourcentage par tranches d'âge. Ces tranches ont été uniquement établies pour la population active. 
#Gestion des données
# Données Acquéreurs

Grid200mTrancAgeAcq <- Grid200mJoinBIEN %>%
  filter(Nature_Acq== "PPH" & !is.na(Tranche_Age_Acq)) %>%
  count(Carreau_ID, annee, Tranche_Age_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Tranche_Age_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MOC_AGE_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid200mTrancAgeVe <- Grid200mJoinBIEN %>%
  filter(Nature_Acq== "PPH" & !is.na(Tranche_Age_Vendeur))%>%
  count(Carreau_ID, annee, Tranche_Age_Vendeur) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Tranche_Age_Vendeur, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MOC_AGE_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid200mTrancAgeAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mTrancAgeAcq, by = "Carreau_ID")

Grid200mTrancAgeVe <- left_join(FictifMarketSpaceGrid200m, Grid200mTrancAgeVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mTrancAgeAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  acquéreurs
ProfilsAcq <- unique(Grid200mTrancAgeAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
ProfilsAcq <- ProfilsAcq[-c(4)] # On enelève la catégorie des NA
# List profil  vendeurs
ProfilsVe <- unique(Grid200mTrancAgeVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])
ProfilsVe <-ProfilsVe[-c(4)] # On enelève la catégorie des NA


# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid200mTrancAgeAcq,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr200m_PotentialTrancAgeAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid200mTrancAgeVe,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal") 

Gr200m_PotentialTrancAgeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr200m_PotentialTrancAge_ACVE  <- full_join(Gr200m_PotentialTrancAgeAcq,
                                            Gr200m_PotentialTrancAgeVe,
                                            by= c("Carreau_ID", "annee"))

# Jointure Age et tranche Age 
Gr200m_PotentialAge_ACVE  <- full_join(Gr200m_PotentialAgeMoye_ACVE,
                                       Gr200m_PotentialTrancAge_ACVE,
                                       by= c("Carreau_ID", "annee"))

###### Situation Matrimoniale ######

# Pourcentage par situation matrimoniale, uniquement personnes physiques avec information sur la situation matrimoniale 
## Gestion des données
# Données Acquéreurs
Grid200mSitMatriAcq <- Grid200mJoinBIEN %>%
  filter(Nature_Acq== "PPH" & !is.na(SitMatri_Acq)) %>%
  count(Carreau_ID, annee, SitMatri_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(SitMatri_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_MATRI_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid200mSitMatriVe <- Grid200mJoinBIEN %>%
  filter(Nature_Acq== "PPH" & !is.na(SitMatri_VE))%>%
  count(Carreau_ID, annee, SitMatri_VE) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(SitMatri_VE, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_MATRI_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid200mSitMatriAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mSitMatriAcq, by = "Carreau_ID")

Grid200mSitMatriVe <- left_join(FictifMarketSpaceGrid200m, Grid200mSitMatriVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mSitMatriAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil  acquéreurs
ProfilsAcq <- unique(Grid200mSitMatriAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])
# List profil  vendeurs
ProfilsVe <- unique(Grid200mSitMatriVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)])

# Calcul des potentiels
## Potentiels pour les Acquéreurs
FastPotentialsYearsAndProfils(datasf = Grid200mSitMatriAcq,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsAcq, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr200m_PotentialSitMatriAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


## Potentiels pour les Vendeurs
FastPotentialsYearsAndProfils(datasf = Grid200mSitMatriVe,
                              DistSpan = 500, 
                              Mask = FictifMarketSpaceGrid200m,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal") 

Gr200m_PotentialSitMatriVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 

# Jointure
Gr200m_PotentialSitMatri_ACVE  <- full_join(Gr200m_PotentialSitMatriAcq,
                                            Gr200m_PotentialSitMatriVe,
                                            by= c("Carreau_ID", "annee"))


####### Acquéreurs selon l'origine résidentielle, en pourcentage par commune et par année ########


######## Gestion des données
Grid200mPortee <- Grid200mJoinBIEN %>%
  filter(Nature_Acq == "PPH", !is.na(Provenance_Acq))%>%
  count(Carreau_ID, annee, Provenance_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Provenance_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_ORIGIN_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Remise en format Sf
Grid200mPortee <- left_join(FictifMarketSpaceGrid200m, Grid200mPortee, by = "Carreau_ID")

# List années
annees <- unique(Grid200mPortee$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsAcq <- unique(Grid200mPortee$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)]) # On enelève la catégorie des NA

##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid200mPortee,
                              Mask = FictifMarketSpaceGrid200m,
                              DistSpan = 500, 
                              Categories = ProfilsAcq, 
                              Years = annees, Limit = 1000, 
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  


Gr200m_PotentialPortee <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)



###### Jointure finale #########

Grid200mAcqVe <- full_join (Gr200m_PotentialCSP_Social, 
                            Gr200m_PotentialAge_ACVE, 
                            by = c("Carreau_ID","annee")) %>%
  full_join (., Gr200m_PotentialSexe_ACVE, 
             by = c("Carreau_ID","annee")) %>%
  full_join (., Gr200m_PotentialSitMatri_ACVE, 
             by = c("Carreau_ID","annee")) %>%
   full_join (., Gr200m_PotentialPortee, 
             by = c("Carreau_ID","annee")) %>%
  left_join(FictifMarketSpaceGrid200m,., by = "Carreau_ID")

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

Script sur les communes

# Jointure spatiale
ComJoinBIEN<- st_join(FictifCommunes, BIEN_PURCHMUT, join = st_contains, left=T)

ComJoinBIEN$VoronoiID <- as.character(ComJoinBIEN$VoronoiID)
# passage en dataframe
ComJoinBIEN <- as.data.frame(ComJoinBIEN) %>%
  select(-geom)

##### Durée de détention des biens ######

ComDurDetent_Ve<- ComJoinBIEN %>% 
  filter(Nature_Ve == "PPH"  & !is.na(Duree_Detention_Ve)) %>% 
  group_by(VoronoiID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            Moyen = mean (Duree_Detention_Ve, na.rm = T),
            Median = median (Duree_Detention_Ve, na.rm = T),
            EcartType = sd (Duree_Detention_Ve, na.rm = T)) %>%
  filter(NTotal >= 5) 

ComDurDetent_Ve <- ComDurDetent_Ve %>%
  select(-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.)))

####### Tranches de durée de détention du bien vendu ########

ComTranDurDetent_Ve <- ComJoinBIEN %>% 
  filter(Nature_Ve == "PPH" & !is.na(Tranche_DureeDetention_Ve)) %>%
  count(VoronoiID, annee, Tranche_DureeDetention_Ve) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTotal = sum(n)) %>%
  spread(Tranche_DureeDetention_Ve, n, fill = 0) %>% 
  filter(NTotal >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTotal)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.)))

ComTranDurDetent_Ve <- ComTranDurDetent_Ve %>%
  select(-NTotal)

######## Type de mutation des biens lors de l'acquisition du bien par le vendeur #########
# Vendeurs, en pourcentage par commune et par année avec information sur le type de mutation

ComTypeMutatPrec_Ve <- ComJoinBIEN %>% 
  filter(Nature_Ve == "PPH" & !is.na(TypMutPrec_VE)) %>%
  count(VoronoiID, annee, TypMutPrec_VE) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTotal = sum(n)) %>%
  spread(TypMutPrec_VE, n, fill = 0) %>% 
  filter(NTotal >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTotal)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_TYPMUT_",.)))

ComTypeMutatPrec_Ve <- ComTypeMutatPrec_Ve %>%
  select(-NTotal)

####### Présence de crédit à l'acquisition ##########

# Rappel : L'indicateur produit inique le pourcentage d'acquisition sans crédit
# Population : uniquement personnes physiques acquéreurs

ComPresCred_Acq <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & !is.na(PresCred_Acq)) %>%
  count(VoronoiID, annee, PresCred_Acq) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTotal = sum(n)) %>%
  spread(PresCred_Acq, n, fill = 0) %>% 
  filter(NTotal >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTotal)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_PRESCRED_",.)))

ComPresCred_Acq <- ComPresCred_Acq %>%
  select(-NTotal)

##########  Garantie du pret ##########
ComTypPret_Acq <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & !is.na(TypePret_Acq)) %>%
  count(VoronoiID, annee, TypePret_Acq) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTotal = sum(n)) %>%
  spread(TypePret_Acq, n, fill = 0) %>% 
  filter(NTotal >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTotal)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_TYPCRED_",.)))

ComTypPret_Acq <- ComTypPret_Acq %>%
  select(-NTotal)

##### Loan-to-value ##########
ComJoinBIEN$MTCRED <- as.numeric(ComJoinBIEN$MTCRED)

ComLTV_Acq <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & MTCRED>= 1000) %>% # On retire les credits insignifiants dans le calcul
  group_by(VoronoiID, annee) %>%
  summarise (NTotal = length(which(!is.na(ID_new))),
             LTV = (sum(MTCRED/ sum(REQ_PRIX)*100))) %>%
  filter(NTotal >= 5)  

ComLTV_Acq <- ComLTV_Acq %>%
  select(-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_",.)))


######### Montant du crédit #########

ComMtCred_Acq <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & MTCRED>= 1000) %>% # On retire les credits insignifiants dans le calcul
  group_by(VoronoiID, annee) %>%
  mutate (NTotal = length(which(!is.na(ID_new)))) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            Moyen = mean (MTCRED, na.rm = T),
            Median = median (MTCRED, na.rm = T),
            EcartType = sd (MTCRED, na.rm = T)) %>%
  filter(NTotal >= 5) 

ComMtCred_Acq <- ComMtCred_Acq %>%
  select(-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_MTCRED_",.)))


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

BIEN_PurchMut<- full_join (ComTranDurDetent_Ve, 
                              ComDurDetent_Ve, 
                              by = c("VoronoiID","annee")) %>%
  full_join (., ComTypeMutatPrec_Ve, 
             by = c("VoronoiID","annee")) %>%
  full_join (., ComLTV_Acq, 
             by = c("VoronoiID","annee")) %>%
  full_join (., ComMtCred_Acq, 
             by = c("VoronoiID","annee")) %>%
  full_join (., ComPresCred_Acq, 
             by = c("VoronoiID","annee")) %>%
  full_join (., ComTypPret_Acq, 
             by = c("VoronoiID","annee")) 

######################################

#### Variables à partir des données de la base PTZ #######

#### 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 #######
PTZ_PurchMut <- SamplePTZ_ReadyForOp %>%
  group_by(annee,VoronoiID)  %>%
  summarise(n_operation_PTZ= length(which(!is.na(VoronoiID))),
            # Nature du pret principal
            P_AC_MEN_TYPCRED_Libre=(length(which(Nature_PretPrincipal=="LIB"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPCRED_Conventionne =(length(which(Nature_PretPrincipal=="CONV"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPCRED_Autre =(length(which(Nature_PretPrincipal=="AUTR"))/n_operation_PTZ)*100,
            # Type de garantie du crédit
             P_AC_MEN_GARCRED_Hypothecaire  =(length(which(TypeGarantie=="HYPO"))/n_operation_PTZ)*100,
            P_AC_MEN_GARCRED_Caution =(length(which(TypeGarantie=="CAUT"))/n_operation_PTZ)*100,
            P_AC_MEN_GARCRED_N =(length(which(TypeGarantie=="N"))/n_operation_PTZ)*100,
            # Type d'opération
            P_AC_MEN_TYPOP_Neuf = (length(which(TypeOperationPTZ=="NEUF"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPOP_FoncierConstruction= (length(which(TypeOperationPTZ=="FON"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPOP_AncienRenovation= (length(which(TypeOperationPTZ=="REN"))/n_operation_PTZ)*100,
            # Montants prêts principaux
            P_AC_MEN_MTCREDPP_Moyenne= mean(vtpp),
            P_AC_MEN_MTCREDPP_Median = median(vtpp),
            P_AC_MEN_MTCREDPP_EcartType= sd(vtpp),
            # Montants tous prêts 
            P_AC_MEN_MTCREDPR_Moyenne= mean(vtpr),
            P_AC_MEN_MTCREDPR_Median = median(vtpr),
            P_AC_MEN_MTCREDPR_EcartType= sd(vtpr),
            # LTV 
            P_AC_MEN_LTV_Moyenne= mean((vtpr/vtto)*100),
            P_AC_MEN_LTV_Median = median((vtpr/vtto)*100),
            P_AC_MEN_LTV_EcartType= sd((vtpr/vtto)*100))%>%
  filter(n_operation_PTZ>=5 ) %>% # Condition à 5 transactions minimum
  select(-n_operation_PTZ)
###################### Jointure finale  ################

PTZ_PurchMut$VoronoiID<- as.character(PTZ_PurchMut$VoronoiID)

CommunesPurchMut<- full_join (as.data.frame(BIEN_PurchMut), 
                              as.data.frame(PTZ_PurchMut), 
                              by = c("VoronoiID","annee")) %>%
  left_join(FictifCommunes,as.data.frame(.), by= "VoronoiID")

Script sur les carreaux 1km

# Jointure Spatiale
Grid1kmJoinBIEN<- st_join(FictifMarketSpaceGrid1km, BIEN_PURCHMUT, join = st_contains, left=T)

# passage Detent en dataframe
Grid1kmJoinBIEN <- as.data.frame(Grid1kmJoinBIEN) %>%
  select(-geom)

##################### Durée de détention des biens #################


######## Gestion des données
Grid1kmDurDetent_Ve<- Grid1kmJoinBIEN %>% 
  filter(!is.na(Duree_Detention_Ve)) %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumDurDetent = sum (Duree_Detention_Ve, na.rm = T)) 

# Remise en format Sf

Grid1kmDurDetent_Ve <- left_join(FictifMarketSpaceGrid1km, Grid1kmDurDetent_Ve, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmDurDetent_Ve$annee)
annees <- sort(annees[!is.na(annees)])

##############################
# Calcul des potentiels 

FastPotentialsYears   (datasf = Grid1kmDurDetent_Ve,
                       Mask = FictifMarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumDurDetent",
                       VarStock2 = "NTotal")  


Gr1km_PotentialDurDetentVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_VE_MEN_DURDET_Moyen = Potential)

###### Tranche durée de détention des vendeurs

# Données Vendeurs

Grid1kmTrancDurDetentVe <- Grid1kmJoinBIEN %>%
  filter(!is.na(Tranche_DureeDetention_Ve))%>%
  count(Carreau_ID, annee, Tranche_DureeDetention_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Tranche_DureeDetention_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmTrancDurDetentVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmTrancDurDetentVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmTrancDurDetentVe$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsVe <- unique(Grid1kmTrancDurDetentVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)]) # On enelève la catégorie des NA

##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid1kmTrancDurDetentVe,
                              Mask = FictifMarketSpaceGrid1km,
                              DistSpan = 3000, 
                              Categories = ProfilsVe, 
                              Years = annees, Limit = 6000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

Gr1km_PotentialTrancDurDetentVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       

# Jointure entre données sur la durée de détention

Gr1km_PotentialDurDetentVe <- full_join(Gr1km_PotentialDurDetentVe,
                                        Gr1km_PotentialTrancDurDetentVe,
                                        by= c("Carreau_ID", "annee"))


####### Types de Mutation précédente du bien par les vendeurs ####

#### Gestion des données
# Données Vendeurs

Grid1kmTypMutPrecVe <- Grid1kmJoinBIEN %>%
  filter( !is.na(TypMutPrec_VE ))%>%
  count(Carreau_ID, annee, TypMutPrec_VE ) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(TypMutPrec_VE , n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_TYPMUT_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmTypMutPrecVe <- left_join(FictifMarketSpaceGrid1km, Grid1kmTypMutPrecVe, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmTypMutPrecVe$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsVe <- unique(Grid1kmTypMutPrecVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)]) # On enelève la catégorie des NA

####
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid1kmTypMutPrecVe,
                              Mask = FictifMarketSpaceGrid1km,
                              DistSpan = 3000, 
                              Categories = ProfilsVe, 
                              Years = annees, Limit = 6000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

Gr1km_PotentialTypMutPrecVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


########## Pourcentage Présence crédit et types de prêts des acquéreurs ##########


### Gestion des données 

# Données Acquéreurs
Grid1kmPresCredAcq <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq == "PPH"& !is.na(PresCred_Acq)) %>%
  count(Carreau_ID, annee, PresCred_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(PresCred_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_PRESCRED_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Remise en format Sf
Grid1kmPresCredAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmPresCredAcq, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmPresCredAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil 
ProfilsAcq <- unique(Grid1kmPresCredAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])


###
# Calcul des potentiels
## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid1kmPresCredAcq,
                              Mask = FictifMarketSpaceGrid1km,
                              DistSpan = 3000, 
                              Categories = ProfilsAcq, 
                              Years = annees, Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr1km_PotentialPresCredAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       

####

#### Types de garantis sur les prêts immobiliers

# Données Acquéreurs
Grid1kmTypePretAcq <- Grid1kmJoinBIEN %>%
  filter(Nature_Acq == "PPH"& !is.na(TypePret_Acq)) %>%
  count(Carreau_ID, annee, TypePret_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(TypePret_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_GARCRED_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmTypePretAcq <- left_join(FictifMarketSpaceGrid1km, Grid1kmTypePretAcq, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmTypePretAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil 
ProfilsAcq <- unique(Grid1kmTypePretAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])


##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid1kmTypePretAcq,
                              Mask = FictifMarketSpaceGrid1km,
                              DistSpan = 3000, 
                              Categories = ProfilsAcq, 
                              Years = annees, Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr1km_PotentialTypePretAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 


#### Montant du crédit et Loan-to-Value ######

###Montant du crédit

######## Gestion des données
Grid1kmJoinBIEN$MTCRED <- as.numeric(Grid1kmJoinBIEN$MTCRED)

Grid1kmMtCred_Acq<- Grid1kmJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & MTCRED >1000 ) %>% # On enlève les prêts insignifiants
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumMTCRED = sum (MTCRED, na.rm = T)) 

# Remise en format Sf

Grid1kmMtCred_Acq <- left_join(FictifMarketSpaceGrid1km, Grid1kmMtCred_Acq, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmMtCred_Acq$annee)
annees <- sort(annees[!is.na(annees)])

##############################
# Calcul des potentiels 

FastPotentialsYears   (datasf = Grid1kmMtCred_Acq,
                       Mask = FictifMarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumMTCRED",
                       VarStock2 = "NTotal")

Gr1km_PotentialMtCredMoyen <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_MEN_MTCRED_Moyen = Potential)


### Loan-to-Value

######## Gestion des données

Grid1kmLTV_Acq<- Grid1kmJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & MTCRED >1000 ) %>% # On enlève les prêts insignifiants
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrices = sum (REQ_PRIX, na.rm = T),
            SumMTCRED = sum (MTCRED, na.rm = T)) 

# Remise en format Sf

Grid1kmLTV_Acq <- left_join(FictifMarketSpaceGrid1km, Grid1kmLTV_Acq, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmLTV_Acq$annee)
annees <- sort(annees[!is.na(annees)])

##############################
# Calcul des potentiels 

FastPotentialsYears   (datasf = Grid1kmLTV_Acq,
                       Mask = FictifMarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumMTCRED",
                       VarStock2 = "SumPrices")

Gr1km_PotentialLTVMoyen <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_MEN_LTV = Potential)

## Jointure des tables sur le crédit 

Gr1km_PotentialCredit_Acq <- full_join(Gr1km_PotentialPresCredAcq, 
                                       Gr1km_PotentialTypePretAcq,
                                       by= c("Carreau_ID", "annee")) %>%
  full_join(.,
            Gr1km_PotentialMtCredMoyen,
            by= c("Carreau_ID", "annee")) %>%
  full_join(., Gr1km_PotentialLTVMoyen,
            by= c("Carreau_ID", "annee"))



##############  Jointure finale ##############

Grid1kmPurchMut <- full_join (Gr1km_PotentialDurDetentVe, 
                              Gr1km_PotentialCredit_Acq, 
                              by = c("Carreau_ID","annee")) %>%
  full_join (., Gr1km_PotentialTypMutPrecVe, 
             by = c("Carreau_ID","annee")) %>%
  left_join(FictifMarketSpaceGrid1km,., by = "Carreau_ID")

Script sur les carreaux 200m

# Jointure Spatiale
Grid200mJoinBIEN<- st_join(FictifMarketSpaceGrid200m, BIEN_PURCHMUT, join = st_contains, left=T)

# passage Detent en dataframe
Grid200mJoinBIEN <- as.data.frame(Grid200mJoinBIEN) %>%
  select(-geom)

##################### Durée de détention des biens #################


######## Gestion des données
Grid200mDurDetent_Ve<- Grid200mJoinBIEN %>% 
  filter(!is.na(Duree_Detention_Ve)) %>% 
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumDurDetent = sum (Duree_Detention_Ve, na.rm = T)) 

# Remise en format Sf

Grid200mDurDetent_Ve <- left_join(FictifMarketSpaceGrid200m, Grid200mDurDetent_Ve, by = "Carreau_ID")

# List années
annees <- unique(Grid200mDurDetent_Ve$annee)
annees <- sort(annees[!is.na(annees)])


# Calcul des potentiels 

FastPotentialsYears   (datasf = Grid200mDurDetent_Ve,
                       Mask = FictifMarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumDurDetent",
                       VarStock2 = "NTotal")  


Gr200m_PotentialDurDetentVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_VE_MEN_DURDET_Moyen = Potential)

###### Tranche durée de détention des vendeurs

# Données Vendeurs

Grid200mTrancDurDetentVe <- Grid200mJoinBIEN %>%
  filter(!is.na(Tranche_DureeDetention_Ve))%>%
  count(Carreau_ID, annee, Tranche_DureeDetention_Ve) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(Tranche_DureeDetention_Ve, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid200mTrancDurDetentVe <- left_join(FictifMarketSpaceGrid200m, Grid200mTrancDurDetentVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mTrancDurDetentVe$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsVe <- unique(Grid200mTrancDurDetentVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)]) # On enelève la catégorie des NA

# Calcul des potentiels
## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid200mTrancDurDetentVe,
                              Mask = FictifMarketSpaceGrid200m,
                              DistSpan = 500, 
                              Categories = ProfilsVe, 
                              Years = annees, Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

Gr200m_PotentialTrancDurDetentVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       

# Jointure entre données sur la durée de détention

Gr200m_PotentialDurDetentVe <- full_join(Gr200m_PotentialDurDetentVe,
                                        Gr200m_PotentialTrancDurDetentVe,
                                        by= c("Carreau_ID", "annee"))


####### Types de Mutation précédente du bien par les vendeurs ####

#### Gestion des données
# Données Vendeurs

Grid200mTypMutPrecVe <- Grid200mJoinBIEN %>%
  filter( !is.na(TypMutPrec_VE ))%>%
  count(Carreau_ID, annee, TypMutPrec_VE ) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NVeTotal = sum(n)) %>%
  spread(TypMutPrec_VE , n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_VE_MEN_TYPMUT_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid200mTypMutPrecVe <- left_join(FictifMarketSpaceGrid200m, Grid200mTypMutPrecVe, by = "Carreau_ID")

# List années
annees <- unique(Grid200mTypMutPrecVe$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsVe <- unique(Grid200mTypMutPrecVe$Profil)
ProfilsVe <- sort(ProfilsVe[!is.na(ProfilsVe)]) # On enelève la catégorie des NA

####
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid200mTypMutPrecVe,
                              Mask = FictifMarketSpaceGrid200m,
                              DistSpan = 500, 
                              Categories = ProfilsVe, 
                              Years = annees, Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

Gr200m_PotentialTypMutPrecVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


########## Pourcentage Présence crédit et types de prêts des acquéreurs ##########


### Gestion des données 

# Données Acquéreurs
Grid200mPresCredAcq <- Grid200mJoinBIEN %>%
  filter(Nature_Acq == "PPH"& !is.na(PresCred_Acq)) %>%
  count(Carreau_ID, annee, PresCred_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(PresCred_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_PRESCRED_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Remise en format Sf
Grid200mPresCredAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mPresCredAcq, by = "Carreau_ID")

# List années
annees <- unique(Grid200mPresCredAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil 
ProfilsAcq <- unique(Grid200mPresCredAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])


###
# Calcul des potentiels
## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid200mPresCredAcq,
                              Mask = FictifMarketSpaceGrid200m,
                              DistSpan = 500, 
                              Categories = ProfilsAcq, 
                              Years = annees, Limit = 1000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr200m_PotentialPresCredAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)       


#### Types de garantis sur les prêts immobiliers

# Données Acquéreurs
Grid200mTypePretAcq <- Grid200mJoinBIEN %>%
  filter(Nature_Acq == "PPH"& !is.na(TypePret_Acq)) %>%
  count(Carreau_ID, annee, TypePret_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(TypePret_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_MEN_GARCRED_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 


# Remise en format Sf
Grid200mTypePretAcq <- left_join(FictifMarketSpaceGrid200m, Grid200mTypePretAcq, by = "Carreau_ID")

# List années
annees <- unique(Grid200mTypePretAcq$annee)
annees <- sort(annees[!is.na(annees)])

# List profil 
ProfilsAcq <- unique(Grid200mTypePretAcq$Profil)
ProfilsAcq <- sort(ProfilsAcq[!is.na(ProfilsAcq)])


##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid200mTypePretAcq,
                              Mask = FictifMarketSpaceGrid200m,
                              DistSpan = 500, 
                              Categories = ProfilsAcq, 
                              Years = annees, Limit = 1000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  

Gr200m_PotentialTypePretAcq <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential) 


#### Montant du crédit et Loan-to-Value ######

###Montant du crédit

######## Gestion des données
Grid200mJoinBIEN$MTCRED <- as.numeric(Grid200mJoinBIEN$MTCRED)

Grid200mMtCred_Acq<- Grid200mJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & MTCRED >1000 ) %>% # On enlève les prêts insignifiants
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumMTCRED = sum (MTCRED, na.rm = T)) 

# Remise en format Sf

Grid200mMtCred_Acq <- left_join(FictifMarketSpaceGrid200m, Grid200mMtCred_Acq, by = "Carreau_ID")

# List années
annees <- unique(Grid200mMtCred_Acq$annee)
annees <- sort(annees[!is.na(annees)])

##############################
# Calcul des potentiels 

FastPotentialsYears   (datasf = Grid200mMtCred_Acq,
                       Mask = FictifMarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumMTCRED",
                       VarStock2 = "NTotal")

Gr200m_PotentialMtCredMoyen <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_MEN_MTCRED_Moyen = Potential)


### Loan-to-Value

######## Gestion des données

Grid200mLTV_Acq<- Grid200mJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & MTCRED >1000 ) %>% # On enlève les prêts insignifiants
  group_by(Carreau_ID, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            SumPrices = sum (REQ_PRIX, na.rm = T),
            SumMTCRED = sum (MTCRED, na.rm = T)) 

# Remise en format Sf

Grid200mLTV_Acq <- left_join(FictifMarketSpaceGrid200m, Grid200mLTV_Acq, by = "Carreau_ID")

# List années
annees <- unique(Grid200mLTV_Acq$annee)
annees <- sort(annees[!is.na(annees)])

##############################
# Calcul des potentiels 

FastPotentialsYears   (datasf = Grid200mLTV_Acq,
                       Mask = FictifMarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumMTCRED",
                       VarStock2 = "SumPrices")

Gr200m_PotentialLTVMoyen <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_MEN_LTV = Potential)

## Jointure des tables sur le crédit 

Gr200m_PotentialCredit_Acq <- full_join(Gr200m_PotentialPresCredAcq, 
                                       Gr200m_PotentialTypePretAcq,
                                       by= c("Carreau_ID", "annee")) %>%
  full_join(.,
            Gr200m_PotentialMtCredMoyen,
            by= c("Carreau_ID", "annee")) %>%
  full_join(., Gr200m_PotentialLTVMoyen,
            by= c("Carreau_ID", "annee"))



##############  Jointure finale ##############

Grid200mPurchMut <- full_join (Gr200m_PotentialDurDetentVe, 
                              Gr200m_PotentialCredit_Acq, 
                              by = c("Carreau_ID","annee")) %>%
  full_join (., Gr200m_PotentialTypMutPrecVe, 
             by = c("Carreau_ID","annee")) %>%
  left_join(FictifMarketSpaceGrid200m,., by = "Carreau_ID")

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

Script sur les communes

# Jointure spatiale
ComJoinBIEN<- st_join(FictifCommunes, BIEN_HousingTypes, join = st_contains, left=T)

# passage en dataframe
ComJoinBIEN <- as.data.frame(ComJoinBIEN) %>%
  select(-geom)


####### Types de biens par taille du bien en nombre de pièces, en pourcentage par commune et par année ########

ComTypBien <- ComJoinBIEN %>% 
  filter(!is.na(TypBien)) %>%
  count(VoronoiID, annee, TypBien) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTotal = sum(n)) %>%
  spread(TypBien, n, fill = 0) %>% 
  filter(NTotal >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTotal)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_IMMO_TYP_",.)))

ComTypBien <- ComTypBien %>%
  select(-NTotal)

####### Types de biens par catégorie d'ancienneté et époque de construction du bien, en pourcentage par commune et par année ########


ComAncBien <- ComJoinBIEN %>% 
  filter(!is.na(Anciennete)) %>%
  count(VoronoiID, annee, Anciennete) %>%
  group_by(VoronoiID, annee) %>%
  mutate( NTotal = sum(n)) %>%
  spread(Anciennete, n, fill = 0) %>% 
  filter(NTotal >= 5)  %>%
  mutate_at(4:ncol(.), funs((./NTotal)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_IMMO_ANC_",.)))

ComAncBien <- ComAncBien %>%
  select(-NTotal)


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

FictifCommunesHousingTypes_BIEN<- full_join (ComTypBien, 
                                  ComAncBien, 
                                  by = c("VoronoiID","annee")) 


######################################

#### Variables à partir des données de la base PTZ #######

# Nature des biens, en pourcentage par commune et par année
ComNatBiens_PTZ <- SamplePTZ_ReadyForOp %>% 
              filter(!is.na(Nature_Bien)) %>%
              count(VoronoiID, annee, Nature_Bien) %>%
              group_by(VoronoiID, 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 <- SamplePTZ_ReadyForOp %>% 
              filter(!is.na(TypBien)) %>%
              count(VoronoiID, annee, TypBien) %>%
              group_by(VoronoiID, 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  ################

FictifCommunesHousingTypes_PTZ<- full_join (ComNatBiens_PTZ, 
                                  ComTypBiens_PTZ, 
                                  by = c("VoronoiID","annee")) 

FictifCommunesHousingTypes_PTZ$VoronoiID<-as.character(FictifCommunesHousingTypes_PTZ$VoronoiID)
###################### Jointure finale  ################

FictifCommunesHousingTypes<- full_join (FictifCommunesHousingTypes_BIEN, 
                                  FictifCommunesHousingTypes_PTZ, 
                                  by = c("VoronoiID","annee")) %>%
  left_join(FictifCommunes,., by= "VoronoiID")

Script sur les carreaux 1km

# Jointure Spatiale
Grid1kmJoinBIEN<- st_join(FictifMarketSpaceGrid1km, BIEN_HousingTypes, join = st_contains, left=T)

# passage Detent en dataframe
Grid1kmJoinBIEN <- as.data.frame(Grid1kmJoinBIEN) %>%
  select(-geom)


####### Types de biens par taille du bien en nombre de pièces, en pourcentage par commune et par année ########

######## Gestion des données
Grid1kmTypBien <- Grid1kmJoinBIEN %>%
  filter(!is.na(TypBien))%>%
  count(Carreau_ID, annee, TypBien) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NBiensTotal = sum(n)) %>%
  spread(TypBien, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_IMMO_TYP_",.))) %>%
  gather(key = "Profil", value="NBiens", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmTypBien <- left_join(FictifMarketSpaceGrid1km, Grid1kmTypBien, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmTypBien$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsBiens <- unique(Grid1kmTypBien$Profil)
ProfilsBiens <- sort(ProfilsBiens[!is.na(ProfilsBiens)]) # On enelève la catégorie des NA

##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid1kmTypBien,
                              Mask = FictifMarketSpaceGrid1km,
                              DistSpan = 3000, 
                              Categories = ProfilsBiens, 
                              Years = annees, Limit = 6000, 
                              VarStock1 = "NBiens",
                              VarStock2 = "NBiensTotal")  


Gr1km_PotentialTypBien <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)


########## Types de biens par catégorie d'ancienneté et époque de construction du bien #####

######## Gestion des données
Grid1kmAnc <- Grid1kmJoinBIEN %>%
  filter(!is.na(Anciennete))%>%
  count(Carreau_ID, annee, Anciennete) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NBiensTotal = sum(n)) %>%
  spread(Anciennete, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_IMMO_ANC_",.))) %>%
  gather(key = "Profil", value="NBiens", c(4:ncol(.))) 

EffectifGrid1kmAnc <- sum(Grid1kmAnc$NBiens)

# Remise en format Sf
Grid1kmAnc <- left_join(FictifMarketSpaceGrid1km, Grid1kmAnc, by = "Carreau_ID")

# List années
annees <- unique(Grid1kmAnc$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsBiens <- unique(Grid1kmAnc$Profil)
ProfilsBiens <- sort(ProfilsBiens[!is.na(ProfilsBiens)]) # On enelève la catégorie des NA

##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid1kmAnc,
                              Mask = FictifMarketSpaceGrid1km,
                              DistSpan = 3000, 
                              Categories = ProfilsBiens, 
                              Years = annees, Limit = 6000, 
                              VarStock1 = "NBiens",
                              VarStock2 = "NBiensTotal")  


Gr1km_PotentialAnc <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)

###################### Jointure finale ################

Grid1kmHousingTypes<- full_join (Gr1km_PotentialTypBien, 
                                 Gr1km_PotentialAnc, 
                                 by = c("Carreau_ID","annee")) %>%
  left_join(FictifMarketSpaceGrid1km,., by = "Carreau_ID")

Script sur les carreaux 200m

# Jointure Spatiale
Grid200mJoinBIEN<- st_join(FictifMarketSpaceGrid200m, BIEN_HousingTypes, join = st_contains, left=T)

# passage Detent en dataframe
Grid200mJoinBIEN <- as.data.frame(Grid200mJoinBIEN) %>%
  select(-geom)


####### Types de biens par taille du bien en nombre de pièces, en pourcentage par commune et par année ########

######## Gestion des données
Grid200mTypBien <- Grid200mJoinBIEN %>%
  filter(!is.na(TypBien))%>%
  count(Carreau_ID, annee, TypBien) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NBiensTotal = sum(n)) %>%
  spread(TypBien, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_IMMO_TYP_",.))) %>%
  gather(key = "Profil", value="NBiens", c(4:ncol(.))) 

EffectifGrid200mTypBien <- sum(Grid200mTypBien$NBiens)

# Remise en format Sf
Grid200mTypBien <- left_join(FictifMarketSpaceGrid200m, Grid200mTypBien, by = "Carreau_ID")

# List années
annees <- unique(Grid200mTypBien$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsBiens <- unique(Grid200mTypBien$Profil)
ProfilsBiens <- sort(ProfilsBiens[!is.na(ProfilsBiens)]) # On enelève la catégorie des NA

##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid200mTypBien,
                              Mask = FictifMarketSpaceGrid200m,
                              DistSpan = 500, 
                              Categories = ProfilsBiens, 
                              Years = annees,  Limit = 1000,
                              VarStock1 = "NBiens",
                              VarStock2 = "NBiensTotal")  

Gr200m_PotentialTypBien <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)


########## Types de biens par catégorie d'ancienneté et époque de construction du bien #####

######## Gestion des données
Grid200mAnc <- Grid200mJoinBIEN %>%
  filter(!is.na(Anciennete))%>%
  count(Carreau_ID, annee, Anciennete) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NBiensTotal = sum(n)) %>%
  spread(Anciennete, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_IMMO_ANC_",.))) %>%
  gather(key = "Profil", value="NBiens", c(4:ncol(.))) 

EffectifGrid200mAnc <- sum(Grid200mAnc$NBiens)

# Remise en format Sf
Grid200mAnc <- left_join(FictifMarketSpaceGrid200m, Grid200mAnc, by = "Carreau_ID")

# List années
annees <- unique(Grid200mAnc$annee)
annees <- sort(annees[!is.na(annees)])

# List profil tranche durée détention vendeurs
ProfilsBiens <- unique(Grid200mAnc$Profil)
ProfilsBiens <- sort(ProfilsBiens[!is.na(ProfilsBiens)]) # On enelève la catégorie des NA

##############################
# Calcul des potentiels

## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid200mAnc,
                              Mask = FictifMarketSpaceGrid200m,
                              DistSpan = 500, 
                              Categories = ProfilsBiens, 
                              Years = annees,  Limit = 1000,
                              VarStock1 = "NBiens",
                              VarStock2 = "NBiensTotal")  


Gr200m_PotentialAnc <- Resultat %>%
  filter(!is.na(Potential))%>%
  spread(Profil, Potential)

###################### Jointure finale ################

Grid200mHousingTypes<- full_join (Gr200m_PotentialTypBien, 
                                  Gr200m_PotentialAnc, 
                                  by = c("Carreau_ID","annee")) 

Finalisation des données spatiales

# Jointure des données sur les communes 

FictifCommunesPrices<- as.data.frame(CommunesPrices) %>%
  select (-geom)
 FictifCommunesAcqVe<- as.data.frame(CommunesAcqVE) #%>%
 #select (-geom)
FictifCommunesHousingTypes<- as.data.frame(CommunesHousingTypes) %>%
  select (-geom)
FictifCommunesPurchMut <- as.data.frame(CommunesPurchMut) %>%
  select (-geom)

FictifCASSMIR_SpatialDataBase_Communes <- full_join (FictifCommunesPrices,
                                      FictifCommunesAcqVe,
                                      by = c("VoronoiID","annee")) %>%
 full_join (.,
FictifCommunesPurchMut,  
by = c("VoronoiID","annee"))%>%
 full_join (.,
 FictifCommunesHousingTypes,  
by = c("VoronoiID","annee"))%>%
left_join(FictifCommunes, ., by = "VoronoiID")

# Jointure des données sur les carreaux 1km 

Grid1kmPrices<- as.data.frame(Grid1kmPrices) %>%
  select (-geom)
Grid1kmAcqVe<- as.data.frame(Grid1kmAcqVe) %>%
  select (-geom)
Grid1kmHousingTypes<- as.data.frame(Grid1kmHousingTypes) %>%
  select (-geom)
Grid1kmMarketScope<- as.data.frame(Grid1kmMarketScope) %>%
  select (-geom)
Grid1kmPurchMut <- as.data.frame(Grid1kmPurchMut) %>%
  select (-geom)


FictifCASSMIR_SpatialDataBase_Grid1km <- full_join (Grid1kmPrices,
                                      Grid1kmAcqVe,
                                      by = c("Carreau_ID","annee"))%>%
 full_join (.,
Grid1kmPurchMut,  
by = c("Carreau_ID","annee"))%>%
 full_join (.,
Grid1kmHousingTypes,  
by = c("Carreau_ID","annee"))%>%
left_join(FictifMarketSpaceGrid1km, ., by = "Carreau_ID")


# Jointure des données sur les carreaux 200m 

Grid200mPrices<- as.data.frame(Grid200mPrices) %>%
  select (-geom)
Grid200mAcqVe<- as.data.frame(Grid200mAcqVe) %>%
  select (-geom)
Grid200mHousingTypes<- as.data.frame(Grid200mHousingTypes) %>%
  select (-geom)
Grid200mPurchMut <- as.data.frame(Grid200mPurchMut) %>%
  select (-geom)


FictifCASSMIR_SpatialDataBase_Grid200m <- full_join (Grid200mPrices,
                                      Grid200mAcqVe,
                                      by = c("Carreau_ID","annee"))%>%
 full_join (.,
Grid200mPurchMut,  
by = c("Carreau_ID","annee"))%>%
 full_join (.,
Grid200mHousingTypes,  
by = c("Carreau_ID","annee"))%>%
left_join(FictifMarketSpaceGrid200m, ., by = "Carreau_ID")

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

Explication des traitements pour l’agrégation des données

Le principe de la production de la base des groupes de population est d’apparier les données des deux bases d’origine, sélectionnées à partir des quatre grands champs d’investigation proposés dans ce travail, en prenant en référence les trois groupes de population : selon un critère social (par Catégories Socio- Professionnelles), générationnel (par tranches d’âge) et genré (par sexe). Ces groupes sont déclinés selon la situtation sociale des individus sur le marché, c’est à dire soient comme acquéreurs, soient comme vendeurs. La référence géographique est régionale. La segmentation temporelle des données reste annuelle. Au sein de ces trois groupes, chaque catégorie définie est caractérisée par les indicateurs du marché, permettant d’analyser anuellement leurs pofils sur le marché immobilier.

Deux séries d’indicateurs supplémentaires s’ajoutent à ceux utilisés pour construire la base spatiale.La première série d’indicateurs supplémentaires entre dans le champ d’investigation des acquéreurs-vendeurs. Il s’agit notamment d’identifier les relations acquéreurs-vendeurs, c’est à dire : qui vend à qui et qui achète à qui ? Pour ce faire, des couples d’acquéreurs-vendeurs ; vendeurs-acquéreurs sont établis et les relations sont dénombrées pour chaque catégorie d’entrée et pour chaque année. La seconde série d’indicateurs supplémentaires entre dans le champ d’investigation des régimes d’achat et des types de mutation du bien. Il s’agit ici de préciser les modalités d’emprunt et certaines caractéristiques des ménages disponibles dans la base de données PTZ. Ces informations sont uniquement agrégées pour les groupes de population par CSP et par tranches d’âge. Ces informations offrent notamment la possibilité d’estimer la capacité d’achat des ménages en tenant compte de l’évolution des conditions du crédit.

La base BIEN permet de caractériser à la fois les acquéreurs et les vendeurs de chaque groupe, quant à la base PTZ elle permet uniquement de caractériser les acquéreurs (ayant recours à un emprunt avec ptz pour leur opération immobilière) pour le groupe “social” et “générationnel” (pas d’information sur le genre disponible dans la base PTZ).

Chaque indicateur concerne au minimum une population de vingt individus, pour chaque groupe et chaque année.

Pour les variables quantitatives continues, aux mesure de distribution précédents (moyenne, médiane, écart type), s’joutent des mesures sur les premiers et troisième quartile. Par ailleurs, deux séries d’indicateurs supplémentaires s’ajoutent à ceux utilisés pour construire la base spatiale. La première série d’indicateurs supplémentaires entre dans le champ d’investigation des acquéreurs-vendeurs. Il s’agit notamment d’identifier les relations acquéreurs-vendeurs, c’est à dire : qui vend à qui et qui achète à qui ? Pour ce faire, des couples d’acquéreurs-vendeurs ; vendeurs-acquéreurs sont établis et les relations sont dénombrées pour chaque catégorie d’entrée et pour chaque année. La seconde série d’indicateurs supplémentaires entre dans le champ d’investigation des régimes d’achat et des types de mutation du bien. Il s’agit ici de préciser les modalités d’emprunt et certaines caractéristiques des ménages disponibles dans la base de données PTZ. Ces informations sont uniquement agrégées pour les groupes de population par CSP et par tranches d’âge.

Préparation des données sur les prix

####### Prix Nominaux pour l'ensemble des maisons et appartements ########

# Acquéreurs
PricesAllAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX)) %>%
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

# Vendeurs
PricesAllVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX)) %>%
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

####### Prix Nominaux pour l'ensemble des maisons ########


# Acquéreurs
PricesHousesAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>% 
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI_",.))) 

#Vendeurs
PricesHousesVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>%
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI_",.))) 

####### Prix Nominaux pour l'ensemble des Appartements ########


# Acquéreurs
PricesAppartAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP_",.))) 

#Vendeurs
PricesAppartVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP_",.))) 

####### Prix au m² pour l'ensemble des Appartements ########

# Acquéreurs
PM2AppartAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise( NTotal = length(which(!is.na(Acquereurs))),
             Moyen = mean(REQ_PM2),
             Q1 = quantile(REQ_PM2,0.25),
             Median = quantile(REQ_PM2,0.5),
             Q3 = quantile(REQ_PM2,0.75),
             EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_APP_",.))) 

#Vendeurs
PM2AppartVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_APP_",.))) 

###### Prix nominaux par types de biens détaillés#####

# Acquéreurs
PricesTypBienAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PX_", TypBien, Mesure, sep="_") %>%
  spread(B_PX_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 


#Vendeurs
PricesTypBienVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX))  %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PX_", TypBien, Mesure, sep="_") %>%
  spread(B_PX_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 


###### Prix au m² par types de biens quand appartement #####


# Acquéreurs
PM2TypAppartAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PM_", TypBien, Mesure, sep="_") %>%
  spread(B_PM_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 


#Vendeurs
PM2TypAppartVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2))  %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PM_", TypBien, Mesure, sep="_") %>%
  spread(B_PM_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 

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

# Acquéreurs
PricesAcq_Social <-  left_join(PricesAllAcq_Social,
                               PricesHousesAcq_Social,
                               by = c("Acquereurs", "annee")) %>%
  left_join(., PricesAppartAcq_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., PM2AppartAcq_Social,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., PricesTypBienAcq_Social,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., PM2TypAppartAcq_Social,
            by = c("Acquereurs", "annee"))  

# Vendeurs
PricesVe_Social <-  left_join(PricesAllVe_Social,
                              PricesHousesVe_Social,
                              by = c("Vendeurs", "annee")) %>%
  left_join(., PricesAppartVe_Social,
            by = c("Vendeurs", "annee")) %>%
  left_join(., PM2AppartVe_Social,
            by = c("Vendeurs", "annee"))  %>%
  left_join(., PricesTypBienVe_Social,
            by = c("Vendeurs", "annee"))  %>%
  left_join(., PM2TypAppartVe_Social,
            by = c("Vendeurs", "annee")) 

#### Groupe génération #### 

####### Prix Nominaux pour l'ensemble des maisons et appartements ########

# Acquéreurs
PricesAllAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX)) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

# Vendeurs
PricesAllVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

####### Prix Nominaux pour l'ensemble des maisons ########


# Acquéreurs
PricesHousesAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", 
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI",.))) 

#Vendeurs
PricesHousesVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",    
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI",.))) 

####### Prix Nominaux pour l'ensemble des Appartements ########


# Acquéreurs
PricesAppartAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",    
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP",.))) 

#Vendeurs
PricesAppartVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",   
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP",.))) 

####### Prix au m² pour l'ensemble des Appartements ########

# Acquéreurs
PM2AppartAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",  
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise( NTotal = length(which(!is.na(Acquereurs))),
             Moyen = mean(REQ_PM2),
             Q1 = quantile(REQ_PM2,0.25),
             Median = quantile(REQ_PM2,0.5),
             Q3 = quantile(REQ_PM2,0.75),
             EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 

#Vendeurs
PM2AppartVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",   
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 

###### Prix nominaux par types de biens détaillés#####

# Acquéreurs
PricesTypBienAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",     
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PX_", TypBien, Mesure, sep="_") %>%
  spread(B_PX_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 


#Vendeurs
PricesTypBienVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",  
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX))  %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PX_", TypBien, Mesure, sep="_") %>%
  spread(B_PX_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 


###### Prix au m² par types de biens quand appartement #####


# Acquéreurs
PM2TypAppartAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",     
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PM_", TypBien, Mesure, sep="_") %>%
  spread(B_PM_, 4)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.)))


#Vendeurs
PM2TypAppartVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7", 
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2))  %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PM_", TypBien, Mesure, sep="_") %>%
  spread(B_PM_, 4)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.)))

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

# Acquéreurs
PricesAcq_Generation <-  left_join(PricesAllAcq_Generation,
                                   PricesHousesAcq_Generation,
                                   by = c("Acquereurs", "annee")) %>%
  left_join(., PricesAppartAcq_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., PM2AppartAcq_Generation,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., PricesTypBienAcq_Generation,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., PM2TypAppartAcq_Generation,
            by = c("Acquereurs", "annee"))  

# Vendeurs

PricesVe_Generation <-  left_join(PricesAllVe_Generation,
                                  PricesHousesVe_Generation,
                                  by = c("Vendeurs", "annee")) %>%
  left_join(., PricesAppartVe_Generation,
            by = c("Vendeurs", "annee")) %>%
  left_join(., PM2AppartVe_Generation,
            by = c("Vendeurs", "annee"))  %>%
  left_join(., PricesTypBienVe_Generation,
            by = c("Vendeurs", "annee"))  %>%
  left_join(., PM2TypAppartVe_Generation,
            by = c("Vendeurs", "annee"))  


####### Prix Nominaux pour l'ensemble des maisons et appartements ########

# Acquéreurs
PricesAllAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX)) %>%
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

# Vendeurs
PricesAllVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX)) %>%
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

####### Prix Nominaux pour l'ensemble des maisons ########


# Acquéreurs
PricesHousesAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>% 
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI",.))) 

#Vendeurs
PricesHousesVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>%
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI",.))) 

####### Prix Nominaux pour l'ensemble des Appartements ########


# Acquéreurs
PricesAppartAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP",.))) 

#Vendeurs
PricesAppartVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP",.))) 

####### Prix au m² pour l'ensemble des Appartements ########

# Acquéreurs
PM2AppartAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise( NTotal = length(which(!is.na(Acquereurs))),
             Moyen = mean(REQ_PM2),
             Q1 = quantile(REQ_PM2,0.25),
             Median = quantile(REQ_PM2,0.5),
             Q3 = quantile(REQ_PM2,0.75),
             EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 

#Vendeurs
PM2AppartVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 

###### Prix nominaux par types de biens détaillés#####

# Acquéreurs
PricesTypBienAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PX_", TypBien, Mesure, sep="_") %>%
  spread(B_PX_, 4)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.)))


#Vendeurs
PricesTypBienVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Median = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            EcartType = sd(REQ_PRIX))  %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PX_", TypBien, Mesure, sep="_") %>%
  spread(B_PX_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.)))


###### Prix au m² par types de biens quand appartement #####


# Acquéreurs
PM2TypAppartAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PM_", TypBien, Mesure, sep="_") %>%
  spread(B_PM_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.)))


#Vendeurs
PM2TypAppartVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Median = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            EcartType = sd(REQ_PM2))  %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "B_PM_", TypBien, Mesure, sep="_") %>%
  spread(B_PM_, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.)))

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

# Acquéreurs
PricesAcq_Sexe <-  left_join(PricesAllAcq_Sexe,
                             PricesHousesAcq_Sexe,
                             by = c("Acquereurs", "annee")) %>%
  left_join(., PricesAppartAcq_Sexe,
            by = c("Acquereurs", "annee")) %>%
  left_join(., PM2AppartAcq_Sexe,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., PricesTypBienAcq_Sexe,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., PM2TypAppartAcq_Sexe,
            by = c("Acquereurs", "annee"))  

# Vendeurs

PricesVe_Sexe <-  left_join(PricesAllVe_Sexe,
                            PricesHousesVe_Sexe,
                            by = c("Vendeurs", "annee")) %>%
  left_join(., PricesAppartVe_Sexe,
            by = c("Vendeurs", "annee")) %>%
  left_join(., PM2AppartVe_Sexe,
            by = c("Vendeurs", "annee"))  %>%
  left_join(., PricesTypBienVe_Sexe,
            by = c("Vendeurs", "annee"))  %>%
  left_join(., PM2TypAppartVe_Sexe,
            by = c("Vendeurs", "annee"))  

#### Appariement des Prix avec données PTZ ####

### Groupe pop par CSP ###
PricesPTZ_Social <-  SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(vtto),
            Q1 = quantile(vtto,0.25),
            Median = quantile(vtto,0.5),
            Q3 = quantile(vtto,0.75),
            EcartType = sd(vtto)) %>%
  rename_at(3:ncol(.), list( ~paste0("P_PX_",.))) 

# Jointure

PricesAcq_Social <-  left_join(PricesAcq_Social,
                                   PricesPTZ_Social,
                                   by = c("Acquereurs", "annee"))

### Groupe pop par Generation ###

PricesPTZ_Generation <-  SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%  
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(vtto),
            Q1 = quantile(vtto,0.25),
            Median = quantile(vtto,0.5),
            Q3 = quantile(vtto,0.75),
            EcartType = sd(vtto)) %>%
  rename_at(3:ncol(.), list( ~paste0("P_PX_",.))) 

# Jointure

PricesAcq_Generation <-  left_join(PricesAcq_Generation,
                                   PricesPTZ_Generation,
                                   by = c("Acquereurs", "annee"))

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

#### Informations principales sur les acquéreurs ####

BuyersN <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  count(Acquereurs, annee, name = "B_AC_TOT", .drop = T)

BuyersCSP_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(Sexe_Acq)) %>%
  group_by(CSP_Acq, annee) %>%
  count(Sexe_Acq, .drop = T) %>%
  spread(Sexe_Acq, n)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_SEX_",.))) 


BuyersCSP_TrancheAge <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(Tranche_Age_Acq)) %>%
  group_by(CSP_Acq, annee) %>%
  count(Tranche_Age_Acq, .drop = T) %>%
  spread(Tranche_Age_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MOC_AGE_",.))) 

BuyersCSP_Age <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(Age_Acq)) %>%
  group_by(CSP_Acq, annee) %>%
  summarise(Moyen = mean(Age_Acq),
            Q1 = quantile(Age_Acq, 0.25),
            Median = quantile(Age_Acq, 0.5),
            Q3 = quantile(Age_Acq, 0.75),
            EcartType = sd(Age_Acq)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_AGE",.))) 

BuyersCSP_SitMatri <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(SitMatri_Acq)) %>%
  group_by(CSP_Acq, annee) %>%
  count(SitMatri_Acq, .drop = T) %>%
  spread(SitMatri_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_MATRI_",.)))

# Relations d'achats-ventes CSP
BuyersCSP_AcheteA <- SampleBIEN_ReadyForOp %>%  
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Acquereurs, annee ) %>%
  count(Vendeurs, .drop = T) %>%
  spread(Vendeurs, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_ACHA_",.)))

# Acquéreurs selon l'origine résidentielle

Portee_Social <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = CSP_Acq) %>%
  filter(!is.na(Acquereurs), !is.na(Provenance_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(Provenance_Acq, .drop = T) %>%
  spread(Provenance_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_ORIGIN_",.)))


### Jointure des tables CSP Acquereurs 

Buyers_Social <- left_join(BuyersN,
                           BuyersCSP_Sexe,
                           by = c("Acquereurs"="CSP_Acq", "annee")) %>%
  left_join(., BuyersCSP_Age,
            by = c("Acquereurs"="CSP_Acq", "annee")) %>%
  left_join(., BuyersCSP_TrancheAge,
            by = c("Acquereurs"="CSP_Acq", "annee"))  %>%
  left_join(., BuyersCSP_SitMatri,
            by = c("Acquereurs"="CSP_Acq", "annee"))  %>%
  left_join(., BuyersCSP_AcheteA,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., Portee_Social,
            by = c("Acquereurs", "annee")) 



######## Informations principales sur les Vendeurs########

SellersN <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  count(Vendeurs, annee, name = "B_VE_TOT", .drop = T)

SellersCSP_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(Sexe_Ve)) %>%
  group_by(CSP_Ve, annee) %>%
  count(Sexe_Ve, .drop = T) %>%
  spread(Sexe_Ve, n)%>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_SEX_",.))) 


SellersCSP_TrancheAge <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(Tranche_Age_Vendeur)) %>%
  group_by(CSP_Ve, annee) %>%
  count(Tranche_Age_Vendeur, .drop = T) %>%
  spread(Tranche_Age_Vendeur, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MOC_AGE_",.))) 


SellersCSP_Age <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(Age_Ve)) %>%
  group_by(CSP_Ve, annee) %>%
  summarise(Moyen = mean(Age_Ve),
            Q1 = quantile(Age_Ve, 0.25),
            Median = quantile(Age_Ve, 0.5),
            Q3 = quantile(Age_Ve, 0.75),
            EcartType = sd(Age_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_AGE_",.)))

SellersCSP_SitMatri <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(SitMatri_VE)) %>%
  group_by(CSP_Ve, annee) %>%
  count(SitMatri_VE, .drop = T) %>%
  spread(SitMatri_VE, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_MATRI",.)))

# Relations d'achats-ventes

Sellers_VendA <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Ve, CSP_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Vendeurs, annee ) %>%
  count(Acquereurs, .drop = T) %>%
  spread(Acquereurs, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_VEND_",.)))


### Jointure des tables vendeurs ####

Sellers_Social <- left_join(SellersN,
                            SellersCSP_Sexe,
                            by = c("Vendeurs" = "CSP_Ve", "annee")) %>%
  left_join(., SellersCSP_Age,
            by = c("Vendeurs" ="CSP_Ve", "annee")) %>%
  left_join(., SellersCSP_TrancheAge,
            by = c("Vendeurs" ="CSP_Ve", "annee"))  %>%
  left_join(., SellersCSP_SitMatri,
            by = c("Vendeurs" ="CSP_Ve", "annee"))  %>%
  left_join(., Sellers_VendA,
            by = c("Vendeurs", "annee")) 



#### Groupe de population par génération ####

#### Informations principales sur les acquéreurs ####


BuyersN <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  count(Acquereurs, annee, name = "B_AC_TOT", .drop = T)

BuyersGeneration_CSP <- SampleBIEN_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(CSP_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(CSP_Acq, .drop = T) %>%
  spread(CSP_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_CSP_",.))) 

BuyersGeneration_Sexe <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Sexe_Acq, .drop = T) %>%
  spread(Sexe_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_SEX_",.))) 

BuyersGeneration_Age <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(Age_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(Moyen = mean(Age_Acq, na.rm= TRUE),
            Q1 = quantile(Age_Acq, 0.25,na.rm=T),
            Median = quantile(Age_Acq, 0.5,na.rm=T),
            Q3 = quantile(Age_Acq, 0.75,na.rm=T),
            EcartType = sd(Age_Acq, na.rm=TRUE)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_AGE_",.))) 

BuyersGeneration_SitMatri <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(SitMatri_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(SitMatri_Acq, .drop = T) %>%
  spread(SitMatri_Acq, n)%>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_MATRI_",.)))

# Relations d'achats-ventes Generations
BuyersGeneration_AcheteA <- SampleBIEN_ReadyForOp %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Acquereurs, annee ) %>%
  count(Vendeurs, .drop = T) %>%
  spread(Vendeurs, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_ACHA_",.)))


# Acquéreurs selon l'origine résidentielle 

Portee_Generation <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(Provenance_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(Provenance_Acq, .drop = T) %>%
  spread(Provenance_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_ORIGIN_",.)))

### Jointure des tables Generation Acquereurs  

BuyersGeneration <- left_join(BuyersN,
                              BuyersGeneration_CSP,
                              by = c("Acquereurs", "annee")) %>%
  left_join(., BuyersGeneration_Age,
            by = c("Acquereurs", "annee")) %>%
  left_join(., BuyersGeneration_Sexe,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., BuyersGeneration_SitMatri,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., BuyersGeneration_AcheteA,
            by = c("Acquereurs", "annee")) %>%
  left_join(., Portee_Generation,
            by = c("Acquereurs", "annee")) 



#### Informations principales sur les Vendeurs ####


SellersN <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  count(Vendeurs, annee, name = "B_VE_TOT", .drop = T) 

SellersGeneration_CSP <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs), !is.na(CSP_Ve)) %>%
  group_by(Vendeurs, annee) %>%
  count(CSP_Ve, .drop = T) %>%
  spread(CSP_Ve, n)%>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MOC_AGE_",.)))

SellersGeneration_Sexe <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs), !is.na(CSP_Ve)) %>%
  group_by(Vendeurs, annee) %>%
  count(Sexe_Ve, .drop = T) %>%
  spread(Sexe_Ve, n)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_SEX_",.))) 

SellersGeneration_Age <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs), !is.na(Age_Ve)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(Age_Ve),
            Q1 = quantile(Age_Ve, 0.25),
            Median = quantile(Age_Ve, 0.5),
            Q3 = quantile(Age_Ve, 0.75),
            EcartType = sd(Age_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_AGE_",.))) 


SellersGeneration_SitMatri <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs), !is.na(SitMatri_VE)) %>%
  group_by(Vendeurs, annee) %>%
  count(SitMatri_VE, .drop = T) %>%
  spread(SitMatri_VE, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_MATRI_",.))) 

# Relations d'achats-ventes Generations
SellersGeneration_Relation <- SampleBIEN_ReadyForOp %>%  
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Vendeurs, annee ) %>%
  count(Acquereurs, .drop = T) %>%
  spread(Acquereurs, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_VEND_",.)))

### Jointure des tables Generation Vendeurs  

SellersGeneration <- left_join(SellersN,
                               SellersGeneration_CSP,
                               by = c("Vendeurs", "annee")) %>%
  left_join(., SellersGeneration_Age,
            by = c("Vendeurs", "annee")) %>%
  left_join(., SellersGeneration_Sexe,
            by = c("Vendeurs", "annee"))  %>%
  left_join(., SellersGeneration_SitMatri,
            by = c("Vendeurs", "annee"))  %>%
  left_join(., SellersGeneration_Relation,
            by = c("Vendeurs", "annee")) 


#### Groupe de population par genre #####

#### Informations principales sur les acquéreurs ####


BuyersN <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  count(Acquereurs, annee, name = "B_AC_TOT", .drop = T)

BuyersSexe_CSP <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(Sexe_Acq)) %>%
  group_by(Sexe_Acq, annee) %>%
  count(CSP_Acq, .drop = T) %>%
  spread(CSP_Acq, n)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_CSP_",.)))

BuyersSexe_TrancheAge <- SampleBIEN_ReadyForOp %>% 
  filter (!is.na(Sexe_Acq), !is.na(Tranche_Age_Acq)) %>%
  group_by(Sexe_Acq, annee) %>%
  count(Tranche_Age_Acq, .drop = T) %>%
  spread(Tranche_Age_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MOC_AGE_",.))) 

BuyersSexe_Age <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(Sexe_Acq), !is.na(Age_Acq)) %>%
  group_by(Sexe_Acq, annee) %>%
  summarise(Moyen = mean(Age_Acq),
            Q1 = quantile(Age_Acq, 0.25),
            Median = quantile(Age_Acq, 0.5),
            Q3 = quantile(Age_Acq, 0.75),
            EcartType = sd(Age_Acq))%>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_AGE_",.))) 

BuyersSexe_SitMatri <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(Sexe_Acq),!is.na(SitMatri_Acq)) %>%
  group_by(Sexe_Acq, annee) %>%
  count(SitMatri_Acq, .drop = T) %>%
  spread(SitMatri_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_MATRI_",.))) 

# Relations d'achats-ventes Sexes
BuyersSexe_AcheteA <- SampleBIEN_ReadyForOp %>%  
  mutate(Acquereurs = Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Acquereurs, annee ) %>%
  count(Vendeurs, .drop = T) %>%
  spread(Vendeurs, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_ACHA_",.)))

# Acquéreurs selon l'origine résidentielle 

Portee_Sexe <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = Sexe_Acq) %>%
  filter(!is.na(Acquereurs), !is.na(Provenance_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(Provenance_Acq, .drop = T) %>%
  spread(Provenance_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_ORIGIN_",.)))

### Jointure des tables Sexe Acquereurs  
BuyersSexe <- left_join(BuyersN,
                        BuyersSexe_CSP,
                        by = c("Acquereurs"="Sexe_Acq", "annee")) %>%
  left_join(., BuyersSexe_Age,
            by = c("Acquereurs"="Sexe_Acq", "annee")) %>%
  left_join(., BuyersSexe_TrancheAge,
            by = c("Acquereurs"="Sexe_Acq", "annee"))  %>%
  left_join(., BuyersSexe_SitMatri,
            by = c("Acquereurs"="Sexe_Acq", "annee"))  %>%
  left_join(., BuyersSexe_AcheteA,
            by = c("Acquereurs", "annee")) %>%
  left_join(., Portee_Sexe,
            by = c("Acquereurs", "annee")) 



#### Informations principales sur les Vendeurs ####
SellersN <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  count(Vendeurs, annee, name = "B_VE_TOT", .drop = T)

SellersSexe_CSP <- SampleBIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(Sexe_Ve)) %>%
  group_by(Sexe_Ve, annee) %>%
  count(CSP_Ve, .drop = T) %>%
  spread(CSP_Ve, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_SEX_",.)))

SellersSexe_TrancheAge <- SampleBIEN_ReadyForOp %>% 
  filter (!is.na(Sexe_Ve), !is.na(Tranche_Age_Vendeur)) %>%
  group_by(Sexe_Ve, annee) %>%
  count(Tranche_Age_Vendeur, .drop = T) %>%
  spread(Tranche_Age_Vendeur, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MOC_AGE_",.))) 

SellersSexe_Age <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(Sexe_Ve), !is.na(Age_Ve)) %>%
  group_by(Sexe_Ve, annee) %>%
  summarise(Moyen = mean(Age_Ve),
            Q1 = quantile(Age_Ve, 0.25),
            Median = quantile(Age_Ve, 0.5),
            Q3 = quantile(Age_Ve, 0.75),
            EcartType = sd(Age_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_AGE_",.)))

SellersSexe_SitMatri <- SampleBIEN_ReadyForOp %>% 
  filter(!is.na(Sexe_Ve),!is.na(SitMatri_VE)) %>%
  group_by(Sexe_Ve, annee) %>%
  count(SitMatri_VE, .drop = T) %>%
  spread(SitMatri_VE, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_SEX_",.)))

# Relations d'achats-ventes Sexes
SellersSexe_VendA <- SampleBIEN_ReadyForOp %>%  
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  mutate(Acquereurs = Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Vendeurs, annee ) %>%
  count(Acquereurs, .drop = T) %>%
  spread(Acquereurs, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_VEND_",.)))

### Jointure des tables Sexe Vendeurs  

SellersSexe <- left_join(SellersN,
                         SellersSexe_CSP,
                         by = c("Vendeurs"="Sexe_Ve", "annee")) %>%
  left_join(., SellersSexe_Age,
            by = c("Vendeurs"="Sexe_Ve", "annee")) %>%
  left_join(., SellersSexe_TrancheAge,
            by = c("Vendeurs"="Sexe_Ve", "annee"))  %>%
  left_join(., SellersSexe_SitMatri,
            by = c("Vendeurs"="Sexe_Ve", "annee"))  %>%
  left_join(., SellersSexe_VendA,
            by = c("Vendeurs", "annee")) 

#### Appariement des données à partir de la base PTZ ###

### Groupe pop par CSP ###

# Acquéreurs totaux par CSP
TotPTZ_Social <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs,.drop = T) %>%
  spread(Acquereurs, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_TOT",.)))

# Type d'Acquéreurs totaux par CSP
TypAcqPTZ_Social <- SamplePTZ_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_MEN_TYP_")))

#  Age des acquéreurs avec PTZ
AgePTZ_Social <- SamplePTZ_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))),
            Moyen = mean(age),
            Q1 = quantile(age, 0.25, na.rm = T),
            Median = quantile(age,0.5, na.rm = T),
            Q3 = quantile(age,0.75, na.rm = T),
            EcartType = sd(age)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_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<- SamplePTZ_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_MOC_AGE_")))



#  Revenus total net du ménage des acquéreurs avec PTZ
RevenusPTZ_Social <- SamplePTZ_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))),
            Moyen = mean(rann),
            Q1 = quantile(rann, 0.25, na.rm = T),
            Median = quantile(rann,0.5, na.rm = T),
            Q3 = quantile(rann,0.75, na.rm = T),
            EcartType = sd(rann)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_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 <- SamplePTZ_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_MEN_STATOCC_",.)))

# Situation matrimoniale
AcqSitMatriPTZ_Social <- SamplePTZ_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_MEN_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 <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%  
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs,.drop = T) %>%
  spread(Acquereurs, n, fill = 0) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_TOT",.)))

# Type d'Acquéreurs par Generation
TypeAcqPTZ_Generation <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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_MEN_TYP_")))

# CSP des Acquéreurspar Generation
CSP_PTZ_Generation <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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_MEN_CSP_")))

#  Age des acquéreurs avec PTZ
AgePTZ_Generation <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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))),
            Moyen = mean(age),
            Q1 = quantile(age, 0.25, na.rm = T),
            Median = quantile(age,0.5, na.rm = T),
            Q3 = quantile(age,0.75, na.rm = T),
            EcartType = sd(age)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_AGE_",.)))


#  Revenus total net du ménage des acquéreurs avec PTZ
RevenusPTZ_Generation <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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))),
            Moyen = mean(rann),
            Q1 = quantile(rann, 0.25, na.rm = T),
            Median = quantile(rann,0.5, na.rm = T),
            Q3 = quantile(rann,0.75, na.rm = T),
            EcartType = sd(rann)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_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 <- SamplePTZ_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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_MEN_STATOCC_",.)))

# Situation matrimoniale
AcqSitMatriPTZ_Generation <- SamplePTZ_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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_MEN_MATRI_",.)))

# Jointure des tables PTZ Generation

BuyersPTZ_Generation <- left_join(TotPTZ_Generation, 
                             TypAcqPTZ_Generation,
                             by = c("Acquereurs", "annee")) %>%
   left_join(., 
            CSP_PTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            AgePTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            TranAgePTZ_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")) 

# Jointure des tables BIENS et PTZ
## Groupe pop par CSP
Buyers_Social <- left_join(Buyers_Social, 
                             BuyersPTZ_Social,
                             by = c("Acquereurs", "annee"))

## Groupe pop par Generation
Buyers_Generation <- left_join(BuyersPTZ_Generation, 
                             TypAcqPTZ_Generation,
                             by = c("Acquereurs", "annee"))

Préparation des données sur les caractéristiques régimes d’achat et type de mutation des biens

##### Durée de détention des biens ######

# Vendeurs personnes physiques
DurDetentVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Duree_Detention_Ve)) %>%
  mutate(Vendeurs = CSP_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(Duree_Detention_Ve),
            Q1 = quantile(Duree_Detention_Ve,0.25),
            Median = quantile(Duree_Detention_Ve,0.5),
            Q3 = quantile(Duree_Detention_Ve,0.75),
            EcartType = sd(Duree_Detention_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.))) 


#### Tranche durée de détention ####

# Vendeurs personnes physiques
TranDurDetentVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Tranche_DureeDetention_Ve)) %>%
  mutate(Vendeurs = CSP_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  count(Tranche_DureeDetention_Ve, .drop = T) %>%
  filter( n >=5) %>%
  spread(Tranche_DureeDetention_Ve, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.)))

#### Type de mutation des biens lors de l'acquisition du bien par le vendeur #####

# Vendeurs personnes physiques
TypeMutatPrec_Social <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(TypMutPrec_VE)) %>%
  mutate(Vendeurs = CSP_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  count(TypMutPrec_VE, .drop = T) %>%
  filter( n >=5) %>%
  spread(TypMutPrec_VE, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_TYPMUT_",.)))

#### Présence de crédit à l'acquisition #####

# Acquéreurs personnes physiques
PresCredAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(PresCred_Acq)) %>%
  mutate(Acquereurs = CSP_Ve) %>%
  filter(!is.na(PresCred_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(PresCred_Acq, .drop = T) %>%
  filter( n >=5) %>%
  spread(PresCred_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_PRESCRED_",.)))

#### Type de pret #####

# Acquéreurs personnes physiques
TypPretAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(TypePret_Acq)) %>%
  mutate(Acquereurs = CSP_Acq) %>%
  filter(!is.na(TypePret_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(TypePret_Acq, .drop = T) %>%
  filter( n >=5) %>%
  spread(TypePret_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_GARCRED_",.)))

#### Loan-to-value ####

# Acquéreurs personnes physiques
SampleBIEN_ReadyForOp$MTCRED <- as.numeric(SampleBIEN_ReadyForOp$MTCRED)

LTVAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(REQ_PRIX) & MTCRED >= 1000) %>%
  mutate(Acquereurs = CSP_Acq,
         LTV = (MTCRED/ REQ_PRIX)*100) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(LTV),
            Q1 = quantile(LTV,0.25),
            Median = quantile(LTV,0.5),
            Q3 = quantile(LTV,0.75),
            EcartType = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_LTV_",.))) 

#### Montant du crédit ####

# Acquéreurs personnes physiques
MtCredAcq_Social <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & MTCRED >= 1000) %>%
  mutate(Acquereurs = CSP_Acq)%>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(MTCRED),
            Q1 = quantile(MTCRED,0.25),
            Median = quantile(MTCRED,0.5),
            Q3 = quantile(MTCRED,0.75),
            EcartType = sd(MTCRED)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_MTCRED_",.))) 

#### Plus-value réalisée par les vendeurs en fonction de la durée de détention des biens ####

# Vendeurs personnes physiques
SampleBIEN_ReadyForOp$REQ_VALUE <- as.numeric(SampleBIEN_ReadyForOp$REQ_VALUE)

PlusValueVe_Social <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(REQ_VALUE) & 
            REQ_VALUE != 0) %>%
  mutate(Vendeurs = CSP_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, Tranche_DureeDetention_Ve) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_VALUE),
            Q1 = quantile(REQ_VALUE, 0.25, na.rm = T),
            Median = quantile(REQ_VALUE,0.5, na.rm = T),
            Q3 = quantile(REQ_VALUE,0.75, na.rm = T),
            EcartType = sd(REQ_VALUE)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "PlusValue", Tranche_DureeDetention_Ve, Mesure, sep="_") %>%
  spread(PlusValue, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_PVALUE_",.))) 

##### Agregation des données orIginaires de la Base PTZ #####

# Agregation sur les variables de types de prêt principal et Type de bien (Ancien/neuf)acheté
PretPTZ_Social <- SamplePTZ_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_MEN_TYPCRED_Libre=(length(which(Nature_PretPrincipal=="LIB"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPCRED_Conventionne=(length(which(Nature_PretPrincipal=="CONV"))/n_operation_PTZ)*100,            
            # Type de garantie du crédit
            P_AC_MEN_GARCRED_Hypothecaire  =(length(which(TypeGarantie=="HYPO"))/n_operation_PTZ)*100,
            P_AC_MEN_GARCRED_Caution =(length(which(TypeGarantie=="CAUT"))/n_operation_PTZ)*100,
            P_AC_MEN_GARCRED_N =(length(which(TypeGarantie=="N"))/n_operation_PTZ)*100,
            # Type d'opération
            P_AC_MEN_TYPOP_Neuf = (length(which(TypeOperationPTZ=="NEUF"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPOP_FoncierConstruction= (length(which(TypeOperationPTZ=="FON"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPOP_AncienRenovation= (length(which(TypeOperationPTZ=="REN"))/n_operation_PTZ)*100)
            

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

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

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

#  Montant total TTC de l'opération
MtOperationPTZ_Social <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(vtto),
            Q1 = quantile(vtto, 0.25, na.rm = T),
            Median = quantile(vtto,0.5, na.rm = T),
            Q3 = quantile(vtto,0.75, na.rm = T),
            EcartType = 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 <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = CSP_Acq ) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(vtpr),
            Q1 = quantile(vtpr, 0.25, na.rm = T),
            Median = quantile(vtpr,0.5, na.rm = T),
            Q3 = quantile(vtpr,0.75, na.rm = T),
            EcartType = sd(vtpr)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_MTCREDPR_",.)))

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

#  LTV de l'opération
LTVPTZ_Social <- SamplePTZ_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))),
            Moyen = mean(LTV),
            Q1 = quantile(LTV, 0.25, na.rm = T),
            Median = quantile(LTV,0.5, na.rm = T),
            Q3 = quantile(LTV,0.75, na.rm = T),
            EcartType = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_LTV_",.)))

# Revente d'un logement pour financer l'acquisition
RevLog_Social <- SamplePTZ_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_MEN_REVLOG_",.)))



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


# Acquéreurs
PurchaseAndMutationAcq_Social <- left_join(PresCredAcq_Social, 
                                           TypPretAcq_Social,
                                           by = c("Acquereurs", "annee")) %>%
  left_join(., 
            LTVAcq_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtCredAcq_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            PretPTZ_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            TEG_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            DurCredit_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtPTZ_Social,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtOperationPTZ_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"))



# Vendeurs

PurchaseAndMutationVe_Social <-  left_join(DurDetentVe_Social, 
                                           TranDurDetentVe_Social,
                                           by = c("Vendeurs", "annee")) %>%
  left_join(., 
            TypeMutatPrec_Social,
            by = c("Vendeurs", "annee")) %>%
  
  left_join(., 
            PlusValueVe_Social,
            by = c("Vendeurs", "annee"))



##### Durée de détention des biens ######

# Vendeurs personnes physiques
DurDetentVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Duree_Detention_Ve)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7", "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(Duree_Detention_Ve),
            Q1 = quantile(Duree_Detention_Ve,0.25),
            Median = quantile(Duree_Detention_Ve,0.5),
            Q3 = quantile(Duree_Detention_Ve,0.75),
            EcartType = sd(Duree_Detention_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.))) 


#### Tranche durée de détention ####

# Vendeurs personnes physiques
TranDurDetentVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Tranche_DureeDetention_Ve)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7", "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  count(Tranche_DureeDetention_Ve, .drop = T) %>%
  filter( n >=5) %>%
  spread(Tranche_DureeDetention_Ve, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.)))

#### Type de mutation des biens lors de l'acquisition du bien par le vendeur #####

# Vendeurs personnes physiques
TypeMutatPrec_Generation <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(TypMutPrec_VE)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7", "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  count(TypMutPrec_VE, .drop = T) %>%
  filter( n >=5) %>%
  spread(TypMutPrec_VE, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_TYPMUT_",.)))

#### Présence de crédit à l'acquisition #####

# Acquéreurs personnes physiques
PresCredAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(PresCred_Acq)) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7","PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(PresCred_Acq, .drop = T) %>%
  filter( n >=5) %>%
  spread(PresCred_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_PRESCRED_",.)))

#### Type de pret #####

# Acquéreurs personnes physiques
TypPretAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(TypePret_Acq)) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  count(TypePret_Acq, .drop = T) %>%
  filter( n >=5) %>%
  spread(TypePret_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_TYPCRED_",.)))

#### Loan-to-value ####

# Acquéreurs personnes physiques
SampleBIEN_ReadyForOp$MTCRED <- as.numeric(SampleBIEN_ReadyForOp$MTCRED)

LTVAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(REQ_PRIX) & MTCRED >= 1000) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%
  mutate(LTV = (MTCRED/ REQ_PRIX)*100) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(LTV),
            Q1 = quantile(LTV,0.25),
            Median = quantile(LTV,0.5),
            Q3 = quantile(LTV,0.75),
            EcartType = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_LTV_",.))) 

#### Montant du crédit ####

# Acquéreurs personnes physiques
MtCredAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & MTCRED >= 1000) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(MTCRED),
            Q1 = quantile(MTCRED,0.25),
            Median = quantile(MTCRED,0.5),
            Q3 = quantile(MTCRED,0.75),
            MtCredSd = sd(MTCRED)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_MTCRED_",.))) 

#### Plus-value réalisée par les vendeurs en fonction de la durée de détention des biens ####

# Vendeurs personnes physiques
SampleBIEN_ReadyForOp$REQ_VALUE <- as.numeric(SampleBIEN_ReadyForOp$REQ_VALUE)

PlusValueVe_Generation <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(REQ_VALUE) & 
            REQ_VALUE != 0) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7","PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, Tranche_DureeDetention_Ve) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            Moyen = mean(REQ_VALUE),
            Q1 = quantile(REQ_VALUE, 0.25, na.rm = T),
            Median = quantile(REQ_VALUE,0.5, na.rm = T),
            PlusValueQ3 = quantile(REQ_VALUE,0.75, na.rm = T),
            EcartType = sd(REQ_VALUE)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "PlusValue", Tranche_DureeDetention_Ve, Mesure, sep="_") %>%
  spread(PlusValue, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_PVALUE_",.))) 
  

##### Agregation des données orginaires de la Base PTZ #####

# Agregation sur les variables de types de prêt principal et Type de bien (Ancien/neuf)acheté
PretPTZ_Generation <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(n_operation_PTZ= length(which(!is.na(Acquereurs))),
           P_AC_MEN_TYPCRED_Libre=(length(which(Nature_PretPrincipal=="LIB"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPCRED_Conventionne=(length(which(Nature_PretPrincipal=="CONV"))/n_operation_PTZ)*100,            
            # Type de garantie du crédit
            P_AC_MEN_GARCRED_Hypothecaire  =(length(which(TypeGarantie=="HYPO"))/n_operation_PTZ)*100,
            P_AC_MEN_GARCRED_Caution =(length(which(TypeGarantie=="CAUT"))/n_operation_PTZ)*100,
            P_AC_MEN_GARCRED_N =(length(which(TypeGarantie=="N"))/n_operation_PTZ)*100,
            # Type d'opération
            P_AC_MEN_TYPOP_Neuf = (length(which(TypeOperationPTZ=="NEUF"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPOP_FoncierConstruction= (length(which(TypeOperationPTZ=="FON"))/n_operation_PTZ)*100,
            P_AC_MEN_TYPOP_AncienRenovation= (length(which(TypeOperationPTZ=="REN"))/n_operation_PTZ)*100)

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

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

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

#  Montant total TTC de l'opération
MtOperationPTZ_Generation <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(vtto),
            Q1 = quantile(vtto, 0.25, na.rm = T),
            Median = quantile(vtto,0.5, na.rm = T),
            Q3 = quantile(vtto,0.75, na.rm = T),
            EcartType = 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 <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(vtpr),
            Q1 = quantile(vtpr, 0.25, na.rm = T),
            Median = quantile(vtpr,0.5, na.rm = T),
            Q3 = quantile(vtpr,0.75, na.rm = T),
            EcartType = sd(vtpr)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_MTCREDPR_",.)))


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

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


# Revente d'un logement pour achat du bien
RevLog_Generation <-SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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_MEN_REVLOG_",.)))

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


# Acquéreurs
PurchaseAndMutationAcq_Generation <- left_join(PresCredAcq_Generation, 
                                               TypPretAcq_Generation,
                                               by = c("Acquereurs", "annee")) %>%
  left_join(., 
            LTVAcq_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtCredAcq_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            PretPTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            TEG_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            DurCredit_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtPTZ_Generation,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtOperationPTZ_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"))

# Vendeurs

PurchaseAndMutationVe_Generation <-  left_join(DurDetentVe_Generation, 
                                               TranDurDetentVe_Generation,
                                               by = c("Vendeurs", "annee")) %>%
  left_join(., 
            TypeMutatPrec_Generation,
            by = c("Vendeurs", "annee")) %>%
  
  left_join(., 
            PlusValueVe_Generation,
            by = c("Vendeurs", "annee"))


# Genre
##### Durée de détention des biens ######
# Vendeurs personnes physiques
DurDetentVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Duree_Detention_Ve)) %>%
  mutate(Vendeurs= Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(Moyen = mean(Duree_Detention_Ve),
            Q1 = quantile(Duree_Detention_Ve,0.25),
            Median = quantile(Duree_Detention_Ve,0.5),
            Q3 = quantile(Duree_Detention_Ve,0.75),
            EcartType = sd(Duree_Detention_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("P_AC_MEN_TEG_",.))) 


#### Tranche durée de détention ####

# Vendeurs personnes physiques
TranDurDetentVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Tranche_DureeDetention_Ve)) %>%
  mutate(Vendeurs= Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  count(Tranche_DureeDetention_Ve, .drop = T) %>%
  filter( n >=5) %>%
  spread(Tranche_DureeDetention_Ve, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_DURDET_",.)))

#### Type de mutation des biens lors de l'acquisition du bien par le vendeur #####

# Vendeurs personnes physiques
TypeMutatPrec_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(TypMutPrec_VE)) %>%
  mutate(Vendeurs= Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  count(TypMutPrec_VE, .drop = T) %>%
  filter( n >=5) %>%
  spread(TypMutPrec_VE, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_TYPMUT_",.)))

#### Présence de crédit à l'acquisition #####

# Acquéreurs personnes physiques
PresCredAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(PresCred_Acq)) %>%
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(PresCred_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(PresCred_Acq, .drop = T) %>%
  filter( n >=5) %>%
  spread(PresCred_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_PRESCRED_",.)))

#### Type de pret #####

# Acquéreurs personnes physiques
TypPretAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(TypePret_Acq)) %>%
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(TypePret_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(TypePret_Acq, .drop = T) %>%
  filter( n >=5) %>%
  spread(TypePret_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_TYPCRED_",.)))

#### Loan-to-value ####

# Acquéreurs personnes physiques
SampleBIEN_ReadyForOp$MTCRED <- as.numeric(SampleBIEN_ReadyForOp$MTCRED)

LTVAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(REQ_PRIX) & MTCRED >= 1000) %>%
  mutate(Acquereurs = Sexe_Acq,
         LTV = (MTCRED/ REQ_PRIX)*100) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(LTV),
            Q1 = quantile(LTV,0.25),
            Median = quantile(LTV,0.5),
            Q3 = quantile(LTV,0.75),
            EcartType = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_LTV_",.))) 

#### Montant du crédit ####

# Acquéreurs personnes physiques
MtCredAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & MTCRED >= 1000) %>%
  mutate(Acquereurs = Sexe_Acq)%>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            Moyen = mean(MTCRED),
            Q1 = quantile(MTCRED,0.25),
            Median = quantile(MTCRED,0.5),
            Q3 = quantile(MTCRED,0.75),
            MtCredSd = sd(MTCRED)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_MEN_MTCRED_",.))) 

#### Plus-value réalisée par les vendeurs en fonction de la durée de détention des biens ####

# Vendeurs personnes physiques
SampleBIEN_ReadyForOp$REQ_VALUE <- as.numeric(SampleBIEN_ReadyForOp$REQ_VALUE)

PlusValueVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(REQ_VALUE) & 
            REQ_VALUE != 0) %>%
  mutate(Vendeurs= Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, Tranche_DureeDetention_Ve) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            PlusValueMoyen = mean(REQ_VALUE),
            Q1 = quantile(REQ_VALUE, 0.25, na.rm = T),
            Median = quantile(REQ_VALUE,0.5, na.rm = T),
            Q3 = quantile(REQ_VALUE,0.75, na.rm = T),
            EcartType = sd(REQ_VALUE)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  gather(key = "Mesure", value = "Value", 4:ncol(.)) %>% 
  unite(., col = "PlusValue", Tranche_DureeDetention_Ve, Mesure, sep="_") %>%
  spread(PlusValue, 4) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_MEN_PVALUE_",.))) 

##### Pas de données disponibles pour Agregation des données orginaires de la Base PTZ #####


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


# Acquéreurs
PurchaseAndMutationAcq_Sexe <- left_join(PresCredAcq_Sexe, 
                                         TypPretAcq_Sexe,
                                         by = c("Acquereurs", "annee")) %>%
  left_join(., 
            LTVAcq_Sexe,
            by = c("Acquereurs", "annee")) %>%
  left_join(., 
            MtCredAcq_Sexe,
            by = c("Acquereurs", "annee")) 

# Vendeurs

PurchaseAndMutationVe_Sexe <-  left_join(DurDetentVe_Sexe, 
                                         TranDurDetentVe_Sexe,
                                         by = c("Vendeurs", "annee")) %>%
  left_join(., 
            TypeMutatPrec_Sexe,
            by = c("Vendeurs", "annee")) %>%
  
  left_join(., 
            PlusValueVe_Sexe,
            by = c("Vendeurs", "annee"))

Préparation des données sur les caractéristiques des types de biens immobiliers

####### Types de biens par taille du bien en nombre de pièces ###

HousingTypesAcq_Social <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(TypBien)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs,TypBien, .drop = T) %>%
  spread(TypBien, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_TYP_",.)))


HousingTypesVe_Social <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Acq, CSP_Ve)) %>%
  filter(!is.na(Vendeurs), !is.na(TypBien)) %>%
  group_by(Vendeurs, annee) %>%
  count(Vendeurs,TypBien, .drop = T) %>%
  spread(TypBien, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_TYP_",.)))


####### Types de biens par catégorie d'ancienneté et époque de construction du bien, en pourcentage par commune et par année ########

AncBienAcq_Social <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(CSP_Acq), Type_Acq, CSP_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(Anciennete)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs, Anciennete, .drop = T) %>%
  spread(Anciennete, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_ANC_",.)))

AncBienVe_Social <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Acq, CSP_Ve)) %>%
  filter(!is.na(Vendeurs), !is.na(Anciennete)) %>%
  group_by(Vendeurs, annee) %>%
  count(Vendeurs, Anciennete, .drop = T) %>%
  spread(Anciennete, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_ANC_",.)))


  NatBienPTZ_Social <-SamplePTZ_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_",.)))

TypBienPTZ_Social <-SamplePTZ_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 tables Acquéreurs ####

HousingTypesAcqSocial <-  left_join(HousingTypesAcq_Social,
                                    AncBienAcq_Social,
                                    by = c("Acquereurs", "annee"))%>%
  left_join(., 
            NatBienPTZ_Social,
            by = c("Acquereurs", "annee"))%>%
  left_join(., 
            TypBienPTZ_Social,
            by = c("Acquereurs", "annee"))

#### Jointure tables Vendeurs ####

HousingTypesVeSocial <-  left_join(HousingTypesVe_Social,
                                   AncBienVe_Social,
                                   by = c("Vendeurs", "annee"))


#### Générations ####

HousingTypesAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(TypBien)) %>%
  group_by(Acquereurs, annee) %>%
  count(TypBien, .drop = T) %>%
  spread(TypBien, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_TYP_",.))) 


HousingTypesVe_Generation <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & CSP_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs), !is.na(TypBien)) %>%
  group_by(Vendeurs, annee) %>%
  count(TypBien, .drop = T) %>%
  spread(TypBien, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_TYP_",.))) 

####### Types de biens par catégorie d'ancienneté et époque de construction du bien,par année ########

AncBienAcq_Generation <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(Anciennete)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs, Anciennete, .drop = T) %>%
  spread(Anciennete, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_ANC_",.))) 

AncBienVe_Generation <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(CSP_Ve), Type_Acq, CSP_Ve)) %>%
  filter(!is.na(Vendeurs), !is.na(Anciennete)) %>%
  group_by(Vendeurs, annee) %>%
  count(Vendeurs, Anciennete, .drop = T) %>%
  spread(Anciennete, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_ANC_",.)))


NatBienPTZ_Generation <-SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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_",.)))

TypBienPTZ_Generation <- SamplePTZ_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & CSP_Acq == "PCS7", "PCS7", 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 tables Acquéreurs ####

HousingTypesAcqGeneration <-  left_join(HousingTypesAcq_Generation,
                                        AncBienAcq_Generation,
                                        by = c("Acquereurs", "annee")) %>%
  left_join(., 
            NatBienPTZ_Generation,
            by = c("Acquereurs", "annee"))%>%
  left_join(., 
            TypBienPTZ_Generation,
            by = c("Acquereurs", "annee"))

#### Jointure tables Vendeurs ####

HousingTypesVeGeneration <-  left_join(HousingTypesVe_Generation,
                                       AncBienVe_Generation,
                                       by = c("Vendeurs", "annee"))

#### Sexe ####



####### Types de biens par taille du bien en nombre de pièces ####

HousingTypesAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = Sexe_Acq) %>%
  filter(!is.na(Acquereurs), !is.na(TypBien)) %>%
  group_by(Acquereurs, annee) %>%
  count(Acquereurs,TypBien, .drop = T) %>%
  spread(TypBien, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_TYP_",.))) 


HousingTypesVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs), !is.na(TypBien)) %>%
  group_by(Vendeurs, annee) %>%
  count(Vendeurs,TypBien, .drop = T) %>%
  spread(TypBien, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_TYP_",.))) 


####### Types de biens par catégorie d'ancienneté et époque de construction du bien, en pourcentage par commune et par année ########

AncBienAcq_Sexe <- SampleBIEN_ReadyForOp %>% 
  mutate(Acquereurs = Sexe_Acq) %>%
  filter(!is.na(Acquereurs), !is.na(Anciennete)) %>%
  group_by(Acquereurs, annee) %>%
  count(Anciennete, .drop = T) %>%
  spread(Anciennete, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_ANC_",.))) 

AncBienVe_Sexe <- SampleBIEN_ReadyForOp %>% 
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs), !is.na(Anciennete)) %>%
  group_by(Vendeurs, annee) %>%
  count(Vendeurs,Anciennete, .drop = T) %>%
  spread(Anciennete, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_IMMO_ANC_",.))) 


#### Jointure tables Acquéreurs ####

HousingTypesAcqSexe <-  left_join(HousingTypesAcq_Sexe,
                                  AncBienAcq_Sexe,
                                  by = c("Acquereurs", "annee"))

#### Jointure tables Vendeurs ####

HousingTypesVeSexe <-  left_join(HousingTypesVe_Sexe,
                                 AncBienVe_Sexe,
                                 by = c("Vendeurs", "annee"))

Jointures finales tables sur les groupes de population

# Tables Social
# Jointure tables acquéreurs
 FictifCASSSMIR_GroupesPopAcquereur_Social <- left_join(PricesAcq_Social, Buyers_Social,
by = c("Acquereurs", "annee")) %>%
  left_join(., PurchaseAndMutationAcq_Social,
by = c("Acquereurs", "annee")) %>%
  left_join(., HousingTypesAcq_Social,
by = c("Acquereurs", "annee"))

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

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

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


# Jointure tables vendeurs
 FictifCASSSMIR_GroupesPopVendeur_Social <- left_join(PricesVe_Social, Sellers_Social,
by = c("Vendeurs", "annee")) %>%
left_join(., PurchaseAndMutationVe_Social,
by = c("Vendeurs", "annee")) %>%
  left_join(., HousingTypesVe_Social,
by = c("Vendeurs", "annee")) 
 
FictifCASSSMIR_GroupesPopVendeur_Social <- FictifCASSSMIR_GroupesPopVendeur_Social %>% rename(Groupes = Vendeurs)
FictifCASSSMIR_GroupesPopVendeur_Social$TypeGroupe <- "Social"
FictifCASSSMIR_GroupesPopVendeur_Social<- FictifCASSSMIR_GroupesPopVendeur_Social %>% relocate(TypeGroupe, .after = Groupes)

 FictifCASSSMIR_GroupesPopVendeur_Social$Parties <- "Vendeurs"
 FictifCASSSMIR_GroupesPopVendeur_Social<-FictifCASSSMIR_GroupesPopVendeur_Social %>% relocate(Parties, .after = TypeGroupe)
 # Bind rows for one df
 FictifCASSSMIR_GroupesPop_Social<- rbind(FictifCASSSMIR_GroupesPopAcquereur_Social, FictifCASSSMIR_GroupesPopVendeur_Social)

 
 # Tables Generation
# Jointure tables acquéreurs
 CASSSMIR_GroupesPopAcquereur_Generation <- left_join( PricesAcq_Generation,BuyersGeneration,
by = c("Acquereurs", "annee")) %>%
   left_join(., PurchaseAndMutationAcq_Generation,
by = c("Acquereurs", "annee")) %>%
  left_join(., HousingTypesAcq_Generation,
by = c("Acquereurs", "annee")) 
 
 CASSSMIR_GroupesPopAcquereur_Generation <- CASSSMIR_GroupesPopAcquereur_Generation %>% rename(Groupes = Acquereurs)
CASSSMIR_GroupesPopAcquereur_Generation$TypeGroupe <- "Generationnel"

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

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

# Jointure tables vendeurs
 CASSSMIR_GroupesPopVendeur_Generation <- left_join(PricesVe_Generation, SellersGeneration,
by = c("Vendeurs", "annee")) %>%
   left_join(., PurchaseAndMutationVe_Generation,
by = c("Vendeurs", "annee")) %>%
  left_join(., HousingTypesVe_Generation,
by = c("Vendeurs", "annee")) 
 
 
  CASSSMIR_GroupesPopVendeur_Generation <- CASSSMIR_GroupesPopVendeur_Generation %>% rename(Groupes = Vendeurs)
CASSSMIR_GroupesPopVendeur_Generation$TypeGroupe <- "Generationnel"

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

CASSSMIR_GroupesPopVendeur_Generation$Parties <- "Vendeurs"
 CASSSMIR_GroupesPopVendeur_Generation <- CASSSMIR_GroupesPopVendeur_Generation %>% relocate(Parties, .after = TypeGroupe)

 # Bind rows for one df
 FictifCASSSMIR_GroupesPop_Generation<- rbind(CASSSMIR_GroupesPopAcquereur_Generation, CASSSMIR_GroupesPopVendeur_Generation)

 
# Tables Sexe
# Jointure tables acquéreurs
 FictifCASSSMIR_GroupesPopAcquereur_Sexe <- left_join( PricesAcq_Sexe,BuyersSexe,
by = c("Acquereurs", "annee")) %>%
  left_join(., HousingTypesAcq_Sexe,
by = c("Acquereurs", "annee")) %>%
   left_join(., PurchaseAndMutationAcq_Sexe,
by = c("Acquereurs", "annee")) %>%
  left_join(., Portee_Sexe,
by = c("Acquereurs", "annee")) 
 
  FictifCASSSMIR_GroupesPopAcquereur_Sexe <- FictifCASSSMIR_GroupesPopAcquereur_Sexe %>% rename(Groupes = Acquereurs)
FictifCASSSMIR_GroupesPopAcquereur_Sexe$TypeGroupe <- "Genre"

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

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


# Jointure tables vendeurs
 FictifCASSSMIR_GroupesPopVendeur_Sexe <- left_join( PricesVe_Sexe, SellersSexe,
by = c("Vendeurs", "annee")) %>%
   left_join(., PurchaseAndMutationVe_Sexe,
by = c("Vendeurs", "annee")) %>%
  left_join(., HousingTypesVe_Sexe,
by = c("Vendeurs", "annee"))
 
   FictifCASSSMIR_GroupesPopVendeur_Sexe <- FictifCASSSMIR_GroupesPopVendeur_Sexe %>% rename(Groupes = Vendeurs)
FictifCASSSMIR_GroupesPopVendeur_Sexe$TypeGroupe <- "Genre"

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

FictifCASSSMIR_GroupesPopVendeur_Sexe$Parties <- "Vendeurs"
 FictifCASSSMIR_GroupesPopVendeur_Sexe <- FictifCASSSMIR_GroupesPopVendeur_Sexe %>% relocate(Parties, .after = TypeGroupe)
 
  # Bind rows for one df
 FictifCASSSMIR_GroupesPop_Sexe<- rbind(FictifCASSSMIR_GroupesPopAcquereur_Sexe, FictifCASSSMIR_GroupesPopVendeur_Sexe)
 
 
 # Final R bind
 FictifCASSSMIR_GroupesPopDataBase <- rbind(FictifCASSSMIR_GroupesPop_Social, FictifCASSSMIR_GroupesPop_Generation)

 FictifCASSSMIR_GroupesPopDataBase <- rbind(FictifCASSSMIR_GroupesPopDataBase, FictifCASSSMIR_GroupesPop_Sexe)

Base de données et exemples de réalisations graphiques

# Donnees spatiales

str(FictifCASSMIR_SpatialDataBase_Grid200m)
str(FictifCASSMIR_SpatialDataBase_Grid1km)
str(FictifCASSMIR_SpatialDataBase_Communes)

# Donnees groupes de population

str(FictifCASSSMIR_GroupesPopDataBase)

#### Cartographie ####

# Import espace fictif
 LastFile <- list.files("CASSMIR_Outputs",pattern =  "OutputFictifSpace",full.names = T) %>% 
  enframe(name = NULL) %>% 
  bind_cols(pmap_df(., file.info)) %>% 
  filter(mtime==max(mtime)) %>% 
  pull(value)
 
FictifSpace<- st_read(LastFile, quiet = TRUE, layer = "VoronoiForCommunes")


# # Génération automatique de cartes lissées avec la fonction plotMapSmoothData
# # Avec :
# # plotMapSmoothData (
# # data = objet spatial de type sf avec données attributaires quantitatives *interpolées au préalable*
# # Var = un vecteur numérique de valeurs lisées
# # nk = le nombre de classes (discrétisation en quantile)
# # Breaks = Bornes des classes
# # Col = codes couleurs des classes
# # titleleg = une expression en charactère pour le titre de la légende
# # Title = une expression en charactère pour le titre de la carte
# # Sources = une expression en charactère pour l'énumération des sources
# #)
# 
# plotMapSmoothData <- function(data, Var, nk, Breaks, SizeSideTile, Col, titleLeg, Title, Sources) {
#   
#   require(cartography)
#   require(sf)
#   
#   
#   #Création d'un Mask avec l'objet de type sf
#   Mask <- st_union(data)
#   Mask<-st_sf(id = 1, geometry = Mask)
#   
#   # Simplification géométrique du Mask
#   
#   Mask <- Mask %>%
#     st_buffer(dist = SizeSideTile) %>%
#     st_buffer(dist = -(SizeSideTile*2)) %>%
#     st_simplify(preserveTopology = FALSE, dTolerance = SizeSideTile) %>%
#     st_buffer(SizeSideTile)
#   
#   # Fenetre
#   par(mar = c(0,0,0,0))
#   bbx <- st_bbox(Com_sf) # Pour placer les éléments relativement à la bbox
#   
#   # Centroids, polygons to point
#   
#    dataformap = st_centroid(dataformap)
#   dataformap <- st_jitter(dataformap,amount = 100)
#   # Extraction des centroids et des coordonnées X / Y
# 
# dataformap$X <- st_coordinates(dataformap)[,1]
# dataformap$Y <- st_coordinates(dataformap)[,2]
# dataformap$id <- row.names(dataformap)
# 
#   unique(dataformap$geom)
#   # Create an isopleth layer
#   pot <- isopoly(x = dataformap, var = "B_AC_MEN_CSP_Ouvrier",
#                  breaks = Bv,
#                  mask = Mask, 
#                  returnclass = "sf")
# 
#   length(unique(dataformap[["Y"]]))
#   x[[var]]
#   
#   # Get breaks values
#   bv3 <- sort(c(unique(pot$min), max(pot$max)), decreasing = FALSE)
  
# Base map
   plot(st_geometry(Com_sf), col = "white")
  
   # Map potential
  choroLayer(x = dataformap, var = "B_AC_MEN_CSP_Ouvrier",
             breaks = Bv, 
             col = Col,
             border = NA,
             legend.pos = NA, add = TRUE)
  
  
  legendChoro(pos = c(bbx[1], bbx[2] + 1000 ), # pour une légende en haut à gauche de la carte, à ajuster
              cex = 0.9,
              title.cex = 0.8, # à ajuster
              values.cex = 0.6, # à ajuster
              title.txt = "titleLeg", 
              breaks = Bv, 
              nodata = F, 
              values.rnd = 2, 
              col = Col,
              border = "grey60")
  
  # Add Main Title
  text(x = c(bbx[1]), y = c(bbx[4] + 200), labels = "Title", cex = 1, adj = 0, font = 2) # hors cadre
  #text(x = c(bbx[1] + 1000), y = c(bbx[4] - 2000), labels = Title, cex = 1, adj = 0, font = 2) # dans cadre
  
  
  # Add scalebar
  barscale(5, pos = c(bbx[3] - 5000, bbx[2] + 500 ))
  
  # Add sources
  mtext(text = Sources,
        
        side = 1, 
        line = -0.95, 
        adj = 0.95,
        cex = 0.50)
  
}

# Exemple sur le pourcentage de PCS3 pour l'année 2012

dataformap<- FictifCASSMIR_SpatialDataBase_Grid200m %>%
  filter(annee==2012) %>%
  select(Carreau_ID, geom, B_AC_MEN_CSP_Ouvrier)

# Les seuils de classe sont aussi à définir en dehors de la fonction
Bv <- getBreaks(dataformap$B_AC_MEN_CSP_Ouvrier, nclass = 3, method = "quantile")

# Le choix de la couleur ne rentre pas dans la fonction
Col <-  carto.pal(pal1 = "red.pal", pal2 = "blue.pal", n1 = 4, n2 = 4)


plotMapSmoothData (data = dataformap, 
              Var = "B_AC_MEN_CSP_CPIS",
              Breaks = Bv,
              Col = Col,
              SizeSideTile = 200,
              titleLeg = "",
              Title = "",
              Sources = "Réalisation : T. Le Corre, 2020")

plot(dataformap$geom)

Session info

sessionInfo()












BD CASSMIR - licence CC-BY-NC