Stage R&D : Data Science

1 Résumé :

Un bref aperçu du rapport, incluant les objectifs, les principales conclusions et les recommandations. Cela permet au lecteur de comprendre rapidement l’essentiel du rapport sans entrer dans les détails.

2 Introduction

2.1 Contexte :

Dans le cadre de mon stage de Master 1 à chez Linkpact, j’ai été amené à travillez sur deux projets. Ce projet de recherche est un projet de data science kaggle, dont le but est de nous initier à l’analyse et au traitement des bases de données ; Mais surtout pour nous permettre d’avoir une prise en main sur les algorithmes de machines learning couramment utilisés en actuariat.

2.2 Objectifs :

Il est de notre devoir de prédire le prix de vente pour chaque maison, et de développer en parallèle les compétences de tarification non vie.

2.2.1 Sources de données :

Décrire les sources de données utilisées (bases de données, fichiers CSV, APIs, etc.) et la manière dont elles ont été collectées. (see house-prices-advanced-regression-techniques? )

3 Importation et préparation des données :

Expliquer le processus de nettoyage des données, y compris la gestion des valeurs manquantes, le traitement des doublons et toute transformation effectuée sur les données brutes.

Id	MSSubClass	MSZoning	LotFrontage	LotArea	Street	Alley	LotShape	LandContour	Utilities	LotConfig	LandSlope	Neighborhood	Condition1	Condition2	BldgType	HouseStyle	OverallQual	OverallCond	YearBuilt	YearRemodAdd	RoofStyle	RoofMatl	Exterior1st	Exterior2nd	MasVnrType	MasVnrArea	ExterQual	ExterCond	Foundation	BsmtQual	BsmtCond	BsmtExposure	BsmtFinType1	BsmtFinSF1	BsmtFinType2	BsmtFinSF2	BsmtUnfSF	TotalBsmtSF	Heating	HeatingQC	CentralAir	Electrical	X1stFlrSF	X2ndFlrSF	LowQualFinSF	GrLivArea	BsmtFullBath	BsmtHalfBath	FullBath	HalfBath	BedroomAbvGr	KitchenAbvGr	KitchenQual	TotRmsAbvGrd	Functional	Fireplaces	FireplaceQu	GarageType	GarageYrBlt	GarageFinish	GarageCars	GarageArea	GarageQual	GarageCond	PavedDrive	WoodDeckSF	OpenPorchSF	EnclosedPorch	X3SsnPorch	ScreenPorch	PoolArea	PoolQC	Fence	MiscFeature	MiscVal	MoSold	YrSold	SaleType	SaleCondition	type
1	60	RL	65	8450	Pave	NA	Reg	Lvl	AllPub	Inside	Gtl	CollgCr	Norm	Norm	1Fam	2Story	7	5	2003	2003	Gable	CompShg	VinylSd	VinylSd	BrkFace	196	Gd	TA	PConc	Gd	TA	No	GLQ	706	Unf	0	150	856	GasA	Ex	Y	SBrkr	856	854	0	1710	1	0	2	1	3	1	Gd	8	Typ	0	NA	Attchd	2003	RFn	2	548	TA	TA	Y	0	61	0	0	0	0	NA	NA	NA	0	2	2008	WD	Normal	train
2	20	RL	80	9600	Pave	NA	Reg	Lvl	AllPub	FR2	Gtl	Veenker	Feedr	Norm	1Fam	1Story	6	8	1976	1976	Gable	CompShg	MetalSd	MetalSd	None	0	TA	TA	CBlock	Gd	TA	Gd	ALQ	978	Unf	0	284	1262	GasA	Ex	Y	SBrkr	1262	0	0	1262	0	1	2	0	3	1	TA	6	Typ	1	TA	Attchd	1976	RFn	2	460	TA	TA	Y	298	0	0	0	0	0	NA	NA	NA	0	5	2007	WD	Normal	train
3	60	RL	68	11250	Pave	NA	IR1	Lvl	AllPub	Inside	Gtl	CollgCr	Norm	Norm	1Fam	2Story	7	5	2001	2002	Gable	CompShg	VinylSd	VinylSd	BrkFace	162	Gd	TA	PConc	Gd	TA	Mn	GLQ	486	Unf	0	434	920	GasA	Ex	Y	SBrkr	920	866	0	1786	1	0	2	1	3	1	Gd	6	Typ	1	TA	Attchd	2001	RFn	2	608	TA	TA	Y	0	42	0	0	0	0	NA	NA	NA	0	9	2008	WD	Normal	train
4	70	RL	60	9550	Pave	NA	IR1	Lvl	AllPub	Corner	Gtl	Crawfor	Norm	Norm	1Fam	2Story	7	5	1915	1970	Gable	CompShg	Wd Sdng	Wd Shng	None	0	TA	TA	BrkTil	TA	Gd	No	ALQ	216	Unf	0	540	756	GasA	Gd	Y	SBrkr	961	756	0	1717	1	0	1	0	3	1	Gd	7	Typ	1	Gd	Detchd	1998	Unf	3	642	TA	TA	Y	0	35	272	0	0	0	NA	NA	NA	0	2	2006	WD	Abnorml	train
5	60	RL	84	14260	Pave	NA	IR1	Lvl	AllPub	FR2	Gtl	NoRidge	Norm	Norm	1Fam	2Story	8	5	2000	2000	Gable	CompShg	VinylSd	VinylSd	BrkFace	350	Gd	TA	PConc	Gd	TA	Av	GLQ	655	Unf	0	490	1145	GasA	Ex	Y	SBrkr	1145	1053	0	2198	1	0	2	1	4	1	Gd	9	Typ	1	TA	Attchd	2000	RFn	3	836	TA	TA	Y	192	84	0	0	0	0	NA	NA	NA	0	12	2008	WD	Normal	train
6	50	RL	85	14115	Pave	NA	IR1	Lvl	AllPub	Inside	Gtl	Mitchel	Norm	Norm	1Fam	1.5Fin	5	5	1993	1995	Gable	CompShg	VinylSd	VinylSd	None	0	TA	TA	Wood	Gd	TA	No	GLQ	732	Unf	0	64	796	GasA	Ex	Y	SBrkr	796	566	0	1362	1	0	1	1	1	1	TA	5	Typ	0	NA	Attchd	1993	Unf	2	480	TA	TA	Y	40	30	0	320	0	0	NA	MnPrv	Shed	700	10	2009	WD	Normal	train
7	20	RL	75	10084	Pave	NA	Reg	Lvl	AllPub	Inside	Gtl	Somerst	Norm	Norm	1Fam	1Story	8	5	2004	2005	Gable	CompShg	VinylSd	VinylSd	Stone	186	Gd	TA	PConc	Ex	TA	Av	GLQ	1369	Unf	0	317	1686	GasA	Ex	Y	SBrkr	1694	0	0	1694	1	0	2	0	3	1	Gd	7	Typ	1	Gd	Attchd	2004	RFn	2	636	TA	TA	Y	255	57	0	0	0	0	NA	NA	NA	0	8	2007	WD	Normal	train
8	60	RL	NA	10382	Pave	NA	IR1	Lvl	AllPub	Corner	Gtl	NWAmes	PosN	Norm	1Fam	2Story	7	6	1973	1973	Gable	CompShg	HdBoard	HdBoard	Stone	240	TA	TA	CBlock	Gd	TA	Mn	ALQ	859	BLQ	32	216	1107	GasA	Ex	Y	SBrkr	1107	983	0	2090	1	0	2	1	3	1	TA	7	Typ	2	TA	Attchd	1973	RFn	2	484	TA	TA	Y	235	204	228	0	0	0	NA	NA	Shed	350	11	2009	WD	Normal	train
9	50	RM	51	6120	Pave	NA	Reg	Lvl	AllPub	Inside	Gtl	OldTown	Artery	Norm	1Fam	1.5Fin	7	5	1931	1950	Gable	CompShg	BrkFace	Wd Shng	None	0	TA	TA	BrkTil	TA	TA	No	Unf	0	Unf	0	952	952	GasA	Gd	Y	FuseF	1022	752	0	1774	0	0	2	0	2	2	TA	8	Min1	2	TA	Detchd	1931	Unf	2	468	Fa	TA	Y	90	0	205	0	0	0	NA	NA	NA	0	4	2008	WD	Abnorml	train
10	190	RL	50	7420	Pave	NA	Reg	Lvl	AllPub	Corner	Gtl	BrkSide	Artery	Artery	2fmCon	1.5Unf	5	6	1939	1950	Gable	CompShg	MetalSd	MetalSd	None	0	TA	TA	BrkTil	TA	TA	No	GLQ	851	Unf	0	140	991	GasA	Ex	Y	SBrkr	1077	0	0	1077	1	0	1	0	2	2	TA	5	Typ	2	TA	Attchd	1939	RFn	1	205	Gd	TA	Y	0	4	0	0	0	0	NA	NA	NA	0	1	2008	WD	Normal	train
11	20	RL	70	11200	Pave	NA	Reg	Lvl	AllPub	Inside	Gtl	Sawyer	Norm	Norm	1Fam	1Story	5	5	1965	1965	Hip	CompShg	HdBoard	HdBoard	None	0	TA	TA	CBlock	TA	TA	No	Rec	906	Unf	0	134	1040	GasA	Ex	Y	SBrkr	1040	0	0	1040	1	0	1	0	3	1	TA	5	Typ	0	NA	Detchd	1965	Unf	1	384	TA	TA	Y	0	0	0	0	0	0	NA	NA	NA	0	2	2008	WD	Normal	train
12	60	RL	85	11924	Pave	NA	IR1	Lvl	AllPub	Inside	Gtl	NridgHt	Norm	Norm	1Fam	2Story	9	5	2005	2006	Hip	CompShg	WdShing	Wd Shng	Stone	286	Ex	TA	PConc	Ex	TA	No	GLQ	998	Unf	0	177	1175	GasA	Ex	Y	SBrkr	1182	1142	0	2324	1	0	3	0	4	1	Ex	11	Typ	2	Gd	BuiltIn	2005	Fin	3	736	TA	TA	Y	147	21	0	0	0	0	NA	NA	NA	0	7	2006	New	Partial	train
@bineneothniel.tra

nombre de lignes

2919

Il s'agit du nombre de ligne observé sur l'ensemble des donnée train test

Nombre de colonnes

81

Nous avons affaire à une base de donnée importantes

3rd value

789

The 4th detail

The 5th detail

The 6th detail

pour des questions pratiques, nous allons faire un nuage de graphe (bien que peu lisible) auquel nous allons nous référer quand nous aurons besoin de nous faire une rapide idée d’une varible lors du traitement de données

cat_var <- data %>% select(where(~ is.character(.) || is.factor(.))) %>% colnames()

for (column in cat_var) {
  df <- count(data, !!sym(column))
  hc <- df %>% hchart('column', hcaes(x = !!sym(column), y = "n"))
  print(hc)
}

num_var <- data %>% select(where(~ is.numeric(.) || is.integer(.))) %>% colnames()

charts_list <- list()

# Loop through the numeric columns, create highcharts, and store them in the list
for (column in num_var) {
  hc2 <- hchart(
    data[[column]], 
    color = lkp_magenta, 
    name = paste(column)
  )
  charts_list[[column]] <- hc2
}

# Display all charts
for (i in 1:length(charts_list) ) {
  charts_list[i]
}

3.1 Nuage d’histogramme

Vizualisation des valeurs manquantes dans ma base de donnée

variables	missing	%
PoolQC	1453	100
MiscFeature	1406	96
Alley	1369	94
Fence	1179	81
FireplaceQu	690	47
LotFrontage	259	18
GarageType	81	6
GarageYrBlt	81	6
GarageFinish	81	6
GarageQual	81	6
GarageCond	81	6
BsmtExposure	38	3
BsmtFinType2	38	3
BsmtQual	37	3
BsmtCond	37	3
BsmtFinType1	37	3
MasVnrType	8	1
MasVnrArea	8	1
Electrical	1	0
@bineneothniel.tra

on observe:

• une grade inégalité de la repartition des valeurs manquantes entre les variables

• qu’il existe des valeurs manquantes qui sont corélée par groupe,

nous en tiendrons compte dans notre analyse lors de la transformation des donnée. voir Section 8 .

3.2 Nuage de proportion des valeurs manquantes par variable

3.3 exploration de la base de donnée

Variables categoriels

44

trop, nombreux pour une base de donnée avec si peu de ligne car la dummifiction de notre base de donnée, va exploser le nombre de variable

Variables numériques

37

certaines variables pourraient s'agir de variables qualitatives dont les modalités ont été encodées par des étiquettes

4 analyse de la variable cibles

• Options variables

  • vlabels: étiquettes des variables

  • vlcex: contrôle la taille de la police des étiquettes variables

• Options de polygone:

  • pcol: couleur de la ligne

  • pfcol: couleur de remplissage

  • plwd: largeur de ligne

  • plty: types de lignes. Peut être un tableau numérique 1:6 ou un tableau de caractères c (“solid”, “dashed”, “dotdash”, “dotdash”, “longdash”, “twodash”). Pour supprimer la ligne, utilisez plty = 0 ou plty = “blank”.

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  34900  129975  163000  180921  214000  755000 

4.1 exemple de Variables qualitatives

4.1.1 MSZoning

[1] "il y a 15 modalités"

distribution

lien avec la variable cible

5 Valeurs manquantes

Avant de procéder à la transformation des données, nous alons analyser les valeurs manquantes présentes dans la base de données.

5.1 les premiers traitements

Nous commençons par éliminer les variables qui présentent un trop grand nombre de valeurs manquantes. Pour les valeurs manquantes restantes, si elles sont justifiées, nous les remplaçons par leur signification spécifique.

data <- data %>% 
  dplyr::select( -c(MiscFeature, PoolQC, Id, MoSold))
data <- data %>%
  mutate(
    Alley = ifelse(is.na(Alley), "No.alley.access", Alley),
    BsmtQual = ifelse(is.na(BsmtQual), "No.Basement", BsmtQual),
    BsmtCond = ifelse(is.na(BsmtCond), "Autre", BsmtCond),
    BsmtExposure = ifelse(is.na(BsmtExposure), "Autre", BsmtExposure),
    BsmtFinType1 = ifelse(is.na(BsmtFinType1), "Autre", BsmtFinType1),
    BsmtFinType2 = ifelse(is.na(BsmtFinType2), "Autre", BsmtFinType2),
    
    Fence = ifelse(is.na(Fence), "None", Fence),
    FireplaceQu = ifelse(is.na(FireplaceQu), "No.Fireplace", FireplaceQu),
    
    GarageType = ifelse(is.na(GarageType), "No.Garage", GarageType),
    GarageFinish = ifelse(is.na(GarageFinish), "Autre", GarageFinish),
    GarageQual = ifelse(is.na(GarageQual), "Autre", GarageQual),
    GarageCond = ifelse(is.na(GarageCond), "Autre", GarageCond),
  )

1

je remplace par Autre, afin de pouvoir les retirer en les recupérant avec end_with() et éviter la corélation

5.2 Aperçu des valeurs manquantes dans la base de données

variables	missing	%
LotFrontage	259	18
GarageYrBlt	81	6
MasVnrType	8	1
MasVnrArea	8	1
Electrical	1	0
@bineneothniel.tra

Il existe des variables catégorielles dans la base de donnée avec des modalités qui ne sont pas présentes dans les deux bases de données train et test. Nous devons nous assurer que les modalités de nos variables catégorielle sont existe dans les deux bases de données.

Notre méthode consiste à les remplacer par des valeurs manquantes et à les imputer plustard plustard

sum(is.na(data))

[1] 357

sum(is.na(data))

[1] 357

6 inputation des valeurs manquantes (Miss Forest)

Missforest permet d’imputer les valeurs manquantes dans les jeux de données de type mixte en utilisant les forêts aléatoires pour prédire les valeurs manquantes de manière itérative et non paramétrique, en tirant parti des relations entre les variables.

missForest surpasse les autres méthodes d’imputation, en particulier dans les contextes de données où des interactions complexes et des relations non linéaires sont suspectées.

Pour une meilleure compréhension des détails de l’algorithme MissForest, je vous recommande de consulter ce lien

Pour ceux qui doutent de l’efficacité de MissForest, nous avons effectué une comparaison entre MissForest et les méthodes d’imputation par le mode ou la moyenne.

table de contingeance
cat 1	cat 2
	X	Y	Z
A	0.5	0.5	0.5
B	0.3	0.3	0.4
C	0.2	0.3	0.1
D	0.2	0.2	0.5

Nous souhaitons tester l’algorithme MissForest sur une base de données corrélée.

Pour ce faire, nous allons créer une base de données contenant deux variables qualitatives et deux variables quantitatives. Les variables qualitatives seront corrélées entre elles ainsi qu’avec les variables quantitatives, conformément au tableau de contingence suivant :

library(tidyverse)
library(missForest)
set.seed(999)
n_samples <- 10^5

num_var1 <- rnorm(n_samples, mean = 50, sd = 10)
num_var2 <- num_var1 + rgamma(n_samples, shape = 2, scale = 5)


probs <- c(0.3, 0.2, 0.4, 0.1)  # Probabilités pour A, B, C, D respectivement 
cont <- list(
  c(0.5, 0.3, 0.2),   # Distribution de X, Y, Z respectivement pour A
  c(0.2, 0.5, 0.3),   # Distribution de X, Y, Z respectivement pour B
  c(0.3, 0.2, 0.5),   # Distribution de X, Y, Z respectivement pour C
  c(0.4, 0.1, 0.5)    # Distribution de X, Y, Z respectivement pour D
)

cat_var1 <- sample(c('A', 'B', 'C', 'D'), n_samples, replace = TRUE, prob = probs)


cat_var2 <- sapply(cat_var1, function(x) {
  sample(c('X', 'Y', 'Z'), 1, prob = cont[[match(x, c('A', 'B', 'C', 'D'))]])
})

df <- data.frame(
  num_var1 = num_var1,
  num_var2 = num_var2,
  cat_var1 = cat_var1,
  cat_var2 = cat_var2
)
base_data <- df


missing_fraction <- 0.1  
num_missing <- round(n_samples * missing_fraction)
num_var1_missing_indices <- sample(n_samples, num_missing, replace = FALSE)             
df$num_var1[num_var1_missing_indices] <- NA

cat_var2_missing_indices <- sample(n_samples, num_missing, replace = FALSE)
df$cat_var2[cat_var2_missing_indices] <- NA

1

taille de la base de données

2

distributions conditionnelles

3

Générer cat_var2 en fonction de cat_var1

4

Création de la base de données

5

Introduire des valeurs manquantes de manière aléatoire dans les variables numériques

base de donnée comportant des NA
num_var1	num_var2	cat_var1	cat_var2
47.18260	53.89243	B	Y
36.87440	44.54535	B	Y
57.95184	66.89920	C	X
52.70070	69.97779	A	Z
NA	57.92752	B	Y
44.33976	51.92473	C	Y
31.21342	42.49518	B	Y
37.33209	46.01625	A	NA
NA	47.10857	C	NA
NA	59.91066	D	Z
@bineneothniel.tra

Nous observons les valeurs manquantes dans notre petite base de données après l’imputation des NA.

inputation variable numérique

data_mode <- df
data_mean <- df
data_miss <- df


data_mean$num_var1 <- ifelse(is.na(data_mean$num_var1), mean(data_mean$num_var1, na.rm = TRUE), data_mean$num_var1)

error_mean_num_var1 <- sqrt(sum((base_data$num_var1[num_var1_missing_indices] - data_mean$num_var1[num_var1_missing_indices])^2))
r_squared_mean_num_var1 <- 1 - (sum((base_data$num_var1[num_var1_missing_indices] - data_mean$num_var1[num_var1_missing_indices])^2) / sum((base_data$num_var1[num_var1_missing_indices] - mean(base_data$num_var1[num_var1_missing_indices]))^2))

1

Imputation avec la moyenne pour les variables numériques

2

Calcul du RMSE pour la méthode de la moyenne

3

Calcul du R^2 pour la méthode de la moyenne

mean input :

-0.00018

R2 pour num_var1

mean input :

1020.965

RMSE pour num_var1

• R2: le coefficient de détermination est négatif car la meilleure constante pour predire une variable est sa moyenne, alors qu’on observe une différence entre la moyenner de trains et tests, donc la moyenne des valeurs présente ne permet pas d’avoir une bonne estimation des valeurs manquantes
• RMSE: à comparer avec celui du Miss forest

data_miss <- data_miss %>% 
  mutate(across(where(is.character), as.factor))

imputed_data <- missForest(data_miss, verbose = FALSE, maxiter = 3 , ntree = 6, replace = TRUE)

data_miss$num_var1 <- imputed_data$ximp[, 1]


error_miss_num_var1 <- sqrt(sum((base_data$num_var1[num_var1_missing_indices] - data_miss$num_var1[num_var1_missing_indices])^2))

r_squared_miss_num_var1 <- 1 - (sum((base_data$num_var1[num_var1_missing_indices] - data_miss$num_var1[num_var1_missing_indices])^2) / sum((base_data$num_var1[num_var1_missing_indices] - mean(base_data$num_var1[num_var1_missing_indices]))^2))

7 Calcul du RMSE pour la méthode de missForest

1. Calcul du R^2 pour la méthode de missForest

miss forest input :

0.679

R2 pour num_var1

miss forest input :

578.689

RMSE pour num_var1

inputation variable catégorielle

calc_mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}
data_mode$cat_var2 <- ifelse(is.na(data_mode$cat_var2), calc_mode(data_mode$cat_var2) , data_mode$cat_var2)
accuracy_mode_qual_var1 <- sum(data_mode$cat_var2[cat_var2_missing_indices] == base_data$cat_var2[cat_var2_missing_indices]) / length(cat_var2_missing_indices)
data_miss$cat_var2 <- imputed_data$ximp[, 4]
accuracy_miss_cat_var2 <- sum(data_miss$cat_var2[cat_var2_missing_indices] == base_data$cat_var2[cat_var2_missing_indices]) / length(cat_var2_missing_indices)

mode input :

0.363

Accuracy pour cat_var2

miss forest input :

0.406

Accuracy pour cat_var2

Dans notre projet, vu la forte colinéarité qu’il y a entre les variables, cette méthode d’inputation est donc la plus adaptée pour inputer des valeures qui ne pertubent pas l’information contenu dans notre base de donnée tout en tenant compte des colinéarités entre les variables

7.1 Nous y voilà!

Je pense vous avoir convaincu avec ma petite démonstration 😁

data$GarageCars <- as.factor(data$GarageCars)
data$TotalBath <- as.factor(data$GarageCars)
data$MSSubClass <- as.factor(data$MSSubClass)
data  <- data %>%
  mutate(across(where(is.character), as.factor))


data.imp <- missForest(data, verbose = TRUE, maxiter = 8 , ntree = 50, replace = TRUE)

1

Préparation de la base de données pour l’algorithm de missforest

2

Je crois que c’est évident

8 TRANSFORMATION

8.1 Preparation des données

clean_data <- read.csv("clean_data.csv", na.strings = "NA")

unique(clean_data$Utilities)
clean_data <- clean_data %>% dplyr::select(-Utilities)
clean_data$MSSubClass <- as.factor(clean_data$MSSubClass)

[1] "AllPub"

Maintenant que nous n’avons plus de valeurs manquantes, nous pouvons utiliser des outils de visualisation avancés pour mieux comprendre la structure de nos données.

viz_lm_r2 <- function(data, var, label){
  var_name <- as_label(enquo(var))
  label_name <- as_label(enquo(label))
  
  model <- lm(as.formula(paste(label_name, "~", var_name)), data = data)
  
  predictions <- predict(model, newdata = data, interval = "confidence")
  data <- data %>%
    mutate(pred = predictions[, "fit"],
           lwr = predictions[, "lwr"],
           upr = predictions[, "upr"],
           resid = residuals(model))
  
  r2 <- summary(model)$r.squared
  
  p <- ggplot(data, aes(x = !!enquo(var), y = !!enquo(label))) +
    geom_point() +
    geom_line(aes(y = pred), color = lkp_magenta, linewidth = 0.7) +
    geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.15, fill = "red") +
    theme_bw() +
    labs(title = glue("Linear Model: {label_name} ~ {var_name},  R² = {round(r2, 2)}"),
         x = var_name,
         y = label_name)
  
  print(p)
}

1

Ajuster le modèle de régression linéaire

2

Obtenir les valeurs prédites et les intervalles de confiance

3

Ligne des valeurs prédites

4

Intervalle de confiance

un nuage de graph qui va nous permettre d’apprecier la qualité de l’ajustement

library(rlang)

clean_train <- as_train(clean_data)
num_var <- clean_data %>%
  dplyr::select(where(~ is.numeric(.) || is.integer(.))) %>%
  colnames()
num_var <- num_var[1:3]

for (column in num_var) {
    viz_lm_r2(as_train(clean_data), !!sym(column), SalePrice)
}

Nous effectuons une régression linéaire entre chaque variable numérique et la variable cible. Ensuite, nous visualisons les résultats à l’aide de lolliplots, où la longueur de chaque lollipop représente le coefficient de détermination (R^2) du modèle.

Cette approche nous permet de hiérarchiser les variables en fonction de la force de leur relation avec la variable cible, allant des relations les plus fortes aux plus faibles.

num_feature_importance <- function(data, label){
  label_name <- as_label(enquo(label))
  
  num_data <- data %>%
    mutate(across(where(is.integer), as.numeric)) %>%
    dplyr::select(where(is.numeric))
  
  num_vars <- colnames(num_data)
  num_vars <- num_vars[num_vars != label_name]
  n <- nrow(data)
  
  R2 <- c()
  for (var in num_vars) {
    x <- data[[var]]
    y <- data[[label_name]]
    model <- lm(as.formula(paste(label_name, "~", var)), data = data)
    rsq <- summary(model)$r.squared
    R2 <- c(R2, rsq)
  }
  
  df <- data.frame(variables = num_vars, R2 = R2)
  
  df %>%
    arrange(desc(R2)) %>%
    mutate(variables = factor(variables, levels = rev(variables))) %>%
    ggplot(aes(x = variables, y = R2)) +
    geom_segment(aes(xend = variables, yend = 0), color = "grey") +
    geom_point(size = 2, color = "red") +
    coord_flip() +
    labs(title = "Variables numériques qui expliquent le mieux la variance de SalePrice",
         x = "",
         y = "R²") +
    theme_minimal()
}

1

Exclure la variable cible

9 analyse de corélation

9.1 variables numériques

10 c’est une bonne idée ou pas de discrétiser mes variables ?

10.1 Exemple avec LotArea

les dernières lignes permetent de savoir quelles sont les moyennes des diférents noeud et le mse associé à chaque node si la moyenne du node etait la prediction

is_discretisable <- function(data, var, label) {
  var_name <- as_label(enquo(var))
  label_name <- as_label(enquo(label))
  
  formula_regress <- as.formula(paste(label_name, "~", var_name))
  formula_cart <- formula_regress
  formula_poly <- as.formula(paste(label_name, " ~ poly(", var_name, ", 2, raw = TRUE)"))
  
  model_regress <- lm(formula_regress, data = data)
  model_regress_summary <- summary(model_regress)
  r_regress_squared <- model_regress_summary$r.squared
  
  model_poly <- lm(formula_poly, data = data)
  model_poly_summary <- summary(model_poly)
  r_squared_poly <- model_poly_summary$r.squared
  
  cart_model <- rpart(
    formula_cart,
    data = data,
    method = "anova",
    control = rpart.control(minsplit = 20, minbucket = 15)
  )
  # minsplit: Minimum number of observations that must exist in a node in order for a split to be attempted.
  # minbucket: Minimum number of observations in any terminal (leaf) node. This controls the complexity of the tree.
  
  # Assigner chaque observation à un nœud
  data$node <- cart_model$where
  
  # Calculer la moyenne de chaque nœud
  node_means <- aggregate(as.formula(paste(label_name, "~ node")), data = data, FUN = mean)
  names(node_means)[2] <- "NodeMean"
  
  
  # Fusionner les moyennes des nœuds avec les données d'origine
  data <- merge(data, node_means, by = "node")
  
  # Créer des bar plots pour chaque nœud
  plot1 <- ggplot(data, aes(x = as.factor(node), y = {{label}})) +
    geom_bar(fill = "#219C90",
             stat = "summary",
             fun = "mean") +
    stat_summary(
      fun = "mean",
      geom = "text",
      aes(label = round(..y.., 2)),
      vjust = -0.5,
      color = "black"
    ) +
    labs(title = "",
         x = "Nœud",
         y = paste0("Moyenne de ", label_name)) +
    custom_theme
  
  # Calculer les proportions pour chaque niveau de node
  proportions <- prop.table(table(data$node)) * 100
  
  plot2 <- ggplot(data, aes(x = as.factor(node), y = {{label}})) +
    geom_boxplot(fill = "#219C90") +
    labs(title = "", x = "Nœud", y = label_name) + annotate(
      "text",
      x = as.factor(unique(data$node)),
      y = rep(max(data[[label_name]]) + 1, length(unique(data$node))),
      label = paste0(round(proportions, 1), "%"),
      vjust = -0.5,
      size = 4
    )  + custom_theme
  
  # Afficher le R^2
  sst <- sum((data[[label_name]] - mean(data[[label_name]])) ^ 2)
  sse <- sum((data[[label_name]] - data$NodeMean) ^ 2)
  r_squared <- 1 - (sse / sst)
  
  mat <- matrix(
    c(
      "regress",
      "poly     ",
      "CART  ",
      round(r_regress_squared, 3),
      round(r_squared_poly, 3),
      round(r_squared, 3)
    ),
    nrow = 3,
    byrow = FALSE
  )
  
  # Convertir la matrice en une chaîne de caractères formatée pour afficher dans un sous-titre
  subtitle_text <- paste("- ", apply(mat, 1, paste, collapse = "       "), collapse = "\n")
  
  combined_plot <- plot1 + plot2 +
    plot_layout(ncol = 2) +
    plot_annotation(title = var_name, subtitle = "")
  
  a <- sort(as.data.frame(cart_model$splits)$index)
  return(list(
    cuts = a,
    barplot = plot1,
    boxplot = plot2
  ))
  
}
is_discretisable(train, LotArea, SalePrice)

$cuts
[1]  8637.5 10924.0 13681.0

$barplot

$boxplot

[1]  8637.5 10924.0 13681.0

comparaison de LotArea discrétisé et LotArea continue

11 métrique d’évaluation (modèle le plus simple)

Nous choisissons dans notre étude le modèle intercept comme modèle de référence.

    Id SalePrice
1 1461  180921.2
2 1462  180921.2
3 1463  180921.2
4 1464  180921.2
5 1465  180921.2
6 1466  180921.2

après une submission sur kaggle, on observe que le modèle le plus simple (modèle à 1 paramètre) a comme score 0.42577

mon indicateur de performance s’inspire du R^2 = 1 - \frac{\sum_{i=1}^{n} (y_i - \hat{y}_i)^2}{\sum_{i=1}^{n} (y_i - \bar{y})^2}

nouveau indicateur de performance : Soit y = SalaPrice et z=ln(y)

indiacteur =1 - \frac{RMSE_{model d'etude}}{RMSE_{modelsimple}} = 1 - \frac{\sqrt{\frac{1}{n} \sum_{i=1}^{n} (z_i - \hat{z}_i)^2}}{\sqrt{\frac{1}{n} \sum_{i=1}^{n} (z_i - \bar{z})^2}}

indicateur <- function(a){
if ( a > 0.42577 | a < 0 ){
  print("faut te revoir")
}else{
    result <- (1 - a / 0.42577) * 100
  sprintf("%.1f%%", result)
} }

11.1 meilleur score actuel su kaggle

[1] "65.4%"

   Cat1B    Cat1C    Cat2Y 
1.250000 1.250000 1.071429 

     GVIF Df GVIF^(1/(2*Df))
cat1  1.2  2        1.046635
cat2  1.2  1        1.095445

11.1.1 References