Análisis de correspondencia múltiple

Fecha de publicación

4 de septiembre de 2024

Objetivo de la práctica

La siguiente práctica tiene el objetivo de introducir la idea central del análisis de correspondencia. Para ello, utilizaremos la base de datos de la cuarta ola del Estudio Longitudinal Social de Chile (2019) con el objetivo de analizar agrupaciones de variables categóricas nominales.

Preparación datos

Comencemos por preparar nuestros datos. Iniciamos cargando las librerías necesarias.

Código 
pacman::p_load(tidyverse, # Manipulacion datos
               sjPlot, # Tablas
               psych, # Correlaciones
               DescTools, # Tablas
               ggplot2, # graficos en general
               broom,
               rempsyc,
               FactoMineR, # analisis de correspondencia 
               factoextra # analisis de correspondencia
               )

options(scipen = 999) # para desactivar notacion cientifica
rm(list = ls()) # para limpiar el entorno de trabajo

Cargamos los datos directamente desde internet.

Código 
#cargamos la base de datos desde internet
load(url("https://dataverse.harvard.edu/api/access/datafile/7245118")) 

dim(elsoc_long_2016_2022.2)
[1] 18035   750

Contamos con 750 variables (columnas) y 18035 observaciones (filas).

Código 
proc_data <- elsoc_long_2016_2022.2 %>% filter(ola=="4") %>% 
  select(constitucion=c29, # Confianza generalizada
         educacion=m01,# nivel educacional
         coalicion=c17, # coalicion politica
         aut_demo=c25 # autoritarismo o democracia
         ) 

proc_data <- proc_data %>% sjlabelled::set_na(., na = c(-999, -888, -777, -666))
# Comprobar
names(proc_data)
[1] "constitucion" "educacion"    "coalicion"    "aut_demo"
Código 
proc_data$educacion <- car::recode(proc_data$educacion, "c(1,2,3)=1; c(4,5)=2; c(6,7,8,9,10)=3")

proc_data$educacion <- sjlabelled::set_labels(proc_data$educacion,
            labels=c( "Educación básica"=1,
                      "Educación media"=2,
                      "Educación superior"=3))

proc_data$constitucion <- sjlabelled::set_labels(proc_data$constitucion,
            labels=c( "Expertos"=1,
                      "Parlamento"=2,
                      "Asamblea"=3))

proc_data$coalicion <- sjlabelled::set_labels(proc_data$coalicion,
            labels=c( "Chile vamos"=1,
                      "Nueva mayoría"=2,
                      "Frente amplio"=3,
                      "Otro"=4,
                      "Ninguno"=5))

proc_data$aut_demo <- sjlabelled::set_labels(proc_data$aut_demo,
            labels=c( "Democracia"=1,
                      "Autoritarismo"=2,
                      "Da lo mismo"=3,
                      "Ninguno"=4))

sjmisc::frq(proc_data$educacion)
Nivel educacional (x) <numeric> 
# total N=3417 valid N=3413 mean=2.12 sd=0.75

Value |              Label |    N | Raw % | Valid % | Cum. %
------------------------------------------------------------
    1 |   Educación básica |  781 | 22.86 |   22.88 |  22.88
    2 |    Educación media | 1432 | 41.91 |   41.96 |  64.84
    3 | Educación superior | 1200 | 35.12 |   35.16 | 100.00
 <NA> |               <NA> |    4 |  0.12 |    <NA> |   <NA>
Código 
sjmisc::frq(proc_data$constitucion)
Mecanismo de cambio de Constitucion (x) <numeric> 
# total N=3417 valid N=3035 mean=2.51 sd=0.84

Value |      Label |    N | Raw % | Valid % | Cum. %
----------------------------------------------------
    1 |   Expertos |  701 | 20.52 |   23.10 |  23.10
    2 | Parlamento |   78 |  2.28 |    2.57 |  25.67
    3 |   Asamblea | 2256 | 66.02 |   74.33 | 100.00
 <NA> |       <NA> |  382 | 11.18 |    <NA> |   <NA>
Código 
sjmisc::frq(proc_data$coalicion)
Identificacion con coaliciones politicas (x) <numeric> 
# total N=3417 valid N=3316 mean=4.37 sd=1.29

Value |         Label |    N | Raw % | Valid % | Cum. %
-------------------------------------------------------
    1 |   Chile vamos |  266 |  7.78 |    8.02 |   8.02
    2 | Nueva mayoría |  179 |  5.24 |    5.40 |  13.42
    3 | Frente amplio |  234 |  6.85 |    7.06 |  20.48
    4 |          Otro |   20 |  0.59 |    0.60 |  21.08
    5 |       Ninguno | 2617 | 76.59 |   78.92 | 100.00
 <NA> |          <NA> |  101 |  2.96 |    <NA> |   <NA>
Código 
sjmisc::frq(proc_data$aut_demo)
Preferencia entre Autoritarismo y Democracia (x) <numeric> 
# total N=3417 valid N=3356 mean=1.79 sd=1.05

Value |         Label |    N | Raw % | Valid % | Cum. %
-------------------------------------------------------
    1 |    Democracia | 2011 | 58.85 |   59.92 |  59.92
    2 | Autoritarismo |  295 |  8.63 |    8.79 |  68.71
    3 |   Da lo mismo |  781 | 22.86 |   23.27 |  91.98
    4 |       Ninguno |  269 |  7.87 |    8.02 | 100.00
 <NA> |          <NA> |   61 |  1.79 |    <NA> |   <NA>
Código 
proc_data <- proc_data %>%
  mutate(across(everything(), sjlabelled::as_label))

Tablas de contingencia

Código 
sjPlot::sjt.xtab(var.row = proc_data$educacion, 
                 var.col = proc_data$constitucion, 
                 show.summary = F, 
                 emph.total = T, 
                 show.row.prc = T, # porcentaje fila
                 show.col.prc = T, # porcentaje columna
                 encoding= "UTF-8")
Nivel educacional Mecanismo de cambio
de Constitucion		 Total
Expertos Parlamento Asamblea
Educación básica 138
22.5 %
19.7 %		 30
4.9 %
38.5 %		 446
72.6 %
19.8 %		 614
100 %
20.3 %
Educación media 277
21.8 %
39.5 %		 31
2.4 %
39.7 %		 964
75.8 %
42.8 %		 1272
100 %
42 %
Educación superior 286
25 %
40.8 %		 17
1.5 %
21.8 %		 843
73.6 %
37.4 %		 1146
100 %
37.8 %
Total 701
23.1 %
100 %		 78
2.6 %
100 %		 2253
74.3 %
100 %		 3032
100 %
100 %

Prueba de hipótesis con Chi-cuadrado

cálculo directo en R:

Código 
chi_results1 <- chisq.test(table(proc_data$educacion, proc_data$constitucion))
stats.table <- tidy(chi_results1)
nice_table(stats.table)

statistic

p

parameter

Method

21.61

< .001***

4

Pearson's Chi-squared test

Código 
chi_results2 <- chisq.test(table(proc_data$educacion, proc_data$coalicion))
stats.table <- tidy(chi_results1)
nice_table(stats.table)

statistic

p

parameter

Method

21.61

< .001***

4

Pearson's Chi-squared test

Código 
chi_results3 <- chisq.test(table(proc_data$constitucion, proc_data$coalicion))
stats.table <- tidy(chi_results3)
nice_table(stats.table)

statistic

p

parameter

Method

76.40

< .001***

8

Pearson's Chi-squared test

Análisis de correspondencias simple

Código 
tabla <- prop.table(table(proc_data$educacion, proc_data$constitucion))
dimnames(tabla) <- list(educacion=c("Básica", "Media", "Universitaria"),
                        constitucion=c("Expertos", "Parlamento", "Asamblea")
                        )
tabla
               constitucion
educacion          Expertos  Parlamento    Asamblea
  Básica        0.045514512 0.009894459 0.147097625
  Media         0.091358839 0.010224274 0.317941953
  Universitaria 0.094327177 0.005606860 0.278034301
Código 
ACS <- CA(tabla, ncp=2, graph = FALSE)
summary(ACS)

Call:
CA(X = tabla, ncp = 2, graph = FALSE) 

The chi square of independence between the two variables is equal to 0.007128577 (p-value =  0.9999937 ).

Eigenvalues
                       Dim.1   Dim.2
Variance               0.006   0.001
% of var.             88.450  11.550
Cumulative % of var.  88.450 100.000

Rows
                Iner*1000    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
Básica        |     4.325 |  0.144 66.923  0.976 |  0.023 12.826  0.024 |
Media         |     0.481 | -0.003  0.052  0.007 | -0.034 57.995  0.993 |
Universitaria |     2.322 | -0.074 33.024  0.897 |  0.025 29.179  0.103 |

Columns
                Iner*1000    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
Expertos      |     0.915 | -0.037  5.146  0.355 |  0.051 71.734  0.645 |
Parlamento    |     5.986 |  0.481 94.558  0.996 |  0.030  2.869  0.004 |
Asamblea      |     0.228 | -0.005  0.296  0.082 | -0.017 25.397  0.918 |

La salida del análisis de correspondencia simple nos entrega distintos atributos que es interesante mirar:

  • Eigenvalues: En un ACS tenemos un ‘autovalor’ por cada dimensión que nos entrega la varianza total de las variables que representa nuestro análisis y, además, un porcentaje de la varianza asociado a cada dimensión.

  • En cada fila y columna, nos entrega distintos valores, de los cuales nos interesan dos principales ‘ctr’ y ‘cos2’.

    • ctr: Es la contribución que cada categoría de la variable le da a cada dimensión (horizontal o vertical)

    • cos2: Es nuestra medida de calidad de nuestra medición. De la misma forma que la ‘contribución’, cada variable le entrega una mayor o menor calidad a nuestro análisis.

Ahora veamos estos mismos valores en un gráfico:

Código 
#Representación simultánea
plot.CA(ACS)

Tenemos las mismas dos dimensiones, una horizontal (Dim 1) que representa el 88.45% de la varianza de nuestras variables y una dimensión vertical (Dim 2) que representa el 11.5% de la varianza. Esto se representa gráficamente en que la mayoría de las variables están más distantes horizontalmente que verticalmente. Además, la mayor contribución a la varianza de la dimensión 1 está por las categorías Universitaria (33.024), Básica (66.923) y Parlamento (94.558)

Probemos otra correspondencia simple

Código 
tabla <- prop.table(table(proc_data$educacion, proc_data$aut_demo))
dimnames(tabla) <- list(educacion=c("Básica", "Media", "Universitaria"),
                        aut_demo=c("Democracia", "Autoritarismo", "Da lo mismo","Ninguno")
                        )
tabla
               aut_demo
educacion       Democracia Autoritarismo Da lo mismo    Ninguno
  Básica        0.10680191    0.01998807  0.07875895 0.02058473
  Media         0.23359189    0.03550119  0.11634845 0.03490453
  Universitaria 0.25924821    0.03251790  0.03729117 0.02446301
Código 
ACS <- CA(tabla, ncp=2, graph = FALSE)
summary(ACS)

Call:
CA(X = tabla, ncp = 2, graph = FALSE) 

The chi square of independence between the two variables is equal to 0.06017212 (p-value =  0.9999956 ).

Eigenvalues
                       Dim.1   Dim.2
Variance               0.060   0.000
% of var.             99.875   0.125
Cumulative % of var.  99.875 100.000

Rows
                Iner*1000    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
Básica        |    19.531 |  0.294 32.443  0.998 |  0.012 44.944  0.002 |
Media         |     5.028 |  0.109  8.304  0.993 | -0.009 49.662  0.007 |
Universitaria |    35.614 | -0.317 59.254  1.000 |  0.003  5.394  0.000 |

Columns
                Iner*1000    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
Democracia    |    18.006 | -0.173 29.949  1.000 | -0.003  9.468  0.000 |
Autoritarismo |     0.124 | -0.027  0.107  0.518 |  0.026 79.512  0.482 |
Da lo mismo   |    41.134 |  0.421 68.441  1.000 | -0.004  4.276  0.000 |
Ninguno       |     0.908 |  0.106  1.503  0.994 |  0.008  6.744  0.006 |
Código 
#Representación simultánea
plot.CA(ACS)

Y con más categorías de respuesta?

Código 
tabla <- prop.table(table(proc_data$educacion, proc_data$coalicion))
dimnames(tabla) <- list(educacion=c("Básica", "Media", "Universitaria"),
                        coalicion=c("Chile vamos", "Nueva mayoría", "Frente Amplio", "Otro", "Ninguno")
                        )
tabla
               coalicion
educacion       Chile vamos Nueva mayoría Frente Amplio        Otro     Ninguno
  Básica        0.018412315   0.012677332   0.008753396 0.000000000 0.185934199
  Media         0.029882282   0.017506791   0.022638092 0.002112889 0.347721099
  Universitaria 0.031995171   0.023845457   0.039239360 0.003923936 0.255357682
Código 
ACS <- CA(tabla, ncp=2, graph = FALSE)
summary(ACS)

Call:
CA(X = tabla, ncp = 2, graph = FALSE) 

The chi square of independence between the two variables is equal to 0.02238892 (p-value =  1 ).

Eigenvalues
                       Dim.1   Dim.2
Variance               0.021   0.002
% of var.             92.772   7.228
Cumulative % of var.  92.772 100.000

Rows
                Iner*1000    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
Básica        |     4.972 | -0.134 19.419  0.811 |  0.064 58.004  0.189 |
Media         |     4.164 | -0.091 16.838  0.840 | -0.040 41.176  0.160 |
Universitaria |    13.253 |  0.193 63.744  0.999 |  0.006  0.820  0.001 |

Columns
                Iner*1000    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
Chile vamos   |     0.881 |  0.086  2.866  0.676 |  0.060 17.633  0.324 |
Nueva mayoría |     2.354 |  0.169  7.441  0.656 |  0.122 49.971  0.344 |
Frente Amplio |    12.973 |  0.427 62.062  0.994 | -0.034  5.119  0.006 |
Otro          |     2.922 |  0.650 12.285  0.873 | -0.248 22.892  0.127 |
Ninguno       |     3.259 | -0.064 15.346  0.978 | -0.009  4.384  0.022 |
Código 
#Representación simultánea
plot.CA(ACS)

Y si juntamos otras? ¿cuál sería nuestra variable dependiente?

Código 
tabla <- prop.table(table(proc_data$coalicion, proc_data$aut_demo))
dimnames(tabla) <- list(coalicion=c("Chile vamos", "Nueva mayoría", "Frente Amplio", "Otro", "Ninguno"),
                        aut_demo=c("Democracia", "Autoritarismo", "Da lo mismo","Ninguno")
                        )
tabla
               aut_demo
coalicion         Democracia Autoritarismo  Da lo mismo      Ninguno
  Chile vamos   0.0459418070  0.0156202144 0.0165390505 0.0021439510
  Nueva mayoría 0.0392036753  0.0055130168 0.0079632466 0.0015313936
  Frente Amplio 0.0581929556  0.0033690658 0.0088820827 0.0009188361
  Otro          0.0049004594  0.0006125574 0.0003062787 0.0003062787
  Ninguno       0.4532924962  0.0606431853 0.1996937213 0.0744257274
Código 
ACS <- CA(tabla, ncp=3, graph = FALSE)
Código 
#Representación simultánea
plot.CA(ACS)

Análisis de correspondencia múltiple

Código 
ACM <- dplyr::select(proc_data, constitucion, coalicion, aut_demo) %>% na.omit() %>% 
    MCA(, graph = FALSE)
summary(ACM)

Call:
MCA(X = ., graph = FALSE) 


Eigenvalues
                       Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
Variance               0.423   0.383   0.343   0.339   0.330   0.325   0.298
% of var.             14.099  12.779  11.424  11.292  11.015  10.826   9.925
Cumulative % of var.  14.099  26.879  38.302  49.595  60.609  71.436  81.360
                       Dim.8   Dim.9
Variance               0.285   0.274
% of var.              9.502   9.138
Cumulative % of var.  90.862 100.000

Individuals (the 10 first)
                           Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
1                       | -0.235  0.004  0.040 | -0.691  0.042  0.347 |  0.271
2                       | -0.235  0.004  0.040 | -0.691  0.042  0.347 |  0.271
3                       | -0.235  0.004  0.040 | -0.691  0.042  0.347 |  0.271
4                       |  1.502  0.182  0.460 |  0.590  0.031  0.071 | -0.420
5                       | -0.235  0.004  0.040 | -0.691  0.042  0.347 |  0.271
6                       | -0.372  0.011  0.333 |  0.056  0.000  0.008 | -0.077
7                       |  0.739  0.044  0.141 |  0.633  0.036  0.103 | -0.041
8                       | -0.235  0.004  0.040 | -0.691  0.042  0.347 |  0.271
9                       | -0.372  0.011  0.333 |  0.056  0.000  0.008 | -0.077
10                      |  0.430  0.015  0.011 | -1.172  0.122  0.078 |  1.958
                           ctr   cos2  
1                        0.007  0.053 |
2                        0.007  0.053 |
3                        0.007  0.053 |
4                        0.018  0.036 |
5                        0.007  0.053 |
6                        0.001  0.014 |
7                        0.000  0.000 |
8                        0.007  0.053 |
9                        0.001  0.014 |
10                       0.382  0.218 |

Categories (the 10 first)
                            Dim.1     ctr    cos2  v.test     Dim.2     ctr
Expertos                |   1.104  21.972   0.361  32.539 |  -0.063   0.079
Parlamento              |   1.365   3.658   0.048  11.808 |   0.032   0.002
Asamblea                |  -0.384   8.667   0.434 -35.641 |   0.018   0.022
coalicion_Chile vamos   |   2.063  28.606   0.397  34.094 |   0.679   3.420
coalicion_Nueva mayoría |  -0.223   0.234   0.003  -3.039 |   1.433  10.658
coalicion_Frente amplio |  -1.009   6.270   0.086 -15.899 |   1.884  24.121
coalicion_Otro          |  -0.262   0.035   0.000  -1.147 |   1.832   1.893
coalicion_Ninguno       |  -0.107   0.690   0.038 -10.566 |  -0.393  10.337
aut_demo_Democracia     |  -0.236   2.726   0.091 -16.354 |   0.479  12.408
aut_demo_Autoritarismo  |   1.964  26.155   0.363  32.613 |   0.369   1.020
                           cos2  v.test     Dim.3     ctr    cos2  v.test  
Expertos                  0.001  -1.857 |  -0.610   8.270   0.110 -17.969 |
Parlamento                0.000   0.273 |   3.927  37.368   0.394  33.972 |
Asamblea                  0.001   1.695 |   0.056   0.226   0.009   5.175 |
coalicion_Chile vamos     0.043  11.223 |  -0.005   0.000   0.000  -0.087 |
coalicion_Nueva mayoría   0.130  19.541 |   1.854  19.960   0.218  25.284 |
coalicion_Frente amplio   0.301  29.690 |  -0.215   0.351   0.004  -3.388 |
coalicion_Otro            0.022   8.011 |  -6.446  26.208   0.271 -28.185 |
coalicion_Ninguno         0.518 -38.937 |  -0.067   0.337   0.015  -6.646 |
aut_demo_Democracia       0.377  33.216 |  -0.123   0.918   0.025  -8.540 |
aut_demo_Autoritarismo    0.013   6.130 |  -0.031   0.008   0.000  -0.515 |

Categorical variables (eta2)
                          Dim.1 Dim.2 Dim.3  
constitucion            | 0.435 0.001 0.472 |
coalicion               | 0.455 0.580 0.482 |
aut_demo                | 0.379 0.569 0.075 |

Eigen values / Varianza

Siguiendo la lógica del análisis que existe en el Análisis de Componentes Principales, que permite “reducir” las dimensiones de un data frame a partir de generar nuevos ejes o componentes que sirven a manera de “resumen” de las variables cuantitativas originales, en el análisis MCA también es posible construir dichos componentes o ejes a partir de variables categóricas.

Una vez que se generan los nuevos componentes, es importante identificar la capacidad explicativa del total de los casos que cada una proporciona. Para ello es importante revisar la proporción de varianzas que “retiene” cada una de estas dimensiones o ejes. Y puede ser extraído a partir de la función get_eigenvalue() de la siguiente manera:

Código 
eig_val <- factoextra::get_eigenvalue(ACM)
head(eig_val, 10)
      eigenvalue variance.percent cumulative.variance.percent
Dim.1  0.4229843        14.099478                    14.09948
Dim.2  0.3833712        12.779041                    26.87852
Dim.3  0.3427139        11.423796                    38.30231
Dim.4  0.3387669        11.292229                    49.59454
Dim.5  0.3304430        11.014766                    60.60931
Dim.6  0.3247917        10.826389                    71.43570
Dim.7  0.2977398         9.924659                    81.36036
Dim.8  0.2850535         9.501784                    90.86214
Dim.9  0.2741358         9.137859                   100.00000

En la tabla anterior se muestran del lado de las columnas los componentes o ejes nuevos, resultados del análisis MCA, mientras que en la primer columna se muestran los eigenvalores o el tamaño de las varianzas que explica cada uno, mientras que en la segunda columna se muestra el porcentaje de la varianza total que es explicado por cada eje o dimensión. En la tercer columna se muestra el porcentaje de varianza acumulado.

También es posible visualizar los porcentajes de varianza explicados por cada dimensión MCA, a partir de usar el comando fviz_screeplot(), con el que se puede crear un “scree plot.”

Código 
fviz_screeplot(ACM, addlabels = TRUE)

Si una dimensión explica, por ejemplo, el 14.1% de la inercia o varianza, significa que la mayoría de la variabilidad en las relaciones entre categorías puede entenderse a través de esta dimensión.

Es importante interpretar el contenido de cada dimensión. A menudo, la primera dimensión puede representar la principal diferencia entre grupos de categorías (por ejemplo, ideología política en una encuesta de actitudes), mientras que la segunda dimensión podría representar una diferencia secundaria (como la educación o el nivel socioeconómico).

Representación gráfica

Código 
fviz_mca_var(ACM, #objeto tipo lista con resultados mca
             col.var = "contrib", #definición de los colores a partir del valor cos2
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), #definición de la paleta de colores
             repel = TRUE, # evitar solapamientos de etiquetas,
             max.overlaps = "ggrepel.max.overlaps", #aumentar el tamaño de solapamientos
             ggtheme = theme_minimal()
             )

Podemos interpretar este gráfico de una forma similar al de un ACS, pero además podemos identificar de mejor manera la agrupación de ciertas categorías de variables. ¿Existe algún patrón que identificar?

Con todas las variables

Código 
ACM <- proc_data %>% na.omit() %>% 
    MCA(, graph = FALSE)
Código 
fviz_screeplot(ACM, addlabels = TRUE)

Código 
fviz_mca_var(ACM, #objeto tipo lista con resultados mca
             col.var = "cos2", #definición de los colores a partir del valor cos2
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), #definición de la paleta de colores
             repel = TRUE, # evitar solapamientos de etiquetas,
             max.overlaps = "ggrepel.max.overlaps", #aumentar el tamaño de solapamientos
             ggtheme = theme_minimal()
             )