Introducción

El objetivo de este estudio es analizar los patrones de consumo de diferentes categorías alimentarias en 25 países europeos mediante técnicas de estadística multivariada. En particular, se empleará el Análisis de Componentes Principales (PCA) para identificar estructuras subyacentes, relaciones entre variables y agrupamientos entre países.

Carga y preparación de datos

setwd("C:/Users/HECTOR HERNANDEZ/Documents/BackUp Dell 8Oct21/Del 2026/Ejercicios para PUBLICAR")
data <- read.csv("PCA_Protein_Consumption.csv")

Datos_pca

##                RMeat WMeat Eggs Milk Fish Cereals Starch Seeds FruitsVeg
## Albania           10     1    1    9    0      42      1     6         2
## Austria            9    14    4   20    2      28      4     1         4
## Belgium           14     9    4   18    5      27      6     2         4
## Bulgaria           8     6    2    8    1      57      1     4         4
## Czechoslovakia    10    11    3   13    2      34      5     1         4
## Denmark           11    11    4   25   10      22      5     1         2
## E.Germany          8    12    4   11    5      25      7     1         4
## Finland           10     5    3   34    6      26      5     1         1
## France            18    10    3   20    6      28      5     2         7
## Greece            10     3    3   18    6      42      2     8         7
## Hungary            5    12    3   10    0      40      4     5         4
## Ireland           14    10    5   26    2      24      6     2         3
## Italy              9     5    3   14    3      37      2     4         7
## Netherlands       10    14    4   23    3      22      4     2         4
## Norway             9     5    3   23   10      23      5     2         3
## Poland             7    10    3   19    3      36      6     2         7
## Portugal           6     4    1    5   14      27      6     5         8
## Romania            6     6    2   11    1      50      3     5         3
## Spain              7     3    3    9    7      29      6     6         7
## Sweden            10     8    4   25    8      20      4     1         2
## Switzerland       13    10    3   24    2      26      3     2         5
## UK                17     6    5   21    4      24      5     3         3
## USSR               9     5    2   17    3      44      6     3         3
## W.Germany         11    13    4   19    3      19      5     2         4
## Yugoslavia         4     5    1   10    1      56      3     6         3

Datos estimados del consumo promedio de proteina de diferentes fuentes de alimentación para los habitantes de 25 países Europeos *Weber (1973) .

Estadística descriptiva

A continuación se presenta un resumen descriptivo de las variables analizadas.

datatable(
  sapply(datos_pca,summary))
datatable(
  round(sapply(datos_pca,summary),2),
caption = "Estadísticos descriptivos de consumo alimentario"
)
datatable(
  round(describe(datos_pca),2),
  caption = "Estadísticos descriptivos de consumo alimentario")
colores <- c(
  "firebrick",
  "sandybrown",
  "gold",
  "lightblue",
  "steelblue",
  "darkolivegreen3",
  "tan",
  "turquoise3",
  "forestgreen"
)

boxplot(
  datos_pca,
  las = 2,
  col = colores,
  main = "Boxplot Consumo Alimentario"
)

# las = 2 orientación vertical texto

Media por País (renglones) y por Categoría alimentaria (columnas)

rowMeans(datos_pca)
##        Albania        Austria        Belgium       Bulgaria Czechoslovakia 
##       8.000000       9.555556       9.888889      10.111111       9.222222 
##        Denmark      E.Germany        Finland         France         Greece 
##      10.111111       8.555556      10.111111      11.000000      11.000000 
##        Hungary        Ireland          Italy    Netherlands         Norway 
##       9.222222      10.222222       9.333333       9.555556       9.222222 
##         Poland       Portugal        Romania          Spain         Sweden 
##      10.333333       8.444444       9.666667       8.555556       9.111111 
##    Switzerland             UK           USSR      W.Germany     Yugoslavia 
##       9.777778       9.777778      10.222222       8.888889       9.888889
colMeans(datos_pca)
##     RMeat     WMeat      Eggs      Milk      Fish   Cereals    Starch     Seeds 
##      9.80      7.92      3.08     17.28      4.28     32.32      4.36      3.08 
## FruitsVeg 
##      4.20

Los cereales tienen el más alto consumo con un promedio de 32.23g ,la dispersion es de 11.01, muy alta, lo cual significa que existen diversos niveles de consumo El siguiente grupo con consumo promedio alto es de carnes rojas 9.8 g, carnes blancas 7.92 g, leche 17.28 g con sd.7.1g, este último con variación también alta. En contraste con promedios bajos tenemos: Huevos 3.8 g, Pescado 4.28g, Almidones con 4.36 g, semillas 3.08, Frutas y vegetales 4.92. Lo anterior vemos mayor predominancia de dieta fuentes de origen de proteina animal y menor las de origen vegetal, a excepción del cereal cuyo consumo es alto.

corr_matrix <- round(cor(datos_pca),2)

print(corr_matrix)
##           RMeat WMeat  Eggs  Milk  Fish Cereals Starch Seeds FruitsVeg
## RMeat      1.00  0.19  0.58  0.54  0.06   -0.51   0.15 -0.41     -0.06
## WMeat      0.19  1.00  0.60  0.30 -0.20   -0.44   0.33 -0.67     -0.07
## Eggs       0.58  0.60  1.00  0.61  0.05   -0.70   0.41 -0.60     -0.16
## Milk       0.54  0.30  0.61  1.00  0.16   -0.59   0.21 -0.62     -0.40
## Fish       0.06 -0.20  0.05  0.16  1.00   -0.52   0.44 -0.12      0.23
## Cereals   -0.51 -0.44 -0.70 -0.59 -0.52    1.00  -0.58  0.64      0.04
## Starch     0.15  0.33  0.41  0.21  0.44   -0.58   1.00 -0.50      0.07
## Seeds     -0.41 -0.67 -0.60 -0.62 -0.12    0.64  -0.50  1.00      0.35
## FruitsVeg -0.06 -0.07 -0.16 -0.40  0.23    0.04   0.07  0.35      1.00
corrplot(
  corr_matrix,
  method = "circle",
  type = "lower",
  tl.srt = 45,
  tl.col = "black",
  tl.cex = 0.5,
  col= colores
)

 mtext("Matriz de Correlaciones",side = 3, line=3)

Matriz de correlaciones La matriz de correlaciones permite identificar relaciones entre las categorías alimentarias. Existen relaciones altas entre las categorías lo cual justifica realizar el PCA, Se observan grupos alimenticios con correlaciones positivas como las carnes rojas con el Huevo y la Leche, Hay correlaciones negativas, altas como las carnes rojas con los cereales o las carnes blancas con las semillas, en estos casos de correlaciones negativas es un indicador de que el consumo de unos alimentos se asocia con un consumo menor de otros. Algunas correlaciones son cercanas a cero, en este casos son alimentos cuyo consumo es independientes. Está matriz de correlaciones es adecuada para el estudio.

Heatmap

El mapa de calor permite identificar patrones de consumo similares entre países y categorías alimentarias. La comparación por categorías (columnas) compara como esta un país respecto al promedio de los otros países. se utilizan datos estandarizados. función: pheatmat()

pheatmap(as.matrix(datos_pca),
         color = colores,
         scale = "column",
         main = " Heat Map Consumo de Proteinas por país (columna)")

# Construcción Tabla Estandarizada

datos_col <- scale(datos_pca)

tabla_heat <- data.frame(
  Pais = rownames(datos_col),
    round(datos_col,2)
  )

datatable(
  tabla_heat,
  caption = "Datos Estandarizados para Heat Map"
)

Evaluación de Supuestos del PCA

Supuestos del Modelo PCA

Determinante de la matriz de correlaciones

det(corr_matrix)
## [1] 0.003873461

det > 0.00001 , indica la existencia de correlaciones

Prueba de Bartlett

cortest.bartlett(corr_matrix,
                 n = nrow(datos_pca))
## $chisq
## [1] 111.9977
## 
## $p.value
## [1] 0.000000001001365
## 
## $df
## [1] 36

p-value < .05 Las variables están correlacionadas.

Índice KMO

KMO(datos_pca)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = datos_pca)
## Overall MSA =  0.68
## MSA for each item = 
##     RMeat     WMeat      Eggs      Milk      Fish   Cereals    Starch     Seeds 
##      0.66      0.53      0.77      0.81      0.41      0.78      0.77      0.69 
## FruitsVeg 
##      0.39

KMO > 0.60 La estructura es buena para reducir dimensiones

Análisis de Componentes Principales

pca <- prcomp(datos_pca,
              scale. = TRUE)

summary(pca)
## Importance of components:
##                           PC1    PC2    PC3    PC4     PC5     PC6     PC7
## Standard deviation     2.0237 1.2747 1.0418 0.9513 0.65325 0.58902 0.51916
## Proportion of Variance 0.4551 0.1805 0.1206 0.1006 0.04742 0.03855 0.02995
## Cumulative Proportion  0.4551 0.6356 0.7562 0.8568 0.90417 0.94272 0.97266
##                            PC8     PC9
## Standard deviation     0.36677 0.33391
## Proportion of Variance 0.01495 0.01239
## Cumulative Proportion  0.98761 1.00000
pca$sdev
## [1] 2.0237432 1.2747169 1.0417887 0.9513238 0.6532516 0.5890163 0.5191570
## [8] 0.3667732 0.3339091
pca$sdev^2 #varianzas
## [1] 4.0955365 1.6249031 1.0853237 0.9050170 0.4267377 0.3469402 0.2695240
## [8] 0.1345226 0.1114953
pca$rotation  #cargas factoriales
##                  PC1         PC2         PC3         PC4         PC5
## RMeat     -0.3106693 -0.06957085 -0.35546338 -0.59650142  0.39658595
## WMeat     -0.3159279 -0.21457197  0.62841986 -0.03961214 -0.31059983
## Eggs      -0.4205930 -0.09986721  0.08050675 -0.25525634  0.06707700
## Milk      -0.3788776 -0.16867961 -0.40414435  0.03223542 -0.31800256
## Fish      -0.1341071  0.65161517 -0.29971395  0.23487897 -0.30432982
## Cereals    0.4298291 -0.25366332  0.06815673  0.02030764  0.18501820
## Starch    -0.2959618  0.38888491  0.28085511  0.30524504  0.67317396
## Seeds      0.4218085  0.12932932 -0.14030066 -0.25125596  0.09378094
## FruitsVeg  0.1223681  0.50377330  0.34041535 -0.60376932 -0.22763119
##                   PC6         PC7          PC8        PC9
## RMeat      0.37671581 -0.22797808 -0.049688240 -0.2506754
## WMeat      0.08129384 -0.14601621 -0.028186225 -0.5766036
## Eggs      -0.66453033 -0.03595386 -0.467400341  0.2750188
## Milk      -0.01779923  0.71798985  0.102202763 -0.1903416
## Fish       0.04476482 -0.23683595 -0.440552318 -0.2600351
## Cereals    0.19398782  0.34306417 -0.720660760 -0.1921878
## Starch    -0.02444741  0.32554187  0.082975933 -0.1499922
## Seeds     -0.58676016  0.03105426  0.217739473 -0.5666397
## FruitsVeg  0.15823653  0.35941199  0.009714519  0.2114057
pca$x
##                       PC1         PC2          PC3         PC4        PC5
## Albania         3.4062175 -1.43187183 -1.596648133 -0.08434257  0.4124395
## Austria        -1.3961709 -1.07844406  1.234558817 -0.02919248 -0.7564630
## Belgium        -1.6271911  0.27394175 -0.009163712 -0.41608341  0.9108462
## Bulgaria        3.0996115 -1.50333675  0.082356700 -0.30660707 -0.2970873
## Czechoslovakia -0.4277883 -0.57418064  1.159335459  0.21991003  0.3701307
## Denmark        -2.4422594  0.28305004 -0.676942687  1.02016258 -0.6562849
## E.Germany      -1.4249913  0.60782538  1.746831101  0.87710306  0.6028516
## Finland        -1.7006498 -0.58298031 -1.972677332  1.58071748 -0.2011453
## France         -1.4354297  0.89590251 -0.161539920 -1.95053301  0.3099538
## Greece          2.3291742  0.86546599 -1.227337046 -1.75741320 -0.6575195
## Hungary         1.4302687 -0.95052166  1.782611863  0.26555332 -0.1057918
## Ireland        -2.5809791 -0.82037615 -0.161750192 -0.51252848  0.8610870
## Italy           1.5501576  0.16192833 -0.053056104 -1.33599650 -0.7676190
## Netherlands    -1.7115591 -0.78012960  0.766301047 -0.25865817 -0.9164207
## Norway         -0.9571511  1.10929163 -1.319851198  1.21615923 -0.4173226
## Poland         -0.1285106  0.63184836  1.522555810 -0.03104612 -0.1228267
## Portugal        1.8854364  4.23632323  0.235407502  0.64127627 -0.3296311
## Romania         2.6361730 -1.10164486  0.169166371  0.60431439  0.1965040
## Spain           1.4042842  2.43957843  0.249276728 -0.24228673  0.6238140
## Sweden         -1.9196053 -0.08881654 -1.085799797  0.90373795 -0.7886161
## Switzerland    -0.8862644 -0.79798276 -0.228906351 -1.06865159 -0.7103254
## UK             -1.9396765 -0.32877834 -1.274231236 -1.19215725  1.2311866
## USSR            0.8607657 -0.15774231 -0.215679913  1.04275420  1.2112175
## W.Germany      -1.8007758 -0.34409820  0.872728311 -0.26262846 -0.1813817
## Yugoslavia      3.7769132 -0.96425165  0.162453908  1.07643653  0.1784042
##                          PC6         PC7         PC8         PC9
## Albania         0.2667144820 -0.94892837  0.84693053  0.15478609
## Austria        -0.0237975418 -0.05758584 -0.05177819  0.11624278
## Belgium         0.1269263837 -0.22683921 -0.22319293 -0.09689498
## Bulgaria        0.5842119100 -0.39976618 -0.90940273  0.25018422
## Czechoslovakia  0.7261570266 -0.29971869 -0.06798719  0.25074519
## Denmark        -0.0627184045 -0.48030200 -0.56925372 -0.50886295
## E.Germany      -0.2138448106 -0.53117349 -0.18580431  0.29526903
## Finland         0.2058406000  0.97347796  0.28022893  0.12113082
## France          1.4755527601  0.03008584 -0.06846045 -0.51649154
## Greece         -1.0097312103  0.57538334 -0.34740216 -0.45103458
## Hungary        -0.8657732666 -0.11900810  0.19668872 -0.44150330
## Ireland        -0.6415595029  0.43471746  0.03742272 -0.05217871
## Italy          -0.0312818001  0.14708797 -0.12872601  0.85624862
## Netherlands    -0.3040553671 -0.06091030  0.35043459 -0.28870555
## Norway         -0.0038561601 -0.04796743 -0.05700862  0.18258443
## Poland          0.3479854540  1.31643147 -0.01492251  0.31505313
## Portugal        0.5280805539 -0.53140483  0.20289705 -0.20295441
## Romania        -0.1708000230  0.04058813 -0.17580879 -0.13304725
## Spain          -1.0132276525  0.14851022  0.27557451  0.36210459
## Sweden         -0.2848678709 -0.41870881 -0.19737555  0.30259740
## Switzerland     0.6895174928  0.21158255  0.59042991  0.03956071
## UK             -0.6339274501 -0.43367349 -0.24441516  0.13761916
## USSR            0.5814776989  0.72141844 -0.05214970 -0.11645720
## W.Germany      -0.2726945750 -0.39030488  0.53225955 -0.13919641
## Yugoslavia     -0.0003287263  0.34700826 -0.01917849 -0.43679928
pca$center
##     RMeat     WMeat      Eggs      Milk      Fish   Cereals    Starch     Seeds 
##      9.80      7.92      3.08     17.28      4.28     32.32      4.36      3.08 
## FruitsVeg 
##      4.20
pca$scale
##     RMeat     WMeat      Eggs      Milk      Fish   Cereals    Starch     Seeds 
##  3.403430  3.740766  1.115049  7.097652  3.470351 11.010298  1.655295  2.019076 
## FruitsVeg 
##  1.914854
print(round((pca$sdev^2),2))
## [1] 4.10 1.62 1.09 0.91 0.43 0.35 0.27 0.13 0.11
print(round(pca$rotation[,1:4],2))
##             PC1   PC2   PC3   PC4
## RMeat     -0.31 -0.07 -0.36 -0.60
## WMeat     -0.32 -0.21  0.63 -0.04
## Eggs      -0.42 -0.10  0.08 -0.26
## Milk      -0.38 -0.17 -0.40  0.03
## Fish      -0.13  0.65 -0.30  0.23
## Cereals    0.43 -0.25  0.07  0.02
## Starch    -0.30  0.39  0.28  0.31
## Seeds      0.42  0.13 -0.14 -0.25
## FruitsVeg  0.12  0.50  0.34 -0.60

Interpretación mediante PCA$Rotation obtenemos los componentes principales, nos enfocamos en aquellos que representan aproximadamente el 80% de la Varianza , en este caso tomamos los tres primeros componentes suman 75%, lo podemos visualizar en el Scree plot

Visualización de los componentes principales

Varianza explicada

fviz_eig(pca,
         addlabels = TRUE)

cumsum(pca$sdev^2 /
       sum(pca$sdev^2)) * 100
## [1]  45.50596  63.56044  75.61959  85.67534  90.41687  94.27176  97.26647
## [8]  98.76116 100.00000

Biplot clásico

biplot(pca, cex = 0.5,
       xlim = c(-.3,.2),
       ylim = c(-.3,.3)
       )
mtext("Biplot PCA", side = 3, outer = TRUE, line = -1)

El Biplot muestra dos ejes con los 2 primeros componentes PC1 y PC2, los ejes principales son los valores de las categorias (cargas)

Círculo de correlaciones

fviz_pca_var(
  pca,
  repel = TRUE
)

Biplot PCA

fviz_pca_biplot(
  pca,
  repel = TRUE,
  labelsize = 3,
  col.var = "red",
  col.ind = "blue"
)