Análisis de Componentes Principales para clasificar superhéroes

Soy aficionado a los superhéroes. Muy aficionado. Hasta podría atribuir mi gusto a la lectura a los cómics de Superman y Batman cuando era pequeño, y que haya sobrevivido a la pubertad y adolescencia a los cómics de los X-Men.

Así que, cuando me encontré con un conjunto de datos con información de superhéroes y sus poderes, se me ocurrió que sería el pretexto perfecto para hablar sobre el Análisis de Componentes Principales y cómo podemos usarlo para caracterizar o clasificar datos.

Hasta podríamos ser ambiciosos y decir que esta es una forma no supervisada de aprendizaje automático, pero nos basta saber que con Análisis de Componentes Principales tenemos una herramienta para entender y describir mejor nuestros datos.

En este documento revisaremos como implementar el Análisis de Componentes Principales usando el paquete psych de R, y de paso aprenderemos un poco más sobre los superhéroes de DC Comics y Marvel Comics.

Justice League Vol 2 #40, ©DC Comics

Una introducción (muy) informal al Análisis de Componentes Principales

El Análisis de Componentes Principales es, en realidad, un procedimiento bastante complejo que involucra álgebra lineal y tiene diferentes usos e interpretaciones dependiendo del campo de aplicación.

Introducciones formales al PCA pueden ser encontradas en los siguientes enlaces:

Nosotros utilizaremos PCA como una manera de encontrar una estructura subyacente a nuestros datos. Específicamente, vamos a explorar la posibilidad de que los poderes de los superhéroes de DC y Marvel forman grupos que pueden caracterizar a los personajes.

Partimos de tres supuesto generales.

  • Nuestras variables tienen correlaciones entre sí
  • Estas correlaciones entre variables forman grupos, llamados componentes, pues “apuntan” en la misma dirección
  • Los componentes que se forman son diferentes entre sí

Es decir, suponemos hay poderes relacionados entre sí, por ejemplo, volar y tener fuerza sobrehumana o súper velocidad y resistencia física sobrehumana.

Suponemos que esos poderes pueden agruparse entre sí, y que esos grupos no son iguales. Podríamos decir que esos grupos, o componentes, corresponden a un arquetipo de superhéroe. En este ejemplo, poderes de “superhumano” y poderes de “velocista”.

Entonces, con estos componentes podríamos clasificar a nuestros superhéroes en diferentes arquetipos, Flash como “velocista”, Sentry como “superhumano”, etcétera.

Veamos si lo logramos, empezando por preparar nuestro entorno de trabajo.

Paquetes necesarios

Estos son los paquetes que utilizaremos.

  • tidyverse: Como de costumbre, usaremos la familia de paquetes tidyverse para importar, manipular, procesar, visualizar y exportar datos.
  • psych: Un paquete dedicado a funciones psicométricas. Utilizaremos su implementación de Análisis de Componentes Principales.
library(tidyverse)library(psych)

Si no cuentas con estos paquetes, puedes instalarlos con install.packages().

Lectura de datos

Usaremos el conjunto de datos “Super Hero Dataset”, disponible en Kaggle.

He alojado una copia de estos datos en Github que puede ser descargada usando download.file()

download.file("https://github.com/jboscomendoza/rpubs/raw/master/pca_superheroes/superhero-set.zip", destfile = "superhero-set.zip")

De esta manera obtenemos un archivo .zip. Extraemos su contenido en nuestra carpeta de trabajo con unzip().

unzip("superhero-set.zip")

Esto nos dejará con dos archivos:

  • heroes_information.csv que contiene los nombres de los personajes, su información biográfica, características físicas y editorial que los publica.
  • super_hero_powers.csv que contiene los nombres de los personajes y los poderes que poseen.

Importación de los datos

Para este análisis, usaremos los datos de sólo dos editoriales: DC Comics y Marvel Comics. Esto, por dos razones.

En primer lugar, porque estas dos editoriales son las más grandes y tienen una larga tradición publicando cómics de superhéroes, sus personajes tienden a seguir una línea editorial más o menos consistente; en segundo lugar, dado que conozco mejor a los personajes de estas dos editoriales, es más fácil que interprete los resultados y juzgue si tienen sentido o no. Como siempre, el conocimiento disciplinar es importante.

Empezamos por importar la información de los superhéroes.

Usamos la función read_csv() de readr para leer los archivos .csv, después select() de dplyr para elegir las columnas que conservaremos (nombre del personaje y editorial), y por último filter(), también de dplyr para filtrar sólo los datos de las editoriales DC y Marvel.

dc_marvel <-  read_csv("heroes_information.csv") %>%  select(name, Publisher) %>%  filter(Publisher %in% c("DC Comics", "Marvel Comics"))
## Warning: Missing column names filled in: 'X1' [1]
## Parsed with column specification:
## cols(
##   X1 = col_integer(),
##   name = col_character(),
##   Gender = col_character(),
##   `Eye color` = col_character(),
##   Race = col_character(),
##   `Hair color` = col_character(),
##   Height = col_double(),
##   Publisher = col_character(),
##   `Skin color` = col_character(),
##   Alignment = col_character(),
##   Weight = col_double()
## )
# Resultados
dc_marvel
## # A tibble: 603 x 2
##    name          Publisher    
##    <chr>         <chr>        
##  1 A-Bomb        Marvel Comics
##  2 Abin Sur      DC Comics    
##  3 Abomination   Marvel Comics
##  4 Abraxas       Marvel Comics
##  5 Absorbing Man Marvel Comics
##  6 Adam Strange  DC Comics    
##  7 Agent 13      Marvel Comics
##  8 Agent Bob     Marvel Comics
##  9 Agent Zero    Marvel Comics
## 10 Air-Walker    Marvel Comics
## # ... with 593 more rows

Importamos los poderes de los personajes.

heroe_poderes <- read_csv("super_hero_powers.csv")
## Parsed with column specification:
## cols(
##   .default = col_character()
## )
## See spec(...) for full column specifications.
# Resultados
heroe_poderes
## # A tibble: 667 x 168
##    hero_names  Agility `Accelerated Hea~ `Lantern Power ~ `Dimensional Aw~
##    <chr>       <chr>   <chr>             <chr>            <chr>           
##  1 3-D Man     True    False             False            False           
##  2 A-Bomb      False   True              False            False           
##  3 Abe Sapien  True    True              False            False           
##  4 Abin Sur    False   False             True             False           
##  5 Abomination False   True              False            False           
##  6 Abraxas     False   False             False            True            
##  7 Absorbing ~ False   False             False            False           
##  8 Adam Monroe False   True              False            False           
##  9 Adam Stran~ False   False             False            False           
## 10 Agent Bob   False   False             False            False  
## #   [truncado para mejorar la presentación]

Como en este segundo conjunto de datos no tenemos un identificador de editorial, filtramos utilizando los datos de dc_marvel para quedarmos con los personajes de DC y Marvel.

heroe_poderes <-
  heroe_poderes %>%
  filter(hero_names %in% dc_marvel$name)

El siguiente paso es procesar nuestros datos para el análisis.

Procesamiento de los datos

Los nombres de nuestros datos nos darán problemas más adelantes si los dejamos como están. Los espacios en los nombres de columnas pueden producir errores o comportamientos imprevistos, así que los quitaremos, lo mismo que el resto de signos de puntuación. Ambos serán reemplazados por guiones bajos (“_“) usando Regular Expressions (regex) y la función gsub().

names(heroe_poderes) <-
  names(heroe_poderes) %>%
  tolower() %>%
  gsub("\\W+", "_", .)

Creamos dos data frames diferentes, una con los nombres de los personajes y otra con los poderes.

# Personajes
heroe <- select(heroe_poderes, hero_names)

# Poderes
poderes <- select(heroe_poderes, -hero_names)

Poderes escasos y abundantes

Como vimos más arriba, los poderes que tienen los personajes están codificados como cadenas de texto “True” y “False”, recodificamos a 1 y 0, respectivamente, para poder hacer cálculos numéricos.

poderes <-
  map_df(poderes, ~ifelse(. == "True", 1, 0))

Hecho esto, podemos calcular cuántos personajes tienen un poder en particular a partir de la suma de valores de una columna. Veamos cuántos personajes tienen “grito sónico”.

sum(poderes$sonic_scream)
## [1] 5

Podríamos apostar a que uno de ellos es “Banshee”.

Usando map() de dplyr, obtenemos la suma anterior para todos los poderes. De esto sabremos cuáles poderes son los más y menos comunes. Con esta información podremos detectar outliers: poderes muy raros o muy comunes.

Si omitimos estos poderes al realizar PCA obtendremos mejores resultados, pues los este método es sensible a valores extremos.

index_poderes <- map_dbl(poderes, sum)

Veamos la distribución de los poderes con una curva de densidad.

plot(density(index_poderes), main = "Frecuencia de poderes")

Ahora veamos los cinco poderes más y menos comunes, con ayuda de sort() y head().

# Más comunes
head(sort(index_poderes, decreasing = TRUE), 5)
## super_strength        stamina     durability    super_speed         flight 
##            302            228            215            207            191
# Menos comunes
head(sort(index_poderes), 5)
##       hyperkinesis     thirstokinesis     changing_armor 
##                  0                  0                  0 
##  spatial_awareness intuitive_aptitude 
##                  0                  0

Tenemos poderes que ningún personaje en nuestros datos posee, así que podemos omitirlos sin ningún problema. También podemos omitir aquellos poderes que sólo aparecen en una ocasión, pues es probable que tampoco aporten mucha información.

También tenemos poderes que más de 200 personajes poseen. Esto es casi 30% de nuestros personajes. Estos poderes quizás no ayuden a crear grupos distintos entre sí, así que haremos el análisis sin ellos.

La manera de quitar estos poderes es un poco enredada, pero consiste en usar sus índices de posición en el vector index_poderes, para así hacer una selección de columnas a conservar.

poderes <- poderes[(index_poderes > 4 & index_poderes < 150)]
# Tamaño nuevo de poderes
dim(poderes)
## [1] 521 116
# Histograma nuevo de poderes
map_dbl(poderes, sum) %>% 
  density() %>% 
  plot(main = "Frecuencia de poderes")

Personajes muy poderosos

También quitaremos a los personajes que no tiene ningún poder y a aquellos que tienen un número muy alto de ellos. Estos datos también pueden ser considerados como outliers.

Para descubrir quienes son estos personajes, usamos la función rowSums().

index_heroe <- rowSums(poderes)
# Resultado
index_heroe
##   [1]  4  1  5 11  9  7  1  5  3  2 11 38  1 12  0  4  5  1  2  6 20 11 17
##  [24]  2  9 18  6  3  0 12  3  2  2  7  3  1  3  1  1  5  6  2  8  2  4  0
##  [47]  6  4  2 12  6  1  5  2 10  9  1  4 15  5  1  2  2  2  1  6 16  5  9
##  [70]  7  7  3  8  1  6  3 13 11  7  5  1  2  7  2  1  2  1  1  8  6  8  1
##  [93]  1  9  5 14  1  7  3  1  2  7  1  1 23  5  3  7 22  4  2 26  4 21  7
## [116] 11  2  6  3  0  4  1  3  3  2 13  3  5  5  5  0  3  1  4  7 13  6  3
## [139]  9  6 23  4 13  9 14  3  6  7  4  4  2  0  8  3 19  6 17  3  0 14  5
## [162] 10 24  7  1  1  9  3 11 11  8 14  7 11  1  3 14 14  6  1  6  6  4  5
## [185] 19  8 10 10  6  2 21  3  1 24  4  8  1 14  1 14  3  2 10  2  1  1 10
## [208]  0  4  4  5  4  0  0 10  7 10  7  5  3  4  2  5  1  1 11  5  6  4  1
## [231]  2  7 13  8  2  3 16  7 12 12  8  5  3  7 16 16  2  5  5 12  2  8  1
## [254]  4 10  3  6  2  3  5  4  4  6  5  7  1  8  5  4 13  5  3  2 10  9  1
## [277]  6  3  0 19  7  2  1  2  1 30 10 10  9  4  3  1  3 13  1  1  6  2  8
## [300]  6  9  5 11 12 29 10 11  1  5  2  6 13 11  5  4  4  1  6  2 12  4  4
## [323]  2 29 18  4  2  5  4  4  2  0  3  0  1 11 10 11  5  3  1  2  2  6  6
## [346]  2 17 25 10 23 19  1  4  6  7  1  1  3  1 16  3  9  1  8  7 18  8  3
## [369]  1 10  6  5  1  1  2  2  3  4 12  2  3  5  7  4  1  8  4  1  1  7  2
## [392]  5  3  4  4  1  9  2  3 13  4  9  2  2 10  6 12  3  5  2 17  6  3  8
## [415]  3  2  5  2  4  7  7 12  1  1 14  3 10  4 11  2  2  3  6  0  7  2  9
## [438] 44  4  4 11 11 15  6  4  7  5  5  9  4  9 11  4 10  7  9 11 18 21 23
## [461] 12  7  1  6  3 25  1  6 11  4  0  3  3  1 11  2  1 13 15  0 10  1  4
## [484]  3 18  3  1  1 10  5  8 21  1  4  6 15 12  4  2 14  3  1  6  6 17  4
## [507]  3  6  4  6 17  4  6 25 13  9  2  2  4  7  3

Obtenemos una vector en el que cada valor representa el total de poderes por renglón, esto es, los poderes que posee cada personaje.

Demos un vistazo a cómo se distribuyen estos valores.

plot(density(index_heroe), "Distribución de héroe")

Más de treinta parece un abuso de poder, así que quitemos a esos personajes de nuestros datos (si te da curiosidad, son Amazo y Spectre).

Hacemos el filtrado, usando nuestro vector index_heroe para seleccionar los renglones que deseamos conservar.

heroe <- heroe[index_heroe > 0 & index_heroe < 30, ]

Tambien lo tenemos que hacer con poderes para que coincidan los tamaños de las tablas

poderes <- poderes[index_heroe > 0 & index_heroe < 30, ]
# Nueva distribución
rowSums(poderes) %>%
  density() %>%
  plot(main = "Distribución de héroe - Nuevo")

Ya estamos listos para para realizar PCA.

Análisis de Componentes Principales (PCA)

La implementación de PCA que usaremos requiere que especifiquemos a priori el número de componentes a extraer. Esto es algo que desconocemos.

Hay distintas maneras de llegar a un número razonable, que van desde partir de conocimiento disciplinario, hasta realizar manualmente múltiples análisis y elegir aquel que dé mejores resultados.

Nosotros haremos algo más eficiente.

Very Simple Structure

Para obtener un diagnóstico del número de componentes que podemos extraer, utilizaremos Very Simple Structure (VSS, Estructura Muy Simple). Este métodos trata de encontrar una estructura que explique la mayor proporción de varianza, con la menor complejidad posible.

Puedes leer más al respecto aquí:

Llamamos a VSS usando la función vss() de psych.

poderes_vss <- vss(poderes)
# Nuestro resultado
poderes_vss
## 
## Very Simple Structure
## Call: vss(x = poderes)
## Although the VSS complexity 1 shows  6  factors, it is probably more reasonable to think about  3  factors
## VSS complexity 2 achieves a maximimum of 0.51  with  8  factors
## 
## The Velicer MAP achieves a minimum of 0  with  8  factors 
## BIC achieves a minimum of  -24886.18  with  5  factors
## Sample Size adjusted BIC achieves a minimum of  -6372.34  with  8  factors
## 
## Statistics by number of factors 
##   vss1 vss2    map  dof chisq prob sqresid  fit RMSEA    BIC SABIC complex
## 1 0.20 0.00 0.0081 6554 18382    0     198 0.20 0.064 -22375 -1572     1.0
## 2 0.32 0.35 0.0067 6439 16215    0     161 0.35 0.059 -23826 -3388     1.2
## 3 0.36 0.42 0.0060 6325 14847    0     142 0.43 0.056 -24486 -4410     1.4
## 4 0.36 0.45 0.0057 6212 13918    0     131 0.47 0.054 -24712 -4995     1.7
## 5 0.38 0.48 0.0054 6100 13047    0     121 0.51 0.052 -24886 -5524     1.8
## 6 0.39 0.49 0.0053 5989 12396    0     113 0.54 0.050 -24847 -5837     2.0
## 7 0.39 0.50 0.0050 5879 11701    0     105 0.57 0.049 -24858 -6198     2.0
## 8 0.38 0.51 0.0049 5770 11195    0     100 0.60 0.048 -24687 -6372     2.1
##   eChisq  SRMR eCRMS   eBIC
## 1  47030 0.084 0.085   6274
## 2  32830 0.070 0.071  -7212
## 3  26222 0.063 0.064 -13110
## 4  22889 0.058 0.061 -15741
## 5  20015 0.055 0.057 -17918
## 6  17831 0.052 0.054 -19412
## 7  15661 0.048 0.052 -20898
## 8  14226 0.046 0.050 -21655

Estos resultados nos indican que VSS nos propone una estructura de ocho componentes. Probemos con ella

Ejecutando PCA

Usamos la función pca() de psych, aplicada a nuestro objeto poderes y con el argumento nfactors = 8 para ejecutar este procedimiento.

poderes_pca <- pca(r = poderes, nfactors = 8)

Puedes llamar al objeto poderes_pca para ver los resultados del PCA. Como es una salida extensa por el número de variables que tenemos, he decidido no mostrarla para hacer más legible este documento, pero tu puedes visualizarla si así lo deseas.

Obtenemos, entre otras cosas, las cargas de cada variable en cada componente. Podemos usarlas para comprobar que la correlación entre componentes sea baja.

Usamos cor() para verificar.

cor(poderes_pca$weights) %>% round(2)
##       RC2   RC1   RC4   RC3   RC5   RC7   RC8   RC6
## RC2  1.00 -0.05 -0.04 -0.09 -0.23 -0.16 -0.23 -0.08
## RC1 -0.05  1.00 -0.38 -0.05 -0.06 -0.23 -0.29  0.01
## RC4 -0.04 -0.38  1.00 -0.06 -0.04 -0.15 -0.07 -0.02
## RC3 -0.09 -0.05 -0.06  1.00 -0.17  0.04 -0.12 -0.15
## RC5 -0.23 -0.06 -0.04 -0.17  1.00 -0.02 -0.13 -0.04
## RC7 -0.16 -0.23 -0.15  0.04 -0.02  1.00 -0.17 -0.02
## RC8 -0.23 -0.29 -0.07 -0.12 -0.13 -0.17  1.00  0.03
## RC6 -0.08  0.01 -0.02 -0.15 -0.04 -0.02  0.03  1.00

La correlación más alta que tenemos es 0.38 entre el componente 1 y el 4, de modo que podemos decir que nuestros componentes son más o menos independientes entre sí.

Pero veamos algo mucho más interesante con las cargas de los componentes.

Cargas o pesos de los componentes

El principal resultado de PCA son las cargas o pesos que cada una de nuestras variables tiene con respecto a cada componente.

Podemos extraer del objeto poderes_pca y transformarlo a un data frame. Usamos la función rownames_to_column() de tibble para conservar los nombres de cada columna.

Podemos extraer del objeto poderes_pca y transformarlo a un data frame. Usamos la función rownames_to_column() de tibble para conservar los nombres de cada columna.

poderes_loadings <-
  poderes_pca$weights %>%
  data.frame() %>%
  rownames_to_column("poder") %>%
  tbl_df()
# Nuestro resultado
poderes_loadings
## # A tibble: 116 x 9
##    poder         RC2      RC1      RC4      RC3      RC5      RC7      RC8
##    <chr>       <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
##  1 acceler~  0.0359   4.19e-2 -0.00960  0.0856   0.00995 -0.00228  0.0629 
##  2 lantern~ -0.0145  -1.60e-5 -0.0275   0.00339  0.00167  0.125   -0.0565 
##  3 dimensi~ -0.0120   1.06e-1  0.0226   0.00558 -0.0146  -0.00656  0.00829
##  4 cold_re~ -0.0205  -3.50e-2 -0.0179  -0.0280   0.113   -0.0237   0.163  
##  5 stealth  -0.0188   9.65e-3  0.0181   0.0135   0.0627  -0.0155   0.00659
##  6 energy_~  0.0458  -1.22e-2 -0.0174   0.00365 -0.0452   0.102    0.0767 
##  7 danger_~ -0.00558  1.41e-2 -0.0140   0.174   -0.0403   0.0299   0.0110 
##  8 underwa~ -0.0307  -7.09e-3 -0.00747 -0.0154   0.177    0.0547  -0.0253 
##  9 marksma~ -0.00514 -1.84e-2 -0.00362 -0.00535  0.00301  0.0730   0.0227 
## 10 weapons~ -0.0141  -3.87e-3 -0.00500 -0.0496   0.00240  0.00708  0.0195 
## # ... with 106 more rows, and 1 more variable: RC6 <dbl>

El resultado es un data frame en el que los renglones son las variables, poderes en nuestro caso, y las columnas son los componentes. En cada celda se encuentra un número, que indica la carga que tiene la variable con el componente.

Entre mayor sea el valor de la carga de una variable con un componente, es mayor su relación con este. Los valores están expresados en puntuaciones estandarizadas Z, con media 0 y desviación estándar 1, por lo tanto tenemos positivos y negativos.

Para ilustrar esto, veamos los ocho componentes con los poderes que tienen las cargas más altas con ellos. Deberíamos observar poderes relacionados entre sí.

Usamos la función map() de purrr con los nombres de las columnas en nuestro data frame para obtener con una función anónima los poderes con mayor carga en cada componente. Nos apoyamos con la función arrange() de dplyr.

names(poderes_loadings[-1]) %>%
  map(function(x){
    poderes_loadings %>%
      select(poder, factor = x) %>%
      arrange(desc(factor))
  })
## [[1]]
## # A tibble: 116 x 2
##    poder              factor
##    <chr>               <dbl>
##  1 vision_microscopic 0.163 
##  2 vision_x_ray       0.158 
##  3 vision_heat        0.149 
##  4 super_breath       0.134 
##  5 vision_telescopic  0.131 
##  6 vision_infrared    0.111 
##  7 enhanced_hearing   0.104 
##  8 hypnokinesis       0.0948
##  9 enhanced_memory    0.0793
## 10 vision_thermal     0.0689
## # ... with 106 more rows
## 
## [[2]]
## # A tibble: 116 x 2
##    poder                 factor
##    <chr>                  <dbl>
##  1 time_manipulation     0.148 
##  2 time_travel           0.126 
##  3 reality_warping       0.121 
##  4 magic                 0.118 
##  5 teleportation         0.112 
##  6 dimensional_awareness 0.106 
##  7 animation             0.0967
##  8 weather_control       0.0947
##  9 dimensional_travel    0.0859
## 10 phasing               0.0808
## # ... with 106 more rows
## 
## [[3]]
## # A tibble: 116 x 2
##    poder                   factor
##    <chr>                    <dbl>
##  1 mind_control            0.189 
##  2 mind_blast              0.174 
##  3 astral_projection       0.163 
##  4 psionic_powers          0.157 
##  5 telekinesis             0.144 
##  6 illusions               0.138 
##  7 telepathy               0.137 
##  8 telepathy_resistance    0.113 
##  9 resurrection            0.0848
## 10 mind_control_resistance 0.0762
## # ... with 106 more rows
## 
## [[4]]
## # A tibble: 116 x 2
##    poder               factor
##    <chr>                <dbl>
##  1 wallcrawling        0.192 
##  2 web_creation        0.186 
##  3 danger_sense        0.174 
##  4 symbiote_costume    0.161 
##  5 natural_weapons     0.127 
##  6 substance_secretion 0.120 
##  7 jump                0.113 
##  8 camouflage          0.102 
##  9 animal_attributes   0.0954
## 10 accelerated_healing 0.0856
## # ... with 106 more rows
## 
## [[5]]
## # A tibble: 116 x 2
##    poder                factor
##    <chr>                 <dbl>
##  1 sub_mariner          0.213 
##  2 underwater_breathing 0.177 
##  3 water_control        0.172 
##  4 enhanced_smell       0.161 
##  5 enhanced_sight       0.155 
##  6 animal_control       0.122 
##  7 vision_night         0.118 
##  8 cold_resistance      0.113 
##  9 animal_attributes    0.0997
## 10 enhanced_hearing     0.0948
## # ... with 106 more rows
## 
## [[6]]
## # A tibble: 116 x 2
##    poder               factor
##    <chr>                <dbl>
##  1 energy_beams         0.177
##  2 energy_blasts        0.161
##  3 force_fields         0.155
##  4 energy_constructs    0.142
##  5 energy_armor         0.127
##  6 lantern_power_ring   0.125
##  7 heat_generation      0.112
##  8 invisibility         0.109
##  9 energy_manipulation  0.108
## 10 light_control        0.108
## # ... with 106 more rows
## 
## [[7]]
## # A tibble: 116 x 2
##    poder                        factor
##    <chr>                         <dbl>
##  1 heat_resistance               0.207
##  2 cold_resistance               0.163
##  3 fire_resistance               0.128
##  4 toxin_and_disease_resistance  0.127
##  5 invulnerability               0.122
##  6 self_sustenance               0.121
##  7 regeneration                  0.117
##  8 resurrection                  0.113
##  9 natural_armor                 0.111
## 10 immortality                   0.109
## # ... with 106 more rows
## 
## [[8]]
## # A tibble: 116 x 2
##    poder                        factor
##    <chr>                         <dbl>
##  1 weapons_master               0.236 
##  2 marksmanship                 0.211 
##  3 stealth                      0.194 
##  4 peak_human_condition         0.155 
##  5 intelligence                 0.120 
##  6 toxin_and_disease_resistance 0.115 
##  7 weapon_based_powers          0.113 
##  8 mind_control_resistance      0.105 
##  9 telepathy_resistance         0.0846
## 10 longevity                    0.0835
## # ... with 106 more rows

De un vistazo general, podemos identificar patrones al mostrar los poderes de esta manera. Por ejemplo, el primer componente parece haber agrupado poderes relacionas con sentidos sobrehumanos, en particular la visión; el tercero parece agrupar poderes psíquicos; y el sexto a habilidades relacionadas con energía de todo tipo.

Cabe señalar que de estos ocho componentes obtenidos, el primero es el que explica la mayor proporción de la varianza, seguido del segundo, después el tercero y así sucesivamente.

En nuestro caso esto implica que el primer componente caracteriza de una manera más cohesiva y clara a los poderes que el octavo. Esto es, podremos describir mejor a los superhéroes que compartan los poderes del primer componente que del octavo.

Guardemos de una vez un vector con los nombres posibles para cada uno de estos componentes y los asignamos al objeto poderes_loading.

poderes_nombres <- c("super_ojos", "divino", "psiquico", "spider_man",
                     "acuatico", "energia", "ladrillo", "vigilante")

# Asignamos nombres
names(poderes_loadings) <- c("poder", poderes_nombres)

Puntuaciones de cada componente

Podemos obtener una puntuación o score por componente de cada renglón. En nuestro caso, entre más alto sea esta puntuación, más relacionado está el conjunto de poderes de un personaje con cada componente en particular.

Esta información se encuentra almacenada en el objeto poderes_scores y también está expresada como una puntuación Z.

Extraemos la puntuación y la re escalamos a una media 500 y desviación estándar 100 para facilitar su interpretación. También le ponemos a cada columna el nombre provisional que tenemos a cada componente.

poderes_scores <-
  ((poderes_pca$scores * 100) + 500) %>%
  tbl_df() %>%
  bind_cols(heroe, .)
# Asignación de nombre
names(poderes_scores) <- c("heroe", poderes_nombres)
# Resultado
poderes_scores
## # A tibble: 502 x 9
##    heroe   super_ojos divino psiquico spider_man acuatico energia ladrillo
##    <chr>        <dbl>  <dbl>    <dbl>      <dbl>    <dbl>   <dbl>    <dbl>
##  1 A-Bomb        482.   487.     481.       530.     442.    434.     545.
##  2 Abin S~       460.   462.     451.       467.     464.    548.     413.
##  3 Abomin~       581.   603.     443.       471.     435.    376.     457.
##  4 Abraxas       448.   735.     468.       436.     445.    461.     644.
##  5 Absorb~       441.   445.     415.       487.     547.    498.     904.
##  6 Adam S~       485.   446.     447.       428.     562.    499.     552.
##  7 Agent ~       466.   465.     475.       468.     479.    454.     455.
##  8 Agent ~       489.   469.     436.       453.     454.    603.     502.
##  9 Air-Wa~       448.   494.     464.       449.     448.    480.     598.
## 10 Ajax          466.   437.     451.       466.     471.    548.     478.
## # ... with 492 more rows, and 1 more variable: vigilante <dbl>

De manera similar a como lo hicimos con los las cargas, podemos ver los personajes con las puntuaciones más altas en cada uno de los componentes usando sus nombres.

names(poderes_scores[-1]) %>%
  map(function(x){
    poderes_scores %>%
      select(heroe, Score = x) %>%
      arrange(desc(Score))
  }) %>% {
    names(.) <- poderes_nombres
    .
  }
## $super_ojos
## # A tibble: 502 x 2
##    heroe             Score
##    <chr>             <dbl>
##  1 Supergirl         1191.
##  2 Power Girl        1150.
##  3 Superboy-Prime    1147.
##  4 Superman          1089.
##  5 Martian Manhunter 1076.
##  6 Wonder Woman      1055.
##  7 Faora             1028.
##  8 General Zod       1028.
##  9 Krypto             971.
## 10 Hyperion           946.
## # ... with 492 more rows
## 
## $divino
## # A tibble: 502 x 2
##    heroe             Score
##    <chr>             <dbl>
##  1 Mister Mxyzptlk   1431.
##  2 One-Above-All     1247.
##  3 Franklin Richards 1077.
##  4 Odin              1049.
##  5 Dr Manhattan      1019.
##  6 Anti-Monitor      1006.
##  7 Doctor Strange     926.
##  8 Thanos             849.
##  9 Legion             776.
## 10 Silver Surfer      772.
## # ... with 492 more rows
## 
## $psiquico
## # A tibble: 502 x 2
##    heroe             Score
##    <chr>             <dbl>
##  1 Cable             1159.
##  2 Onslaught         1137.
##  3 Phoenix           1127.
##  4 Jean Grey         1053.
##  5 Emma Frost        1004.
##  6 Professor X        993.
##  7 Psylocke           962.
##  8 Exodus             953.
##  9 Martian Manhunter  913.
## 10 Darkseid           899.
## # ... with 492 more rows
## 
## $spider_man
## # A tibble: 502 x 2
##    heroe       Score
##    <chr>       <dbl>
##  1 Hybrid      1244.
##  2 Toxin       1211.
##  3 Carnage     1095.
##  4 Spider-Man  1048.
##  5 Anti-Venom  1036.
##  6 Venom       1035.
##  7 Silk        1030.
##  8 Venompool   1025.
##  9 Spider-Gwen  987.
## 10 Venom III    935.
## # ... with 492 more rows
## 
## $acuatico
## # A tibble: 502 x 2
##    heroe          Score
##    <chr>          <dbl>
##  1 Aquaman        1303.
##  2 Captain Planet 1213.
##  3 King Shark     1056.
##  4 Tiger Shark    1044.
##  5 Mera           1018.
##  6 Siren          1018.
##  7 Cheetah III     961.
##  8 Namor           950.
##  9 Wolverine       907.
## 10 Aqualad         831.
## # ... with 492 more rows
## 
## $energia
## # A tibble: 502 x 2
##    heroe        Score
##    <chr>        <dbl>
##  1 Iron Man     1030.
##  2 War Machine  1018.
##  3 Captain Atom 1011.
##  4 Ultron       1000.
##  5 Dazzler       971.
##  6 John Stewart  913.
##  7 Nova          911.
##  8 Hal Jordan    901.
##  9 Jessica Cruz  886.
## 10 Simon Baz     884.
## # ... with 492 more rows
## 
## $ladrillo
## # A tibble: 502 x 2
##    heroe          Score
##    <chr>          <dbl>
##  1 Hulk            969.
##  2 Doomsday        948.
##  3 Captain Marvel  920.
##  4 Thanos          913.
##  5 Absorbing Man   904.
##  6 Galactus        901.
##  7 Groot           875.
##  8 Captain Atom    869.
##  9 Offspring       862.
## 10 Ardina          857.
## # ... with 492 more rows
## 
## $vigilante
## # A tibble: 502 x 2
##    heroe           Score
##    <chr>           <dbl>
##  1 Deadpool         937.
##  2 Evil Deadpool    937.
##  3 Venompool        925.
##  4 Batman           844.
##  5 Cable            839.
##  6 Wonder Woman     797.
##  7 Elektra          790.
##  8 Black Panther    784.
##  9 Captain America  782.
## 10 Black Widow      772.
## # ... with 492 more rows

Definitivamente estamos observando patrones. Por ejemplo, el primer componente, efectivamente agrupa a personajes con sentidos sobrehumanos, en especial visión. Esto es característico de los personajes Kryptonianos, así que allí nos encontramos a Supergirl, Superman y Zod, entre otros.

El resto de los componentes también tienen sentido, algunos más que otros, pero en general estamos observando regularidades.

De hecho, podemos cambiar los nombres de los componentes a otros más apropiados, que corresponden a arquetipos de poderes.

poderes_nombres <- c("superman", "omnipotente", "psiquico", "spiderman",
                     "animal", "energia", "titan", "vigilante")
# Renombramos las columnas de poderes_scores
names(poderes_scores) <- c("heroe", poderes_nombres)

Ahora sí, podemos clasificar a nuestros superhéroes.

Puntuación de componente para clasificar

Podemos determinar a qué arquetipo pertenece un personaje usando su puntuación. Si nuestros componentes efectivamente reflejan una estructura subyacente de nuestros datos, podremos caracterizar con mayor precisión a los superhéroes.

Empecemos analizando las puntuaciones de Colossus, un X-Men cuyo poder mutante le otorga piel metálica, fuerza y resistencia sobrehumanas, así como un poco de invulnerabilidad.

filter(poderes_scores, heroe == "Colossus")
## # A tibble: 1 x 9
##   heroe    superman omnipotente psiquico spiderman animal energia titan
##   <chr>       <dbl>       <dbl>    <dbl>     <dbl>  <dbl>   <dbl> <dbl>
## 1 Colossus     457.        425.     452.      467.   513.    442.  727.
## # ... with 1 more variable: vigilante <dbl>

Colossus tiene su puntuación más alta, de manera considerable, en el componente “titan”, lo cual es consistente con lo que sabemos de él.

En segundo lugar se encuentra el arquetipo “animal”, seguido de “spiderman”, lo cual no es muy claro por qué ha ocurrido. Sin embargo, la puntuación en “titan” es tan alta, que nos deja claro cómo clasificaríamos a Colossus.

Probemos con otro personaje. Black Lightning es un superhéroe que puede controlar la electricidad, además de que es capaz de volar y resistir ataques de energía, por lo tanto, esperaríamos encontrarlo precisamente en el componente “energia”.

filter(poderes_scores, heroe == "Black Lightning")
## # A tibble: 1 x 9
##   heroe       superman omnipotente psiquico spiderman animal energia titan
##   <chr>          <dbl>       <dbl>    <dbl>     <dbl>  <dbl>   <dbl> <dbl>
## 1 Black Ligh~     465.        470.     462.      438.   445.    604.  505.
## # ... with 1 more variable: vigilante <dbl>

¡Excelente! La puntuación más alta para Black Lightning está en “energia”. Esta ocasión tuvimos una puntuación cercana en “titan”, que es un poco enigmático.

Lo anterior nos ilustra que esta forma de clasificación no es perfecta. Tendremos mejores resultados para aquellos personajes con más poderes con cargas altas en componentes específicos.

Sistematizando la clasificación

Podemos crear una pequeña función para determinar a qué grupo es posible que pertenezca un personaje a partir de sus puntuaciones.

Esta función, nos devolverá los tres componentes en los que un personaje tiene las puntuaciones más altas, aunque dejamos argumento para que nos devuelva más o menos componentes.

Nuestra función usa las funciones gather() de tidyr para convertir nuestros datos de un formato ancho a uno alto, y arrange() y top_n() de dplyr para ordenar y seleccionar renglones.

Además, obtendremos una columna llamada “diferencia”, que nos mostrará la diferencia entre cada puntuación y la puntuación más alta de todas, determinada usando first() de dplyr. Entre mayor sea la diferencia, tendremos más confianza en la clasificación.

obten_tipo <- function(nombre, cuantos = 3) {
  poderes_scores %>% 
    filter(heroe == nombre) %>% 
    gather(componente, score, superman:vigilante) %>% 
    arrange(desc(score)) %>% 
    top_n(wt = score, n = cuantos) %>% 
    mutate(diferencia = score - first(score))
}

Probemos con cuatro personajes diferentes.

c("X-23", "Punisher", "Stargirl", "Swamp Thing") %>% 
  map(obten_tipo)
## [[1]]
## # A tibble: 3 x 4
##   heroe componente score diferencia
##   <chr> <chr>      <dbl>      <dbl>
## 1 X-23  animal      766.        0  
## 2 X-23  vigilante   681.      -84.3
## 3 X-23  superman    633.     -133. 
## 
## [[2]]
## # A tibble: 3 x 4
##   heroe    componente score diferencia
##   <chr>    <chr>      <dbl>      <dbl>
## 1 Punisher vigilante   760.         0 
## 2 Punisher energia     491.      -269.
## 3 Punisher animal      479.      -281.
## 
## [[3]]
## # A tibble: 3 x 4
##   heroe    componente score diferencia
##   <chr>    <chr>      <dbl>      <dbl>
## 1 Stargirl energia     837.         0 
## 2 Stargirl titan       548.      -289.
## 3 Stargirl spiderman   482.      -354.
## 
## [[4]]
## # A tibble: 3 x 4
##   heroe       componente  score diferencia
##   <chr>       <chr>       <dbl>      <dbl>
## 1 Swamp Thing titan        775.         0 
## 2 Swamp Thing psiquico     635.      -140.
## 3 Swamp Thing omnipotente  523.      -251.

De nuevo, no es una clasificación perfecta, pero es un buen punto de partida.

Conclusiones

En este artículo revisamos una aplicación del Análisis de Componentes Principales (PCA) para encontrar una estructura subyacente en nuestros, si es que esta existe. Además vimos cómo podemos aprovechar esta estructura para entender mejor nuestros datos e incluso para caracterizar los casos con los que contamos.

En nuestro caso, tuvimos cierto éxito con los poderes de los superhéroes, lo cual no es por completo una sorpresa. Hay ciertos poderes que son necesarios para que otros funcionen. Un personaje con súper fuerza que tenga también súper resistencia, destruiría su cuerpo utilizando sus habilidades, algo que My Hero Academia ha demostrado recientemente.

Si tienes familiaridad con el Análisis Factorial Exploratorio (EFA) la manera en la que hemos usado PCA te sonará peculiar, en especial por las interpretaciones que hacemos de sus resultados. En teoría, PCA no nos permite caracterizar rasgos latentes, para ello usamos EFA.

También puede que te llame la atención no nos aseguramos de cumplir los supuestos de los datos para realizar un PCA.

Esto es, en realidad sumamente interesante. Hice pruebas con EFA, de los cuales obtuve resultados prácticamente iguales a los aquí mostrados. También en un principio pensé que dado que los datos con los que contamos son binarios sería necesario usar una matriz de correlación tetracórica o que PCA no llegaría a convergencia. Sin embargo, usando el coeficiente R de Pearson función razonablemente bien.

No tengo una respuesta definitiva a lo anterior, pero es algo que sobre lo que vale la pena indagar.


Consultas, dudas, comentarios y correcciones son bienvenidas:

El código y los datos usados en este documento se encuentran en Github:

Publicado originalmente en Junio de 2018 en:

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *