Análise de Correspondência

library(FactoMineR)
library(dplyr)

Caso 1:

A Tabela a seguir a contém as frequências de 4 tipos de cerâmica (A, B, C e D) encontrados em 7 lugares arqueológicos diferentes (L1, L2, …, L7). Estamos interessados em saber se existe associação entre as variáveis e, se existir, quais categorias estão mais associadas entre si.

dados = read.table("https://raw.githubusercontent.com/ctruciosm/Johnson_Wichern_2007_datasets/master/T12-8.DAT")
colnames(dados) = c("A", "B", "C", "D")
row.names(dados) = c("L1", "L2", "L3", "L4", "L5", "L6", "L7")
dados

chisq.test(dados)

Warning: Aproximação do qui-quadrado pode estar incorreta

    Pearson's Chi-squared test

data:  dados
X-squared = 400.25, df = 18, p-value < 2.2e-16

AC = CA(dados, ncp = 2)

Inércia

• As porcentagens ao lado de cada uma das componentes nos dizem a porcentagem da inércia que é explicada por cada uma das componentes.
• A inercia é dada por \(\dfrac{\chi^2}{n}\).
• A primeira componente explica 55% da inércia total e as duas primeiras componentes explicam mais de 88% da inercia total.

Regra de Interpretação

• Se os pontos referentes a duas linhas (colunas) estão próximos, isto indica que os perfis linha (coluna) são semelhantes. Eles poderiam ser unidos em uma única categoria, caso seja necessário, para melhorar a aproximação \(\chi^2\).
• A proximidade de um ponto representando uma linha e um ponto representando uma coluna indica que elas ocorrem, conjuntamente, mais do que o esperado se as variáveis fossem independentes (indicando uma “atração” entre essas categorias, o que se traduz como associação entre as categorias).

Interpretação

• O ponto representando o lugar L1 e o ponto representando o tipo de cerâmica D estão próximos e afastados da origem.
• O ponto representando o lugar L7 e o ponto representando o tipo de cerâmica C estão próximos e afastados da origem.
• O ponto representando os lugares L2 e L3 e o ponto representando o tipo de cerâmica A estão próximos e afastados da origem.

# Note que se as variáveis fossem independes, esperariamos que:
total_linha = rowSums(dados)/sum(dados)
total_coluna = colSums(dados)/sum(dados)
E = sum(dados)*total_linha %o% total_coluna
E

          A         B        C         D
L1 32.24968 10.370038 37.94750  8.432778
L2 27.17670  8.738796 31.97823  7.106274
L3 42.03329 13.516005 49.45967 10.991037
L4 11.23303  3.612036 13.21767  2.937260
L5 47.83099 15.380282 56.28169 12.507042
L6 43.48271 13.982074 51.16517 11.370038
L7 78.99360 25.400768 92.95006 20.655570

Caso 2:

Em 1960, uma pesquisa foi aplicada a 1724 mulheres e, entre outras questões, foram coletadas informações a respeito do trabalho da mulher. As duas perguntas a seguir faziam parte do questionário:

• Qual das seguintes três opções é, na sua opinão, o ambiente famiiar ideal? (a) uma familia em que ambos os pais tem uma profissão e o trabalho de casa, bem como o cuidado das crianças, é igualmente dividido, (b) uma familia na qual a mãe trabalha mas este trabalho consome menos tempo do que o trabalho do pai. A mãe cuida dos afazeres da casa e das crianças, (c) uma familia em que apenas o marido trabalha e a esposa fica em casa.
• Quando as crianças são muito pequenas e estão no começo da etapa escolar, qual é a melhor atividade para a mae? (a) Ficar em casa, (b) Trabalho a tempo parcial, (c) Trabalho a tempo integral.

A Tabela resumindo as informações de ambas as respostas é apresentada a seguir:

opinion <- matrix(c(13, 142, 106, 30, 408, 117, 241, 573, 94), byrow = TRUE, ncol = 3)
colnames(opinion) <- c("Ficar em Casa", "Part-time", "Tempo Integral")
row.names(opinion) <- c("Ambos", "Marido trabalha mais", "Só marido")
opinion

                     Ficar em Casa Part-time Tempo Integral
Ambos                           13       142            106
Marido trabalha mais            30       408            117
Só marido                      241       573             94

chisq.test(opinion)

    Pearson's Chi-squared test

data:  opinion
X-squared = 233.43, df = 4, p-value < 2.2e-16

CA_opinion <- CA(opinion, ncp = 2)

• Note que as categorias “Ficar em Casa” e “Tempo integral” estão em lugares opostos, indicando que os perfis (coluna) dessas categorias é diferente.
• Note que a categoria “Part-time” está perto da origem, indicando um perfil próximo ao perfil médio.
• Veja que a dimensão 1 ordena as respostas das mais progressistas (ambos trabalham) às mais conservadores (só o marido trabalha).
• As categorias “Ambos” e “tempo integral” estão perto, indicando que ambas as categorias estão associadas (ocorrem conjuntamente com maior frequencia do que seria se fossem independentes).
• As categorias “Ficar em casa” e “Só marido” estão perto (mas não muito), indicando também que ambas as categorias estão associadas .

Como saber a qualidade dos pontos representados?

Até agora temos focado unicamente na qualidade do mapa de pontos e na interpretação dos pontos. Contudo, é importante saber a qualidade dos pontos representados (afinal, poderiam existir pontos pobremente representados e fariam com que nossa interpretação perca força/sentido).

Contribuição

A contribuição da linha \(i\) à inércia da dimensão \(r_k\) e a contribuição da coluna \(j\) à dimensão \(s_k\) são dadas, respectivamente, por:

\[C_a(i, r_k) = \dfrac{f_{i.} r_{ki}^2}{\lambda_k} \quad e \quad C_a(j, s_k) = \dfrac{f_{.j} s_{kj}^2}{\lambda_k}\]

• escolher os pontos que mais contribuem à inércia facilita a interpretação.
• Pode acontecer que, apenas poucos pontos contribuam com quase a totalidade da inêrcia. Nestes casos, o foco da interpretação deve cair nestes pontos (e evitar interpretações arriscadas).

summary(CA_opinion)

Call:
CA(X = opinion, ncp = 2) 

The chi square of independence between the two variables is equal to 233.4304 (p-value =  2.410248e-49 ).

Eigenvalues
                       Dim.1   Dim.2
Variance               0.117   0.019
% of var.             86.292  13.708
Cumulative % of var.  86.292 100.000

Rows
                       Iner*1000    Dim.1    ctr   cos2  
Ambos                |    55.487 | -0.559 40.432  0.851 |
Marido trabalha mais |    28.675 | -0.244 16.371  0.667 |
Só marido            |    51.239 |  0.310 43.197  0.985 |
                      Dim.2    ctr   cos2  
Ambos                 0.233 44.429  0.149 |
Marido trabalha mais -0.172 51.436  0.333 |
Só marido             0.038  4.135  0.015 |

Columns
                       Iner*1000    Dim.1    ctr   cos2  
Ficar em Casa        |    68.489 |  0.618 53.913  0.920 |
Part-time            |     6.478 | -0.004  0.007  0.001 |
Tempo Integral       |    60.434 | -0.541 46.079  0.891 |
                      Dim.2    ctr   cos2  
Ficar em Casa         0.183 29.613  0.080 |
Part-time            -0.100 34.853  0.999 |
Tempo Integral        0.189 35.533  0.109 |

Contribuição

\[C_a(i, r_k) = \dfrac{f_{i.} r_{ki}^2}{\lambda_k} \quad e \quad C_a(j, s_k) = \dfrac{f_{.j} s_{kj}^2}{\lambda_k}\]

# Contribuição
C_a_1_r11 = ((106 + 142 + 13)/1724)*(-0.559)^2/0.117
C_a_1_r11

[1] 0.4043347

C_a_2_r12 = ((30 + 408 + 117)/1724)*(-0.244)^2/0.117
C_a_2_r12

[1] 0.1638134

C_a_1_r21 = ((106 + 142 + 13)/1724)*(0.233)^2/0.019
C_a_1_r21

[1] 0.4325751

C_a_3_r31 = (241 + 573 + 94)/1724*(0.310)^2/0.117
C_a_3_r31

[1] 0.4325996

CA_opinion$eig

      eigenvalue percentage of variance
dim 1 0.11684002               86.29218
dim 2 0.01856045               13.70782
      cumulative percentage of variance
dim 1                          86.29218
dim 2                         100.00000

• “Ambos” contribui com 40% da inércia da dimensão 1.
• “Só marido” contribui com 43% da inércia da dimensão 1.
• etc.

Qualidade

A qualidade da representação do ponto \(i\) é dado por \[\dfrac{\text{Inércia de i projetada}}{\text{Inércia total de i}}.\]

Isto mede quanto da desviação da categoria \(i\), w.r.t perfil médio, é capturado (focamos nos pontos cuja qualidade de representação é maior). No caso dos dados opinion os dados são perfeitamente representados pelas duas dimensões (mas isto não sempre será assim).

Na Tabela, é representado por cos2.

• A inércia total: \(\chi^2/n = \displaystyle \sum_{i = 1}^p\sum_{j = 1}^q \dfrac{(f_{ij} - f_{i.}f_{.j})^2}{f_{i.}f_{.j}}\)
• A inércia de \(i\): \(\displaystyle\sum_{j = 1}^q \dfrac{(f_{ij} - f_{i.}f_{.j})^2}{f_{i.}f_{.j}}\)
• A inércia de \(i\) projetada na primeira dimensão: \(r_1^2 f_{i.}\)

Freq_rel <- opinion/sum(opinion)
Freq_rel

                     Ficar em Casa  Part-time Tempo Integral
Ambos                  0.007540603 0.08236659     0.06148492
Marido trabalha mais   0.017401392 0.23665893     0.06786543
Só marido              0.139791183 0.33236659     0.05452436

total_linha <- apply(Freq_rel, 1, sum)
total_linha

               Ambos Marido trabalha mais 
           0.1513921            0.3219258 
           Só marido 
           0.5266821 

total_coluna <- apply(Freq_rel, 2, sum)
total_coluna

 Ficar em Casa      Part-time Tempo Integral 
     0.1647332      0.6513921      0.1838747 

# Inércia da linha 1
inercia_linha_1 = (Freq_rel[1,1] - total_linha[1]*total_coluna[1])^2/(total_linha[1]*total_coluna[1]) +
(Freq_rel[1,2] - total_linha[1]*total_coluna[2])^2/(total_linha[1]*total_coluna[2]) + 
(Freq_rel[1,3] - total_linha[1]*total_coluna[3])^2/(total_linha[1]*total_coluna[3])
inercia_linha_1

     Ambos 
0.05548659 

# Inércia da linha 2
inercia_linha_2 = (Freq_rel[2,1] - total_linha[2]*total_coluna[1])^2/(total_linha[2]*total_coluna[1]) +
(Freq_rel[2,2] - total_linha[2]*total_coluna[2])^2/(total_linha[2]*total_coluna[2]) + 
(Freq_rel[2,3] - total_linha[2]*total_coluna[3])^2/(total_linha[2]*total_coluna[3])
inercia_linha_2

Marido trabalha mais 
          0.02867515 

# Inércia projetada da linha 1
total_linha[1]*(-0.559)^2

     Ambos 
0.04730716 

# Inércia projetada da linha 2
total_linha[1]*(-0.244)^2

      Ambos 
0.009013281 

# Qualidade da representação da linha 1
total_linha[1]*(-0.559)^2 / inercia_linha_1

# Qualidade da representação da linha 1
total_linha[2]*(-0.244)^2 / inercia_linha_2

Marido trabalha mais 
           0.6683896 

Veja, por exemplo, a contribuição das linhas/colunas do primeiro exemplo:

summary(AC)

Call:
CA(X = dados, ncp = 2) 

The chi square of independence between the two variables is equal to 400.2473 (p-value =  8.126171e-74 ).

Eigenvalues
                       Dim.1   Dim.2   Dim.3
Variance               0.284   0.170   0.059
% of var.             55.336  33.193  11.471
Cumulative % of var.  55.336  88.529 100.000

Rows
     Iner*1000     Dim.1     ctr    cos2     Dim.2     ctr
L1 |   168.442 |   0.919  33.974   0.572 |   0.752  37.904
L2 |    49.628 |   0.378   4.842   0.277 |  -0.611  21.102
L3 |    57.532 |   0.137   0.989   0.049 |  -0.586  29.971
L4 |    25.735 |   0.700   6.862   0.756 |  -0.221   1.140
L5 |    43.968 |   0.148   1.306   0.084 |   0.135   1.815
L6 |     7.650 |  -0.078   0.333   0.123 |  -0.087   0.677
L7 |   159.525 |  -0.725  51.694   0.919 |   0.212   7.392
      cos2  
L1   0.383 |
L2   0.723 |
L3   0.886 |
L4   0.075 |
L5   0.070 |
L6   0.150 |
L7   0.079 |

Columns
     Iner*1000     Dim.1     ctr    cos2     Dim.2     ctr
A  |   134.069 |   0.420  22.580   0.478 |  -0.440  41.164
B  |    61.739 |  -0.008   0.003   0.000 |   0.358   8.801
C  |   142.554 |  -0.564  47.849   0.952 |   0.067   1.140
D  |   174.118 |   0.941  29.569   0.482 |   0.937  48.896
      cos2  
A    0.522 |
B    0.242 |
C    0.014 |
D    0.478 |

Caso 3:

Uma pesquisa foi aplicada a 300 bebedores asíduos de chá. Entre as perguntas do questionários temos:

1. What kind of tea do you drink the most (black tea, green tea, avoured tea)?

2. How do you take your tea (nothing added, with lemon, with milk, other)?

3. What kind of tea do you buy (tea bags, loose tea, both)?

4. Do you add sugar to your tea (yes, no)?

5. Where do you buy your tea (in the supermarket, in specialist shops, both)?

6. What kind of tea do you buy (cheapest, supermarket brand, well-known brand, luxury, it varies, I don’t know)?

7. How often do you drink tea (more than twice a day, once a day, 3 to 6 times a week, once or twice per week)?

8. Do you drink tea at home?

9. Do you drink tea at work?

10. Do you drink tea in tearooms or coffee shops?

11. Do you drink tea at friends’ houses?

12. Do you drink tea in restaurants?

13. Do you drink tea in bars?

14. Do you drink tea at breakfast?

15. Do you drink tea in the afternoon?

16. Do you drink tea in the evening?

17. Do you drink tea after lunch?

18. Do you drink tea after dinner?

19. Do you drink tea throughout the day

20. Do you consider tea to be exotic?

21. Do you associate tea with spirituality?

22. Is tea good for your health?

23. Is tea a diuretic?

24. Do you associate tea with friendliness?

25. Does tea stop the body from absorbing iron?

26. Is tea feminine?

27. Is tea re ned?

28. Will tea help you to lose weight?

29. Is tea a stimulant?

30. sex

31. professional category (farmer, manual labourer, professional, senior management, employee, other profession, student, unemployed),

32. age

33. whether or not the participant regularly played sports

O data set está disponível aqui.

tea = read.table("http://factominer.free.fr/bookV2/tea.csv", header = TRUE, sep = ";")
tea

ACM permite, além de permitir observar associação entre categorias, identificar sub-grupos de indivíduos, bem como identificar quais variáveis estão correlacionadas.

tea_dados_acm = tea[, -c(19:36)]
acm_tea = MCA(tea_dados_acm, ncp = 2)

1. Nuvem das categorias
2. Nuvem das observações
3. Nuvem das variáveis

summary(acm_tea)

Call:
MCA(X = tea_dados_acm, ncp = 2) 


Eigenvalues
                       Dim.1   Dim.2   Dim.3   Dim.4   Dim.5
Variance               0.148   0.122   0.090   0.078   0.074
% of var.              9.885   8.103   6.001   5.204   4.917
Cumulative % of var.   9.885  17.988  23.989  29.192  34.109
                       Dim.6   Dim.7   Dim.8   Dim.9  Dim.10
Variance               0.071   0.068   0.065   0.062   0.059
% of var.              4.759   4.522   4.355   4.123   3.902
Cumulative % of var.  38.868  43.390  47.745  51.867  55.769
                      Dim.11  Dim.12  Dim.13  Dim.14  Dim.15
Variance               0.057   0.054   0.052   0.049   0.048
% of var.              3.805   3.628   3.462   3.250   3.221
Cumulative % of var.  59.574  63.202  66.664  69.914  73.135
                      Dim.16  Dim.17  Dim.18  Dim.19  Dim.20
Variance               0.047   0.046   0.040   0.038   0.037
% of var.              3.127   3.037   2.683   2.541   2.438
Cumulative % of var.  76.262  79.298  81.982  84.523  86.961
                      Dim.21  Dim.22  Dim.23  Dim.24  Dim.25
Variance               0.036   0.035   0.031   0.029   0.027
% of var.              2.378   2.323   2.055   1.915   1.821
Cumulative % of var.  89.339  91.662  93.717  95.633  97.454
                      Dim.26  Dim.27
Variance               0.021   0.017
% of var.              1.407   1.139
Cumulative % of var.  98.861 100.000

Individuals (the 10 first)
                    Dim.1    ctr   cos2    Dim.2    ctr
1                | -0.541  0.658  0.143 | -0.149  0.061
2                | -0.361  0.293  0.133 | -0.078  0.017
3                |  0.073  0.012  0.003 | -0.169  0.079
4                | -0.572  0.735  0.235 |  0.018  0.001
5                | -0.253  0.144  0.079 | -0.118  0.038
6                | -0.684  1.053  0.231 |  0.032  0.003
7                | -0.111  0.027  0.022 | -0.182  0.090
8                | -0.210  0.099  0.043 | -0.068  0.013
9                |  0.118  0.031  0.012 |  0.229  0.144
10               |  0.258  0.150  0.045 |  0.478  0.627
                   cos2  
1                 0.011 |
2                 0.006 |
3                 0.018 |
4                 0.000 |
5                 0.017 |
6                 0.001 |
7                 0.059 |
8                 0.004 |
9                 0.044 |
10                0.156 |

Categories (the 10 first)
                    Dim.1    ctr   cos2 v.test    Dim.2
breakfast        |  0.166  0.495  0.025  2.756 | -0.166
not.breakfast    | -0.153  0.457  0.025 -2.756 |  0.154
afternoon.tea    |  0.386  3.142  0.192  7.578 | -0.072
Not.afternoon.t  | -0.498  4.053  0.192 -7.578 |  0.093
evening          |  0.319  1.307  0.053  3.985 | -0.058
not.evening      | -0.167  0.683  0.053 -3.985 |  0.030
after.lunch      |  0.659  2.385  0.075  4.722 | -0.390
not.after.lunch  | -0.113  0.410  0.075 -4.722 |  0.067
after.dinner     | -0.661  1.146  0.033 -3.136 |  0.796
not.after.dinner |  0.050  0.086  0.033  3.136 | -0.060
                    ctr   cos2 v.test  
breakfast         0.607  0.026 -2.764 |
not.breakfast     0.560  0.026  2.764 |
afternoon.tea     0.135  0.007 -1.423 |
Not.afternoon.t   0.174  0.007  1.423 |
evening           0.053  0.002 -0.728 |
not.evening       0.028  0.002  0.728 |
after.lunch       1.018  0.026 -2.793 |
not.after.lunch   0.175  0.026  2.793 |
after.dinner      2.025  0.048  3.774 |
not.after.dinner  0.152  0.048 -3.774 |

Categorical variables (eta2)
                   Dim.1 Dim.2  
breakfast        | 0.025 0.026 |
afternoon.tea    | 0.192 0.007 |
evening          | 0.053 0.002 |
after.lunch      | 0.075 0.026 |
after.dinner     | 0.033 0.048 |
anytime          | 0.045 0.001 |
home             | 0.005 0.000 |
work             | 0.112 0.043 |
tearoom          | 0.372 0.022 |
friends          | 0.243 0.015 |