Parcial02_232819
Joshet Moises Quispe Farfan
2024-06-12
setwd(“C:/Users/JHOSETH/Downloads/Maestría CURSO/Semestre II/Mineria de Datos/Tareas/Parcial II”)
Importación de la base de datos
A continuación, se importa la base de datos “Red Wine Quality”
#Uso de la libreria "readxl" y asignacion de la base de datos en la variable "data_vino"
library(readxl)## Warning: package 'readxl' was built under R version 4.3.2data_vino <- read.csv("winequality-red.csv")
#La base datos la guardamos en un data.frame con el mismo nombre(opcional)
data_vino <- as.data.frame(data_vino)Análisis Exploratorio
#Se muestra la cabecera y las 2 primeras filas de datos
head(data_vino,2)## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1 7.4 0.70 0 1.9 0.076
## 2 7.8 0.88 0 2.6 0.098
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 1 11 34 0.9978 3.51 0.56 9.4
## 2 25 67 0.9968 3.20 0.68 9.8
## quality
## 1 5
## 2 5#Dimension de la base de datos
dim(data_vino)## [1] 1599 12#Resumen de la base de datos
summary(data_vino)## fixed.acidity volatile.acidity citric.acid residual.sugar
## Min. : 4.60 Min. :0.1200 Min. :0.000 Min. : 0.900
## 1st Qu.: 7.10 1st Qu.:0.3900 1st Qu.:0.090 1st Qu.: 1.900
## Median : 7.90 Median :0.5200 Median :0.260 Median : 2.200
## Mean : 8.32 Mean :0.5278 Mean :0.271 Mean : 2.539
## 3rd Qu.: 9.20 3rd Qu.:0.6400 3rd Qu.:0.420 3rd Qu.: 2.600
## Max. :15.90 Max. :1.5800 Max. :1.000 Max. :15.500
## chlorides free.sulfur.dioxide total.sulfur.dioxide density
## Min. :0.01200 Min. : 1.00 Min. : 6.00 Min. :0.9901
## 1st Qu.:0.07000 1st Qu.: 7.00 1st Qu.: 22.00 1st Qu.:0.9956
## Median :0.07900 Median :14.00 Median : 38.00 Median :0.9968
## Mean :0.08747 Mean :15.87 Mean : 46.47 Mean :0.9967
## 3rd Qu.:0.09000 3rd Qu.:21.00 3rd Qu.: 62.00 3rd Qu.:0.9978
## Max. :0.61100 Max. :72.00 Max. :289.00 Max. :1.0037
## pH sulphates alcohol quality
## Min. :2.740 Min. :0.3300 Min. : 8.40 Min. :3.000
## 1st Qu.:3.210 1st Qu.:0.5500 1st Qu.: 9.50 1st Qu.:5.000
## Median :3.310 Median :0.6200 Median :10.20 Median :6.000
## Mean :3.311 Mean :0.6581 Mean :10.42 Mean :5.636
## 3rd Qu.:3.400 3rd Qu.:0.7300 3rd Qu.:11.10 3rd Qu.:6.000
## Max. :4.010 Max. :2.0000 Max. :14.90 Max. :8.000#Estructura de la base datos
str(data_vino)## 'data.frame': 1599 obs. of 12 variables:
## $ fixed.acidity : num 7.4 7.8 7.8 11.2 7.4 7.4 7.9 7.3 7.8 7.5 ...
## $ volatile.acidity : num 0.7 0.88 0.76 0.28 0.7 0.66 0.6 0.65 0.58 0.5 ...
## $ citric.acid : num 0 0 0.04 0.56 0 0 0.06 0 0.02 0.36 ...
## $ residual.sugar : num 1.9 2.6 2.3 1.9 1.9 1.8 1.6 1.2 2 6.1 ...
## $ chlorides : num 0.076 0.098 0.092 0.075 0.076 0.075 0.069 0.065 0.073 0.071 ...
## $ free.sulfur.dioxide : num 11 25 15 17 11 13 15 15 9 17 ...
## $ total.sulfur.dioxide: num 34 67 54 60 34 40 59 21 18 102 ...
## $ density : num 0.998 0.997 0.997 0.998 0.998 ...
## $ pH : num 3.51 3.2 3.26 3.16 3.51 3.51 3.3 3.39 3.36 3.35 ...
## $ sulphates : num 0.56 0.68 0.65 0.58 0.56 0.56 0.46 0.47 0.57 0.8 ...
## $ alcohol : num 9.4 9.8 9.8 9.8 9.4 9.4 9.4 10 9.5 10.5 ...
## $ quality : int 5 5 5 6 5 5 5 7 7 5 ...Se observa que en la columna “quality” las variables son tipo “int”, se procede a realizar el cambio a “num”
data_vino$quality <- as.numeric(data_vino$quality)
#Comprobamos si se realizó el cambio (puede usarse tambien "str")
print(sapply(data_vino, class))## fixed.acidity volatile.acidity citric.acid
## "numeric" "numeric" "numeric"
## residual.sugar chlorides free.sulfur.dioxide
## "numeric" "numeric" "numeric"
## total.sulfur.dioxide density pH
## "numeric" "numeric" "numeric"
## sulphates alcohol quality
## "numeric" "numeric" "numeric"Análisis de Datos Faltantes
#Columnas que tienen valores perdidos
which(colSums(is.na(data_vino))!=0)## named integer(0)#Filas que tienen valores perdidos
which(rowSums(is.na(data_vino))!=0)## integer(0)En esta base de datos no hay datos faltantes y/o perdidos razón por la cual no aplicaremos técnicas para el análisis de los mismos como imputación por la media, imputación por regresión lineal o imputación por kNN
Análisis de Outlier
Primero procedemos a realizar algunos gráficos de boxplot los cuales
nos pueden brindar información sobre el comportamiento de los datos.
De igual manera para las distintas columnas se puede hacer el análisis
gráfico.
#Datos outliers de la Data "Vinos" y columna "volatile acidity"
boxplot.stats(data_vino$volatile.acidity)$out## [1] 1.130 1.020 1.070 1.330 1.330 1.040 1.090 1.040 1.240 1.185 1.020 1.035
## [13] 1.025 1.115 1.020 1.020 1.580 1.180 1.040#Posición de los datos outliers
i2 <- which(data_vino$volatile.acidity %in% boxplot.stats(data_vino$volatile.acidity)$out);i2## [1] 39 95 121 127 128 135 200 554 673 691 701 706 711 725 900
## [16] 1262 1300 1313 1468De acuerdo a los resultados anteriores, se tiene tanto los valores como las posiciones de los datos outliers, en este caso para la columna “volatile acidity”
library(DMwR2)## Warning: package 'DMwR2' was built under R version 4.3.3## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo#Puntaje outlier de toda la base de datos
puntaje_outlier <- lofactor(data_vino, k = 5)
#Gráfico de densidad de los puntajes outlier
plot(density(puntaje_outlier))
#Posición de los puntajes outlier en orden decreciente
outliers_multivariado <- order(puntaje_outlier, decreasing = TRUE )
#Puntaje outlier de toda la base de datos en orden decreciente
puntajes_ordenados <- puntaje_outlier[outliers_multivariado]
muestra <- cbind(outliers_multivariado[1:5], puntajes_ordenados[1:5])
colnames(muestra) <- c("posic_outlier", "puntaj_outlier")
muestra ## posic_outlier puntaj_outlier
## [1,] 1082 9.766265
## [2,] 1080 9.269985
## [3,] 481 3.164795
## [4,] 1044 3.016246
## [5,] 1236 2.542430Se puede apreciar los cinco primeros valores de los outliers de toda la base de datos, así como la posición o el número de fila en el que se encuentran. ### Normalizacion Dado que nuestra base de datos tiene 1599 filas y 12 columnas, realizaremos el proceso de normalizacion para la segunda columna “volatile.acidity”. #### Normalizacion por Min-Max
# Función Normalización por Min-Max
normalizar_min_max <- function(x) {
return ((x - min(x)) / (max(x) - min(x)))
}Normalizacion por Z-score (estandarización)
En caso se desee obtener los valores de media y la desviación estándar, para realizar el proceso manualmente, se pueden utilizar los resultados siguientes. Luego se presenta la función de estandarización.
#Obtencion de la media total de la segunda columna "volatile.acidity"
mean(data_vino$volatile.acidity)## [1] 0.5278205#Obtencion de la desviación estándar total de la segunda columna "volatile.acidity"
sd(data_vino$volatile.acidity)## [1] 0.1790597#Función Normalización por Z-Score
normalizar_z_score <- function(x) {
return ((x - mean(x)) / sd(x))
}Dado que el número de filas que se tiene en la base de datos es extensa, se mostrarán los cinco primeros valores de la columna “volatile.acidity” con ambos métodos de normalización
#Llamado de las funciones de normalización y asignación a nuevas variables
normalizado_min_max <- normalizar_min_max(data_vino$volatile.acidity)
normalizado_z_score <- normalizar_z_score(data_vino$volatile.acidity)
#Comparación de Normalizaciones
muestra2 <- cbind(original = data_vino$volatile.acidity[1:5], normalizado_min_max = normalizado_min_max[1:5], normalizado_z_score = normalizado_z_score[1:5])De igual manera se puede emplear el mismo código para las demás columnas de la base de datos
Análisis de Clusterización
Para conocer el número de clúster que se tendrán o con los que se trabajarán, utilizamos el siguiente código:
table(data_vino$quality)##
## 3 4 5 6 7 8
## 10 53 681 638 199 18Se puede ver que tenemos 6 tipos de “calidades de vino”, utilizaremos esta información para hacer uso de 6 clúster.
result_kmeans <- kmeans(data_vino[, -12], 5)
table(data_vino$quality, result_kmeans$cluster)##
## 1 2 3 4 5
## 3 0 0 1 6 3
## 4 4 1 10 28 10
## 5 121 61 134 199 166
## 6 54 6 125 244 209
## 7 12 2 20 110 55
## 8 2 0 2 11 3Las calidades de vino varían de 3 a 8, de toda la base de datos, estos están clasificados en 6 clúster. A continuación, un gráfico que muestra las dos primeras columnas de la base de datos con sus respectivos clúster y centros.
plot(data_vino[c("fixed.acidity", "volatile.acidity")], col = result_kmeans$cluster, main = "Gráfico de 6 clúster de las variables 'fixed.acidity' & 'volatile.acidity'")
points(result_kmeans$centers[ ,c("fixed.acidity", "volatile.acidity")],
col = c("orange","cyan","pink","red","blue","green"),
pch = "*",
cex = 2.5)
#### Clústerización Método “k-Medoids” A continuación haremos uso del
método de clúster “k-Medoids” para conocer el número de clúster
adecuado.
library(fpc)## Warning: package 'fpc' was built under R version 4.3.3result_kmedoides <- pamk(data_vino[, -12])
result_kmedoides## $pamobject
## Medoids:
## ID fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## [1,] 490 9.3 0.39 0.40 2.6 0.073
## [2,] 412 9.1 0.45 0.35 2.4 0.080
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## [1,] 10 26 0.9984 3.34 0.75 10.2
## [2,] 23 78 0.9987 3.38 0.62 9.5
## Clustering vector:
## [1] 1 2 2 2 1 1 2 1 1 2 2 2 2 1 2 2 2 2 1 2 2 2 1 2 1 1 1 1 1 1 2 1 2 2 1 1 1
## [38] 1 1 2 2 1 1 1 1 2 2 1 1 2 1 1 1 2 2 1 1 2 2 1 2 2 1 2 1 1 1 1 2 1 1 2 2 1
## [75] 2 1 1 1 2 2 1 2 2 1 2 1 2 1 2 1 2 2 2 1 2 2 1 1 1 1 1 1 1 2 1 2 2 2 2 2 1
## [112] 2 2 1 1 2 1 1 2 2 2 2 1 1 2 2 1 1 1 1 2 2 2 1 1 2 1 1 2 2 2 1 2 1 2 2 2 2
## [149] 1 1 1 2 2 2 2 2 2 2 1 2 1 1 1 2 2 2 2 1 1 2 1 1 1 1 1 1 1 1 1 1 1 2 1 2 2
## [186] 2 2 1 2 2 2 1 2 1 1 2 2 1 2 1 1 2 1 1 1 1 1 2 2 1 1 2 1 2 1 2 1 1 1 2 2 2
## [223] 1 1 2 2 2 1 2 1 2 1 2 1 1 1 1 1 1 1 2 1 2 1 1 1 1 2 1 1 1 1 1 2 1 2 1 2 1
## [260] 1 1 2 1 1 1 1 2 1 1 1 2 1 2 1 2 2 1 1 1 1 1 1 1 1 2 2 1 2 1 2 1 1 1 1 2 1
## [297] 2 1 1 1 1 1 1 1 2 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 1 2 1 1 1 1 1 1 1 1 2
## [334] 1 1 1 1 2 2 1 1 1 1 1 1 2 1 1 1 1 1 1 1 2 2 1 2 1 1 1 2 1 1 1 1 1 1 1 2 1
## [371] 2 1 1 2 1 1 1 1 1 2 1 1 1 1 2 1 1 1 2 1 2 1 1 2 1 1 2 1 1 1 2 1 2 1 1 1 1
## [408] 1 1 1 2 2 2 1 2 2 1 2 1 2 2 1 2 1 2 1 1 1 1 1 1 2 1 1 2 1 2 1 2 1 1 1 1 1
## [445] 1 1 2 1 1 1 1 1 1 1 2 1 1 2 1 1 1 1 1 2 1 1 2 1 1 2 1 2 2 1 1 1 1 1 1 1 1
## [482] 1 1 1 1 1 1 1 2 1 2 1 1 2 2 1 1 2 1 2 1 2 2 1 1 1 1 1 2 1 1 2 1 1 1 2 1 1
## [519] 1 2 1 1 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 2 1 1 2 1 1 1 1 2 1
## [556] 1 1 1 1 1 1 2 2 2 1 1 1 1 1 1 1 1 1 1 2 1 1 2 2 1 1 1 1 1 2 1 1 2 1 1 2 2
## [593] 2 1 1 2 1 1 1 1 1 1 1 1 2 1 1 2 2 1 2 1 1 1 2 2 2 1 1 1 2 2 1 1 2 2 1 1 1
## [630] 2 1 1 1 2 2 1 2 2 1 2 1 2 1 2 1 1 1 1 1 2 1 2 2 1 1 2 1 1 1 1 1 1 1 1 2 1
## [667] 1 1 1 1 1 1 2 1 1 1 1 1 2 1 1 1 2 1 2 1 1 1 1 1 1 2 2 2 2 1 1 1 2 1 2 1 1
## [704] 2 1 2 1 1 1 1 2 2 1 1 2 1 1 1 1 1 1 2 1 2 1 1 1 1 1 2 1 1 1 2 1 1 1 2 2 1
## [741] 1 2 1 2 2 1 2 2 1 1 1 1 2 1 1 1 1 1 1 2 2 1 1 1 1 1 2 2 2 1 2 2 2 1 1 1 1
## [778] 1 1 2 1 1 2 1 2 2 2 2 2 2 2 2 2 1 1 2 2 1 1 1 2 1 2 1 1 1 1 1 1 1 1 1 1 1
## [815] 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1 2 2 2 1 1 1 1 2 2 1 1 1 1 1 1 1
## [852] 1 2 2 2 1 2 1 1 1 2 2 1 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 2 2 1 1 2
## [889] 2 2 2 2 1 2 2 1 1 1 1 1 1 1 1 1 1 2 2 1 2 1 1 1 1 1 1 1 2 1 2 1 1 2 1 1 1
## [926] 2 2 2 1 1 1 1 2 1 1 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [963] 1 1 1 1 1 2 1 1 1 1 1 1 1 2 2 2 1 1 1 1 2 1 1 1 1 2 1 1 1 2 1 2 2 1 1 1 1
## [1000] 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1
## [1037] 1 2 1 1 1 1 1 1 1 1 1 2 1 1 2 1 1 1 2 2 1 2 2 1 1 1 1 1 1 1 1 1 1 2 1 2 2
## [1074] 1 2 2 1 1 1 2 1 2 2 2 2 2 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2
## [1111] 1 2 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 1 2 1 1 1 1 1 1 2 2 2 2 1 1 2 2 1
## [1148] 1 1 1 1 2 1 1 2 1 2 2 2 1 1 1 1 1 1 1 2 1 1 1 1 1 1 2 2 2 1 1 2 1 1 1 2 2
## [1185] 2 1 1 1 2 1 1 1 1 1 2 2 2 1 2 2 1 1 1 2 1 1 1 2 1 1 1 2 1 1 1 1 2 2 1 2 1
## [1222] 1 2 1 1 2 1 1 2 2 2 2 2 1 1 2 1 1 1 1 2 2 1 2 2 1 1 1 1 1 1 2 1 1 1 1 2 2
## [1259] 1 1 2 1 2 1 2 1 1 1 2 2 2 2 1 1 1 2 1 1 2 1 2 2 1 2 1 1 1 1 2 2 1 2 1 1 2
## [1296] 2 2 1 1 1 1 2 1 2 2 2 2 1 2 2 2 1 1 2 2 2 1 1 2 2 2 1 1 2 1 1 1 1 1 2 2 2
## [1333] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 2 2 1 1 1 2 2 1 1 2 1 2 1 1 1 2 2
## [1370] 1 2 1 2 2 1 2 1 2 1 1 1 1 2 2 2 2 1 1 1 2 1 1 1 2 2 1 1 2 1 1 2 2 1 1 1 1
## [1407] 1 2 2 2 1 1 1 2 1 1 1 1 1 2 1 2 2 1 1 1 2 1 2 2 1 2 1 1 2 2 2 1 1 2 1 2 1
## [1444] 1 2 2 1 1 2 1 1 1 2 2 1 1 2 2 1 1 2 1 1 1 2 2 2 1 2 1 1 1 1 1 2 2 2 2 1 1
## [1481] 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 2 1 1 1 1 2 2 1 1 1 1 1 1 1 1 1 1 2 2 2 2
## [1518] 1 1 1 1 1 2 2 1 1 1 1 2 2 1 1 1 2 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 2 1
## [1555] 1 1 1 1 2 2 2 2 1 1 1 1 2 1 1 1 1 1 2 1 2 1 1 1 1 1 1 1 1 2 1 1 2 1 2 2 1
## [1592] 1 1 1 1 2 1 1 1
## Objective function:
## build swap
## 18.14052 16.57510
##
## Available components:
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call" "data"
##
## $nc
## [1] 2
##
## $crit
## [1] 0.0000000 0.5784708 0.5057893 0.4290681 0.4310318 0.3884592 0.3559808
## [8] 0.3684360 0.3407140 0.3365239El resultado sugiere que debería trabajarse con 2 clúster por la mediana.
# $nc
# [1] 2A continuación, se muestra una tabla de las 2 clúster con los 6 diferentes “calidades de vino”. Cabe resaltar que es lo que sugiere la clusterización por la mediana (k-medoids).
table(result_kmedoides$pamobject$clustering, data_vino$quality)##
## 3 4 5 6 7 8
## 1 9 40 365 461 169 15
## 2 1 13 316 177 30 3En el siguiente gráfico se puede observar los 2 clúster (recomendados) para toda la base de datos.
#Dos gráficos en una ventana
layout(matrix(c(1,2),1,2))
#Mostrar el primer gráfico
plot(result_kmedoides$pamobject, which.plot = 1)
plot.new()
layout(matrix(1))Clusterización utilizando Dendogramas
A continuación, se realizará la clusterización haciendo uso del gráfico de dendograma.
#Semilla para poder reproducir
set.seed(110)
#Muestra posición de 50 tuplas
indice50 <- sample(1:dim(data_vino)[1],50)
indice50## [1] 1364 742 435 1513 336 1575 355 873 772 1427 883 1247 122 161 1537
## [16] 1045 1404 1583 1351 185 1237 1596 1420 406 1258 1548 1454 187 718 251
## [31] 1173 1223 984 1227 170 1028 817 1567 769 521 1406 1254 136 1506 1540
## [46] 796 558 1536 1182 1209#Valores de los 50 datos aleatorios
vino_indice50 <- data_vino[indice50, ]
vino_indice50[1:5,]## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1364 8.0 0.830 0.27 2.0 0.080
## 742 9.2 0.530 0.24 2.6 0.078
## 435 10.4 0.410 0.55 3.2 0.076
## 1513 6.4 0.790 0.04 2.2 0.061
## 336 11.9 0.695 0.53 3.4 0.128
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 1364 11 63 0.99652 3.29 0.48 9.8
## 742 28 139 0.99788 3.21 0.57 9.5
## 435 22 54 0.99960 3.15 0.89 9.9
## 1513 11 17 0.99588 3.53 0.65 10.4
## 336 7 21 0.99920 3.17 0.84 12.2
## quality
## 1364 4
## 742 5
## 435 6
## 1513 6
## 336 7#Valores de los 50 datos aleatorios sin columna "calidad vino"
vino_indice50_sin12 <- vino_indice50[ , -12]
vino_indice50_sin12[1:5,]## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1364 8.0 0.830 0.27 2.0 0.080
## 742 9.2 0.530 0.24 2.6 0.078
## 435 10.4 0.410 0.55 3.2 0.076
## 1513 6.4 0.790 0.04 2.2 0.061
## 336 11.9 0.695 0.53 3.4 0.128
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 1364 11 63 0.99652 3.29 0.48 9.8
## 742 28 139 0.99788 3.21 0.57 9.5
## 435 22 54 0.99960 3.15 0.89 9.9
## 1513 11 17 0.99588 3.53 0.65 10.4
## 336 7 21 0.99920 3.17 0.84 12.2#Función de Clúster Jerárquico
cluster_jerarquico <- hclust(dist(vino_indice50_sin12),method = "ave")
cluster_jerarquico##
## Call:
## hclust(d = dist(vino_indice50_sin12), method = "ave")
##
## Cluster method : average
## Distance : euclidean
## Number of objects: 50#Gráfico del dendograma con 50 valores aleatorios de la base de datos
plot(cluster_jerarquico, hang = -1, labels =data_vino$quality[indice50])
#Agrupando en 6 clúster
rect.hclust(cluster_jerarquico, k=6)
Si deseamos conocer a qué clúster pertenece cada variable aleatoria de
las 50 escogidas, se utiliza el siguiente código:
grupos <- cutree(cluster_jerarquico, k=6)library(factoextra)## Warning: package 'factoextra' was built under R version 4.3.3## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.3.2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(ggplot2)
fviz_nbclust(data_vino, kmeans, method = "wss") +
geom_vline(xintercept = 4, linetype = 2)
De forma gráfica, se puede observar que la sugerencia de 2 clúster o
acorde a cómo queríamos que fuese (6 clúster), no concuerda con el
número de clúster recomendado según la sumatoria total de cuadrados.
Análisis de Componentes Principales
#Media a toda la base de datos por columna
apply(X = data_vino[, -12], MARGIN = 2, FUN = mean)## fixed.acidity volatile.acidity citric.acid
## 8.31963727 0.52782051 0.27097561
## residual.sugar chlorides free.sulfur.dioxide
## 2.53880550 0.08746654 15.87492183
## total.sulfur.dioxide density pH
## 46.46779237 0.99674668 3.31111320
## sulphates alcohol
## 0.65814884 10.42298311#Varianza a toda la base de datos por columna
apply(X = data_vino[, -12], MARGIN = 2, FUN = var)## fixed.acidity volatile.acidity citric.acid
## 3.031416e+00 3.206238e-02 3.794748e-02
## residual.sugar chlorides free.sulfur.dioxide
## 1.987897e+00 2.215143e-03 1.094149e+02
## total.sulfur.dioxide density pH
## 1.082102e+03 3.562029e-06 2.383518e-02
## sulphates alcohol
## 2.873262e-02 1.135647e+00#Función de Análisis de Componentes Principales
pca <- prcomp(data_vino[, -12], scale = TRUE)
#Nombres de llamado para la función PCA en la variable "pca"
names(pca)## [1] "sdev" "rotation" "center" "scale" "x"#Columnas de la base de datos "centradas a cero" (media de las variables) - Promedios de los atributos
pca$center## fixed.acidity volatile.acidity citric.acid
## 8.31963727 0.52782051 0.27097561
## residual.sugar chlorides free.sulfur.dioxide
## 2.53880550 0.08746654 15.87492183
## total.sulfur.dioxide density pH
## 46.46779237 0.99674668 3.31111320
## sulphates alcohol
## 0.65814884 10.42298311#Columnas de la base de datos "escaladas" (desviacion típica o estándar)
pca$scale## fixed.acidity volatile.acidity citric.acid
## 1.741096318 0.179059704 0.194801137
## residual.sugar chlorides free.sulfur.dioxide
## 1.409928060 0.047065302 10.460156970
## total.sulfur.dioxide density pH
## 32.895324478 0.001887334 0.154386465
## sulphates alcohol
## 0.169506980 1.065667582#Componentes principales para cada columna de la base de datos
pca$rotation## PC1 PC2 PC3 PC4
## fixed.acidity 0.48931422 0.110502738 -0.12330157 0.229617370
## volatile.acidity -0.23858436 -0.274930480 -0.44996253 -0.078959783
## citric.acid 0.46363166 0.151791356 0.23824707 0.079418256
## residual.sugar 0.14610715 -0.272080238 0.10128338 0.372792562
## chlorides 0.21224658 -0.148051555 -0.09261383 -0.666194756
## free.sulfur.dioxide -0.03615752 -0.513566812 0.42879287 0.043537818
## total.sulfur.dioxide 0.02357485 -0.569486959 0.32241450 0.034577115
## density 0.39535301 -0.233575490 -0.33887135 0.174499758
## pH -0.43851962 -0.006710793 0.05769735 0.003787746
## sulphates 0.24292133 0.037553916 0.27978615 -0.550872362
## alcohol -0.11323206 0.386180959 0.47167322 0.122181088
## PC5 PC6 PC7 PC8
## fixed.acidity -0.08261366 -0.10147858 0.35022736 -0.17759545
## volatile.acidity 0.21873452 -0.41144893 0.53373510 -0.07877531
## citric.acid -0.05857268 -0.06959338 -0.10549701 -0.37751558
## residual.sugar 0.73214429 -0.04915555 -0.29066341 0.29984469
## chlorides 0.24650090 -0.30433857 -0.37041337 -0.35700936
## free.sulfur.dioxide -0.15915198 0.01400021 0.11659611 -0.20478050
## total.sulfur.dioxide -0.22246456 -0.13630755 0.09366237 0.01903597
## density 0.15707671 0.39115230 0.17048116 -0.23922267
## pH 0.26752977 0.52211645 0.02513762 -0.56139075
## sulphates 0.22596222 0.38126343 0.44746911 0.37460432
## alcohol 0.35068141 -0.36164504 0.32765090 -0.21762556
## PC9 PC10 PC11
## fixed.acidity -0.194020908 0.24952314 -0.639691452
## volatile.acidity 0.129110301 -0.36592473 -0.002388597
## citric.acid 0.381449669 -0.62167708 0.070910304
## residual.sugar -0.007522949 -0.09287208 -0.184029964
## chlorides -0.111338666 0.21767112 -0.053065322
## free.sulfur.dioxide -0.635405218 -0.24848326 0.051420865
## total.sulfur.dioxide 0.592115893 0.37075027 -0.068701598
## density -0.020718675 0.23999012 0.567331898
## pH 0.167745886 0.01096960 -0.340710903
## sulphates 0.058367062 -0.11232046 -0.069555381
## alcohol -0.037603106 0.30301450 0.314525906#Primeros cinco valores con sus respectivos Pesos de Componentes
head(pca$x, 5)## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] -1.619023 -0.4508091 -1.7738992 -0.04372663 0.06699352 0.9136349
## [2,] -0.798920 -1.8559724 -0.9114050 -0.54789457 -0.01838581 -0.9294232
## [3,] -0.748245 -0.8817630 -1.1710279 -0.41089213 -0.04351739 -0.4013476
## [4,] 2.356935 0.2698916 0.2434125 0.92815961 -1.49868022 0.1309762
## [5,] -1.619023 -0.4508091 -1.7738992 -0.04372663 0.06699352 0.9136349
## PC7 PC8 PC9 PC10 PC11
## [1,] 0.1609928 -0.2821700 0.005096442 0.2676757 -0.04861491
## [2,] 1.0095128 0.7623485 -0.520543822 -0.0628132 0.13809868
## [3,] 0.5393847 0.5977591 -0.086829762 0.1873837 0.11819169
## [4,] -0.3441828 -0.4552326 0.091547938 0.1303517 -0.31661464
## [5,] 0.1609928 -0.2821700 0.005096442 0.2676757 -0.04861491#Dimensiones de la variable y/o función pca (Análisis Componentes Principales) [Nueva data en Componentes]
dim(pca$x)## [1] 1599 11Se tiene también, la representación gráfica de los datos multivariantes, en este caso es la representación bidimensional de las dos primeras componentes.
par(mfrow = c(1, 2))
biplot(x = pca, scale = 0, cex = 0.6, col = c("skyblue", "brown3"), main = "Gráfica original")
#Cambio de signo de los componentes principales
pca$rotation <- -pca$rotation
pca$x <- -pca$x
biplot(x = pca, scale = 0, cex = 0.6, col = c("blue4", "brown3", main = "Gráfica con cambio de signo"))
par(mfrow = c(1, 1))Luego, se procede a realizar un gráfico de barras que explique el comportamiento de los componentes principales
#Llamado de la librería "ggplot2"
library(ggplot2)
#Varianza de los PCA
pca$sdev^2## [1] 3.09913244 1.92590969 1.55054349 1.21323253 0.95929207 0.65960826
## [7] 0.58379122 0.42295670 0.34464212 0.18133317 0.05955831#Proporción de cada varianza respecto al total de las mismas
prop_varianza <- pca$sdev^2 / sum(pca$sdev^2)
prop_varianza## [1] 0.281739313 0.175082699 0.140958499 0.110293866 0.087208370 0.059964388
## [7] 0.053071929 0.038450609 0.031331102 0.016484833 0.005414392ggplot(data = data.frame(prop_varianza, pc = 1:11),
aes(x = pc, y = prop_varianza)) +
geom_col(width = 0.3) +
scale_y_continuous(limits = c(0,1)) +
theme_bw() +
labs(x = "Componente principal",
y = "Prop. de varianza explicada", title = "Proporción de cada componente principal")
Si deseamos conocer los valores de la proporción de cada componente principal, se ejecuta el siguiente código:
prop_varianza_acum <- cumsum(prop_varianza)
prop_varianza_acum## [1] 0.2817393 0.4568220 0.5977805 0.7080744 0.7952827 0.8552471 0.9083191
## [8] 0.9467697 0.9781008 0.9945856 1.0000000De igual manera, se tiene un gráfico que explica los componentes principales en función de su acumulada
ggplot(data = data.frame(prop_varianza_acum, pc = 1:11),
aes(x = pc, y = prop_varianza_acum, group = 1)) +
geom_point() +
geom_line() +
theme_bw() +
labs(x = "Componente principal",
y = "Prop. varianza explicada acumulada", title = "Proporción de la componente principal acumulada")
En la anterior gráfica se tiene alrededor de 80% de la varianza acumulada, dado que con cinco componentes se tiene lo suficiente para explicar esta varianza.
Regresión Logística
Dado que es una técnica estadística la cual se basa en tratar de obtener valores predecibles basado en los residuales; no la desarrollaremos.
Análisis de Reglas de asociación
#Ejecución de librería "arules"
library(arules)## Warning: package 'arules' was built under R version 4.3.3## Loading required package: Matrix##
## Attaching package: 'arules'## The following objects are masked from 'package:base':
##
## abbreviate, write#Creación de la nueva Base de datos (10 tuplas aleatorias)
#Semilla para poder reproducir
set.seed(123)
#Asignación de la variable "vino_indice10" representa 10 tuplas aleatorias
vino_indice10 <- data_vino[sample(1:nrow(data_vino), 10), -12]
# Discretización de las variables continuas (3 primeras columnas)
vino_indice10$fixed.acidity <- cut(vino_indice10$fixed.acidity, breaks = 3, labels = c("Bajo", "Medio", "Alto"))
vino_indice10$volatile.acidity <- cut(vino_indice10$volatile.acidity, breaks = 3, labels = c("Bajo", "Medio", "Alto"))
vino_indice10$citric.acid <- cut(vino_indice10$citric.acid, breaks = 3, labels = c("Bajo", "Medio", "Alto"))
#Base de datos de 10 tuplas aleatorias en transacciones
trans <- as(vino_indice10[, 1:3], "transactions")
#Transacciones con sus respectivos números de fila
inspect(trans)## items transactionID
## [1] {fixed.acidity=Medio,
## volatile.acidity=Medio,
## citric.acid=Medio} 415
## [2] {fixed.acidity=Alto,
## volatile.acidity=Bajo,
## citric.acid=Alto} 463
## [3] {fixed.acidity=Bajo,
## volatile.acidity=Alto,
## citric.acid=Bajo} 179
## [4] {fixed.acidity=Alto,
## volatile.acidity=Alto,
## citric.acid=Medio} 526
## [5] {fixed.acidity=Bajo,
## volatile.acidity=Medio,
## citric.acid=Bajo} 195
## [6] {fixed.acidity=Alto,
## volatile.acidity=Alto,
## citric.acid=Alto} 938
## [7] {fixed.acidity=Bajo,
## volatile.acidity=Bajo,
## citric.acid=Medio} 1142
## [8] {fixed.acidity=Medio,
## volatile.acidity=Bajo,
## citric.acid=Medio} 1323
## [9] {fixed.acidity=Bajo,
## volatile.acidity=Alto,
## citric.acid=Bajo} 1253
## [10] {fixed.acidity=Alto,
## volatile.acidity=Bajo,
## citric.acid=Alto} 1268#Reglas de asociación con soporte del 20% y confianza del 50%
reglas <- apriori(trans, parameter = list(supp = 0.2, conf = 0.5))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.5 0.1 1 none FALSE TRUE 5 0.2 1
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 2
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[9 item(s), 10 transaction(s)] done [0.00s].
## sorting and recoding items ... [9 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [24 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].#Dado que el número de reglas son 24, procedemos a observar cúales son
inspect(reglas)## lhs rhs support confidence coverage lift count
## [1] {fixed.acidity=Medio} => {citric.acid=Medio} 0.2 1.0000000 0.2 2.500000 2
## [2] {citric.acid=Medio} => {fixed.acidity=Medio} 0.2 0.5000000 0.4 2.500000 2
## [3] {citric.acid=Alto} => {fixed.acidity=Alto} 0.3 1.0000000 0.3 2.500000 3
## [4] {fixed.acidity=Alto} => {citric.acid=Alto} 0.3 0.7500000 0.4 2.500000 3
## [5] {citric.acid=Alto} => {volatile.acidity=Bajo} 0.2 0.6666667 0.3 1.666667 2
## [6] {volatile.acidity=Bajo} => {citric.acid=Alto} 0.2 0.5000000 0.4 1.666667 2
## [7] {citric.acid=Bajo} => {fixed.acidity=Bajo} 0.3 1.0000000 0.3 2.500000 3
## [8] {fixed.acidity=Bajo} => {citric.acid=Bajo} 0.3 0.7500000 0.4 2.500000 3
## [9] {citric.acid=Bajo} => {volatile.acidity=Alto} 0.2 0.6666667 0.3 1.666667 2
## [10] {volatile.acidity=Alto} => {citric.acid=Bajo} 0.2 0.5000000 0.4 1.666667 2
## [11] {citric.acid=Medio} => {volatile.acidity=Bajo} 0.2 0.5000000 0.4 1.250000 2
## [12] {volatile.acidity=Bajo} => {citric.acid=Medio} 0.2 0.5000000 0.4 1.250000 2
## [13] {fixed.acidity=Alto} => {volatile.acidity=Bajo} 0.2 0.5000000 0.4 1.250000 2
## [14] {volatile.acidity=Bajo} => {fixed.acidity=Alto} 0.2 0.5000000 0.4 1.250000 2
## [15] {fixed.acidity=Alto} => {volatile.acidity=Alto} 0.2 0.5000000 0.4 1.250000 2
## [16] {volatile.acidity=Alto} => {fixed.acidity=Alto} 0.2 0.5000000 0.4 1.250000 2
## [17] {fixed.acidity=Bajo} => {volatile.acidity=Alto} 0.2 0.5000000 0.4 1.250000 2
## [18] {volatile.acidity=Alto} => {fixed.acidity=Bajo} 0.2 0.5000000 0.4 1.250000 2
## [19] {fixed.acidity=Alto,
## citric.acid=Alto} => {volatile.acidity=Bajo} 0.2 0.6666667 0.3 1.666667 2
## [20] {volatile.acidity=Bajo,
## citric.acid=Alto} => {fixed.acidity=Alto} 0.2 1.0000000 0.2 2.500000 2
## [21] {fixed.acidity=Alto,
## volatile.acidity=Bajo} => {citric.acid=Alto} 0.2 1.0000000 0.2 3.333333 2
## [22] {fixed.acidity=Bajo,
## citric.acid=Bajo} => {volatile.acidity=Alto} 0.2 0.6666667 0.3 1.666667 2
## [23] {volatile.acidity=Alto,
## citric.acid=Bajo} => {fixed.acidity=Bajo} 0.2 1.0000000 0.2 2.500000 2
## [24] {fixed.acidity=Bajo,
## volatile.acidity=Alto} => {citric.acid=Bajo} 0.2 1.0000000 0.2 3.333333 2De la primera fila se tiene que cuando “fixed.acidity” sea “medio” y “citric.acid” sea “medio”:
-Presenta un soporte del 20% (el 20% de transacciones tienen estos atributos)
-Confianza del 100% (el 100% de las transacciones tienen esas características)
-La cobertura es del 20% (el 20% de las transacciones tiene como “fixed.acidity” de valor “medio” como antecedente)
-La elevación es de 2.5 lo cual indica que es 2.5 veces más probable “citric.acid” sea “medio” cuando “fixed.acidity” sea “medio” que a diferencia de otros posibles valores.
-El número de transacciones es 2 respecto del total de 24.
Árboles de Clasificación
Haciendo uso del objeto “vino_indice50” que contiene 50 tuplas de nuestra base de datos completa (data_vino) se observó que la muestra no representaba realmente resultados que puedan expresar el comportamiento de los árboles de clasificación
#Semilla para poder reproducir
set.seed(810)
#División de datos en 2 muestras, donde el 70% pertenecen a la data de entrenamiento y el resto a la data de prueba
ind <- sample(2, nrow(data_vino), replace = TRUE, prob = c(0.7, 0.3))
#Muestra data de entrenamiento
trainData <- data_vino[ind==1,]
#Muestra data de prueba
testData <- data_vino[ind==2,]
#Llamado de la librería "party"
library(party)## Warning: package 'party' was built under R version 4.3.3## Loading required package: grid## Loading required package: mvtnorm## Warning: package 'mvtnorm' was built under R version 4.3.2## Loading required package: modeltools## Loading required package: stats4##
## Attaching package: 'modeltools'## The following object is masked from 'package:arules':
##
## info## Loading required package: strucchange## Warning: package 'strucchange' was built under R version 4.3.3## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## Loading required package: sandwich## Warning: package 'sandwich' was built under R version 4.3.2#La variable "quality" en función de las cuatro primeras variables (columnas) de la base de datos
myFormula <- quality ~ fixed.acidity + volatile.acidity + citric.acid + residual.sugar
#Variables que influyen sobre la respuesta respecto a los datos de la data de entrenamiento
data_vino_ctree <- ctree(myFormula, data=trainData)
data_vino_ctree##
## Conditional inference tree with 4 terminal nodes
##
## Response: quality
## Inputs: fixed.acidity, volatile.acidity, citric.acid, residual.sugar
## Number of observations: 1108
##
## 1) volatile.acidity <= 0.42; criterion = 1, statistic = 155.931
## 2)* weights = 346
## 1) volatile.acidity > 0.42
## 3) volatile.acidity <= 0.585; criterion = 1, statistic = 43.646
## 4)* weights = 354
## 3) volatile.acidity > 0.585
## 5) volatile.acidity <= 1; criterion = 1, statistic = 17.161
## 6)* weights = 396
## 5) volatile.acidity > 1
## 7)* weights = 12Se observa que de las 1108 muestras, la variable que predomina es “volatile.acidity” y en base a esta se hacen los criterios de las ramas. A continuación, se muestra una tabla que presenta la relación de los valores de la variable “quality”
#Tabla de relación de los valores de "quality"
table(predict(data_vino_ctree), trainData$quality)##
## 3 4 5 6 7 8
## 4.33333333333333 2 4 6 0 0 0
## 5.3510101010101 3 22 225 125 21 0
## 5.60734463276836 2 8 149 165 28 2
## 6.03757225433526 0 3 90 153 91 9Si se realiza la sumatoria de estos valores se tendrá 1108 valores, los cuales se puede apreciar en la tabla que es un aproximado de 4 clúster que se deberían realizar. A continuación, se muestran los gráficos de árbol, el primer caso es el
#Gráfico de árbol con barras o boxplot dependiendo del número de categorías de la variable "quality"
plot(data_vino_ctree)
El segundo caso es el gráfico de árbol pero expresado con probabilidad
#Gráfico de árbol
plot(data_vino_ctree, type = "simple")
Análisis Redes Neuronales
De igual manera, se procede a realizar el análisis de Redes Neuronales, en este caso para fines estéticos y que el diagrama pueda ser visible, utilizaremos 10 tuplas aleatorias y una semilla para reproducir.
#Instalación del paquete en caso no se tenga aún
# install.packages('neuralnet')
#Ejecución de la librería
library("neuralnet") ## Warning: package 'neuralnet' was built under R version 4.3.3#Semilla para la reproductibilidad
set.seed(1234)
entrada_entrenamiento_vino_indice10_col1 <- data_vino[sample(1:nrow(data_vino), 10), 1]
entrada_entrenamiento_vino_indice10_col1## [1] 6.8 8.0 6.5 6.8 10.0 6.8 9.9 7.4 8.7 8.3salida_entrenamiento_vino_indice10_col12 <- data_vino[sample(1:nrow(data_vino), 10), 12]
salida_entrenamiento_vino_indice10_col12## [1] 5 6 5 6 6 5 6 7 5 4datos_entrenamiento <- cbind(entrada_entrenamiento_vino_indice10_col1,salida_entrenamiento_vino_indice10_col12)
colnames(datos_entrenamiento) <- c("Entrada","Salida")
datos_entrenamiento## Entrada Salida
## [1,] 6.8 5
## [2,] 8.0 6
## [3,] 6.5 5
## [4,] 6.8 6
## [5,] 10.0 6
## [6,] 6.8 5
## [7,] 9.9 6
## [8,] 7.4 7
## [9,] 8.7 5
## [10,] 8.3 4#Llamado de la función "neuralnet"
net.vino10 <- neuralnet(Salida~Entrada, #funcion estadistica de la red
datos_entrenamiento, #base de datos que trabajaremos
hidden=c(5,3,2), # topologia de la red neuronal
threshold=0.001) #tolerancia del error
# print(net.sqrt)
plot(net.vino10)Se puede observar que la red neuronal contiene los nodos solicitados para su desarrollo (5, 3 y 2) De igual manera, se puede obtener una red neuronal con más variables de nuestra base de datos. Recordemos que son 1599 datos y realizarlo demanda recursos tecnológicos, por lo tanto se mostrará el código mas no el resultado.
#Semilla para reproducir
set.seed(123)
vino_indice20 <- sample(1:nrow(data_vino), 20)
data_vino_indice20 <- data_vino[vino_indice20, ]
#Entrenamiento red neuronal para 20 tuplas
net.vino_2 <- neuralnet(quality ~ fixed.acidity + volatile.acidity + citric.acid + residual.sugar,
data = data_vino_indice20, # usar el subconjunto de datos
hidden = c(10, 15, 10), # topología de la red neuronal
threshold = 0.001) # tolerancia del erro
# print(net.vino_2)
plot(net.vino_2)