Segmentación de Clientes — Supermercado

Paso 1. Librerías

# install.packages(c("readxl","cluster","ggplot2","factoextra","dplyr","scales","knitr"))
library(readxl)
library(cluster)
library(ggplot2)
library(factoextra)
library(dplyr)
library(scales)
library(knitr)

---

Paso 2. Carga de datos

raw <- read_excel("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'

head(raw)

## # A tibble: 6 × 8
##   BillNo Itemname         Quantity Date                Time                Price
##    <dbl> <chr>               <dbl> <dttm>              <dttm>              <dbl>
## 1 536365 WHITE HANGING H…        6 2010-12-01 00:00:00 1899-12-31 08:26:00  2.55
## 2 536365 WHITE METAL LAN…        6 2010-12-01 00:00:00 1899-12-31 08:26:00  3.39
## 3 536365 CREAM CUPID HEA…        8 2010-12-01 00:00:00 1899-12-31 08:26:00  2.75
## 4 536365 KNITTED UNION F…        6 2010-12-01 00:00:00 1899-12-31 08:26:00  3.39
## 5 536365 RED WOOLLY HOTT…        6 2010-12-01 00:00:00 1899-12-31 08:26:00  3.39
## 6 536365 SET 7 BABUSHKA …        2 2010-12-01 00:00:00 1899-12-31 08:26:00  7.65
## # ℹ 2 more variables: CustomerID <dbl>, Country <chr>

---

Paso 3. Limpieza y estadística descriptiva

# Dimensiones y estructura
dim(raw)

## [1] 522064      8

str(raw)

## tibble [522,064 × 8] (S3: tbl_df/tbl/data.frame)
##  $ BillNo    : num [1:522064] 536365 536365 536365 536365 536365 ...
##  $ Itemname  : chr [1:522064] "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Quantity  : num [1:522064] 6 6 8 6 6 2 6 6 6 32 ...
##  $ Date      : POSIXct[1:522064], format: "2010-12-01" "2010-12-01" ...
##  $ Time      : POSIXct[1:522064], format: "1899-12-31 08:26:00" "1899-12-31 08:26:00" ...
##  $ Price     : num [1:522064] 2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ CustomerID: num [1:522064] 17850 17850 17850 17850 17850 ...
##  $ Country   : chr [1:522064] "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...

# Valores faltantes por columna
colSums(is.na(raw))

##     BillNo   Itemname   Quantity       Date       Time      Price CustomerID 
##          3       1455          0          0          0          0     134041 
##    Country 
##          0

# Eliminar filas sin CustomerID, sin precio válido y devoluciones (Quantity < 0)
df_clean <- raw %>%
  filter(!is.na(CustomerID),
         Price > 0,
         Quantity > 0) %>%
  mutate(Total = Quantity * Price)

cat("Filas originales:", nrow(raw), "\n")

## Filas originales: 522064

cat("Filas después de limpieza:", nrow(df_clean), "\n")

## Filas después de limpieza: 387985

# Estadística descriptiva de las variables clave
summary(df_clean[, c("Quantity", "Price", "Total")])

##     Quantity            Price              Total          
##  Min.   :    1.00   Min.   :   0.001   Min.   :1.000e-03  
##  1st Qu.:    2.00   1st Qu.:   1.250   1st Qu.:4.350e+00  
##  Median :    5.00   Median :   1.950   Median :1.140e+01  
##  Mean   :   12.86   Mean   :   3.080   Mean   :2.207e+01  
##  3rd Qu.:   12.00   3rd Qu.:   3.750   3rd Qu.:1.950e+01  
##  Max.   :80995.00   Max.   :8142.750   Max.   :1.685e+05

---

Paso 4. Construcción de métricas por cliente

Se calculan dos métricas para cada cliente:

• Frecuencia de Compra: número de facturas únicas.
• Ticket Promedio ($): gasto promedio por factura.

clientes <- df_clean %>%
  group_by(CustomerID) %>%
  summarise(
    Frecuencia  = n_distinct(BillNo),
    TicketProm  = sum(Total) / n_distinct(BillNo)
  ) %>%
  ungroup()

head(clientes)

## # A tibble: 6 × 3
##   CustomerID Frecuencia TicketProm
##        <dbl>      <int>      <dbl>
## 1      12346          1     77184.
## 2      12347          7       616.
## 3      12349          1      1758.
## 4      12350          1       334.
## 5      12352          8       313.
## 6      12353          1        89

summary(clientes[, c("Frecuencia", "TicketProm")])

##    Frecuencia        TicketProm      
##  Min.   :  1.000   Min.   :    3.45  
##  1st Qu.:  1.000   1st Qu.:  178.30  
##  Median :  2.000   Median :  292.00  
##  Mean   :  4.227   Mean   :  415.62  
##  3rd Qu.:  5.000   3rd Qu.:  426.63  
##  Max.   :209.000   Max.   :84236.25

ggplot(clientes, aes(x = Frecuencia, y = TicketProm)) +
  geom_point(alpha = 0.4, color = "steelblue") +
  scale_y_log10(labels = dollar) +
  labs(title = "Clientes: Frecuencia vs Ticket Promedio",
       x = "Frecuencia de Compra (# facturas)",
       y = "Ticket Promedio ($) — escala log") +
  theme_minimal()

---

Paso 5. Eliminación de outliers

Se usa el método IQR: se eliminan clientes cuya Frecuencia o TicketProm estén por encima de Q3 + 1.5 × IQR. Solo se recorta por arriba porque los valores mínimos legítimos son cercanos a cero.

iqr_frec  <- IQR(clientes$Frecuencia)
iqr_tick  <- IQR(clientes$TicketProm)
q3_frec   <- quantile(clientes$Frecuencia, 0.75)
q3_tick   <- quantile(clientes$TicketProm, 0.75)

lim_frec  <- q3_frec + 1.5 * iqr_frec
lim_tick  <- q3_tick + 1.5 * iqr_tick

cat("Límite Frecuencia:", round(lim_frec, 1), "\n")

## Límite Frecuencia: 11

cat("Límite Ticket Promedio:", round(lim_tick, 2), "\n")

## Límite Ticket Promedio: 799.13

clientes_sin_out <- clientes %>%
  filter(Frecuencia <= lim_frec,
         TicketProm  <= lim_tick)

cat("Clientes antes:", nrow(clientes), "\n")

## Clientes antes: 4296

cat("Clientes después de quitar outliers:", nrow(clientes_sin_out), "\n")

## Clientes después de quitar outliers: 3768

cat("Outliers eliminados:", nrow(clientes) - nrow(clientes_sin_out), "\n")

## Outliers eliminados: 528

ggplot(clientes_sin_out, aes(x = Frecuencia, y = TicketProm)) +
  geom_point(alpha = 0.4, color = "steelblue") +
  labs(title = "Clientes sin outliers",
       x = "Frecuencia de Compra",
       y = "Ticket Promedio ($)") +
  theme_minimal()

---

Paso 6. Escalado de datos

Las variables están en escalas muy distintas, por lo que se normalizan antes de clusterizar.

datos_escalar <- clientes_sin_out %>% select(Frecuencia, TicketProm)
datos_scaled  <- scale(datos_escalar)

---

Paso 7. Optimización del número de clusters

set.seed(123)
optimizacion <- fviz_nbclust(datos_scaled, kmeans, method = "wss") +
  labs(title = "Método del Codo — Número óptimo de clusters",
       x = "Número de clusters k",
       y = "Suma de cuadrados intra-cluster") +
  theme_minimal()
optimizacion

set.seed(123)
fviz_nbclust(datos_scaled, kmeans, method = "silhouette") +
  labs(title = "Método Silhouette — Número óptimo de clusters") +
  theme_minimal()

Ambos métodos confirman k = 4 como número óptimo de clusters.

---

Paso 8. Generación de los 4 clusters

set.seed(123)
km <- kmeans(datos_scaled, centers = 4, nstart = 25)
km

## K-means clustering with 4 clusters of sizes 1104, 667, 462, 1535
## 
## Cluster means:
##    Frecuencia  TicketProm
## 1 -0.42910270  0.35429698
## 2  1.75259650  0.05644045
## 3 -0.06486845  1.90366437
## 4 -0.43340930 -0.85230136
## 
## Clustering vector:
##    [1] 3 1 2 4 1 3 4 2 1 1 1 1 3 1 3 2 2 1 4 2 3 1 1 1 4 4 2 3 1 4 4 2 3 4 1 2 3
##   [38] 3 1 1 1 1 3 4 4 4 1 1 4 4 3 4 2 1 1 3 1 2 1 1 3 3 2 3 3 2 2 3 1 1 2 1 4 4
##   [75] 2 4 2 3 4 4 1 4 4 3 4 3 1 3 3 2 1 3 3 4 2 2 1 4 2 1 4 1 1 1 1 1 3 3 4 4 4
##  [112] 4 2 1 1 1 3 4 2 1 4 1 1 3 4 4 2 4 1 1 4 2 4 1 1 4 4 2 1 2 2 2 4 4 3 4 1 2
##  [149] 3 3 1 3 1 1 4 2 1 4 1 1 3 3 1 3 3 3 1 1 4 1 3 1 1 3 1 4 1 4 4 1 3 4 4 2 4
##  [186] 3 4 1 3 2 1 4 2 2 4 3 1 2 4 1 4 1 1 4 1 3 3 2 1 1 3 3 4 1 2 4 4 1 1 2 2 4
##  [223] 1 4 1 4 1 4 4 3 1 1 2 1 4 3 4 2 2 2 3 2 1 1 4 4 1 4 1 1 1 1 1 1 4 1 4 4 4
##  [260] 3 1 4 4 4 1 2 1 2 4 2 4 4 4 1 1 3 4 1 3 3 2 4 4 3 4 1 2 1 4 2 3 3 4 3 3 2
##  [297] 2 4 1 1 4 1 4 1 3 4 1 1 3 4 1 4 4 4 4 4 1 3 1 2 2 2 3 4 3 3 2 4 1 4 4 1 2
##  [334] 4 4 4 2 1 1 4 1 4 1 1 2 2 2 3 2 1 1 2 4 2 4 2 3 4 4 4 4 3 4 4 1 4 3 1 3 4
##  [371] 4 4 1 4 1 4 4 4 4 1 4 4 4 2 2 3 1 4 2 1 2 1 1 1 3 4 1 1 1 1 1 3 3 1 1 2 3
##  [408] 1 1 1 4 4 1 4 1 1 4 4 4 4 4 4 4 4 4 2 4 4 1 4 4 2 4 4 4 2 4 1 1 1 2 3 3 2
##  [445] 2 4 1 1 2 1 4 1 4 4 1 3 2 2 3 4 3 1 4 4 4 4 1 1 4 1 1 1 4 4 1 3 1 4 1 1 4
##  [482] 4 4 1 1 2 4 2 2 4 3 4 4 4 1 4 4 1 3 4 4 4 2 3 1 1 1 2 1 4 4 4 1 4 4 1 1 4
##  [519] 2 1 1 4 1 4 4 3 4 1 2 4 4 4 3 4 4 1 3 1 4 2 2 3 4 4 4 1 4 3 4 1 1 4 4 3 1
##  [556] 1 1 4 4 3 1 4 1 4 4 1 2 4 1 2 1 1 2 1 2 4 1 1 4 2 2 3 2 1 1 1 3 1 3 1 1 1
##  [593] 4 4 3 1 1 3 3 3 3 1 1 3 3 4 4 1 1 3 1 3 1 4 3 4 3 3 1 1 3 4 2 1 3 2 1 1 4
##  [630] 4 4 2 4 1 1 1 4 4 3 2 4 4 4 1 3 1 2 4 2 1 1 1 3 1 2 3 1 4 3 2 4 3 4 3 1 3
##  [667] 4 3 4 4 1 3 2 4 2 4 4 1 1 1 4 4 2 1 1 1 2 1 4 2 1 4 4 1 4 3 4 2 1 4 4 4 4
##  [704] 1 3 3 4 3 1 4 3 4 1 2 4 4 4 4 2 2 4 4 4 1 2 4 1 4 4 4 3 1 3 4 1 4 4 4 4 4
##  [741] 1 4 4 3 4 3 2 4 2 1 4 2 1 1 4 4 1 1 4 4 3 2 1 1 1 4 4 4 4 1 2 2 2 2 2 2 2
##  [778] 1 4 1 4 3 4 1 4 2 4 1 2 1 4 4 3 3 1 4 4 1 4 1 4 4 4 4 4 4 4 2 4 4 3 4 1 2
##  [815] 4 2 4 1 1 1 4 4 4 2 4 2 4 2 4 3 3 4 2 3 4 2 1 1 1 3 1 1 4 1 4 2 3 1 4 2 2
##  [852] 1 2 3 4 2 2 1 4 3 1 3 2 3 1 1 4 4 4 2 2 4 4 1 3 4 1 3 1 1 2 1 1 4 2 3 1 4
##  [889] 1 3 1 4 1 4 1 1 2 4 4 4 2 4 1 4 4 4 4 2 1 1 1 1 3 4 4 4 2 2 1 4 4 1 3 2 4
##  [926] 3 2 4 4 2 3 2 4 4 1 1 1 2 4 4 3 1 4 4 4 3 4 3 2 1 4 3 4 1 2 4 4 1 4 1 4 3
##  [963] 1 1 1 4 4 4 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 4 2 4 1 1 2 1 4 4 3 2 1 3 3 1 2
## [1000] 4 2 2 2 3 3 1 3 3 1 1 1 4 3 3 1 4 1 1 4 4 4 2 2 4 2 3 4 3 4 4 4 1 4 2 1 1
## [1037] 4 4 4 3 4 2 4 4 1 2 4 1 4 4 2 1 4 1 4 2 4 4 4 1 4 2 4 2 4 2 1 4 4 2 3 4 2
## [1074] 4 3 1 4 4 1 2 1 2 4 3 1 1 4 1 4 4 4 1 1 1 3 4 4 3 2 1 4 3 4 4 1 4 4 4 4 2
## [1111] 1 1 4 2 1 3 1 4 4 2 4 4 1 4 2 2 2 2 2 3 4 4 1 2 3 1 1 2 2 3 1 2 1 4 3 4 4
## [1148] 4 2 1 4 4 2 3 4 1 3 3 3 3 4 3 2 4 1 3 1 4 4 4 1 4 1 3 4 1 2 3 2 2 1 4 1 2
## [1185] 4 3 1 3 2 2 1 2 4 2 3 4 2 1 4 1 3 4 1 1 2 4 1 1 1 4 2 4 2 4 3 1 4 1 4 1 4
## [1222] 4 4 1 4 1 3 4 2 4 4 4 1 1 4 4 3 1 4 4 3 2 3 2 4 2 4 3 1 2 4 2 2 2 2 1 4 2
## [1259] 4 3 2 1 1 3 1 1 2 4 2 1 2 2 4 4 4 3 1 1 1 2 4 4 4 1 4 4 2 4 4 3 2 4 1 2 4
## [1296] 4 2 4 3 1 4 1 4 1 1 2 4 1 4 2 1 4 3 4 4 1 1 2 1 4 4 2 3 4 3 2 2 4 2 4 4 1
## [1333] 2 4 4 4 4 4 2 2 1 4 2 4 2 4 1 4 1 1 2 4 3 2 1 1 1 4 4 2 3 4 3 1 3 3 4 4 2
## [1370] 2 4 4 4 4 4 2 1 4 4 2 4 1 4 4 4 2 1 4 1 4 3 1 4 4 4 1 4 2 1 2 4 1 3 1 1 1
## [1407] 4 1 1 1 2 2 4 4 1 1 1 4 1 1 4 2 3 4 4 4 2 4 4 4 1 2 4 1 4 1 2 3 2 4 4 2 3
## [1444] 4 4 2 4 4 2 4 2 4 3 2 1 2 4 1 4 2 1 2 4 4 4 2 4 4 2 3 1 1 2 4 2 1 2 2 3 2
## [1481] 2 2 1 2 1 3 1 2 3 1 1 3 4 4 1 1 4 2 4 1 4 1 2 1 4 4 4 4 4 1 4 4 4 4 2 4 4
## [1518] 4 4 1 1 4 4 2 2 4 1 1 3 4 4 4 4 4 1 3 4 4 2 4 1 4 3 3 3 1 1 1 2 4 2 1 1 3
## [1555] 1 4 4 1 1 4 4 2 1 1 4 3 3 2 4 1 1 2 3 1 1 4 4 1 3 3 4 1 2 2 1 3 3 1 2 1 4
## [1592] 1 1 4 1 3 3 3 1 4 4 4 2 1 1 2 1 1 4 4 4 4 3 4 2 4 1 4 1 4 1 1 4 1 4 1 2 2
## [1629] 4 4 4 4 1 4 4 4 1 1 3 4 1 1 4 4 4 4 4 1 2 4 2 2 1 4 1 4 1 4 2 2 4 4 2 4 4
## [1666] 3 1 1 4 4 3 1 4 4 4 3 2 2 4 4 1 3 3 1 4 3 1 3 3 4 4 4 1 3 2 1 1 4 3 1 4 4
## [1703] 1 1 4 1 3 2 2 2 1 4 3 2 1 1 2 4 1 1 4 3 4 1 1 2 1 2 1 2 4 1 4 2 3 1 1 3 3
## [1740] 1 3 2 1 1 1 3 1 4 4 1 1 4 4 2 4 4 4 2 4 4 1 4 1 4 1 3 1 4 1 2 2 1 1 4 2 1
## [1777] 1 4 4 2 4 4 2 1 2 1 3 1 4 1 4 2 4 1 4 1 1 1 1 2 2 1 1 1 1 1 2 1 4 1 1 2 1
## [1814] 4 4 1 3 4 2 1 2 1 1 3 4 1 1 4 2 4 4 3 1 4 3 4 3 1 3 2 1 4 1 4 4 1 1 4 1 4
## [1851] 1 3 4 1 4 1 1 1 4 4 1 1 1 4 1 4 4 4 4 4 2 1 4 2 1 1 1 1 2 1 3 1 2 4 1 2 2
## [1888] 1 1 1 1 3 1 4 3 4 1 4 3 1 4 1 1 1 1 1 2 1 4 1 3 3 4 4 4 4 4 2 3 4 4 4 1 2
## [1925] 4 1 4 4 4 3 2 3 4 4 1 1 1 4 2 4 4 4 4 4 4 4 1 4 4 1 1 1 2 1 3 4 4 1 2 1 2
## [1962] 3 3 1 4 4 3 1 1 2 4 2 4 2 4 1 2 1 2 4 1 1 1 4 2 4 2 1 1 1 4 4 3 4 4 4 2 4
## [1999] 3 4 1 4 1 4 1 1 4 4 1 4 4 4 2 4 2 1 4 4 4 4 4 4 1 4 4 1 4 2 2 1 4 1 2 4 4
## [2036] 2 2 4 1 1 4 4 4 1 3 1 2 1 4 1 1 2 3 2 4 1 4 1 3 4 4 3 4 1 1 4 1 1 1 3 4 4
## [2073] 2 1 2 4 4 1 1 4 4 4 2 3 3 4 3 1 4 1 2 4 2 4 4 4 4 4 2 1 1 1 4 3 4 1 4 2 4
## [2110] 2 4 4 1 4 3 3 2 4 4 1 3 4 1 4 4 3 2 1 4 4 4 1 4 1 4 2 2 4 4 2 4 1 4 4 1 3
## [2147] 3 1 4 3 1 4 4 1 4 4 4 3 1 1 4 1 3 2 3 1 1 1 1 1 1 1 4 1 2 2 3 3 2 3 4 1 1
## [2184] 4 3 3 1 3 1 3 4 4 1 1 4 1 4 4 2 4 4 4 4 4 1 2 2 2 4 4 2 1 4 4 1 4 3 4 1 4
## [2221] 4 4 4 4 4 4 3 4 4 4 2 4 1 4 3 4 2 1 4 2 4 2 4 4 1 4 1 1 4 4 1 2 1 4 4 4 4
## [2258] 1 1 4 1 4 1 1 4 2 1 4 4 4 4 4 1 1 2 1 4 3 2 1 2 3 4 2 4 1 4 2 1 2 3 3 4 4
## [2295] 1 4 4 4 3 4 4 2 4 4 2 1 3 4 4 1 4 2 1 1 4 1 1 4 1 2 4 1 4 1 4 1 3 3 4 3 2
## [2332] 2 1 1 1 2 1 1 3 4 2 4 1 4 3 3 1 2 2 4 1 4 1 1 4 2 4 3 2 1 1 4 2 1 1 4 4 4
## [2369] 2 3 4 4 1 1 4 1 4 1 3 2 3 1 3 4 4 1 3 3 2 4 2 4 1 4 4 2 2 2 4 1 3 4 1 1 3
## [2406] 2 4 2 2 1 1 1 4 4 1 1 2 1 4 4 4 1 1 3 3 1 4 1 4 4 1 1 2 3 1 4 1 4 4 2 1 1
## [2443] 2 4 1 3 1 4 4 2 1 4 2 4 3 3 4 4 2 4 2 3 4 4 2 2 1 2 1 1 3 3 3 4 2 1 4 1 2
## [2480] 1 1 4 4 1 2 3 1 1 4 4 2 1 1 1 3 4 4 4 4 4 3 4 2 4 4 4 3 3 4 4 4 3 1 2 4 1
## [2517] 4 4 4 4 4 3 2 3 4 4 4 1 2 1 1 4 3 1 4 4 3 3 4 3 1 1 4 4 4 1 4 2 2 4 1 4 4
## [2554] 1 4 4 2 2 4 4 1 4 4 1 4 2 1 4 1 2 4 1 1 4 1 4 2 2 3 4 4 4 4 1 4 1 1 1 4 2
## [2591] 2 4 1 4 4 1 1 2 4 4 4 4 4 2 4 2 4 4 3 4 4 4 1 4 3 1 4 3 2 4 4 2 1 1 3 4 1
## [2628] 4 1 4 2 4 4 4 4 1 1 4 4 1 2 1 3 3 1 4 1 1 2 3 1 4 1 4 2 4 1 1 4 4 1 4 2 3
## [2665] 1 1 1 4 1 4 1 1 4 4 4 4 4 1 4 4 4 2 4 3 4 3 4 4 1 3 3 4 4 3 4 4 4 4 1 1 1
## [2702] 2 4 2 4 1 2 1 4 1 1 1 4 1 3 3 4 3 4 4 4 1 4 4 1 2 1 2 3 4 1 4 4 2 2 4 2 1
## [2739] 4 4 3 4 4 4 4 3 3 2 2 2 1 1 1 3 3 2 4 1 1 2 2 1 1 4 3 4 3 1 4 1 1 2 2 1 2
## [2776] 4 4 4 3 4 4 1 1 1 3 3 4 3 2 4 1 4 2 4 4 2 1 4 4 4 1 4 1 4 2 2 4 4 2 1 1 1
## [2813] 1 4 4 4 1 4 2 1 1 1 2 4 2 2 1 1 4 1 1 4 4 1 4 1 1 4 4 2 1 2 1 4 4 1 4 1 4
## [2850] 4 4 4 1 1 4 4 4 4 2 4 2 2 4 2 1 4 4 4 4 4 3 2 4 4 4 4 4 2 1 1 2 4 2 1 2 2
## [2887] 4 4 2 1 1 2 2 4 1 4 4 2 4 4 1 1 1 3 2 1 1 4 2 1 1 4 4 2 4 1 4 4 4 4 4 4 2
## [2924] 1 4 4 1 4 1 2 3 1 2 2 2 4 2 4 2 2 4 4 4 2 3 3 4 2 4 1 4 3 1 1 4 4 4 4 2 1
## [2961] 4 4 1 4 4 4 1 1 2 1 4 3 1 1 2 3 4 1 3 2 1 3 4 2 4 2 1 2 1 2 1 4 1 4 4 4 4
## [2998] 3 2 2 3 2 2 1 1 1 1 2 3 1 4 1 2 4 4 2 1 4 4 1 1 4 1 1 1 2 4 3 3 4 2 1 1 3
## [3035] 3 4 1 4 3 4 1 4 4 1 3 3 2 4 2 4 4 1 4 1 2 4 1 1 4 4 4 3 4 4 2 4 4 2 2 4 4
## [3072] 1 3 1 1 4 2 4 2 2 4 2 4 4 1 4 1 2 2 4 2 2 4 4 4 1 2 4 1 3 4 1 1 4 1 4 4 4
## [3109] 4 4 1 2 4 1 4 4 4 3 4 3 4 4 3 2 4 2 2 1 1 3 2 4 4 4 4 4 2 4 4 3 4 2 1 1 2
## [3146] 4 4 1 4 4 1 4 3 4 1 4 4 4 4 2 4 1 4 4 4 4 4 4 4 4 2 2 4 2 4 4 2 4 4 4 4 1
## [3183] 4 4 4 1 2 1 1 1 4 4 1 4 2 1 1 3 4 1 2 1 2 1 3 4 4 2 1 1 4 4 4 1 4 1 2 4 1
## [3220] 4 2 4 1 2 2 4 4 4 4 2 1 1 2 4 1 2 1 1 4 2 2 4 4 3 1 4 1 4 2 2 1 4 1 1 3 1
## [3257] 4 4 1 2 3 1 1 1 3 1 2 3 4 4 4 4 2 3 4 2 4 4 1 1 4 2 2 1 4 4 4 1 4 1 4 4 4
## [3294] 4 4 1 4 2 4 4 4 4 4 2 4 1 2 1 1 4 4 4 4 4 4 4 3 1 1 3 3 2 3 3 4 2 4 4 1 4
## [3331] 4 2 2 1 4 4 1 4 4 1 3 1 3 4 2 4 4 1 2 1 1 4 3 1 4 2 1 4 1 4 2 1 4 2 2 1 4
## [3368] 2 1 1 2 4 2 4 1 2 1 2 1 4 2 4 2 4 4 4 1 1 2 1 4 3 1 3 1 1 2 4 4 4 4 3 4 1
## [3405] 2 4 1 3 3 1 2 1 1 1 4 4 4 3 2 4 2 4 4 1 2 4 2 2 1 4 3 4 1 4 1 3 2 2 4 4 1
## [3442] 4 4 4 4 4 4 4 3 3 4 4 1 4 4 1 2 2 1 3 3 4 2 4 4 2 1 2 3 4 4 4 4 4 2 3 1 4
## [3479] 2 4 4 4 4 1 4 4 2 1 3 4 1 2 4 4 2 2 4 1 4 1 4 4 4 4 1 4 2 4 1 4 4 4 2 4 1
## [3516] 4 4 4 4 4 4 4 4 4 1 4 4 1 4 4 4 2 4 4 4 4 2 4 1 1 4 1 3 4 2 1 4 4 4 1 4 1
## [3553] 4 4 4 3 4 4 4 2 4 1 4 3 4 1 4 1 1 1 4 1 4 3 4 4 2 4 4 4 4 2 4 4 4 4 1 2 1
## [3590] 4 4 4 4 4 2 4 4 4 3 4 4 4 4 4 4 4 4 2 4 4 4 2 4 4 4 1 2 1 4 4 2 4 1 1 1 4
## [3627] 2 4 4 1 2 2 4 3 4 3 4 1 4 4 3 2 1 1 2 4 4 3 4 1 1 4 4 4 4 2 1 4 4 1 2 1 1
## [3664] 4 4 4 1 4 1 4 3 3 3 4 4 4 4 1 4 4 1 4 3 1 2 1 1 1 2 4 1 2 3 4 1 2 1 2 2 1
## [3701] 1 4 1 3 3 4 4 4 1 4 1 4 3 1 4 2 4 4 4 1 1 1 1 2 1 2 1 4 2 4 1 2 2 4 1 3 2
## [3738] 2 2 1 3 2 1 1 4 1 1 4 2 3 2 4 4 1 1 4 4 4 2 4 4 1 4 4 4 4 4 3
## 
## Within cluster sum of squares by cluster:
## [1] 365.2970 761.3557 424.6731 510.3419
##  (between_SS / total_SS =  72.6 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

---

Paso 9. Visualización de los clusters

fviz_cluster(km, data = datos_scaled,
             palette = c("#E41A1C","#377EB8","#4DAF4A","#FF7F00"),
             geom = "point", ellipse.type = "convex",
             ggtheme = theme_minimal()) +
  labs(title = "Segmentación de Clientes — 4 Clusters",
       x = "Frecuencia de Compra (escalada)",
       y = "Ticket Promedio (escalado)")

---

Paso 10. Agregar clusters a la tabla original

clientes_cluster <- clientes_sin_out %>%
  mutate(Cluster = factor(km$cluster))

head(clientes_cluster)

## # A tibble: 6 × 4
##   CustomerID Frecuencia TicketProm Cluster
##        <dbl>      <int>      <dbl> <fct>  
## 1      12347          7       616. 3      
## 2      12350          1       334. 1      
## 3      12352          8       313. 2      
## 4      12353          1        89  4      
## 5      12355          1       459. 1      
## 6      12358          2       584. 3

---

Paso 11. Características por cluster

resumen <- clientes_cluster %>%
  group_by(Cluster) %>%
  summarise(
    N_clientes   = n(),
    Frec_media   = round(mean(Frecuencia), 1),
    Frec_mediana = median(Frecuencia),
    Ticket_medio = round(mean(TicketProm), 2),
    Ticket_med   = round(median(TicketProm), 2)
  ) %>%
  arrange(Cluster)

kable(resumen, caption = "Resumen estadístico por cluster")

Resumen estadístico por cluster

Cluster	N_clientes	Frec_media	Frec_mediana	Ticket_medio	Ticket_med
1	1104	1.9	2	351.04	341.65
2	667	7.1	7	302.97	292.50
3	462	2.8	2	601.12	585.21
4	1535	1.9	2	156.29	158.16

ggplot(clientes_cluster, aes(x = Frecuencia, y = TicketProm, color = Cluster)) +
  geom_point(alpha = 0.5) +
  scale_y_log10(labels = dollar) +
  scale_color_manual(values = c("1"="#E41A1C","2"="#377EB8","3"="#4DAF4A","4"="#FF7F00")) +
  labs(title = "Frecuencia de Compra vs Ticket Promedio por Cluster",
       x = "Frecuencia de Compra",
       y = "Ticket Promedio ($) — escala log",
       color = "Cluster") +
  theme_minimal()

---

Paso 12. Nombres y recomendaciones por cluster

Se asigna un nombre de negocio a cada cluster con base en su perfil:

# Asignar etiqueta según el perfil de cada cluster
# (ajustar el mapeo si los números de cluster cambian al re-ejecutar)
niveles <- resumen %>%
  mutate(nombre = case_when(
    Frec_media == max(Frec_media)  & Ticket_medio == max(Ticket_medio) ~ "VIP / Champions",
    Frec_media == max(Frec_media)                                       ~ "Fieles de bajo ticket",
    Ticket_medio == max(Ticket_medio)                                   ~ "Compradores ocasionales premium",
    TRUE                                                                ~ "Clientes esporádicos"
  ))

# Mapa cluster → nombre
mapa_nombres <- setNames(niveles$nombre, as.character(niveles$Cluster))

clientes_cluster <- clientes_cluster %>%
  mutate(Segmento = mapa_nombres[as.character(Cluster)])

kable(head(clientes_cluster, 10))

CustomerID	Frecuencia	TicketProm	Cluster	Segmento
12347	7	615.7143	3	Compradores ocasionales premium
12350	1	334.4000	1	Clientes esporádicos
12352	8	313.2550	2	Fieles de bajo ticket
12353	1	89.0000	4	Clientes esporádicos
12355	1	459.4000	1	Clientes esporádicos
12358	2	584.0300	3	Compradores ocasionales premium
12361	1	189.9000	4	Clientes esporádicos
12362	10	522.6230	2	Fieles de bajo ticket
12363	2	276.0000	1	Clientes esporádicos
12364	4	328.2750	1	Clientes esporádicos

# Distribución de clientes por segmento
clientes_cluster %>%
  count(Segmento) %>%
  mutate(Pct = scales::percent(n / sum(n))) %>%
  kable(caption = "Distribución de clientes por segmento")

Distribución de clientes por segmento

Segmento	n	Pct
Clientes esporádicos	2639	70.0%
Compradores ocasionales premium	462	12.3%
Fieles de bajo ticket	667	17.7%

---

Conclusiones y Recomendaciones

VIP / Champions

Perfil: alta frecuencia de compra y ticket promedio alto. Recomendación: programa de lealtad exclusivo, acceso anticipado a nuevos productos, descuentos personalizados. Son los clientes más valiosos — el objetivo es retenerlos.

---

Fieles de bajo ticket

Perfil: compran muy seguido pero gastan poco por visita. Recomendación: estrategias de upselling y venta cruzada para incrementar el valor por transacción: combos, mínimos de envío gratuito, sugerencias de productos complementarios.

---

Compradores ocasionales premium

Perfil: compran poco frecuente pero gastan mucho cuando lo hacen. Recomendación: campañas de reactivación (email/push) con ofertas de temporada, recordatorios de recompra y programas de suscripción para aumentar la frecuencia.

---

Clientes esporádicos

Perfil: baja frecuencia y bajo ticket. Recomendación: descuentos de bienvenida, promociones de primer reorder, comunicación educativa sobre el catálogo. Son candidatos a ascender de segmento con la estrategia correcta.