Analisis de componentes principales
astrid Muñoz
2024-08-27
Tabs
Análisis de componentes principales
###Paquetes
#install.packages("sf")
library(corrr)
library(corrplot)## corrplot 0.94 loadedlibrary(FactoMineR)
library(factoextra)## Cargando paquete requerido: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(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':
##
## layoutlibrary(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, unionlibrary(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 TRUElibrary(readr)Dataset
Los datos de este dataset miden el consumo de proteinas en 25 paises para nueve grupos de alimentos (carne roja, carne blanca, )
proteinData <- read_csv("protein.csv")## Rows: 25 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Country
## dbl (10): Red_Meat, White_Meat, Eggs, Milk, Fish, Cereals, Starchy_Foods, Pu...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.str(proteinData)## spc_tbl_ [25 × 11] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Country : chr [1:25] "Albania" "Austria" "Belgium" "Bulgaria" ...
## $ Red_Meat : num [1:25] 10 9 14 8 10 11 8 10 18 10 ...
## $ White_Meat : num [1:25] 1 14 9 6 11 11 12 5 10 3 ...
## $ Eggs : num [1:25] 1 4 4 2 3 4 4 3 3 3 ...
## $ Milk : num [1:25] 9 20 18 8 13 25 11 34 20 18 ...
## $ Fish : num [1:25] 0 2 5 1 2 10 5 6 6 6 ...
## $ Cereals : num [1:25] 42 28 27 57 34 22 25 26 28 42 ...
## $ Starchy_Foods : num [1:25] 1 4 6 1 5 5 7 5 5 2 ...
## $ Pulses_nuts_oilseeds: num [1:25] 6 1 2 4 1 1 1 1 2 8 ...
## $ Fruits_Vegetables : num [1:25] 2 4 4 4 4 2 4 1 7 7 ...
## $ Total : num [1:25] 72 86 89 91 83 91 77 91 99 99 ...
## - attr(*, "spec")=
## .. cols(
## .. Country = col_character(),
## .. Red_Meat = col_double(),
## .. White_Meat = col_double(),
## .. Eggs = col_double(),
## .. Milk = col_double(),
## .. Fish = col_double(),
## .. Cereals = col_double(),
## .. Starchy_Foods = col_double(),
## .. Pulses_nuts_oilseeds = col_double(),
## .. Fruits_Vegetables = col_double(),
## .. Total = col_double()
## .. )
## - attr(*, "problems")=<externalptr>Presencia de datos nulos
colSums(is.na(proteinData))## 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 numericos.
datosNumericos <- proteinData[,2:10]Calcular la media y varianza de los datos.
#Si margin es igual a 1, opera sobre las filas
#Si margin es igual a 2, opera sobre las columnas
apply(X = datosNumericos, 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 = datosNumericos, 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 = datosNumericos, MARGIN = 2, FUN = sd) #desviacion estandar## 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
dataNormalized <- scale(datosNumericos)Despues de transformar los datos, tendremos una media de cercana 0 y una varianza iual a 1
apply(X = dataNormalized, 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-16apply(X = dataNormalized, MARGIN = 2, FUN = var) #Varianza## Red_Meat White_Meat Eggs
## 1 1 1
## Milk Fish Cereals
## 1 1 1
## Starchy_Foods Pulses_nuts_oilseeds Fruits_Vegetables
## 1 1 1Una vez normalizados los datos, aplicamos el analisis de componentes principales ACP
data.cpa <- princomp(dataNormalized)Loadings contiene los valores propios para cada componente (eigenvector). El numero maximo de componentes que se calculan, son: min(n-1,p). En nuestro 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.000summary(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 mas significativos, ya que contienen casi el 86% de los datos.
corr_matrix <- cor(dataNormalized)
ggcorrplot::ggcorrplot(corr_matrix)
Screen Plot, sirve para visualizar la importancia de cada componente principal
fviz_eig(data.cpa,addlabels = TRUE)
Grafico Biplot
fviz_pca_var(data.cpa)
fviz_cos2(data.cpa, choice = "var",axes = 1:4)
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
proteinData$Cluster <- as.factor(kmeans_result$cluster)# Visualización del clustering en el espacio de los dos primeros componentes principales
plot1<-ggplot(proteinData, aes(x = cpa_scores[,1], y = cpa_scores[,2], color = Cluster, label = rownames(proteinData))) +
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 Paises basado en el Consumo de Proteinas",
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 <- proteinData%>% 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 <- proteinData%>% 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 Paises Europeos basados en el Consumo de Proteinas",
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],
PC4 = cpa_scores[, 4],
Red_Meat = proteinData$Red_Meat)# Ajustar un modelo de regresión lineal usando las primeras 3 componentes principales
regression_model <- lm(Red_Meat ~ PC1 + PC2 + PC3 + PC4, data = regression_data)# Resumen del modelo
summary(regression_model)##
## Call:
## lm(formula = Red_Meat ~ PC1 + PC2 + PC3 + PC4, data = regression_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.18498 -0.92786 -0.06316 0.78331 2.73909
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.8000 0.2767 35.418 < 2e-16 ***
## PC1 1.0573 0.1395 7.577 2.67e-07 ***
## PC2 0.2368 0.2215 1.069 0.297899
## PC3 1.2098 0.2711 4.463 0.000238 ***
## PC4 2.0302 0.2969 6.839 1.20e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.383 on 20 degrees of freedom
## Multiple R-squared: 0.8623, Adjusted R-squared: 0.8348
## F-statistic: 31.31 on 4 and 20 DF, p-value: 2.359e-08plot_model <- ggplot(regression_data, aes(x = PC4, y = Red_Meat)) +
geom_point(color = "blue") +
geom_smooth(method = "lm", formula = y ~ x, color = "red") +
labs(title = "Modelo de Regresion: 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, PC4 = 0.4)
# 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: 11.31"