Fecha de publicación

28 de agosto 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
               gginference, # Visualizacion 
               rempsyc, # Reporte
               broom) # Varios

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(c29, # Confianza generalizada
         m01# nivel educacional
         )

proc_data <- proc_data %>% sjlabelled::set_na(., na = c(-999, -888, -777, -666))
# Comprobar
names(proc_data)
[1] "c29" "m01"
Código 
proc_data$educacion <- car::recode(proc_data$m01, "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))

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>

Tablas de contingencia

Una tabla de contingencia es una de las maneras más simples y útiles para representar el cruce entre dos variables categóricas.

Con ella, podemos obtener en las celdas las frecuencias conjuntas entre ambas variables, es decir, cuántos casos de una determinada categoría de la variable Y ocurren conjuntamente con una determinada categoría de la variable X.

Además, podemos presentar los totales de cada fila y columna al exterior de la tabla, también conocidas como frecuencias marginales.

Veamos un ejemplo con ss_salud y universitaria:

Código 
sjPlot::sjt.xtab(var.row = proc_data$educacion, var.col = proc_data$c29, 
                 show.summary = F, emph.total = T, encoding = "UTF-8")
Nivel educacional Mecanismo de cambio
de Constitucion		 Total
Que sea un grupo de
expertos los que
redacten una nueva
Constitucion		 Que el parlamento
redacte una nueva
Constitucion		 Que los ciudadanos
elijan una Asamblea
constituyente para
que redacte una
nueva Constitucion
Educación básica 138 30 446 614
Educación media 277 31 964 1272
Educación superior 286 17 843 1146
Total 701 78 2253 3032

Sumado a esto, tenemos:

  • Frecuencias absolutas: números que aparencen en la tabla (ya sean conjuntas o marginales)

  • Frecuencias relativas:

    • porcentaje fila: % que cada frecuencia conjunta representa sobre la marginal de su fila
    • porcentaje columna: % que cada frecuencia conjunta representa sobre la marginal de su columna
    • porcentaje total: % que cada frecuencia conjunta representa sobre el número total de casos de la tabla

Veamos cómo incorporar el porcentaje fila y columna en la tabla.

Código 
sjPlot::sjt.xtab(var.row = proc_data$educacion, 
                 var.col = proc_data$c29, 
                 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
Que sea un grupo de
expertos los que
redacten una nueva
Constitucion		 Que el parlamento
redacte una nueva
Constitucion		 Que los ciudadanos
elijan una Asamblea
constituyente para
que redacte una
nueva Constitucion
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 %

Aquí, los porcentajes fila aparecen en azul y los porcentajes columna en verde.

Prueba de hipótesis con Chi-cuadrado

cálculo directo en R:

Código 
chi_results <- chisq.test(table(proc_data$educacion, proc_data$c29))

stats.table <- tidy(chi_results, conf_int = T)
nice_table(stats.table)

Visualicemos la distribución de esta prueba y su zona de rechazo.

Código 
ggchisqtest(chi_results)

Análisis de correspondencias simple

Código 
pacman::p_load(ade4, FactoMineR, factoextra)

  There is a binary version available but the source version is later:
                binary   source needs_compilation
RcppArmadillo 14.0.2-1 14.2.0-1              TRUE

  Binaries will be installed
package 'pixmap' successfully unpacked and MD5 sums checked
package 'sp' successfully unpacked and MD5 sums checked
package 'RcppArmadillo' successfully unpacked and MD5 sums checked
package 'ade4' successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\danie\AppData\Local\Temp\Rtmp88h1j1\downloaded_packages
package 'crosstalk' successfully unpacked and MD5 sums checked
package 'DT' successfully unpacked and MD5 sums checked
package 'ellipse' successfully unpacked and MD5 sums checked
package 'flashClust' successfully unpacked and MD5 sums checked
package 'leaps' successfully unpacked and MD5 sums checked
package 'multcompView' successfully unpacked and MD5 sums checked
package 'scatterplot3d' successfully unpacked and MD5 sums checked
package 'FactoMineR' successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\danie\AppData\Local\Temp\Rtmp88h1j1\downloaded_packages
package 'dendextend' successfully unpacked and MD5 sums checked
package 'factoextra' successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\danie\AppData\Local\Temp\Rtmp88h1j1\downloaded_packages
Código 
proc_data <- proc_data %>% select(-m01)
tabla <- prop.table(table(proc_data$educacion, proc_data$c29))
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 
chisq.test(tabla)

    Pearson's Chi-squared test

data:  tabla
X-squared = 0.0071286, df = 4, p-value = 1
Código 
ACS <- CA(tabla, ncp=2, graph = FALSE)
Código 
#Perfiles fila
variables_fila=get_ca_row(ACS)
variables_fila$inertia
[1] 0.0043252569 0.0004808203 0.0023224997
Código 
#Nube de individuos fila
fviz_ca_row(ACS, repel = TRUE)+ggtitle("") + ylab("Eje 2(11.55%)")+xlab("Eje 1(88.45%)")+ylim(-0.5,.5)+xlim(-.5,.5)

Código 
#Perfiles columna
variables_columna=get_ca_col(ACS)
variables_columna$inertia
[1] 0.0009150867 0.0059857229 0.0002277674
Código 
#Nube de individuos columna
fviz_ca_col(ACS)+ggtitle("")+ylab("Eje 2(11.55%)")+xlab("Eje 1(88.45%)")+ylim(-0.5,.5)+xlim(-0.5,.5)

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