##Introducción El Análisis de Componentes Principales (PCA) es una técnica estadística que reduce la dimensionalidad de los datos, transformando un conjunto de variables originales en un número menor de variables nuevas llamadas componentes principales. Estas nuevas componentes son combinaciones lineales de las originales, son ortogonales (independientes) entre sí y capturan la máxima varianza posible de los datos, simplificando así el conjunto de datos mientras se preserva la información más importante. Es útil para simplificar el análisis, visualizar datos complejos, eliminar redundancias y preprocesar datos para otros algoritmos de aprendizaje automático.

Desarrollo

##Primer set de variables Se va a utilizar una base de datos de medidas de dientes caninos de hombres y mujeres, que se utiliza para la estimación de edad. En este ejercicio se utilizaran 11 variables. Las primeras son: ACSD”, “APSD”, “ACSI”, “APSI”, “ACID”, “APID”, “ACII”, “APII”. La base de datos se encuentra en formato .sav, por lo que se usa R para convertirla a R Data.

setwd("C:/Users/house/OneDrive/Escritorio/ENAH/A. Forense/Estadistica/Carpeta trabajos R")
library(pacman)
p_load(haven,dplyr,ggplot2,tinytex,tidyr,GGally,purrr,labelled,tidyverse,FactoMineR,factoextra)
Caninos1 <- read_sav("Base ejemplo estimacion edad.sav")

se seleccionan las variables que se van a utilizar y se convierten en factores “masculino” y “femenino” los valores númericos que le fueron asignados a la categoría de género.

##Variables CUANTITATIVAS SELECCIONADAS CANINOS
vars <- c("ACSD", "APSD", "ACSI", "APSI", "ACID", "APID", "ACII", "APII")

# Datos
datos <- Caninos1 %>% 
  select(all_of(vars), Sexo)
# Convertir Sexo a factor (IMPORTANTE)
datos$Sexo <- as_factor(datos$Sexo)

Después se aplica la ténica de análisis de componentes principales

# PCA imputando NA
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   Dim.5   Dim.6   Dim.7
## Variance               4.716   2.338   0.682   0.137   0.064   0.047   0.010
## % of var.             58.945  29.221   8.529   1.711   0.803   0.587   0.128
## Cumulative % of var.  58.945  88.166  96.694  98.405  99.208  99.796  99.923
##                        Dim.8
## Variance               0.006
## % of var.              0.077
## Cumulative % of var. 100.000
## 
## Individuals (the 10 first)
##          Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr
## 1    |  2.079 | -1.322  0.131  0.404 | -1.562  0.369  0.565 |  0.228  0.027
## 2    |  3.499 |  3.432  0.883  0.962 |  0.440  0.029  0.016 | -0.253  0.033
## 3    |  2.577 | -0.278  0.006  0.012 | -2.169  0.711  0.708 |  1.098  0.624
## 4    |  4.346 |  4.155  1.294  0.914 | -0.180  0.005  0.002 |  1.176  0.716
## 5    |  1.936 | -1.890  0.268  0.953 |  0.113  0.002  0.003 |  0.125  0.008
## 6    |  5.167 | -4.999  1.873  0.936 | -0.837  0.106  0.026 | -0.233  0.028
## 7    |  2.297 | -0.861  0.056  0.140 |  1.778  0.478  0.599 |  0.968  0.486
## 8    |  1.984 |  1.143  0.098  0.332 | -1.174  0.208  0.350 |  1.007  0.525
## 9    |  2.256 | -0.391  0.011  0.030 |  0.914  0.126  0.164 |  2.019  2.110
## 10   |  2.346 |  2.073  0.322  0.780 | -0.579  0.051  0.061 |  0.734  0.279
##        cos2  
## 1     0.012 |
## 2     0.005 |
## 3     0.181 |
## 4     0.073 |
## 5     0.004 |
## 6     0.002 |
## 7     0.178 |
## 8     0.258 |
## 9     0.800 |
## 10    0.098 |
## 
## Variables
##         Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr   cos2  
## ACSD |  0.673  9.618  0.454 |  0.613 16.055  0.375 |  0.381 21.273  0.145 |
## APSD |  0.794 13.362  0.630 | -0.558 13.329  0.312 |  0.163  3.891  0.027 |
## ACSI |  0.655  9.090  0.429 |  0.621 16.475  0.385 |  0.398 23.229  0.158 |
## APSI |  0.797 13.482  0.636 | -0.551 13.004  0.304 |  0.180  4.771  0.033 |
## ACID |  0.729 11.279  0.532 |  0.545 12.696  0.297 | -0.367 19.691  0.134 |
## APID |  0.879 16.368  0.772 | -0.412  7.256  0.170 | -0.149  3.254  0.022 |
## ACII |  0.708 10.632  0.501 |  0.562 13.518  0.316 | -0.378 20.894  0.143 |
## APII |  0.873 16.169  0.762 | -0.423  7.667  0.179 | -0.143  2.997  0.020 |

Gráfica de scree La gráfica de scree (o diagrama de sedimentación) es una representación gráfica utilizada en el Análisis de Componentes Principales (ACP) para determinar el número óptimo de componentes principales a retener. Muestra la varianza explicada (o los valores propios/autovalores) por cada componente principal, ordenados de mayor a menor varianza.

El eje X representa el número del componente principal (PC1, PC2, PC3, etc.), y el eje Y representa la magnitud de la varianza explicada o el valor propio (autovalor) correspondiente a cada componente.

## 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 4.715592396 58.9449050  58.94490
## comp 2 2.337654692 29.2206836  88.16559
## comp 3 0.682289668  8.5286208  96.69421
## comp 4 0.136899276  1.7112410  98.40545
## comp 5 0.064236876  0.8029610  99.20841
## comp 6 0.046975338  0.5871917  99.79560
## comp 7 0.010223090  0.1277886  99.92339
## comp 8 0.006128664  0.0766083 100.00000

Coeficientes de los componentes

loadings <- as.data.frame(pca$var$coord)
loadings
##          Dim.1      Dim.2      Dim.3       Dim.4        Dim.5
## ACSD 0.6734435  0.6126230  0.3809814 -0.03467129 -0.045564017
## APSD 0.7937995 -0.5582060  0.1629302  0.16818490 -0.008419293
## ACSI 0.6547149  0.6205856  0.3981109 -0.07205444  0.049558602
## APSI 0.7973457 -0.5513544  0.1804212  0.15376416  0.001690566
## ACID 0.7292818  0.5447912 -0.3665330  0.06878172 -0.172761755
## APID 0.8785529 -0.4118440 -0.1490004 -0.17581179 -0.024815935
## ACII 0.7080634  0.5621424 -0.3775708  0.10528704  0.166413748
## APII 0.8731986 -0.4233425 -0.1429868 -0.17846479  0.038405846

Los dos primeros componentes son los que abarcan el mayor procentaje de la varianza, son los que se utilizaran para graficar los datos.

## Gráfica de los dos primeros componenetes

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")
  )

##Segundo set de variables Para estos se utilizará una base de datos que ya está en formaro R Data, por lo cual tiene una forma diferente de carga.

load("C:/Users/house/OneDrive/Escritorio/ENAH/A. Forense/Estadistica/Carpeta trabajos R/Caninos.RData")

Las variables a utilizar son: “RCSD”, “RCSI”, “RCID”, “RCII”

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

Se seleccionan las variables que se van a utilizar y se convierten en factores “masculino” y “femenino” los valores númericos que le fueron asignados a la categoría de género.

datos <- Caninos %>% 
  select(all_of(vars), Sexo)
# Convertir Sexo a factor (IMPORTANTE)
datos$Sexo <- as_factor(datos$Sexo)

Aplicación del análisis de componente principales

# PCA imputando NA
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 |

Gráfica Scree plot

## 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

Coeficientes de los componentes

## 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

De nueva cuenta los primeros componentes son los que contienen la mayor varianza

## Gráfica de los dos primeros componenetes

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")
  )

## Intrerpretación Del primer set de datos:

Se observa una nube de puntos relativamente homogénea, sin formaciones de grupos visibles o clusters separados.

Esto indica que no existe una diferenciación clara entre individuos masculinos y femeninos basada en las variables dentarias utilizadas para el ACP.

Ambos sexos ocupan prácticamente el mismo espacio multivariado, lo cual sugiere que las medidas utilizadas (ACSD, APSD, ACSI, APSI, ACID, APID, ACII, APII) no presentan dimorfismo sexual significativo, al menos en relación con la estructura latente capturada por los dos componentes principales.

Componente Principal 1 (eje X)

El eje horizontal representa el componente asociado con la maduración apical general, tal como se interpretó previamente.

La distribución en este eje muestra:

Individuos dispersos desde valores negativos (menor madurez dental)

hasta valores positivos (mayor cierre apical y desarrollo radicular)

Ambos sexos se distribuyen de manera similar, lo que sugiere que el ritmo de maduración dental capturado por el Componente 1 es comparable entre hombres y mujeres.

Componente Principal 2 (eje Y)

Este componente, que representa la variabilidad bilateral y morfológica, tampoco muestra diferencias sistemáticas por sexo.

Los puntos se distribuyen de manera simétrica alrededor del centro, lo que indica que las diferencias anatómicas radiculares y de apertura/cierre apical no están asociadas al sexo.

Del segundo set de datos:

La nube de puntos muestra una superposición considerable entre ambos sexos a lo largo de los dos componentes. No se observan agrupaciones definidas, separación espacial clara, ni tendencias direccionales que indiquen una diferenciación marcada entre hombres y mujeres.

Esto sugiere que las variables dentales utilizadas no permiten discriminar el sexo, al menos dentro del espacio explicado por los dos componentes principales.

El Componente Principal 1 está asociado con la maduración radicular y cierre apical, según la interpretación previa del ACP.

En el gráfico:

Los valores negativos se asocian con menor madurez dental.

Los valores positivos con mayor cierre apical y desarrollo radicular.

Ambos sexos se encuentran representados a lo largo de todo el rango de valores, lo cual indica que la progresión de madurez dental es similar en hombres y mujeres.

Componente Principal 2 (Eje Y)

El Componente Principal 2 refleja variaciones morfológicas y asimetrías laterales. También aquí se observa solapamiento entre ambos sexos, sin patrones de diferenciación.

Esto sugiere que estas variaciones anatómicas no están influenciadas por el sexo, sino que responden más probablemente a variabilidad individual (idiosincrática).

Conclusiones

Del primer set de datos, el gráfico de dispersión de los dos primeros componentes principales muestra que los individuos masculinos y femeninos se superponen ampliamente en el espacio multivariado, sin evidencia de separación o agrupamiento por sexo. Dado que estos componentes explican el 88.16% de la variabilidad de las mediciones, la ausencia de separación visual sugiere que las variables dentales analizadas no presentan dimorfismo sexual marcado y, por tanto, ambos sexos siguen patrones similares de desarrollo radicular. En consecuencia, las mediciones empleadas pueden considerarse adecuadas para estimación de edad sin necesidad de modelos separados por sexo.

Del segundo set, la visualización de los dos primeros componentes principales, que explican el 88% de la variabilidad total del conjunto de datos, muestra una fuerte superposición entre individuos masculinos y femeninos. No se evidencia agrupación o separación por sexo, lo que indica que las variables dentales analizadas no presentan un dimorfismo sexual marcado. Esto sugiere que el desarrollo radicular reflejado en las mediciones utilizadas es comparable entre hombres y mujeres y, por lo tanto, el análisis y los modelos predictivos derivados del ACP pueden aplicarse sin necesidad de segmentación por sexo.