# Teoría Agrupamiento o clustering es una técnica de aprendizaje automático no supervisado que agrupa datos en función de su similitud. Algunos usos típicos de esta técnica son: * Segmentación de clientes * Detección de anormalidades * Categorización de documentos

Paso 1. Instalar paquetes y llamar librerías

#install.packages("cluster") # Análisis de Agrupamiento
library(cluster)
#install.packages("ggplot2") # Graficar
library(ggplot2)
#install.packages("data.table") # Manejo de muchos datos
library(data.table)
# install.packages("factoextra") # Gráfica optimización de número de clusters
library(factoextra)
library(readxl)
library(dplyr)

Obtener los datos 

super <- read_excel("C:\\Users\\Emili\\OneDrive\\Desktop\\TEC\\Tec 6to Semestre Concentracion\\Modulo 2\\Archivos CSV\\supermarket.xlsx")
## Warning: Expecting numeric in A522063 / R522063C1: got 'A563185'
## Warning: Expecting numeric in A522064 / R522064C1: got 'A563186'
## Warning: Expecting numeric in A522065 / R522065C1: got 'A563187'
super <- na.omit(super)

Entender los datos 

summary(super)
##      BillNo         Itemname            Quantity       
##  Min.   :536365   Length:388023      Min.   :    1.00  
##  1st Qu.:549225   Class :character   1st Qu.:    2.00  
##  Median :561888   Mode  :character   Median :    5.00  
##  Mean   :560611                      Mean   :   12.89  
##  3rd Qu.:572131                      3rd Qu.:   12.00  
##  Max.   :581587                      Max.   :80995.00  
##       Date                          Time                         Price         
##  Min.   :2010-12-01 00:00:00   Min.   :1899-12-31 06:20:00   Min.   :   0.000  
##  1st Qu.:2011-04-07 00:00:00   1st Qu.:1899-12-31 11:44:00   1st Qu.:   1.250  
##  Median :2011-07-31 00:00:00   Median :1899-12-31 13:11:00   Median :   1.950  
##  Mean   :2011-07-10 08:10:29   Mean   :1899-12-31 13:15:23   Mean   :   3.079  
##  3rd Qu.:2011-10-21 00:00:00   3rd Qu.:1899-12-31 14:50:00   3rd Qu.:   3.750  
##  Max.   :2011-12-09 00:00:00   Max.   :1899-12-31 20:18:00   Max.   :8142.750  
##    CustomerID      Country         
##  Min.   :12346   Length:388023     
##  1st Qu.:13950   Class :character  
##  Median :15265   Mode  :character  
##  Mean   :15317                     
##  3rd Qu.:16837                     
##  Max.   :18287
str(super)
## tibble [388,023 × 8] (S3: tbl_df/tbl/data.frame)
##  $ BillNo    : num [1:388023] 536365 536365 536365 536365 536365 ...
##  $ Itemname  : chr [1:388023] "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Quantity  : num [1:388023] 6 6 8 6 6 2 6 6 6 32 ...
##  $ Date      : POSIXct[1:388023], format: "2010-12-01" "2010-12-01" ...
##  $ Time      : POSIXct[1:388023], format: "1899-12-31 08:26:00" "1899-12-31 08:26:00" ...
##  $ Price     : num [1:388023] 2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ CustomerID: num [1:388023] 17850 17850 17850 17850 17850 ...
##  $ Country   : chr [1:388023] "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...
##  - attr(*, "na.action")= 'omit' Named int [1:134041] 614 1411 1412 1413 1414 1415 1416 1417 1418 1419 ...
##   ..- attr(*, "names")= chr [1:134041] "614" "1411" "1412" "1413" ...

Crear columnas adicionales 

super <- super %>%
  mutate(Subtotal = Quantity * Price)
totales_factura <- super %>%
  group_by(CustomerID, BillNo) %>%
  summarise(TotalFactura = sum(Subtotal, na.rm = TRUE)) %>%
  ungroup()
## `summarise()` has grouped output by 'CustomerID'. You can override using the
## `.groups` argument.
ticket_cliente <- totales_factura %>%
  group_by(CustomerID) %>%
  summarise(
    Frecuencia = n(),  # número de facturas
    TicketPromedio = mean(TotalFactura)
  ) %>%
  ungroup()

Escalar los datos 

# Sólo si los datos no están en la misma escala.
ticket_cliente <- ticket_cliente %>%
  mutate(
    Frecuencia_scaled = as.numeric(scale(Frecuencia)),
    TicketPromedio_scaled = as.numeric(scale(TicketPromedio))
  )
df1 <- ticket_cliente %>%
  select(Frecuencia_scaled, TicketPromedio_scaled) %>%
  na.omit()

Numero optimo de grupos 

set.seed(123)
optimizacion1 <- clusGap(df1, FUN=kmeans, nstart=1, K.max=7)
# El K.max normalmente es 10, en este ejercicio al ser 8 datos se dejó en
7.
## [1] 7
plot(optimizacion1, xlab="Número de clusters k", main="Optimización de
Clusters")

# Se selecciona como óptimo el primer punto más alto.
wss <- numeric(10)

for (k in 1:10) {
  kmeans_model <- kmeans(df1, centers = k, nstart = 25)
  wss[k] <- kmeans_model$tot.withinss
}
plot(1:10, wss,
     type = "b",
     pch = 19,
     xlab = "Número de clusters (k)",
     ylab = "Within-Cluster Sum of Squares",
     main = "Método del Codo")

Determinar número de grupos 

# Siempre es un valor inicial "cualquiera", luego se optimiza.
plot(ticket_cliente$Frecuencia_scaled,ticket_cliente$TicketPromedio_scaled)

grupos1 <- 4

Generar los grupos 

set.seed(123)
clusters1 <- kmeans(df1,grupos1)
clusters1
## K-means clustering with 4 clusters of sizes 19, 2, 436, 3840
## 
## Cluster means:
##   Frecuencia_scaled TicketPromedio_scaled
## 1         9.8400548            0.42762303
## 2        -0.3845733           44.52401880
## 3         1.5348491            0.01814010
## 4        -0.2227568           -0.02736509
## 
## Clustering vector:
##    [1] 2 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4
##   [38] 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4
##   [75] 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 3 4 3 4 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 3 4 4
##  [112] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4
##  [149] 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4 4 3 4
##  [186] 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4
##  [223] 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 3 3 3 4 4 4 4 4
##  [260] 4 4 4 4 4 4 4 4 4 4 3 4 3 3 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 3 4 4 4
##  [297] 4 4 4 4 4 4 4 3 1 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
##  [334] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 3 4
##  [371] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4
##  [408] 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4
##  [445] 4 4 4 4 3 4 4 4 4 4 4 4 4 4 1 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4
##  [482] 3 4 4 4 4 4 3 3 4 4 4 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 3 4 4 4
##  [519] 4 4 4 4 4 4 4 4 4 3 4 4 4 4 3 4 4 3 3 4 4 1 3 4 4 4 3 4 3 3 4 4 3 4 4 4 4
##  [556] 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4
##  [593] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 3 3 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4
##  [630] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
##  [667] 4 4 3 4 3 3 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4
##  [704] 4 4 4 4 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
##  [741] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 1 4 4 4
##  [778] 4 4 3 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 3
##  [815] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
##  [852] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4
##  [889] 4 4 4 4 3 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4
##  [926] 4 4 4 4 3 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4
##  [963] 4 4 4 4 4 4 4 4 4 4 4 4 1 3 4 4 3 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4
## [1000] 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4 4 3 3 4 4 4
## [1037] 3 4 4 4 4 3 4 4 4 4 4 1 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [1074] 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4
## [1111] 3 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [1148] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3 4
## [1185] 3 4 4 4 4 4 4 3 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4
## [1222] 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 3 3 4 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3
## [1259] 4 3 4 4 3 4 3 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4
## [1296] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 3 3 4
## [1333] 3 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 3 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 3
## [1370] 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 3 3 4
## [1407] 4 4 3 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [1444] 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 3 4 3 4 3 4 4
## [1481] 4 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [1518] 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [1555] 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3 1 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3
## [1592] 4 4 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4
## [1629] 4 4 4 4 4 1 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 1 4 4 4
## [1666] 4 4 4 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3
## [1703] 3 4 3 4 4 3 4 3 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4 4 4 4 4 4 4
## [1740] 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 3 4 4 4
## [1777] 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4
## [1814] 4 4 4 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 3 4 4 4 4 4 4
## [1851] 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4
## [1888] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3 4 3 3 4 4 4 4 4 4 4 3
## [1925] 4 4 4 4 1 4 4 4 3 4 3 4 4 4 4 4 4 4 4 4 3 3 4 1 4 4 4 4 4 4 4 4 4 4 4 4 4
## [1962] 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4
## [1999] 4 3 4 4 3 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 3 3 4 4 4 4 4 3 4 4 4 4 4 4 4 4
## [2036] 4 4 4 4 4 4 4 4 4 4 3 3 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4
## [2073] 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [2110] 4 4 4 3 4 4 4 4 4 4 4 3 4 4 4 4 3 3 4 4 4 3 4 4 3 4 4 4 4 4 1 4 4 4 4 4 4
## [2147] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4 4 4
## [2184] 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [2221] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4
## [2258] 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4
## [2295] 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 3
## [2332] 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 3 4 4 4 4 3 4 3 4 4 4
## [2369] 4 3 4 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4
## [2406] 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3
## [2443] 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [2480] 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4 4 4 4 4
## [2517] 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4 4 4
## [2554] 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [2591] 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4
## [2628] 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 1 4 4 4 4 4 3 4 4 4 4 4 4 4
## [2665] 1 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4
## [2702] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [2739] 4 3 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 3 4 4 4 3 4 4 4 3 4 4 4 4 4 4 4 4 4
## [2776] 4 4 4 4 4 4 4 3 3 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4
## [2813] 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4
## [2850] 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 3 4 4
## [2887] 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 3 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4
## [2924] 4 4 4 4 4 4 4 3 4 4 4 4 4 3 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 1 4 4 4 3 4 4 4
## [2961] 4 4 4 4 4 4 4 4 4 4 2 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [2998] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4 4
## [3035] 4 4 4 4 4 4 4 3 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4
## [3072] 3 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 3 4 4
## [3109] 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 3 4 3 4 4 3 4 4 4 4 3 4 4 4 4 4 4
## [3146] 4 4 4 4 3 3 3 4 4 4 3 4 3 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 3 4 4 4 4 4 4 4 4
## [3183] 4 4 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 3 4 4 4 4 4 4 3 4 4 4 3 4 4 3
## [3220] 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3 4 3 3 4 4 4 4 4 4 4 4 4 4
## [3257] 4 4 4 3 4 3 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [3294] 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 3 4 4 4 4 4 4 3 4 3 4 4 4 3 4 4 3 4 4 4
## [3331] 4 4 4 3 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4
## [3368] 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [3405] 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 4 3 3 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3
## [3442] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4
## [3479] 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [3516] 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 3 4 4 3 4 4 4 4 4 4 4 4
## [3553] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4
## [3590] 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4
## [3627] 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4 4 4
## [3664] 4 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 1 4 4 4 4 4 4 4 4 4 4 4
## [3701] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 3 3 4 4 4 4
## [3738] 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [3775] 4 4 4 4 4 3 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4 4
## [3812] 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 3 3 4 4 4 4 4 3 4 4 4 4 4 4
## [3849] 4 4 4 4 4 4 3 4 3 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 3 3 4 4 4 4 4
## [3886] 4 4 3 4 3 4 4 4 4 3 4 4 3 4 4 4 4 3 4 4 4 4 4 4 4 4 4 3 4 4 3 4 4 4 4 4 4
## [3923] 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 3 3 4 4 4 3 3 4 4 4 4 4 4
## [3960] 4 4 4 4 4 4 4 4 4 4 4 1 4 4 3 4 3 4 4 4 4 3 3 4 4 4 4 4 4 3 4 4 4 3 4 4 4
## [3997] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4
## [4034] 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 1 4 4 3 4 4 4 4 4 3 4 4 3 4 4 4 4 4
## [4071] 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4
## [4108] 4 4 4 4 4 4 4 4 4 3 4 4 3 4 4 4 4 3 4 4 4 3 4 4 3 4 4 4 4 4 4 3 4 3 3 4 4
## [4145] 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 1 4 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4
## [4182] 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4
## [4219] 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 4 4 4 3 4 3 3 4
## [4256] 4 3 4 4 4 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [4293] 4 4 4 3 4
## 
## Within cluster sum of squares by cluster:
## [1] 573.026031   7.656972 433.142874 549.246270
##  (between_SS / total_SS =  81.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Graficar los grupos 

fviz_cluster(clusters1, data=df1)

Agregar Clusters a la Base de Datos

df1_clusters <- cbind(df1, cluster = clusters1$cluster)
head(df1_clusters)
##   Frecuencia_scaled TicketPromedio_scaled cluster
## 1        -0.4550880           42.56863812       2
## 2         0.3910881            0.11101871       4
## 3        -0.4550880            0.74417746       4
## 4        -0.4550880           -0.04497273       4
## 5         0.5321175           -0.05669783       4
## 6        -0.4550880           -0.18104936       4

Conclusiones

Con base a nuestro analisis, se decidio que el numero optimo de clusteres sea 4

LS0tDQp0aXRsZTogIkNsdXN0ZXJpbmcgLSBTdXBlcm1hcmtldCINCmF1dGhvcjogIkVtaWxpbyBDaXVmZmFyZGkgQTAxNjEyNTY5Ig0KZGF0ZTogIjIwMjYtMDItMjMiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KICAgIHRoZW1lOiB5ZXRpDQotLS0NCg0KIVtdKGh0dHBzOi8vc3RhdGljLndpa2lhLm5vY29va2llLm5ldC90aGVhbWF6aW5nd29ybGRvZmd1bWJhbGwvaW1hZ2VzL2EvYTAvRWxtb3JlU2hvcHBpbmcucG5nL3JldmlzaW9uL2xhdGVzdD9jYj0yMDEzMDkyMTEwMzUxNw0KKQ0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBUZW9yw61hIDwvc3Bhbj4NCioqQWdydXBhbWllbnRvKiogbyAqY2x1c3RlcmluZyogZXMgdW5hIHTDqWNuaWNhIGRlIGFwcmVuZGl6YWplIGF1dG9tw6F0aWNvDQpubyBzdXBlcnZpc2FkbyBxdWUgYWdydXBhIGRhdG9zIGVuIGZ1bmNpw7NuIGRlIHN1IHNpbWlsaXR1ZC4NCkFsZ3Vub3MgdXNvcyB0w61waWNvcyBkZSBlc3RhIHTDqWNuaWNhIHNvbjoNCiogU2VnbWVudGFjacOzbiBkZSBjbGllbnRlcw0KKiBEZXRlY2Npw7NuIGRlIGFub3JtYWxpZGFkZXMNCiogQ2F0ZWdvcml6YWNpw7NuIGRlIGRvY3VtZW50b3MNCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gMS4gSW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hcw0KPC9zcGFuPg0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCiNpbnN0YWxsLnBhY2thZ2VzKCJjbHVzdGVyIikgIyBBbsOhbGlzaXMgZGUgQWdydXBhbWllbnRvDQpsaWJyYXJ5KGNsdXN0ZXIpDQojaW5zdGFsbC5wYWNrYWdlcygiZ2dwbG90MiIpICMgR3JhZmljYXINCmxpYnJhcnkoZ2dwbG90MikNCiNpbnN0YWxsLnBhY2thZ2VzKCJkYXRhLnRhYmxlIikgIyBNYW5lam8gZGUgbXVjaG9zIGRhdG9zDQpsaWJyYXJ5KGRhdGEudGFibGUpDQojIGluc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKSAjIEdyw6FmaWNhIG9wdGltaXphY2nDs24gZGUgbsO6bWVybyBkZSBjbHVzdGVycw0KbGlicmFyeShmYWN0b2V4dHJhKQ0KbGlicmFyeShyZWFkeGwpDQpsaWJyYXJ5KGRwbHlyKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gT2J0ZW5lciBsb3MgZGF0b3MgPC9zcGFuPg0KYGBge3J9DQpzdXBlciA8LSByZWFkX2V4Y2VsKCJDOlxcVXNlcnNcXEVtaWxpXFxPbmVEcml2ZVxcRGVza3RvcFxcVEVDXFxUZWMgNnRvIFNlbWVzdHJlIENvbmNlbnRyYWNpb25cXE1vZHVsbyAyXFxBcmNoaXZvcyBDU1ZcXHN1cGVybWFya2V0Lnhsc3giKQ0Kc3VwZXIgPC0gbmEub21pdChzdXBlcikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+ICBFbnRlbmRlciBsb3MgZGF0b3MgPC9zcGFuPg0KYGBge3J9DQpzdW1tYXJ5KHN1cGVyKQ0Kc3RyKHN1cGVyKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gIENyZWFyIGNvbHVtbmFzIGFkaWNpb25hbGVzIDwvc3Bhbj4NCmBgYHtyfQ0Kc3VwZXIgPC0gc3VwZXIgJT4lDQogIG11dGF0ZShTdWJ0b3RhbCA9IFF1YW50aXR5ICogUHJpY2UpDQp0b3RhbGVzX2ZhY3R1cmEgPC0gc3VwZXIgJT4lDQogIGdyb3VwX2J5KEN1c3RvbWVySUQsIEJpbGxObykgJT4lDQogIHN1bW1hcmlzZShUb3RhbEZhY3R1cmEgPSBzdW0oU3VidG90YWwsIG5hLnJtID0gVFJVRSkpICU+JQ0KICB1bmdyb3VwKCkNCnRpY2tldF9jbGllbnRlIDwtIHRvdGFsZXNfZmFjdHVyYSAlPiUNCiAgZ3JvdXBfYnkoQ3VzdG9tZXJJRCkgJT4lDQogIHN1bW1hcmlzZSgNCiAgICBGcmVjdWVuY2lhID0gbigpLCAgIyBuw7ptZXJvIGRlIGZhY3R1cmFzDQogICAgVGlja2V0UHJvbWVkaW8gPSBtZWFuKFRvdGFsRmFjdHVyYSkNCiAgKSAlPiUNCiAgdW5ncm91cCgpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiAgRXNjYWxhciBsb3MgZGF0b3MgPC9zcGFuPg0KYGBge3J9DQojIFPDs2xvIHNpIGxvcyBkYXRvcyBubyBlc3TDoW4gZW4gbGEgbWlzbWEgZXNjYWxhLg0KdGlja2V0X2NsaWVudGUgPC0gdGlja2V0X2NsaWVudGUgJT4lDQogIG11dGF0ZSgNCiAgICBGcmVjdWVuY2lhX3NjYWxlZCA9IGFzLm51bWVyaWMoc2NhbGUoRnJlY3VlbmNpYSkpLA0KICAgIFRpY2tldFByb21lZGlvX3NjYWxlZCA9IGFzLm51bWVyaWMoc2NhbGUoVGlja2V0UHJvbWVkaW8pKQ0KICApDQpgYGANCmBgYHtyfQ0KZGYxIDwtIHRpY2tldF9jbGllbnRlICU+JQ0KICBzZWxlY3QoRnJlY3VlbmNpYV9zY2FsZWQsIFRpY2tldFByb21lZGlvX3NjYWxlZCkgJT4lDQogIG5hLm9taXQoKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gIE51bWVybyBvcHRpbW8gZGUgZ3J1cG9zIDwvc3Bhbj4NCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0Kb3B0aW1pemFjaW9uMSA8LSBjbHVzR2FwKGRmMSwgRlVOPWttZWFucywgbnN0YXJ0PTEsIEsubWF4PTcpDQojIEVsIEsubWF4IG5vcm1hbG1lbnRlIGVzIDEwLCBlbiBlc3RlIGVqZXJjaWNpbyBhbCBzZXIgOCBkYXRvcyBzZSBkZWrDsyBlbg0KNy4NCnBsb3Qob3B0aW1pemFjaW9uMSwgeGxhYj0iTsO6bWVybyBkZSBjbHVzdGVycyBrIiwgbWFpbj0iT3B0aW1pemFjacOzbiBkZQ0KQ2x1c3RlcnMiKQ0KIyBTZSBzZWxlY2Npb25hIGNvbW8gw7NwdGltbyBlbCBwcmltZXIgcHVudG8gbcOhcyBhbHRvLg0KYGBgDQpgYGB7cn0NCndzcyA8LSBudW1lcmljKDEwKQ0KDQpmb3IgKGsgaW4gMToxMCkgew0KICBrbWVhbnNfbW9kZWwgPC0ga21lYW5zKGRmMSwgY2VudGVycyA9IGssIG5zdGFydCA9IDI1KQ0KICB3c3Nba10gPC0ga21lYW5zX21vZGVsJHRvdC53aXRoaW5zcw0KfQ0KcGxvdCgxOjEwLCB3c3MsDQogICAgIHR5cGUgPSAiYiIsDQogICAgIHBjaCA9IDE5LA0KICAgICB4bGFiID0gIk7Dum1lcm8gZGUgY2x1c3RlcnMgKGspIiwNCiAgICAgeWxhYiA9ICJXaXRoaW4tQ2x1c3RlciBTdW0gb2YgU3F1YXJlcyIsDQogICAgIG1haW4gPSAiTcOpdG9kbyBkZWwgQ29kbyIpDQpgYGANCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IERldGVybWluYXIgbsO6bWVybyBkZSBncnVwb3MgPC9zcGFuPg0KYGBge3J9DQojIFNpZW1wcmUgZXMgdW4gdmFsb3IgaW5pY2lhbCAiY3VhbHF1aWVyYSIsIGx1ZWdvIHNlIG9wdGltaXphLg0KcGxvdCh0aWNrZXRfY2xpZW50ZSRGcmVjdWVuY2lhX3NjYWxlZCx0aWNrZXRfY2xpZW50ZSRUaWNrZXRQcm9tZWRpb19zY2FsZWQpDQpncnVwb3MxIDwtIDQNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IEdlbmVyYXIgbG9zIGdydXBvcyA8L3NwYW4+DQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCmNsdXN0ZXJzMSA8LSBrbWVhbnMoZGYxLGdydXBvczEpDQpjbHVzdGVyczENCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IEdyYWZpY2FyIGxvcyBncnVwb3MgPC9zcGFuPg0KYGBge3J9DQpmdml6X2NsdXN0ZXIoY2x1c3RlcnMxLCBkYXRhPWRmMSkNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IEFncmVnYXIgQ2x1c3RlcnMgYSBsYSBCYXNlIGRlIERhdG9zDQo8L3NwYW4+DQpgYGB7cn0NCmRmMV9jbHVzdGVycyA8LSBjYmluZChkZjEsIGNsdXN0ZXIgPSBjbHVzdGVyczEkY2x1c3RlcikNCmhlYWQoZGYxX2NsdXN0ZXJzKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gQ29uY2x1c2lvbmVzIDwvc3Bhbj4NCkNvbiBiYXNlIGEgbnVlc3RybyBhbmFsaXNpcywgc2UgZGVjaWRpbyBxdWUgZWwgbnVtZXJvIG9wdGltbyBkZSBjbHVzdGVyZXMgc2VhIDQNCg==