METODOS MULTIVARIADOS: Análisis de correspondencia
Yeimy Maryury Montilla Montilla ymontilla@unal.edu.co
Julio 15 del 2021
Dataset
library (readxl)
data = read_excel('pansorgo.xlsx')## New names:
## * `` -> ...9
## * `` -> ...10
## * `` -> ...11head(data)## # A tibble: 6 x 11
## id_pan_sorgo color olor sabor textura apariencia dureza preferencia_global
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 6 6 1 6 6 6 6
## 2 2 7 5 1 2 1 6 4
## 3 3 5 7 7 5 6 2 6
## 4 4 5 5 5 5 5 5 5
## 5 5 7 6 7 5 7 6 7
## 6 6 7 5 7 7 7 7 7
## # ... with 3 more variables: ...9 <lgl>, ...10 <chr>, ...11 <dbl>library(reshape2)
data2 = melt(data[,2:8])## No id variables; using all as measure variables#tabla de contingencia
tbl2 = table(data2)
tbl2## value
## variable 1 2 3 4 5 6 7
## color 5 5 9 8 20 34 19
## olor 6 5 5 6 26 25 27
## sabor 6 3 9 8 16 34 24
## textura 3 3 7 12 21 31 23
## apariencia 5 2 9 13 26 25 20
## dureza 3 2 14 10 17 29 25
## preferencia_global 4 4 9 6 30 28 19Exploración de los datos
library (gplots)##
## Attaching package: 'gplots'## The following object is masked from 'package:stats':
##
## lowessballoonplot(t(tbl2), main ="data2", xlab ="Escala", ylab="Propiedad",
label = FALSE, show.margins = FALSE)
Se observa una tendencia en las propiedades hacia la preferencia, lo cual coincide con la preferencia global.
Análisis de correspondencia
library("FactoMineR")
library("factoextra")## Loading required package: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBaca_tbl2 = CA(tbl2)
ca_tbl2$eig## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.0174817163 43.778414 43.77841
## dim 2 0.0101697748 25.467557 69.24597
## dim 3 0.0055148403 13.810484 83.05645
## dim 4 0.0043302591 10.844008 93.90046
## dim 5 0.0018824502 4.714107 98.61457
## dim 6 0.0005532337 1.385430 100.00000ca_tbl2$eig[2,2]## [1] 25.46756La propiedad con menor calificación es el olor, mientras que las mejor calificadas son color y sabor, las calificaciones intermedias se asocian a dureza, textura y apariencia. La preferencia global se asocia al 5, la cual corresponde a “Me gusta un poco”.
ellipseCA(ca_tbl2, ellipse="row")
### Contribución resultante entre las primeras dos dimensiones
¿Qué variables quedaron mejor mejores presentadas en las dos dimensiones? ¿Cuál variable es más diferenciadora?
#resultante calculando la hipotenusa para filas
cont_12 = sqrt(rowSums(ca_tbl2$row$contrib[,1:2]^2))
cont_12## color olor sabor textura
## 13.509335 35.509988 27.274965 3.631358
## apariencia dureza preferencia_global
## 46.379747 35.758363 20.234716#resultante calculando la hipotenusa para columnas
cont_col_12 = sqrt(rowSums(ca_tbl2$col$contrib[,1:2]^2))
sort(100*cont_col_12/sum(cont_col_12))## 7 1 2 6 3 4 5
## 2.990461 4.860793 11.522972 11.712052 15.355391 21.279116 32.279214barplot(100*cont_col_12/sum(cont_col_12))
barplot(100*cont_12/sum(cont_12), las = 2)
Conforme al resultado la propiedad mejor representada en las dos dimensiones es la apariencia y la escala que tiene mayor importancia en las dos dimensiones es el cinco.
Contribución resultante entre las primeras dos dimensiones con ponderación
pod_dim1=ca_tbl2$row$contrib[,1:1]*ca_tbl2$eig[1,2]
pod_dim2=ca_tbl2$row$contrib[,2:2]*ca_tbl2$eig[2,2]
cont_pr_2d = sqrt(pod_dim1^2+pod_dim2^2)
cont_pr_2d ## color olor sabor textura
## 344.0506 1538.0972 739.1258 124.3612
## apariencia dureza preferencia_global
## 1181.1789 1565.2067 874.9559pod_dim1=ca_tbl2$col$contrib[,1:1]*ca_tbl2$eig[1,2]
pod_dim2=ca_tbl2$col$contrib[,2:2]*ca_tbl2$eig[2,2]
cont_cal_2d=sqrt(pod_dim1^2+pod_dim2^2)
cont_cal_2d## 1 2 3 4 5 6 7
## 225.6171 610.2635 1030.6057 967.7364 1952.7993 500.2151 117.3316barplot(100*cont_cal_2d/sum(cont_cal_2d))
barplot(100*cont_pr_2d/sum(cont_pr_2d), las = 2)
Se obtuvo una contribución resultante entre las primeras dos dimensiones las cuales representan 69.25 % de los datos. La resultante se calculó aplicando el teorema de Pitágoras y Cada contribución se pondero con el porcentaje de varianza de su respectiva dimensión. Se obtiene como resultado que las propiedades mejor representadas en las dos dimensiones es el olor y la dureza, mientras que se confirma que la escala que tiene mayor importancia en las dos dimensiones es el cinco.
Contribución resultante entre las primeras tes dimensiones con ponderación
pod_dim1=ca_tbl2$row$contrib[,1:1]*ca_tbl2$eig[1,2]
pod_dim2=ca_tbl2$row$contrib[,2:2]*ca_tbl2$eig[2,2]
pod_dim3=ca_tbl2$row$contrib[,3:3]*ca_tbl2$eig[3,3]
cont_pr_3d = sqrt(pod_dim1^2+pod_dim2^2+pod_dim3^2)
cont_pr_3d ## color olor sabor textura
## 1021.3811 2214.9266 765.5484 1308.6553
## apariencia dureza preferencia_global
## 1240.1088 1610.5136 3598.9630pod_dim1=ca_tbl2$col$contrib[,1:1]*ca_tbl2$eig[1,2]
pod_dim2=ca_tbl2$col$contrib[,2:2]*ca_tbl2$eig[2,2]
pod_dim3=ca_tbl2$col$contrib[,3:3]*ca_tbl2$eig[3,2]
cont_cal_3d=sqrt(pod_dim1^2+pod_dim2^2+pod_dim3^2)
cont_cal_3d## 1 2 3 4 5 6 7
## 233.4952 610.6368 1157.6236 1006.8179 1954.2294 503.0339 384.9522barplot(100*cont_cal_3d/sum(cont_cal_3d))
barplot(100*cont_pr_3d/sum(cont_pr_3d), las = 2)
Se generó una contribución resultante entre las primeras tres dimensiones las cuales representan 83.1 % de los datos. La resultante se calculó aplicando el teorema de Pitágoras y Cada contribución se pondero con el porcentaje de varianza de su respectiva dimensión. Se obtiene como resultado que la propiedad mejor representada en las tres dimensiones es la preferencia global, mientras que se confirma que la escala que tiene mayor importancia es el cinco.