Introduction -Objectif

En 1973 l’Université de Berkeley, l’une des meilleures des Etats-Unis, a reçu des milliers de candidatures pour son école doctarale. Mais ce grand succès a été éntaché par des rumeurs selon laquelle l’institution a fait une discrimination contre les femmes candidates. Nous disposons d’un ensemble de données sur les candidatures à cette époque. Notre objectif est d’examiner ces données pour essayer de déterminer si ces rumeurs sont fondées ou pas. Après une analyse exploratoire des données, nous contruirons des modèles de régression logistique pour évaluer la probabilité qu’un homme ou une femme soit rejetée.

Analyse exploratoire des données

Importation et Vérification des données

#Charger les données
data('UCBAdmissions')

#Afficahge des données
print(UCBAdmissions)
## , , Dept = A
## 
##           Gender
## Admit      Male Female
##   Admitted  512     89
##   Rejected  313     19
## 
## , , Dept = B
## 
##           Gender
## Admit      Male Female
##   Admitted  353     17
##   Rejected  207      8
## 
## , , Dept = C
## 
##           Gender
## Admit      Male Female
##   Admitted  120    202
##   Rejected  205    391
## 
## , , Dept = D
## 
##           Gender
## Admit      Male Female
##   Admitted  138    131
##   Rejected  279    244
## 
## , , Dept = E
## 
##           Gender
## Admit      Male Female
##   Admitted   53     94
##   Rejected  138    299
## 
## , , Dept = F
## 
##           Gender
## Admit      Male Female
##   Admitted   22     24
##   Rejected  351    317

Les données se présentent sous une forme qui ne facilitera pas les analyses. Mettons-les sous une forme plus adéquate. Pour ce faire, on utilisera la fonction tidy() du package broom.

# Tidy Data 
UCB_tidy <- tidy(UCBAdmissions)

#Type de UCB_tidy
typeof(UCB_tidy)
## [1] "list"
#Valeurs manquantes ?
any(is.na(UCB_tidy))
## [1] FALSE
#Affichage des 6 premières lignes de UCB_tidy
head(UCB_tidy)
## # A tibble: 6 x 4
##   Admit    Gender Dept      n
##   <chr>    <chr>  <chr> <dbl>
## 1 Admitted Male   A       512
## 2 Rejected Male   A       313
## 3 Admitted Female A        89
## 4 Rejected Female A        19
## 5 Admitted Male   B       353
## 6 Rejected Male   B       207

Il n’y a pas de données manquantes et les données sont maintenant présentées sous forme de table. Il serait quand même mieux de convertir les types des variables Admit, Gender et Dept car on remarque qu’il s’agit en réalité de variables factorielles.

#Contraindre au type factor

Calcul et Visualisation de la proportion des admis selon le Genre

#Proportion des admis selon le sexe
UCBprop_admi <- UCB_tidy %>%
  group_by(Admit, Gender) %>%
  summarize(n = sum(n)) %>%
  ungroup() %>% 
  group_by(Gender) %>% 
  mutate(prop = n/sum(n)) %>%
  filter(Admit == 'Admitted')

#Visulaisation des proportions d'amission pour chaque sexe
ggplot(UCBprop_admi, aes(Gender, percent(prop), fill = Gender)) +
  geom_col()

Il y a 44,5% d’hommes qui ont été admis et 30,4% de femmes admises. Au vu de ces chiffres, est-ce qu’il y a une discrimination contre les femmes par rapport à l’admission dans cette université ?

Faisons la même analyse que précédemment mais en calculant cette fois la proportion des admis selon le sexe et aussi le département.

Calcul et Visualisation de la proportion des admis selon le Genre et le Département

#Proportion des admis selon le sexe et le département
UCBprop2_admi <- UCB_tidy %>%
  group_by(Gender, Dept) %>%
  mutate(prop = n/sum(n)) %>%
  filter(Admit == 'Admitted')

#Visulaisation des proportions d'amission pour chaque sexe
ggplot(UCBprop2_admi, aes(Gender, percent(prop), fill = Gender)) +
  geom_col() +
  facet_wrap(~ Dept)

Une vue d’ensemble de ces graphiques change complètement notre intuition au vue de la première analyse. Cette analyse département par département nous montre que, bien que les hommes étaient plus acceptés que les femmes dans les départements C et E, les femmes étaient plus admises que les hommes dans tous les autres départements (A, B, D et F).

Liaison entre chacune des variables prédictrices avec la variable cible

Nous allons tester statisquement la relation entre chacune des variables Gender et Dept avec la variable Admit. Mais d’abord, rappelez que l’ensemble des données est stockée sous forme de liste donc il faudra désagrégé cet ensemble afin d’avor une dataframe avec une ligne par candidat. Le nombre de lignes du jeu de données complet doit être égal à sum(UCB_tidy$n).

#Création d'une fonction de désagrégation (répétition n fois d'une colonne)
multiply_rows <- function(column, n) {
  rep(column, n)
}

# Création du jeu de données entier
ucb_full <- data.frame(Admit = multiply_rows(UCB_tidy$Admit, UCB_tidy$n),
                      Gender = multiply_rows(UCB_tidy$Gender, UCB_tidy$n),
                      Dept = multiply_rows(UCB_tidy$Dept, UCB_tidy$n))

#Vérifiez le nombre de lignes de ucb_full
print(nrow(ucb_full) == sum(UCB_tidy$n))
## [1] TRUE
#Affichage des premières lignes de ucb_full
head(ucb_full)
##      Admit Gender Dept
## 1 Admitted   Male    A
## 2 Admitted   Male    A
## 3 Admitted   Male    A
## 4 Admitted   Male    A
## 5 Admitted   Male    A
## 6 Admitted   Male    A

Voilà qui est bien fait :). Passons aux tests statistiques.

#Association entre 'Gender' et 'Admit'
testGender <- chisq.test(ucb_full$Gender, ucb_full$Admit)
testGender
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  ucb_full$Gender and ucb_full$Admit
## X-squared = 91.61, df = 1, p-value < 2.2e-16
#Association entre 'Dept' et 'Admit'
testDept <- chisq.test(ucb_full$Dept, ucb_full$Admit)
testDept
## 
##  Pearson's Chi-squared test
## 
## data:  ucb_full$Dept and ucb_full$Admit
## X-squared = 778.91, df = 5, p-value < 2.2e-16
#Coefficient de corrélation entre 'Dept' et 'Admit'
cor(as.numeric(ucb_full$Dept), as.numeric(ucb_full$Admit))
## [1] 0.4002256
#Coefficient de corrélation entre 'Gender' et 'Admit'
cor(as.numeric(ucb_full$Gender), as.numeric(ucb_full$Admit))
## [1] -0.1427318

Les p-valeurs sont toutes largement inférieures à 0,05 donc la corrélation entre Gender et Admit ainsi que celle entre Dept et Admit sont statistiquement significatives.

Par ailleurs le calcul des coefficients de corrélations montre que la variable Dept est positivement liée à la variable Admit tandis qe la variable Gender est négativement liée à Admit. Alors la relation linéaire entre Dept et Admit est plus forte que celle entre Gender et Admit.

Modélisation

Dans un premier temps on va construire un modèle Admit ~ Gender et dans une second temps un modèle Admit ~ Gender + Dept. Gardez

#Création du modèle m1
m1 <- glm(Admit ~ Gender, data = ucb_full, family = "binomial")

tidy_m1 <- tidy(m1)

#Calcul des rapports de chance (ODD RATIO)
tidy_m1$OR <- exp(tidy_m1$estimate)

tidy_m1
## # A tibble: 2 x 6
##   term        estimate std.error statistic  p.value    OR
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl> <dbl>
## 1 (Intercept)    0.830    0.0508     16.4  3.87e-60 2.29 
## 2 GenderMale    -0.610    0.0639     -9.55 1.26e-21 0.543

Soulignez qu’ici le modèle m1 donne la probabilité d’être rejeté car Admitted vient alphabatiquement avant Rejected. Donc R a codé Admitted égal à 0 (échec) et Rejected égal à 1. Il est possible de recoder la variable Admit mais cela ne devrait pas gêné nos analyses si on garde ça bien en esprit.

Selon notre modèle, un homme a 54,3% de chance d’être rejetté pour l’entrée dans cette université tandis qu’une femme n’a que 29,4% d’être rejetté. Nous sommes vraiment loin de notre première intuition selon laquelle Cette Université faisait une discrimination contre les femmes.

Passons au deuxième modèle Admit ~ Gender + Dept.

#Création du modèle m2
m2 <- glm(Admit ~ Gender + Dept, data = ucb_full, family = "binomial")

tidy_m2 <- tidy(m2)

#Calcul des rapports de chance (ODD RATIO)
tidy_m2$OR <- exp(tidy_m2$estimate)

tidy_m2
## # A tibble: 7 x 6
##   term        estimate std.error statistic  p.value     OR
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl>  <dbl>
## 1 (Intercept)  -0.682     0.0991    -6.88  5.97e-12  0.506
## 2 GenderMale    0.0999    0.0808     1.24  2.17e- 1  1.11 
## 3 DeptB         0.0434    0.110      0.395 6.93e- 1  1.04 
## 4 DeptC         1.26      0.107     11.8   2.41e-32  3.53 
## 5 DeptD         1.29      0.106     12.2   2.05e-34  3.65 
## 6 DeptE         1.74      0.126     13.8   2.86e-43  5.69 
## 7 DeptF         3.31      0.170     19.5   2.80e-84 27.3

Selon les valeurs de OR, les hommes avaient plus de chance d’être rejetées dans tous les départements que les femmes.

Conclusion

Notre analyse a commencé par le calcul de la proportion des admis selon le sexe. 44,5% des hommes avaient été accepté contre 30,4% d’admission chez les femmes. Alors il nous a semblé qu’il y a vraiment eu de discrimination sexiste. Mais après avoir fait une analyse à l’intérieur de chaque département de l’université, nous avons remarqué que les femmes étaient plus acceptées que les hommes dans 4 départements sur les 6 que compte l’Université. Cela change radicalement notre première intuition. Que s’est-il passé donc ? Il s’agit en effet du Paradoxe de Simpson.

Par ailleurs, après avoir construit les modèles, nous avons confirmé que le hommes avaient plus de chance d’être rejeté que les femmes. Nous concluons donc qu’au vu de ces analyses, il n’y avait pas eu de discrimination envers les femmes pour l’entrée à l’école doctorale de l’Université de Berkeley en 1973.