Considérons le tableau de contingence suivant

> N=margin.table(HairEyeColor, c(1,2))
> N
       Eye
Hair    Brown Blue Hazel Green
  Black    68   20    15     5
  Brown   119   84    54    29
  Red      26   17    14    14
  Blond     7   94    10    16

avec ici les comptages, que l’on peut aussi traduire sous la forme de probabilités jointes (empiriques)

> N/n
       Eye
Hair    Brown  Blue Hazel Green
  Black 0.115 0.034 0.025 0.008
  Brown 0.201 0.142 0.091 0.049
  Red   0.044 0.029 0.024 0.024
  Blond 0.012 0.159 0.017 0.027

Pour faire un test d’indépendance entre la couleur des yeux et la couleurs, rappelons que sous l’hypothèse d’indépendance

doit être égale à

et ce,  pour tout couple .  Ici, sous hypothèse d’indépendance, on devrait avoir les probabilités jointes suivantes

> n=sum(N)
> NHair=apply(N,1,sum)
> NEye =apply(N,2,sum)
> Nind=NHair%*%t(NEye)/n
> Nind/n
           Brown       Blue      Hazel      Green
Black 0.06779584 0.06625502 0.02865915 0.01972243
Brown 0.17953342 0.17545311 0.07589367 0.05222790
Red   0.04456949 0.04355654 0.01884074 0.01296567
Blond 0.07972288 0.07791100 0.03370104 0.02319211

ce qui devrait se traduire par les comptages suivants

> Nind
          Brown      Blue    Hazel     Green
Black  40.13514  39.22297 16.96622 11.675676
Brown 106.28378 103.86824 44.92905 30.918919
Red    26.38514  25.78547 11.15372  7.675676
Blond  47.19595  46.12331 19.95101 13.729730

La distance que l’on va utiliser entre les deux tableaux de contingence est la distance du chi-deux,

soit ici

> X=(N-Nind)^2/Nind
> Qobs=sum(X)
> Qobs
[1] 138.2898

Notons qu’il est toujours informatif de regarder les termes de la somme, qui sont les contributions au chi-deux

> X
       Eye
Hair    Brown  Blue Hazel Green
  Black 19.34  9.42  0.22  3.81
  Brown  1.52  3.80  1.83  0.11
  Red    0.00  2.99  0.72  5.21
  Blond 34.23 49.69  4.96  0.37

Rappelons que sous l’hypothèse d’indépendance,

On peut visualiser la densité de cette loi

> library(ggplot2)
> x=seq(0,140)
> ggplot(data=data.frame(x=x), aes(x = x))+
+ stat_function(fun=Vectorize(function(x)
+ dchisq(x,df=(ncol(N)-1)*(nrow(N)-1))),
+ geom="line", col = "red", size = 1) + 
+ ylab("Fonction de densité")

On voit que la valeur observée n’est pas vraisemblable pour une telle loi. La p-value est proche de 0 ici,

> 1-pchisq(Qobs,df=(ncol(N)-1)*(nrow(N)-1))

C’est en fait ce que l’on retrouve en faisant le test

> chisq.test(N)

	Pearson's Chi-squared test

data:  N
X-squared = 138.2898, df = 9, p-value < 2.2e-16

Notons que cette fonction permet d’obtenir le tableau de contingence sous hypothèse d’indépendance

> chisq.test(N)$expected
       Eye
Hair        Brown      Blue    Hazel     Green
  Black  40.13514  39.22297 16.96622 11.675676
  Brown 106.28378 103.86824 44.92905 30.918919
  Red    26.38514  25.78547 11.15372  7.675676
  Blond  47.19595  46.12331 19.95101 13.729730

---

---