Chargement des librairies

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

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

Nettoyage des données

# Import des données N Open Access
## Import des données BIEN (Chemin sécurisé et répertoire de travail externe au dossier)
BIEN_Brute <- read.csv2("CASSMIR_NoOpenDataRaws/BIEN_9618_Consolidated.csv", stringsAsFactors=FALSE)

# Import des données Open Access
## Répertoire de travail interne au dossier
### Population en 2011 : données utiles au redressement de l'échantillon.
PopIris2011 <- read_excel("CASSMIR_OpenDataRaws/Population/base-ic-evol-struct-pop-2011.xls", sheet = "IRIS", skip = 5)%>%
  select("IRIS", "COM", "P11_POP") #On retient le code Iris, code commune et population à l'iris en 2011.
# Liste des communes reçues par le service producteur des données pour le redressement
ComMoins10000 <- read.csv("CASSMIR_OpenDataRaws/Population/ComMoins10000.csv", sep=";", stringsAsFactors=FALSE)

# Import données géométriques Voir les informations sur la préparation des objets géométriques dans l'onglet "PlayWithCassmir"
## Couche Communes 
Com_Sf <- st_read("CASSMIR_OpenDataRaws/GEOFLA_2-2_COMMUNE_SHP_LAMB93_FXX_2016-06-28/GEOFLA/1_DONNEES_LIVRAISON_2016-06-00236/GEOFLA_2-2_SHP_LAMB93_FR-ED161/COMMUNE/COMMUNE.shp", quiet = TRUE) %>%
  filter(CODE_REG == "11") %>%
  st_transform(.,crs = "+init=epsg:2154")

Nombre d’individus nettoyage étape 0 : 1 113 795

Nombre d’individus de l’échantillon de la base BIEN : 1 113 795

Amélioration de la qualité du géoréférencement

Les coordonnées telles qu’elles sont renseignées peuvent présenter quelques variations spatiales par rapport à l’emplacement exact du bien soumis à la transaction. Pour augmenter la précision de la localisation des transactions, de nouvelles coordonnées géographiques sont attribuées à toutes les transactions qui possèdent des informations attributaires conformes qui permettent d’identifier leurs parcelles cadastrales d’appartenance.

Même si la dispersion incertaines est limitée avec les coordonnées géographiques initiales (dans la petite couronne, en 2011, plus de 80 % des transactions sont localisées à moins de 50m de leur parcelle cadastrale d’appartenance, et seulement 1% à plus de 500m), ce traitement améliore la qualité des localisations. Par ailleurs, comme les coordonnées du centroïde des parcelles sont attribuées aux transactions sans coordonnées initiales X,Y renseignées, cela diminue le nombre de transactions écartées dans l’échantillon.

On utilise ici les couches issues du Plan Cadastral Informatisté (PCI). Ce sont des données ouvertes, fournies par Etalab.

Ici, on utilisera le millésime du 01 janvier 2019, avec des données en format Shapefile

Le PCI est téléchargeable sur cette page.

Peu importe la source des données, il est impératif que chaque parcelle possède un champ d’identifiant de 14 caractères, composé des 5 caractères du code INSEE de la commune, des 3 caractères du préfixe de la section cadastrale, des 2 caractères du numéro de section cadastrale, et des 4 caractères du numéro de parcelle. Le script utilise cet identifiant afin de procéder au géoréférencement de la base BIEN

# Données cadastrales
parcelles92 <- st_read("CASSMIR_OpenDataRaws/cadastre_IDF/parcelles92.shp")
parcelles92 <- st_transform(parcelles92,2154)

parcelles93 <- st_read("CASSMIR_OpenDataRaws/cadastre_IDF/parcelles93.shp")
parcelles93 <- st_transform(parcelles93,2154)

parcelles94 <- st_read("CASSMIR_OpenDataRaws/cadastre_IDF/parcelles94.shp")
parcelles94 <- st_transform(parcelles94,2154)

parcelles95 <- st_read("CASSMIR_OpenDataRaws/cadastre_IDF/parcelles95.shp")
parcelles95 <- st_transform(parcelles95,2154)

parcelles91 <- st_read("CASSMIR_OpenDataRaws/cadastre_IDF/parcelles91.shp")
parcelles91 <- st_transform(parcelles91,2154)

parcelles77 <- st_read("CASSMIR_OpenDataRaws/cadastre_IDF/parcelles77.shp")
parcelles77 <- st_transform(parcelles77,2154)

parcelles78 <- st_read("CASSMIR_OpenDataRaws/cadastre_IDF/parcelles78.shp")
parcelles78 <- st_transform(parcelles78,2154)

parcelles75 <- st_read("CASSMIR_OpenDataRaws/cadastre_IDF/parcelles75.shp")
parcelles75 <- st_transform(parcelles75,2154)


# Objet commun 
parcelles <- rbind(parcelles75,  parcelles77, parcelles78, parcelles91, parcelles92, parcelles93, parcelles94, parcelles95)

# Ecrasement des objets individuels
rm(parcelles92)
rm(parcelles93)
rm(parcelles94)
rm(parcelles95)
rm(parcelles91)
rm(parcelles77)
rm(parcelles78)
rm(parcelles75)

colnames(parcelles)[1] <- 'idpar' # ID de la parcelle réelle

Le résulat du script ci-dessous confirme qu’une grande majorité des transactions de l’échantillon inital a des coordonnées modifiées issues des coordonnées du centroïde de la parcelle d’appartenance :

  • Sur 1 062 529 transactions avec des informations XY, 80 522 n’ont pas d’attribution avec leur parcelle cadastrale d’appartenance, soit environ 7 %.

  • Pour ces lignes restantes, les coordonnées XY renseignées dans l’échantillon initial sont sauvegardées. Le risque d’une erreur importante de localisation, de plusieurs centaines de mètres, s’il existe, relève de l’exception. En effet, parmi ces lignes, 17382 lignes n’ont pas d’informations attributaires pour les relier au niveau de la section cadastrale (niveau scalaire supérieur de la parcelle dans le découpage cadastrale). Pour une très forte majorité l’éloignement est donc faible.

# Creation de champ X et Y pour la table des parcelles a partir du centroide 
centrpar <- as.data.frame(st_coordinates(st_centroid(st_geometry(parcelles))))
parcelles["X"] <- centrpar$X
parcelles["Y"] <- centrpar$Y
rm(centrpar)

## Creation d'un ID concatene pour chaque parcelle a partir de code INSEE de la commune, de la section cadastrale et du numero de parcelle
### On ne choisit pas le prefixe de section cadastrale, car il n'est pas renseigne sur BIEN 
### NB : Si on a travaille sur des donnees parcellaires anciennes, les champs de commune, section et numero ne sont pas forcement renseignes
### Pour que le script fonctionne avec toutes les annees sans soucis, on les extrait donc a partir de l'ID de la parcelle, present pour chaque version
parcelles["commune"] <- substr(parcelles$idpar,start=1,stop=5)
parcelles["prefixe"] <- substr(parcelles$idpar,start=6,stop=8)
parcelles["section"] <- substr(parcelles$idpar,start=9,stop=10)
parcelles["numero"] <- substr(parcelles$idpar,start=11,stop=14)


parcelles["IDCONCAT"] <- paste(parcelles$commune,parcelles$section,parcelles$numero, sep="")

nrow(parcelles[which(parcelles$prefixe != '000'),])
head(parcelles)
## Creation d'une couche section parcellaire a partir de la couche parcelles
### Creation d'un ID concatene de la section cadastrale, pour la jointure avec BIEN
parcelles["IDCONCATSEC"] <- paste(parcelles$commune,parcelles$prefixe,parcelles$section, sep="")

# Attention : On doit changer le numéro communal pour communes de Paris pour la base BIEN (ex : codage 75001 vers 75101)
BIEN_Brute$insee<- if_else(BIEN_Brute$insee <= 76000, str_replace(as.character(BIEN_Brute$insee), "750", "751"), as.character(BIEN_Brute$insee))

#### Attribution coordonnées géographiques à partir des centroïdes des parcelles ####

# Extrait des transactions san coord
BIEN_Coord <- BIEN_Brute[,c("ID","NRPLAN1","REFSECTION","insee","REQTYPBIEN","X","Y")]

# Creation d'un ID concatene pour chaque ligne de BIEN a partir du code INSEE de la commune, de la section cadastrale et du numero de parcelle
colnames(BIEN_Coord) <- c("ID","num_plan","cod_section","num_cominsee","REQTYPBIEN","x","y")

## Il faut passer par des etapes intermediaires afin de faire correspondre les formats entre les parcelles et BIEN, surtout au niveau des numeros de parcelle et de la section cadastrale

### Rajouts de 0 si necessaire afin de mettre le numero de parcelle sur 4 caracteres, et le code de section cadastrale sur 2 caracteres

#### On converti les colonnes num_plan et cod_section en chaine de caractere, au lieu de facteur
BIEN_Coord$num_plan <- as.character(BIEN_Coord$num_plan)

BIEN_Coord$cod_section <- as.character(BIEN_Coord$cod_section)

#### Rajout des 0 lorsque necessaire
BIEN_Coord <- BIEN_Coord%>%
  mutate( num_plan = case_when(is.na(num_plan)~"ERREUR", TRUE ~num_plan))

BIEN_Coord$num_plan <- if_else(nchar(as.character(BIEN_Coord$num_plan)) == 1, as.character(paste("000",BIEN_Coord$num_plan, sep="")), 
if_else(nchar(as.character(BIEN_Coord$num_plan)) == 2, as.character(paste("00",BIEN_Coord$num_plan, sep="")),
if_else(nchar(as.character(BIEN_Coord$num_plan)) == 3, as.character(paste("0",BIEN_Coord$num_plan, sep="")),as.character(BIEN_Coord$num_plan))))

BIEN_Coord <- BIEN_Coord%>%
  mutate( cod_section = case_when(is.na(cod_section)~"ERREUR", TRUE ~cod_section))

BIEN_Coord$cod_section <- if_else(nchar(as.character(BIEN_Coord$cod_section)) == 1, as.character(paste("0",BIEN_Coord$cod_section, sep="")),as.character(BIEN_Coord$cod_section))

nchar(as.character(parcelles$IDCONCATSEC)) == 10
#### Numero de parcelle
# for(i in 1:nrow(BIEN)) {
#   if(is.na(BIEN[i,"num_plan"])) { BIEN[i,"num_plan"] <- as.character("ERREUR") }
#   else if(nchar(as.character(BIEN[i,"num_plan"])) == 1) {
#     BIEN[i,"num_plan"] <- as.character(paste("000",BIEN[i,"num_plan"], sep=""))
#   }
#   else if(nchar(as.character(BIEN[i,"num_plan"])) == 2) {
#     BIEN[i,"num_plan"] <- as.character(paste("00",BIEN[i,"num_plan"], sep=""))
#   }
#   else if(nchar(as.character(BIEN[i,"num_plan"])) == 3) {
#     BIEN[i,"num_plan"] <- as.character(paste("0",BIEN[i,"num_plan"], sep=""))
#   }
# }

## Code de section cadastrale
# for(i in 1:nrow(BIEN)) {
#   if(is.na(BIEN[i,"cod_section"])) { BIEN[i,"cod_section"] <- as.character("ERREUR") }
#   else if(nchar(as.character(BIEN[i,"cod_section"])) == 1) {
#     BIEN[i,"cod_section"] <- as.character(paste("0",BIEN[i,"cod_section"], sep=""))
#   }
# }

# On peut alors creer l'ID concatene qui va permettre de faire la jointure avec la table des parcelles
BIEN_Coord["IDCONCAT"] <- paste(BIEN_Coord$num_cominsee,BIEN_Coord$cod_section,BIEN_Coord$num_plan, sep="")

# Creation ID concatene qui va permettre de faire la jointure avec la table des sections si necessaire
#Prefixe
BIEN_Coord$prefixe_sec <- "000"
BIEN_Coord["IDCONCATSEC"] <- paste(BIEN_Coord$num_cominsee,BIEN_Coord$prefixe_sec,BIEN_Coord$cod_section, sep="")

length(which(BIEN_Coord$num_plan=="ERREUR"))
# Résulat intermédiaire : problème d'encodage des attributs parcellaires pour au moins 1908 transactions

### Jointure  entre BIEN et la couche des parcelles
BIEN_Coord_Parcelles<- BIEN_Coord %>%
  left_join(., as.data.frame(parcelles)%>%
              select(-geometry), 
            by = "IDCONCAT") %>%
  filter(!duplicated(ID))


unique(duplicated(BIEN_Coord_Parcelles$ID))
length(which(is.na(BIEN_Coord_Parcelles$X)))# 88241 transactions sans parcelle identifée


BIEN_AjustCoord <- BIEN_Coord_Parcelles%>%
  rename(X_parcelles = X) %>%
  rename(Y_parcelles = Y) 


BIEN_AjustCoord <- BIEN_AjustCoord %>%
  mutate(Result_Coords = case_when((x < 100 | is.na(x)) & !is.na(X_parcelles)~ "NoOriginalsCoords_ParcellesCoords", 
                                   (x < 100 | is.na(x))  & is.na(X_parcelles)~ "NoOriginalsCoords_NoParcellesCoords",
                                   x > 100 & is.na(X_parcelles)~ "OriginalsCoords_NoParcellesCoords",
                                   x > 100 & !is.na(X_parcelles)~ "OriginalsCoords_ParcellesCoords"))

table(BIEN_AjustCoord$Result_Coords, useNA = "always")


# Résultats : sur 46717 lignes sans coords X,Y et erreurs ; 7 719 n'ont pas d'attribution avec les parcelles (informations manquantes, d'autres erronnées, actualisation du cadastre ?) : ces transactions sont écartées de l'analyse
# 80 522 lignes avec coordonnées sans attributs directs avec la parcelle cadastrale : on garde les coordonnées d'origine 
# 43 547 lignes sans coordonnéees avec attributs directs avec la parcelle cadastrale : on stocke les coordonnées de la parcelle cadastrale comme coordonnées des transactions
# 982 007 lignes avec coordonnées et attributs directs avec la parcelle cadastrale : on stocke les coordonnées de la parcelle cadastrale comme coordonnées des transactions

BIEN_AjustCoord <- BIEN_AjustCoord%>%
  select(ID,x, y, X_parcelles,Y_parcelles,Result_Coords )

#### Changement de projection avec conversion  lambert 2 étendu vers lambert93 et stockage des nouvelles coordonnées ####

## Transformation en objet spatial
BIEN_AjustCoord_NewCoords <- st_as_sf(BIEN_AjustCoord %>% select(ID,x,y,Result_Coords) %>% filter (Result_Coords == "OriginalsCoords_NoParcellesCoords" & !is.na(x) & !is.na(y)),
                     
                     coords = c("x", "y"),
                     
                     agr = "constant",
                     
                     crs = 27572,# Lambert 2 étendu
                     
                     stringsAsFactors = FALSE)

# 1 transaction éliminée
## conversion Lamb 93 et stockage coords
BIEN_AjustCoord_NewCoords <-  st_transform(BIEN_AjustCoord_NewCoords, crs = 2154)
coords <- st_coordinates(BIEN_AjustCoord_NewCoords)
BIEN_AjustCoord_NewCoords$Xlamb93<-coords[,1]   
BIEN_AjustCoord_NewCoords$Ylamb93<-coords[,2]

BIEN_AjustCoord_NewCoords <- as.data.frame(BIEN_AjustCoord_NewCoords)%>%
  select (-geometry, - Result_Coords)

## Mise en forme lignes avec coordonnées parcelles cadastrales
BIEN_AjustCoord_ParcellesCoords<- BIEN_AjustCoord %>% 
  select(ID,X_parcelles,Y_parcelles,Result_Coords)%>% 
  filter (Result_Coords != "OriginalsCoords_NoParcellesCoords")

BIEN_AjustCoord_ParcellesCoords<-BIEN_AjustCoord_ParcellesCoords %>%
  rename(Xlamb93 = X_parcelles) %>%
  rename(Ylamb93 = Y_parcelles) %>%
  select (-Result_Coords)

## Bindage des 2 tableaux

BIEN_CleanCoords <- rbind(BIEN_AjustCoord_NewCoords, BIEN_AjustCoord_ParcellesCoords)

# Arrange ID
BIEN_CleanCoords<-BIEN_CleanCoords %>% arrange(ID)
unique(duplicated(BIEN_CleanCoords$ID))
length(which(is.na(BIEN_CleanCoords$Xlamb93))) # Résulatat final : 7719 transactions n'ont pas d'informations sur les coordonnées géographiques et seront écartées

# df final
BIEN_Brute2 <- left_join(BIEN_Brute, BIEN_CleanCoords, by = "ID")

#Ecrasement parcelles
rm(parcelles)

Filtrage sur le prix et l’année

Les transactions qui ne possèdent pas d’informations sur l’année et sur le prix sont écartées. De plus, exclusion des biens les moins onéreux pour de potentiels transactions déguisées.

# Programme filtrage sur le prix et l'année 
## Etape 1
# On favorise ici un filtrage détaillé par étapes
BIEN_Brute2$REQ_PRIX <- as.numeric(BIEN_Brute2$REQ_PRIX)
BIEN_filt1 <- BIEN_Brute2%>%
  dplyr::filter(!is.na(REQ_PRIX)) %>% # filtrage sur indication des prix (nominaux nets vendeurs)    
  filter (annee >= 1996 & annee <= 2018) %>% # filtrage sur années 
  filter(REQ_PRIX > quantile(BIEN_Brute2$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)
  filter(ID != 403773 | ID != 253617 | ID != 570130 | !ID != 910347) # exclusion des biens qui présentent des prix très anormalement élevés (ligne N disponible pour l'échantillon )

Nombre d’individus après nettoyage étape 1 : 1 101 120

Filtrage sur le géoréférencement

Toutes les transactions sans information de localisation par coordonnées géographiques sont retirées de l’échantillon initial.

# Programme filtrage sur le géoréférencement
BIEN_filt1$X<- as.numeric(BIEN_filt1$Xlamb93)
BIEN_filt1$Y<- as.numeric(BIEN_filt1$Ylamb93)
BIEN_filt2 <- BIEN_filt1 %>%
filter(!is.na(Xlamb93) & !is.na(Ylamb93)) %>%# Filtrage sur les coord.
 filter(Xlamb93 >100 & Ylamb93 > 100)# On précise pour éviter des coord aberrantes et mal renseignées(bcp de valeurs == 0)

Nombre d’individus après nettoyage étape 2 : 1 094 055

Filtrage sur les types de biens

Exclusion des produits immobiliers exceptionnels/spécifiques

L’exclusion de logements spécifiques

Nous excluons les ateliers d’artiste, les chambres de service, les greniers destinés à être aménagés en appartement et les logements de gardien faisant office de loge. Pour les maisons nous excluons les tours et moulins, les fermes, les hôtels particuliers, les châteaux et grandes propriétés et les maisons rurales.

  # 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 et maisons rurales.
BIEN_filt3 <- BIEN_filt3 %>%
dplyr::filter (is.na(TYPMAI) |TYPMAI!="DI" & TYPMAI!="FE" &  TYPMAI!="RU")

Nombre d’individus après nettoyage étape 3 : 1 088 078

Ecarter les biens isolés avec DBSCAN

2 objecifs = travailler uniquement sur les espaces sans densités résiduelles du marché + que toutes les opérations de traitement des données renvoient des résulats qui sont agrégés sur la base d’au moins 5 individus statistiques (voir distance des fonctions du calcul de potentiels).

## On garde l'ID, les années et les coordonnées et Passage en data frame
semis_BIEN <- as.data.frame(BIEN_filt3[,c("ID","annee","Xlamb93","Ylamb93")])

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

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<-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 = 2018,
#              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,  "OutsideCluster",ifelse (tableau_RECUP$cluster>=1 , "InsideCluster", NA ))


##Visualisation des résultats avec le package ggplot2 

ggplot(tableau_RECUP, aes(Xlamb93, Ylamb93, 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),ylim=range(tableau_RECUP$Y))+
  facet_wrap(~annee,ncol = 4, 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 (N redressée) ; Réalisation : Thibault Le Corre")

## Jointure
semis_BIEN<- left_join (semis_BIEN, tableau_RECUP[,c("ID","cluster")], by = "ID")

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

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

Les transactions écartées concernent essentiellement des villages et petites villes en périphérie de la région.

Nombre d’individus après nettoyage étape 4 : 1 072 116

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

Les promoteurs immobiliers, ne sont pas directement détectables dans la base. Toutefois, des biens probablement vendus par des promoteurs ont été isolés. Il ne s’agit pas ici d’une étape de nettoyage pour éliminer des individus. Il s’agit d’une opération de correction et d’ajout de l’information.

# Selection des individus probables : Biens neufs et personnes morales type "entreprises" ou "sociétés"
Promo <- as.data.frame(BIEN_Filt4) %>%
  filter (REQ_ANC=="2", QUALITE_VE== "EN" |  QUALITE_VE== "SC")

# Sélection des variables d'intérêt
Promo <- as.data.frame(Promo[,c("ID","annee","REQTYPBIEN", "Xlamb93","Ylamb93")])

## 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

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)], 100,5,borderPoints = T)
### On retient comme paramètres 5 transactions pour une distance de 100M

  res.db$ID<-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,5,borderPoints = T)
### On retient comme paramètres 5 transactions pour une distance de 300M

  res.db$ID<-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","typeVarPromo")])

91 354 appartements sont qualifiés comme “vendus par des promoteurs” ; 11224 maisons sont qualifiées comme “vendues par des promoteurs”.

Redressement

Duplication des transactions pour les communes de plus de 10 000 habitants en 2011.

#Ecrasement objets individuels et enregistrement objet precedent car traitements suivant lourds (risque de crash)
rm(BIEN_filt1, BIEN_filt2, BIEN_filt3, BIEN_Filt4, BIEN_Coord_Parcelles)
write.csv2(BIEN_Filt5, file = "CASSMIR_Outputs/BIEN_Filt5.csv",
             row.names = FALSE)

#Population communale 2011
Com_Sf$INSEE_COM<- as.character(Com_Sf$INSEE_COM)

# PopCom2011_sf <- PopIris2011 %>%
#   group_by(COM) %>%
#   summarise(PopCom = sum(P11_POP)) %>%
#   left_join(Com_Sf %>%
#               select("INSEE_COM","geometry"),., by= c("INSEE_COM" = "COM"))

ComMoins10000$Code.INSEE<- as.character(ComMoins10000$Code.INSEE)
PopCom2011_sf <- anti_join(Com_Sf %>%
              select("INSEE_COM","geometry"),ComMoins10000, by= c("INSEE_COM" = "Code.INSEE"))
# %>%
#   filter(!is.na(Population))

 ## Transformation du data frame de l'étape précédente en objet spatial
## Transformation en objet spatial

BIEN_SF_Filt5 <- st_as_sf(BIEN_Filt5,
                     
                     coords = c("Xlamb93", "Ylamb93"),
                     
                     agr = "constant",
                     
                     crs = 2154,
                     
                     stringsAsFactors = FALSE) 


BIEN_SF_Filt5 <-  st_transform(BIEN_SF_Filt5, crs =2154)
PopCom2011_sf<- st_transform(PopCom2011_sf, crs =2154)
#Jointure Transaction-Communes
COM_BIEN<-st_join(PopCom2011_sf, BIEN_SF_Filt5, join = st_contains, left=T) %>%
  filter(!is.na(ID)) # NB Quelques transactions tombent à côté des limites régionales (si on prend toutes les communes pour l'opération)

COM_BIEN <-  as.data.frame(COM_BIEN)%>%
  select(-"geometry") %>%
  arrange(ID)

COM_BIEN <- left_join(COM_BIEN %>%
                        select(-INSEE_COM), BIEN_Filt5[,c("ID", "Xlamb93", "Ylamb93")], by = "ID")

BIEN_Redress <- rbind(BIEN_Filt5,
      COM_BIEN)

BIEN_clean <- BIEN_Redress

BIEN_clean<-BIEN_clean%>%
arrange(ID)

BIEN_clean$ID_new <- row.names(BIEN_clean)


# PopDuplicated <- COM_BIEN %>% 
#         filter(PopCom>=10000)

#Duplication des lignes appartenant à une commune >= 10000 habitants (Insee).
# COM_BIEN <- rbind(COM_BIEN,
#       COM_BIEN %>% 
#         filter(PopCom>=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(-"geometry") %>%
#   arrange(ID)
# 
# # Recuperation des X et Y
# COM_BIEN<- left_join(COM_BIEN,BIEN_SF_Filt5[,c("ID", "Xlamb93", "Ylamb93")], by = "ID")
# 
# # Echantillon BIEN nettoyé
# BIEN_clean <- COM_BIEN
# 
# # Génération de nouveaux identifiants pour la variable : "ID" afin d'éviter des opérations contraintes par la duplication des identifiants (par exemple des jointures). 
# BIEN_clean$ID_new <- row.names(BIEN_clean)
# write.csv2(BIEN_clean, file = "CASSMIR_Outputs/BIEN_clean.csv",
#              row.names = FALSE)

Fin des opération de nettoyage de la base BIEN, nombre d’individus de l’échantillon avant préparation : 1 887 177 (dont plus de 800 000 transactions dupliquées)

Délimitation de l’espace géographique du marché sur le carroyage 1km et 200m

Un découpage est effectué sur le carroyage 1km et 200m en retenant uniquement les carreaux où au moins une transaction immobilière a été observée, ceci afin de n’étudier que l’espace du marché à la propriété (en supposant que l’ensemble de l’espace urbain n’est pas ) et, en conséquence de la diminution du nobre d’entités spatiales, de diminuer le coûts computationnel lié aux calculs de potentiels. Les couches nouvelles crées sont exportées en Geopackage dans le dossier local “CASSMIR_Geom”. Ce dossier est localisé à l’emplacement du projet CASSMIR. En ce qui concerne les couches importées (carroyage 1km et 200m), elles ont été préparées au préalable et stockées dans ce même dossier en .gpkg. Pour plus d’explications voir l’onglet “PlayWithCassmir”

#Selection des entités sur les grilles 1km et 200m qui correspondent à l'espace périmètrique du marché immobilier, c'est à dire les entités avec des transactions observées dans la période étudiée.
## Grids

Grid200 <- st_read("CASSMIR_Geom/geom_IDF.gpkg", quiet = TRUE, layer = "grid200")
Grid1k <- st_read("CASSMIR_Geom/geom_IDF.gpkg", quiet = TRUE, layer = "grid1km")

### BIEN_sf
BIEN_sf <- BIEN_clean %>%
  select(ID, Xlamb93, Ylamb93) %>% # On garde uniquement les variables d'intérêts
st_as_sf(.,coords = c("Xlamb93", "Ylamb93"),agr = "constant", crs = 2154, stringsAsFactors = FALSE) %>%
  st_transform(., crs = "+init=epsg:2154")
  # Passage en objet spatial SF 

### Jointures spatiales
Grid1kmJoinBIEN<- st_join(st_transform(Grid1k, crs = "+init=epsg:2154"), BIEN_sf, join = st_contains, left=T)

Grid200JoinBIEN<- st_join(st_transform(Grid200, crs = "+init=epsg:2154"), BIEN_sf, join = st_contains, left=T)

### Filtrage sur le nombre de transactions : on garde uniquement "l'espace du marché"
MarketSpaceGrid1km<- Grid1kmJoinBIEN%>% 
  group_by(Id_carr1km) %>%
  summarise (N_TotalTransacs = length(which(ID != "NA"))) %>%
  filter(N_TotalTransacs >= 1) %>% 
  select(Id_carr1km, geom)

MarketSpaceGrid200m<- Grid200JoinBIEN%>% 
  group_by(IdINSPIRE) %>%
  summarise (N_TotalTransacs = length(which(ID != "NA"))) %>%
  filter(N_TotalTransacs >= 1) %>% 
  select(IdINSPIRE, geom)
  
### Création d'un identifiant numérique
MarketSpaceGrid1km$Carreau_ID<-1:length(MarketSpaceGrid1km$Id_carr1km)

MarketSpaceGrid200m$Carreau_ID<-1:length(MarketSpaceGrid200m$IdINSPIRE)

## Export des géométries
st_write(obj =  MarketSpaceGrid1km, dsn = "CASSMIR_Geom/geom_IDF.gpkg", layer = "MarketSpaceGrid1km",  delete_layer = TRUE, quiet = TRUE)

st_write(obj =  MarketSpaceGrid200m, dsn = "CASSMIR_Geom/geom_IDF.gpkg", layer = "MarketSpaceGrid200m",  delete_layer = TRUE, quiet = TRUE)

 # MarketSpaceGrid200m <- st_read("CASSMIR_Geom/geom_IDF.gpkg", quiet = TRUE, layer = "MarketSpaceGrid200m")
 # MarketSpaceGrid1km <- st_read("CASSMIR_Geom/geom_IDF.gpkg", quiet = TRUE, layer = "MarketSpaceGrid1km")
# Penser à nettoyer l'environnement rm()

rm(Grid1kmJoinBIEN, Grid200JoinBIEN, BIEN_sf)

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

BIEN_select <- BIEN_clean %>%
  select(ID_new, annee, Xlamb93, Ylamb93, 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)

Le champ d’investigation des prix

Variables

  • 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

Script sur les prix

BIEN_Prices <-  BIEN_select %>% 
  select(ID_new, annee, Xlamb93, Ylamb93, REQ_PRIX, REQ_PM2 ) # Les variables spatiales et temporelles sont inclues ici.

Le champ d’investigation des acquéreurs-vendeurs

Variables préparées

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

  • Type_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”

  • Type_Ve ; nom complet : Type de vendeur ; valeurs des attributs : “TYP5”, “TYP4”, “TYP3”, “TYP1”, “TYP2”

TYP5 = Personne morale identifiée comme promoteur immobilier (voir opération ci-dessus)

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

  • PCS_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)

  • PCS_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 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 Type_Ve = “TYP1”, sinon \(NA\).

  • SitMatri_Acq ; nom complet : Situation matrimoniale de l’acquéreur ; valeurs des attributs : “CEL”, “CONJ”, “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”, “CONJ”, “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\).

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

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

BIEN_ACVE <- as.data.frame(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
BIEN_ACVE <- 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"),
        PCS_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
BIEN_ACVE <- 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"),
        PCS_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 
BIEN_ACVE <- 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
BIEN_ACVE <- BIEN_ACVE %>%
  mutate( SitMatri_Acq =  case_when( Nature_Acq == "PPH" & (SITMAT_AC == "M" | SITMAT_AC == "P" |SITMAT_AC == "R") ~ "CONJ",
                            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") ~ "CONJ",
                            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
BIEN_ACVE<- 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"))

BIEN_ACVE <- BIEN_ACVE %>%
  select(ID_new, Nature_Acq, Nature_Ve, Type_Acq, Type_Ve,PCS_Acq, PCS_Ve,Age_Acq, Age_Ve,Tranche_Age_Acq, Tranche_Age_Vendeur,SitMatri_Acq, SitMatri_VE, Sexe_Acq, Sexe_Ve)

# Portée géographique
## création d'un nouvel objet
BIEN_PORTEE <- BIEN_select %>%
  select(ID_new, NUMCOM_AC, PADEPT_AC,Xlamb93,Ylamb93)


BIEN_PORTEE <- st_as_sf(BIEN_PORTEE,
                     
                     coords = c("Xlamb93", "Ylamb93"),
                     
                     agr = "constant",
                     
                     crs = 2154,
                     
                     stringsAsFactors = FALSE) 

## Pour Paris pas d'information sur les arrondissement quand Paris commune d'origine de l'acquéreur : modification de la couche commune

Communes2 <- Com_Sf %>%
  mutate(INSEE_COM = 
           ifelse(CODE_DEPT == 75, 75056, as.character(INSEE_COM))) %>%
  group_by (INSEE_COM) %>%
  summarise() %>%
  st_transform(.,"+init=epsg:2154")

## Jointure spatiale
CommunesJoin<-st_join(BIEN_PORTEE, Communes2, join = st_within, left=T)

### Recodage commune origine

CommunesJoin <- CommunesJoin %>%
  mutate(Num_Com_Acq = 
           ifelse (NUMCOM_AC>=10 & NUMCOM_AC<100, paste0("0",NUMCOM_AC), ifelse( NUMCOM_AC<10, paste0("00",NUMCOM_AC),NUMCOM_AC)),
         Num_Com_Acq = paste0(PADEPT_AC,Num_Com_Acq))


### Origine régionale
CommunesJoin <- CommunesJoin %>%
  mutate(Region = ifelse( PADEPT_AC==75|PADEPT_AC==91|PADEPT_AC==92|PADEPT_AC==93|PADEPT_AC==94|PADEPT_AC==95|PADEPT_AC==77|PADEPT_AC==78, "Region_IDF","Autres_region"))

### Communes voisines

CommunesJoin_2 <- CommunesJoin %>% filter (Region == "Region_IDF", !is.na(INSEE_COM))

diff <- setdiff(CommunesJoin_2$Num_Com_Acq,Communes2$INSEE_COM)

CommunesJoin_2 <- CommunesJoin_2 %>%
  filter(!Num_Com_Acq %in% diff & !is.na(NUMCOM_AC))


### Les communes intersectent leurs voisins
CommunesVoisines <- st_intersects(Communes2,Communes2)

### Fonction créée pour déterminer si l'acquéreur est résident dans la communes d'achat ou une de ses voisine

getNeig <- function(x, y, tabref, nei){ 
  idTrans <- which(x == tabref$INSEE_COM)
  idResid <- which(y == tabref$INSEE_COM)
  vecNei <- nei[[idResid]]
  test<- idTrans %in% vecNei
  return(test)
}

Acq_portee_proche <- base::mapply(getNeig, x = CommunesJoin_2$INSEE_COM, y= CommunesJoin_2$Num_Com_Acq, 
                                  MoreArgs = list(tabref = Communes2, nei = CommunesVoisines))

### extraction des résultats

Result_Local <- list(Acq_portee_proche) 

Result_Local <- Result_Local %>%
map(., ~ cbind.data.frame (.)) %>%
  cbind.data.frame()

names(Result_Local)[1] <- "Com_Resid_Neigh"
Result_Local$Com_Resid_Neigh <- as.character(Result_Local$Com_Resid_Neigh)
CommunesJoin_2 <- bind_cols(CommunesJoin_2,Result_Local)
CommunesJoin_2 <- as.data.frame(CommunesJoin_2) %>% 
  select(-geometry)

### Jointures
BIEN_PORTEE <- left_join(as.data.frame(BIEN_PORTEE), CommunesJoin_2[,c("ID_new","Num_Com_Acq", "Region", "Com_Resid_Neigh")], by="ID_new")

# Requêtes finales 
BIEN_PORTEE <- BIEN_PORTEE %>%
  mutate(Provenance_Acq = case_when(Region == "Region_IDF" & Com_Resid_Neigh =="TRUE" ~ "LOC", TRUE ~ "Autre"),
         Provenance_Acq = case_when(Provenance_Acq == "Autre" & Region  =="Region_IDF" ~ "REG", TRUE ~ Provenance_Acq),
         Provenance_Acq = case_when(Provenance_Acq == "Autre" & (is.na(Region)  & PADEPT_AC != 99) ~ "NAT", TRUE ~ Provenance_Acq),
         Provenance_Acq = case_when(Provenance_Acq == "Autre" & PADEPT_AC == 99 ~ "INTER", TRUE ~ Provenance_Acq))

BIEN_PORTEE <- BIEN_PORTEE %>% # On transforme la valuer "Autre" en NA
  replace_with_na(replace = list(Provenance_Acq = "Autre")) %>%
  select(ID_new, Provenance_Acq)


### Jointure finale ###

BIEN_ACVE <- full_join(BIEN_ACVE, BIEN_PORTEE, by = "ID_new")

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

Les variables sur le régime d’achat et type de mutation

  • 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\).

“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, “Caution” = CAUT

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

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

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

# Présence d'un crédit

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

# Type de prêt
BIEN_PURCHMUT <- 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)
BIEN_PURCHMUT <- 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
# Le format de date n'est pas le même pour les années 2015 et 2018 (Y-M-D) et les autres années (D-M-Y)
BIEN_PURCHMUT1518<- BIEN_PURCHMUT %>%
  filter(annee==2015 | annee==2018)
BIEN_PURCHMUT1518$Annee_MUTPREC <- as.numeric(substr(BIEN_PURCHMUT1518$DATMUTPREC, start = 1, stop = 4))

BIEN_PURCHMUT9612<- BIEN_PURCHMUT %>%
  filter(annee>= 1996 & annee<=2012)

BIEN_PURCHMUT9612$Annee_MUTPREC <- as.numeric(substr(BIEN_PURCHMUT9612$DATMUTPREC, start = 7, stop = 10))
#Opération pour informations avec espace entre charactères
BIEN_PURCHMUT9612$Annee_MUTPREC<- ifelse(BIEN_PURCHMUT9612$Annee_MUTPREC<1000, as.numeric(substr(BIEN_PURCHMUT9612$DATMUTPREC, start = 6, stop = 10)),BIEN_PURCHMUT9612$Annee_MUTPREC)

BIEN_PURCHMUT <- bind_rows(BIEN_PURCHMUT9612,BIEN_PURCHMUT1518)
#Durée de détention du bien en années : année de référence de la transaction - année de référence de la transaction précédente
BIEN_PURCHMUT$Duree_Detention_Ve <- BIEN_PURCHMUT$annee - BIEN_PURCHMUT$Annee_MUTPREC

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

BIEN_PURCHMUT <- 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"))

BIEN_PURCHMUT <- BIEN_PURCHMUT %>%
  select(ID_new, PresCred_Acq, TypePret_Acq, MTCRED, TypMutPrec_VE, Duree_Detention_Ve,Tranche_DureeDetention_Ve, REQ_VALUE)

Le champ d’investigation des types de biens immobiliers

Les variables sur les types de biens immobiliers

  • 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)

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

BIEN_TBTaille <- as.data.frame (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" ))


BIEN_TBAnciennete <- as.data.frame (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"))


BIEN_TB <- full_join(BIEN_TBTaille[, c("ID_new", "REQTYPBIEN", "TypBien")], BIEN_TBAnciennete[,c("ID_new", "Anciennete")], by = "ID_new")

Jointure des quatres tables données BIEN

BIEN_ReadyForOp <- full_join(BIEN_Prices, BIEN_ACVE, by = "ID_new") %>%
  full_join(.,BIEN_PURCHMUT, by = "ID_new")%>%
  full_join(.,BIEN_TB, by = "ID_new")

 # write.csv2(BIEN_ReadyForOp, file = "CASSMIR_Outputs/BIEN_ReadyForOp.csv",
 #             row.names = FALSE)

Fin des opérations de préparation de la base BIEN, nombre d’individus de l’échantillon après préparation : 1 887 177

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

Fonction pour le calcul des potentiels sur les carreaux 200m et 1km de côté

#### 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 N 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 N 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 objets pour le traitement spatial

BIEN_Prices <- BIEN_ReadyForOp %>%
  st_as_sf(.,coords = c("Xlamb93", "Ylamb93"),agr = "constant", crs = 2154, stringsAsFactors = FALSE) %>%
  select(ID_new,  annee, REQTYPBIEN, TypBien, REQ_PRIX, REQ_PM2)

BIEN_BuyerSeller <- BIEN_ReadyForOp %>%
  st_as_sf(.,coords = c("Xlamb93", "Ylamb93"),agr = "constant", crs = 2154, stringsAsFactors = FALSE) %>%
  select(ID_new,  annee, Nature_Acq, Type_Acq,PCS_Acq, Nature_Ve,   Type_Ve, PCS_Ve, Sexe_Acq, Sexe_Ve, Age_Acq, Age_Ve, Tranche_Age_Acq, Tranche_Age_Vendeur, SitMatri_Acq, SitMatri_VE,Provenance_Acq)

BIEN_PURCHMUT <- BIEN_ReadyForOp %>%
  st_as_sf(.,coords = c("Xlamb93", "Ylamb93"),agr = "constant", crs = 2154, 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 <- BIEN_ReadyForOp %>%
  st_as_sf(.,coords = c("Xlamb93", "Ylamb93"),agr = "constant", crs = 2154, 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(Com_Sf, BIEN_Prices, join = st_contains, left=T)

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

####### Prix Nominaux pour l'ensemble des maisons et appartements ########
ComPricesAll <- ComJoinBIEN %>% 
  filter(!is.na(REQ_PRIX)) %>% 
  group_by(INSEE_COM, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            M = mean (REQ_PRIX, na.rm = T),
            Q2 = median (REQ_PRIX, na.rm = T),
            SD = 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(INSEE_COM, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            M = mean (REQ_PRIX, na.rm = T),
            Q2 = median (REQ_PRIX, na.rm = T),
            SD = 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(INSEE_COM, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            M = mean (REQ_PRIX, na.rm = T),
            Q2 = median (REQ_PRIX, na.rm = T),
            SD = 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(INSEE_COM, annee) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            M = mean (REQ_PM2, na.rm = T),
            Q2 = median (REQ_PM2, na.rm = T),
            SD = 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(INSEE_COM, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            M = mean (REQ_PRIX, na.rm = T),
            Q2 = median (REQ_PRIX, na.rm = T),
            SD = 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(INSEE_COM, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(ID_new))),
            M = mean (REQ_PM2, na.rm = T),
            Q2 = median (REQ_PM2, na.rm = T),
            SD = 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("INSEE_COM","annee")) %>%
  full_join (., ComPricesHouses, 
             by = c("INSEE_COM","annee")) %>%
  full_join (., ComPricesTypBien, 
             by = c("INSEE_COM","annee")) %>%
  full_join (., ComPM2Appart, 
             by = c("INSEE_COM","annee")) %>%
  full_join (., ComPM2TypAppart, 
             by = c("INSEE_COM","annee")) %>%
  left_join(Com_Sf[,c("INSEE_COM")],., by= "INSEE_COM")

str(CommunesPrices_BIEN)

Script sur les carreaux 1km

# Jointure Spatiale
Grid1kmJoinBIEN<- st_join(MarketSpaceGrid1km, 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(MarketSpaceGrid1km, Grid1kmPricesAll, by = "Carreau_ID")

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

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

Gr1km_PotentialAllPrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_M = 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(MarketSpaceGrid1km, Grid1kmPricesHouse, by = "Carreau_ID")

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

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

Gr1km_PotentialHousePrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_MAI_M = 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(MarketSpaceGrid1km, Grid1kmPricesAppart, by = "Carreau_ID")

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

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

Gr1km_PotentialAppartPrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_APP_M = 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(MarketSpaceGrid1km, Grid1kmPricesAppart, by = "Carreau_ID")

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

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

Gr1km_PotentialAppartPM2<- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PM_APP_M = 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(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                                 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_",.))) %>%
rename_at(3:ncol(.), list( ~paste0(.,"_M")))

####### 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(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                                 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_",.))) %>%
rename_at(3:ncol(.), list( ~paste0(.,"_M")))


############ 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(MarketSpaceGrid1km,., by = "Carreau_ID")

Script sur les carreaux 200m

# Jointure Spatiale
Grid200mJoinBIEN<- st_join(MarketSpaceGrid200m, 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(MarketSpaceGrid200m, Grid200mPricesAll, by = "Carreau_ID")

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

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

Gr200m_PotentialAllPrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_M = 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(MarketSpaceGrid200m, Grid200mPricesHouse, by = "Carreau_ID")

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

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

Gr200m_PotentialHousePrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_MAI_M = 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(MarketSpaceGrid200m, Grid200mPricesAppart, by = "Carreau_ID")

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

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

Gr200m_PotentialAppartPrices <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PX_APP_M = 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(MarketSpaceGrid200m, Grid200mPricesAppart, by = "Carreau_ID")

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

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

Gr200m_PotentialAppartPM2<- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_PM_APP_M = 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(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                                 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_",.))) %>%
rename_at(3:ncol(.), list( ~paste0(.,"_M")))

####### 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(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                                 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_",.))) %>%
rename_at(3:ncol(.), list( ~paste0(.,"_M")))


############ 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(MarketSpaceGrid200m,., by = "Carreau_ID")

rm(BIEN_Prices)

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

Script sur les communes

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

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

#### 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(INSEE_COM , annee, Nature_Acq) %>%
  group_by(INSEE_COM, 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_",.)))


# Total des vendeurs et nature des vendeurs, en pourcentage par commune et par année
ComNatVe <- ComJoinBIEN %>% 
   filter(!is.na(ID_new)) %>%
  count(INSEE_COM , annee, Nature_Ve) %>%
  group_by(INSEE_COM , 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_",.)))

ComNatVe <- ComNatVe %>%
  select(-`B_VE_<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(Type_Acq)) %>%
  count(INSEE_COM, annee, Type_Acq) %>%
  group_by(INSEE_COM, 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_",.)))

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

# Type de Vendeurs, en pourcentage par commune et par année
ComTypeVe <- ComJoinBIEN %>% 
  filter(!is.na(Type_Ve)) %>%
  count(INSEE_COM, annee, Type_Ve ) %>%
  group_by(INSEE_COM, 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_",.)))

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

# Pourcentage des acquéreurs par CSP, population personnes physiques
ComAcqPrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & !is.na(PCS_Acq)) %>%
  count(INSEE_COM, annee, PCS_Acq) %>%
  group_by(INSEE_COM, annee) %>%
  mutate( B_AC_PPH_TOT = sum(n)) %>%
  spread(PCS_Acq, n, fill = 0) %>% 
  filter(B_AC_PPH_TOT >= 5)  %>%
  mutate_at(4:ncol(.), funs((./B_AC_PPH_TOT)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_AC_PPH_",.)))


# Pourcentage des vendeurs par CSP, population personnes physiques
ComVePrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Ve== "PPH" & !is.na(PCS_Ve)) %>%
  count(INSEE_COM, annee, PCS_Ve) %>%
  ungroup %>%
  group_by(INSEE_COM, annee) %>%
  mutate( B_VE_PPH_TOT = sum(n)) %>%
  spread(PCS_Ve, n, fill = 0) %>% 
  filter(B_VE_PPH_TOT >= 5)  %>%
  mutate_at(4:ncol(.), funs((./B_VE_PPH_TOT)*100)) %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_PPH_",.)))

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


#### Sexe ####
# Acquéreurs, Pourcentage selon Sexe, population personnes physiques
ComAcqSexe_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Acq== "PPH" & !is.na(Sexe_Acq)) %>%
  count(INSEE_COM, annee, Sexe_Acq) %>%
  ungroup %>%
  group_by(INSEE_COM, 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_PPH_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(INSEE_COM, annee, Sexe_Ve) %>%
  ungroup %>%
  group_by(INSEE_COM, 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_PPH_SEX_",.)))

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

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

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

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

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

## vendeurs
ComVeAge_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Ve== "PPH" & !is.na(Age_Ve)) %>%
  group_by(INSEE_COM, annee) %>%
  summarise( NVeMenages = length(which(!is.na(ID_new))),
             M = mean(Age_Ve),
             Q2 = median (Age_Ve),
             SD = sd(Age_Ve))%>%
  filter(NVeMenages >= 5)  %>%
  rename_at(4:ncol(.), list( ~paste0("B_VE_PPH_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(INSEE_COM, annee, Tranche_Age_Acq) %>%
  group_by(INSEE_COM, 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_TYP1_",.)))

ComAcqTrancAge_PrivateIndiv <- ComAcqTrancAge_PrivateIndiv %>%
  select(-NAcqMenages, -`B_AC_TYP1_<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(INSEE_COM, annee, Tranche_Age_Vendeur) %>%
  ungroup %>%
  group_by(INSEE_COM, 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_TYP1_",.)))

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

# Jointure
CommunesAcqVE_Age <- full_join (ComAcqAge_PrivateIndiv, 
                                ComVeAge_PrivateIndiv, 
                                by= c("INSEE_COM","annee")) %>%
              full_join (., 
                         ComAcqTrancAge_PrivateIndiv, 
             by= c("INSEE_COM","annee")) %>%
  full_join (., 
             ComVeTrancAge_PrivateIndiv, 
             by= c("INSEE_COM","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(INSEE_COM, annee, SitMatri_Acq) %>%
  ungroup %>%
  group_by(INSEE_COM, 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_PPH_MATRI_",.)))

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

# Vendeurs
ComVeSitMatri_PrivateIndiv <- ComJoinBIEN %>% 
  filter(Nature_Ve== "PPH" & !is.na(SitMatri_VE)) %>%
  count(INSEE_COM, annee, SitMatri_VE) %>%
  ungroup %>%
  group_by(INSEE_COM, 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_PPH_MATRI_",.)))


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

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

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

ComPortee <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH", !is.na(Provenance_Acq)) %>%
  count(INSEE_COM, annee, Provenance_Acq) %>%
  group_by(INSEE_COM, 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_PPH_ORIGIN_",.)))

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

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

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

Script sur les carreaux 1km

# Jointure Spatiale
Grid1kmJoinBIEN<- st_join(MarketSpaceGrid1km, 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_",.))) %>%
  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_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

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

Grid1kmNatVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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 = MarketSpaceGrid1km,
                              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(Type_Acq)) %>%
  count(Carreau_ID, annee, Type_Acq) %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(Type_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

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

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

Grid1kmTypeVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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 = MarketSpaceGrid1km,
                              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"& !is.na(PCS_Acq)) %>%
  count(Carreau_ID, annee, PCS_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(PCS_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_PPH_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

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

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

Grid1kmCSPVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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 = MarketSpaceGrid1km,
                              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.integer(Gr1km_PotentialCSPVe$Carreau_ID)
Gr1km_PotentialACVE  <- full_join(Gr1km_PotentialCSPAcq,
                                       Gr1km_PotentialCSPVe,
                                       by= c("Carreau_ID", "annee"))


# Jointure intermediaire pour les variables sociales 
Gr1km_PotentialSocial  <- full_join(Gr1km_PotentialNat_ACVE,
                                         Gr1km_PotentialType_ACVE,
                                         by= c("Carreau_ID", "annee")) %>%
  full_join (., Gr1km_PotentialACVE,  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_PPH_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_PPH_SEX_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


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

Grid1kmSexeVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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 = MarketSpaceGrid1km,
                              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 M 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(MarketSpaceGrid1km, Grid1kmAgeAcq, by = "Carreau_ID")

Grid1kmAgeVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                    Years = annees,
                    Limit = 6000,
                    VarStock1 = "PrivIndivAcq_SumAge",
                    VarStock2 = "NAcqTotal") 

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


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

Gr1km_PotentialAgeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_VE_PPH_AGE_M = 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_TYP1_",.))) %>%
  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_TYP1_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

EffectifGrid1kmTrancAgeVe <- sum(Grid1kmTrancAgeVe$NVe)

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

Grid1kmTrancAgeVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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 = MarketSpaceGrid1km,
                              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("B_AC_PPH_MATRI_",.))) %>%
  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("B_VE_PPH_MATRI_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

EffectifGrid1kmSitMatriVe <- sum(Grid1kmSitMatriVe$NVe)

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

Grid1kmSitMatriVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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 = MarketSpaceGrid1km,
                              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_PPH_ORIGIN_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmPortee <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              DistSpan = 3000, 
                              Categories = ProfilsAcq, 
                              Years = annees, Limit = 6000,
                              VarStock1 = "NAcq",
                              VarStock2 = "NAcqTotal")  


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

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

Grid1kmAcqVe <- full_join (Gr1km_PotentialSocial, 
                            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 (., Gr1km_PotentialPortee, 
             by = c("Carreau_ID","annee")) %>%
  left_join(MarketSpaceGrid1km,., by = "Carreau_ID")

Script sur les carreaux 200m

# Jointure Spatiale
Grid200mJoinBIEN<- st_join(MarketSpaceGrid200m, 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_",.))) %>%
  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_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

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

Grid200mNatVe <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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 = MarketSpaceGrid200m,
                              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(Type_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_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Données Vendeurs
Grid200mTypeVe <- Grid200mJoinBIEN %>%
  filter(!is.na(Type_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_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

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

Grid200mTypeVe <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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 = MarketSpaceGrid200m,
                              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" & !is.na(PCS_Acq)) %>%
  count(Carreau_ID, annee, PCS_Acq) %>%
  ungroup () %>%
  group_by(Carreau_ID, annee) %>%
  mutate( NAcqTotal = sum(n)) %>%
  spread(PCS_Acq, n, fill = 0) %>% 
  rename_at(4:ncol(.), list( ~paste0("B_AC_PPH_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

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

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

Grid200mCSPVe <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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 = MarketSpaceGrid200m,
                              Categories = ProfilsVe, 
                              Years = annees,
                              Limit = 1000,
                              VarStock1 = "NVe",
                              VarStock2 = "NVeTotal")  

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

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

# Jointure intermediaire pour les variables sociales 
Gr200m_PotentialSocial  <- full_join(Gr200m_PotentialNat_ACVE,
                                         Gr200m_PotentialType_ACVE,
                                         by= c("Carreau_ID", "annee")) %>%
  full_join (., Gr200m_PotentialACVE,  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_PPH_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_PPH_SEX_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 

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

Grid200mSexeVe <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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 = MarketSpaceGrid200m,
                              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 M 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(MarketSpaceGrid200m, Grid200mAgeAcq, by = "Carreau_ID")

Grid200mAgeVe <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                    Years = annees,
                    Limit = 1000,
                    VarStock1 = "PrivIndivAcq_SumAge",
                    VarStock2 = "NAcqTotal") 

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


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

Gr200m_PotentialAgeVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_VE_PPH_AGE_M = 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_TYP1_",.))) %>%
  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_TYP1_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


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

Grid200mTrancAgeVe <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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 = MarketSpaceGrid200m,
                              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_PPH_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_PPH_MATRI_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


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

Grid200mSitMatriVe <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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 = MarketSpaceGrid200m,
                              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  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_PPH_ORIGIN_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Remise en format Sf
Grid200mPortee <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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_PotentialSocial, 
                            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(MarketSpaceGrid200m,., by = "Carreau_ID")

rm(BIEN_BuyerSeller)

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(Com_Sf, BIEN_PURCHMUT, join = st_contains, left=T)

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

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

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

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

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

ComTranDurDetent_Ve <- ComJoinBIEN %>% 
  filter(Nature_Ve == "PPH" & !is.na(Tranche_DureeDetention_Ve)) %>%
  count(INSEE_COM, annee, Tranche_DureeDetention_Ve) %>%
  group_by(INSEE_COM, 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_PPH_",.)))

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(INSEE_COM, annee, TypMutPrec_VE) %>%
  group_by(INSEE_COM, 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_PPH_TYPMUT_",.)))

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

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

# Rappel : L'indicateur produit indique 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(INSEE_COM, annee, PresCred_Acq) %>%
  group_by(INSEE_COM, 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_PPH_CRED_",.)))

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

##########  Garantie du pret ##########
ComTypPret_Acq <- ComJoinBIEN %>% 
  filter(Nature_Acq == "PPH" & !is.na(TypePret_Acq)) %>%
  count(INSEE_COM, annee, TypePret_Acq) %>%
  group_by(INSEE_COM, 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_PPH_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(INSEE_COM, 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_PPH_",.)))


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

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

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


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

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

Script sur les carreaux 1km

# Jointure Spatiale
Grid1kmJoinBIEN<- st_join(MarketSpaceGrid1km, 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(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumDurDetent",
                       VarStock2 = "NTotal")  


Gr1km_PotentialDurDetentVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_VE_PPH_DET_M = 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_PPH_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmTrancDurDetentVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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_PPH_TYPMUT_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmTypMutPrecVe <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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_PPH_CRED_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Remise en format Sf
Grid1kmPresCredAcq <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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_PPH_GARCRED_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmTypePretAcq <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumMTCRED",
                       VarStock2 = "NTotal")

Gr1km_PotentialMtCred <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_PPH_MTCRED_M = 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(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                       DistSpan = 3000, 
                       Years = annees, Limit = 6000,
                       VarStock1 = "SumMTCRED",
                       VarStock2 = "SumPrices")

Gr1km_PotentialLTV <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_PPH_LTV_M = 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_PotentialMtCred,
            by= c("Carreau_ID", "annee")) %>%
  full_join(., Gr1km_PotentialLTV,
            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(MarketSpaceGrid1km,., by = "Carreau_ID")

Script sur les carreaux 200m

# Jointure Spatiale
Grid200mJoinBIEN<- st_join(MarketSpaceGrid200m, 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(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumDurDetent",
                       VarStock2 = "NTotal")  


Gr200m_PotentialDurDetentVe <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_VE_PPH_DET_M = 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_PPH_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid200mTrancDurDetentVe <- left_join(MarketSpaceGrid200m, 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 enlève la catégorie des NA

# Calcul des potentiels
## Potentiels 
FastPotentialsYearsAndProfils(datasf = Grid200mTrancDurDetentVe,
                              Mask = MarketSpaceGrid200m,
                              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_PPH_TYPMUT_",.))) %>%
  gather(key = "Profil", value="NVe", c(4:ncol(.))) 


# Remise en format Sf
Grid200mTypMutPrecVe <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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_PPH_CRED_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Remise en format Sf
Grid200mPresCredAcq <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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_PPH_GARCRED_",.))) %>%
  gather(key = "Profil", value="NAcq", c(4:ncol(.))) 

# Remise en format Sf
Grid200mTypePretAcq <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumMTCRED",
                       VarStock2 = "NTotal")

Gr200m_PotentialMtCred <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_PPH_MTCRED_M = 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(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                       DistSpan = 500, 
                       Years = annees, Limit = 1000,
                       VarStock1 = "SumMTCRED",
                       VarStock2 = "SumPrices")

Gr200m_PotentialLTV <- Resultat %>%
  filter(!is.na(Potential))%>%
  rename(B_AC_PPH_LTV_M = 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_PotentialMtCred,
            by= c("Carreau_ID", "annee")) %>%
  full_join(., Gr200m_PotentialLTV,
            by= c("Carreau_ID", "annee"))



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

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


rm(BIEN_PURCHMUT)

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

Script sur les communes

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

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


####### 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(INSEE_COM, annee, TypBien) %>%
  group_by(INSEE_COM, 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_",.)))

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(INSEE_COM, annee, Anciennete) %>%
  group_by(INSEE_COM, 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_",.)))

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


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

ComHousingTypes_BIEN<- full_join (ComTypBien, 
                                  ComAncBien, 
                                  by = c("INSEE_COM","annee")) 

Script sur les carreaux 1km

# Jointure Spatiale
Grid1kmJoinBIEN<- st_join(MarketSpaceGrid1km, 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_",.))) %>%
  gather(key = "Profil", value="NBiens", c(4:ncol(.))) 


# Remise en format Sf
Grid1kmTypBien <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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_",.))) %>%
  gather(key = "Profil", value="NBiens", c(4:ncol(.))) 

EffectifGrid1kmAnc <- sum(Grid1kmAnc$NBiens)

# Remise en format Sf
Grid1kmAnc <- left_join(MarketSpaceGrid1km, 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 = MarketSpaceGrid1km,
                              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(MarketSpaceGrid1km,., by = "Carreau_ID")

Script sur les carreaux 200m

# Jointure Spatiale
Grid200mJoinBIEN<- st_join(MarketSpaceGrid200m, 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_",.))) %>%
  gather(key = "Profil", value="NBiens", c(4:ncol(.))) 

EffectifGrid200mTypBien <- sum(Grid200mTypBien$NBiens)

# Remise en format Sf
Grid200mTypBien <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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_",.))) %>%
  gather(key = "Profil", value="NBiens", c(4:ncol(.))) 

EffectifGrid200mAnc <- sum(Grid200mAnc$NBiens)

# Remise en format Sf
Grid200mAnc <- left_join(MarketSpaceGrid200m, 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 = MarketSpaceGrid200m,
                              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")) 

rm(BIEN_HousingTypes)

Jointure des données spatiales et export

# Jointure des données sur les communes 
CommunesPrices<- as.data.frame(CommunesPrices_BIEN) %>%
  select (-geometry)
 CommunesAcqVe<- as.data.frame(CommunesAcqVE_BIEN) #%>%
 #select (-geom)
CommunesHousingTypes<- as.data.frame(ComHousingTypes_BIEN)#%>%
 #select (-geom)
CommunesPurchMut <- as.data.frame(CommunesPurchMut_BIEN)#%>%
 #select (-geom)

BIEN_SpatialDataBase_Communes <- full_join (CommunesPrices,
                                      CommunesAcqVe,
                                      by = c("INSEE_COM","annee")) %>%
 full_join (.,
CommunesPurchMut,  
by = c("INSEE_COM","annee"))%>%
 full_join (.,
 CommunesHousingTypes,  
by = c("INSEE_COM","annee"))%>%
left_join(Com_Sf, ., by = "INSEE_COM")

BIEN_SpatialDataBase_Communes<-BIEN_SpatialDataBase_Communes%>%
  select(-'B_AC_<NA>')

# str(BIEN_SpatialDataBase_Communes)
# Jointure des données BIEN avec données PTZ (voir onglet PTZ)

CASSMIR_SpatialDataBase_Communes <- full_join(BIEN_SpatialDataBase_Communes, CASSMIR_CommunesPTZ,
                                      by = c("INSEE_COM" = "cins","annee"))

# Jointure des données sur les carreaux 1km 

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


CASSMIR_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(MarketSpaceGrid1km, ., by = "Carreau_ID")


# Jointure des données sur les carreaux 200m 

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


CASSMIR_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(MarketSpaceGrid200m, ., by = "Carreau_ID")

#### EXPORT DE LA BASE SPATIALE #####

# st=format(Sys.time(), "%d%m%Y")
# NomFichier = paste("CASSMIR_SpatialDataBase_",st, sep = "")
# FormatFichier = ".gpkg"

NomFichier = "CASSMIR_SpatialDataBase"
FormatFichier = ".gpkg"


st_write (obj =  CASSMIR_SpatialDataBase_Communes, dsn = paste0("CASSMIR_Outputs/",NomFichier,FormatFichier), layer = "Communes", delete_layer = TRUE, quiet = TRUE)


st_write (obj =  CASSMIR_SpatialDataBase_Grid1km, dsn = paste0("CASSMIR_Outputs/",NomFichier,FormatFichier), layer = "Grid1km", delete_layer = TRUE, quiet = TRUE)


st_write (obj =  CASSMIR_SpatialDataBase_Grid200m, dsn = paste0("CASSMIR_Outputs/",NomFichier,FormatFichier), layer = "Grid200m", delete_layer = TRUE, quiet = TRUE)

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

Préparation des données sur les prix

###### Groupe par catégories sociales (PCS) ####

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

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

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

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


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

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

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


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

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

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

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

#Vendeurs
PM2AppartVe_Social <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Ve, PCS_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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 <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Acquereurs = ifelse(is.na(PCS_Acq), Type_Acq, PCS_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = 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 <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Ve, PCS_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = 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 <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(PCS_Acq), Type_Acq, PCS_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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 <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Ve, PCS_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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 par Génération ####

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

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

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

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

# Acquéreurs
PricesHousesAcq_Generation <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7", 
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI_",.))) 

#Vendeurs
PricesHousesVe_Generation <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",    
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI_",.))) 

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


# Acquéreurs
PricesAppartAcq_Generation <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7",    
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP_",.))) 

#Vendeurs
PricesAppartVe_Generation <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",   
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP_",.))) 

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

# Acquéreurs
PM2AppartAcq_Generation <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7",  
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise( NTotal = length(which(!is.na(Acquereurs))),
             M = mean(REQ_PM2),
             Q1 = quantile(REQ_PM2,0.25),
             Q2 = quantile(REQ_PM2,0.5),
             Q3 = quantile(REQ_PM2,0.75),
             SD = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 

# Vendeurs
PM2AppartVe_Generation <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",   
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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 <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7",     
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = 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 <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & !is.na(TypBien)) %>%  
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",  
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = 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 <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7",     
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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 <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PM2) & !is.na(TypBien) & REQTYPBIEN == "AP") %>%  
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7", 
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, TypBien) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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"))  


###### Groupe par genre ####

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

# Acquéreurs
PricesAllAcq_Sexe <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX)) %>%
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

# Vendeurs
PricesAllVe_Sexe <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX)) %>%
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_",.))) 

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


# Acquéreurs
PricesHousesAcq_Sexe <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>% 
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI_",.))) 

#Vendeurs
PricesHousesVe_Sexe <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "MA") %>%
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_MAI_",.))) 

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


# Acquéreurs
PricesAppartAcq_Sexe <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%  
  mutate(Acquereurs= Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP_",.))) 

#Vendeurs
PricesAppartVe_Sexe <- BIEN_ReadyForOp %>% 
  filter(!is.na(REQ_PRIX) & REQTYPBIEN == "AP") %>%
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = sd(REQ_PRIX)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PX_APP_",.))) 

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

# Acquéreurs
PM2AppartAcq_Sexe <- BIEN_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))),
             M = mean(REQ_PM2),
             Q1 = quantile(REQ_PM2,0.25),
             Q2 = quantile(REQ_PM2,0.5),
             Q3 = quantile(REQ_PM2,0.75),
             SD = sd(REQ_PM2)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_PM_",.))) 

#Vendeurs
PM2AppartVe_Sexe <- BIEN_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))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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 <- BIEN_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))),
            M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = 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 <- BIEN_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))),
            M = mean(REQ_PRIX),
            Q1 = quantile(REQ_PRIX,0.25),
            Q2 = quantile(REQ_PRIX,0.5),
            Q3 = quantile(REQ_PRIX,0.75),
            SD = 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 <- BIEN_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))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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 <- BIEN_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))),
            M = mean(REQ_PM2),
            Q1 = quantile(REQ_PM2,0.25),
            Q2 = quantile(REQ_PM2,0.5),
            Q3 = quantile(REQ_PM2,0.75),
            SD = 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"))  

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

#### Informations principales sur les acquéreurs ####

BuyersN <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(PCS_Acq), Type_Acq, PCS_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  count(Acquereurs, annee, name = "B_AC_TOT", .drop = T)

BuyersSexe <- BIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(Sexe_Acq)) %>%
  group_by(PCS_Acq, annee) %>%
  count(Sexe_Acq, .drop = T) %>%
  spread(Sexe_Acq, n)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_SEX_",.))) 


BuyersTrancheAge <- BIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(Tranche_Age_Acq)) %>%
  group_by(PCS_Acq, annee) %>%
  count(Tranche_Age_Acq, .drop = T) %>%
  spread(Tranche_Age_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_TYP1_",.))) 

BuyersAge <- BIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(Age_Acq)) %>%
  group_by(PCS_Acq, annee) %>%
  summarise(M = mean(Age_Acq),
            Q1 = quantile(Age_Acq, 0.25),
            Q2 = quantile(Age_Acq, 0.5),
            Q3 = quantile(Age_Acq, 0.75),
            SD = sd(Age_Acq)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_AGE_",.))) 

BuyersSitMatri <- BIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(SitMatri_Acq)) %>%
  group_by(PCS_Acq, annee) %>%
  count(SitMatri_Acq, .drop = T) %>%
  spread(SitMatri_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_MATRI_",.)))

# Relations d'achats-ventes CSP
BuyersAcheteA <- BIEN_ReadyForOp %>%  
  mutate(Acquereurs = ifelse(is.na(PCS_Acq), Type_Acq, PCS_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Ve, PCS_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 <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = PCS_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_PPH_ORIGIN_",.)))


### Jointure des tables CSP Acquereurs 

Buyers_Social <- left_join(BuyersN,
                           BuyersSexe,
                           by = c("Acquereurs"="PCS_Acq", "annee")) %>%
  left_join(., BuyersAge,
            by = c("Acquereurs"="PCS_Acq", "annee")) %>%
  left_join(., BuyersTrancheAge,
            by = c("Acquereurs"="PCS_Acq", "annee"))  %>%
  left_join(., BuyersSitMatri,
            by = c("Acquereurs"="PCS_Acq", "annee"))  %>%
  left_join(., BuyersAcheteA,
            by = c("Acquereurs", "annee"))  %>%
  left_join(., Portee_Social,
            by = c("Acquereurs", "annee")) 


######## Informations principales sur les Vendeurs########

SellersN <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Ve, PCS_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  count(Vendeurs, annee, name = "B_VE_TOT", .drop = T)

SellersSexe <- BIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(Sexe_Ve)) %>%
  group_by(PCS_Ve, annee) %>%
  count(Sexe_Ve, .drop = T) %>%
  spread(Sexe_Ve, n)%>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_SEX_",.))) 


SellersTrancheAge <- BIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(Tranche_Age_Vendeur)) %>%
  group_by(PCS_Ve, annee) %>%
  count(Tranche_Age_Vendeur, .drop = T) %>%
  spread(Tranche_Age_Vendeur, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_TYP1_",.))) 


SellersAge <- BIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(Age_Ve)) %>%
  group_by(PCS_Ve, annee) %>%
  summarise(M = mean(Age_Ve),
            Q1 = quantile(Age_Ve, 0.25),
            Q2 = quantile(Age_Ve, 0.5),
            Q3 = quantile(Age_Ve, 0.75),
            SD = sd(Age_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_AGE_",.)))

SellersSitMatri <- BIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(SitMatri_VE)) %>%
  group_by(PCS_Ve, annee) %>%
  count(SitMatri_VE, .drop = T) %>%
  spread(SitMatri_VE, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_MATRI_",.)))

# Relations d'achats-ventes

Sellers_VendA <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Ve, PCS_Ve)) %>%
  filter(!is.na(Vendeurs)) %>%
  mutate(Acquereurs = ifelse(is.na(PCS_Acq), Type_Acq, PCS_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,
                            SellersSexe,
                            by = c("Vendeurs" = "PCS_Ve", "annee")) %>%
  left_join(., SellersAge,
            by = c("Vendeurs" ="PCS_Ve", "annee")) %>%
  left_join(., SellersTrancheAge,
            by = c("Vendeurs" ="PCS_Ve", "annee"))  %>%
  left_join(., SellersSitMatri,
            by = c("Vendeurs" ="PCS_Ve", "annee"))  %>%
  left_join(., Sellers_VendA,
            by = c("Vendeurs", "annee")) 


#### Groupe de population par génération ####

#### Informations principales sur les acquéreurs ####


BuyersN <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  count(Acquereurs, annee, name = "B_AC_TOT", .drop = T)

BuyersGeneration_CSP <- BIEN_ReadyForOp %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(PCS_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  count(PCS_Acq, .drop = T) %>%
  spread(PCS_Acq, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_",.))) 

BuyersGeneration_Sexe <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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_PPH_SEX_",.))) 

BuyersGeneration_Age <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs), !is.na(Age_Acq)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(M = mean(Age_Acq, na.rm= TRUE),
            Q1 = quantile(Age_Acq, 0.25,na.rm=T),
            Q2 = quantile(Age_Acq, 0.5,na.rm=T),
            Q3 = quantile(Age_Acq, 0.75,na.rm=T),
            SD = sd(Age_Acq, na.rm=TRUE)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_AGE_",.))) 

BuyersGeneration_SitMatri <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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_PPH_MATRI_",.)))

# Relations d'achats-ventes Generations
BuyersGeneration_AcheteA <- BIEN_ReadyForOp %>%  
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7",
                             "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_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 <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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_PPH_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 <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  count(Vendeurs, annee, name = "B_VE_TOT", .drop = T) 

SellersGeneration_CSP <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs), !is.na(PCS_Ve)) %>%
  group_by(Vendeurs, annee) %>%
  count(PCS_Ve, .drop = T) %>%
  spread(PCS_Ve, n)%>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_TYP1_",.)))

SellersGeneration_Sexe <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs), !is.na(PCS_Ve)) %>%
  group_by(Vendeurs, annee) %>%
  count(Sexe_Ve, .drop = T) %>%
  spread(Sexe_Ve, n)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_SEX_",.))) 

SellersGeneration_Age <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs), !is.na(Age_Ve)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(Age_Ve),
            Q1 = quantile(Age_Ve, 0.25),
            Q2 = quantile(Age_Ve, 0.5),
            Q3 = quantile(Age_Ve, 0.75),
            SD = sd(Age_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_AGE_",.))) 


SellersGeneration_SitMatri <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_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_PPH_MATRI_",.))) 

# Relations d'achats-ventes Generations
SellersGeneration_Relation <- BIEN_ReadyForOp %>%  
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7",
                           "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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 <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = Sexe_Acq) %>%
  filter(!is.na(Acquereurs)) %>%
  count(Acquereurs, annee, name = "B_AC_TOT", .drop = T)

BuyersSexe_CSP <- BIEN_ReadyForOp %>% 
  filter(Nature_Acq == "PPH", !is.na(Sexe_Acq)) %>%
  group_by(Sexe_Acq, annee) %>%
  count(PCS_Acq, .drop = T) %>%
  spread(PCS_Acq, n)  %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_",.)))

BuyersSexe_TrancheAge <- BIEN_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_TYP1_",.))) 

BuyersSexe_Age <- BIEN_ReadyForOp %>% 
  filter(!is.na(Sexe_Acq), !is.na(Age_Acq)) %>%
  group_by(Sexe_Acq, annee) %>%
  summarise(M = mean(Age_Acq),
            Q1 = quantile(Age_Acq, 0.25),
            Q2 = quantile(Age_Acq, 0.5),
            Q3 = quantile(Age_Acq, 0.75),
            SD = sd(Age_Acq))%>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_AGE_",.))) 

BuyersSexe_SitMatri <- BIEN_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_PPH_MATRI_",.))) 

# Relations d'achats-ventes Sexes
BuyersSexe_AcheteA <- BIEN_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 <- BIEN_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_PPH_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 <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  count(Vendeurs, annee, name = "B_VE_TOT", .drop = T)

SellersSexe_CSP <- BIEN_ReadyForOp %>% 
  filter(Nature_Ve == "PPH", !is.na(Sexe_Ve)) %>%
  group_by(Sexe_Ve, annee) %>%
  count(PCS_Ve, .drop = T) %>%
  spread(PCS_Ve, n) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_SEX_",.)))

SellersSexe_TrancheAge <- BIEN_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_TYP1_",.))) 

SellersSexe_Age <- BIEN_ReadyForOp %>% 
  filter(!is.na(Sexe_Ve), !is.na(Age_Ve)) %>%
  group_by(Sexe_Ve, annee) %>%
  summarise(M = mean(Age_Ve),
            Q1 = quantile(Age_Ve, 0.25),
            Q2 = quantile(Age_Ve, 0.5),
            Q3 = quantile(Age_Ve, 0.75),
            SD = sd(Age_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_AGE_",.)))

SellersSexe_SitMatri <- BIEN_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_PPH_SEX_",.)))

# Relations d'achats-ventes Sexes
SellersSexe_VendA <- BIEN_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")) 

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 <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Duree_Detention_Ve)) %>%
  mutate(Vendeurs = PCS_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(Duree_Detention_Ve),
            Q1 = quantile(Duree_Detention_Ve,0.25),
            Q2 = quantile(Duree_Detention_Ve,0.5),
            Q3 = quantile(Duree_Detention_Ve,0.75),
            SD = sd(Duree_Detention_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_",.))) 


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

# Vendeurs personnes physiques
TranDurDetentVe_Social <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Tranche_DureeDetention_Ve)) %>%
  mutate(Vendeurs = PCS_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_PPH_",.)))

#### Type de mutation des biens lors de l'acquisition du bien par le vendeur #####

# Vendeurs personnes physiques
TypeMutatPrec_Social <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(TypMutPrec_VE)) %>%
  mutate(Vendeurs = PCS_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_PPH_TYPMUT_",.)))

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

# Acquéreurs personnes physiques
PresCredAcq_Social <- BIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(PresCred_Acq)) %>%
  mutate(Acquereurs = PCS_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_PPH_CRED_",.)))

#### Type de pret #####

# Acquéreurs personnes physiques
TypPretAcq_Social <- BIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(TypePret_Acq)) %>%
  mutate(Acquereurs = PCS_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_PPH_GARCRED_",.)))

#### Loan-to-value ####

# Acquéreurs personnes physiques
BIEN_ReadyForOp$MTCRED <- as.numeric(BIEN_ReadyForOp$MTCRED)

LTVAcq_Social <- BIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(REQ_PRIX) & MTCRED >= 1000) %>%
  mutate(Acquereurs = PCS_Acq,
         LTV = (MTCRED/ REQ_PRIX)*100) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(LTV),
            Q1 = quantile(LTV,0.25),
            Q2 = quantile(LTV,0.5),
            Q3 = quantile(LTV,0.75),
            SD = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_LTV_",.))) 

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

# Acquéreurs personnes physiques
MtCredAcq_Social <- BIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & MTCRED >= 1000) %>%
  mutate(Acquereurs = PCS_Acq)%>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(MTCRED),
            Q1 = quantile(MTCRED,0.25),
            Q2 = quantile(MTCRED,0.5),
            Q3 = quantile(MTCRED,0.75),
            SD = sd(MTCRED)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_MTCRED_",.))) 

#### Plus-value réalisée par les vendeurs en fonction de la durée de détention des biens ####

# Vendeurs personnes physiques
BIEN_ReadyForOp$REQ_VALUE <- as.numeric(BIEN_ReadyForOp$REQ_VALUE)

PlusValueVe_Social <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(REQ_VALUE) & 
            REQ_VALUE != 0, !is.na(Tranche_DureeDetention_Ve)) %>%
  mutate(Vendeurs = PCS_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, Tranche_DureeDetention_Ve) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_VALUE),
            Q1 = quantile(REQ_VALUE, 0.25, na.rm = T),
            Q2 = quantile(REQ_VALUE,0.5, na.rm = T),
            Q3 = quantile(REQ_VALUE,0.75, na.rm = T),
            SD = 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_PPH_PV_",.))) 

##### 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")) 


# 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"))


#### Agrégation sur les groupes de population par génération ####

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

# Vendeurs personnes physiques
DurDetentVe_Generation <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Duree_Detention_Ve)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7", "PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(Duree_Detention_Ve),
            Q1 = quantile(Duree_Detention_Ve,0.25),
            Q2 = quantile(Duree_Detention_Ve,0.5),
            Q3 = quantile(Duree_Detention_Ve,0.75),
            SD = sd(Duree_Detention_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_",.))) 


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

# Vendeurs personnes physiques
TranDurDetentVe_Generation <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Tranche_DureeDetention_Ve)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_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_PPH_",.)))

#### Type de mutation des biens lors de l'acquisition du bien par le vendeur #####

# Vendeurs personnes physiques
TypeMutatPrec_Generation <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(TypMutPrec_VE)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_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_PPH_TYPMUT_",.)))

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

# Acquéreurs personnes physiques
PresCredAcq_Generation <- BIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(PresCred_Acq)) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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_PPH_CRED_",.)))

#### Type de pret #####

# Acquéreurs personnes physiques
TypPretAcq_Generation <- BIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(TypePret_Acq)) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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_PPH_TYPCRED_",.)))

#### Loan-to-value ####

# Acquéreurs personnes physiques
BIEN_ReadyForOp$MTCRED <- as.numeric(BIEN_ReadyForOp$MTCRED)

LTVAcq_Generation <- BIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & !is.na(REQ_PRIX) & MTCRED >= 1000) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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))),
            M = mean(LTV),
            Q1 = quantile(LTV,0.25),
            Q2 = quantile(LTV,0.5),
            Q3 = quantile(LTV,0.75),
            SD = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_LTV_",.))) 

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

# Acquéreurs personnes physiques
MtCredAcq_Generation <- BIEN_ReadyForOp %>% 
  filter( Nature_Acq == "PPH"  & MTCRED >= 1000) %>%
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_Acq == "PCS7", "PCS7", Tranche_Age_Acq)) %>%
  filter(!is.na(Acquereurs)) %>%
  group_by(Acquereurs, annee) %>%
  summarise(NTotal = length(which(!is.na(Acquereurs))),
            M = mean(MTCRED),
            Q1 = quantile(MTCRED,0.25),
            Q2 = quantile(MTCRED,0.5),
            Q3 = quantile(MTCRED,0.75),
            SD = sd(MTCRED)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_MTCRED_",.))) 

#### Plus-value réalisée par les vendeurs en fonction de la durée de détention des biens ####

# Vendeurs personnes physiques
BIEN_ReadyForOp$REQ_VALUE <- as.numeric(BIEN_ReadyForOp$REQ_VALUE)

PlusValueVe_Generation <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(REQ_VALUE) & 
            REQ_VALUE != 0, !is.na(Tranche_DureeDetention_Ve)) %>%
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_Ve == "PCS7","PCS7", Tranche_Age_Vendeur)) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, Tranche_DureeDetention_Ve) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_VALUE),
            Q1 = quantile(REQ_VALUE, 0.25, na.rm = T),
            Q2 = quantile(REQ_VALUE,0.5, na.rm = T),
            Q3 = quantile(REQ_VALUE,0.75, na.rm = T),
            SD = 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_PPH_PV_",.)))


### jointure ####

# 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"))
  
# 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"))

#### Groupes de population sur le Genre #### 

##### Durée de détention des biens ######
# Vendeurs personnes physiques
DurDetentVe_Sexe <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(Duree_Detention_Ve)) %>%
  mutate(Vendeurs= Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee) %>%
  summarise(M = mean(Duree_Detention_Ve),
            Q1 = quantile(Duree_Detention_Ve,0.25),
            Q2 = quantile(Duree_Detention_Ve,0.5),
            Q3 = quantile(Duree_Detention_Ve,0.75),
            SD = sd(Duree_Detention_Ve)) %>%
  rename_at(3:ncol(.), list( ~paste0("B_VE_PPH_",.))) 


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

# Vendeurs personnes physiques
TranDurDetentVe_Sexe <- BIEN_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_PPH_",.)))

#### Type de mutation des biens lors de l'acquisition du bien par le vendeur #####

# Vendeurs personnes physiques
TypeMutatPrec_Sexe <- BIEN_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_PPH_TYPMUT_",.)))

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

# Acquéreurs personnes physiques
PresCredAcq_Sexe <- BIEN_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_PPH_CRED_",.)))

#### Type de pret #####

# Acquéreurs personnes physiques
TypPretAcq_Sexe <- BIEN_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_PPH_TYPCRED_",.)))

#### Loan-to-value ####

# Acquéreurs personnes physiques
BIEN_ReadyForOp$MTCRED <- as.numeric(BIEN_ReadyForOp$MTCRED)

LTVAcq_Sexe <- BIEN_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))),
            M = mean(LTV),
            Q1 = quantile(LTV,0.25),
            Q2 = quantile(LTV,0.5),
            Q3 = quantile(LTV,0.75),
            SD = sd(LTV)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_LTV_",.))) 

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

# Acquéreurs personnes physiques
MtCredAcq_Sexe <- BIEN_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))),
            M = mean(MTCRED),
            Q1 = quantile(MTCRED,0.25),
            Q2 = quantile(MTCRED,0.5),
            Q3 = quantile(MTCRED,0.75),
            SD = sd(MTCRED)) %>%
  filter(NTotal >= 20) %>%
  select (-NTotal) %>%
  rename_at(3:ncol(.), list( ~paste0("B_AC_PPH_MTCRED_",.))) 

#### Plus-value réalisée par les vendeurs en fonction de la durée de détention des biens ####

# Vendeurs personnes physiques
BIEN_ReadyForOp$REQ_VALUE <- as.numeric(BIEN_ReadyForOp$REQ_VALUE)

PlusValueVe_Sexe <- BIEN_ReadyForOp %>% 
  filter( Nature_Ve == "PPH"  & !is.na(REQ_VALUE) & 
            REQ_VALUE != 0, !is.na(Tranche_DureeDetention_Ve)) %>%
  mutate(Vendeurs= Sexe_Ve) %>%
  filter(!is.na(Vendeurs)) %>%
  group_by(Vendeurs, annee, Tranche_DureeDetention_Ve) %>%
  summarise(NTotal = length(which(!is.na(Vendeurs))),
            M = mean(REQ_VALUE),
            Q1 = quantile(REQ_VALUE, 0.25, na.rm = T),
            Q2 = quantile(REQ_VALUE,0.5, na.rm = T),
            Q3 = quantile(REQ_VALUE,0.75, na.rm = T),
            SD = 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_PPH_PV_",.))) 

##### 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 <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(PCS_Acq), Type_Acq, PCS_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_",.)))


HousingTypesVe_Social <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Acq, PCS_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_",.)))


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

AncBienAcq_Social <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(PCS_Acq), Type_Acq, PCS_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_",.)))

AncBienVe_Social <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Acq, PCS_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_",.)))

#### Jointure tables Acquéreurs ####

HousingTypesAcqSocial <-  left_join(HousingTypesAcq_Social,
                                    AncBienAcq_Social,
                                    by = c("Acquereurs", "annee"))

#### Jointure tables Vendeurs ####

HousingTypesVeSocial <-  left_join(HousingTypesVe_Social,
                                   AncBienVe_Social,
                                   by = c("Vendeurs", "annee"))

#### Générations ####

HousingTypesAcq_Generation <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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_",.))) 


HousingTypesVe_Generation <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(Tranche_Age_Vendeur) & PCS_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_",.))) 

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

AncBienAcq_Generation <- BIEN_ReadyForOp %>% 
  mutate(Acquereurs = ifelse(is.na(Tranche_Age_Acq) & PCS_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_",.))) 

AncBienVe_Generation <- BIEN_ReadyForOp %>% 
  mutate(Vendeurs = ifelse(is.na(PCS_Ve), Type_Acq, PCS_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_",.)))


#### Jointure tables Acquéreurs ####

HousingTypesAcqGeneration <-  left_join(HousingTypesAcq_Generation,
                                        AncBienAcq_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 <- BIEN_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_",.))) 


HousingTypesVe_Sexe <- BIEN_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_",.))) 


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

AncBienAcq_Sexe <- BIEN_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_",.))) 

AncBienVe_Sexe <- BIEN_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_",.))) 

#### 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 tables sur les groupes de population et export

# Tables Social
# Jointure tables acquéreurs
BIEN_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"))

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

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

BIEN_GroupesPopAcquereur_Social$Parties <- "Acquereurs"
 BIEN_GroupesPopAcquereur_Social <- BIEN_GroupesPopAcquereur_Social %>% relocate(Parties, .after = TypeGroupe)
 
 # Jointure tables vendeurs
 BIEN_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")) 
 
BIEN_GroupesPopVendeur_Social <- BIEN_GroupesPopVendeur_Social %>% rename(Groupes = Vendeurs)
BIEN_GroupesPopVendeur_Social$TypeGroupe <- "Social"
BIEN_GroupesPopVendeur_Social<- BIEN_GroupesPopVendeur_Social %>% relocate(TypeGroupe, .after = Groupes)

 BIEN_GroupesPopVendeur_Social$Parties <- "Vendeurs"
 BIEN_GroupesPopVendeur_Social<-BIEN_GroupesPopVendeur_Social %>% relocate(Parties, .after = TypeGroupe)
 # Bind rows for one df
 BIEN_GroupesPop_Social<- rbind(BIEN_GroupesPopAcquereur_Social, BIEN_GroupesPopVendeur_Social)

 
# Tables Generation
# Jointure tables acquéreurs
BIEN_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"))

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

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

BIEN_GroupesPopAcquereur_Generation$Parties <- "Acquereurs"
 BIEN_GroupesPopAcquereur_Generation <- BIEN_GroupesPopAcquereur_Generation %>% relocate(Parties, .after = TypeGroupe)
 
 # Jointure tables vendeurs
 BIEN_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")) 
 
 
  BIEN_GroupesPopVendeur_Generation <- BIEN_GroupesPopVendeur_Generation %>% rename(Groupes = Vendeurs)
BIEN_GroupesPopVendeur_Generation$TypeGroupe <- "Generationnel"

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

BIEN_GroupesPopVendeur_Generation$Parties <- "Vendeurs"
 BIEN_GroupesPopVendeur_Generation <- BIEN_GroupesPopVendeur_Generation %>% relocate(Parties, .after = TypeGroupe)

 # Bind rows for one df
 BIEN_GroupesPop_Generation<- rbind(BIEN_GroupesPopAcquereur_Generation, BIEN_GroupesPopVendeur_Generation)

 
# Tables Sexe
# Jointure tables acquéreurs
 BIEN_GroupesPopAcquereur_Sexe <- left_join( PricesAcq_Sexe,BuyersSexe,
by = c("Acquereurs", "annee"))  %>%
   left_join(., PurchaseAndMutationAcq_Sexe,
by = c("Acquereurs", "annee")) %>%
  left_join(., HousingTypesAcq_Sexe,
by = c("Acquereurs", "annee")) 
 
  BIEN_GroupesPopAcquereur_Sexe <- BIEN_GroupesPopAcquereur_Sexe %>% rename(Groupes = Acquereurs)
BIEN_GroupesPopAcquereur_Sexe$TypeGroupe <- "Genre"

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

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


# Jointure tables vendeurs
 BIEN_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"))
 
BIEN_GroupesPopVendeur_Sexe <- BIEN_GroupesPopVendeur_Sexe %>% rename(Groupes = Vendeurs)
BIEN_GroupesPopVendeur_Sexe$TypeGroupe <- "Genre"

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

BIEN_GroupesPopVendeur_Sexe$Parties <- "Vendeurs"
 BIEN_GroupesPopVendeur_Sexe <- BIEN_GroupesPopVendeur_Sexe %>% relocate(Parties, .after = TypeGroupe)
 
# Bind rows for one df
 BIEN_GroupesPop_Sexe<- rbind(BIEN_GroupesPopAcquereur_Sexe, BIEN_GroupesPopVendeur_Sexe)
 
 
 # Final R bind
 BIEN_GroupesPopDataBase <- rbind(BIEN_GroupesPop_Social, BIEN_GroupesPop_Generation)

 BIEN_GroupesPopDataBase <- rbind(BIEN_GroupesPopDataBase, BIEN_GroupesPop_Sexe)
 
 # Jointure avec données PTZ
 
  CASSMIR_GroupesPopDataBase <- full_join(BIEN_GroupesPopDataBase, PTZ_GroupesPopDataBase,
by = c("Groupes", "TypeGroupe", "Parties", "annee")) 
  
CASSMIR_GroupesPopDataBase<-CASSMIR_GroupesPopDataBase%>%
    select(-`P_AC_PPH_<NA>`,
           -`B_VE_PPH_SEX_<NA>`,
           -`B_AC_PPH_SEX_<NA>` ) %>%
    arrange(Groupes, Parties, annee)
  
#### EXPORT DE LA BASE GROUPE POPULATION #####

# st=format(Sys.time(), "%d%m%Y")
# NomFichier = paste("CASSMIR_SpatialDataBase_",st, sep = "")
# FormatFichier = ".gpkg"

NomFichier = "CASSMIR_GroupesPopDataBase"
FormatFichier = ".csv"
  
 write.csv2(CASSMIR_GroupesPopDataBase,
          file =  paste0("CASSMIR_Outputs/",NomFichier,FormatFichier), fileEncoding = "UTF-8")












BD CASSMIR - licence CC-BY-NC