L’objectif de ce projet est de construire un modèle de régression linéaire multiple capable d’expliquer et de prédire le prix final d’une maison à partir de six variables explicatives : la surface, le nombre de pièces, la distance au centre-ville, le temps de trajet, le numéro dans la rue et l’âge du vendeur.
Les résultats montrent que la surface est le
déterminant le plus important du prix, avec un effet positif marqué,
tandis que la distance au centre-ville exerce un effet
négatif. Le modèle obtenu possède un bon pouvoir explicatif et fournit
des prédictions cohérentes pour un nouveau bien. En revanche, l’analyse
diagnostique met en évidence une multicolinéarité
notable entre distance_centre et temps_trajet,
ainsi qu’une légère hétéroscédasticité. D’un point de
vue actuariel, le modèle est pertinent pour la prévision, mais il
gagnerait à être complété par une version plus parcimonieuse et, si
l’objectif est explicatif, par des erreurs standards robustes.
immobilier <- read.csv("immobilier.csv", header = TRUE, sep = ",", stringsAsFactors = FALSE)
dim(immobilier)
## [1] 100 7
names(immobilier)
## [1] "surface" "nb_pieces" "distance_centre" "temps_trajet"
## [5] "numero_rue" "age_vendeur" "prix"
colSums(is.na(immobilier))
## surface nb_pieces distance_centre temps_trajet numero_rue
## 0 0 0 0 0
## age_vendeur prix
## 0 0
head(immobilier)
## surface nb_pieces distance_centre temps_trajet numero_rue age_vendeur
## 1 103.1857 4 25.99405 54.84238 127 54
## 2 113.0947 5 21.56206 45.86606 12 35
## 3 166.7612 7 13.67427 29.53293 8 48
## 4 122.1153 5 17.71597 37.27440 71 59
## 5 123.8786 4 12.92830 29.54512 15 26
## 6 171.4519 7 12.61877 31.23107 83 53
## prix
## 1 303.5261
## 2 296.8194
## 3 530.1027
## 4 348.4971
## 5 363.4106
## 6 522.5020
Le fichier immobilier.csv contient 100 observations et 7
variables.
Les variables présentes sont : surface, nb_pieces, distance_centre,
temps_trajet, numero_rue, age_vendeur, prix.
Le contrôle des valeurs manquantes montre qu’il n’y a aucune
valeur manquante, ce qui permet d’estimer directement le modèle
sans étape d’imputation.
stats_desc <- data.frame(
Moyenne = sapply(immobilier, mean),
Ecart_type = sapply(immobilier, sd),
Minimum = sapply(immobilier, min),
Mediane = sapply(immobilier, median),
Maximum = sapply(immobilier, max)
)
knitr::kable(round(stats_desc, 2), caption = "Statistiques descriptives")
| Moyenne | Ecart_type | Minimum | Mediane | Maximum | |
|---|---|---|---|---|---|
| surface | 122.71 | 27.38 | 50.72 | 121.85 | 185.62 |
| nb_pieces | 4.81 | 1.24 | 2.00 | 5.00 | 8.00 |
| distance_centre | 15.60 | 4.75 | 6.22 | 15.18 | 26.47 |
| temps_trajet | 36.10 | 9.86 | 14.60 | 34.89 | 60.38 |
| numero_rue | 71.48 | 41.68 | 2.00 | 72.00 | 143.00 |
| age_vendeur | 53.48 | 10.42 | 26.00 | 53.50 | 84.00 |
| prix | 355.13 | 89.29 | 114.36 | 350.56 | 595.64 |
Le prix moyen observé est de 355.13 milliers d’euros, soit environ
355131 euros.
La surface moyenne est de 122.71 m², pour 4.81 pièces en moyenne.
La dispersion des prix (89.29 milliers d’euros) indique que
l’échantillon est suffisamment hétérogène pour justifier une
modélisation explicative.
mat_cor <- cor(immobilier)
knitr::kable(round(mat_cor, 2), caption = "Matrice de corrélation")
| surface | nb_pieces | distance_centre | temps_trajet | numero_rue | age_vendeur | prix | |
|---|---|---|---|---|---|---|---|
| surface | 1.00 | 0.89 | -0.13 | -0.14 | 0.04 | -0.03 | 0.93 |
| nb_pieces | 0.89 | 1.00 | -0.13 | -0.13 | 0.01 | 0.00 | 0.83 |
| distance_centre | -0.13 | -0.13 | 1.00 | 0.95 | -0.10 | 0.03 | -0.34 |
| temps_trajet | -0.14 | -0.13 | 0.95 | 1.00 | -0.06 | -0.01 | -0.33 |
| numero_rue | 0.04 | 0.01 | -0.10 | -0.06 | 1.00 | -0.01 | 0.06 |
| age_vendeur | -0.03 | 0.00 | 0.03 | -0.01 | -0.01 | 1.00 | -0.06 |
| prix | 0.93 | 0.83 | -0.34 | -0.33 | 0.06 | -0.06 | 1.00 |
La variable la plus corrélée au prix est la surface
(0.933), suivie du nombre de pièces (0.828).
À l’inverse, la corrélation entre le prix et la distance au
centre est négative (-0.343), ce qui est cohérent avec
l’intuition économique.
Enfin, distance_centre et temps_trajet sont
très fortement corrélés (0.949), ce qui laisse anticiper un problème de
multicolinéarité.
par(mfrow = c(1, 3))
plot(immobilier$surface, immobilier$prix,
xlab = "Surface (m²)", ylab = "Prix (k€)",
main = "Prix et surface", pch = 19)
abline(lm(prix ~ surface, data = immobilier), lwd = 2)
plot(immobilier$distance_centre, immobilier$prix,
xlab = "Distance au centre (km)", ylab = "Prix (k€)",
main = "Prix et distance", pch = 19)
abline(lm(prix ~ distance_centre, data = immobilier), lwd = 2)
plot(immobilier$distance_centre, immobilier$temps_trajet,
xlab = "Distance au centre (km)", ylab = "Temps de trajet (min)",
main = "Distance et temps", pch = 19)
abline(lm(temps_trajet ~ distance_centre, data = immobilier), lwd = 2)
par(mfrow = c(1, 1))
Les graphiques confirment trois résultats simples.
D’abord, la relation entre le prix et la surface est globalement
croissante et quasi linéaire. Ensuite, le prix tend à
diminuer quand la distance au centre augmente. Enfin, le temps de trajet
croît fortement avec la distance au centre, ce qui confirme l’existence
d’une information redondante entre ces deux variables.
Nous estimons le modèle suivant :
\[ prix_i = \beta_0 + \beta_1 surface_i + \beta_2 nb\_pieces_i + \beta_3 distance\_centre_i + \beta_4 temps\_trajet_i + \beta_5 numero\_rue_i + \beta_6 age\_vendeur_i + \varepsilon_i \]
modele <- lm(prix ~ surface + nb_pieces + distance_centre +
temps_trajet + numero_rue + age_vendeur,
data = immobilier)
coef_table <- summary(modele)$coefficients
knitr::kable(round(coef_table, 4), caption = "Table des coefficients estimés")
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 63.2103 | 22.0595 | 2.8655 | 0.0051 |
| surface | 3.0724 | 0.2104 | 14.6032 | 0.0000 |
| nb_pieces | -3.0592 | 4.6519 | -0.6576 | 0.5124 |
| distance_centre | -5.3508 | 1.7630 | -3.0350 | 0.0031 |
| temps_trajet | 0.5573 | 0.8462 | 0.6585 | 0.5118 |
| numero_rue | 0.0016 | 0.0628 | 0.0260 | 0.9793 |
| age_vendeur | -0.1334 | 0.2505 | -0.5324 | 0.5957 |
qualite_modele <- data.frame(
R2 = summary(modele)$r.squared,
R2_ajuste = summary(modele)$adj.r.squared,
RMSE = sqrt(mean(residuals(modele)^2)),
Sigma = summary(modele)$sigma
)
knitr::kable(round(qualite_modele, 4), caption = "Indicateurs de qualité du modèle")
| R2 | R2_ajuste | RMSE | Sigma |
|---|---|---|---|
| 0.9223 | 0.9173 | 24.7575 | 25.6723 |
Le coefficient de détermination vaut 0.922, et le \(R^2\) ajusté vaut 0.917.
Autrement dit, environ 92.2 % de la variabilité observée du prix est
expliquée par les variables retenues, ce qui traduit un très bon
ajustement.
Le RMSE en échantillon est de 24.76 milliers d’euros, soit environ 24757
euros.
Le coefficient associé à la surface est estimé à
3.072.
Ainsi, toutes choses égales par ailleurs, une
augmentation de 1 m² de surface augmente le prix attendu d’environ 3.072
milliers d’euros, soit près de 3072 euros. Il s’agit de la variable la
plus influente du modèle.
Le coefficient de distance_centre vaut -5.351.
Cela signifie qu’un kilomètre supplémentaire par rapport au centre-ville
est associé à une baisse moyenne d’environ 5.351 milliers d’euros du
prix de vente, toutes choses égales par ailleurs. Cet effet est cohérent
avec la logique de marché immobilier.
En revanche, nb_pieces, temps_trajet,
numero_rue et age_vendeur ne sont pas
significatifs au seuil de 5 %.
D’un point de vue actuariel, cela signifie surtout que leur
apport marginal devient faible une fois que la surface
et la localisation sont déjà prises en compte. Cela peut également
refléter la forte corrélation entre certaines variables
explicatives.
vif_maison <- function(model) {
X <- model.matrix(model)[, -1, drop = FALSE]
vif <- numeric(ncol(X))
names(vif) <- colnames(X)
for (j in 1:ncol(X)) {
y_j <- X[, j]
x_j <- X[, -j, drop = FALSE]
reg_aux <- lm(y_j ~ ., data = as.data.frame(x_j))
vif[j] <- 1 / (1 - summary(reg_aux)$r.squared)
}
return(vif)
}
vif_modele <- vif_maison(modele)
table_vif <- data.frame(
Variable = names(vif_modele),
VIF = as.numeric(vif_modele)
)
table_vif$VIF <- round(table_vif$VIF, 2)
knitr::kable(table_vif, caption = "Facteurs d'inflation de variance (VIF)")
| Variable | VIF |
|---|---|
| surface | 4.99 |
| nb_pieces | 4.97 |
| distance_centre | 10.53 |
| temps_trajet | 10.46 |
| numero_rue | 1.03 |
| age_vendeur | 1.02 |
Les VIF sont particulièrement élevés pour
distance_centre et temps_trajet, ce qui
confirme une multicolinéarité importante entre ces deux
variables.
Les variables surface et nb_pieces présentent
également une corrélation marquée, mais à un niveau plus modéré. Cela
explique pourquoi certaines variables intuitivement pertinentes peuvent
apparaître peu significatives en présence des autres.
par(mfrow = c(2, 2))
plot(modele)
par(mfrow = c(1, 1))
Dans l’ensemble, les graphiques diagnostiques sont satisfaisants : la relation semble correctement captée, la normalité des résidus paraît acceptable et l’écart à l’homoscédasticité reste limité, même si une légère dispersion variable est visible.
test_shapiro <- shapiro.test(residuals(modele))
test_shapiro
##
## Shapiro-Wilk normality test
##
## data: residuals(modele)
## W = 0.98395, p-value = 0.2662
La p-value du test de Shapiro-Wilk vaut 0.2662.
On ne rejette donc pas l’hypothèse de normalité des résidus au seuil de
5 %, ce qui rend l’approximation gaussienne globalement acceptable.
bp_test_maison <- function(model) {
e2 <- residuals(model)^2
X <- model.matrix(model)[, -1, drop = FALSE]
reg_aux <- lm(e2 ~ ., data = as.data.frame(X))
LM <- nrow(X) * summary(reg_aux)$r.squared
ddl <- ncol(X)
p_value <- 1 - pchisq(LM, df = ddl)
data.frame(
Statistique_LM = LM,
ddl = ddl,
p_value = p_value
)
}
bp_table <- bp_test_maison(modele)
knitr::kable(round(bp_table, 4), caption = "Test de Breusch-Pagan")
| Statistique_LM | ddl | p_value |
|---|---|---|
| 14.4718 | 6 | 0.0248 |
La p-value du test de Breusch-Pagan est de 0.0248.
On détecte donc une hétéroscédasticité légère au seuil
de 5 %. Pour un usage de prévision, cela reste acceptable, mais pour une
inférence plus rigoureuse sur les coefficients, il serait préférable
d’utiliser des erreurs standards robustes.
cook <- cooks.distance(modele)
seuil_cook <- 4 / nrow(immobilier)
points_influents <- data.frame(
Observation = which(cook > seuil_cook),
Distance_Cook = cook[cook > seuil_cook]
)
plot(cook, type = "h",
main = "Distance de Cook",
xlab = "Observation", ylab = "Cook's distance")
abline(h = seuil_cook, lty = 2)
if (nrow(points_influents) == 0) {
points_influents <- data.frame(
Observation = NA_integer_,
Distance_Cook = NA_real_
)
}
knitr::kable(round(points_influents, 4), caption = "Observations potentiellement influentes")
| Observation | Distance_Cook | |
|---|---|---|
| 1 | 1 | 0.0626 |
| 19 | 19 | 0.0635 |
| 22 | 22 | 0.0468 |
| 40 | 40 | 0.0609 |
| 43 | 43 | 0.2539 |
| 92 | 92 | 0.0725 |
Le seuil usuel retenu est
4/n = r round(seuil_cook, 4).
Dans cet échantillon, 6 observation(s) dépassent ce seuil. Il ne s’agit
pas nécessairement d’erreurs, mais ces points doivent être surveillés
car ils peuvent peser fortement sur les coefficients estimés.
cv_rmse_lm <- function(formula, data, K = 10, seed = 123) {
set.seed(seed)
n <- nrow(data)
folds <- sample(rep(1:K, length.out = n))
rmse_fold <- numeric(K)
for (k in 1:K) {
train_data <- data[folds != k, ]
test_data <- data[folds == k, ]
mod_k <- lm(formula, data = train_data)
pred_k <- predict(mod_k, newdata = test_data)
rmse_fold[k] <- sqrt(mean((test_data$prix - pred_k)^2))
}
data.frame(
Fold = 1:K,
RMSE = rmse_fold
)
}
cv_table <- cv_rmse_lm(
prix ~ surface + nb_pieces + distance_centre + temps_trajet + numero_rue + age_vendeur,
data = immobilier,
K = 10,
seed = 123
)
cv_resume <- data.frame(
RMSE_moyen = mean(cv_table$RMSE),
RMSE_ecart_type = sd(cv_table$RMSE)
)
knitr::kable(round(cv_resume, 4), caption = "Synthèse du RMSE en validation croisée à 10 blocs")
| RMSE_moyen | RMSE_ecart_type |
|---|---|
| 24.5856 | 9.411 |
Le RMSE moyen en validation croisée vaut 24.59 milliers
d’euros.
Il est proche du RMSE obtenu en échantillon, ce qui suggère que le
modèle généralise correctement et qu’il ne souffre pas d’un
sur-ajustement excessif.
new_house <- data.frame(
surface = 120,
nb_pieces = 5,
distance_centre = 10,
temps_trajet = 20,
numero_rue = 15,
age_vendeur = 60
)
prediction_house <- predict(modele, newdata = new_house,
interval = "prediction", level = 0.95)
prediction_table <- data.frame(prediction_house)
knitr::kable(round(prediction_table, 2), caption = "Prédiction pour la nouvelle maison")
| fit | lwr | upr |
|---|---|---|
| 366.26 | 313.45 | 419.08 |
Pour la maison considérée, le prix prédit est de 366.26 milliers
d’euros, soit environ 366263 euros.
L’intervalle de prédiction à 95 % est [313.45 ; 419.08] milliers
d’euros.
Cet intervalle est plus large qu’un intervalle de confiance sur la
moyenne, car il intègre aussi la variabilité individuelle des prix
autour de la droite de régression.
Cette étude met en évidence que la surface et la
localisation sont les principaux déterminants du prix
immobilier dans cet échantillon.
Le modèle linéaire multiple présente de bonnes performances globales,
avec un \(R^2\) de 0.922 et un RMSE de
validation croisée d’environ 24.59 milliers d’euros.
Les diagnostics montrent toutefois deux limites principales : une
multicolinéarité élevée entre
distance_centre et temps_trajet, ainsi qu’une
hétéroscédasticité légère.
Dans une logique de prolongement, deux pistes sont particulièrement
pertinentes :
distance_centre
ou temps_trajet, et en réévaluant la place de
nb_pieces.Au total, le modèle proposé constitue une base solide pour une première estimation automatisée du prix des maisons. ```