Introducción

Utilizando el dataset de “Ejemplo de estimacion de edad.sav”, se construirán las Razones del área pulpar /Area total del diente:

Mediante el calculo de las razones bajo la siguiente fórmula:

Area pulpar /Area total

RCSD : Ratio canino superior derecho
RCSI : Ratio canino superior izquierdo
RCID : Ratio canino inferior derecho
RCII : Ratio canino inferior izquierdo

Importamos dataset y librerias

##Librerías
library(pacman)
## Warning: package 'pacman' was built under R version 4.5.2
p_load(haven,dplyr,ggplot2,tinytex,tidyr,GGally,purrr,labelled,tidyverse,FactoMineR,factoextra)

##Dataset
Caninos <- read_sav("Base ejemplo estimacion edad.sav")

Calculamos y generamos el vector

# Variables
Caninos <- Caninos %>%
  mutate(
    RCSD = APSD / ACSD,   # Ratio canino superior derecho
    RCSI = APSI / ACSI,   # Ratio canino superior izquierdo
    RCID = APID / ACID,   # Ratio canino inferior derecho
    RCII = APII / ACII    # Ratio canino inferior izquierdo
  )

vars <- c("RCSD", "RCSI", "RCID", "RCII")

Conversión a factor

##Datos
datos <- Caninos %>% 
  dplyr::select(all_of(vars), Sexo)
##Conversion de Sexo a factor
datos$Sexo <- as_factor(datos$Sexo)

PCA imputando NA

pca <- PCA(
  datos %>% dplyr::select(all_of(vars)),
  scale.unit = TRUE,
  ncp = 5,
  graph = FALSE
)

Gráfica scree-plot

fviz_screeplot(pca, addlabels = TRUE, ylim = c(0, 60))
## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.

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

El Componente 1 (Comp 1) tiene un valor propio de \(\approx 3.71\), que es mucho más alto que los demás además de que explica el \(92.84\%\)de la varianza total pero si consideramos el Componente 2 (Comp 2) se alcanza casi la totalidad de la varianza con el \(98.53\%\) de la varianza.

Como casi toda la información de los 4 ratios se puede resumir en la primera dimensión significa que los datos están altamente correlacionados.

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

En el caso de los coeficientes estos indican la correlación entre cada ratio (RCSD, RCSI, RCID, RCII) y cada componente principal. Cuanto más cerca esté un valor de \(\mathbf{+1}\) o \(\mathbf{-1}\), más fuerte es la contribución de esa variable a ese componente.

Como todas las variables tienen una correlación muy alta y positiva (cerca de 0.96) con la Dimensión por lo que esto implica que la Dimensión 1 esta relacionada con todas las demas variables figurando una gran redundancia en los datos comprobada con e el Componente 2, ya que cuando el (Comp 2) es alto, RCID y RCII son altos, pero RCSD y RCSI son bajos y viceversa.

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

Estos valores son las coordenadas de las RCXX e indican la correlación entre cada variable

Graficamos la dispersió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")
  )

Conclusión

El PCA revela que las cuatro variables son extremadamente redundantes (compartiendo casi el 93% de la información). El primer componente resume casi toda la información, y la segunda componente captura una diferencia sutil (menos del 6% de la varianza) entre dos pares de variables. Por lo que podemos concluir que los datos no son lo suficientemente excluyentes para denotar una diferencia significativa.