0.1 Que es el análisis de componentes principales
“La idea central del análisis de componentes principales (PCA, por sus siglas en inglés) es reducir la dimensionalidad de un conjunto de datos que consiste en un gran número de variables interrelacionadas, conservando al mismo tiempo, en la medida de lo posible, la variación presente en el conjunto de datos” (Jolliffe 2002). El objetivo de la PCA es reemplazar un gran número de variables correlacionadas con un conjunto de componentes principales no correlacionados. Estos componentes pueden considerarse como combinaciones lineales de las variables originales que se ponderan de manera óptima y se derivan de la matriz de correlación de los datos. Los primeros componentes principales explican la mayor proporción de la varianza total y pueden retenerse para su uso en modelos de regresión subsiguientes sin preocuparse por la multicolinealidad.
Considere la posibilidad de utilizar esta técnica cuando:
- tiene un gran conjunto de datos con variables correlacionadas,
- estas variables capturan algunas construcciones subyacentes que pretende describir,
- no desea incluir todas las medidas originales en análisis posteriores.
Diferencias con regresion - Intercepto - Funcion a optimizar - Error - Se calcula la descomposición de inercia, no una sola “componente” como es el caso de la regresión.
0.2 Intuiciones
0.2.1 Nube estandarizada
0.2.2 ¿Qué linea?
0.2.3 Proyecciones
0.2.4 ¿Qué hace el algoritmo?
Minimizar las distancias de las protecciones.
Maximinar las distancias del centroide a los puntos.
0.3 Articulos de aplicación
0.3.0.1 PCA en Estudios de Asociación Genómica Global:
Price, A.L., et al., Principal components analysis corrects for stratification in genome-wide association studies. Nature genetics, 2006. 38(8): p. 904-9
0.3.0.2 PCA en Epidemiología Nutricional:
Navarro Silvera, S.A., et al., Principal component analysis of dietary and lifestyle patterns in relation to risk of subtypes of esophageal and gastric cancer. Annals of epidemiology, 2011. 21(7): p. 543-50.
Hu, F.B., Dietary pattern analysis: a new direction in nutritional epidemiology. Current opinion in lipidology, 2002. 13(1): p. 3-9.
0.3.0.3 PCA en Epidemiología de Enfermedades Cardiovasculares:
Okin, P.M., et al., Principal component analysis of the T wave and prediction of cardiovascular mortality in American Indians: the Strong Heart Study. Circulation, 2002. 105(6): p. 714-9.
0.3.0.5 PCA en Epidemiología de salud oral:
Bueno, R.E., S.J. Moyses, and S.T. Moyses, Millennium development goals and oral health in cities in southern Brazil. Community dentistry and oral epidemiology, 2010.
0.3.0.6 PCA en Epidemiología Psiquiátrica:
Stewart, S.E., et al., Principal components analysis of obsessive-compulsive disorder symptoms in children and adolescents. Biological psychiatry, 2007. 61(3): p. 285-91.
library(scatterplot3d)
data(trees)
s3d <- scatterplot3d(trees, type = "h", color = "blue",
angle=55, pch = 16)
# Add regression plane
my.lm <- lm(trees$Volume ~ trees$Girth + trees$Height)
s3d$plane3d(my.lm)
# Add supplementary points
s3d$points3d(seq(10, 20, 2), seq(85, 60, -5), seq(60, 10, -10),
col = "red", type = "h", pch = 8)
0.4 Ejemplos
0.4.1 Deportistas
Datos sobre 102 atletas hombres y 100 mujeres recogidos en el Instituto Australiano del Deporte
| sex | categorical, niveles: femenino, masculino |
|---|---|
| sport | categóricos, niveles: B_Bola, Campo, Gimnasio, Netball, Remo, Nado, T_400m, |
| Tenis, T_Sprnt, W_Polo | |
| RCC | Recuento de glóbulos rojos (numérico) |
| WCC | Recuento de glóbulos blancos (numérico) |
| Hc | Hematocrito (numérico) |
| Hg | Hemoglobina (numérica) |
| Fe | Concentración de ferritina en plasma (numérica) |
| BMI | índice de masa corporal, peso/(altura)2 (numérico) |
| SSF | suma de los pliegues de la piel (numérico) |
| Bfat | porcentaje de grasa corporal (numérico) |
| LBM | Masa corporal magra (numérica) |
| Ht | altura, cm (numérico) |
| Wt | peso, kg (numérico) |
#install.packages(c("FactoMineR", "factoextra"))
#install.packages(c("sn"))
library("FactoMineR")
library("factoextra")## Loading required package: ggplot2## Welcome! Related Books: `Practical Guide To Cluster Analysis in R` at https://goo.gl/13EFCZlibrary("sn")## Loading required package: stats4##
## Attaching package: 'sn'## The following object is masked from 'package:stats':
##
## sdlibrary("corrplot")## corrplot 0.84 loadeddata(ais)
summary(ais)## sex sport RCC WCC
## female:100 Row :37 Min. :3.800 Min. : 3.300
## male :102 T_400m :29 1st Qu.:4.372 1st Qu.: 5.900
## B_Ball :25 Median :4.755 Median : 6.850
## Netball:23 Mean :4.719 Mean : 7.109
## Swim :22 3rd Qu.:5.030 3rd Qu.: 8.275
## Field :19 Max. :6.720 Max. :14.300
## (Other):47
## Hc Hg Fe BMI
## Min. :35.90 Min. :11.60 Min. : 8.00 Min. :16.75
## 1st Qu.:40.60 1st Qu.:13.50 1st Qu.: 41.25 1st Qu.:21.08
## Median :43.50 Median :14.70 Median : 65.50 Median :22.72
## Mean :43.09 Mean :14.57 Mean : 76.88 Mean :22.96
## 3rd Qu.:45.58 3rd Qu.:15.57 3rd Qu.: 97.00 3rd Qu.:24.46
## Max. :59.70 Max. :19.20 Max. :234.00 Max. :34.42
##
## SSF Bfat LBM Ht
## Min. : 28.00 Min. : 5.630 Min. : 34.36 Min. :148.9
## 1st Qu.: 43.85 1st Qu.: 8.545 1st Qu.: 54.67 1st Qu.:174.0
## Median : 58.60 Median :11.650 Median : 63.03 Median :179.7
## Mean : 69.02 Mean :13.507 Mean : 64.87 Mean :180.1
## 3rd Qu.: 90.35 3rd Qu.:18.080 3rd Qu.: 74.75 3rd Qu.:186.2
## Max. :200.80 Max. :35.520 Max. :106.00 Max. :209.4
##
## Wt
## Min. : 37.80
## 1st Qu.: 66.53
## Median : 74.40
## Mean : 75.01
## 3rd Qu.: 84.12
## Max. :123.20
## 0.4.1.1 Valores propios
ais.active<-ais[,3:ncol(ais)]
res.pca <- PCA(ais.active, graph = FALSE)
eig.val <- get_eigenvalue(res.pca)
eig.val## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 4.990960588 45.372368983 45.37237
## Dim.2 2.557676373 23.251603389 68.62397
## Dim.3 1.157299795 10.520907229 79.14488
## Dim.4 0.889205819 8.083689266 87.22857
## Dim.5 0.795285026 7.229863877 94.45843
## Dim.6 0.433899882 3.944544384 98.40298
## Dim.7 0.105161008 0.956009166 99.35899
## Dim.8 0.040935973 0.372145211 99.73113
## Dim.9 0.023191833 0.210834846 99.94197
## Dim.10 0.005300995 0.048190863 99.99016
## Dim.11 0.001082707 0.009842787 100.00000fviz_eig(res.pca, addlabels = TRUE, ylim = c(0, 50),main = "")
0.4.2 Componentes principales como combicación lineal de las variables
res.pca$var$coord## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## RCC 0.8366476 -0.25422918 0.25248785 0.204900533 0.20623716
## WCC 0.1700154 0.23443562 0.68550547 0.183352990 -0.63501656
## Hc 0.8695328 -0.27075806 0.24001016 0.192413311 0.19035125
## Hg 0.8801837 -0.23732261 0.23490019 0.118797678 0.21972438
## Fe 0.4042893 0.06430965 0.29377694 -0.837901236 -0.03221278
## BMI 0.5739135 0.67803494 0.07488143 -0.106343505 0.23169881
## SSF -0.3944878 0.84101150 0.19263747 0.109237677 0.19987575
## Bfat -0.5308974 0.75726937 0.20477958 0.131454278 0.19781462
## LBM 0.8935221 0.29622614 -0.28467616 -0.050197146 -0.11672301
## Ht 0.6574536 0.31663387 -0.46071694 0.131627571 -0.34032536
## Wt 0.7552082 0.61304208 -0.21585263 -0.004627216 -0.041764530.4.2.1 Círculo de correlaciones
Entonces el espacio de las variables de un ACP normado es una representación de la matriz de correlaciones, porque la norma de todas las variables es uno y el coseno entre dos vectores variables es igual a la correlación entre ellas. Si dos vectores variables tienen ángulo pequeño su correlación es alta, dos vectores variables ortogonales indican que las variables no están correlacionadas.
fviz_pca_var(res.pca, col.var = "black",repel = TRUE)
0.4.2.2 Calidad de representación - Cosenos cuadrado
La calidad de representación puede interpretarse tambien como la correlación al cuadrado entre los valores de la variable original y las proyecciones de los puntos sobre la dirección que representa a la variable.
- Las variables y los individuos van a proyectar su sombra (producto punto) en cada componente principal, esta sombra va a estar descompuesta en cada uno de los ejes, es decir que no todas las variables (individuos) estarán bien representadas en cada eje o plano, por lo cual en cada eje se debe interpretar las variables con altos cosenos al cuadrado.
var <- get_pca_var(res.pca)
corrplot(var$cos2, is.corr=FALSE)
0.4.2.3 Circulo de correlación
Es la proyección de la hiperesfera de correlaciones, flechas que parten del origen y tienen longitud 1. La longitud de la proyección, sin error, de un vector-variable es 1. La calidad de la representación en el plano de las variables se observa visualmente al dibujar un círculo de radio uno en el plano factorial.
fviz_pca_var(res.pca, col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE # Avoid text overlapping
)
0.4.2.4 Contribuciones de las variables en los ejes
las contribuciones a la inercia de los ejes sirven para detectar los variables mas relevantes en cada.
corrplot(var$contrib, is.corr=FALSE) 
0.4.2.5 Plano Factorial individuos
fviz_pca_ind(res.pca, col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")
#,repel = TRUE # Avoid text overlapping (slow if many points)
)
0.4.2.6 Variables ilustrativas
fviz_pca_ind(res.pca,
geom.ind = "point", # show points only (nbut not "text")
col.ind = ais$sex, # color by groups
palette = c("#00AFBB", "#E7B800", "#FC4E07"),
addEllipses = TRUE, # Concentration ellipses
legend.title = "Sexo"
)
#install.packages("RColorBrewer")
library(RColorBrewer)
fviz_pca_ind(res.pca,
geom.ind = "point", # show points only (nbut not "text")
col.ind = ais$sport, # color by groups
palette = brewer.pal(10,"Paired"),
addEllipses = TRUE, # Concentration ellipses
legend.title = "Deporte"
)
0.4.2.7 Representación simultanea y otros planos
fviz_pca_biplot(res.pca, axes = c(1,2),
# Individuals
geom.ind = "point",
fill.ind = ais$sex, col.ind = "black",
pointshape = 21, pointsize = 2,
palette = "jco",
addEllipses = TRUE,
# Variables
alpha.var ="contrib",
#col.var = "contrib",
gradient.cols = "RdYlBu",repel = TRUE
# ,legend.title = list(fill = "Sex", color = "Contrib",
# alpha = "Contrib")
)
fviz_pca_biplot(res.pca, axes = c(2,3),
# Individuals
geom.ind = "point",
fill.ind = ais$sex, col.ind = "black",
pointshape = 21, pointsize = 2,
palette = "jco",
addEllipses = TRUE,
# Variables
alpha.var ="contrib",
#col.var = "contrib",
gradient.cols = "RdYlBu",repel = TRUE
# ,legend.title = list(fill = "Sex", color = "Contrib",
# alpha = "Contrib")
)
0.5 Ejercicio
0.5.1 Desempeño Municipal
La Medición de Desempeño Municipal-MDM tiene como objetivo medir y comparar el desempeño municipal entendido como la gestión de las Entidades Territoriales y la consecución de resultados de desarrollo (el aumento de la calidad de vida de la población) teniendo en cuenta las capacidades iniciales de los municipios, para incentivar la inversión orientada a resultados y como instrumento para el diseño de políticas dirigidas al fortalecimiento de capacidades y al cierre de brechas territoriales.
La MDM se mide al interior de 6 grupos que buscan categorizar municipios “similares” según el nivel de capacidades iniciales, esto con el fin de hacer la medición entre grupos homogéneos controlando por diferencias iniciales de desarrollo territorial. Los grupos son: Ciudades (13 principales ciudades) Grupo 1 (nivel alto de capacidades) Grupo 2 (medio alto) Grupo 3 (nivel medio) Grupo 4 (medio bajo) y Grupo 5 (nivel bajo). https://www.dnp.gov.co/programas/desarrollo-territorial/Estudios-Territoriales/Indicadores-y-Mediciones/Paginas/desempeno-integral.aspx
desempeno<-read.table("Desempeno municipal.csv",header=T,sep=",")
row.names(desempeno)<-desempeno$Codigo
desempeno$desempeno_cuartil<-cut(desempeno$Desempeno.Municipal,breaks = quantile(desempeno$Desempeno.Municipal, prob=c(0,0.25,0.5,0.75,1)),labels = paste("Cuartil", 1:4),include.lowest = TRUE)
desempeno$Ingresos.tributarios.y.no.tributarios.per.cápita_cuartil<-cut(desempeno$Ingresos.tributarios.y.no.tributarios.per.cápita,breaks = quantile(desempeno$Ingresos.tributarios.y.no.tributarios.per.cápita, prob=c(0,0.25,0.5,0.75,1)),labels = paste("Cuartil", 1:4),include.lowest = TRUE)
# table(desempeno$Ingresos.tributarios.y.no.tributarios.per.cápita_cuartil)
# dput(names(desempeno.act))
desempeno.act<-desempeno[,7:20]
desempeno.act[is.na(desempeno.act)]<-0
names(desempeno.act)<-c("Cobertura.media.neta", "SABER.11.Matematicas", "SABER.11.Lenguaje", "Cobertura.Transición",
"Cobertura.salud", "Vacunación.Pentavalente", "Mortalidad.Infantil", "Cobertura.eléctrica.rural",
".Cobertura.internet", "Cobertura.Acueducto", "Cobertura.Alcantarillado", "Hurtos.x.10000.hab",
"Homicidios.x.10000.hab", "Violencia.Intrafamiliar.x.10000.hab")
res.pca <- PCA(desempeno.act, graph = FALSE)corrplot(cor(desempeno.act),type="upper")
# install.packages("GGally")
# library(ggplot2)
# source("https://raw.githubusercontent.com/briatte/ggcorr/master/ggcorr.R")
#ggcorr(desempeno.act, geom = "circle", nbreaks = 5)0.5.1.1 Circulo de correlaciones
fviz_pca_var(res.pca, col.var = "black",repel = TRUE)
0.5.1.2 Cosenos cuadrado
var <- get_pca_var(res.pca)
corrplot(var$cos2, is.corr=FALSE)
0.5.1.3 Circulo de correlación
fviz_pca_var(res.pca, col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE # Avoid text overlapping
)
0.5.1.4 Contribuciones de las variables en los ejes
corrplot(var$contrib, is.corr=FALSE) 
0.5.1.5 Plano Factorial individuos
fviz_pca_ind(res.pca, col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")
#,repel = TRUE # Avoid text overlapping (slow if many points)
)
0.5.1.6 Variables ilustrativas
0.5.1.6.1 Grupo de dotaciones
fviz_pca_ind(res.pca,
geom.ind = "point", # show points only (nbut not "text")
col.ind = desempeno$Grupo.dotaciones, # color by groups
palette = brewer.pal(10,"Paired"),
#addEllipses = TRUE, # Concentration ellipses
legend.title = "Grupo dotaciones"
)
0.5.1.6.2 Categoría de ruralidad
#install.packages("RColorBrewer")
library(RColorBrewer)
fviz_pca_ind(res.pca,
geom.ind = "point", # show points only (nbut not "text")
col.ind = desempeno$Categoria.de.ruralidad, # color by groups
palette = brewer.pal(10,"Paired"),
#addEllipses = TRUE, # Concentration ellipses
legend.title = "Categoría de ruralidad"
)
0.5.1.6.3 Cuartil de desempeño
fviz_pca_ind(res.pca,
geom.ind = "point", # show points only (nbut not "text")
col.ind = desempeno$desempeno_cuartil, # color by groups
palette = brewer.pal(10,"Paired"),
#addEllipses = TRUE, # Concentration ellipses
legend.title = "Cuartil de desempeño"
)
0.5.1.6.4 Ingresos tributarios y no tributarios per cápita
fviz_pca_ind(res.pca,
geom.ind = "point", # show points only (nbut not "text")
col.ind = desempeno$Ingresos.tributarios.y.no.tributarios.per.cápita_cuartil, # color by groups
palette = brewer.pal(10,"Paired"),
#addEllipses = TRUE, # Concentration ellipses
legend.title = "Ingresos per cápita"
)
0.5.1.7 Representación simultanea y otros planos
fviz_pca_biplot(res.pca, axes = c(1,2),
# Individuals
geom.ind = "point",
fill.ind = desempeno$Ingresos.tributarios.y.no.tributarios.per.cápita_cuartil,
col.ind = "black",
pointshape = 21,
pointsize = 2,
palette = "jco",
#addEllipses = TRUE,
# Variables
alpha.var ="contrib",
#col.var = "contrib",
gradient.cols = "RdYlBu",repel = TRUE
,legend.title = list(fill = "Ingresos per capita", color = "Contrib",
alpha = "Contrib")
)
0.5.1.8 Plano factorial 2-3
fviz_pca_biplot(res.pca, axes = c(2,3),
# Individuals
geom.ind = "point",
fill.ind = desempeno$Ingresos.tributarios.y.no.tributarios.per.cápita_cuartil,
col.ind = "black",
pointshape = 21, pointsize = 2,
palette = "jco",
#addEllipses = TRUE,
# Variables
alpha.var ="contrib",
#col.var = "contrib",
gradient.cols = "RdYlBu",repel = TRUE
,legend.title = list(fill = "Ingresos per capita", color = "Contrib",
alpha = "Contrib")
)