Análisis de Componentes Principales - Base de Datos Caninos
Ennie Monserrat Abrego Camacho
1. Introducción
El presente análisis aplica la técnica de Componentes Principales (PCA) a la base de datos de caninos, utilizando las variables de razón construidas: RCSD, RCSI, RCID y RCII.
2. Objetivo
El objetivo es reducir la dimensionalidad de los datos y explorar patrones de variación entre individuos según el sexo.
3. Configuración del ambiente de trabajo
# Defino mi directorio de trabajo
setwd("C:/Users/OSCAR/Desktop/Estadistica forense EMAC")
# Abriendo paquete pacman
library(pacman)
# Abriendo las librerías o paquetes que se usan
p_load(haven, dplyr, ggplot2, tinytex, tidyr, GGally, purrr,
labelled, tidyverse, FactoMineR, factoextra)4. Carga y preparación de datos
# Cargar base de datos de caninos
load("Caninos.RData")
# Variables de razón seleccionadas
vars <- c("RCSD", "RCSI", "RCID", "RCII")
# Selección de variables
datos <- Caninos %>%
select(all_of(vars), Sexo)
# Convertir Sexo a factor
datos$Sexo <- as_factor(datos$Sexo)
# Visualizar estructura de los datos
str(datos)## tibble [283 × 5] (S3: tbl_df/tbl/data.frame)
## $ RCSD: num [1:283] 0.1097 0.1021 0.1279 0.109 0.0873 ...
## ..- attr(*, "label")= chr "Área cavidad pulpar canino superior derecho"
## ..- attr(*, "format.spss")= chr "F11.0"
## ..- attr(*, "display_width")= int 11
## $ RCSI: num [1:283] 0.1097 0.0965 0.1084 0.1036 0.083 ...
## ..- attr(*, "label")= chr "Área cavidad pulpar canino superior izquierdo"
## ..- attr(*, "format.spss")= chr "F11.0"
## ..- attr(*, "display_width")= int 11
## $ RCID: num [1:283] 0.116 0.111 0.141 0.128 0.104 ...
## ..- attr(*, "label")= chr "Área cavidad pulpar canino inferior derecho"
## ..- attr(*, "format.spss")= chr "F11.0"
## ..- attr(*, "display_width")= int 11
## $ RCII: num [1:283] 0.1274 0.1123 0.1411 0.1182 0.0944 ...
## ..- attr(*, "label")= chr "Área cavidad pulpar canino inferior izquierdo"
## ..- attr(*, "format.spss")= chr "F11.0"
## ..- attr(*, "display_width")= int 11
## $ Sexo: Factor w/ 2 levels "Masculino","Femenino": 2 1 2 1 1 2 2 1 1 1 ...5. Análisis de Componentes Principales
# Aplicar PCA
pca <- PCA(
datos %>% select(all_of(vars)),
scale.unit = TRUE,
ncp = 4,
graph = FALSE
)
# Resumen del PCA
summary(pca)##
## Call:
## PCA(X = datos %>% select(all_of(vars)), scale.unit = TRUE, ncp = 4,
## graph = FALSE)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4
## Variance 3.714 0.228 0.036 0.023
## % of var. 92.840 5.693 0.897 0.570
## Cumulative % of var. 92.840 98.533 99.430 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## 1 | 1.577 | 1.509 0.217 0.916 | 0.253 0.099 0.026 | 0.376 1.394
## 2 | 0.584 | 0.492 0.023 0.709 | 0.250 0.097 0.184 | 0.010 0.001
## 3 | 3.073 | 2.890 0.795 0.885 | 0.800 0.993 0.068 | -0.134 0.178
## 4 | 1.558 | 1.420 0.192 0.831 | 0.483 0.363 0.096 | -0.401 1.584
## 5 | 0.954 | -0.827 0.065 0.751 | 0.311 0.150 0.106 | -0.349 1.200
## 6 | 1.475 | -1.029 0.101 0.487 | -0.333 0.172 0.051 | -0.869 7.436
## 7 | 2.160 | -2.129 0.431 0.972 | 0.360 0.201 0.028 | -0.031 0.010
## 8 | 1.954 | 1.821 0.316 0.869 | 0.643 0.642 0.108 | 0.220 0.475
## 9 | 1.092 | -1.054 0.106 0.931 | 0.250 0.097 0.052 | -0.107 0.113
## 10 | 1.191 | 1.146 0.125 0.927 | -0.277 0.119 0.054 | 0.155 0.236
## cos2
## 1 0.057 |
## 2 0.000 |
## 3 0.002 |
## 4 0.066 |
## 5 0.134 |
## 6 0.347 |
## 7 0.000 |
## 8 0.013 |
## 9 0.010 |
## 10 0.017 |
##
## Variables
## Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr cos2
## RCSD | 0.966 25.121 0.933 | -0.236 24.363 0.055 | -0.017 0.845 0.000 |
## RCSI | 0.965 25.060 0.931 | -0.241 25.437 0.058 | 0.021 1.260 0.000 |
## RCID | 0.963 24.986 0.928 | 0.232 23.647 0.054 | -0.134 50.215 0.018 |
## RCII | 0.960 24.834 0.922 | 0.246 26.554 0.060 | 0.131 47.681 0.017 |5.1 Interpretación de las varianzas
# Tabla de varianza explicada
varianza <- as.data.frame(pca$eig)
colnames(varianza) <- c("Eigenvalue", "Porcentaje", "Acumulado")
knitr::kable(varianza, digits = 3,
caption = "Tabla 1. Varianza explicada por cada componente principal")| Eigenvalue | Porcentaje | Acumulado | |
|---|---|---|---|
| comp 1 | 3.714 | 92.840 | 92.840 |
| comp 2 | 0.228 | 5.693 | 98.533 |
| comp 3 | 0.036 | 0.897 | 99.430 |
| comp 4 | 0.023 | 0.570 | 100.000 |
Interpretación:
El primer componente principal (PC1) explica el 92.84% de la varianza total de los datos. Esto indica que casi toda la información contenida en las cuatro variables de razón puede ser capturada por un solo componente.
El segundo componente (PC2) contribuye con un 5.69% adicional, alcanzando un 98.53% acumulado entre ambos componentes.
Los componentes 3 y 4 aportan menos del 1.5% de varianza combinados, lo que sugiere que son prácticamente irrelevantes para el análisis.
Con solo dos componentes se retiene más del 98.5% de la información original, justificando plenamente la reducción dimensional.
6. Gráfica Scree Plot
# Gráfica scree-plot
fviz_screeplot(pca, addlabels = TRUE, ylim = c(0, 100)) +
labs(title = "Scree Plot - Varianza Explicada por Componente",
x = "Componentes Principales",
y = "Porcentaje de Varianza Explicada") +
theme_minimal(base_size = 12)
Figura 1. Scree plot mostrando la varianza explicada por cada componente principal
Interpretación del Scree Plot:
El gráfico muestra un “codo” pronunciado después del primer componente, confirmando que PC1 domina la estructura de variación. La caída abrupta hacia PC2 y la meseta subsecuente indican que los componentes posteriores aportan información marginal. Este patrón es típico cuando las variables están altamente correlacionadas entre sí.
7. Pesos de las variables (Loadings)
# Coeficientes de los componentes
loadings <- as.data.frame(pca$var$coord)
knitr::kable(loadings[, 1:2], digits = 4,
caption = "Tabla 2. Pesos (loadings) de las variables en PC1 y PC2")| Dim.1 | Dim.2 | |
|---|---|---|
| RCSD | 0.9659 | -0.2355 |
| RCSI | 0.9647 | -0.2407 |
| RCID | 0.9633 | 0.2321 |
| RCII | 0.9603 | 0.2459 |
Interpretación de los pesos:
Componente Principal 1 (PC1):
- Todas las variables tienen pesos muy similares y positivos (aprox 0.96), indicando que PC1 representa un factor de tamaño general de los caninos.
- Las cuatro razones (RCSD, RCSI, RCID, RCII) contribuyen casi por igual a este componente.
- Valores altos en PC1 corresponden a individuos con caninos proporcionalmente grandes en todas las dimensiones.
Componente Principal 2 (PC2):
- RCSD y RCSI tienen pesos negativos (-0.236 y -0.241)
- RCID y RCII tienen pesos positivos (0.232 y 0.246)
- PC2 contrasta las razones de caninos superiores vs inferiores, capturando diferencias en la morfología entre maxilar y mandíbula.
8. Gráfica de los dos primeros componentes
# Extraer coordenadas de individuos
coords <- as.data.frame(pca$ind$coord[, 1:2])
colnames(coords) <- c("PC1", "PC2")
coords$Sexo <- datos$Sexo
# Gráfica de dispersión
ggplot(coords, aes(x = PC1, y = PC2, color = Sexo)) +
geom_point(size = 3, alpha = 0.7) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
theme_minimal(base_size = 14) +
labs(
title = "Análisis de Componentes Principales - Caninos",
x = paste0("Componente Principal 1 (", round(varianza$Porcentaje[1], 2), "%)"),
y = paste0("Componente Principal 2 (", round(varianza$Porcentaje[2], 2), "%)"),
color = "Sexo"
) +
scale_color_manual(values = c("1" = "blue", "2" = "red"),
labels = c("1" = "Mujeres", "2" = "Hombres")) +
theme(
legend.position = "right",
panel.grid.minor = element_blank(),
panel.grid.major = element_line(color = "grey85"),
plot.title = element_text(hjust = 0.5, face = "bold")
)
Figura 2. Distribución de individuos en el espacio de los dos primeros componentes principales
Interpretación de la gráfica:
Se observa una separación parcial entre sexos principalmente en el eje PC1 (horizontal), donde los individuos de un sexo tienden a agruparse hacia valores más positivos.
Esta separación sugiere dimorfismo sexual en el tamaño general de los caninos, siendo uno de los sexos consistentemente mayor.
El eje PC2 (vertical) muestra mayor dispersión sin un patrón claro de separación por sexo, indicando que las diferencias morfológicas superiores/inferiores son independientes del sexo.
Algunos individuos presentan valores extremos en PC1, lo que podría indicar casos con caninos excepcionalmente grandes o pequeños.
8. Conclusiones
Reducción dimensional exitosa: El 98.53% de la varianza se captura con solo 2 componentes de 4 variables originales.
Dimorfismo sexual: Existe evidencia de diferenciación sexual principalmente en el tamaño general (PC1), lo cual es relevante para aplicaciones forenses de estimación de sexo.
Este análisis demuestra la utilidad del PCA en antropología forense para identificar patrones morfométricos y reducir la complejidad de datos multivariados manteniendo la información relevante para la identificación humana.