Analyse des Déterminants du Placement
KONAN Kevin, AGOSSOU Christine, GEHIN Nathan
02/12/26
Enfant_placé <- "D:/Documents/Master DS2E/S1/Econometrie appliquée/Projet_Econométrie/Base_de_donnée_Enfant_placé.xlsx"
bdd <- read_excel(Enfant_placé)
head(bdd)str(bdd) ## tibble [100 × 14] (S3: tbl_df/tbl/data.frame)
## $ N° : chr [1:100] "01" "02" "03" "04" ...
## $ Département : chr [1:100] "Ain" "Aisne" "Allier" "Alpes-de-Haute-Provence" ...
## $ 0 à 19 ans : num [1:100] 171336 125708 66246 33920 27874 ...
## $ 20 à 24 ans : num [1:100] 32113 27152 15740 6983 5632 ...
## $ 20-24/5 : num [1:100] 6423 5430 3148 1397 1126 ...
## $ 0 à 20 ans : num [1:100] 177759 131138 69394 35317 29000 ...
## $ Total des enfants acceuilli : num [1:100] 1915 2484 1152 659 277 ...
## $ taux_placement_enfant_(Pour_1000) : num [1:100] 10.77 18.94 16.6 18.66 9.55 ...
## $ taux_chomage : num [1:100] 5.5 10.5 7.7 8.1 6.6 7.1 8 9.7 9.4 9.6 ...
## $ taux_pauvreté : chr [1:100] "10.8" "18.8" "16.2" "17.100000000000001" ...
## $ taux_immigration : num [1:100] 11.98 5.06 5.5 8.44 5.96 ...
## $ taux_logement_sociaux_(pour_10000_hab): chr [1:100] "730" "790" "597" "469" ...
## $ Population_ayant_bac : num [1:100] 50.6 38.3 40.9 49.3 53.1 ...
## $ Capacite_acceuil_(pour_1000) : num [1:100] 2.9 5.1 8.3 9.2 6.3 5.1 5.8 13.8 17.1 9.8 ...bdd <- bdd %>% rename(Tx_placement = "taux_placement_enfant_(Pour_1000)",
Tx_pauvre = "taux_pauvreté",
Tx_logement = "taux_logement_sociaux_(pour_10000_hab)",
Tx_cho = "taux_chomage",
Tx_immi = "taux_immigration",
Tx_bac = "Population_ayant_bac",
Cap_acc = "Capacite_acceuil_(pour_1000)")bdd$Tx_pauvre <- as.numeric(gsub(",", ".", bdd$Tx_pauvre))
bdd$Tx_cho <- as.numeric(gsub(",", ".", bdd$Tx_cho))
bdd$Tx_logement <- as.numeric(gsub(",", ".", bdd$Tx_logement))
colSums(is.na(bdd))## N° Département
## 0 0
## 0 à 19 ans 20 à 24 ans
## 0 0
## 20-24/5 0 à 20 ans
## 0 0
## Total des enfants acceuilli Tx_placement
## 0 0
## Tx_cho Tx_pauvre
## 0 2
## Tx_immi Tx_logement
## 0 4
## Tx_bac Cap_acc
## 0 0bdd <- na.omit(bdd)
str(bdd) ## tibble [96 × 14] (S3: tbl_df/tbl/data.frame)
## $ N° : chr [1:96] "01" "02" "03" "04" ...
## $ Département : chr [1:96] "Ain" "Aisne" "Allier" "Alpes-de-Haute-Provence" ...
## $ 0 à 19 ans : num [1:96] 171336 125708 66246 33920 27874 ...
## $ 20 à 24 ans : num [1:96] 32113 27152 15740 6983 5632 ...
## $ 20-24/5 : num [1:96] 6423 5430 3148 1397 1126 ...
## $ 0 à 20 ans : num [1:96] 177759 131138 69394 35317 29000 ...
## $ Total des enfants acceuilli: num [1:96] 1915 2484 1152 659 277 ...
## $ Tx_placement : num [1:96] 10.77 18.94 16.6 18.66 9.55 ...
## $ Tx_cho : num [1:96] 5.5 10.5 7.7 8.1 6.6 7.1 8 9.7 9.4 9.6 ...
## $ Tx_pauvre : num [1:96] 10.8 18.8 16.2 17.1 14.7 16.4 14.9 19.4 19 16.9 ...
## $ Tx_immi : num [1:96] 11.98 5.06 5.5 8.44 5.96 ...
## $ Tx_logement : num [1:96] 730 790 597 469 568 ...
## $ Tx_bac : num [1:96] 50.6 38.3 40.9 49.3 53.1 ...
## $ Cap_acc : num [1:96] 2.9 5.1 8.3 9.2 6.3 5.1 5.8 13.8 17.1 9.8 ...
## - attr(*, "na.action")= 'omit' Named int [1:4] 97 98 99 100
## ..- attr(*, "names")= chr [1:4] "97" "98" "99" "100"Les chaines de caractère ont bien été transformé en valeur numérique.
De plus pour les besoins de la regression il était nécessaire d’enlever les valeurs absentes, nous avons pu vérifier qu’elle n’était pas nombreuse et qu’elle concernais uniquement les départements d’outre-mer, notre travail se consacre ainsi uniquement aux départements de la France métropolitaine.
Analyse préliminaire :
ggplot(bdd, aes(x = Tx_pauvre, y = Tx_placement)) +
geom_point(alpha = 0.6, color = "blue") +
geom_smooth(method ="lm", color = "red",
fill = "white", alpha = 0.2) +
labs(title = "Relation entre placement et pauvreté",
x = "Taux de pauvreté (%)",
y = "Taux de placement (‰)") +
theme_minimal()
On observer clairement une relation positive entre nos deux
variables
bdd_pour_cor <- bdd %>% dplyr::select(Tx_placement, Tx_pauvre, Tx_cho, Tx_logement, Tx_immi, Tx_bac, Cap_acc)
corrplot(cor(bdd_pour_cor), method = "square",
diag = FALSE, addCoef.col = "black", number.cex = 0.8)
La matrice de corrélation(…)
bdd <- bdd %>% mutate(Log_pauvre = log(Tx_pauvre), Log_Placement = log(Tx_placement), Log_cho = log(Tx_cho), Log_bac = log(Tx_bac), Log_logement = log(Tx_logement), Log_immi = log(Tx_immi), Log_acceuil = log(Cap_acc))Nous avons également longement refléchi au type de régression que nous allions faire, nous avons donc testé un modèle Log-Log, et l’autre Lin-Lin :
#Première regression linéaire :
Model_lin <- lm(Tx_placement ~ Tx_pauvre, bdd)
Model_log <- lm(Log_Placement ~ Log_pauvre, bdd)
suppressWarnings(
stargazer(Model_lin, Model_log,
type = "text",
title = "Comparaison des modèles",
header = FALSE))##
## Comparaison des modèles
## ==========================================================
## Dependent variable:
## ----------------------------
## Tx_placement Log_Placement
## (1) (2)
## ----------------------------------------------------------
## Tx_pauvre 0.363**
## (0.147)
##
## Log_pauvre 0.510***
## (0.156)
##
## Constant 9.644*** 1.298***
## (2.230) (0.419)
##
## ----------------------------------------------------------
## Observations 96 96
## R2 0.061 0.102
## Adjusted R2 0.051 0.092
## Residual Std. Error (df = 94) 4.350 0.299
## F Statistic (df = 1; 94) 6.104** 10.677***
## ==========================================================
## Note: *p<0.1; **p<0.05; ***p<0.01Le modèle Logarythmique parait plus évident pour la significativité, néanmoins pour la compréhension et après la réalisation des deux modèles complets, il paraissait plus simple de choisir le modèle linéaire. En effet ce dernier explique déjà près de 55% de de la variance du taux de placement observée dans notre échantillon
#Modèle complet :
Model_1 <- lm(Tx_placement ~ Tx_pauvre + Tx_cho + Tx_immi + Log_acceuil + Tx_logement + Tx_bac, bdd)
suppressWarnings(
stargazer(Model_1, type = "text"))##
## ===============================================
## Dependent variable:
## ---------------------------
## Tx_placement
## -----------------------------------------------
## Tx_pauvre 0.461***
## (0.173)
##
## Tx_cho -0.219
## (0.321)
##
## Tx_immi -0.340***
## (0.111)
##
## Log_acceuil 2.763***
## (0.622)
##
## Tx_logement 0.001
## (0.001)
##
## Tx_bac -0.213***
## (0.066)
##
## Constant 16.537***
## (4.083)
##
## -----------------------------------------------
## Observations 96
## R2 0.574
## Adjusted R2 0.545
## Residual Std. Error 3.012 (df = 89)
## F Statistic 19.951*** (df = 6; 89)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01plot(Model_1, 1)
resettest(Model_1, power = 2:3, type = "regressor")##
## RESET test
##
## data: Model_1
## RESET = 1.5029, df1 = 12, df2 = 77, p-value = 0.1414Le modèle choisi est bon car permet une interpretation direct des coefficients en termes de point de pourcentage, plus pertinente pour l’aide à la décision publique. Le test de Ramsey RESET valide économétriquement ce choix avec une P-value de 0,141 ce qui comfirme l’hypothèse nulle de bonne spécification du modèle.
Verification de la multicolinéarité via un VIF;
vif(Model_1)## Tx_pauvre Tx_cho Tx_immi Log_acceuil Tx_logement Tx_bac
## 2.880820 2.259019 2.878568 1.086457 1.380237 2.204522Toutes la valeurs sont inférieur à 5 donc il n’y pas de problème de multicolinéarité
Vérification de l’hétéroskedasticité :
bptest(Model_1)##
## studentized Breusch-Pagan test
##
## data: Model_1
## BP = 4.7588, df = 6, p-value = 0.5751Le test de Brusch-Pagan confirme l’hypothèse nulle ; p-value = 0.2384 > 0.05, le modèle est donc significatif, homoskédastique et ne souffre pas de multicolinéarité (VIF)
Avec le théorème centrale limite on peut facilement expliquer que les erreur suivent une loi normal, néanmoins on peut faire le test de Shapiro afin de le prouver :
shapiro.test(resid(Model_1))##
## Shapiro-Wilk normality test
##
## data: resid(Model_1)
## W = 0.97758, p-value = 0.09893La p-value = 0,3908 > 0.05 donc les résidus suivent bien une loi normale