Afin de permettre à l’utilisateur de prendre connaissance des données sources, et dans un souci de reproductibilité du travail, des échantillons tests sont diffusés. La production de ces échantillons est contrainte par les restrictions d’accès aux données, pour des questions de confidentialité de la donnée individuelle mais, aussi, par l’interdiction de délivrer une donnée qui ne respecterait pas la propriété intellectuelle des services producteurs de la donnée. Ces deux contraintes peuvent être surmontées en proposant des données qui n’offrent pas la possibilité reconstituer la réalité. L’objectif est ainsi de donner accès à un échantillon des données BIEN et PTZ en passant par une anonymysation des données individuelles et la génération d’un espace fictif.

En dehors de l’import des bases de données sources non anonymisées, l’intégralité du code ci-dessous est exécutable en important les échantillons de données individuelles anonymisées

Aucune information produite à partir de ce jeu de données anonymisées serait suceptible d’être utilisée comme une expression de “l’état réel du marché”. Ce jeu de données est spécialement dédié à la reproductibilité du travail de construction de la base de données CASSMIR et aucun autre usage peut en être fait.

library(sf)
library(tidyverse)
library(ade4)
library(cartography)
library(ggplot2)
library(SpatialPosition)

Générer un espace fictif

Cette première étape a pour objectif de créer un espace discret qui ne représente aucun autre espace dans la réalité. Cet espace est contraint par des limites en absicces et ordonnées distantes de 20 km. Cet espace est ensuite découpé par la génération de polygones de Voronoï qui symbolisent des limites administratives communales. A ce découpage s’ajoute la création de deux grilles carroyées dont la taille équivaut à celle des carreaux Insee de 200m et de 1Km de côté.

Optionnellement, une fois générée, les trois couches peuvent être enregistrées dans un fichier au format Geopackage sous le nom de “OutputFictifSpace”, stocké dans le dossier local “CASSMIR_Outputs”. Nous conseillons à l’utilisateur de créer ce dossier à l’emplacement du projet CASSMIR.

#Create random Points
Nunits <- 80
DistSpace <- 20000 #in meters
SPoints.df<-data.frame(X=runif(n = Nunits, min=0, max = DistSpace), 
                   Y=runif(n=Nunits, min=0, max = DistSpace))
SPoints.sf<- st_as_sf (x = SPoints.df,coords=c("X","Y"))%>%
  st_sf(sf_column_name = "geometry")

#Define a border as a reference polygon
Borders.sf<-st_sfc(st_polygon(list(cbind(c(0,DistSpace,DistSpace,0,0), c(0,0,DistSpace,DistSpace,0)))))

#Create Voronoi polygons
Voronoi<-st_voronoi(st_union(SPoints.sf))
Voronoi<-st_join (x = st_sf(Voronoi), y = SPoints.sf, join = st_intersects)

#Cut the space to fit with the reference polygon
Voronoi<-st_intersection(st_cast(Voronoi), Borders.sf)
#Add areas and simplify objects
Voronoi_zones <- Voronoi %>%
  st_sf() %>% st_cast("POLYGON")%>%
  mutate(area=st_area(.))%>%
  distinct()
nrow(Voronoi)
Voronoi_zones$VoronoiID<- row.names(Voronoi_zones)

png(file = "fig/Voronoi.png", width = 800, height = 700, res = 150)
plot(st_geometry(Voronoi_zones))
mtext(text = "Exemple d'un espace fictif",
      col = "black", font = 4 )

dev.off()

# Build grid sf 200m and 1km
Grid200m <-st_make_grid(
  Voronoi_zones,
  cellsize = 200,
  what = "polygons",
  square = TRUE,
  flat_topped = FALSE)
Grid200m <-st_sf(Grid200m)

plot(st_geometry(Grid200m), cex = 0.1, pch = ".")

Grid1km <-st_make_grid(
  Voronoi_zones,
  cellsize = 1000,
  what = "polygons",
  square = TRUE,
  flat_topped = FALSE)
Grid1km <-st_sf(Grid1km)

plot(st_geometry(Grid1km), cex = 0.1, pch = ".")

# création d'un identifiant unique pour chaque carreau
Grid1km$Carreau_ID <- row.names(Grid1km)
Grid200m$Carreau_ID <- row.names(Grid200m)

# # Export 
# 
# NomFichier = "OutputFictifSpace"
# FormatFichier = ".gpkg"
# 
# st_write(obj =  Voronoi_zones, dsn = paste0("CASSMIR_Outputs/",NomFichier,FormatFichier), layer = "VoronoiForCommunes", 
#          delete_layer = TRUE, quiet = TRUE)
# 
# st_write(obj =  Grid200m, dsn = paste0("CASSMIR_Outputs/",NomFichier,FormatFichier), layer = "Grid200", 
#          delete_layer = TRUE, quiet = TRUE)
# 
# st_write(obj =  Grid1km, dsn = paste0("CASSMIR_Outputs/",NomFichier,FormatFichier), layer = "Grid1km", 
#          delete_layer = TRUE, quiet = TRUE)

Anonymisation des données BIEN et PTZ

Une fois l’espace fictif généré, la seconde étape est de tirer un échantillon sur la base de données des transactions (BIEN) et la base de données sur les opérations financières PTZ (PTZ). Conçu pour la première version de la base Cassmir, l’échantillon exclu les années les plus récentes (2015 et 2018) présentes dans la seconde version de la BD. Cet échantillon est composé de 2000 transactions annuelles (1996, 1999, 2003 à 2012) dans le cas des transactions immobilières, tirées aléatoirement de la base BIEN, soit 24 000 transactions. En ce qui concerne les données PTZ, l’échantillon est composé de 500 opérations pour les mêmes années que les données BIEN (1996, 1999, 2003 à 2012), tirées aléatoirement de la base PTZ, soit au total un échantillon de données individuelles de 6 000 investissements avec PTZ.

Pour que cet échantillon soit diffusable, une anonymysation totale a été réalisée en excluant toutes les informations permettant de localiser les biens concernés par la transaction (base BIEN) et par l’opération financière PTZ (base PTZ), les informations datées, ainsi que les informations d’identification sensibles.

Pour la base BIEN, 16 variables sont exclues de l’échantillon par rapport aux données originales. L’utilisateur dispose alors d’un échantillon composé de 24 000 lignes (transactions) pour 80 colonnes (caractéristiques des transactions). Ce code n’est pas exécutable sans la base de données BIEN.

Pour la base PTZ, 20 variables sont exclues de l’échantillon par rapport aux données originales. L’utilisateur dispose alors d’un échantillon composé de 6000 lignes (opérations PTZ) pour 81 colonnes (caractéristiques des transactions).

Cette partie du code n’est pas exécutable sans les bases de données sources. L’utilisateur qui ne dispose pas des données sources peut télécharger directement les deux échantillons (BIENSampleForTest et PTZSampleForTest), les importer dans l’environnement de travail et passer à l’étape suivante.

## Echantillon BIEN
BIEN_Sample <- read.csv("CASSMIR_NoOpenDataRaws/BIEN_LABEX_2016_consolidated_all_years.txt", stringsAsFactors=FALSE, na.strings=c(""," ","NA")) %>%
  filter(annee >=1996 & annee <= 2012) %>% # On s'assure de retenir les transactions sans erreur de renseignement sur l'année de la transaction
  group_by(annee) %>%
 sample_n(2000)

# Création d'une nouvelle variable d'identifiant "ID_new" pour parfaire l'anonymisation des données brutes. 
BIEN_Sample$ID_new <- row.names(BIEN_Sample)

# Les variables spatiales et temporelles qui permettent de reconnaître les transactions sont enlevées pour anonymisation des données. 
 drop.cols <- c( "X.1", "ID", "BICOMPADR", "BICOMPNRVO", "BIDEPT","BILIBVOIEO","BINRQUARAD","BINRVOIE", "BINUCOM","BITYPVOIE", "insee", "IRIS", "Nom_commune", "NRPLAN1",  "REFSECTION", "X","Y")
 
BIEN_Sample <- as.data.frame(BIEN_Sample) %>%
  select( -one_of (drop.cols) )

## Echantillon PTZ
options(scipen=999)
PTZ_Sample <- read.delim("CASSMIR_NoOpenDataRaws/BASE_PTZ_2016.txt", 
                            stringsAsFactors=FALSE, encoding ="UTF-8",na.strings=c(""," ","NA")) %>%
    filter(dept==75 |dept==91 | dept==92| dept==93 | dept==94 | dept==95 | dept==77 | dept==78, an==1996 | an==1999 |an>=2003 & an<=2012 ) %>% # On retient les informations PTZ pour les mêmes années que les données BIEN (an = "année de référence de l'émission du prêt ptz") et le même terrain d'étude (Île-de-France)
  group_by(an) %>%
 sample_n(500)

# Création d'une nouvelle variable d'identifiant "ID_new" pour parfaire l'anonymisation des données brutes. 
PTZ_Sample$ID_new <- row.names(PTZ_Sample)

# Les variables d'identification du produit (non renotées) ou du ménage, ainsi que les variables spatiales et temporelles qui permettent de reconnaître les opérations immobilières et l'émission du prêt PTZ sont enlevées pour anonymisation des données. 
 drop.cols <- c("cpla", "iden", "cpfl", "datp", "dato", "datm","ipas","lcom","dmef", "dpve","ddve","ddpl", "dfpl","dept", "cins", "cdco", "dcre", "dmod","dcna","cuna", "dcno","cuno")
 
PTZ_Sample <- as.data.frame(PTZ_Sample) %>%
  select( -one_of (drop.cols) )

Une distribution non-aléatoire des échantillons dans l’espace fictif

L’enjeu de cet exercice est d’assurer une distribution spatiale adéquat de ces deux échantillons pour préserver une structure spatiale du marché telle que l’on observe dans la réalité. En effet, il n’est pas question de distribuer aléatoirement dans cet espace fictif les opérations immobilières associées aux données, cela n’aurait que peu de sens compte-tenu des fortes hiérarchies spatiales d’un marché d’une région métropolitaine. La préservation de la structure spatiale du marché est alors réalisée en passant par une analyse des correspondances multiples (ACM).

En projetant les individus sur un plan en deux dimensions, l’analyse factorielle donne l’occasion de récupérer les coordonnées en abscisses et en ordonnées de chaque individu. Ces coordonnées correspondent alors aux localisations des transactions dans l’espace fictif. Cette analyse factorielle se base sur un tableau disjonctif à partir de deux types d’informations présents dans les deux bases de données sources, et qui résument bien la structure urbaine (maisons appartements), ainsi que les hiérarchies spatiales du marché immobilier : le prix et le profil social des acquéreurs :

Après avoir construit les valeurs catégorielles pour les deux échantillons, un tableau de données qui combine les deux échantillons est créé. cela permet ainsi de réaliser l’opération de spatialisation en préservant une structure spatiale similaire pour les deux jeux de données.

L’analyse factorielle à partir du tableau commun renvoie des coordonnées géographiques fictives, selon la projection des individus sur l’axe factorielle. Ce sont ces projections qui déterminent la géographie fictive du marché en assigant les coordonées du plan factorielle comme coordonnées géographiques X,Y, puis en ajoutant du bruit pour améliorer la distribution. Pour les individus issus de la base BIEN, nous assignons directement ces nouvelles coordonnées fictives. en ce qui concerne les individus de la base PTZ, nous assignons l’ID de chaque polygone de Voronoï, la granularité la plus fine de l’opération dans la base PTZ étant le niveau communal.

Avant de procéder à l’export, les informations spatiales fictives sont jointes aux deux échantillons créés dans la partie précédente. Nous obtenons alors, pour BIEN et PTZ, deux tableaux de données d’individus avec des informations géographiques, dont la granularité est équivalente aux données sources. Au fil des opérations, une partie des effectifs qui ne dispose pas des renseignements nécessaires est éliminée. Une partie de l’échantillon final ne dispose donc pas d’informations de localisation dans l’espace fictif. Enfin, pour anonymiser complètement les données, du bruit randomisé est introduit dans l’échantillon afin de modifier sensiblement les valeurs réelles sur une sélection de variables concernant le prix, le crédit, les revenus (base PTZ), les taux d’intérêts (base PTZ).

Ces deux tableaux de données sont exportés au format .txt, pour préserver le format original des données. Quant à l’espace fictif, il est exporté en format .gpkg.

#### Echantillon BIEN ####
BIEN_Sample$REQ_PRIX <- as.numeric(BIEN_Sample$REQ_PRIX)
BIEN_Sample$REQ_PM2 <- as.numeric(BIEN_Sample$REQ_PM2)
#Discretisation of prices in 5 categories for houses
BIENHouses_Prices<- BIEN_Sample %>%
  filter(REQTYPBIEN=="MA") %>%
  group_by(annee) %>%  
  mutate(PrixDisc = cut(x = REQ_PRIX, breaks = quantile(x = REQ_PRIX,
                                                                   probs = c(0, 0.2, 0.4, 0.6, 0.8, 1), na.rm = T),
                               labels = paste0("Q", 1:5),
                               include.lowest = TRUE)) %>%
  ungroup() 

#Discretisation of prices in 5 categories for appartments
BIENAppartments_Prices<- BIEN_Sample %>%
  filter(REQTYPBIEN=="AP") %>%
  group_by(annee) %>%  
  mutate(PrixDisc = cut(x = REQ_PM2, breaks = quantile(x = REQ_PM2,
                                                        probs = c(0, 0.2, 0.4, 0.6, 0.8, 1), na.rm = T),
                        labels = paste0("Q", 1:5),
                        include.lowest = TRUE)) %>%
  ungroup()

#New data frame with categorical variable for transactions prices
Transactions_sample<- rbind(BIENHouses_Prices,BIENAppartments_Prices)
#Disjunctive table based on the qualitative variables (RESTYPBIEN, CSP_VE, CSP_AC, ) on the data frame
#We do not put the "years" variables in input

Transactions_sample <-  Transactions_sample %>%
  mutate(Type_Acq = case_when(QUALITE_AC == "AD" | QUALITE_AC == "SO" ~ "Public_HLM", QUALITE_AC== "PR" |  QUALITE_AC== "EN"  |  QUALITE_AC== "SC" ~  "Entreprise_Marchand_SCI", 
                          #CSP_AC == 10 ~ "Agriculteur",
                           CSP_AC >= 20 & CSP_AC < 30 ~ "Art/Com/ChefEts",
                            CSP_AC >= 30 & CSP_AC < 40 ~ "CPIS",
                            CSP_AC >= 40 & CSP_AC < 50 ~ "Profession_intermediaire",
                           CSP_AC >= 50 & CSP_AC < 60 ~ "Employe",
                           CSP_AC >= 60 & CSP_AC < 70 ~ "Ouvrier",
                           CSP_AC >= 70 & CSP_AC < 80 ~ "retraite",
                           CSP_AC == 80 ~ "Inactif"))


#### Echantillon PTZ ####

#Discretisation of prices in 5 categories for houses
PTZHouses_Prices<- PTZ_Sample %>%
  filter(timm==1) %>%
  group_by(an) %>%  
  mutate(PrixDisc = cut(x = vtto, breaks = quantile(x = vtto,
                                                                   probs = c(0, 0.2, 0.4, 0.6, 0.8, 1), na.rm = T),
                               labels = paste0("Q", 1:5),
                               include.lowest = TRUE)) %>%
  ungroup() 

#Discretisation of prices in 5 categories for appartments
PTZAppartments_Prices<- PTZ_Sample %>%
  filter(timm==2) %>%
  group_by(an) %>%  
  mutate(PrixDisc = cut(x = vtto/surh, breaks = quantile(x = vtto/surh,
                                                        probs = c(0, 0.2, 0.4, 0.6, 0.8, 1), na.rm = T),
                        labels = paste0("Q", 1:5),
                        include.lowest = TRUE)) %>%
  ungroup()

#New data frame with categorical variable for transactions prices
PTZOperation_sample<- rbind(PTZHouses_Prices,PTZAppartments_Prices)
#Disjunctive table based on the qualitative variables (RESTYPPTZ, CSP_VE, CSP_AC, ) on the data frame
#We do not put the "years" variables in input

PTZOperation_sample <-  PTZOperation_sample %>%
  mutate(Type_Acq = case_when(#ccsp == 10 ~ "Agriculteur",
                    ccsp >= 20 & ccsp < 30 ~ "Art/Com/ChefEts",
                    ccsp >= 30 & ccsp < 40 ~ "CPIS",
                    ccsp >= 40 & ccsp < 50 ~ "Profession_intermediaire",
                    ccsp >= 50 & ccsp < 60 ~ "Employe",
                    ccsp >= 60 & ccsp < 70 ~ "Ouvrier",
                    ccsp >= 70 & ccsp < 80 ~ "retraite",
                    ccsp == 80 ~ "Inactif"))


#### Création d'un tableau commun ####

Transactions_sample<- Transactions_sample %>%
  select (ID_new ,annee,PrixDisc, Type_Acq,REQTYPBIEN)
Transactions_sample$origine<-"BIEN"

PTZOperation_sample<- PTZOperation_sample %>%
 rename(annee = an,
        REQTYPBIEN = timm) %>%
  select (ID_new,annee,PrixDisc, Type_Acq, REQTYPBIEN) %>%
  mutate (REQTYPBIEN = case_when(REQTYPBIEN == 1 ~ "MA", REQTYPBIEN == 2 ~ "AP"))
PTZOperation_sample$origine<-"PTZ"

Common_df <- rbind(Transactions_sample, PTZOperation_sample)%>%
  filter(!is.na(PrixDisc) & !is.na(Type_Acq))

#### Réalisation de l'analyse####
disjonce <- acm.disjonctif(df = as.data.frame(Common_df[,c("PrixDisc", "Type_Acq","REQTYPBIEN")]))
#Correspondence analysis 
dudi.coa(disjonce, scannf = FALSE, nf = 3) -> results_AFC
#rescale the individuals coords in outputs to fit with the space created before. We scale from 2000 t0 18000 to improve concentration in the bouding box
x_rescale <- scales::rescale(x = results_AFC$li[[1]], to = c(5000,15000)) # X 
y_rescale <- scales::rescale(x = results_AFC$li[[2]], to = c(5000,15000)) # Y
# Add some noise with jitter 
x_rescale<- jitter(x_rescale, factor = 2000)
y_rescale<- jitter(y_rescale, factor = 2000)
# We use factor = 1000 to improve the ditribution in spaces
#cbind with the existing data frame on the sample transactions
Facto_coords<-cbind(Common_df,x_rescale,y_rescale)
#change it to a spatial sf object
Facto_coords_sf<-st_as_sf(Facto_coords,coords=c("x_rescale","y_rescale"))
#Make the spatial intersection with the voronoi polygons
Generated_space<- st_join(Facto_coords_sf, Voronoi_zones, join = st_within, left=T)

# Check if the operations return a well fitted spatial objects
plot(Voronoi_zones$geometry)
plot(Generated_space$geometry,add=TRUE)

# Cut in two discinct data frame, depending on BIEN and PTZ
BIENGenerated_space<- Generated_space %>%
  filter(origine=="BIEN")
# Recupe geom coordinates and change in df
coords <- st_coordinates(BIENGenerated_space)
BIENGenerated_space$X_fictif<-coords[,1]   
BIENGenerated_space$Y_fictif<-coords[,2]
BIENGenerated_space<- as.data.frame(BIENGenerated_space) %>%
    select(ID_new, X_fictif, Y_fictif)

  
PTZGenerated_space<- as.data.frame(Generated_space) %>%
  filter(origine=="PTZ") %>%
  select(ID_new, origine, VoronoiID) 

# Join with first samples 
BIEN_Sample <- left_join(BIEN_Sample, BIENGenerated_space, by = "ID_new")
PTZ_Sample <- left_join(PTZ_Sample, PTZGenerated_space, by = "ID_new")

## Introduce noise in some values columns. We Keep jitter's fonction default factors value.
BIEN_Sample$REQ_VALUE <-as.numeric(BIEN_Sample$REQ_VALUE)
BIEN_Sample$REQ_VALUE <- jitter(BIEN_Sample$REQ_VALUE)

BIEN_Sample$REQ_PRIX <- jitter(BIEN_Sample$REQ_PRIX)

BIEN_Sample$MTCRED <-as.numeric(BIEN_Sample$MTCRED)
BIEN_Sample$REQ_PRIX <- jitter(BIEN_Sample$REQ_PRIX)

PTZ_Sample$rani <- jitter(PTZ_Sample$rani) 
PTZ_Sample$rann <- jitter(PTZ_Sample$rann) 
PTZ_Sample$vtto <- jitter(PTZ_Sample$vtto) 
PTZ_Sample$vt1e <- jitter(PTZ_Sample$vt1e) 
PTZ_Sample$vtpr <- jitter(PTZ_Sample$vtpr) 
PTZ_Sample$vtpz <- jitter(PTZ_Sample$vtpz) 
PTZ_Sample$vtsu <- jitter(PTZ_Sample$vtsu) 
PTZ_Sample$tegp <- jitter(PTZ_Sample$tegp) 
PTZ_Sample$tegz <- jitter(PTZ_Sample$tegz) 
PTZ_Sample$vtpp <- jitter(PTZ_Sample$vtpp) 

## Export
st=format(Sys.time(), "%d%m%Y")
NomFichier = paste("BIENSampleForTest_",st, sep = "")
FormatFichier = ".csv"

write.csv2(x =  BIEN_Sample, file = paste0("CASSMIR_Outputs/",NomFichier,FormatFichier))

st=format(Sys.time(), "%d%m%Y")
NomFichier = paste("PTZSampleForTest_",st, sep = "")
FormatFichier = ".txt"

write.csv2(x =  PTZ_Sample, file = paste0("CASSMIR_Outputs/",NomFichier,FormatFichier))

Session info

sessionInfo()












BD CASSMIR - licence CC-BY-NC