# Cartographier l'évolution des prix de l'immobilier résidentiel avec R
L'objectif de cette séance est de mobiliser différents **packages de R** pour cartographier à partir des **données DVF** l'évolution dans le temps des prix au m² des ventes d'appartements et de maisons de l'aire urbaine de Nantes (2014-2019).
Cette séance revient à la fois sur la **préparation de données** (filtre, agrégation, calcul d'indicateurs, restructuration) et la réalisation de **cartes thématiques** dans l'environnement R.
---
## PARTIE 1 : Préparer les données DVF pour la France
La **première partie de la séance** consiste à mettre en place un **script de préparation des données DVF (nettoyage, structuration et enrichissement).
Séance > https://hackmd.io/KQkBGA1MTiujiWYtjOJdvA?view
> Résultat de la première partie de la séance
---
## PARTIE 2 : Analyses des données DVF à l'échelle de l'aire urbaine de Nantes
La **seconde partie de la séance** consiste à travailler sur les d**onnées DVF de l'aire urbaine de Nantes de 2014 à 2019**
## Données & Packages
### Données
---
* Transactions DVF issues de la base ["Demandes de valeurs foncières géolocalisées"](https://www.data.gouv.fr/fr/datasets/5cc1b94a634f4165e96436c1/) produite par Etalab
> Attention les données DVF utilisées ici sont préparées en amont (séance précédente)
* Contours des IRIS/communes (IGN)
> Attention il n'existe pas de fichier de contours IRIS/communes pour l'aire urbaine de Nantes, il faut en amont préparer ce jeu de données géographique en mobilisant des données IGN et de l'INSEE
### Packages
---
**Tidyverse** pour la manipulation et la restructuration des données
https://www.tidyverse.org/
```
library(tidyverse)
```
**SF** pour la manipulation de données spatiales (importation de shapefile, reprojection, jointures spatiales)
https://r-spatial.github.io/sf/
```
library(sf)
```
**Cartography** pour la cartographie thématique
https://rcarto.github.io/carto_avec_r/chapitre2.html
```
library(cartography)
```
## Cartographier les prix de l'immobilier et autre indicateurs pour toute la période (2014-2019)
### Importer les transactions
1. Importer le shapefile dans R
```
Transactions <- st_read(dsn = "C:/Users/Xo/Desktop/DVF_NANTES/TransactionsDVF.shp", stringsAsFactors = FALSE)
```
2. Visualiser les transactions selon le code de la commune
```
plot(Transactions["codecommun"])
```
### Importer les contours des IRIS/communes
1. Importer le shapefile dans R
```
IRIS <- st_read(dsn = "C:/Users/Xo/Desktop/DVF_NANTES/iris.shp", stringsAsFactors = FALSE)
```
2. Visualiser les transactions selon le nom de l'IRIS
```
plot(IRIS["nom_iris"])
```
### Reprojeter les contours des IRIS/communes
1. Verifier les SCR des deux couches
```
st_crs(Transactions)
```
```
st_crs(IRIS)
```
### Procéder aux agrégations statistiques entre transactions DVF et les IRIS
Calculer :
* Le nombre total de transactions
* Le prix moyen des biens vendus
* La surface moyenne
* Le prix moyen au m²
***Quelles est la variable la plus adaptée pour l'aggrégation ?***
```
IRISDVF <- IRIS %>% st_join(Transactions) %>% group_by(code_iris) %>%
summarise(Nb_Transactions = n(), Prix_moyen= (mean(PrixOK)), Surface_Moyenne = (mean(SurfaceOK)), PrixM2_moyen = (mean(PrixM2OK)))
```
Visualiser le résultat (ici les prix au m²)
```
plot(IRISDVF["PrixM2_moyen"], breaks = "quantile", key.pos = 1)
```
---
### Cartographier les indicateurs avec le package *cartography*
http://riatelab.github.io/cartography/vignettes/cheatsheet/cartography_cheatsheet.pdf
https://riatelab.github.io/mapsf/
### Cartographie du prix moyen au m² pour toute la période
Nous allons ici cartographier le prix moyen au m2 de la couche IRISGlobal sous forme de carte choroplèthe
```
choroLayer(
x = IRISDVF,
var = "PrixM2_moyen",
breaks = c(1000, 1500, 2000, 2500, 3000, 3500),
col = c("#F1B1B4", "#E3898E", "#D35E63", "#BD2D33", "#7E1512"),
legend.title.txt = "Prix moyen/m² (euros)")
title(main = "Prix moyen au m² par IRIS/communes (2014-2019)")
```
**Changer les couleurs** en utilisant le site [ColorBrewer](https://colorbrewer2.org)
```
choroLayer(
x = IRISDVF,
var = "PrixM2_moyen",
breaks = c(1000, 1500, 2000, 2500, 3000, 3500),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
title(main = "Prix moyen au m² par IRIS/communes (2014-2019)")
```
**Ajouter les élements constitutifs de la carte**
```
choroLayer(
x = IRISDVF,
var = "PrixM2_moyen",
breaks = c(1000, 1500, 2000, 2500, 3000, 3500),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
north(pos = "topright")
barscale(size = 10)
layoutLayer( title= "Prix moyen au m² par IRIS/communes (2014-2019)", frame = FALSE, sources = "DGFiP")
```
**Rencentrer l'image par rapport à la carte**
```
par(mar=c(0,0,1.2,0))
```
### Cartographie de trois variables
```
par(mar=c(0,0,1.2,0))
par(mfrow=c(1,3))
choroLayer(
x = IRISDVF,
var = "PrixM2_moyen",
breaks = c(1000, 1500, 2000, 2500, 3000, 3500),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
title(main = "Prix moyen au m²")
choroLayer(
x = IRISDVF,
var = "Prix_moyen",
breaks = c(50000, 100000, 150000, 200000, 250000, 400000),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen (euros)")
title(main = "Prix moyen des biens")
choroLayer(
x = IRISDVF,
var = "Surface_Moyenne",
breaks = c(40, 60, 80, 100, 120, 140),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Surface moyenne (m²)")
title(main = "Surface moyenne des biens")
```
---
## Cartographie du prix moyen au m² pour chaque année
### Réaliser les agrégations selon l'année
Calculer :
* Le nombre total de transactions
* Le prix moyen des biens vendus
* La surface moyenne
* Le prix moyen au m²
**mais cette fois par année !**
```
IRISDVFANNEE <- IRIS %>% st_join(Transactions) %>%
group_by(code_iris, annee) %>%
summarise(Nb_Transactions = n(), Prix_moyen= (mean(PrixOK)), Surface_Moyenne = (mean(SurfaceOK)), PrixM2_moyen = (mean(PrixM2OK)))
```
### Changement de structuration de la table
Afin de pouvoir cartographier automatiquement la variable de prix moyen au m² par année, il faut modifier la structuration de la table en passant d'une modélisation de **lignes en colonnes** aussi nommé ***Long > Wide***
On va utiliser ici la fonction `spread`
```
TransactionsAnnesColonnes <- IRISDVFANNEE %>% spread(key= annee, value = PrixM2_moyen)
```
> Problème : la ventilation s'opére sur toutes les variables... on va donc en amont du changement de structuration faire une sélection de la variable qui nous intéresse à savoir le prix moyen au m²
>
```
Prixm2annees <- IRISDVFANNEE %>% select(nom_iris, annee, PrixM2_moyen)
```
On refait un changement de structure (passage ligne>colonnes)
```
PrixM2anneescolonne <- Prixm2annees %>% spread(key= annee, value = PrixM2_moyen)
```
**-> Produire une planche avec une carte du prix moyen au m² pour chacune des 6 années**
```
par(mar=c(0,0,0.9,0))
par(mfrow=c(2,3))
choroLayer(
x = PrixM2anneescolonne,
var = "2014",
breaks = c(1154, 1800, 2300, 2500, 2800, 3787),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
barscale(size = 5)
title(main = "2014")
choroLayer(
x = PrixM2anneescolonne,
var = "2015",
breaks = c(1171, 1800, 2300, 2500, 2800, 3969),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
barscale(size = 5)
title(main = "2015")
choroLayer(
x = PrixM2anneescolonne,
var = "2016",
breaks = c(665, 1800, 2300, 2500, 2800, 4914),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
barscale(size = 5)
title(main = "2016")
choroLayer(
x = PrixM2anneescolonne,
var = "2017",
breaks = c(1069, 1800, 2300, 2500, 2800, 4301),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
barscale(size = 5)
title(main = "2017")
choroLayer(
x = PrixM2anneescolonne,
var = "2018",
breaks = c(1231, 1800, 2300, 2500, 2800, 4073),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
barscale(size = 5)
title(main = "2018")
choroLayer(
x = PrixM2anneescolonne,
var = "2019",
breaks = c(1367, 1800, 2300, 2500, 2800, 6364),
col = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
legend.title.txt = "Prix moyen/m² (euros)")
barscale(size = 5)
title(main = "2019")
```
---
## Mettre en place une CAH
Une CAH vise à constituer des groupes d’individus statistiques regroupés en classes les plus homogènes possibles
```
library(cluster)
```
### Enrichir le dataframe des transactions avec le code de l'IRIS
```
TransactionsIRIS <- Transactions %>% st_join(IRIS)
TransactionsIRIS <- as.data.frame(TransactionsIRIS)
```
### Créer le dataframe avec les variables de la CAH
* Nombre de transactions
* Prix Moyen
* Prix au m² moyen
* Surface moyenne
* Proportion de maisons
* Proportion d'appartements
```
IRISCAH1 <- TransactionsIRIS %>% group_by(code_iris) %>%
summarise(Nbtransactions = n(),
Prixmoyen = mean(PrixOK),
Prixm2moyen = mean(PrixM2OK),
Surfacemoyenne = mean(SurfaceOK),
PropMaison = length(type[type=="Maison"])/Nbtransactions*100,
PropAppart = length(type[type=="Appartement"])/Nbtransactions*100)
IRISCAH <- data.frame(IRISCAH[, c("Nbtransactions", "Prixmoyen", "Prixm2moyen", "Surfacemoyenne", "PropMaison", "PropAppart")])
```
### Centrage et reduction des variables
```
IRISDVFClassifscale <- scale(IRISCAH)
```
### CAH
La classification a été calculée à l’aide de l’algorithme de regroupement hiérarchique ascendant AGNES (Agglomerative Nesting) en utilisant la méthode de Ward et la distance euclidienne.
Cette classification regroupe les individus de façon à ce que les classes constituées soient les plus homogènes possibles, c’est-à-dire avec une inertie intraclasse minimale et une variance interclasse maximale.
```
CAHIRIS <- agnes(IRISDVFClassifscale,
metric = "euclidean",
method = "ward")
```
### Graphiques des gains d'inertie inter-classe
```
sortedHeight<- sort(CAHIRIS$height,decreasing= TRUE)
relHeight<-sortedHeight/ sum(sortedHeight)*100
barplot(relHeight[1:30],names.arg=seq(1, 30, 1),col= "black",border= "white",xlab= "Noeuds",ylab= "Part de l'inertie totale (%)")
```
### Partition (en 6 classes)
```
clusIRIS <- cutree(CAHIRIS, k = 6)
IRISCluster <- as.data.frame(IRISCAH1)
IRISCluster$CLUSIMMO <- factor(clusIRIS,
levels = 1:6,
labels = paste("Classe", 1:6))
```
### Tableau récapitulatif des groupes
```
RecapCAHIRIS <- IRISCluster %>% group_by(CLUSIMMO) %>%
summarise(NB= n(), NbTransac = mean(Nbtransactions), Prixmoyen = mean(Prixmoyen), Prixm2 = mean(Prixm2moyen), Surface=mean(Surfacemoyenne), PropMaison = mean(PropMaison), PropAppart= mean(PropAppart))
```
### Graphique des écarts à la moyenne
#### Créer un tableau récapitulatif des écarts à la moyenne
```
SyntheseCAHIRIS <- RecapCAHIRIS %>% mutate(
nbtransacmoy = mean(IRISCAH$Nbtransactions),
surfacemoy = mean(IRISCAH$Surfacemoyenne),
prixmoy = mean(IRISCAH$Prixmoyen),
prixm2moyen = mean(IRISCAH$Prixm2moyen),
propmaisonmoyen = mean(IRISCAH$PropMaison),
propappartmoyen = mean(IRISCAH$PropAppart),
NbMutations=(NbTransac- nbtransacmoy)/nbtransacmoy*100,
Prix=(Prixmoyen- prixmoy)/prixmoy*100,
Prixm2=(Prixm2- prixm2moyen)/prixm2moyen*100,
Surface=(Surface- surfacemoy)/surfacemoy*100,
PropMaison=(PropMaison- propmaisonmoyen)/propmaisonmoyen*100,
PropAppart=(PropAppart- propappartmoyen)/propappartmoyen*100)
SyntheseCAHIRIS <- data.frame(SyntheseCAHIRIS[, c("CLUSIMMO", "NbMutations", "Surface", "Prix", "Prixm2", "PropMaison", "PropAppart")])
```
#### Passer en long
```
gather <- SyntheseCAHIRIS %>% gather(key=variable, value= "value", NbMutations:PropAppart)
```
#### Faire un graphique
```
ggplot(gather, aes(x=variable, y=value, fill=CLUSIMMO)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_fill_manual(values=c("#416979","#f9c155","#39a699","#FF4136","#FF851B", "#1f78b4")) +
ylab("Variation par rapport à la moyenne métropolitaine (%)") +
theme_bw() +
theme(legend.position = "none") +
facet_wrap(~CLUSIMMO, ncol = 1)
```
### Faire une carte de la CAH
#### Joindre le résultat de la typologie dans la couche des IRIS
```
IRISDVFCAH <- left_join(IRIS, IRISCluster, by= "code_iris")
```
#### Faire la carte (catégorisée)
```
par(mar=c(0,0,1.2,0))
typoLayer(
x = IRISDVFCAH,
var="CLUSIMMO",
col = c("#416979","#f9c155","#39a699","#FF4136","#FF851B", "#1f78b4"),
lwd = 0.1,
border = "white",
legend.values.order = c("Classe 1",
"Classe 2",
"Classe 3",
"Classe 4",
"Classe 5",
"Classe 6"),
legend.pos = "bottomleft",
legend.title.txt = "Sous-marchés \nimmobiliers",
legend.nodata = "Aucune mutation")
layoutLayer(title = "Sous-marchés immobiliers dans l'aire urbaine de Nantes à l'échelon des IRIS (2014-2019)",
author = "Sources : IGN et DGFip - Typologie obtenue par CAH",
scale = 5, frame = TRUE, col = "#cdd2d4", coltitle = "#8A5543",
north(pos = "topleft"), tabtitle=TRUE, horiz = FALSE)
```
### Ecrire un gpkg pour cartographier la CAH dans QGIS
```
st_write(IRISDVFCAH, "IRISDVFCAH.gpkg", append = FALSE)
```
Sign in with Wallet
Connect another wallet