I-But

Le but de ce projet est de déterminer le meilleur modèle qui pourrait estimer la variable DOCTOR qui est une variable Dummy qui indique si notre individu est allé chez un docteur ou un hopitale à travers des variables exogènes tellesque : (AGE,SEXE,REVENU …).

Après avoir determiner le meilleur modèle explicant notre variables endogène , on testera par la suite si la probabilité d’aller chez un docteur pour les femmes est égale à celle des homme , identiquement equivalent :

\(H_0\) : \(P(DOCTOR=1 | SEXE = F)\) = \(P(DOCTOR=1 | SEXE = H)\)

Pour résoudre ce test on va utiliser 3 méthodes à savoir :

  • Test de WALD
  • test du multiplicateur de Lagrange ( test du score )
  • test de rapport de vrai semblance

    • Importation de la base de donnée : Germain Helth Care. 

    library(readr)
data<- read_delim("C:/Users/User-LENOVO/Desktop/German health care_data.csv", 
    ";", escape_double = FALSE, trim_ws = TRUE)
    ## Parsed with column specification:
## cols(
##   id = col_integer(),
##   FEMALE = col_integer(),
##   YEAR = col_integer(),
##   AGE = col_integer(),
##   HHNINC = col_double(),
##   HHKIDS = col_integer(),
##   EDUC = col_double(),
##   WORKING = col_integer(),
##   DOCVIS = col_integer(),
##   HOSPVIS = col_integer(),
##   `Health Satisfaction Index` = col_integer(),
##   DOCTOR = col_integer()
## )
    attach(data)
bd<-data[data$YEAR==1994,]

    Correlation entre les variables:

    library(corrplot)
    ## corrplot 0.84 loaded
    bd1<-bd[,-c(1,3,9,10)]
m<-cor(bd1)
corrplot(m, method = "circle")

    L’étude de la corélation montrent qu’il existe des relations entre les différentes variables , en effet la variable DOCTOR est fortement correlé avec les variables HSI , SEXE , AGE , ceci montre que ces variables pourrait explique la variable exogène.

    II-Estimation du modèle complét :

    Dans cette partie on va considérer le modèle complet definit comme suit :

    \(Y^{*}\) = \(\alpha\) + \(\beta_{femme}\) \(\mathbb{1}_{femme}(X_1)\) + \(\beta_{age}\) \(X_{2}\)+ \(\beta_{INC}\) \(X_{3}\)+ \(\beta_{KIDS}\) \(\mathbb{1}_{KID}(X_4)\) + \(\beta_{EDUC}\) \(X_{5}\) + \(\beta_{WORKING}\) \(X_{6}\) + \(\beta_{HSI}\) \(X_{7}\) + \(\epsilon_{i}\)

    \(\epsilon_i\) \(\rightsquigarrow\)Logit

    \[\begin{equation} Y^{*} = \left\{ \begin{split} 1 si Y>0 \\0 sinon \end{split} \right. \end{equation}\] 
    ##<-bd1$`Health Satisfaction Index`
reg<-glm(DOCTOR ~ . , data=bd1 , family= binomial)
summary(reg) 
    ## 
## Call:
## glm(formula = DOCTOR ~ ., family = binomial, data = bd1)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.6376  -1.1265   0.6115   0.9114   1.5798  
## 
## Coefficients:
##                              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                  2.406344   0.319264   7.537 4.80e-14 ***
## FEMALE                       0.597600   0.081837   7.302 2.83e-13 ***
## AGE                          0.008628   0.003702   2.331   0.0198 *  
## HHNINC                      -0.092186   0.188273  -0.490   0.6244    
## HHKIDS                      -0.357357   0.080881  -4.418 9.95e-06 ***
## EDUC                        -0.008826   0.016718  -0.528   0.5976    
## WORKING                      0.009633   0.096880   0.099   0.9208    
## `Health Satisfaction Index` -0.302952   0.020917 -14.484  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 4338.5  on 3376  degrees of freedom
## Residual deviance: 3927.9  on 3369  degrees of freedom
## AIC: 3943.9
## 
## Number of Fisher Scoring iterations: 4

    Le modèle est globalement significative (un critère de AIC= 3943.9 assez elevé) , notre variable d’interet DOCTOR est expliqué par les variabLes SEXE , AGE , KIDS , et HSI . ces coefficient sont signifiacativement non nul (on rejette l’hypothèse de base \(H_0\) ) car ils admettent des P_valeur qui soit inférieur au seuil de significativité de 5% , tant dis que les autres variables sont non significative (P_value > 0.05).

    Le modèle complet nous donne une idée génerale sur la variable DOCTOR, mais par contre il se peut bien qu’il existe un autre modèle explicant mieux notre variable d’interêt DOCTOR.

    Pour ce faire on va utiliser les deux critère AIC et BIC afin de selectionner le meilleur modèle

    III-Selection du meilleur modèle avec le critère du BIC

    library(leaps)
res1 <- regsubsets(DOCTOR~. ,data=bd1  , nbest = 1 , vmax = NULL,  force.in = NULL,  force.out = NULL ,  method = "exhaustive")
plot(res1,scale="bic")

    D’après le graphique ci-dessous on remarque très bien que le meilleur modèle explicant notre variable d’intérêt est celle du bic le moins elevé .

    d’après ce modèle de selection exhaustive le modèle le plus adéquat est :

    \(Y^{*}\) = \(\alpha\) + \(\beta_{femme}\) \(\mathbb{1}_{femme}(X_1)\) + \(\beta_{KIDS}\) \(\mathbb{1}_{KID}(X_2)\)+ \(\beta_{HSI}\) \(X_{3}\) + \(\epsilon_{i}\)

    On remarque aussi qu’il existe un autre modèle dont l’odre de grandeur du BIC est trés proche du BIC du modèle séléctionné , en effet il contient tout les variables du modéle précedent en incorporant la variable AGE

    IV-Selection du meilleur modèle avec le critère du AIC

    library(glmulti)
    ## Loading required package: rJava
    HSI<-bd1$`Health Satisfaction Index`
select.res2<-glmulti(DOCTOR~FEMALE+AGE + HHNINC + HHKIDS + EDUC + WORKING +HSI , data=bd1 ,fitfunction = glm ,  level=1 , crit='aic' , plotty = F  , method="h") 
    ## Initialization...
## TASK: Exhaustive screening of candidate set.
## Fitting...
## 
## After 50 models:
## Best model: DOCTOR~1+FEMALE+AGE+HHNINC+HHKIDS
## Crit= 4396.52047427701
## Mean crit= 4462.08358773305
## 
## After 100 models:
## Best model: DOCTOR~1+FEMALE+AGE+HHKIDS+HSI
## Crit= 4161.45797198903
## Mean crit= 4373.28444133439
## 
## After 150 models:
## Best model: DOCTOR~1+FEMALE+AGE+HHKIDS+HSI
## Crit= 4161.45797198903
## Mean crit= 4285.83406670536
## Completed.
    plot(select.res2 , type="s")

    La valeur de l’importance d’une variable est égale à la somme des poids divisées par les probabilités des modèles dans lesquels la variable apparaît. Ainsi, une variable qui apparaît dans beaucoup de modèles avec de grands poids aura une grande valeur d’importance. La ligne rouge verticale est tracée à .80 (80%), qui est parfois utilisé comme une limite pour différencier les variables importantes et celles qui ne sont pas si importantes.

    On peut easement constater que le meilleur modèle selectionnée par cette méthode est :

    \(Y^{*}\) = \(\alpha\) + \(\beta_{femme}\) \(\mathbb{1}_{femme}(X_1)\) + \(\beta_{KIDS}\) \(\mathbb{1}_{KID}(X_2)\)+ \(\beta_{HSI}\) \(X_{3}\) + \(\beta_{AGE}\) \(X_{4}\)+\(\epsilon_{i}\)

    En effet tout les variables HSI , SEXE , KIDS apparaissent dans tout les modèles , la variable AGE apparait dans 90% des modèles , tantdisque les autres variables ne sont apparu que au plus de 30% des modèles itérrés .

    IV-Estimation du modèle

    D’aprés les deux méthodes de selection de modèle , le modèle le plus explicative est :

    \(Y^{*}\) = \(\alpha\) + \(\beta_{femme}\) \(\mathbb{1}_{femme}(X_1)\) + \(\beta_{KIDS}\) \(\mathbb{1}_{KID}(X_2)\)+ \(\beta_{HSI}\) \(X_{3}\) + \(\beta_{AGE}\) \(X_{4}\)+\(\epsilon_{i}\)

    reg<-glm(DOCTOR ~ 1 + FEMALE +  HHKIDS + HSI +AGE  , data=bd1 , family= binomial)
summary(reg)
    ## 
## Call:
## glm(formula = DOCTOR ~ 1 + FEMALE + HHKIDS + HSI + AGE, family = binomial, 
##     data = bd1)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.6327  -1.1271   0.6132   0.9122   1.5719  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  2.282942   0.240712   9.484  < 2e-16 ***
## FEMALE       0.601877   0.078563   7.661 1.84e-14 ***
## HHKIDS      -0.359417   0.080802  -4.448 8.66e-06 ***
## HSI         -0.304710   0.020768 -14.672  < 2e-16 ***
## AGE          0.008579   0.003593   2.388   0.0169 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 4338.5  on 3376  degrees of freedom
## Residual deviance: 3928.6  on 3372  degrees of freedom
## AIC: 3938.6
## 
## Number of Fisher Scoring iterations: 4

    Estimation du coefficient de \(\beta_{femme}\)

    Dans cette partie on va tester si le SEXE influe sur la variable d’intéret “DOCTOR” ie

    \(H_0\) : \(P(DOCTOR=1 | SEXE = F)\) = \(P(DOCTOR=1 | SEXE = H)\)

    Ce test est équivalent à :

    \(H_0\) : \(\beta_{femme}^{estimé}\) =0 .

    Test de multiplicateur de Lagrange

    il s’agit de tester le modèle cointraint (modèle sous \(H_0\)) contre le modèle non contraint . la statistique de ce test est définit commme suit

    \(F\)=\(\frac{(SCR_{nc} - SCR{n}) /ddl_{nc} - ddl_{c} }{ ddl_{nc} }\) \(\rightsquigarrow\) \(F\)( \(ddl_{c}\) - \(ddl_{nc}\) , \(ddl_{nc}\) )

    regTermTest(reg,"FEMALE" ,method = "Wald")
    ## Wald test for FEMALE
##  in glm(formula = DOCTOR ~ 1 + FEMALE + HHKIDS + HSI + AGE, family = binomial, 
##     data = bd1)
## F =  58.69191  on  1  and  3372  df: p= 2.394e-14

    \(F(1,3372)\) \(>\) \(F_{calculé}\) = 58.69 alors on rejete \(H_0\) ce qui implique que le coefficient \(\beta_{femme}^{estimé}\) est significativement non nul.

    test de Wald

    le test de Wald est définit sous \(H_0\) par \(R\)\(\beta_{estimé}\)=\(r\) , la statistique du test correspondant est :

    (\(R\)\(\beta^{estimé})\)\(I_{n}\)( \(\beta\) ) \(^t\)(\(R\)\(\beta^{estimé}\))\(\rightsquigarrow\) \(\chi2(k)\)

    dans notre cas , le test de \(\chi2\) est d’ordre 1 , c’est à dire \(R=1\) et \(r=0\) , on pourrait tester alors l’hypothèse \(H_0\) \(\beta_{femme}^{estimé}\)= 0

    grace à la statistique de Student , En effet la statistique du test correspondant est :

    T= \(\frac{ \beta_{femme}^{estimé} }{ \sigma^{estimé}}\) \(\rightsquigarrow\) \(T\)(N-K-1)=\(T\)(3372)

    La taille de notre echantillon est assez grand n>>> 30 alors on peut assimiler la loi de student a une loi normale centré reduite . (convergence en loi . ) 

    summary(reg)$coefficient[2,]
    ##     Estimate   Std. Error      z value     Pr(>|z|) 
## 6.018768e-01 7.856308e-02 7.661064e+00 1.843984e-14

    la P_valeur de la statitique correspondante est de l’ordre de \(10^{-14}\) \(<\) \(.05\) alors on rejette \(H_0\) ie le coefficient est significativement non nul .

    Méthode de rapport de vrai semblance . 

    regTermTest(reg,"FEMALE" ,method = "LRT")
    ## Working (Rao-Scott+F) LRT for FEMALE
##  in glm(formula = DOCTOR ~ 1 + FEMALE + HHKIDS + HSI + AGE, family = binomial, 
##     data = bd1)
## Working 2logLR =  59.63835 p= 1.6682e-14 
## df=1;  denominator df= 3372

    Conclusion

  • grace aux méthodes de selection on a pu déterminer le meilleur modèle expliquant notre variable d’intérêt “DOCTOR” .
  • Les individus agées visitent plus les medecins , ainsi les individus ayant des enfants visitent moins les docteurs
  • les 3 tests aplliqués montrent que le coefficient \(\beta_{femme}\) est significativement non nul ce qui signifie que les femmes visitent plus que les homme les medecins , d’ou le rejet de \(H_0\)
  • \(P(DOCTOR=1 | SEXE = F)\) =97%
  • \(P(DOCTOR=1 | SEXE = H)\) =96%