PCA
Nazly R. Hincapie Monsalve
2024-08-27
Tabs
Análisis de componentes principales
###Paquetes
#Matriz de correlación
library(corrr)
library(corrplot)## corrplot 0.94 loaded#PCA
library(FactoMineR)
library(factoextra)## Cargando paquete requerido: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa#Gráficos
library(ggplot2)
library(plotly)##
## Adjuntando el paquete: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layout#Manejo datos
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union#Mapas
library(rworldmap)## Cargando paquete requerido: sp## ### Welcome to rworldmap ##### For a short introduction type : vignette('rworldmap')library(rnaturalearth)
library(rnaturalearthdata)##
## Adjuntando el paquete: 'rnaturalearthdata'## The following object is masked from 'package:rnaturalearth':
##
## countries110library(sf)## Linking to GEOS 3.12.1, GDAL 3.8.4, PROJ 9.3.1; sf_use_s2() is TRUEDataset
Los datos miden el consumo de proteínas en 25 países para nueve grupos de alimentos (carne roja, carne balnce).
protein_data<-read.csv("protein.csv")
str(protein_data)## 'data.frame': 25 obs. of 11 variables:
## $ Country : chr "Albania" "Austria" "Belgium" "Bulgaria" ...
## $ Red_Meat : int 10 9 14 8 10 11 8 10 18 10 ...
## $ White_Meat : int 1 14 9 6 11 11 12 5 10 3 ...
## $ Eggs : int 1 4 4 2 3 4 4 3 3 3 ...
## $ Milk : int 9 20 18 8 13 25 11 34 20 18 ...
## $ Fish : int 0 2 5 1 2 10 5 6 6 6 ...
## $ Cereals : int 42 28 27 57 34 22 25 26 28 42 ...
## $ Starchy_Foods : int 1 4 6 1 5 5 7 5 5 2 ...
## $ Pulses_nuts_oilseeds: int 6 1 2 4 1 1 1 1 2 8 ...
## $ Fruits_Vegetables : int 2 4 4 4 4 2 4 1 7 7 ...
## $ Total : int 72 86 89 91 83 91 77 91 99 99 ...Presencia de datos nulos
colSums(is.na(protein_data))## Country Red_Meat White_Meat
## 0 0 0
## Eggs Milk Fish
## 0 0 0
## Cereals Starchy_Foods Pulses_nuts_oilseeds
## 0 0 0
## Fruits_Vegetables Total
## 0 0Solamente vamos a seleccionar los datos numéricos
numerical_data <- protein_data[,2:10]Calcular la media y la varianza de los datos
#MARGIN=1 opera sobre filas y MARGIN=2 opera sobre columnas
apply(X=numerical_data, MARGIN =2,FUN = mean) #Media## Red_Meat White_Meat Eggs
## 9.80 7.92 3.08
## Milk Fish Cereals
## 17.28 4.28 32.32
## Starchy_Foods Pulses_nuts_oilseeds Fruits_Vegetables
## 4.36 3.08 4.20apply(X=numerical_data, MARGIN =2,FUN = var) #Varianza## Red_Meat White_Meat Eggs
## 11.583333 13.993333 1.243333
## Milk Fish Cereals
## 50.376667 12.043333 121.226667
## Starchy_Foods Pulses_nuts_oilseeds Fruits_Vegetables
## 2.740000 4.076667 3.666667apply(X=numerical_data, MARGIN =2,FUN = sd) # desviación estándar## Red_Meat White_Meat Eggs
## 3.403430 3.740766 1.115049
## Milk Fish Cereals
## 7.097652 3.470351 11.010298
## Starchy_Foods Pulses_nuts_oilseeds Fruits_Vegetables
## 1.655295 2.019076 1.914854Normalizar los datos
# se resta la mean y se divide por sd
data_normalized <- scale(numerical_data)Después de aplicar esa transformación a los datos, tendrán una media de aproximadamente 0 y una varianza de 1.
mean(data_normalized[,1])## [1] -2.192951e-16apply(X=data_normalized, MARGIN =2,FUN = mean) #Media## Red_Meat White_Meat Eggs
## -2.192951e-16 1.097646e-17 -6.438426e-17
## Milk Fish Cereals
## -1.701417e-16 -6.438426e-17 -1.774622e-17
## Starchy_Foods Pulses_nuts_oilseeds Fruits_Vegetables
## -1.976479e-16 -1.833169e-17 -1.021492e-16#apply(X=data_normalized, MARGIN =2,FUN = var) #VarianzaAplicar ACP
data.cpa <- princomp(data_normalized)loadings contiene los valores propios para cada componente (eigenvector). El número máximo de componentes que se calculan, se calcula el min(n-1,p). En este caso, min(24,9)=9.
data.cpa$loadings##
## Loadings:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## Red_Meat 0.311 0.355 0.597 0.397 0.377 0.228
## White_Meat 0.316 0.215 -0.628 -0.311 0.146
## Eggs 0.421 0.255 -0.665 0.467
## Milk 0.379 0.169 0.404 -0.318 -0.718 -0.102
## Fish 0.134 -0.652 0.300 -0.235 -0.304 0.237 0.441
## Cereals -0.430 0.254 0.185 0.194 -0.343 0.721
## Starchy_Foods 0.296 -0.389 -0.281 -0.305 0.673 -0.326
## Pulses_nuts_oilseeds -0.422 -0.129 0.140 0.251 -0.587 -0.218
## Fruits_Vegetables -0.122 -0.504 -0.340 0.604 -0.228 0.158 -0.359
## Comp.9
## Red_Meat 0.251
## White_Meat 0.577
## Eggs -0.275
## Milk 0.190
## Fish 0.260
## Cereals 0.192
## Starchy_Foods 0.150
## Pulses_nuts_oilseeds 0.567
## Fruits_Vegetables -0.211
##
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 Comp.9
## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
## Proportion Var 0.111 0.111 0.111 0.111 0.111 0.111 0.111 0.111 0.111
## Cumulative Var 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000#PC1 = 0.311*Red_Meat + 0.316*White_Meat + 0.421*Eggs + ...
#PC2 = 0.215*White_Meat + ...summary(data.cpa)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 1.9828553 1.2489623 1.0207403 0.9321032 0.6400533
## Proportion of Variance 0.4550596 0.1805448 0.1205915 0.1005574 0.0474153
## Cumulative Proportion 0.4550596 0.6356044 0.7561959 0.8567534 0.9041687
## Comp.6 Comp.7 Comp.8 Comp.9
## Standard deviation 0.57711577 0.50866787 0.35936288 0.32716279
## Proportion of Variance 0.03854891 0.02994711 0.01494695 0.01238837
## Cumulative Proportion 0.94271757 0.97266468 0.98761163 1.00000000Los cuatro primeros componentes principales pueden considerarse como los más significativos, ya que contienen casi el 86% de la información total de los datos.
corr_matrix<-cor(data_normalized)
ggcorrplot::ggcorrplot(corr_matrix)
Scree plot Sirve para visualizar la importancia de cada componente
principal y puede utilizarse para determinar el número de componentes
principales que deben conservarse.
fviz_eig(data.cpa,addlabels = TRUE)
Biplot
Las variables agrupadas están correlacionadas.
fviz_pca_var(data.cpa)
fviz_cos2(data.cpa,choice = "var",axes=1:2)
Clusterización k-means
Suponiendo que ya tienes el objeto data.pca con los componentes principales
# Extraer los scores de los primeros cuatro componentes
cpa_scores <- data.cpa$scores[, 1:4]# Realizar K-means clustering (25 observaciones correspondientes a los países)
set.seed(123) # Para reproducibilidad
kmeans_result <- kmeans(cpa_scores, centers = 3, nstart = 25)# Añadir el cluster asignado a cada país al dataframe original
protein_data$Cluster <- as.factor(kmeans_result$cluster)# Visualización del clustering en el espacio de los dos primeros componentes principales
plot1<-ggplot(protein_data, aes(x = cpa_scores[,1], y = cpa_scores[,2], color = Cluster, label = rownames(protein_data))) +
geom_point(size = 5) + # Dibuja los puntos de dispersión con un tamaño de 5
geom_text(vjust = 1.5) + # Añade los nombres de los países, con un desplazamiento vertical para que no se superpongan con los puntos
labs(title = "Clustering de Países basado en el Consumo de Proteínas",
x = "Componente Principal 1", # Etiqueta del eje X
y = "Componente Principal 2") + # Etiqueta del eje Y
theme_minimal() # Utiliza un tema minimalista para la gráfica
ggplotly(plot1)Representación en el mapa
# Seleccionar las columnas Country y Cluster
country_clusters <- protein_data%>% select(Country,Cluster)# Obtener los datos del mapa
world <- ne_countries(scale = "medium", returnclass = "sf")# Revisar los nombres de los países
# Nombres de países en el mapa del mundo
world_countries <- unique(world$name)
# Nombres de países en tu dataset
protein_countries <- unique(country_clusters$Country)
# Países que están en el dataset y no en el mapa del mundo
missing_in_world <- setdiff(protein_countries, world_countries)
# Imprimir resultados
print("Países en el dataset pero no en el mapa del mundo:")## [1] "Países en el dataset pero no en el mapa del mundo:"print(missing_in_world)## [1] "Czechoslovakia" "East_Germany" "The_Netherlands" "United_Kingdom"
## [5] "USSR" "West_Germany" "Yugoslavia"country_clusters <- protein_data%>% select(Country,Cluster)%>%
mutate(Country = recode(Country,
"United_Kingdom" = "United Kingdom",
"Yugoslavia" = "Serbia","East_Germany"= "Germany",
"West_Germany"= "Germany","The_Netherlands"= "Netherlands",
"Czechoslovakia"= "Czechia",
"USSR"= "Russia")) # Puedes ajustar según el caso
# Unir los clústeres con los datos del mapamap_data <- left_join(world, country_clusters, by = c("name" = "Country"))
ggplot(data = map_data) +
geom_sf(aes(fill = Cluster)) +
scale_fill_manual(values = c("pink", "green", "skyblue"), na.value = "lightgrey") +
theme_minimal() +
labs(title = "Clustering de Países Europeos basados en el Consumo de Proteínas",
fill = "Cluster") +
theme(legend.position = "bottom") +
coord_sf(xlim = c(-25, 45), ylim = c(35, 70), expand = FALSE) # Ajustar la vista a Europa
Análisis de regresión
Supongamos que quieres predecir el consumo de Red_Meat (Carne Roja) usando las componentes principales obtenidas del PCA.
# Crear un DataFrame con las componentes principales y la variable respuesta
regression_data <- data.frame(PC1 = cpa_scores[, 1],
PC2 = cpa_scores[, 2],
PC3 = cpa_scores[, 3],
Red_Meat = protein_data$Red_Meat)# Ajustar un modelo de regresión lineal usando las primeras 3 componentes principales
regression_model <- lm(Red_Meat ~ PC1 + PC2 + PC3, data = regression_data)# Resumen del modelo
summary(regression_model)##
## Call:
## lm(formula = Red_Meat ~ PC1 + PC2 + PC3, data = regression_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.123 -1.069 -0.436 1.221 6.699
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.8000 0.4934 19.863 4.3e-15 ***
## PC1 1.0573 0.2488 4.249 0.000358 ***
## PC2 0.2368 0.3950 0.599 0.555329
## PC3 1.2098 0.4834 2.503 0.020650 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.467 on 21 degrees of freedom
## Multiple R-squared: 0.5403, Adjusted R-squared: 0.4746
## F-statistic: 8.227 on 3 and 21 DF, p-value: 0.0008238plot_model <- ggplot(regression_data, aes(x = PC1, y = Red_Meat)) +
geom_point(color = "blue") +
geom_smooth(method = "lm", formula = y ~ x, color = "red") +
labs(title = "Modelo de Regresión: Red_Meat vs. PC1",
x = "Componente Principal 1 (PC1)",
y = "Consumo de Carne Roja (Red_Meat)") +
theme_minimal()
# Mostrar el gráfico
plot_model
# Nuevo punto para predecir (valores de PC1, PC2, PC3)
nuevo_punto <- data.frame(PC1 = 0.5, PC2 = -0.3, PC3 = 0.2)
# Predicción del modelo
prediccion <- predict(regression_model, newdata = nuevo_punto)
# Mostrar la predicción
print(paste("Predicción del consumo de Red_Meat para los valores dados:", round(prediccion, 2)))## [1] "Predicción del consumo de Red_Meat para los valores dados: 10.5"