Análisis de Componentes Principales para clasificar superhéroes
Juan Bosco Mendoza Vega
28 de junio de 2018
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.
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:
- https://www.pmrjournal.org/article/S1934-1482(14)00069-0/pdf
- https://arxiv.org/pdf/astro-ph/9905079.pdf
- http://people.tamu.edu/~alawing/materials/ESSM689/pca.pdf
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 rowsImportamos 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
## # ... with 657 more rows, and 163 more variables: `Cold Resistance` <chr>,
## # Durability <chr>, Stealth <chr>, `Energy Absorption` <chr>,
## # Flight <chr>, `Danger Sense` <chr>, `Underwater breathing` <chr>,
## # Marksmanship <chr>, `Weapons Master` <chr>, `Power
## # Augmentation` <chr>, `Animal Attributes` <chr>, Longevity <chr>,
## # Intelligence <chr>, `Super Strength` <chr>, Cryokinesis <chr>,
## # Telepathy <chr>, `Energy Armor` <chr>, `Energy Blasts` <chr>,
## # Duplication <chr>, `Size Changing` <chr>, `Density Control` <chr>,
## # Stamina <chr>, `Astral Travel` <chr>, `Audio Control` <chr>,
## # Dexterity <chr>, Omnitrix <chr>, `Super Speed` <chr>,
## # Possession <chr>, `Animal Oriented Powers` <chr>, `Weapon-based
## # Powers` <chr>, Electrokinesis <chr>, `Darkforce Manipulation` <chr>,
## # `Death Touch` <chr>, Teleportation <chr>, `Enhanced Senses` <chr>,
## # Telekinesis <chr>, `Energy Beams` <chr>, Magic <chr>,
## # Hyperkinesis <chr>, Jump <chr>, Clairvoyance <chr>, `Dimensional
## # Travel` <chr>, `Power Sense` <chr>, Shapeshifting <chr>, `Peak Human
## # Condition` <chr>, Immortality <chr>, Camouflage <chr>, `Element
## # Control` <chr>, Phasing <chr>, `Astral Projection` <chr>, `Electrical
## # Transport` <chr>, `Fire Control` <chr>, Projection <chr>,
## # Summoning <chr>, `Enhanced Memory` <chr>, Reflexes <chr>,
## # Invulnerability <chr>, `Energy Constructs` <chr>, `Force
## # Fields` <chr>, `Self-Sustenance` <chr>, `Anti-Gravity` <chr>,
## # Empathy <chr>, `Power Nullifier` <chr>, `Radiation Control` <chr>,
## # `Psionic Powers` <chr>, Elasticity <chr>, `Substance Secretion` <chr>,
## # `Elemental Transmogrification` <chr>, `Technopath/Cyberpath` <chr>,
## # `Photographic Reflexes` <chr>, `Seismic Power` <chr>, Animation <chr>,
## # Precognition <chr>, `Mind Control` <chr>, `Fire Resistance` <chr>,
## # `Power Absorption` <chr>, `Enhanced Hearing` <chr>, `Nova
## # Force` <chr>, Insanity <chr>, Hypnokinesis <chr>, `Animal
## # Control` <chr>, `Natural Armor` <chr>, Intangibility <chr>, `Enhanced
## # Sight` <chr>, `Molecular Manipulation` <chr>, `Heat Generation` <chr>,
## # Adaptation <chr>, Gliding <chr>, `Power Suit` <chr>, `Mind
## # Blast` <chr>, `Probability Manipulation` <chr>, `Gravity
## # Control` <chr>, Regeneration <chr>, `Light Control` <chr>,
## # Echolocation <chr>, Levitation <chr>, `Toxin and Disease
## # Control` <chr>, Banish <chr>, `Energy Manipulation` <chr>, `Heat
## # Resistance` <chr>, ...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] 5Podrí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 0Tenemos 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)
# Resutlado
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 3Obtenemos 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 -21655Estos 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.00La 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.
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 rowsDe 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 rowsDefinitivamente 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: