D5
Gaby
2025-06-06
Le jeu de données Maisons_Québec.csv contient les informations d’un échantillon de propriétés à vendre sur le site web de DuProprio en 2023. Dans ce travail, on tentera de modéliser le prix affiché à l’aide d’un modèle de régression linéaire. Toutes les données serviront à la création du modèle (pas de plage d’apprentissage).
QUESTION 1 (8 points) Présentons d’abord un aperçu des données. (a) Présentez une carte illustrant l’emplacement des propriétés avec une légende de couleur associée aux prix affichés.
#Chargement des librairies et fonctions necessaires
rm(list=ls())
setwd("~/USHERBROOKE/ESCUELA/ÉTÉ/MQG813 - Statistiques décisionnelles avancées/D5")
#Verifie si une librairie est installee, l'installe au besoin et la charge
list.of.packages <- c("modelr", "rio", "tidyverse", "DescTools", "pastecs",
"psych", "pander", "gmodels", "vcd", "fastDummies",
"questionr", "PerformanceAnalytics", "Hmisc", "FSA",
"car", "robustHD", "hexView", "ggplot2", "dplyr",
"forecast", "latticeExtra", "numbers", "zoo", "lubridate",
"stringr", "fastDummies", "descr","tinytex","readr","leaflet")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
#install.packages("quantmod") %>%
#library("quantmod")
if(length(new.packages)) {install.packages(new.packages)}
lapply(list.of.packages, require, character.only = TRUE)## Loading required package: modelr## Loading required package: rio## Loading required package: tidyverse## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Loading required package: DescTools
##
## Loading required package: pastecs
##
##
## Attaching package: 'pastecs'
##
##
## The following objects are masked from 'package:dplyr':
##
## first, last
##
##
## The following object is masked from 'package:tidyr':
##
## extract
##
##
## Loading required package: psych
##
##
## Attaching package: 'psych'
##
##
## The following objects are masked from 'package:DescTools':
##
## AUC, ICC, SD
##
##
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
##
##
## Loading required package: pander
##
## Loading required package: gmodels
##
## Registered S3 method overwritten by 'gdata':
## method from
## reorder.factor DescTools
##
## Loading required package: vcd
##
## Loading required package: grid
##
## Loading required package: fastDummies
##
## Loading required package: questionr
##
##
## Attaching package: 'questionr'
##
##
## The following object is masked from 'package:psych':
##
## describe
##
##
## Loading required package: PerformanceAnalytics
##
## Loading required package: xts
##
## Loading required package: zoo
##
##
## Attaching package: 'zoo'
##
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
##
##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## ###############################################################################
##
##
## Attaching package: 'xts'
##
##
## The following objects are masked from 'package:pastecs':
##
## first, last
##
##
## The following objects are masked from 'package:dplyr':
##
## first, last
##
##
##
## Attaching package: 'PerformanceAnalytics'
##
##
## The following object is masked from 'package:vcd':
##
## Kappa
##
##
## The following object is masked from 'package:graphics':
##
## legend
##
##
## Loading required package: Hmisc
##
##
## Attaching package: 'Hmisc'
##
##
## The following objects are masked from 'package:questionr':
##
## describe, wtd.mean, wtd.table, wtd.var
##
##
## The following object is masked from 'package:psych':
##
## describe
##
##
## The following objects are masked from 'package:DescTools':
##
## %nin%, Label, Mean, Quantile
##
##
## The following objects are masked from 'package:dplyr':
##
## src, summarize
##
##
## The following objects are masked from 'package:base':
##
## format.pval, units
##
##
## Loading required package: FSA
##
## ## FSA v0.9.6. See citation('FSA') if used in publication.
## ## Run fishR() for related website and fishR('IFAR') for related book.
##
##
## Attaching package: 'FSA'
##
##
## The following object is masked from 'package:psych':
##
## headtail
##
##
## Loading required package: car
##
## Loading required package: carData
##
## Registered S3 methods overwritten by 'car':
## method from
## hist.boot FSA
## confint.boot FSA
##
##
## Attaching package: 'car'
##
##
## The following object is masked from 'package:FSA':
##
## bootCase
##
##
## The following object is masked from 'package:psych':
##
## logit
##
##
## The following object is masked from 'package:DescTools':
##
## Recode
##
##
## The following object is masked from 'package:dplyr':
##
## recode
##
##
## The following object is masked from 'package:purrr':
##
## some
##
##
## Loading required package: robustHD
##
## Loading required package: perry
##
## Loading required package: parallel
##
##
## Attaching package: 'perry'
##
##
## The following object is masked from 'package:modelr':
##
## mape
##
##
## Loading required package: robustbase
##
## Loading required package: hexView
##
## Loading required package: forecast
##
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
##
##
## Attaching package: 'forecast'
##
##
## The following object is masked from 'package:DescTools':
##
## BoxCox
##
##
## Loading required package: latticeExtra
##
## Loading required package: lattice
##
##
## Attaching package: 'latticeExtra'
##
##
## The following object is masked from 'package:vcd':
##
## rootogram
##
##
## The following object is masked from 'package:ggplot2':
##
## layer
##
##
## Loading required package: numbers
##
##
## Attaching package: 'numbers'
##
##
## The following object is masked from 'package:PerformanceAnalytics':
##
## Omega
##
##
## The following object is masked from 'package:psych':
##
## omega
##
##
## The following objects are masked from 'package:DescTools':
##
## GCD, LCM, Primes
##
##
## Loading required package: descr
##
##
## Attaching package: 'descr'
##
##
## The following object is masked from 'package:questionr':
##
## freq
##
##
## The following object is masked from 'package:gmodels':
##
## CrossTable
##
##
## Loading required package: tinytex
##
## Loading required package: leaflet
##
##
## Attaching package: 'leaflet'
##
##
## The following object is masked from 'package:xts':
##
## addLegend## [[1]]
## [1] TRUE
##
## [[2]]
## [1] TRUE
##
## [[3]]
## [1] TRUE
##
## [[4]]
## [1] TRUE
##
## [[5]]
## [1] TRUE
##
## [[6]]
## [1] TRUE
##
## [[7]]
## [1] TRUE
##
## [[8]]
## [1] TRUE
##
## [[9]]
## [1] TRUE
##
## [[10]]
## [1] TRUE
##
## [[11]]
## [1] TRUE
##
## [[12]]
## [1] TRUE
##
## [[13]]
## [1] TRUE
##
## [[14]]
## [1] TRUE
##
## [[15]]
## [1] TRUE
##
## [[16]]
## [1] TRUE
##
## [[17]]
## [1] TRUE
##
## [[18]]
## [1] TRUE
##
## [[19]]
## [1] TRUE
##
## [[20]]
## [1] TRUE
##
## [[21]]
## [1] TRUE
##
## [[22]]
## [1] TRUE
##
## [[23]]
## [1] TRUE
##
## [[24]]
## [1] TRUE
##
## [[25]]
## [1] TRUE
##
## [[26]]
## [1] TRUE
##
## [[27]]
## [1] TRUE
##
## [[28]]
## [1] TRUE
##
## [[29]]
## [1] TRUE
##
## [[30]]
## [1] TRUEinstall_formats()
source("~/USHERBROOKE/ESCUELA/ÉTÉ/MQG813 - Statistiques décisionnelles avancées/D5/MQG813_librairie_spatial.R")## Loading required package: nlme
##
## Attaching package: 'nlme'
##
## The following object is masked from 'package:forecast':
##
## getResponse
##
## The following object is masked from 'package:dplyr':
##
## collapse
##
## Loading required package: knitr
## Loading required package: ape
##
## Attaching package: 'ape'
##
## The following object is masked from 'package:Hmisc':
##
## zoom
##
## The following object is masked from 'package:dplyr':
##
## where
##
## Loading required package: geosphere
##
## Attaching package: 'geosphere'
##
## The following object is masked from 'package:FSA':
##
## geomean
##
## Loading required package: leaflegend
## Loading required package: leaflet.extras
## Loading required package: terra
## terra 1.8.54
##
## Attaching package: 'terra'
##
## The following objects are masked from 'package:ape':
##
## rotate, trans, zoom
##
## The following object is masked from 'package:knitr':
##
## spin
##
## The following objects are masked from 'package:descr':
##
## crosstab, freq
##
## The following objects are masked from 'package:Hmisc':
##
## describe, mask, zoom
##
## The following object is masked from 'package:zoo':
##
## time<-
##
## The following objects are masked from 'package:questionr':
##
## describe, freq
##
## The following objects are masked from 'package:vcd':
##
## mosaic, sieve
##
## The following object is masked from 'package:grid':
##
## depth
##
## The following object is masked from 'package:pander':
##
## wrap
##
## The following objects are masked from 'package:psych':
##
## describe, distance, rescale
##
## The following object is masked from 'package:pastecs':
##
## extract
##
## The following object is masked from 'package:tidyr':
##
## extract
##
## The following object is masked from 'package:modelr':
##
## resample
##
## Loading required package: gstat
## Loading required package: tmaptools
## Loading required package: sp
## Loading required package: sf
## Linking to GEOS 3.13.1, GDAL 3.10.2, PROJ 9.5.1; sf_use_s2() is TRUE#Importer le jeu de donnees
maison <- import("Maisons_Québec.csv")
#Creer une variable ID
maison$ID <- rownames(maison)
# Copiar longitude y latitude a x e y
maison$x <- maison$longitude
maison$y <- maison$latitude
#Creation d'une variable categorique pour le prix en sous-groupes de 20%
maison$price_group = cut(maison$prix, #pricegroup noueeau col
breaks=quantile(maison$prix, # quantile= 5 gropues.. cartiles
probs = seq(0, 1, by = 0.2), # by 0.2 coupe commence a 0.. a 0.2 a 0.4 a 0.6...
na.rm=T),
dig.lab=10,
include.lowest = TRUE)
# separe les donnes en 5 intervales..
#cut pois data prix en breakes en quantiles..... by 0.1 ..
#price group: varaible cateogrique...218 exclut ( et ] inclut
#Determiner les palettes de couleurs
col <- colorRampPalette(c('red', 'blue'))(nlevels(maison$price_group))#col -- liste
pal <- colorFactor(palette = col, #pal palette de couleur
levels = levels(maison$price_group))
# de ou a ou col en changeant le couleur <- colorRampPalette(c('red','purple', 'blue'))(nlevels(data$price_group))
#Carte----cette partie fonctionne pas
leaflet(data=maison) %>%
addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
addCircles(~longitude, ~latitude, weight = 1,
radius=100,
fillOpacity = 1,
color=~pal(maison$price_group)) %>%
addLegend("bottomright",
colors=col,
labels=levels(maison$price_group),
title="Répartition des prix",
opacity = 1)#mais ca devrait me donner ca
#Fonction personnalisee---magie du prof
carte_geo(maison,
long="longitude",
lat="latitude",
variable="prix", # Vvariable a representee
nb_groupes=5,
intervalles="quantiles", #quantiles,uniforme en tranques egale, ou les vectepur avec les separateurs
#intervalles=c(0,20000,400000,600000,800000,1000000), # on peut mettre les intervalles
#couleur=c('red', 'blue'),
couleur=c('red', 'blue'),
taille=5, # taille de points
forme=T, # changer la forme
titre="Répartition des prix",
position="bottomright") #position="topleft")
#carte_geo -- intervalles=c(0,20000,400000) tu propose ta plage intervalle.. avantage.. plus lissible
# forme- on peut changer la forme
#position--- topleft- Présentez une carte illustrant l’emplacement des propriétés avec une légende de couleur associée à la variable spatialement déphasée définie par la moyenne des prix affichés des 30 voisins les plus proches.
#Definir le nombre de voisins souhaite
k <- 30
#Creation de la variable dephasee
for (i in 1:nrow(maison)){
#Calcul des distances par rapport a la maison actuelle (i)
maison$distances_temp <- distGeo(maison[i, c("longitude", "latitude")], maison[, c("longitude", "latitude")])
#Trier les observations en ordre croissant des distances
maison <- maison %>% arrange(distances_temp)
#Filtre des k voisins les plus proches on aurait pu mettre apartir de le 2..
filtre_temp <- intersect(c(1:(k+1)), which(maison$ID != i))
#Calculer la moyenne des k voisins les plus proches
maison$prix_lag_adap[i] <- mean(maison$prix[filtre_temp], na.rm =T)
}
#Fonction personnalisee
maison$prix_lag_adap <- var_spat_dephasee(variable="prix",
long="longitude", lat="latitude",
data=maison,
type_rayon="adaptatif",
rayon=30,
interpolation="moyenne")## | | | 0% | | | 1% | |= | 1% | |= | 2% | |= | 3% | |== | 3% | |== | 4% | |== | 5% | |=== | 5% | |=== | 6% | |=== | 7% | |==== | 7% | |==== | 8% | |==== | 9% | |===== | 9% | |===== | 10% | |===== | 11% | |====== | 11% | |====== | 12% | |====== | 13% | |======= | 13% | |======= | 14% | |======= | 15% | |======== | 15% | |======== | 16% | |======== | 17% | |========= | 17% | |========= | 18% | |========= | 19% | |========== | 19% | |========== | 20% | |========== | 21% | |=========== | 21% | |=========== | 22% | |=========== | 23% | |============ | 23% | |============ | 24% | |============ | 25% | |============= | 25% | |============= | 26% | |============= | 27% | |============== | 27% | |============== | 28% | |============== | 29% | |=============== | 29% | |=============== | 30% | |=============== | 31% | |================ | 31% | |================ | 32% | |================ | 33% | |================= | 33% | |================= | 34% | |================= | 35% | |================== | 35% | |================== | 36% | |================== | 37% | |=================== | 37% | |=================== | 38% | |=================== | 39% | |==================== | 39% | |==================== | 40% | |==================== | 41% | |===================== | 41% | |===================== | 42% | |===================== | 43% | |====================== | 43% | |====================== | 44% | |====================== | 45% | |======================= | 45% | |======================= | 46% | |======================= | 47% | |======================== | 47% | |======================== | 48% | |======================== | 49% | |========================= | 49% | |========================= | 50% | |========================= | 51% | |========================== | 51% | |========================== | 52% | |========================== | 53% | |=========================== | 53% | |=========================== | 54% | |=========================== | 55% | |============================ | 55% | |============================ | 56% | |============================ | 57% | |============================= | 57% | |============================= | 58% | |============================= | 59% | |============================== | 59% | |============================== | 60% | |============================== | 61% | |=============================== | 61% | |=============================== | 62% | |=============================== | 63% | |================================ | 63% | |================================ | 64% | |================================ | 65% | |================================= | 65% | |================================= | 66% | |================================= | 67% | |================================== | 67% | |================================== | 68% | |================================== | 69% | |=================================== | 69% | |=================================== | 70% | |=================================== | 71% | |==================================== | 71% | |==================================== | 72% | |==================================== | 73% | |===================================== | 73% | |===================================== | 74% | |===================================== | 75% | |====================================== | 75% | |====================================== | 76% | |====================================== | 77% | |======================================= | 77% | |======================================= | 78% | |======================================= | 79% | |======================================== | 79% | |======================================== | 80% | |======================================== | 81% | |========================================= | 81% | |========================================= | 82% | |========================================= | 83% | |========================================== | 83% | |========================================== | 84% | |========================================== | 85% | |=========================================== | 85% | |=========================================== | 86% | |=========================================== | 87% | |============================================ | 87% | |============================================ | 88% | |============================================ | 89% | |============================================= | 89% | |============================================= | 90% | |============================================= | 91% | |============================================== | 91% | |============================================== | 92% | |============================================== | 93% | |=============================================== | 93% | |=============================================== | 94% | |=============================================== | 95% | |================================================ | 95% | |================================================ | 96% | |================================================ | 97% | |================================================= | 97% | |================================================= | 98% | |================================================= | 99% | |==================================================| 99% | |==================================================| 100%#Carte
carte_geo(maison, long="longitude", lat="latitude",
variable="prix_lag_adap", nb_groupes=5,
intervalles="quantiles",
couleur=c('red', 'black'),
taille=4,
# taille=T, # ADAPTE LA TAille par rappor a la variable
titre="Répartition des prix moyens",
position="bottomright")- À l’aide du fichier quebec_regions.geojson, présentez une carte représentant les régions administratives avec une légende de couleur associée aux prix médians.
#Importer le fichier des delimitations fichier qui va couper les arrondisments
delim <- read_sf("quebec_regions.geojson", crs = 4326)
#Convertir les donnees des data en objet spatial
maison <- st_as_sf(maison, coords = c("longitude", "latitude"), crs = 4326)
#maison<- maison %>%
# mutate(long = st_coordinates(.)[,1],
# lat = st_coordinates(.)[,2]) # ajouter les coordonnees x et y
# data frame spatiale... positionnement implicite crs.. code pour lire donne du globe
#Joindre les delimitations aux donnees
maison_region <- st_join(maison,delim,join=st_intersects) # left sur delim.. por si tenemos vauler manquantes
# st join fusione 2 table type spatial pour savoir en quel region cest chaque resto
#Calculer le prix median par region
maison_region <-maison_region %>%
group_by(RES_NM_REG) %>% #degrouo par region
mutate(prix_median = median(prix, na.rm = TRUE))%>%
ungroup()# faites moi la moyen de rating..certain secteur sans score
# garde le nom
# 1. Joindre le prix médian à chaque région
regions_prix <- delim %>%
left_join(
maison_region %>%
st_drop_geometry() %>%
dplyr::select(RES_NM_REG, prix_median) %>%
distinct(),
by = "RES_NM_REG") %>%
mutate(
prix_group = cut(prix_median,
breaks = quantile(prix_median, probs = seq(0, 1, by = 0.2), na.rm = TRUE),
include.lowest = TRUE)
)
#####
######Definir une palette de couleurs
col <- colorRampPalette(c("purple", "blue"))(length(levels(regions_prix$prix_group)))
pal <- colorFactor(palette = col, levels = levels(regions_prix$prix_group))
library(sf)
library(leaflet)
library(dplyr)
leaflet(data = regions_prix) %>%
addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
addPolygons(fillColor = ~pal(prix_group),
color = "black",
weight = 1,
fillOpacity = 0.7,
popup = ~paste("Région : ", RES_NM_REG, "<br>Prix médian : ", round(prix_median, 0), "$")) %>%
addLegend("bottomright",
colors = col,
labels = levels(regions_prix$prix_group),
title = "Prix médians par région",
opacity = 1)#####- À l’aide de l’indice de Moran calculé sur un rayon de 10 km ainsi que des trois cartes présentées précédemment, peut-on dire que les prix affichés sont spatialement autocorrélés ?
#Matrice des distances
maison_region <- st_drop_geometry(maison_region)
matrice_distance <- distm(maison_region[, c("x", "y")])
IMoran_prix<-IMoran(maison_region$prix,matrice_distance, rayon=10000)
IMoran_prix_lag<-IMoran(maison_region$prix_lag_adap,matrice_distance, rayon=10000)
IMoran_prix_median<-IMoran(maison_region$prix_median,matrice_distance, rayon=10000)
#Afficher les resultats
IMoran_prix## n observed expected sd p.value
## 1 1302 0.1449438 -0.0007686395 0.0174756 0IMoran_prix_lag## n observed expected sd p.value
## 1 1302 0.9384431 -0.0007686395 0.01791668 0IMoran_prix_median## n observed expected sd p.value
## 1 1302 0.9759602 -0.0007686395 0.01791845 0QUESTION 2 (8 points)
Développez un modèle de régression linéaire estimant le prix affiché à l’aide des variables explicatives à votre disposition. Ce modèle servira de modèle de base pour la suite du travail. Vous pouvez ne présenter que le résumé du modèle final choisi en expliquant globalement vos choix. Analysez la validité des résidus de ce modèle.
Remarque : Pour obtenir tous les points de cette question, il faut minimalement trouver un modèle dont toutes les variables sont statistiquement significatives. Des points bonis seront toutefois accordés aux équipes qui présenteront le modèle avec les meilleurs MAPE sur la plage d’essai (données conservées précieusement par l’enseignant).
Il n’est pas absolument nécessaire de respecter toutes les conditions de validité. Mais, n’oubliez pas que pour obtenir un bon modèle qui se généralise bien à des données inconnues, il est habituellement recommandé de trouver un modèle qui tend vers le respect des conditions de validité tout en évitant le surapprentissage par des modèles trop complexes.
Dans votre exploration, vous pouvez créer de nouvelles variables (catégorisation, calculs, transformation mathématique, interactions), traiter les valeurs aberrantes, etc. Il est toutefois interdit d’utiliser des variables spatialement déphasées, car leur ajout sera exploré dans la prochaine question.
maison_mod <- maison_region %>%
st_drop_geometry() %>%
dplyr::select(prix, nb_etages, nb_chambres, nb_salles_de_bain,
aire_habitable, taille_terrain,
taxes_municipales, taxes_scolaires,
assurances, electricite, RES_NM_REG) %>%
filter(!is.na(prix)) %>%
drop_na() %>%
mutate(RES_NM_REG = as.factor(RES_NM_REG))
# Modèle initial brut
modele1 <- lm(prix ~ nb_etages + nb_chambres + nb_salles_de_bain +
aire_habitable + taille_terrain +
taxes_municipales + taxes_scolaires +
assurances + electricite +
RES_NM_REG,
data = maison_mod)
summary(modele1)##
## Call:
## lm(formula = prix ~ nb_etages + nb_chambres + nb_salles_de_bain +
## aire_habitable + taille_terrain + taxes_municipales + taxes_scolaires +
## assurances + electricite + RES_NM_REG, data = maison_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2001533 -88840 -6795 74242 4266350
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -8.547e+04 8.312e+04 -1.028 0.30402
## nb_etages 3.991e+04 1.259e+04 3.171 0.00155
## nb_chambres -7.772e+03 6.826e+03 -1.139 0.25507
## nb_salles_de_bain 1.941e+04 1.174e+04 1.653 0.09863
## aire_habitable 1.705e+00 2.241e+00 0.761 0.44680
## taille_terrain 7.189e-02 7.558e-03 9.511 < 2e-16
## taxes_municipales 2.835e-01 8.083e-01 0.351 0.72582
## taxes_scolaires 8.970e+02 3.907e+01 22.960 < 2e-16
## assurances 1.053e+02 9.099e+00 11.576 < 2e-16
## electricite 1.558e+01 7.497e+00 2.078 0.03789
## RES_NM_REGBas-Saint-Laurent -4.909e+03 8.711e+04 -0.056 0.95507
## RES_NM_REGCapitale-Nationale 5.790e+04 8.106e+04 0.714 0.47518
## RES_NM_REGCentre-du-Québec 5.900e+04 8.563e+04 0.689 0.49094
## RES_NM_REGChaudière-Appalaches 2.723e+03 8.212e+04 0.033 0.97356
## RES_NM_REGCôte-Nord -6.793e+04 1.072e+05 -0.633 0.52660
## RES_NM_REGEstrie 1.737e+05 8.268e+04 2.100 0.03589
## RES_NM_REGGaspésie–Îles-de-la-Madeleine 2.807e+04 1.055e+05 0.266 0.79013
## RES_NM_REGLanaudière 1.223e+05 8.289e+04 1.475 0.14044
## RES_NM_REGLaurentides 2.498e+05 8.211e+04 3.043 0.00239
## RES_NM_REGLaval 1.673e+05 8.854e+04 1.889 0.05905
## RES_NM_REGMauricie 1.071e+05 8.776e+04 1.221 0.22244
## RES_NM_REGMontérégie 1.918e+05 8.132e+04 2.359 0.01847
## RES_NM_REGMontréal 1.940e+05 8.390e+04 2.313 0.02089
## RES_NM_REGNord-du-Québec -2.508e+04 2.010e+05 -0.125 0.90073
## RES_NM_REGOutaouais 1.089e+05 8.341e+04 1.306 0.19182
## RES_NM_REGSaguenay–Lac-Saint-Jean -4.835e+04 8.353e+04 -0.579 0.56283
##
## (Intercept)
## nb_etages **
## nb_chambres
## nb_salles_de_bain .
## aire_habitable
## taille_terrain ***
## taxes_municipales
## taxes_scolaires ***
## assurances ***
## electricite *
## RES_NM_REGBas-Saint-Laurent
## RES_NM_REGCapitale-Nationale
## RES_NM_REGCentre-du-Québec
## RES_NM_REGChaudière-Appalaches
## RES_NM_REGCôte-Nord
## RES_NM_REGEstrie *
## RES_NM_REGGaspésie–Îles-de-la-Madeleine
## RES_NM_REGLanaudière
## RES_NM_REGLaurentides **
## RES_NM_REGLaval .
## RES_NM_REGMauricie
## RES_NM_REGMontérégie *
## RES_NM_REGMontréal *
## RES_NM_REGNord-du-Québec
## RES_NM_REGOutaouais
## RES_NM_REGSaguenay–Lac-Saint-Jean
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 260800 on 1374 degrees of freedom
## Multiple R-squared: 0.5607, Adjusted R-squared: 0.5527
## F-statistic: 70.16 on 25 and 1374 DF, p-value: < 2.2e-16###On retire les varaibles non significatifs
modele2 <- lm(prix ~ nb_etages + taille_terrain + taxes_scolaires + assurances +
electricite +
RES_NM_REG,
data = maison_mod)
source("MQG813_librairie_temporel.R")## Loading required package: ggpubr##
## Attaching package: 'ggpubr'## The following object is masked from 'package:terra':
##
## rotate## The following object is masked from 'package:ape':
##
## rotate## The following object is masked from 'package:forecast':
##
## gghistogram## Loading required package: vars## Loading required package: MASS##
## Attaching package: 'MASS'## The following object is masked from 'package:terra':
##
## area## The following object is masked from 'package:dplyr':
##
## select## Loading required package: strucchange## Loading required package: sandwich##
## Attaching package: 'strucchange'## The following object is masked from 'package:stringr':
##
## boundary## Loading required package: urca## Loading required package: lmtest##
## Attaching package: 'vars'## The following object is masked from 'package:DescTools':
##
## Phisummary(modele2)##
## Call:
## lm(formula = prix ~ nb_etages + taille_terrain + taxes_scolaires +
## assurances + electricite + RES_NM_REG, data = maison_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1999084 -90510 -10054 75140 4269548
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -8.169e+04 8.199e+04 -0.996 0.31930
## nb_etages 3.996e+04 1.250e+04 3.196 0.00142
## taille_terrain 7.219e-02 7.543e-03 9.570 < 2e-16
## taxes_scolaires 9.106e+02 3.799e+01 23.968 < 2e-16
## assurances 1.055e+02 8.645e+00 12.207 < 2e-16
## electricite 1.713e+01 7.149e+00 2.395 0.01673
## RES_NM_REGBas-Saint-Laurent -3.502e+03 8.707e+04 -0.040 0.96792
## RES_NM_REGCapitale-Nationale 5.628e+04 8.105e+04 0.694 0.48759
## RES_NM_REGCentre-du-Québec 5.537e+04 8.560e+04 0.647 0.51787
## RES_NM_REGChaudière-Appalaches -2.717e+03 8.205e+04 -0.033 0.97359
## RES_NM_REGCôte-Nord -7.715e+04 1.071e+05 -0.720 0.47151
## RES_NM_REGEstrie 1.744e+05 8.267e+04 2.109 0.03508
## RES_NM_REGGaspésie–Îles-de-la-Madeleine 2.058e+04 1.053e+05 0.195 0.84509
## RES_NM_REGLanaudière 1.204e+05 8.288e+04 1.453 0.14640
## RES_NM_REGLaurentides 2.490e+05 8.210e+04 3.033 0.00246
## RES_NM_REGLaval 1.632e+05 8.850e+04 1.844 0.06546
## RES_NM_REGMauricie 1.055e+05 8.775e+04 1.203 0.22928
## RES_NM_REGMontérégie 1.904e+05 8.129e+04 2.342 0.01934
## RES_NM_REGMontréal 1.901e+05 8.378e+04 2.269 0.02345
## RES_NM_REGNord-du-Québec -3.272e+04 2.008e+05 -0.163 0.87057
## RES_NM_REGOutaouais 1.072e+05 8.340e+04 1.285 0.19897
## RES_NM_REGSaguenay–Lac-Saint-Jean -4.983e+04 8.352e+04 -0.597 0.55086
##
## (Intercept)
## nb_etages **
## taille_terrain ***
## taxes_scolaires ***
## assurances ***
## electricite *
## RES_NM_REGBas-Saint-Laurent
## RES_NM_REGCapitale-Nationale
## RES_NM_REGCentre-du-Québec
## RES_NM_REGChaudière-Appalaches
## RES_NM_REGCôte-Nord
## RES_NM_REGEstrie *
## RES_NM_REGGaspésie–Îles-de-la-Madeleine
## RES_NM_REGLanaudière
## RES_NM_REGLaurentides **
## RES_NM_REGLaval .
## RES_NM_REGMauricie
## RES_NM_REGMontérégie *
## RES_NM_REGMontréal *
## RES_NM_REGNord-du-Québec
## RES_NM_REGOutaouais
## RES_NM_REGSaguenay–Lac-Saint-Jean
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 260800 on 1378 degrees of freedom
## Multiple R-squared: 0.5595, Adjusted R-squared: 0.5528
## F-statistic: 83.34 on 21 and 1378 DF, p-value: < 2.2e-16# Ajout des previsions
maison_mod<- ajouter_previsions(maison_mod, modele2,
intervalles=0.95,residu=TRUE,
noms_personnalises="2")
#graphe sequentiel des residus standarises
ggplot(data=maison_mod, aes(x=PREV_2, y=ZRES_2)) +
geom_point() +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
geom_hline(yintercept = 3, linetype = "dotted", color = "darkblue") +
geom_hline(yintercept = -3, linetype = "dotted", color = "darkblue") +
theme_minimal()
#indices de performance
indices_performance("prix","PREV_2",data=maison_mod)## N MAD MAPE
## Valeur de l'indice 1400 134671.1 0.253958###on voit qui peutetre ca sera pertinene dajouter des varaibles binaires dummy pour les regions
maison_mod <- maison_mod %>%
dummy_cols(select_columns = "RES_NM_REG", remove_first_dummy = TRUE, remove_selected_columns = TRUE)
#MODELE 3
modele3 <- lm(prix ~ nb_etages + taille_terrain + taxes_scolaires +
assurances + electricite +
RES_NM_REG_Estrie + RES_NM_REG_Laurentides +
RES_NM_REG_Montérégie + RES_NM_REG_Montréal,
data = maison_mod)
summary(modele3)##
## Call:
## lm(formula = prix ~ nb_etages + taille_terrain + taxes_scolaires +
## assurances + electricite + RES_NM_REG_Estrie + RES_NM_REG_Laurentides +
## RES_NM_REG_Montérégie + RES_NM_REG_Montréal, data = maison_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1948132 -98637 -8289 77514 4269897
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.343e+04 2.331e+04 -1.434 0.151803
## nb_etages 4.311e+04 1.254e+04 3.437 0.000605 ***
## taille_terrain 7.054e-02 7.630e-03 9.245 < 2e-16 ***
## taxes_scolaires 9.377e+02 3.749e+01 25.010 < 2e-16 ***
## assurances 1.032e+02 8.654e+00 11.924 < 2e-16 ***
## electricite 1.351e+01 7.159e+00 1.887 0.059388 .
## RES_NM_REG_Estrie 1.237e+05 2.688e+04 4.601 4.58e-06 ***
## RES_NM_REG_Laurentides 1.990e+05 2.486e+04 8.007 2.47e-15 ***
## RES_NM_REG_Montérégie 1.362e+05 2.130e+04 6.392 2.23e-10 ***
## RES_NM_REG_Montréal 1.333e+05 2.894e+04 4.608 4.44e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 264000 on 1390 degrees of freedom
## Multiple R-squared: 0.5446, Adjusted R-squared: 0.5417
## F-statistic: 184.7 on 9 and 1390 DF, p-value: < 2.2e-16# Ajout des previsions
maison_mod<- ajouter_previsions(maison_mod, modele3,
intervalles=0.95,residu=TRUE,
noms_personnalises="3")
#graphe sequentiel des residus standarises
ggplot(data=maison_mod, aes(x=PREV_3, y=ZRES_3)) +
geom_point() +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
geom_hline(yintercept = 3, linetype = "dotted", color = "darkblue") +
geom_hline(yintercept = -3, linetype = "dotted", color = "darkblue") +
theme_minimal()
#indices de performance
indices_performance("prix","PREV_3",data=maison_mod)## N MAD MAPE
## Valeur de l'indice 1400 139662.2 0.266253MODELE 4
source("MQG813_librairie_temporel.R")
modele4 <- lm(prix ~ nb_etages * electricite +
taille_terrain + taxes_scolaires + assurances +
RES_NM_REG_Estrie + RES_NM_REG_Laurentides +
RES_NM_REG_Montérégie + RES_NM_REG_Montréal,
data = maison_mod)
summary(modele4)##R2 AJUSTE = 0.5424 > 0.5417 DU MODELE PRECEDANT##
## Call:
## lm(formula = prix ~ nb_etages * electricite + taille_terrain +
## taxes_scolaires + assurances + RES_NM_REG_Estrie + RES_NM_REG_Laurentides +
## RES_NM_REG_Montérégie + RES_NM_REG_Montréal, data = maison_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1939212 -100959 -7422 78417 4257055
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.461e+04 4.179e+04 -2.264 0.0237 *
## nb_etages 7.931e+04 2.405e+04 3.298 0.0010 ***
## electricite 4.337e+01 1.838e+01 2.359 0.0184 *
## taille_terrain 7.022e-02 7.626e-03 9.208 < 2e-16 ***
## taxes_scolaires 9.421e+02 3.755e+01 25.091 < 2e-16 ***
## assurances 1.058e+02 8.772e+00 12.059 < 2e-16 ***
## RES_NM_REG_Estrie 1.265e+05 2.691e+04 4.700 2.85e-06 ***
## RES_NM_REG_Laurentides 1.993e+05 2.484e+04 8.023 2.17e-15 ***
## RES_NM_REG_Montérégie 1.357e+05 2.129e+04 6.377 2.46e-10 ***
## RES_NM_REG_Montréal 1.345e+05 2.892e+04 4.650 3.63e-06 ***
## nb_etages:electricite -1.851e+01 1.050e+01 -1.763 0.0780 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 263800 on 1389 degrees of freedom
## Multiple R-squared: 0.5456, Adjusted R-squared: 0.5424
## F-statistic: 166.8 on 10 and 1389 DF, p-value: < 2.2e-16# Ajout des previsions
maison_mod<- ajouter_previsions(maison_mod, modele4,
intervalles=0.95,residu=TRUE,
noms_personnalises="4")
#graphe sequentiel des residus standarises
ggplot(data=maison_mod, aes(x=PREV_4, y=ZRES_4)) +
geom_point() +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
geom_hline(yintercept = 3, linetype = "dotted", color = "darkblue") +
geom_hline(yintercept = -3, linetype = "dotted", color = "darkblue") +
theme_minimal()
#indices de performance
indices_performance("prix","PREV_4",data=maison_mod)## N MAD MAPE
## Valeur de l'indice 1400 140863.3 0.269568modele 5
commentaire:
Pour estimer le prix affiché des propriétés, j’ai développé un modèle de régression linéaire multiple à partir des variables explicatives disponibles. J’ai procédé de manière progressive, en m’appuyant à la fois sur des critères statistiques et sur la logique du domaine immobilier.
- Démarche suivie J’ai commencé par un modèle complet incluant toutes les variables disponibles. Après avoir retiré celles qui n’étaient pas statistiquement significatives (p > 0,05), j’ai exploré plusieurs améliorations :
J’ai introduit des variables indicatrices (dummies) pour modéliser les effets fixes des régions (RES_NM_REG). Ces variables permettent de capter les différences de prix moyen entre régions, qui peuvent être influencées par des facteurs non mesurés directement dans le jeu de données, comme l’attractivité du marché local, la proximité des services, ou encore la pression immobilière.
J’ai conservé uniquement les dummies associées aux régions Estrie, Laurentides, Montérégie et Montréal, car ce sont celles dont les coefficients se sont révélés statistiquement significatifs dans le modèle. Cela signifie que, toutes choses égales par ailleurs, ces régions avaient un effet distinct sur le prix affiché. À l’inverse, les autres régions n’apportaient pas d’effet différentiel significatif, et les garder aurait simplement ajouté du bruit au modèle sans améliorer sa précision.
J’ai également inclus une interaction entre nb_etages et electricite, considérant qu’une maison à plusieurs étages peut avoir une consommation électrique très différente selon sa configuration (chauffage, isolation, zonage). Cette interaction est significative (p = 0,030) et reflète une réalité du marché résidentiel.
Enfin, pour corriger une hétéroscédasticité des résidus observée dans les modèles précédents, j’ai appliqué une transformation par racine carrée à la variable dépendante prix. Cette transformation a permis de stabiliser la variance des erreurs et de renforcer la validité du modèle. Toutefois, pour le calcul du MAPE, j’ai utilisé les prévisions remises à l’échelle (PREV_5^2), afin que les erreurs soient comparables aux prix réels (exprimés en dollars) Le modèle que j’ai retenu est : sqrt_prix ~ nb_etages * electricite + taille_terrain + taxes_scolaires + assurances + RES_NM_REG_Estrie + RES_NM_REG_Laurentides + RES_NM_REG_Montérégie + RES_NM_REG_Montréal
Toutes les variables incluses sont statistiquement significatives
Performance du modèle R² ajusté : 0,612 MAPE : 25,7%
Sur le plan interprétatif, cette interaction est pertinente car elle reflète une réalité courante dans l’immobilier :
Les maisons à plusieurs étages sont souvent plus grandes ou énergivores, et leur consommation électrique peut varier fortement en fonction de la configuration (chauffage électrique centralisé, zonage par étage, etc.).
Ainsi, l’effet de la consommation électrique sur le prix n’est pas le même pour une maison de plain-pied que pour une maison à deux ou trois étages.
L’inspection du graphique des résidus standardisés vs prévisions ne révèle pas de tendance problématique majeure, bien que quelques valeurs aberrantes persistent, comme souvent dans les données immobilières. Toutefois, la grande majorité des observations se situent à l’intérieur des bornes ±3, ce qui confirme que le modèle respecte globalement les hypothèses de normalité et d’homoscédasticité des résidus.
Pour améliorer encore le modèle, je pourrais :
Ajouter d’autres interactions pertinentes, comme :
taille_terrain * région : car un grand terrain n’a pas la même valeur selon qu’il se trouve en région éloignée ou en zone urbaine dense.
taxes_scolaires * nb_chambres : les propriétés familiales (plus de chambres) pourraient être localisées dans des zones avec de meilleures écoles, ce qui justifierait des taxes plus élevées et un prix plus élevé.
par rapport a la vadilite des residus:
➟ LHomoscedasticite: Pasrespecté.. on voit heteroscedasticité La relation à modéliser n’est pas linéaire :On peut observer les donnes sont pas autour de 0 (ily a unetype de “cone”) on peut visualiser un cone , qui montre des variation sur la variance ➟Valeur aberrantes: observe beacoup des valeurs aberrantes
➟ Normalite : Les résidus sont distribués normalement :L’ histograme des residues montre une distribution symetrique et centree, le test de Shapiro-Wilk confirme la normalité : avec une p-valeur non significative (p <0.05), on rejette l’hypothèse de normalité. ➟ LIndependance de residues (= aucun autocorrelation significatif), est rejetée
# 1. Créer la variable transformée
maison_mod <- maison_mod %>%
mutate(sqrt_prix = sqrt(prix))
# 2. Créer le modèle linéaire avec la transformation
modele5 <- lm(sqrt_prix ~ nb_etages * electricite +
taille_terrain + taxes_scolaires + assurances +
RES_NM_REG_Estrie + RES_NM_REG_Laurentides +
RES_NM_REG_Montérégie + RES_NM_REG_Montréal,
data = maison_mod)
# 3. Résumé du modèle
summary(modele5)##
## Call:
## lm(formula = sqrt_prix ~ nb_etages * electricite + taille_terrain +
## taxes_scolaires + assurances + RES_NM_REG_Estrie + RES_NM_REG_Laurentides +
## RES_NM_REG_Montérégie + RES_NM_REG_Montréal, data = maison_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -636.94 -64.92 -3.22 63.22 1060.42
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.379e+02 2.006e+01 16.847 < 2e-16 ***
## nb_etages 5.232e+01 1.154e+01 4.533 6.33e-06 ***
## electricite 3.411e-02 8.821e-03 3.867 0.000115 ***
## taille_terrain 2.457e-05 3.660e-06 6.714 2.76e-11 ***
## taxes_scolaires 5.238e-01 1.802e-02 29.070 < 2e-16 ***
## assurances 4.334e-02 4.210e-03 10.296 < 2e-16 ***
## RES_NM_REG_Estrie 7.625e+01 1.291e+01 5.905 4.43e-09 ***
## RES_NM_REG_Laurentides 1.266e+02 1.192e+01 10.616 < 2e-16 ***
## RES_NM_REG_Montérégie 1.012e+02 1.022e+01 9.907 < 2e-16 ***
## RES_NM_REG_Montréal 1.071e+02 1.388e+01 7.719 2.23e-14 ***
## nb_etages:electricite -1.093e-02 5.037e-03 -2.169 0.030233 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 126.6 on 1389 degrees of freedom
## Multiple R-squared: 0.6148, Adjusted R-squared: 0.612
## F-statistic: 221.7 on 10 and 1389 DF, p-value: < 2.2e-16# 4. Ajouter les prévisions
maison_mod <- ajouter_previsions(maison_mod, modele5,
intervalles=0.95, residu=TRUE,
noms_personnalises="5")
# 5. Graphe des résidus standardisés
ggplot(data=maison_mod, aes(x=PREV_5, y=ZRES_5)) +
geom_point() +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
geom_hline(yintercept = 3, linetype = "dotted", color = "darkblue") +
geom_hline(yintercept = -3, linetype = "dotted", color = "darkblue") +
labs(title = "Résidus standardisés vs prévisions (√prix)",
x = "Prévision (√prix)", y = "Résidus standardisés") +
theme_minimal()
# Ajouter une colonne avec la prédiction remise à l’échelle
maison_mod <- maison_mod %>%
mutate(PREV_5_carre = PREV_5^2)
# 6. Évaluer la performance (erreur quadratique, biais, etc.)
indices_performance("prix", "PREV_5_carre", data = maison_mod)## N MAD MAPE
## Valeur de l'indice 1400 136578.9 0.257324indices_performance## function (y, prev, data = NULL, app = c())
## {
## if (!(is.null(data))) {
## y <- data[[y]]
## prev <- data[[prev]]
## }
## if (length(app) == 0) {
## table_performance <- as.data.frame(t(c(sum(!(is.na(y)) &
## !(is.na(prev))), round(MAE(prev, y, na.rm = TRUE),
## digits = 6), round(MAPE(prev, y, na.rm = TRUE), digits = 6))))
## colnames(table_performance) <- c("N", "MAD", "MAPE")
## row.names(table_performance) <- c("Valeur de l'indice")
## }
## else {
## essai <- which(!(c(1:length(y)) %in% app))
## indices_performance_app <- c(sum(!(is.na(y[app])) & !(is.na(prev[app]))),
## round(MAE(prev[app], y[app], na.rm = TRUE), digits = 6),
## round(MAPE(prev[app], y[app], na.rm = TRUE), digits = 6))
## indices_performance_essai <- c(sum(!(is.na(y[essai])) &
## !(is.na(prev[essai]))), round(MAE(prev[essai], y[essai],
## na.rm = TRUE), digits = 6), round(MAPE(prev[essai],
## y[essai], na.rm = TRUE), digits = 6))
## table_performance <- as.data.frame(rbind(indices_performance_app,
## indices_performance_essai))
## colnames(table_performance) <- c("N", "MAD", "MAPE")
## row.names(table_performance) <- c("Apprentissage", "Essai")
## }
## return(table_performance)
## }
## <bytecode: 0x00000203eb18f460>#validite residues
##HISTOGRAME des residus
ggplot(maison_mod, aes(x=RES_5)) + geom_histogram(bins=10)
#Test de normalite des residus (Shapiro-Wilk)
pander(shapiro.test(maison_mod[["RES_5"]]))| Test statistic | P value |
|---|---|
| 0.9031 | 6.918e-29 * * * |
##Correlogramme des residus
correlogramme(maison_mod[,"RES_5"], lag.max = 25)
## lag ac pac
## 1 1 0.0575371702 0.057537170
## 2 2 0.0374151530 0.034217906
## 3 3 0.0161047966 0.012111124
## 4 4 0.0281890644 0.025466639
## 5 5 0.0757927368 0.072234964
## 6 6 0.0476958666 0.038081800
## 7 7 -0.0006683551 -0.010923589
## 8 8 0.0795667092 0.075838964
## 9 9 0.0262918383 0.014539707
## 10 10 0.0470540741 0.033459934
## 11 11 0.0681569404 0.056894253
## 12 12 0.0666850692 0.055133475
## 13 13 0.0288426747 0.008321638
## 14 14 0.0283451517 0.012652400
## 15 15 0.0335532821 0.023187267
## 16 16 0.0319883677 0.009665361
## 17 17 0.0745625466 0.057336661
## 18 18 0.0563785642 0.038655583
## 19 19 0.0625701865 0.043170843
## 20 20 0.0351118005 0.011892826
## 21 21 0.0254354122 0.007185823
## 22 22 0.0184217923 -0.004849603
## 23 23 0.0348671376 0.010880346
## 24 24 -0.0112292786 -0.032187881
## 25 25 0.0529389468 0.034641426##R² ajusté = 0.612///MAPE = 25.7%/// Toutes les variables sont significatives QUESTION 3 (9 points)
Pour tenir compte de l’aspect spatial des données, on souhaite utiliser une variable spatialement déphasée au modèle de la question 2.
On souhaitera d’abord retirer la (ou les) variable(s) définissant l’emplacement géographique du modèle final de la question 2 (s’il y a lieu). .. donc les regions Dans cette question, ce nouveau modèle sera appelé le modèle de base.
- Présentez un tableau des indices de Moran des résidus du modèle de base (avec les valeurs-p associées), en testant des rayons de 50 kilomètres à 400 kilomètres (par bond de 50 kilomètres). Quel rayon semble présenter le I de Moran le plus statistiquement significatif ? le rayon de 350 km avec un I DE Moran de 0.159 , etant donne que toutes sont significatif avec un pvalue 0.. on regarde le plus grand zstat
source("MQG813_librairie_temporel.R")
modele_de_base <- lm(sqrt_prix ~ nb_etages * electricite +
taille_terrain + taxes_scolaires + assurances,
data = maison_mod)
summary(modele_de_base)##R2 AJUSTE = 0.5424 > 0.5417 DU MODELE PRECEDANT##
## Call:
## lm(formula = sqrt_prix ~ nb_etages * electricite + taille_terrain +
## taxes_scolaires + assurances, data = maison_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -596.90 -75.17 -1.45 72.62 1124.70
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.713e+02 2.139e+01 17.361 < 2e-16 ***
## nb_etages 5.455e+01 1.240e+01 4.398 1.18e-05 ***
## electricite 2.856e-02 9.445e-03 3.024 0.00254 **
## taille_terrain 2.513e-05 3.928e-06 6.398 2.15e-10 ***
## taxes_scolaires 5.608e-01 1.871e-02 29.973 < 2e-16 ***
## assurances 4.085e-02 4.510e-03 9.056 < 2e-16 ***
## nb_etages:electricite -9.505e-03 5.408e-03 -1.758 0.07903 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 136.2 on 1393 degrees of freedom
## Multiple R-squared: 0.5528, Adjusted R-squared: 0.5509
## F-statistic: 287 on 6 and 1393 DF, p-value: < 2.2e-16 # Ajout des previsions
pander(summary(modele_de_base))| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 371.3 | 21.39 | 17.36 | 2.847e-61 |
| nb_etages | 54.55 | 12.4 | 4.398 | 1.178e-05 |
| electricite | 0.02856 | 0.009445 | 3.024 | 0.002542 |
| taille_terrain | 2.513e-05 | 3.928e-06 | 6.398 | 2.15e-10 |
| taxes_scolaires | 0.5608 | 0.01871 | 29.97 | 9.671e-153 |
| assurances | 0.04085 | 0.00451 | 9.056 | 4.43e-19 |
| nb_etages:electricite | -0.009505 | 0.005408 | -1.758 | 0.07903 |
| Observations | Residual Std. Error | \(R^2\) | Adjusted \(R^2\) |
|---|---|---|---|
| 1400 | 136.2 | 0.5528 | 0.5509 |
maison_mod<- ajouter_previsions(maison_mod, modele_de_base,
intervalles=0.95,residu=TRUE,
noms_personnalises="base")
add_predictions(maison_mod, modele_de_base, var = "PREV_base")## # A tibble: 1,400 × 53
## prix nb_etages nb_chambres nb_salles_de_bain aire_habitable taille_terrain
## <dbl> <int> <int> <int> <dbl> <dbl>
## 1 185000 1 2 1 864 18503.
## 2 150000 2 3 2 1486. 39278.
## 3 310000 2 5 2 896 8160
## 4 259500 1 3 2 1200 530000
## 5 447000 2 4 2 2400 53820.
## 6 975000 2 3 2 1680 138111
## 7 245000 1 3 1 1168 7000
## 8 225000 2 3 1 936 3711.
## 9 300000 1 7 2 1087. 7511.
## 10 275000 1 3 1 1225. 7535.
## # ℹ 1,390 more rows
## # ℹ 47 more variables: taxes_municipales <dbl>, taxes_scolaires <dbl>,
## # assurances <dbl>, electricite <dbl>, PREV_2 <dbl>, IP_95_INF_2 <dbl>,
## # IP_95_SUP_2 <dbl>, RES_2 <dbl>, ZRES_2 <dbl>,
## # `RES_NM_REG_Bas-Saint-Laurent` <int>,
## # `RES_NM_REG_Capitale-Nationale` <int>, `RES_NM_REG_Centre-du-Québec` <int>,
## # `RES_NM_REG_Chaudière-Appalaches` <int>, `RES_NM_REG_Côte-Nord` <int>, …maison_mod <- maison_mod %>%
mutate(PREV_base_carre = PREV_base^2)
# 1. Résidus bruts du modèle de base
maison_mod <- add_residuals(maison_mod, modele_de_base, var = "RES_base")
#INDICE DE MORAN
matrice_distances <- distm(
cbind(maison_region$x, maison_region$y)
)
#Definir les differents lag a tester//// rayons de 50 kilomètres à 400 kilomètres (par bond de 50 kilomètres
lag_proposition <- seq(50000, 400000, by=50000)
#Calculs des I de Moran
moran_I <- data.frame(rayon_km=numeric(), n=numeric(), I=numeric(), z_stat=numeric(), p_value=numeric())
###
# 5. Boucle pour calculer les indices de Moran
for (k in lag_proposition) {
# Appel correct de IMoran : variable, matrice, rayon
test <- IMoran(
maison_mod$ZRES_base,
matrice_distances,
k
)
# Stocker la ligne
moran_I <- rbind(
moran_I,
data.frame(
Rayon_km = k / 1000,
n = test$n,
I = test$observed,
z_stat = (test$observed - test$expected) / test$sd,
p_value = test$p.value
)
)
}
moran_I## Rayon_km n I z_stat p_value
## 1 50 1396 0.2151574 23.07672 0
## 2 100 1398 0.2021055 27.86236 0
## 3 150 1399 0.1919297 29.66654 0
## 4 200 1400 0.1833786 31.06490 0
## 5 250 1400 0.1702947 30.74239 0
## 6 300 1400 0.1647337 30.93817 0
## 7 350 1400 0.1590089 31.15660 0
## 8 400 1400 0.1480865 30.31919 0- À partir de la variable dépendante, créez une variable spatialement déphasée dont le rayon est celui repéré en (a) et ajoutez-la au modèle de base. commentaire:cest le rayon 350km qui a le meilleure I de Moran,donc on utilise cet rayon pour calculer la variable spatialement déphasée prix_lagkrig
Présentez un résumé de ce nouveau modèle.
Semble-t-on avoir amélioré le R² ajusté par rapport au modèle final de la question 2 ?
Oui, l’ajout de la variable spatialement déphasée prix_lagkrig (obtenue par krigeage avec un rayon de 350 km) a permis d’améliorer significativement le R² ajusté du modèle. Celui-ci passe de 0,5509 dans le modèle final de la question 2 à 0,613 avec le modèle enrichi, soit une amélioration notable de la capacité explicative. Cette amélioration s’explique par le fait que le prix d’une propriété est fortement corrélé avec celui des propriétés voisines.
source("MQG813_librairie_spatial.R")
k1 <- 350000 ##350 km
#Definir la variable spatialement dephasee
#Definir la variable spatialement dephasee avec krgeage
maison_region$prix_lagkrig<- var_spat_dephasee("prix",
"x", "y",
data=maison_region,
type_rayon="fixe", rayon=k1,
interpolation="krigeage")## Warning in fit.variogram(data.vgm, model = vgm("Sph")): singular model in
## variogram fit## [1] "a possible solution MIGHT be to scale semivariances and/or distances"# ajoute de la colonne sqrt prix
maison_region <- maison_region %>%
mutate(sqrt_prix = sqrt(prix))
#Specifier le modele
modele_de_base2 <- lm(sqrt_prix ~ nb_etages * electricite +
taille_terrain + taxes_scolaires + assurances+prix_lagkrig,
data = maison_region)
#Resume du modele
pander(summary(modele_de_base2))| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 183.8 | 23.44 | 7.842 | 8.793e-15 |
| nb_etages | 45.57 | 11.52 | 3.954 | 8.066e-05 |
| electricite | 0.03136 | 0.008765 | 3.577 | 0.0003591 |
| taille_terrain | 2.622e-05 | 3.645e-06 | 7.194 | 1.021e-12 |
| taxes_scolaires | 0.4958 | 0.01789 | 27.72 | 5.022e-135 |
| assurances | 0.04499 | 0.004194 | 10.73 | 7.519e-26 |
| prix_lagkrig | 0.0003728 | 2.479e-05 | 15.04 | 1.72e-47 |
| nb_etages:electricite | -0.009072 | 0.005018 | -1.808 | 0.07081 |
| Observations | Residual Std. Error | \(R^2\) | Adjusted \(R^2\) |
|---|---|---|---|
| 1400 | 126.4 | 0.6153 | 0.6134 |
selon le I de Moran global, les résidus du modèle de base enrichi avec la variable spatialement déphasée prix_lagkrig ne sont pas spatialement indépendants au seuil α = 0,05. En effet, l’indice de Moran est significatif avec un p-value très faible (p < 0,001), indiquant une autocorrélation positive des résidus. Cela signifie que les résidus ont tendance à être similaires entre les propriétés proches géographiquement,aussi visible sur la carte, où les résidus similaires sont regroupés géographiquement. On en conclut donc qu’il existe une structure spatiale dans les erreurs du modèle, qui n’a pas été complètement capturée par les variables explicatives.
# Ajout des previsions
maison_region<- ajouter_previsions(maison_region, modele_de_base2,
intervalles=0.95,residu=TRUE,
noms_personnalises="base2")
#
add_predictions(maison_region, modele_de_base2, var = "PREV_base2")## # A tibble: 1,400 × 34
## nb_etages nb_chambres nb_salles_de_bain aire_habitable taille_terrain
## <int> <int> <int> <dbl> <dbl>
## 1 1 2 1 864 18503.
## 2 2 3 2 1486. 39278.
## 3 2 5 2 896 8160
## 4 1 3 2 1200 530000
## 5 2 4 2 2400 53820.
## 6 2 3 2 1680 138111
## 7 1 3 1 1168 7000
## 8 2 3 1 936 3711.
## 9 1 7 2 1087. 7511.
## 10 1 3 1 1225. 7535.
## # ℹ 1,390 more rows
## # ℹ 29 more variables: taxes_municipales <dbl>, taxes_scolaires <dbl>,
## # electricite <dbl>, assurances <dbl>, prix <dbl>, ID <chr>, x <dbl>,
## # y <dbl>, price_group <fct>, distances_temp <dbl>, prix_lag_adap <dbl>,
## # AREA <dbl>, PERIMETER <dbl>, REGIO_S_ <dbl>, REGIO_S_ID <dbl>,
## # RES_NO_IND <chr>, RES_DE_IND <chr>, RES_CO_REG <chr>, RES_NM_REG <chr>,
## # RES_CO_REF <chr>, RES_CO_VER <chr>, prix_median <dbl>, …# 1. Résidus bruts du modèle de base
maison_region <- add_residuals(maison_region, modele_de_base2, var = "RES_base2")
#Calculs des I de Moran
moran_I <- data.frame(rayon_km=numeric(), n=numeric(), I=numeric(), z_stat=numeric(), p_value=numeric())
###
IMoran_prix_lagkrig<-IMoran(maison_region$prix_lagkrig,matrice_distance, rayon=350000)
IMoran_prix_lagkrig## n observed expected sd p.value
## 1 1400 0.4697383 -0.0007147963 0.005138731 0#Carte des résidus
carte_geo(maison_region, long="x", lat="y",
variable="ZRES_base2",
nb_groupes=5,
intervalles="quantiles",
couleur=c('red', 'blue'),
taille=3,
titre="Répartition locations")- Comparez le MAD et le MAPE des deux modèles (questions 2 et 3) modele base?. Quel modèle semble le plus performant ? Le modèle 5 présente un MAD légèrement plus faible, ce qui signifie qu’en moyenne, ses erreurs absolues sont un peu plus petites. En revanche, son MAPE est légèrement plus élevé, ce qui suggère que ses erreurs en pourcentage sont un peu plus grandes que celles du modèle de base… ici le plus performante est le modele de base de la Q2
# Ajouter une colonne avec la prédiction remise à l’échelle
maison_region <- maison_region %>%
mutate(PREV_base2_carre = PREV_base2^2)
indices_modele5<-indices_performance("prix", "PREV_5_carre", data = maison_mod)
##modele q3 modele base 2 avec varaible dephasee
indices_modelebasefinal<-indices_performance("prix","PREV_base2_carre",data=maison_region)