Analyse des Déterminants du Placement
Konan Kevin, AGOSSOU Christine, GEHIN Nathan
2025-12-02
Description du dataset :
Il s’agit ici de données issus de l’INSEE et du DREES datant du 31/12/23 ou du 01/01/24 Le but de ces données est d’analyser les déterminants du placement d’un enfant auprès de l’aide social à l’enfance (ASE).
###Les variables :
Il est important de noter que toutes ces variables sont pour chacun des département
Tx_placement: Il s’agit du taux de placement d’enfants
(entre 0 et 20 ans), en ‰, Tx_cho: Taux de chomage en %,
Tx_pauvre: Taux de pauvreté en %, Tx_immi:
Taux d’immigration en %, Tx_logement: Taux de logement
sociaux pour 10000 habitant, Tx_bac: Part de la population
ayant le bac, Cap_acc: Capacité d’acceuil pour 1000 enfant
agé de 0 à 20 ans, Acc_adu: Capacité d’acceuil d’adulte
handicapé en maison de soin, en ‰
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 × 15] (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 ...
## $ Acceuil_Adultes_Handicapées_(Pour_1000): chr [1:100] "4.3" "5.7" "6.3" "6" ...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)",
Acc_adu = "Acceuil_Adultes_Handicapées_(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))
bdd$Acc_adu <- as.numeric(gsub(",",".",bdd$Acc_adu))
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 0
## Acc_adu
## 1bdd <- na.omit(bdd)
str(bdd) ## tibble [95 × 15] (S3: tbl_df/tbl/data.frame)
## $ N° : chr [1:95] "01" "02" "03" "04" ...
## $ Département : chr [1:95] "Ain" "Aisne" "Allier" "Alpes-de-Haute-Provence" ...
## $ 0 à 19 ans : num [1:95] 171336 125708 66246 33920 27874 ...
## $ 20 à 24 ans : num [1:95] 32113 27152 15740 6983 5632 ...
## $ 20-24/5 : num [1:95] 6423 5430 3148 1397 1126 ...
## $ 0 à 20 ans : num [1:95] 177759 131138 69394 35317 29000 ...
## $ Total des enfants acceuilli: num [1:95] 1915 2484 1152 659 277 ...
## $ Tx_placement : num [1:95] 10.77 18.94 16.6 18.66 9.55 ...
## $ Tx_cho : num [1:95] 5.5 10.5 7.7 8.1 6.6 7.1 9.7 9.4 9.6 10.2 ...
## $ Tx_pauvre : num [1:95] 10.8 18.8 16.2 17.1 14.7 16.4 19.4 19 16.9 20.8 ...
## $ Tx_immi : num [1:95] 11.98 5.06 5.5 8.44 5.96 ...
## $ Tx_logement : num [1:95] 730 790 597 469 568 ...
## $ Tx_bac : num [1:95] 50.6 38.3 40.9 49.3 53.1 ...
## $ Cap_acc : num [1:95] 2.9 5.1 8.3 9.2 6.3 5.1 13.8 17.1 9.8 12.5 ...
## $ Acc_adu : num [1:95] 4.3 5.7 6.3 6 9 3.4 4.3 6.1 4.5 5.8 ...
## - attr(*, "na.action")= 'omit' Named int [1:5] 7 97 98 99 100
## ..- attr(*, "names")= chr [1:5] "7" "97" "98" "99" ...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.511***
## (0.157)
##
## Constant 9.675*** 1.297***
## (2.236) (0.421)
##
## ----------------------------------------------------------
## Observations 95 95
## R2 0.061 0.103
## Adjusted R2 0.051 0.093
## Residual Std. Error (df = 93) 4.362 0.300
## F Statistic (df = 1; 93) 6.072** 10.649***
## ==========================================================
## 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 + Cap_acc + Tx_logement + Tx_bac, bdd)
suppressWarnings(
stargazer(model_1, type = "text", title = "Résulat de l'estimation (Lin-Lin)"))##
## Résulat de l'estimation (Lin-Lin)
## ===============================================
## Dependent variable:
## ---------------------------
## Tx_placement
## -----------------------------------------------
## Tx_pauvre 0.526***
## (0.180)
##
## Tx_cho -0.161
## (0.338)
##
## Tx_immi -0.400***
## (0.116)
##
## Cap_acc 0.190***
## (0.061)
##
## Tx_logement 0.001
## (0.002)
##
## Tx_bac -0.190***
## (0.070)
##
## Constant 18.452***
## (4.212)
##
## -----------------------------------------------
## Observations 95
## R2 0.537
## Adjusted R2 0.505
## Residual Std. Error 3.149 (df = 88)
## F Statistic 17.008*** (df = 6; 88)
## ===============================================
## 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 = 2.4185, df1 = 12, df2 = 76, p-value = 0.01028Le modèle choisi est mauvais car Le test de Ramsey RESET ne valide pas économétriquement ce choix avec une P-value de 0,0132 ce qui rejette l’hypothèse nulle de bonne spécification du modèle. Il est ainsi nécessaire de spécifier correctement le modèle, nous avons décider de reprendre un modèle quaratique :
model_2 <- lm(Tx_placement ~ Tx_pauvre + I(Tx_pauvre^2) + Cap_acc + Tx_bac + Tx_immi + Tx_cho + Tx_logement, bdd)
stargazer(model_2, type = "text", title = "Résultats de l'estimaton quadratique")##
## Résultats de l'estimaton quadratique
## ===============================================
## Dependent variable:
## ---------------------------
## Tx_placement
## -----------------------------------------------
## Tx_pauvre 1.360**
## (0.652)
##
## I(Tx_pauvre2) -0.027
## (0.020)
##
## Cap_acc 0.179***
## (0.061)
##
## Tx_bac -0.207***
## (0.071)
##
## Tx_immi -0.345***
## (0.122)
##
## Tx_cho -0.146
## (0.337)
##
## Tx_logement 0.001
## (0.002)
##
## Constant 12.523**
## (6.123)
##
## -----------------------------------------------
## Observations 95
## R2 0.546
## Adjusted R2 0.510
## Residual Std. Error 3.136 (df = 87)
## F Statistic 14.958*** (df = 7; 87)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01plot(model_2, 1)
resettest(model_2, power = 2:3, type = "regressor")##
## RESET test
##
## data: model_2
## RESET = 1.9727, df1 = 14, df2 = 73, p-value = 0.03205Les tests de spécification (Ramsey RESET) ayant rejeté les formes linéaires et quadratiques, nous avons retenu le modèle en double logarithme (Log-Log). Ce modèle est le seul à valider l’ensemble des tests de robustesse (Homoscédasticité, Normalité, Spécification) :
model_3 <- lm(Log_Placement ~ Log_pauvre + Log_acceuil + Log_bac + Log_immi + Log_cho + Log_logement, bdd)
stargazer(model_3, type = "text", title = "Résulats de l'estimation (Log-Log)")##
## Résulats de l'estimation (Log-Log)
## ===============================================
## Dependent variable:
## ---------------------------
## Log_Placement
## -----------------------------------------------
## Log_pauvre 0.527***
## (0.156)
##
## Log_acceuil 0.205***
## (0.040)
##
## Log_bac -0.759***
## (0.215)
##
## Log_immi -0.220***
## (0.063)
##
## Log_cho -0.048
## (0.147)
##
## Log_logement -0.016
## (0.059)
##
## Constant 4.422***
## (1.010)
##
## -----------------------------------------------
## Observations 95
## R2 0.646
## Adjusted R2 0.622
## Residual Std. Error 0.194 (df = 88)
## F Statistic 26.745*** (df = 6; 88)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01plot(model_3, 1)
resettest(model_3, power = 2:3, type = "regressor")##
## RESET test
##
## data: model_3
## RESET = 1.3345, df1 = 12, df2 = 76, p-value = 0.2173Verification de la multicolinéarité via un VIF;
vif(model_3)## Log_pauvre Log_acceuil Log_bac Log_immi Log_cho Log_logement
## 2.376648 1.097193 2.158504 2.403030 2.110461 1.181469Toutes 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_3)##
## studentized Breusch-Pagan test
##
## data: model_3
## BP = 7.978, df = 6, p-value = 0.2397Le 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_3))##
## Shapiro-Wilk normality test
##
## data: resid(model_3)
## W = 0.98403, p-value = 0.3024La p-value = 0,3908 > 0.05 donc les résidus suivent bien une loi normale.
Le choix du modèle Log-Log est cohérent avec la nature des variables socio-économiques (revenus, pauvreté) qui suivent souvent des distributions asymétriques (Loi de Pareto). La transformation logarithmique permet de normaliser ces distributions et de capturer les effets de rendements décroissants
Enfin il reste le détail de l’endogénéité, après de longue recherche il m’est parru relativement évident que cette dernière provenais probablement de la capacité d’acceuil, c’est pourquoi nous avons décider de le vérifier à l’aide de la capacité d’acceuil de personnes adultes handicapées, car la où les investissement sont fait dans le médico-social, ils sont également généralement fait aussi dans le social.
bdd <- bdd %>% mutate(Log_Handicape = log(Acc_adu))
model_iv <- ivreg(Log_Placement ~ Log_acceuil + Log_pauvre + Log_bac + Log_immi + Log_cho + Log_logement | Log_Handicape + Log_pauvre + Log_bac + Log_immi + Log_cho + Log_logement, data = bdd)
summary(model_iv, diagnostics = TRUE) ##
## Call:
## ivreg(formula = Log_Placement ~ Log_acceuil + Log_pauvre + Log_bac +
## Log_immi + Log_cho + Log_logement | Log_Handicape + Log_pauvre +
## Log_bac + Log_immi + Log_cho + Log_logement, data = bdd)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.81656 -0.15618 0.02377 0.15795 0.77163
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.81415 1.64222 1.714 0.09012 .
## Log_acceuil 0.58590 0.19735 2.969 0.00385 **
## Log_pauvre 0.46536 0.22353 2.082 0.04025 *
## Log_bac -0.56062 0.32139 -1.744 0.08459 .
## Log_immi -0.22761 0.08988 -2.532 0.01310 *
## Log_cho -0.19738 0.22195 -0.889 0.37627
## Log_logement 0.07258 0.09420 0.770 0.44309
##
## Diagnostic tests:
## df1 df2 statistic p-value
## Weak instruments 1 88 8.062 0.00561 **
## Wu-Hausman 1 87 8.956 0.00360 **
## Sargan 0 NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2751 on 88 degrees of freedom
## Multiple R-Squared: 0.285, Adjusted R-squared: 0.2362
## Wald test: 12.58 on 6 and 88 DF, p-value: 3.417e-10Le test de Wu-Hausman (p-value = 0.003) révèle la présence d’une endogénéité significative sur la capacité d’accueil. L’estimation par Variable Instrumentale (IV) montre que le coefficient de la capacité d’accueil passe de 0,21 (MCO) à 0,59 (IV). Cela suggère que notre modèle principal (MCO) a tendance à sous-estimer l’effet d’offre induite.
Cependant, bien que le modèle IV corrige ce biais, il entraîne une perte de précision (les écarts-types augmentent, rendant la variable Éducation moins significative). Par souci de lisibilité et de robustesse globale, nous basons nos conclusions principales sur le modèle MCO, tout en gardant à l’esprit que l’impact réel de l’offre de places est probablement plus fort que celui affiché (0,21)