Mall 2da Parte Informe
La agrupación es un amplio conjunto de técnicas para encontrar subgrupos de observaciones dentro de un conjunto de datos. Cuando agrupamos observaciones, queremos que las observaciones en el mismo grupo sean similares y que las observaciones en diferentes grupos sean diferentes. Debido a que no hay una variable de respuesta, este es un método no supervisado, lo que implica que busca encontrar relaciones entre las n observaciones sin ser entrenado por una variable de respuesta. La agrupación nos permite identificar qué observaciones son similares y, potencialmente, clasificarlas en ellas. La agrupación en clústeres de K-medias es el método de agrupación en clúster más simple y más utilizado para dividir un conjunto de datos en un conjunto de k grupos.
Para el siguiente informe se realizaran las diversa graficas y el posterior analisis para el conjunto de datos “mall_costumers” que contiene 200 datos organizados respecto a 5 variables distribuidas de la siguiente manera:
library(tidyverse) # data manipulation## Warning: package 'tidyverse' was built under R version 4.1.1## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.5 v dplyr 1.0.7
## v tidyr 1.1.4 v stringr 1.4.0
## v readr 2.0.2 v forcats 0.5.1## Warning: package 'tibble' was built under R version 4.1.1## Warning: package 'tidyr' was built under R version 4.1.1## Warning: package 'readr' was built under R version 4.1.1## Warning: package 'forcats' was built under R version 4.1.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(cluster) # clustering algorithms
library(factoextra) # clustering algorithms & visualization## Warning: package 'factoextra' was built under R version 4.1.2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBaPara el siguiente informe se realizaran las diversa graficas de agrupación en clusteres de K-medias así como el posterior análisis para el conjunto de datos “mall_costumers” que contiene 200 datos organizados respecto a 5 variables distribuidas de la siguiente manera:
\(\longrightarrow\) ID del comprador
\(\longrightarrow\) Género
\(\longrightarrow\) Edad
\(\longrightarrow\) Ingresos anuales
\(\longrightarrow\) puntaje de gasto
library(dplyr)
df_mall<- read.csv('C:\\Users\\Juan Camilo Perdomo\\Downloads\\mall_customers.csv')
df_mall50<- read.csv('C:\\Users\\Juan Camilo Perdomo\\Downloads\\holaa.csv')
View(distinct(df_mall))
str(df_mall)## 'data.frame': 200 obs. of 5 variables:
## $ CustomerID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Gender : chr "Male" "Male" "Female" "Female" ...
## $ Age : int 19 21 20 23 31 22 35 23 64 30 ...
## $ Annual.Income..k.. : int 15 15 16 16 17 17 18 18 19 19 ...
## $ Spending.Score..1.100.: int 39 81 6 77 40 76 6 94 3 72 ...str(df_mall50)## 'data.frame': 25 obs. of 5 variables:
## $ ï..CustomerID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Gender : chr "Male" "Male" "Female" "Female" ...
## $ Age : int 19 21 20 23 31 22 35 23 64 30 ...
## $ Annual.Income..k.. : int 15 15 16 16 17 17 18 18 19 19 ...
## $ Spending.Score..1.100.: int 39 81 6 77 40 76 6 94 3 72 ...Con el fin de realizar las diversas graficas de agrupación en clusteres de K-medias para el conjunto de datos “mall_costumers” se elminan 2 variables que interfieren con el cálculo:
\(\longrightarrow\) ID del comprador:por su redundancia con la asignación númerica secuencial que asigna k means a cada dato (en este caso cado comprador tendrá asignado de manera secuencial los valores númericos del 1 al 200)
\(\longrightarrow\) Género:Por ser una variables de tipo caracter (chr)
library(dplyr)
dat_mall <- select(df_mall, -Gender, - CustomerID )
dat_mall50 <- select(df_mall50 , -Gender,- ï..CustomerID )
View(dat_mall)Se utiliza la función R scale con el fin de estandarizar los datos:
df <- scale(dat_mall)
df_50<-dat_mall50
head(df)## Age Annual.Income..k.. Spending.Score..1.100.
## [1,] -1.4210029 -1.734646 -0.4337131
## [2,] -1.2778288 -1.734646 1.1927111
## [3,] -1.3494159 -1.696572 -1.7116178
## [4,] -1.1346547 -1.696572 1.0378135
## [5,] -0.5619583 -1.658498 -0.3949887
## [6,] -1.2062418 -1.658498 0.9990891View(df)Se cálcula y visualiza la matriz de distancias usando las funciones get_disty fviz_distdesde del factoextrapaquete R. Esto comienza a ilustrar qué consumidores tienen grandes diferencias (rojo) versus aquellos que parecen ser bastante similares (verde azulado).
\(\cdot\) get_dist : Calcula una matriz de distancia entre las filas de una matriz de datos. La distancia predeterminada calculada es la euclidiana; sin embargo, get_dist también admite distanciados descritos en las ecuaciones 2-5 anteriores más otros.
\(\cdot\) fviz_dist: Para visualizar una matriz de distancias
Con el fin de visualizar mejor la distribución de los consumidores se redujo el conjunto de datos de “mall_costumers” de 200 a 25 sin embargo todo el informe se estara trabajando alrededor de 200 datos.
A continuación se puede observar La distribución de los consumidores para el conjunto de datos de “mall_costumers” con 25 y 200 datos respectivamente:
library(factoextra)
distance <- get_dist(df_50)
fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07")) +
theme(text = element_text(size = 10),
axis.title = element_text(size = 7),
axis.text = element_text(size = 7))
library(factoextra)
distance <- get_dist(df)
fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07")) +
theme(text = element_text(size = 10),
axis.title = element_text(size = 7),
axis.text = element_text(size = 7))
Para calcular la agrupación en clústeres de k-medias en R se utiliza la función kmeansfunción . En donde se agruparán los datos en dos grupos ( centers = 2). La kmeansfunción también tiene una nstartopción que intenta múltiples configuraciones iniciales e informa sobre la mejor. Por ejemplo, agregar nstart = 25 generará 25 configuraciones iniciales. Este enfoque se recomienda a menudo.
Al imprimir los resultados se nota que las agrupaciones resultaron en 2 clusters con tamaños 97 y 103. Como se indico anteriormente se ve los centros de los tamaños (media) para los dos grupos en 3 variables (Edad,Ingresos anuales,puntaje de gasto) También obtenemos la asignación de grupo para cada observación (es decir, el consumidor 1 se asignó al grupo 1, el consumidor 199 se asignó al grupo 2, etc.).
k2 <- kmeans(df, centers = 2, nstart = 25)
str(k2)## List of 9
## $ cluster : int [1:200] 1 1 2 1 1 1 2 1 2 1 ...
## $ centers : num [1:2, 1:3] -0.75089 0.70715 0.00262 -0.00247 0.74079 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:2] "1" "2"
## .. ..$ : chr [1:3] "Age" "Annual.Income..k.." "Spending.Score..1.100."
## $ totss : num 597
## $ withinss : num [1:2] 170 218
## $ tot.withinss: num 387
## $ betweenss : num 210
## $ size : int [1:2] 97 103
## $ iter : int 1
## $ ifault : int 0
## - attr(*, "class")= chr "kmeans"k2## K-means clustering with 2 clusters of sizes 97, 103
##
## Cluster means:
## Age Annual.Income..k.. Spending.Score..1.100.
## 1 -0.7508891 0.002621995 0.7407935
## 2 0.7071480 -0.002469258 -0.6976405
##
## Clustering vector:
## [1] 1 1 2 1 1 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2
## [38] 1 2 1 2 1 2 1 2 1 2 1 1 1 2 1 1 2 2 2 2 2 1 2 2 1 2 2 2 1 2 2 1 1 2 2 2 2
## [75] 2 1 2 2 1 2 2 1 2 2 1 2 2 1 1 2 2 1 2 2 1 1 2 1 2 1 1 2 2 1 2 1 2 2 2 2 2
## [112] 1 2 1 1 1 2 2 2 2 1 2 1 1 1 1 2 1 2 1 2 1 1 1 2 1 2 1 2 1 2 1 1 1 2 1 2 1
## [149] 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2
## [186] 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1
##
## Within cluster sum of squares by cluster:
## [1] 169.6903 217.7489
## (between_SS / total_SS = 35.1 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"También se pueden observar los resultados usando fviz_cluster. Esto proporciona una buena ilustración de los grupos. Si hay más de dos dimensiones (variables), fviz_clusterse realizará un análisis de componentes principales (PCA) y se trazarán los puntos de datos de acuerdo con los dos primeros componentes principales que explican la mayor parte de la varianza.
fviz_cluster(k2, data = df)
Alternativamente, puede utilizar diagramas de dispersión por pares estándar para ilustrar los cluster en comparación con las variables originales.
A continuación se presenta el diagrama de dispersión para las variables edad e ingresos anuales:
df %>%
as_tibble() %>%
mutate(cluster = k2$cluster,
state = row.names(dat_mall)) %>%
ggplot(aes(Age, Annual.Income..k.., color = factor(cluster), label = state)) +
geom_text()
A continuación se presenta el diagrama de dispersión para las variables edad y puntaje de gastos:
df %>%
as_tibble() %>%
mutate(cluster = k2$cluster,
state = row.names(dat_mall)) %>%
ggplot(aes(Age, Spending.Score..1.100., color = factor(cluster), label = state)) +
geom_text()
A continuación se presenta el diagrama de dispersión para las variables ingresos anuales y puntaje de gastos:
df %>%
as_tibble() %>%
mutate(cluster = k2$cluster,
state = row.names(dat_mall)) %>%
ggplot(aes(Annual.Income..k.., Spending.Score..1.100., color = factor(cluster), label = state)) +
geom_text()
Debido a que el número de clusters(k) debe establecerse antes de iniciar el algoritmo, a menudo es ventajoso utilizar varios valores diferentes de k y examinar las diferencias en los resultados. Podemos ejecutar el mismo proceso para 3, 4 y 5 clusters, y los resultados se muestran en la figura:
k3 <- kmeans(df, centers = 3, nstart = 25)
k4 <- kmeans(df, centers = 4, nstart = 25)
k5 <- kmeans(df, centers = 5, nstart = 25)
# plots to compare
p1 <- fviz_cluster(k2, geom = "point", data = df) + ggtitle("k = 2")
p2 <- fviz_cluster(k3, geom = "point", data = df) + ggtitle("k = 3")
p3 <- fviz_cluster(k4, geom = "point", data = df) + ggtitle("k = 4")
p4 <- fviz_cluster(k5, geom = "point", data = df) + ggtitle("k = 5")
library(gridExtra)## Warning: package 'gridExtra' was built under R version 4.1.1##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinegrid.arrange(p1, p2, p3, p4, nrow = 2)
DETERMINACIÓN DE CLÚSTERES OPTIMOS
Teniendo en cuenta que el analista especifica el número de clústeres a utilizar; Es preferible encontrar el número de clusters óptimos, para facilitar al analista.
A continuación se presentan los 3 métodos de determinación de clusteres óptimos basados en el conjunto de datos “mall costumers” :
Metodo del codo
Podemos implementar el método del codo en R con el siguiente código. Los resultados sugieren que 4 es el número óptimo de grupos, ya que parece ser la flexión de la rodilla (o codo).
set.seed(123)
# function to compute total within-cluster sum of square
wss <- function(k) {
kmeans(df, k, nstart = 10 )$tot.withinss
}
# Compute and plot wss for k = 1 to k = 15
k.values <- 1:15
# extract wss for 2-15 clusters
wss_values <- map_dbl(k.values, wss)
plot(k.values, wss_values,
type="b", pch = 19, frame = FALSE,
xlab="Number of clusters K",
ylab="Total within-clusters sum of squares")
Afortunadamente, este proceso para calcular el “método del codo” se ha envuelto en una sola función ( fviz_nbclust):
set.seed(123)
fviz_nbclust(df, kmeans, method = "wss")
Metodo de silueta
Podemos usar la silhouettefunción en el paquete de clúster para calcular el ancho de silueta promedio. El siguiente código calcula este enfoque para 1 a 15 clústeres. Los resultados muestran que 6 clusters maximizan los valores de silueta promedio con 4 clusterscomo segundo número óptimo de clusters.
# function to compute average silhouette for k clusters
avg_sil <- function(k) {
km.res <- kmeans(df, centers = k, nstart = 25)
ss <- silhouette(km.res$cluster, dist(df))
mean(ss[, 3])
}
# Compute and plot wss for k = 2 to k = 15
k.values <- 2:15
# extract avg silhouette for 2-15 clusters
avg_sil_values <- map_dbl(k.values, avg_sil)
plot(k.values, avg_sil_values,
type = "b", pch = 19, frame = FALSE,
xlab = "Number of clusters K",
ylab = "Average Silhouettes")
Afortunadamente, este proceso para calcular el “método de silueta” se ha envuelto en una sola función (fviz_nbclust):
fviz_nbclust(df, kmeans, method = "silhouette")
Método de Estadística de brecha
Para calcular el método de la estadística de la brecha, podemos usar la función clusGap que proporciona la estadística de la brecha y el error estándar para una salida.
De igual manera se puede visualizar los resultados con fviz_gap_stat que sugiere 6 conglomerados como el número óptimo de clusters.
# compute gap statistic
set.seed(123)
gap_stat <- clusGap(df, FUN = kmeans, nstart = 25,
K.max = 10, B = 50)
# Print the result
print(gap_stat, method = "firstmax")## Clustering Gap statistic ["clusGap"] from call:
## clusGap(x = df, FUNcluster = kmeans, K.max = 10, B = 50, nstart = 25)
## B=50 simulated reference sets, k = 1..10; spaceH0="scaledPCA"
## --> Number of clusters (method 'firstmax'): 7
## logW E.logW gap SE.sim
## [1,] 4.721322 5.006365 0.2850429 0.01761100
## [2,] 4.482346 4.815417 0.3330717 0.01609331
## [3,] 4.322989 4.669358 0.3463689 0.01754204
## [4,] 4.150389 4.556498 0.4061085 0.01852678
## [5,] 4.046782 4.460918 0.4141366 0.01860449
## [6,] 3.928559 4.378371 0.4498123 0.01685792
## [7,] 3.842901 4.309040 0.4661388 0.01785922
## [8,] 3.786733 4.248820 0.4620870 0.01830884
## [9,] 3.735731 4.198764 0.4630327 0.01877620
## [10,] 3.681420 4.152835 0.4714153 0.01838831fviz_gap_stat(gap_stat)
Extraer resultados
Como la mayoría de estos enfoques sugieren 6-8 como el número de clusters óptimos, podemos realizar el análisis final y extraer los resultados utilizando 6-8 clusters .
# Compute k-means clustering with k = 4
set.seed(123)
final <- kmeans(df, 6, nstart = 25)
print(final)## K-means clustering with 6 clusters of sizes 45, 33, 39, 38, 24, 21
##
## Cluster means:
## Age Annual.Income..k.. Spending.Score..1.100.
## 1 1.2515802 -0.2396117 -0.04388764
## 2 0.2211606 1.0805138 -1.28682305
## 3 -0.4408110 0.9891010 1.23640011
## 4 -0.8709130 -0.1135003 -0.09334615
## 5 -0.9735839 -1.3221791 1.03458649
## 6 0.4777583 -1.3049552 -1.19344867
##
## Clustering vector:
## [1] 5 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6
## [38] 5 6 5 1 5 6 5 6 5 1 4 4 4 1 4 4 1 1 1 1 1 4 1 1 4 1 1 1 4 1 1 4 4 1 1 1 1
## [75] 1 4 1 4 4 1 1 4 1 1 4 1 1 4 4 1 1 4 1 4 4 4 1 4 1 4 4 1 1 4 1 4 1 1 1 1 1
## [112] 4 4 4 4 4 1 1 1 1 4 4 4 3 4 3 2 3 2 3 2 3 4 3 2 3 2 3 4 3 2 3 4 3 2 3 2 3
## [149] 2 3 2 3 2 3 2 3 2 3 2 3 1 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2
## [186] 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3
##
## Within cluster sum of squares by cluster:
## [1] 23.87015 34.51630 22.36267 20.20990 11.71664 20.52332
## (between_SS / total_SS = 77.7 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"fviz_cluster(final, data = df)
set.seed(123)
final1 <- kmeans(df, 8, nstart = 25)
print(final)## K-means clustering with 6 clusters of sizes 45, 33, 39, 38, 24, 21
##
## Cluster means:
## Age Annual.Income..k.. Spending.Score..1.100.
## 1 1.2515802 -0.2396117 -0.04388764
## 2 0.2211606 1.0805138 -1.28682305
## 3 -0.4408110 0.9891010 1.23640011
## 4 -0.8709130 -0.1135003 -0.09334615
## 5 -0.9735839 -1.3221791 1.03458649
## 6 0.4777583 -1.3049552 -1.19344867
##
## Clustering vector:
## [1] 5 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6 5 6
## [38] 5 6 5 1 5 6 5 6 5 1 4 4 4 1 4 4 1 1 1 1 1 4 1 1 4 1 1 1 4 1 1 4 4 1 1 1 1
## [75] 1 4 1 4 4 1 1 4 1 1 4 1 1 4 4 1 1 4 1 4 4 4 1 4 1 4 4 1 1 4 1 4 1 1 1 1 1
## [112] 4 4 4 4 4 1 1 1 1 4 4 4 3 4 3 2 3 2 3 2 3 4 3 2 3 2 3 4 3 2 3 4 3 2 3 2 3
## [149] 2 3 2 3 2 3 2 3 2 3 2 3 1 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2
## [186] 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3
##
## Within cluster sum of squares by cluster:
## [1] 23.87015 34.51630 22.36267 20.20990 11.71664 20.52332
## (between_SS / total_SS = 77.7 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"fviz_cluster(final1, data = df)
Por último podemos extraer los clústeres y agregarlos a nuestros datos iniciales para hacer algunas estadísticas descriptivas a nivel de clúster:
dat_mall %>%
mutate(Cluster = final$cluster) %>%
group_by(Cluster) %>%
summarise_all("mean")## # A tibble: 6 x 4
## Cluster Age Annual.Income..k.. Spending.Score..1.100.
## <int> <dbl> <dbl> <dbl>
## 1 1 56.3 54.3 49.1
## 2 2 41.9 88.9 17.0
## 3 3 32.7 86.5 82.1
## 4 4 26.7 57.6 47.8
## 5 5 25.2 25.8 76.9
## 6 6 45.5 26.3 19.4dat_mall %>%
mutate(Cluster = final1$cluster) %>%
group_by(Cluster) %>%
summarise_all("mean")## # A tibble: 8 x 4
## Cluster Age Annual.Income..k.. Spending.Score..1.100.
## <int> <dbl> <dbl> <dbl>
## 1 1 24.6 54.5 49.2
## 2 2 47.1 55.6 47.8
## 3 3 45.4 25.6 18.6
## 4 4 64.8 53.2 49.8
## 5 5 49 88.4 19.2
## 6 6 32.7 86.5 82.1
## 7 7 31.1 89.3 13.4
## 8 8 25.3 25.7 79.4