Análisis de Componentes Principales (ACP)

Generalidades

  • El ACP se constituye como una técnica exploratoria, en etapas iniciales del análisis de los datos.
  • Su propósito fundamental es reducir la dimensión de un conjunto de datos.
  • Transforma las variables originales en un conjunto de variables más pequeñas, las cuales son combinaciones lineales de las variables originales y retienen la mayor parte de la variabilidad presente en estas.
  • Convierte un conjunto de variables posiblemente correlacionadas, en un conjunto de variables sin correlación lineal, denominadas Componentes Principales (CP).

Objetivos del ACP

  • Obtener nuevas variables (componentes principales) que expresen la información contenida en los datos originales.
  • Reducir la dimensionalidad de los datos.
  • Reconocer patrones de comportamiento presentes en los datos.
  • Contribuir a la interpretación de la información que poseen los datos.

  • Nuevo sistema de coordenadas.
  • Obtención de direcciones ortogonales (o componentes principales) con máxima variabilidad.
  • Las nuevas direcciones proporcionan una dispersión simple y parsimoniosa de la estructura de covarianza de los datos.
  • Las componentes principales se pueden obtener a través de la matriz de varianzas-covarianzas o de la matriz de correlación.

Análisis de Clúster

Generalidades

  • Procedimiento que tiene como punto de partida un conjunto de datos que contiene información sobre una muestra de individuos e intenta reorganizarlos en grupos relativamente homogéneos a los que se llama conglomerados (clusters).
  • Un conglomerado, grupo o clase es un conjunto de individuos con características similares.
  • Es necesario una medida que indique la similaridad entre individuos u objetos.
  • Es necesario un método para obtener los grupos

Objetivos del Cluster

  • Clasificación
  • Busca particionar un cojunto de objetos en grupos, de tal forma que los objetos de un mismo grupo sean similares y los objetos de grupos distintos sean diferentes.

Medidas de similaridad

  • Métricas: distancias
  • Escala nominal coeficientes de asociación
  • Coeficientes de correlación

Métodos de agrupamiento

  • Métodos jerarquicos
  • Métodos no jerarquicos o de partición
  • Métodos de nubes dinámicas
  • Métodos de clasificación difusa

Los métodos jerarquicos se clasifican en:

  • Aglomerativos
  • Desaglomerativos

Algunos de los métodos jerarquicos aglomerativos son:

  • Método de enlace simple o vecino más cercano
  • Metodo de enlace completo o vecino más lejano
  • Método de enlace promedio
  • Método de Ward

Ejemplo

Descripción del conjunto de datos (Gorriones.csv): " … el 1 de febrero del presente año (1898), cuando, después de una tormenta extraordinariamente severa de nieve, lluvia y aguanieve, varios gorriones ingleses fueron llevados al Laboratorio Anatómico de la Universidad de Brown. Setenta y dos de estas aves revivieron; sesenta y cuatro perecieron; … “.” … la tormenta fue de larga duración, y las aves fueron recogidas, no en una localidad, sino en varias localidades; … “. Este evento fue descrito por Hermon Bumpus (1898) como un ejemplo clásico de la selección natural en acción. Artículo científico

Descripción de variables

  • Sexo: Machos (m) y hembras (f)
  • Edad: Adulto (a) y joven (y)
  • Sobrevivió: Sí (SI) y no (NO)
  • Longitud total (mm): LongitudTotal (desdel la punta del pico hasta la punta de la cola)
  • Extensión de las alas (mm): ExteAlas (de punta a punta de las alas extendidas)
  • Peso (gr): peso del ave
  • Longitud del pico y la cabeza (mm): LonPicoCabe
  • Longitud del húmero (pulgadas): LonHumero
  • Longitud del fémur (pulgadas): LonFemur
  • Longitud de tibia-tarso (pulgadas): LonTibTarso
  • Ancho del cráneo (pulgadas): AncCraneo
  • Longitud de la quilla (pulgadas): LonQuilla

Lectura de datos

datos <- read.csv(file = "data//Gorriones.csv", dec = ",")
datos

Resumen de datos

summary(datos[, 4:12])
##  LongitudTotal      ExteAlas          Peso        LonPicoCabe   
##  Min.   :152.0   Min.   :230.0   Min.   :22.60   Min.   :29.80  
##  1st Qu.:157.0   1st Qu.:242.0   1st Qu.:24.57   1st Qu.:31.10  
##  Median :160.0   Median :246.0   Median :25.55   Median :31.60  
##  Mean   :159.5   Mean   :245.2   Mean   :25.52   Mean   :31.57  
##  3rd Qu.:162.0   3rd Qu.:249.0   3rd Qu.:26.50   3rd Qu.:32.02  
##  Max.   :167.0   Max.   :256.0   Max.   :31.00   Max.   :33.40  
##    LonHumero         LonFemur       LonTibTarso      AncCraneo     
##  Min.   :0.6590   Min.   :0.6530   Min.   :1.011   Min.   :0.5510  
##  1st Qu.:0.7177   1st Qu.:0.7017   1st Qu.:1.112   1st Qu.:0.5920  
##  Median :0.7330   Median :0.7130   Median :1.133   Median :0.6020  
##  Mean   :0.7319   Mean   :0.7130   Mean   :1.134   Mean   :0.6025  
##  3rd Qu.:0.7482   3rd Qu.:0.7312   3rd Qu.:1.162   3rd Qu.:0.6110  
##  Max.   :0.7800   Max.   :0.7670   Max.   :1.230   Max.   :0.6400  
##    LonQuilla     
##  Min.   :0.7340  
##  1st Qu.:0.8090  
##  Median :0.8410  
##  Mean   :0.8399  
##  3rd Qu.:0.8652  
##  Max.   :0.9270

Matriz de dispersión y correlación (gráfico)

library(psych)
pairs.panels(datos[, 4:12],
             hist.col = "gray45",
             density = TRUE,
             main = "Matriz de dispersión y correlación")

Matriz de correlaciones

cor(datos[, 4:12])
##               LongitudTotal  ExteAlas      Peso LonPicoCabe LonHumero
## LongitudTotal     1.0000000 0.6909709 0.5838648   0.4694466 0.4846190
## ExteAlas          0.6909709 1.0000000 0.5686500   0.4990738 0.6779536
## Peso              0.5838648 0.5686500 1.0000000   0.5192088 0.5188943
## LonPicoCabe       0.4694466 0.4990738 0.5192088   1.0000000 0.6229937
## LonHumero         0.4846190 0.6779536 0.5188943   0.6229937 1.0000000
## LonFemur          0.4447051 0.5782836 0.4441451   0.6164174 0.8205803
## LonTibTarso       0.3776146 0.5316798 0.4544589   0.5843728 0.7460385
## AncCraneo         0.4355363 0.4338913 0.4714846   0.5347534 0.5120226
## LonQuilla         0.5008898 0.5801525 0.5126353   0.4903663 0.5486094
##                LonFemur LonTibTarso AncCraneo LonQuilla
## LongitudTotal 0.4447051   0.3776146 0.4355363 0.5008898
## ExteAlas      0.5782836   0.5316798 0.4338913 0.5801525
## Peso          0.4441451   0.4544589 0.4714846 0.5126353
## LonPicoCabe   0.6164174   0.5843728 0.5347534 0.4903663
## LonHumero     0.8205803   0.7460385 0.5120226 0.5486094
## LonFemur      1.0000000   0.8092996 0.5212480 0.4536862
## LonTibTarso   0.8092996   1.0000000 0.4586951 0.3840558
## AncCraneo     0.5212480   0.4586951 1.0000000 0.3840089
## LonQuilla     0.4536862   0.3840558 0.3840089 1.0000000

Cálculo de las componentes principales

acp <- princomp(datos[, 4:12], scale = TRUE, cor = TRUE)
biplot(acp, cex = 0.7)

Proporción de varianza

summary(acp)
## Importance of components:
##                           Comp.1    Comp.2     Comp.3     Comp.4
## Standard deviation     2.3046882 0.9988978 0.81280426 0.73068317
## Proportion of Variance 0.5901764 0.1108663 0.07340564 0.05932199
## Cumulative Proportion  0.5901764 0.7010427 0.77444838 0.83377037
##                            Comp.5     Comp.6     Comp.7     Comp.8
## Standard deviation     0.67837980 0.63624854 0.52104550 0.46168667
## Proportion of Variance 0.05113324 0.04497913 0.03016538 0.02368384
## Cumulative Proportion  0.88490361 0.92988274 0.96004812 0.98373196
##                            Comp.9
## Standard deviation     0.38263868
## Proportion of Variance 0.01626804
## Cumulative Proportion  1.00000000
plot(acp$sdev, type="b", xlab = "Componente Principal",
     ylab = "Desviación Estándar",
     main = "Relación de la variabilidad retenida con el número de componentes")
abline(v = 2, col = "blue", lty = 2, lwd = 0.8)

Importancia de variables sobre las componentes

loadings(acp)[,1:9]
##                   Comp.1      Comp.2      Comp.3      Comp.4     Comp.5
## LongitudTotal -0.3100651 -0.48676787 -0.05636978  0.45377621  0.1326996
## ExteAlas      -0.3505712 -0.25833261 -0.33786910  0.25610634  0.2419548
## Peso          -0.3155630 -0.35142457  0.19791968  0.07935593 -0.7038798
## LonPicoCabe   -0.3358877  0.11469994  0.29286266 -0.30567863 -0.3264084
## LonHumero     -0.3779134  0.25196559 -0.22209147 -0.02197200  0.0837826
## LonFemur      -0.3628170  0.41308546 -0.14264156  0.07732550  0.0761244
## LonTibTarso   -0.3408942  0.46175891 -0.15231419  0.13796632 -0.1776658
## AncCraneo     -0.2946541  0.03996533  0.78349062  0.04854279  0.4795809
## LonQuilla     -0.3017853 -0.33274799 -0.22582687 -0.77518179  0.2179036
##                    Comp.6      Comp.7      Comp.8      Comp.9
## LongitudTotal  0.36031440  0.51853028 -0.13136187 -0.15575960
## ExteAlas       0.02384397 -0.64295510  0.33808212  0.20932445
## Peso          -0.46084211 -0.06240530 -0.10097266  0.09766796
## LonPicoCabe    0.73723935 -0.20681677  0.04051399  0.01834518
## LonHumero     -0.11938625 -0.25053953 -0.58145771 -0.56723163
## LonFemur      -0.04231837  0.23333115 -0.31239139  0.71538857
## LonTibTarso   -0.13117472  0.30096834  0.63401809 -0.29496225
## AncCraneo     -0.23554995 -0.04561749  0.08045686 -0.03649455
## LonQuilla     -0.15802907  0.24736838  0.11168704  0.01339906

Puntajes de los invidividuos sobre las componentes

head(acp$scores, n = 10)
##           Comp.1     Comp.2      Comp.3     Comp.4      Comp.5     Comp.6
##  [1,]  3.8880757 -1.3522616  0.41603544 -1.1326393 -0.09606579  0.3027823
##  [2,]  0.1575123 -1.4096787  0.40722779  0.4664938  0.09095160 -0.3538219
##  [3,] -0.3388752 -0.4201252  0.77208305 -0.2187090 -0.07081691  0.2364849
##  [4,] -0.7918721 -0.3448695 -0.78499927  0.9062612 -0.19145687 -1.3317598
##  [5,]  0.6448564  0.2402161 -0.09755562 -0.2748429 -0.55333926 -1.9911962
##  [6,] -0.8439208 -0.0350315 -0.01554790  0.2697300 -0.15319876  0.9125169
##  [7,]  1.1956308  0.8519471 -0.96170268 -0.9277625 -0.38677427  0.2045844
##  [8,] -1.0570477 -0.5649736  0.29651557 -0.5145504 -0.08213999  0.6833607
##  [9,]  1.6455690  0.4574013 -1.38797615 -0.1532863 -0.38641002  0.6405087
## [10,] -2.9531850  0.3580806  0.29672513 -0.3620770  0.69724960  0.4983349
##           Comp.7       Comp.8      Comp.9
##  [1,] -0.9560481 -0.135479587  0.61889581
##  [2,]  1.1263744 -1.220505643 -0.53167046
##  [3,] -0.3398357 -0.425679302 -0.03965116
##  [4,] -0.2897437  0.937730100 -0.24581620
##  [5,] -0.1090226  0.260215062 -0.23649302
##  [6,] -0.6368404 -0.250486007  0.01779123
##  [7,] -0.9721672  0.473395099 -0.85628752
##  [8,]  0.1076841  0.003133374 -0.31415922
##  [9,] -0.5991745  0.582995122  0.43028359
## [10,]  0.3350900  0.719128185 -0.40058705

Concatenando resultados

datos2 <- data.frame(datos, acp$scores[, c(1, 2)])
datos2

Proyección de aves sobre CP1 y CP2

color <- c("magenta4",  "#66A61E")
simbolos <- c(15, 17)
with(datos2, plot(Comp.1, Comp.2, col = color[Sexo],
                  pch = simbolos[Sobrevivio],
                  cex = 1.5,  xlab = "CP1",
                  ylab = "CP2",
                  main = "Grupo de aves sobre las componentes principales 1 y 2"))
legend("topleft", legend = c("Hembra", "Macho"), col = color, cex = 1, lwd =2)
legend("topright", legend = c("Murió", "Sobrevió"), pch = simbolos,
       col = "black", cex = 1)
abline(h = 0, col = "red")
abline(v = 0, col = "red")
arrows(0, 0,
       acp$loadings[, 1]*5,
       acp$loadings[, 2]*5,
       col = "red",
       lwd = 2.5)
text(acp$loadings[, 1]*5.2,
     acp$loadings[, 2]*5.2,
     row.names(acp$loadings),
     cex = 1.3)

Dendrograma (enlace completo o vecino más lejano)

datosstd <- data.frame(scale(datos[, 4:12]))
cluster1 <- hclust(dist(datosstd))
plot(cluster1)

Concatenando clúster con la base de datos

datos2$grupo <- cutree(cluster1, 5)
datos2

Resumen numérico para cada clúster o grupo

lapply(split(datos2[, 4:12], datos2$grupo), FUN = summary)
## $`1`
##  LongitudTotal      ExteAlas          Peso        LonPicoCabe   
##  Min.   :152.0   Min.   :230.0   Min.   :22.60   Min.   :30.10  
##  1st Qu.:153.0   1st Qu.:234.2   1st Qu.:23.10   1st Qu.:30.38  
##  Median :154.5   Median :237.0   Median :23.30   Median :30.55  
##  Mean   :154.3   Mean   :236.2   Mean   :23.61   Mean   :30.64  
##  3rd Qu.:155.2   3rd Qu.:238.2   3rd Qu.:24.52   3rd Qu.:30.98  
##  Max.   :157.0   Max.   :241.0   Max.   :24.70   Max.   :31.20  
##    LonHumero         LonFemur       LonTibTarso      AncCraneo     
##  Min.   :0.6590   Min.   :0.6530   Min.   :1.011   Min.   :0.5510  
##  1st Qu.:0.6800   1st Qu.:0.6635   1st Qu.:1.037   1st Qu.:0.5840  
##  Median :0.6860   Median :0.6725   Median :1.045   Median :0.5875  
##  Mean   :0.6871   Mean   :0.6739   Mean   :1.069   Mean   :0.5847  
##  3rd Qu.:0.6957   3rd Qu.:0.6837   3rd Qu.:1.107   3rd Qu.:0.5905  
##  Max.   :0.7060   Max.   :0.7020   Max.   :1.156   Max.   :0.5990  
##    LonQuilla     
##  Min.   :0.7340  
##  1st Qu.:0.7698  
##  Median :0.7770  
##  Mean   :0.7805  
##  3rd Qu.:0.7943  
##  Max.   :0.8300  
## 
## $`2`
##  LongitudTotal      ExteAlas          Peso        LonPicoCabe   
##  Min.   :153.0   Min.   :235.0   Min.   :23.20   Min.   :30.30  
##  1st Qu.:156.0   1st Qu.:240.0   1st Qu.:24.20   1st Qu.:31.00  
##  Median :158.5   Median :244.0   Median :24.75   Median :31.40  
##  Mean   :158.6   Mean   :242.7   Mean   :24.88   Mean   :31.27  
##  3rd Qu.:161.0   3rd Qu.:246.0   3rd Qu.:25.55   3rd Qu.:31.50  
##  Max.   :166.0   Max.   :251.0   Max.   :27.50   Max.   :32.40  
##    LonHumero         LonFemur       LonTibTarso      AncCraneo     
##  Min.   :0.6890   Min.   :0.6620   Min.   :1.073   Min.   :0.5750  
##  1st Qu.:0.7150   1st Qu.:0.6947   1st Qu.:1.104   1st Qu.:0.5907  
##  Median :0.7260   Median :0.7050   Median :1.123   Median :0.6000  
##  Mean   :0.7246   Mean   :0.7045   Mean   :1.120   Mean   :0.5991  
##  3rd Qu.:0.7330   3rd Qu.:0.7130   3rd Qu.:1.131   3rd Qu.:0.6082  
##  Max.   :0.7520   Max.   :0.7350   Max.   :1.175   Max.   :0.6200  
##    LonQuilla     
##  Min.   :0.7810  
##  1st Qu.:0.8027  
##  Median :0.8305  
##  Mean   :0.8288  
##  3rd Qu.:0.8492  
##  Max.   :0.8920  
## 
## $`3`
##  LongitudTotal      ExteAlas          Peso        LonPicoCabe   
##  Min.   :155.0   Min.   :239.0   Min.   :24.00   Min.   :30.80  
##  1st Qu.:158.0   1st Qu.:245.0   1st Qu.:25.25   1st Qu.:31.75  
##  Median :160.0   Median :247.0   Median :25.95   Median :32.05  
##  Mean   :159.8   Mean   :246.7   Mean   :25.80   Mean   :32.01  
##  3rd Qu.:162.0   3rd Qu.:248.0   3rd Qu.:26.30   3rd Qu.:32.30  
##  Max.   :165.0   Max.   :253.0   Max.   :27.60   Max.   :33.00  
##    LonHumero         LonFemur       LonTibTarso      AncCraneo     
##  Min.   :0.7090   Min.   :0.6990   Min.   :1.102   Min.   :0.5890  
##  1st Qu.:0.7310   1st Qu.:0.7097   1st Qu.:1.133   1st Qu.:0.5970  
##  Median :0.7390   Median :0.7170   Median :1.149   Median :0.6045  
##  Mean   :0.7387   Mean   :0.7207   Mean   :1.148   Mean   :0.6044  
##  3rd Qu.:0.7445   3rd Qu.:0.7332   3rd Qu.:1.163   3rd Qu.:0.6092  
##  Max.   :0.7660   Max.   :0.7510   Max.   :1.227   Max.   :0.6300  
##    LonQuilla     
##  Min.   :0.7870  
##  1st Qu.:0.8225  
##  Median :0.8405  
##  Mean   :0.8469  
##  3rd Qu.:0.8652  
##  Max.   :0.9270  
## 
## $`4`
##  LongitudTotal      ExteAlas          Peso        LonPicoCabe   
##  Min.   :158.0   Min.   :245.0   Min.   :24.20   Min.   :31.40  
##  1st Qu.:161.0   1st Qu.:250.0   1st Qu.:26.20   1st Qu.:31.80  
##  Median :163.0   Median :251.5   Median :26.85   Median :32.00  
##  Mean   :162.8   Mean   :251.2   Mean   :27.03   Mean   :32.10  
##  3rd Qu.:165.0   3rd Qu.:253.0   3rd Qu.:27.85   3rd Qu.:32.38  
##  Max.   :167.0   Max.   :256.0   Max.   :31.00   Max.   :33.40  
##    LonHumero         LonFemur       LonTibTarso      AncCraneo     
##  Min.   :0.7060   Min.   :0.7110   Min.   :1.120   Min.   :0.5880  
##  1st Qu.:0.7520   1st Qu.:0.7310   1st Qu.:1.153   1st Qu.:0.6070  
##  Median :0.7585   Median :0.7405   Median :1.175   Median :0.6150  
##  Mean   :0.7571   Mean   :0.7392   Mean   :1.171   Mean   :0.6164  
##  3rd Qu.:0.7658   3rd Qu.:0.7488   3rd Qu.:1.189   3rd Qu.:0.6285  
##  Max.   :0.7800   Max.   :0.7670   Max.   :1.230   Max.   :0.6400  
##    LonQuilla     
##  Min.   :0.8300  
##  1st Qu.:0.8572  
##  Median :0.8765  
##  Mean   :0.8755  
##  3rd Qu.:0.8910  
##  Max.   :0.9230  
## 
## $`5`
##  LongitudTotal      ExteAlas          Peso        LonPicoCabe   
##  Min.   :156.0   Min.   :236.0   Min.   :23.60   Min.   :29.80  
##  1st Qu.:158.2   1st Qu.:239.8   1st Qu.:23.98   1st Qu.:29.90  
##  Median :159.0   Median :244.5   Median :25.40   Median :30.25  
##  Mean   :159.0   Mean   :243.5   Mean   :25.17   Mean   :30.30  
##  3rd Qu.:159.8   3rd Qu.:247.0   3rd Qu.:26.07   3rd Qu.:30.68  
##  Max.   :162.0   Max.   :250.0   Max.   :26.80   Max.   :30.90  
##    LonHumero         LonFemur       LonTibTarso      AncCraneo     
##  Min.   :0.6900   Min.   :0.6660   Min.   :1.067   Min.   :0.5630  
##  1st Qu.:0.7045   1st Qu.:0.6680   1st Qu.:1.082   1st Qu.:0.5763  
##  Median :0.7100   Median :0.6720   Median :1.091   Median :0.5835  
##  Mean   :0.7100   Mean   :0.6775   Mean   :1.088   Mean   :0.5828  
##  3rd Qu.:0.7155   3rd Qu.:0.6820   3rd Qu.:1.097   3rd Qu.:0.5893  
##  Max.   :0.7300   Max.   :0.7030   Max.   :1.103   Max.   :0.6020  
##    LonQuilla     
##  Min.   :0.7490  
##  1st Qu.:0.8117  
##  Median :0.8200  
##  Mean   :0.8235  
##  3rd Qu.:0.8290  
##  Max.   :0.9110

Proyecciones en el plano con los Cluster

colores <- c("forestgreen", "blue")
simbolos <- c(15, 16, 17, 18, 20)
with(datos2, plot(Comp.1, Comp.2, col = colores[Sexo], pch = simbolos[grupo], 
                  xlab = "Componente principal 1",
                  ylab = "Componente principal 2", 
                  main = "Grupos de aves sobre componentes principales 1 y 2 (sobrevivencia[SI, NO])", 
                  cex = 1.7))
legend("topright", legend = 1:5, pch = simbolos, col = "black", ncol = 2,
       cex = 1.2, title = "Clúster")
legend("topleft", legend = c("Hembra", "Macho"), col = colores, cex = 1,
       lty =1, lwd =2, title = "Sexo")
abline(h = 0, col = "red")
abline(v = 0, col = "red")
arrows(0, 0, acp$loadings[, 1]*5, acp$loadings[, 2]*5, col = "red", lwd = 2)
text(acp$loadings[, 1]*5.2, acp$loadings[, 2]*5.2,
     row.names(acp$loadings))
text(datos2$Comp.1, datos2$Comp.2, labels = datos2$Sobrevivio, pos = 4,
     cex = 0.6)

Recursos de información