Introducción

El Análisis de Componentes Principales es una técnica estadística multivariada que permite reducir la dimensionalidad de un conjunto de datos con múltiples variables correlacionadas, transformándolas en un número menor de variables no correlacionadas llamadas componentes principales.

¿Para qué sirve?

-Simplificar datos complejos: Convierte muchas variables en pocas componentes que capturan la mayor parte de la información -Visualizar patrones: Facilita graficar datos multidimensionales en 2D o 3D -Eliminar redundancia: Reduce correlaciones entre variables -Identificar estructura: Revela agrupaciones y relaciones ocultas en los datos

¿Cómo funciona? El PCA identifica las direcciones de máxima variabilidad en los datos. El primer componente captura la mayor varianza posible, el segundo captura la siguiente mayor varianza (perpendicular al primero), y así sucesivamente. Permite trabajar con 2-3 componentes en lugar de decenas de variables originales, sin perder información sustancial, facilitando el análisis e interpretación.

Se carga las paqueterías y los datos necesarios

Se cuenta con una base de datos de 283 observaciones con 15 variables diferentes sobre los dientes caninos.

library(pacman)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(FactoMineR)
library(factoextra)
## Loading required package: ggplot2
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(ggplot2)
## Abriendo las librerias o paquetes que se usan
p_load(haven,dplyr,ggplot2,tinytex,tidyr,GGally,purrr,labelled,tidyverse,FactoMineR,factoextra)
load("Caninos.RData")
## Seleccionar variables del diente canino a analizar
#RCSD: Área de cavidad pulpar superior derecho, RCSI: Área de cavidad pulpar superior izquierdo, RCID: Área de cavidad pulpar inferior derecho y RCII: Área de cavidad pulpar inferior izquierdo. 
vars <- c("RCSD", "RCSI", "RCID", "RCII")
# Datos
datos <- Caninos %>% 
  select(all_of(vars), Sexo)

# Convertir Sexo a factor (IMPORTANTE)
datos$Sexo <- as_factor(datos$Sexo)

Se comienza con el PCA (Análisis de componentes principales)

pca <- PCA(
  datos %>% select(all_of(vars)),
  scale.unit = TRUE,
  ncp = 5,
  graph = FALSE
)
summary(pca)
## 
## Call:
## PCA(X = datos %>% select(all_of(vars)), scale.unit = TRUE, ncp = 5,  
##      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 |
#Dim1,2 3 son los componentes principales 
## Gráfica  scree-plot
fviz_screeplot(pca, 
               addlabels = TRUE, 
               ylim = c(0, 60),
               barfill = "steelblue",
               barcolor = "steelblue",
               linecolor = "red")
## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.

Interpretación

De acuerdo con la gráfica, se puede observar que las dos primeras variables contienen el mayor porcentaje de variabilidad.

Se hace un análisis de la varianza de las variables seleccionadas

## Varianza explicada y por componente
varianza <- as.data.frame(pca$eig)
colnames(varianza) <- c("Eigenvalue", "Porcentaje", "Acumulado")
varianza
##        Eigenvalue Porcentaje Acumulado
## comp 1 3.71358662 92.8396655  92.83967
## comp 2 0.22773454  5.6933635  98.53303
## comp 3 0.03586229  0.8965574  99.42959
## comp 4 0.02281655  0.5704136 100.00000
## Coeficientes de los componentes
loadings <- as.data.frame(pca$var$coord)
loadings
##          Dim.1      Dim.2       Dim.3       Dim.4
## RCSD 0.9658577 -0.2355475 -0.01740755 -0.10645799
## RCSI 0.9646826 -0.2406828  0.02125294  0.10491730
## RCID 0.9632636  0.2320607 -0.13419480  0.01621342
## RCII 0.9603210  0.2459097  0.13076444 -0.01458514

#Interpretación Los primeros dos componentes explican un porcentaje alto de la variabilidad total. El primer componente típicamente captura 50-70% de la varianza en datos morfométricos dentales. En este caso mas de 90% de la variabilidad.

Gráfica de los dos primeros componentes

coords <- as.data.frame(pca$ind$coord[, 1:2])
colnames(coords) <- c("PC1", "PC2")

coords$Sexo <- datos$Sexo   # añadir variable de agrupación

ggplot(coords, aes(x = PC1, y = PC2, color = Sexo)) +
  geom_point(size = 3, alpha = 0.8) +
  theme_minimal(base_size = 14) +
  labs(
    x = "Componente Principal 1",
    y = "Componente Principal 2",
    color = "Sexo"
  ) +
  theme(
    legend.position = "right",
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(color = "grey85")
  )

Interpretación

Diferenciación por Sexo La gráfica de dispersión (PC1 vs PC2 coloreada por sexo) revela si existe dimorfismo sexual en las dimensiones de los caninos: -Separación clara: Indicaría que hombres y mujeres tienen diferencias sistemáticas en tamaño/forma de caninos -Sobreposición: Sugeriría similitud entre sexos en estas medidas En este caso los puntos de sobreponen lo que indica que no hay dimorfismo sexual en los caninos.