Segmentación de Clientes para Marketing

Proyecto Segmentación de Clientes

Presentación

En general, la técnica de segmentación consiste en crear grupos o clústers con la característica de que las observaciones dentro de cada grupo son muy similares y, por el contrario, existen diferencias marcadas entre los grupos.

La segmentación de clientes es de gran utilidad dentro de las empresas ya que permite agruparlos según las características que comparten, lo que a su vez permitirá, por ejemplo, al área de Marketing, diseñar campañas mejor focalizadas incrementando la probabilidad de éxito.

Tomando en cuenta lo anterior, la segmentación de clientes es el proceso de dividirlos en grupos basados en características comunes para que las empresas puedan comercializar y focalizar sus recursos y esfuerzos de manera efectiva y adecuada a cada segmento. Por ejemplo, al analizar el historial de compras de clientes y ventas de productos, podemos agrupar productos y clientes en grupos que se comportan de manera similar y tomar decisiones comerciales basadas en datos que pueden mejorar una amplia gama de indicadores clave de rendimiento (KPI´s) de inventario y ventas.

Desde saber qué productos comprar, cuántos de ellos y cuándo, hasta comercializar los productos correctos para los clientes correctos en el momento correcto son algunas de las ventajas de este tipo de análisis.

Los datos para este análisis provienen del repositorio de aprendizaje automático de UC Irvine, que es un sitio web para la comunidad de machine learning, donde se pueden encontrar bases de datos para practicar data science. También, se encuentran en mi repositorio de github junto con el código de esta publicación.

Contenido

• Presentación
• Contenido
• Set up
• Carga y preparación de los datos
• Ingeniería de variables
• Análisis exploratorio
  • Ingresos por fecha
  • Ingresos por día
  • Análisis por hora del día
  • Análisis del mercado
  • Business Insights
  • Curvas de Pareto
  • Insights en la descripción de los productos
• Categorías de productos
• Segmentación de clientes
  • Prediagnóstico
  • Algoritmo K-means
  • Análisis RFM: (Recency, Frequency, Monetary)
  • Productos de interés dentro de cada Clúster
  • Resumen estadístico por Clúster
  • Segmentación adicional: árbol de decisión
• Reglas de Asociación
  • Venta cruzada
  • Algoritmo Apriori
  • Creaando reglas
• Conclusiones

Set up

Iniciamos configurando las opciones generales que vamos a requerir para el desarrollo de este proyecto.

knitr::opts_chunk$set(echo = TRUE,
                      warning = FALSE,
                      message = FALSE,
                      warning = FALSE,
                      fig.align = "center"
                      )


paquetes <- c("knitr","tidyverse","ggplot2","gridExtra","tidyverse","DataExplorer","lubridate",
              "agricolae","sf","raster","dplyr","spData","tm","tmap","cluster","factoextra",
              "FactoMineR","wordcloud","fmsb","scales","rpart","rpart.plot","kableExtra",
              "summarytools", "DT", "clustertend", "ggpubr", "sfo", "arules", "arulesViz",
              "plyr", "plotly")

instalados <- paquetes %in% installed.packages()

if(sum(instalados == FALSE) > 0) {
  install.packages(paquetes[!instalados])
}

lapply(paquetes, require, character.only = TRUE)

 

Carga y preparación de los datos

Comencemos por cargar el conjunto de datos y hacer un primer análisis descriptivo básico para tener una idea de su tamaño y el tipo de cada variable.

El conjunto de datos a trabajar corresponden a todas las transacciones ocurridas entre el 01/12/2010 y el 09/12/2011 para un comercio minorista en línea registrado y no registrado en el Reino Unido. La empresa vende principalmente regalos únicos para todas las ocasiones. Muchos clientes de la empresa son mayoristas.

df <- read_csv("Online Retail.csv", col_types = cols())

DT::datatable(head(df, 20),
              rownames = FALSE,
              options = list(
                pageLength = 5))

Los atributos de la base son los siguientes:

• InvoiceNo: Número de factura. Nominal, un número integral de 6 dígitos asignado de forma exclusiva a cada transacción. Si este código comienza con la letra ‘c’, indica una cancelación.
• StockCode: Código de producto (artículo). Nominal, un número integral de 5 dígitos asignado de forma única a cada producto distinto.
• Description: Nombre del producto (artículo). Nominal.
• Quantity: Las cantidades de cada producto (artículo) por transacción. Numérico.
• InvoiceDate: Fecha y hora de la factura. Numérico, el día y la hora en que se generó cada transacción.
• UnitPrice: Precio unitario. Numérico, Precio del producto por unidad en libras esterlinas.
• CustomerID: Número de cliente. Nominal, un número integral de 5 dígitos asignado de forma exclusiva a cada cliente.
• Country: Nombre del país. Nominal, el nombre del país donde reside cada cliente.

str(df)

## spec_tbl_df [541,909 x 8] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ InvoiceNo  : chr [1:541909] "536365" "536365" "536365" "536365" ...
##  $ StockCode  : chr [1:541909] "85123A" "71053" "84406B" "84029G" ...
##  $ Description: chr [1:541909] "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Quantity   : num [1:541909] 6 6 8 6 6 2 6 6 6 32 ...
##  $ InvoiceDate: chr [1:541909] "01/12/2010 08:26" "01/12/2010 08:26" "01/12/2010 08:26" "01/12/2010 08:26" ...
##  $ UnitPrice  : num [1:541909] 2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ CustomerID : num [1:541909] 17850 17850 17850 17850 17850 ...
##  $ Country    : chr [1:541909] "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   InvoiceNo = col_character(),
##   ..   StockCode = col_character(),
##   ..   Description = col_character(),
##   ..   Quantity = col_double(),
##   ..   InvoiceDate = col_character(),
##   ..   UnitPrice = col_double(),
##   ..   CustomerID = col_double(),
##   ..   Country = col_character()
##   .. )

Tenemos entonces una base datos con 541,909 registros y 8 variables. Veamos si hay valores faltantes:

plot_missing(df, title = "Porcentaje de Datos Incompletos",
             geom_label_args = list("size" = 3, "label.padding" = unit(0.1, "lines")),
             ggtheme = theme_minimal())

En la gráfica anterior, podemos apreciar que casi el 25% de los registros no tiene asignado un id de cliente, además, como esta variable representa el identificador es complicado tratar de hacer algún tipo de imputación, por lo tanto, vamos a eliminar esos registros.

df <- na.omit(df)

plot_missing(df, title = "Porcentaje de Datos Incompletos",
             geom_label_args = list("size" = 3, "label.padding" = unit(0.1, "lines")),
             ggtheme = theme_minimal())

str(df)

## tibble [406,829 x 8] (S3: tbl_df/tbl/data.frame)
##  $ InvoiceNo  : chr [1:406829] "536365" "536365" "536365" "536365" ...
##  $ StockCode  : chr [1:406829] "85123A" "71053" "84406B" "84029G" ...
##  $ Description: chr [1:406829] "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Quantity   : num [1:406829] 6 6 8 6 6 2 6 6 6 32 ...
##  $ InvoiceDate: chr [1:406829] "01/12/2010 08:26" "01/12/2010 08:26" "01/12/2010 08:26" "01/12/2010 08:26" ...
##  $ UnitPrice  : num [1:406829] 2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ CustomerID : num [1:406829] 17850 17850 17850 17850 17850 ...
##  $ Country    : chr [1:406829] "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...
##  - attr(*, "na.action")= 'omit' Named int [1:135080] 623 1444 1445 1446 1447 1448 1449 1450 1451 1452 ...
##   ..- attr(*, "names")= chr [1:135080] "623" "1444" "1445" "1446" ...

Después de eliminar los valores faltantes nos queda una base de 406,829 registros.

Ingeniería de variables

Al ver el tipo de las variables podemos identificar que CustomerID es numérica y debe ser de tipo character, por lo que, hacemos el cambio:

df$CustomerID <- as.character(df$CustomerID)

Las variables que podemos usar para crear variables sintéticas son:

• InvoiceDate:
  • InvoiceTime: hora de facturación
  • Year: año de la facturación
  • Month: mes de la facturación
  • DayOfWeek: día de la facturación
  • HourOfDay: hora del día
• Quantity y UnitPrice: crear una variable que represente el precio total de la cesta, BasketPrice.

df <- separate(df, col = c("InvoiceDate"),
                      into = c("InvoiceDate", "InvoiceTime"), sep = " ")

df <- separate(df, col = c("InvoiceDate"),
                      into = c("Day", "Month", "Year"), sep = "/",
                      remove = FALSE)

df <- df %>% dplyr::select(-c(Day, Month))

df$Month <- dmy(df$InvoiceDate) 
df$Month <- month(df$Month, label = TRUE)

df$InvoiceDate <- as.Date(df$InvoiceDate, "%d/%m/%Y")

df$DayOfWeek <- wday(df$InvoiceDate, label = TRUE, abbr = FALSE)
df$DayOfWeek <- as.character(df$DayOfWeek)

df <- separate(df, col = c("InvoiceTime"),
                      into = c("HourOfDay", "Minutes"), sep = ":",
                      remove = FALSE)

df <- df %>% dplyr::select(-Minutes)

df <- df %>% mutate(BasketPrice = Quantity * UnitPrice)

Finalmente, hay que revisar si hay registros duplicados:

nrow(df[duplicated(df), ])

## [1] 5225

Tenemos 5,225 registros duplicados, por lo que, debemos eliminarlos y, además, revisar los tipos de variables para identificar si son los correctos:

df <- dplyr::distinct(df)

str(df)

## tibble [401,604 x 14] (S3: tbl_df/tbl/data.frame)
##  $ InvoiceNo  : chr [1:401604] "536365" "536365" "536365" "536365" ...
##  $ StockCode  : chr [1:401604] "85123A" "71053" "84406B" "84029G" ...
##  $ Description: chr [1:401604] "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Quantity   : num [1:401604] 6 6 8 6 6 2 6 6 6 32 ...
##  $ InvoiceDate: Date[1:401604], format: "2010-12-01" "2010-12-01" ...
##  $ Year       : chr [1:401604] "2010" "2010" "2010" "2010" ...
##  $ InvoiceTime: chr [1:401604] "08:26" "08:26" "08:26" "08:26" ...
##  $ HourOfDay  : chr [1:401604] "08" "08" "08" "08" ...
##  $ UnitPrice  : num [1:401604] 2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ CustomerID : chr [1:401604] "17850" "17850" "17850" "17850" ...
##  $ Country    : chr [1:401604] "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...
##  $ Month      : Ord.factor w/ 12 levels "ene"<"feb"<"mar"<..: 12 12 12 12 12 12 12 12 12 12 ...
##  $ DayOfWeek  : chr [1:401604] "miércoles" "miércoles" "miércoles" "miércoles" ...
##  $ BasketPrice: num [1:401604] 15.3 20.3 22 20.3 20.3 ...

Las siguientes variables están como character y por conveniencia debemos pasarlas a tipo factor:

• Year
• Country
• DayOfWeek
• HourOfDay

df$Year <- as.factor(df$Year)
levels(df$Year) <- c(2010, 2011)

df$Country <- as.factor(df$Country)

df$HourOfDay <- as.factor(df$HourOfDay)

df$DayOfWeek <- as.factor(df$DayOfWeek)
df$DayOfWeek <- ordered(df$DayOfWeek, 
                        levels = c("lunes", "martes", "miércoles", "jueves", "viernes", "domingo"))

kable(df[1:10, ], caption = "Dataset con nuevas variables", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), font_size = 10)

Dataset con nuevas variables

InvoiceNo	StockCode	Description	Quantity	InvoiceDate	Year	InvoiceTime	HourOfDay	UnitPrice	CustomerID	Country	Month	DayOfWeek	BasketPrice
536365	85123A	WHITE HANGING HEART T-LIGHT HOLDER	6	2010-12-01	2010	08:26	08	2.55	17850	United Kingdom	dic	miércoles	15.30
536365	71053	WHITE METAL LANTERN	6	2010-12-01	2010	08:26	08	3.39	17850	United Kingdom	dic	miércoles	20.34
536365	84406B	CREAM CUPID HEARTS COAT HANGER	8	2010-12-01	2010	08:26	08	2.75	17850	United Kingdom	dic	miércoles	22.00
536365	84029G	KNITTED UNION FLAG HOT WATER BOTTLE	6	2010-12-01	2010	08:26	08	3.39	17850	United Kingdom	dic	miércoles	20.34
536365	84029E	RED WOOLLY HOTTIE WHITE HEART.	6	2010-12-01	2010	08:26	08	3.39	17850	United Kingdom	dic	miércoles	20.34
536365	22752	SET 7 BABUSHKA NESTING BOXES	2	2010-12-01	2010	08:26	08	7.65	17850	United Kingdom	dic	miércoles	15.30
536365	21730	GLASS STAR FROSTED T-LIGHT HOLDER	6	2010-12-01	2010	08:26	08	4.25	17850	United Kingdom	dic	miércoles	25.50
536366	22633	HAND WARMER UNION JACK	6	2010-12-01	2010	08:28	08	1.85	17850	United Kingdom	dic	miércoles	11.10
536366	22632	HAND WARMER RED POLKA DOT	6	2010-12-01	2010	08:28	08	1.85	17850	United Kingdom	dic	miércoles	11.10
536367	84879	ASSORTED COLOUR BIRD ORNAMENT	32	2010-12-01	2010	08:34	08	1.69	13047	United Kingdom	dic	miércoles	54.08

Ahora tenemos un buen marco de datos para explorar y analizar las tendencias de ventas, la rentabilidad del mercado, cancelaciones de pedidos y categorías de productos. Pero antes de pasar a la segmentación de clientes, veremos algunas de las características más importantes del conjunto de datos.

Análisis exploratorio

Iniciamos confirmando que tenemos una base de datos completa, sin datos faltantes:

df %>% 
  summarise_all(~sum(is.na(.))) %>% 
  t()

##             [,1]
## InvoiceNo      0
## StockCode      0
## Description    0
## Quantity       0
## InvoiceDate    0
## Year           0
## InvoiceTime    0
## HourOfDay      0
## UnitPrice      0
## CustomerID     0
## Country        0
## Month          0
## DayOfWeek      0
## BasketPrice    0

Ingresos por fecha

A continuación, veremos la gráfica de los ingresos por ventas a lo largo del periodo de estudio, con la intención de identificar si hay alguna tendencia creciente o decreciente:

df %>%
  group_by(InvoiceDate) %>% summarise(Revenue = sum(BasketPrice)) %>%
  ggplot(aes(x = InvoiceDate, y = Revenue)) + 
  geom_line() +
  scale_y_continuous(labels = scales::comma) +
  geom_smooth(formula = y~x, method = "loess", se = TRUE) +
  labs(x = "Fecha", y = "Ingresos", title = "Ingresos por Ventas")

Se puede apreciar que hay tendencia creciente aunque muy leve, sin embargo, esta primera vista no nos dice mucho, por lo que, haremos un zoom para ver qué más podemos encontrar.

Ingresos por día

Ahora, veamos la gráfica de los ingresos por día, para conocer el volumen acumulado de recursos monetarios:

df %>%
  group_by(DayOfWeek) %>% summarise(Ingresos = sum(BasketPrice)) %>%
  ggplot(aes(x = DayOfWeek, y = Ingresos)) + 
  geom_bar(stat = "identity", fill = 'steelblue') +
  geom_text(aes(label = scales::comma(round(Ingresos, 0))), 
            size = 4, 
            color = 'black',
            position = position_dodge(0.9), vjust = -0.5) +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Día de la semana", y = "Ingresos", title = "Ingresos de Ventas por Día de la Semana")

Se aprecia que el día de mayor ingresos es el día jueves, sin embargo, aún no sabemos el porqué, ya que podría deberse, por ejemplo, a que la facturación promedio es mayor o en ese día hay más transacciones. Para confirmar lo anterior, haremos una tabla con esos indicadores:

df %>%
  group_by(InvoiceDate, DayOfWeek) %>%
  summarise(Ingresos = sum(BasketPrice), Transacciones = n_distinct(InvoiceNo)) %>%
  mutate(PromedioOrderVal = round((Ingresos/ Transacciones), 2)) %>%
  ungroup() %>% 
  head() %>% 
  kbl(align = "c", 
      digits = 2 ,
      format.args = list(big.mark = ","),
      caption = "Resumen de  Transacciones por Día de la Semana") %>%
  kable_paper("hover", full_width = T) 

Resumen de Transacciones por Día de la Semana

InvoiceDate	DayOfWeek	Ingresos	Transacciones	PromedioOrderVal
2010-12-01	miércoles	45,867.26	127	361.16
2010-12-02	jueves	45,656.47	160	285.35
2010-12-03	viernes	22,553.38	64	352.40
2010-12-05	domingo	30,970.28	94	329.47
2010-12-06	lunes	30,258.77	111	272.60
2010-12-07	martes	53,061.64	79	671.67

Ya con la información que vemos en la tabla podemos darnos cuenta de que el jueves hay más ingresos porque es el día de mayor transacciones, sin embargo, el promedio por orden o factura es casi dos veces menor al promedio del martes.

df %>%
  group_by(InvoiceDate, DayOfWeek) %>%
  summarise(Ingresos = sum(BasketPrice), Transacciones = n_distinct(InvoiceNo)) %>%
  mutate(PromedioOrderVal = round((Ingresos/ Transacciones), 2)) %>%
  ungroup() %>%
  ggplot(aes(x = DayOfWeek, y = Ingresos)) + 
  geom_boxplot(fill='#A4A4A4', color="darkred") + 
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Día de la semana", y = "Ingresos", title = "Ingreso de Ventas por Día")

df %>%
  group_by(InvoiceDate, DayOfWeek) %>%
  summarise(Ingresos = sum(BasketPrice), Transacciones = n_distinct(InvoiceNo)) %>%
  mutate(PromedioOrderVal = round((Ingresos/ Transacciones), 2)) %>%
  ungroup() %>%
  ggplot(aes(x = DayOfWeek, y = Transacciones)) + 
  geom_boxplot(fill='#A4A4A4', color="darkred") + 
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Día de la semana", y = "Transacciones", title = "Número de Transacciones por Día")

df %>%
  group_by(InvoiceDate, DayOfWeek) %>%
  summarise(Ingresos = sum(BasketPrice), Transacciones = n_distinct(InvoiceNo)) %>%
  mutate(PromedioOrderVal = round((Ingresos/ Transacciones), 2)) %>%
  ungroup() %>%
  ggplot(aes(x = DayOfWeek, y = PromedioOrderVal)) + 
  geom_boxplot(fill='#A4A4A4', color="darkred") + 
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Día de la semana", 
       y = "Orden promedio",
       title = "Valor Promedio de Transacciones por Día")

Hasta aquí se deduce que entre los días de la semana hay diferencias sobretodo en el número de transacciones, ya que el ingreso total se ve impactado por la cantidad de ordenes facturadas.

df %>%
  group_by(InvoiceDate, DayOfWeek) %>%
  summarise(Ingresos = sum(BasketPrice), Transacciones = n_distinct(InvoiceNo)) %>%
  mutate(PromedioOrderVal = round((Ingresos/ Transacciones), 2)) %>%
  ungroup() %>% 
  ggplot(aes(Transacciones, fill = DayOfWeek)) + 
  geom_density(alpha = 0.2) + labs(title = "Distribución de Transacciones por Día")

En esta gráfica de densidad se aprecia que hay tres días que sí difieren de los demás en cuanto a la simetría de las transacciones. Con apoyo de la prueba no paramétrica de Kruskal–Wallis, veremos si existen diferencias estadísticamente significativas en los datos. Recordando que la hipótesis nula es que los rangos medios de los grupos son los mismos y la hipótesis alterna es que al menos un grupo difiere:

df %>%
  group_by(InvoiceDate, DayOfWeek) %>%
  summarise(Ingresos = sum(BasketPrice), Transacciones = n_distinct(InvoiceNo)) %>%
  mutate(PromedioOrderVal = round((Ingresos/ Transacciones), 2)) %>%
  ungroup() %>%
  kruskal.test(Transacciones ~ DayOfWeek)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  .
## Kruskal-Wallis chi-squared = 1421.6, df = 4, p-value < 2.2e-16

El p-value de la prueba es menor al 0.05 de significancia, por lo que, se rechaza la hipótesis nula y podemos afirmar que los rangos medios son estadísticamente diferentes entre las transacciones de los días.

En resumen, el día que más ingresos se obtienen son los jueves y el domingo el que menos ingresos se captan. Los días sábados al parecer no hay operaciones.

Análisis por hora del día

De manera similar al análisis por día, se puede hacer un análisis por hora para bajar aún más al detalle de la operación.

df %>%
  group_by(HourOfDay) %>% 
  summarise(Ingresos = sum(BasketPrice)) %>%
  ggplot(aes(x = HourOfDay, y = Ingresos)) +
  geom_bar(stat = "identity", fill = 'steelblue') +
  geom_text(aes(label = scales::comma(round(Ingresos, 0))), 
            size = 2, 
            color = 'black',
            position = position_dodge(0.9), vjust = -0.3) +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Hora del Día", y = "Ingreso", title = "Ingresos por Hora del Día")

df %>%
  group_by(HourOfDay) %>% 
  summarise(Transacciones = n_distinct(InvoiceNo)) %>%
  ggplot(aes(x = HourOfDay, y = Transacciones)) +
  geom_bar(stat = "identity", fill = 'steelblue') +
  geom_text(aes(label = format(Transacciones, digits = 0, big.mark = ",")), 
            size = 4, 
            color = 'black',
            position = position_dodge(0.9), vjust = -0.3) +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Hora del Día", y = "Transacciones", title = "Transacciones por Hora del Día")

Al ver ambas gráficas podemos identificar que el grueso de la operación se da al medio día, presentando baja operación durante las primeras horas de la mañana y al final del día. Este comportamiento coincide con las operaciones de clientes mayoristas, ya que los consumidores comunes tienden a comprar por las tardes cuando termina su jornada de trabajo.

Análisis del mercado

En esta parte del trabajo centraremos el análisis en el mercado, ya que los datos representan ventas a varios países.

mercado_mundial <- left_join(world, df, by = c("name_long" = "Country"))

world_df <- mercado_mundial %>%
  dplyr::select(iso_a2, name_long, InvoiceNo) %>% 
  na.omit(world_df) %>% 
  group_by(name_long) %>%
  summarise(Transacciones = n_distinct(InvoiceNo))

tmap_mode("view")
tm_shape(world_df) + 
  tm_polygons("Transacciones", breaks = c(0, 10, 100, 500, 1000, 20000))

En el mapa podemos identificar fácilmente que la mayoría de las ventas y/o pedidos se hacen desde el Reino unido (UK).

df %>%
  group_by(Country) %>%
  summarise(Ingresos = sum(BasketPrice), Transacciones = n_distinct(InvoiceNo)) %>%
  mutate(PromedioOrderVal = round((Ingresos / Transacciones), 2)) %>% 
  arrange(desc(Ingresos)) %>%
  ungroup() %>%
  head(10) %>% 
  kbl(align = "c", 
      digits = 0 ,
      format.args = list(big.mark = ","),
      caption = "Top 10: Resumen de  Transacciones por País") %>%
  kable_paper("hover", full_width = T)

Top 10: Resumen de Transacciones por País

Country	Ingresos	Transacciones	PromedioOrderVal
United Kingdom	6,747,156	19,857	340
Netherlands	284,662	101	2,818
EIRE	250,002	319	784
Germany	221,509	603	367
France	196,626	458	429
Australia	137,010	69	1,986
Switzerland	55,739	71	785
Spain	54,756	105	521
Belgium	40,911	119	344
Sweden	36,585	46	795

df %>%
  group_by(Country) %>%
  summarise(Ingresos = sum(BasketPrice), Clientes = n_distinct(CustomerID)) %>%
  mutate(PromedioGastoCliente = round((Ingresos / Clientes), 2)) %>% 
  arrange(desc(Ingresos)) %>%
  ungroup() %>% 
  head(10) %>% 
  kbl(align = "c", 
      digits = 0 ,
      format.args = list(big.mark = ","),
      caption = "Top 10: Resumen de Clientes en Diferentes Países") %>%
  kable_paper("hover", full_width = T)

Top 10: Resumen de Clientes en Diferentes Países

Country	Ingresos	Clientes	PromedioGastoCliente
United Kingdom	6,747,156	3,950	1,708
Netherlands	284,662	9	31,629
EIRE	250,002	3	83,334
Germany	221,509	95	2,332
France	196,626	87	2,260
Australia	137,010	9	15,223
Switzerland	55,739	21	2,654
Spain	54,756	31	1,766
Belgium	40,911	25	1,636
Sweden	36,585	8	4,573

Ahora, solo analicemos los cinco principales países en términos de ingresos totales sin considerar UK:

df %>%
  filter(Country == 'Netherlands' | 
           Country == 'EIRE' | 
           Country == 'Germany' | 
           Country == 'France' | 
           Country == 'Australia') %>% 
  group_by(Country) %>%
  summarise(Ingresos = sum(BasketPrice), 
            Transacciones = n_distinct(InvoiceNo), 
            Clientes = n_distinct(CustomerID)) %>%
  mutate(PromedioOrderVal = round((Ingresos / Transacciones), 2)) %>%
  arrange(desc(Ingresos)) %>%
  ungroup() %>% 
  kbl(align = "c", 
      digits = 0 ,
      format.args = list(big.mark = ","),
      caption = "Top 5: Resumen de Clientes en Diferentes Países") %>%
  kable_paper("hover", full_width = T)

Top 5: Resumen de Clientes en Diferentes Países

Country	Ingresos	Transacciones	Clientes	PromedioOrderVal
Netherlands	284,662	101	9	2,818
EIRE	250,002	319	3	784
Germany	221,509	603	95	367
France	196,626	458	87	429
Australia	137,010	69	9	1,986

En el top cinco de países (excluyendo el Reino Unido) por ingresos el que tiene menor cantidad de transacciones es Australia con 69, por el contrario, Alemania está en primer lugar en el número de transacciones pero no en ingresos.

df %>%
  filter(Country == 'Netherlands' | 
           Country == 'EIRE' | 
           Country == 'Germany' | 
           Country == 'France' | 
           Country == 'Australia') %>% 
  group_by(Country) %>%
  summarise(Ingresos = sum(BasketPrice), 
            Transacciones = n_distinct(InvoiceNo), 
            Clientes = n_distinct(CustomerID)) %>%
  mutate(PromedioOrderVal = round((Ingresos / Transacciones), 2)) %>%
  arrange(desc(Transacciones)) %>%
  ungroup() %>% 
  ggplot(aes(x = reorder(Country, -Ingresos), y = Ingresos)) +
  stat_summary(fun = sum, geom = "bar", fill = "steelblue", colour = "black") +
  geom_text(aes(label = scales::comma(round(Ingresos, 0))), 
            size = 4, 
            color = 'black',
            position = position_dodge(0.9), vjust = -0.3) +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "País", y = "Ingresos", title = "Ingresos por País")

df %>%
  filter(Country == 'Netherlands' | 
           Country == 'EIRE' | 
           Country == 'Germany' | 
           Country == 'France' | 
           Country == 'Australia') %>% 
  group_by(Country, InvoiceDate) %>%
  summarise(Ingresos = sum(BasketPrice), 
            Transacciones = n_distinct(InvoiceNo), 
            Clientes = n_distinct(CustomerID)) %>%
  mutate(PromedioOrderVal = round((Ingresos / Transacciones), 2)) %>%
  arrange(InvoiceDate) %>%
  ungroup() %>% 
  ggplot(aes(x = InvoiceDate, y = Ingresos, color = Country)) +
  scale_y_continuous(labels = scales::comma) +
  geom_smooth(formula = y~x, method = "loess", se = FALSE) +
  scale_x_date(date_breaks = "1 month", date_labels = "%Y-%b") +
  theme(axis.text.x = element_text(angle = 90, size = 9)) +
  labs(x = "Fecha", y = "Ingresos", title = "Tendencia de Ingresos", subtitle = "Ventas por País")

En la gráfica anterior, se aprecia como los ingresos por ventas a Alemania, EIRE y Francia mantuvieron una tendencia constante en el tiempo, mientras que Holanda y Australia presentan caídas al final del periodo.

df %>%
  filter(Country == 'Netherlands' | 
           Country == 'EIRE' | 
           Country == 'Germany' | 
           Country == 'France' | 
           Country == 'Australia') %>% 
  group_by(Country, InvoiceDate) %>%
  summarise(Ingresos = sum(BasketPrice), 
            Transacciones = n_distinct(InvoiceNo), 
            Clientes = n_distinct(CustomerID)) %>%
  mutate(PromedioOrderVal = round((Ingresos / Transacciones), 2)) %>%
  arrange(desc(Transacciones)) %>%
  ungroup() %>% 
  ggplot(aes(x = Country, y = PromedioOrderVal)) +
  geom_boxplot() +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "País", y = "Valor Promedio por Transacción",
       title = "Valor Promedio de la Transacción por País")

df %>%
  filter(Country == 'Netherlands' | 
           Country == 'EIRE' | 
           Country == 'Germany' | 
           Country == 'France' | 
           Country == 'Australia') %>% 
  group_by(Country, InvoiceDate) %>%
  summarise(Ingresos = sum(BasketPrice), 
            Transacciones = n_distinct(InvoiceNo), 
            Clientes = n_distinct(CustomerID)) %>%
  mutate(PromedioOrderVal = round((Ingresos / Transacciones), 2)) %>%
  arrange(desc(Transacciones)) %>%
  ungroup() %>% 
  ggplot(aes(x = Country, y = Transacciones)) +
  geom_boxplot() +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "País", y = "Transacciones",
       title = "Número de Transacciones Diarias por País")

En los últimos dos boxplots se puede deducir que, por ejemplo, los ingresos en EIRE parecen estar impulsados por cuatro clientes (que se representan como outliers), sin embargo, los ingresos al final del periodo están disminuyendo.

Algo similar sucede con Holanda, ya que los ingresos totales son los más altos al igual que el valor promedio por transacción, sin embargo, su tendencia es decreciente.

Francia y Alemania presentan una tendencia creciente en ingresos y, además, son los dos países que tienen mayor número de transacciones, por lo que, ahí hay una oportunidad de negocio.

Business Insights

df %>% 
  summarise(Numero.de.Productos = n_distinct(Description),
            Numero.de.Transacciones = n_distinct(InvoiceNo),
            Numero.de.Clientes = n_distinct(CustomerID)) %>% 
  kable(caption = "Estadísticas Generales", 
        align = "c", 
        format.args = list(big.mark = ",")) %>% 
  kable_styling()

Estadísticas Generales

Numero.de.Productos	Numero.de.Transacciones	Numero.de.Clientes
3,885	22,190	4,372

En este resumen general se puede ver que los datos contienen 4,372 clientes que han comprado 3,885 productos diferentes. El número total de transacciones realizadas es de 22,190.

A continuación, veamos solo algunos productos comprados en cada transacción:

df %>% 
  group_by(CustomerID, InvoiceNo) %>%
  summarise(NumerodeProductos = n()) %>% 
  head(10) %>% 
  kable(caption = "Cantidad de artículos comprados por transacción", 
        align = "c") %>% 
  kable_paper("hover", full_width = F)

Cantidad de artículos comprados por transacción

CustomerID	InvoiceNo	NumerodeProductos
12346	541431	1
12346	C541433	1
12347	537626	31
12347	542237	29
12347	549222	24
12347	556201	18
12347	562032	22
12347	573511	47
12347	581180	11
12348	539318	17

En el cuadro anterior, se puede apreciar que aparece una factura con el prefijo “C”, que significa Cancelación. También, hay presencia de clientes cuya frecuencia de compra es alta, como por ejemplo, el CustomerID 12347, que ha comprado 31 artículos en un solo pedido. Ahora, veamos quienes son los mejores clientes:

df %>% group_by(CustomerID, Country) %>% 
  summarise(Cliente.Ingreso.Total = sum(BasketPrice)) %>%
  arrange(desc(Cliente.Ingreso.Total)) %>% 
  head(10) %>% 
  kable(caption = "Top 10: Contribución de Ingresos por Ventas", 
        align = "c", format.args = list(big.mark = ","), digits = 0) %>% 
  kable_paper("hover", full_width = F)

Top 10: Contribución de Ingresos por Ventas

CustomerID	Country	Cliente.Ingreso.Total
14646	Netherlands	279,489
18102	United Kingdom	256,438
17450	United Kingdom	187,322
14911	EIRE	132,459
12415	Australia	123,725
14156	EIRE	113,215
17511	United Kingdom	88,125
16684	United Kingdom	65,892
13694	United Kingdom	62,691
15311	United Kingdom	59,284

Como podemos ver en la tabla anterior, el CustomerID 14646 de los Países Bajos es el que más contribuye a los ingresos por ventas, seguido por CustomerID 18102 del Reino Unido.

df %>%
  group_by(Country, CustomerID) %>%
  summarise(Ingresos.por.Cliente = sum(BasketPrice)) %>%
  ungroup() %>% 
  group_by(Country) %>% 
  mutate(Ingresos.por.Pais = round(sum(Ingresos.por.Cliente), 0),
         Contribucion.por.Cliente = round(Ingresos.por.Cliente / Ingresos.por.Pais, 4)) %>% 
  arrange(desc(Ingresos.por.Cliente)) %>%
  head(5) %>% 
  arrange(desc(Contribucion.por.Cliente)) %>% 
  kable(caption = "Top 5: Contribución de Clientes a los Ingresos por País", 
        align = "c", format.args = list(big.mark = ","), digits = 4) %>% 
  kable_paper("hover", full_width = T)

Top 5: Contribución de Clientes a los Ingresos por País

Country	CustomerID	Ingresos.por.Cliente	Ingresos.por.Pais	Contribucion.por.Cliente
Netherlands	14646	279,489.0	284,662	0.9818
Australia	12415	123,725.4	137,010	0.9030
EIRE	14911	132,458.7	250,002	0.5298
United Kingdom	18102	256,438.5	6,747,156	0.0380
United Kingdom	17450	187,322.2	6,747,156	0.0278

En esta otra tabla, podemos identificar los 5 mejores clientes por país de origen. El cliente 14646 contribuye con el 98%, aproximadamente, a los ingresos totales provenientes de Holanda y aunque los ingresos no son tan desiguales con los del cliente 18102, la diferencia en cuanto a porcentaje de contribución lo genera el ingreso total a nivel país.

Ya sabemos que hay presencia de compradores mayoristas y esto es una de las razones por las que es aún más importante segmentar cuidadosamente a los clientes para que se les pueda proporcionar la información que estarán más interesados en consumir. La segmentación permitirá, como minoristas en línea, tomar mejores decisiones de marketing y generar interacciones específicas para los clientes.

Curvas de Pareto

A continuación, se graficarán las curvas de Pareto de los ingresos y las transacciones. Recordando que la curva de pareto consiste en mostrar la regla de que, aproximadamente, el 20% de las observaciones analizadas generan el 80% de sus resultados. Esta regla no es fija y puede variar la distribución, sin embargo, es un buen indicador que permite conocer a los mejores clientes, los más rentables.

df %>% 
  group_by(CustomerID) %>% 
  summarise(Ventas.Netas = sum(BasketPrice)) %>%
  filter(Ventas.Netas > 0) %>% 
  arrange(desc(Ventas.Netas)) %>% 
  mutate(Ranking.Ventas = row_number(desc(Ventas.Netas)),
         Porcentaje.Acum.Ventas = cumsum(Ventas.Netas) / sum(Ventas.Netas)) %>% 
  ggplot(aes(x = Ranking.Ventas, y = Porcentaje.Acum.Ventas)) + 
  scale_x_continuous(labels = scales::comma) +
  geom_line() +
  geom_hline(yintercept = 0.80, colour = "red") +
  geom_vline(xintercept = 1175, colour = "red") +
  geom_point(aes(x = 1175, y = 0.80), color = "navyblue", size = 3) +
  ggplot2::annotate("text", 
           label = "80%-27%",
           x = 1000, y = 0.85,
           size = 3, 
           color = "navyblue") +
  labs(title = "Curva Pareto Ingresos")

En la curva de los ingresos se puede apreciar que con un poco mas de 1,000 clientes se logra el 80% de los ingresos, es decir, un 27% de los clientes están generando el 80% de los ingresos totales.

df %>% 
  group_by(CustomerID) %>% 
  summarise(Ventas.Netas = sum(BasketPrice),
            Transacciones = n()) %>% 
  filter(Ventas.Netas > 0) %>% 
  arrange(desc(Transacciones)) %>% 
  mutate(Ranking.Transacciones = row_number(desc(Transacciones)),
         Porcentaje.Acum.Transacciones = cumsum(Transacciones) / sum(Transacciones)) %>% 
  ggplot(aes(x = Ranking.Transacciones, y = Porcentaje.Acum.Transacciones)) + 
  scale_x_continuous(labels = scales::comma) +
  geom_line() +
  geom_hline(yintercept = 0.80, colour = "red") +
  geom_vline(xintercept = 1452, colour = "red") +
  geom_point(aes(x = 1452, y = 0.80), color = "navyblue", size = 3) +
  ggplot2::annotate("text", 
           label = "80%-33%",
           x = 1300, y = 0.85,
           size = 3, 
           color = "navyblue") +
  labs(title = "Curva Pareto Transacciones")

En la curva de las transacciones la distribución cambia un poco, ya que aquí el 33% de los clientes generan el 80% de las transacciones totales.

Las curvas anteriores sirven mucho para identificar a los mejores clientes y así poder diseñar campañas de fidelización bien focalizadas y efectivas.

Echemos un vistazo al inventario para conocer cuáles son los productos más populares y rentables:

productos.vendidos <- df %>% 
  group_by(Description) %>%
  summarise(Num.Vendido = n())

productos.vendidos$Description <- factor(productos.vendidos$Description , 
                            levels = productos.vendidos$Description [order(productos.vendidos$Num.Vendido)])


t1 <- productos.vendidos %>% 
  arrange(desc(Num.Vendido)) %>%
  top_n(10) %>%
  ggplot(aes(x = Description, y = Num.Vendido)) + 
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = format(Num.Vendido, digits = 0, big.mark = ",")), 
            size = 3, 
            color = 'black',
            position = position_dodge(0.9), hjust = 2) +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Producto", y = "Numero de Productos Vendidos", 
       title = "Top 10: Productos más Vendidos") +
  coord_flip()

productos.vendidos.por.ingresos <- df %>% 
  group_by(Description) %>%
  summarise(Ingresos = sum(BasketPrice))

productos.vendidos.por.ingresos$Description <- factor(productos.vendidos.por.ingresos$Description , 
                            levels = productos.vendidos.por.ingresos$Description
                            [order(productos.vendidos.por.ingresos$Ingresos)])

t2 <- productos.vendidos.por.ingresos %>%
  arrange(desc(Ingresos)) %>%
  top_n(10) %>%
  ggplot(aes(x = Description, y = Ingresos)) + 
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = scales::comma(Ingresos)), 
            size = 3, 
            color = 'black',
            position = position_dodge(0.9), hjust = 2) +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Producto", y = "Ingresos por Ventas", 
       title = "Top 10: Ingresos por Productos") +
  coord_flip()

grid.arrange(t1, t2, nrow = 2, ncol = 1)

Insights en la descripción de los productos

En el conjunto de datos los productos se identifican de forma única a través de la variable StockCode y en la variable Description, viene una breve descripción. En esta parte del trabajo, se agruparán los productos según su descripción. Esta información será de gran utilidad a la hora de agrupar a los clientes y proporcionará información crucial para, por ejemplo, el área de marketing.

Se creará un corpus de las descripciones del producto y aplicando técnicas de preprocesamiento se descartarán palabras que aparezcan menos de 20 veces, además, se eliminarán palabras poco descriptivas o útiles.

descripcion <- unique(df$Description)
corpus <- tm::Corpus(tm::VectorSource(descripcion)) 

# Limpieza

corpus.limpio <- tm::tm_map(corpus, function(x) iconv(x, to = 'UTF-8', sub = 'byte'))  

# Convirtiendo palabras a minusculas
corpus.limpio <- tm::tm_map(corpus.limpio, tolower)

# Removiendo stop-words
corpus.limpio <- tm::tm_map(corpus.limpio, tm::removeWords, tm::stopwords('english'))

# Eliminando terminos especificos (colores)
corpus.limpio <- tm::tm_map(corpus.limpio, tm::removeWords, 
                             c("pink", "red", "blue", "tag", "white", "black", "green", "set"))

# Quitando espacios en blanco
corpus.limpio <- tm::tm_map(corpus.limpio, tm::stripWhitespace)

dtm <- tm::DocumentTermMatrix(corpus.limpio, 
                             control = list(bounds = list(global = c(20, Inf)))) 

mat <- as.matrix(t(dtm))
freq_words <- sort(rowSums(mat), decreasing = TRUE)

Echemos un vistazo a algunas palabras clave que aparecen varias veces en las descripciones de los productos:

df.keywords = as.data.frame(freq_words)
df.keywords["words"] <- rownames(df.keywords)
rownames(df.keywords) <- NULL


df.keywords$words <- factor(df.keywords$words, 
                            levels = df.keywords$words[order(df.keywords$freq_words)])


df.keywords %>% 
  arrange(desc(freq_words)) %>%
  top_n(25) %>% 
  ggplot(aes(x = words, y = freq_words)) + 
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = format(freq_words, digits = 0, big.mark = ",")), 
            size = 3, 
            color = 'black',
            position = position_dodge(0.9), hjust = -0.1) +
  labs(x = "Palabras Clave", 
       y = "Frecuencia ",
       title = "Palabras Clave en la Descripción de los Productos") +
  coord_flip()

set.seed(123) # Reproducibilidad
wordcloud(df.keywords$words, df.keywords$freq_word,
          colors = brewer.pal(8, "Dark2"),
          min.freq = 2, random.order = FALSE, rot.per = 0.20,
          scale = c(5.0, 0.25))

En la nube de palabras se aprecia más claramente una gama de diferentes productos que se han vendido en el periodo de análisis como, por ejemplo:

• regalos (palabras clave: christmas, decoration, flower, cake).
• artículos para el hogar (palabras clave: holder, mug, glass, bowl).
• productos de joyería (palabras clave: necklace, bracelet, silver, earrings).

Categorías de productos

La información que tenemos está incompleta en el sentido de que no tenemos las categorías de los productos vendidos, pues solo contamos con su descripción, por lo tanto, para obtener información más útil y procesable, será necesario conseguir dichas categorías. Esto nos ayudará a comprender mejor lo que les gusta comprar a los clientes y nos ayudará a idear mejores y más focalizadas estrategias de promoción y marketing.

Las categorías pueden proporcionarnos información muy relevante sobre qué tipo de productos suele comprar un cliente, por lo que, obtendremos los datos de una de las tiendas retail más populares a nivel mundial: walmart.

Los datos se obtuvieron de la guía de categorización de walmart. La información se pasó a un archivo en formato csv y con apoyo del complemento de Excel fuzzyLookup, se buscaron las coincidencias (con una tolerancia del 10%) entre la descripción de los productos de la base que estamos trabajando y la descripción del catálogo de walmart. Lo que no se pudo relacionar se etiquetó en la categoría de Others.

# se carga el archivo
categories <- read_csv("categories.csv")

# se limpian los datos
categories$Category <- str_replace_all(categories$Category, "\n", " ")
categories$Category <- gsub("\uFFFD", "", categories$Category, fixed = TRUE)

# se muestran algunos registros
categories %>%
  head() %>% 
  kable(caption = "Descripción de Productos y Categorías de Walmart") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), font_size = 15)

Descripción de Productos y Categorías de Walmart

descripcion	Category
WOODLAND STICKERS	Musical Instrument
BUTTERFLY HAIR BAND	Health & Beauty
SPOTTY BUNTING	Sport & Recreation
BUNTING , SPOTTY	Sport & Recreation
HOME SMALL WOOD LETTERS	Home
FLAMES SUNGLASSES PINK LENSES	Health & Beauty continued

Veamos el top 10 de las categorías para conocer las preferencias de los clientes:

t3 <- categories %>% 
  group_by(Category) %>%
  summarise(Cantidad = n()) %>%
  arrange(desc(Cantidad))

t3$Category <- factor(t3$Category, 
                                  levels = t3$Category
                                  [order(t3$Cantidad)])


t3 %>% 
  top_n(10) %>% 
  ggplot(aes(x = Category, y = Cantidad)) +
  geom_segment(aes(x = Category, xend = Category, y = 0, yend = Cantidad),
               color = "darkblue", lwd = 2) +
  geom_point(size = 8.5, pch = 21, bg = "steelblue", col = "red") +
  geom_text(aes(label = Cantidad), color = "white", size = 3) +
  labs(title = "Top 10: Categoría de Productos", 
       y = "Conteo de Artículos Vendidos",
       x = "Categoría de Producto") +
  coord_flip()

La gráfica anterior muestra que los productos más vendidos pertenecen a la categoría de Ocasion y Temporada, seguido por artículos de Hogar.

Con las categorías de productos ahora disponibles, tenemos un conjunto de datos que podemos utilizar para extraer el comportamiento de gasto de los clientes, sus productos de interés y cierta información básica sobre su actividad.

Segmentación de clientes

Utilicemos el comportamiento de gasto del cliente, sus productos de interés y cierta información básica sobre su actividad para realizar la segmentación, pero antes es buena práctica identificar si los datos son aptos para agrupamiento, es decir, si las características o variables que tenemos son útiles para formar grupos bien definidos.

Prediagnóstico

En primer lugar, se analizará la tendencia de agrupamiento de los datos utilizando estadísticas de Hopkins. El estadístico Hopkins nos ayuda a evaluar la tendencia de clustering de un conjunto de datos al calcular la probabilidad de que dichos datos procedan de una distribución uniforme, es decir, si los datos se distribuyen uniformemente no tiene sentido hacer un modelo de agrupamiento.

Pero primero debemos construir las variables para el análisis:

• Valor medio de la cesta
• Rango de valor de la cesta (mínimo, máximo)
• Frecuencia de pedido
• Tendencia a cancelar un pedido
• Actividad del usuario (primera y última compra)
• Productos de interes

Agrupemos a cada cliente para, posteriormente, determinar el número de transacciones que realizó, su compra mínima y máxima, el monto promedio gastado en todas sus transacciones, monto total gastado, días desde la primera compra, días desde la última compra y, finalmente, cuánto gasta cada cliente en cada categoría.

ultima.fecha <- max(df$InvoiceDate)

df2 <- df %>% filter(BasketPrice > 0)

cliente.order.resum <- df2 %>% 
  group_by(CustomerID) %>% 
  summarise(n.cestas = n_distinct(InvoiceNo),
            min.cesta = min(BasketPrice),
            avg.cesta = mean(BasketPrice),
            max.cesta = max(BasketPrice),
            total.cesta = sum(BasketPrice),
            primera.compra = min(InvoiceDate),
            ultima.compra = max(InvoiceDate)) %>%
  mutate(primera.compra = as.integer(ultima.fecha - primera.compra),
         ultima.compra = as.integer(ultima.fecha - ultima.compra))

temp.df <- df2 %>%
  left_join(categories, by = c("Description" = "descripcion"))

cliente.producto.cat <- temp.df %>% 
  spread(Category, BasketPrice, fill = 0, convert = TRUE) %>%
  dplyr::select(-InvoiceNo, -StockCode, -Description, -Quantity, -InvoiceDate,
                -Month, -Year, -InvoiceTime, -HourOfDay, -UnitPrice, -Country,
                -DayOfWeek) %>%
  group_by(CustomerID) %>% 
  summarise_all(.funs = sum)

cliente.order.resum <- cliente.order.resum %>% 
  left_join(cliente.producto.cat, by = c("CustomerID" = "CustomerID"))

cliente.order.resum$CustomerID <- as.integer(cliente.order.resum$CustomerID)

kable(cliente.order.resum[1:5, c(1:8, 16:17,21, 34)], 
      format = 'html',
      table.attr = "style='width:50%;'",
      size = 5,
      align = "c",
      format.args = list(big.mark = ","),
      digits = 0,
      caption = "Resumen del Historial de Compras del Cliente") %>%
  kable_styling(font_size = 13, bootstrap_options = c("striped", "hover"))

Resumen del Historial de Compras del Cliente

CustomerID	n.cestas	min.cesta	avg.cesta	max.cesta	total.cesta	primera.compra	ultima.compra	Footwear	Furniture	Home	Watches
12,346	1	77,184	77,184	77,184	77,184	325	325	0	0	0	0
12,347	7	5	24	250	4,310	367	2	0	227	625	0
12,348	4	13	58	240	1,797	358	75	42	0	457	0
12,349	1	7	24	300	1,758	18	18	0	92	63	0
12,350	1	8	20	40	334	310	310	0	0	90	25

En el cuadro anterior solo se muestran 12 variables de las 34 que contiene esta nueva base creada la cual contiene 26 categorías de productos y 8 variables calculadas. Ahora, veamos si con esta información es conveniente hacer un modelo de segmentación. Pero antes es necesario hacer un análisis de correlación para identificar si tenemos variables redundantes, ya que si las hay debemos quitarlas:

correlacion <- round(cor(cliente.order.resum[,2:8]), 2)
correlacion

##                n.cestas min.cesta avg.cesta max.cesta total.cesta
## n.cestas           1.00     -0.01     -0.01      0.03        0.55
## min.cesta         -0.01      1.00      0.80      0.41        0.13
## avg.cesta         -0.01      0.80      1.00      0.87        0.29
## max.cesta          0.03      0.41      0.87      1.00        0.38
## total.cesta        0.55      0.13      0.29      0.38        1.00
## primera.compra     0.31      0.01      0.01      0.02        0.15
## ultima.compra     -0.26      0.04      0.02      0.00       -0.12
##                primera.compra ultima.compra
## n.cestas                 0.31         -0.26
## min.cesta                0.01          0.04
## avg.cesta                0.01          0.02
## max.cesta                0.02          0.00
## total.cesta              0.15         -0.12
## primera.compra           1.00          0.27
## ultima.compra            0.27          1.00

corrplot::corrplot(correlacion, method = "number", type = "upper")

En la gráfica podemos identificar que hay variables con alta correlación, como por ejemplo, la variable avg.cesta que está altamente correlacionada con las variables min.cesta y max.cesta, pues superan el 0.8. Por lo anterior, será conveniente quitar el promedio de cesta. También, las variables n.cestas y total.cesta tiene una correlación de 0.55 y, como una representa el total de facturas en cantidad y la otra en dinero, optaremos por eliminar la cantidad.

cliente.order.resum.fin <- cliente.order.resum %>% 
  dplyr::select(-c(avg.cesta, n.cestas))

Volvemos hacer el análisis de correlación:

correlacion <- round(cor(cliente.order.resum.fin[,2:6]),2)
correlacion

##                min.cesta max.cesta total.cesta primera.compra ultima.compra
## min.cesta           1.00      0.41        0.13           0.01          0.04
## max.cesta           0.41      1.00        0.38           0.02          0.00
## total.cesta         0.13      0.38        1.00           0.15         -0.12
## primera.compra      0.01      0.02        0.15           1.00          0.27
## ultima.compra       0.04      0.00       -0.12           0.27          1.00

corrplot::corrplot(correlacion, method = "number", type = "upper")

Ya los datos no presentan correlaciones altas, por lo que, podemos pasar a evaluar si es conveniente hacer la segmentación.

set.seed(123)
clustertend::hopkins(data = scale(cliente.order.resum.fin[, 2:32]), n = 50)

## $H
## [1] 0.01397866

El estadístico de Hopkins para los datos es igual a 0.01397866, lo que permite rechazar la hipótesis nula de que los datos se distribuyen uniformemente. Por tanto, podemos concluir que los datos están muy agrupados o que su estructura contiene algún tipo de agrupación.

Algoritmo K-means

Para realizar la segmentación de los clientes utilizaremos el algoritmo k-means, ya que es un modelo fácil de implementar, sin emgargo, tiene la desventaja de que se requiere conocer previamente el número de grupos a crear, pero para resolver este inconveniente nos apoyaremos de algunas técnicas que ayudan a determinar la cantidad de grupos a crear.

Antes de iniciar hay que tener presente que las variables que se tienen están en diferentes unidades de medición, por ejemplo, las unidades de las fechas son completamente diferentes a las unidades en libras para las cantidades monetarias. De ahí que necesitamos escalar (homologar) los datos, para representar la verdadera distancia entre variables. Los datos se han escalado utilizando la función scale ().

scale.cliente.order.resum <- as.data.frame(scale(cliente.order.resum.fin[,2:32]))
scale.cliente.order.resum$CustomerID <- cliente.order.resum.fin$CustomerID
scale.cliente.order.resum <- scale.cliente.order.resum %>% 
  dplyr::select(CustomerID, everything())

A continuación, se utilizarán dos métodos para tratar de identificar el número óptimo de clústers: wss y silhouette.

fviz_nbclust(scale.cliente.order.resum[,2:32],
             kmeans, 
             method = "wss") # tecnica del codo

fviz_nbclust(scale.cliente.order.resum[,2:32], 
             kmeans, 
             method = "silhouette") # tecnica de la silueta

El método del codo parece indicarnos que deberán ser 2 o 3 grupos y la técnica de la silueta selecciona 2. Vamos a generar 3 grupos para ver cómo se agrupan los datos, ya que tenemos bastantes observaciones.

set.seed(123)

modelo <- kmeans(scale.cliente.order.resum[,2:32], 3, nstart = 25)

scale.cliente.order.resum$Cluster <- modelo$cluster

Como la base de datos ya con el número de clúster es de 32 variables, es complicado comparar los grupos asignados en todas las variables (las visualizaciones legibles están restringidas a un máximo de 3 dimensiones). Por lo anterior, utilizaremos el Análisis de Componentes Principales (PCA), ya que esta técnica crea combinaciones lineales de las variables originales y éstas nuevas variables llamadas componentes PCA, capturan la mayor parte de la variación de los datos. Al trazar la distribución de los conglomerados en los primeros componentes de la PCA debería permitirnos ver si los conglomerados están separados o no.

pca <- PCA(scale.cliente.order.resum[,2:33],  graph = FALSE)

fviz_screeplot(pca, addlabels = TRUE, ylim = c(0, 50))

Para este caso, tracemos la forma en que se distribuyeron los grupos comparando el 1 y el 2, así como el 1 y el 3 componentes de PCA.

pca1 <- fviz_cluster(modelo, data = scale.cliente.order.resum[,2:33],
             axes = c(1,2),
             geom = "point",
             palette = c("#00AFBB", "#E7B800", "#FC4E07"),
             ggtheme = theme_minimal(),
             main = "Agrupación de Clústers Dim1 vs. Dim2")

Resumen por Clúster.

pca2 <- fviz_cluster(modelo, data = scale.cliente.order.resum[,2:33],
             axes = c(1,3),
             geom = "point",
             palette = c("#00AFBB", "#E7B800", "#FC4E07"),
             ggtheme = theme_minimal(),
             main = "Agrupación de Clústers Dim1 vs. Dim3")

Resumen por Clúster.

De los gráficos anteriores podemos concluir que el número de grupos elegido (tres) están bien separados y no hay superposición alguna.

Ya habiendo formado los grupos de clientes, lo que sigue es caracterizarlos, en otras palabras, debemos hacer resúmenes descriptivos con las variables que tenemos.

Análisis RFM: (Recency, Frequency, Monetary)

El RFM es una herramienta de análisis de marketing que se utiliza para identificar a los mejores clientes de una empresa o de una organización mediante el uso de determinadas medidas. El modelo RFM se basa en tres factores cuantitativos:

• Recency: qué tan recientemente un cliente ha realizado una compra.
• Frequency: la frecuencia con la que un cliente realiza una compra.
• Monetary: cuánto dinero gasta un cliente en compras.

Recency

Recency se calculó con la fecha de la última compra del cliente menos la fecha de la última transacción, en días.

Veamos algunas gráficas de cada variable, pero sin considerar los grupos creados para conocer las distribuciones de las mismas y, posteriormente, mostrar resumenes por clúster.

Actualidad <- df %>% 
  group_by(CustomerID) %>%
  summarise(Ultima.Actividad.Cliente = max(InvoiceDate)) %>%
  mutate(Ultima.Factura = max(Ultima.Actividad.Cliente))

Actualidad$Recency <- round(as.numeric(difftime(Actualidad$Ultima.Factura, Actualidad$Ultima.Actividad.Cliente , units = c("days"))))

Actualidad <- Actualidad %>%
  dplyr::select(CustomerID, Recency)

summary(Actualidad$Recency)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00   16.00   50.00   91.58  143.00  373.00

El resumen anterior nos indica lo siguiente:

• El 50% de los clientes tienen menos de 50 días de inactividad.
• El promedio sin realizar alguna compra es de 3 meses.
• Existen clientes que no han realizado una sola campra en más de un año.

Actualidad %>% 
  ggplot(aes(Recency)) +
  geom_histogram() +
  geom_vline(xintercept = 100, colour = "red") +
  labs(title = "Distribución de Inactividad", y = "Número de Clientes")

En la gráfica anterior, se aprecia que la mayoría de los clientes han estado inactivos en los últimos 100 días. Recordar que la antigüedad o inactividad es la diferencia entre la fecha de la última compra del cliente y la fecha de la última transacción, en días.

Frequency

La frecuencia se calculó contando la cantidad de veces que un cliente ha realizado una transacción.

Frecuencia <- df %>% 
  group_by(CustomerID) %>%
  summarise(Frecuencia = n())

summary(Frecuencia$Frecuencia)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00   17.00   41.00   91.86   99.25 7812.00

Algunas de las conclusiones que se pueden sacar al ver el resumen anterior son:

• El promedio de compras por año es de 90, aproximadamente.
• Prácticamente, el 75% de clientes (3er. cuartil) tiene menos de 100 compras en el año.
• Hay una gran diferencia en la cantidad de transacciones que realizó el último cliente o clientes y el 75% restante.

Lo anterior, indica que hay datos atípicos y para investigarlo más a fondo hagamos dos análisis: uno hasta el 75% de los clientes y el segundo para el resto, ya que es en éste rango donde están las frecuencias de compra más elevadas.

Frecuencia %>% 
  as.data.frame() %>%  
  arrange(desc(Frecuencia)) %>% 
  head(25) %>% 
  kable(align = "c", 
        caption = "Top 25: Frecuencia de Compras",
        format.args = list(big.mark = ","), 
        digits = 0) %>%
  kable_paper("hover", full_width = F)

Top 25: Frecuencia de Compras

CustomerID	Frecuencia
17841	7,812
14911	5,898
14096	5,128
12748	4,459
14606	2,759
15311	2,478
14646	2,085
13089	1,853
13263	1,667
14298	1,640
15039	1,483
14156	1,415
18118	1,268
14159	1,183
14796	1,156
15005	1,152
16033	1,143
14056	1,110
17511	1,076
14769	1,066
13081	1,061
14527	1,010
14456	954
15719	932
16549	925

En la tabla anterior, se observan las 25 frecuencias más altas y podemos identificar que fue 1 cliente el que realizó 7,812 transacciones, por lo que, muy probablemente sea un mayorista. veamos los boxplots:

Frecuencia_3Q <- Frecuencia %>%
  filter(Frecuencia <= 99)

Atipicos <- Frecuencia %>%
  filter(Frecuencia >= 100)

Frecuencia_3Q %>% 
  ggplot(aes(x = factor(1), y = Frecuencia)) +
  geom_boxplot() +
  labs(title = "Frecuencia de Compras Cuartil 3", 
       y = "Número de Compras por Cliente",
       x = "CustomerID")

Atipicos %>% 
  ggplot(aes(x = factor(1), y = Frecuencia)) +
  scale_y_continuous(labels= scales::comma) +
  geom_boxplot(outlier.color = "red", alpha = 0.1, outlier.size = 4) +
  labs(title = "Frecuencia Compras Atípicas", 
       y = "Número de Compras por Cliente",
       x = "CustomerID")

Con estos boxplots podemos confirmar que hay clientes que compran poco pero lo hacen frecuentemente y, también, que hay clientes que compran en grandes cantidades pero lo hacen en pocas ocasiones.

Monetary

Esto se refiere a la suma total de ingresos generados por el cliente en el transcurso de un año.

# Monetary Value: group CustomerID y IngresoTotal
Monetary <- df %>% 
  group_by(CustomerID) %>% 
  summarise(Monetary = sum(BasketPrice))

summary(Monetary$Monetary)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -4287.6    291.8    644.1   1893.5   1608.3 279489.0

En el resumen estadístico anterior, se observa que hay ingresos negativos, lo que sugiere que pueden ser las cancelaciones. Además, también se observa que hay datos atípicos muy grandes, por lo que, haremos lo mismo que para la Frecuencia de compra.

Monetary %>% 
  as.data.frame() %>%  
  arrange(desc(Monetary)) %>% 
  head(25) %>% 
  kable(align = "c", 
        caption = "Top 25: Ingreso Total por Cliente",
        format.args = list(big.mark = ","), 
        digits = 0) %>%
  kable_paper("hover", full_width = F)

Top 25: Ingreso Total por Cliente

CustomerID	Monetary
14646	279,489
18102	256,438
17450	187,322
14911	132,459
12415	123,725
14156	113,215
17511	88,125
16684	65,892
13694	62,691
15311	59,284
13089	57,322
14096	57,121
15061	54,229
16029	53,169
17949	52,751
15769	51,824
14298	50,862
14088	50,415
17841	39,869
13798	36,353
16422	33,806
12931	33,463
16013	33,366
15838	33,351
17389	31,300

Monetary_3Q <- Monetary %>%
  filter(Monetary <= 1600)

Monetary_Outliers <- Monetary %>%
  filter(Monetary > 1600)

Vemos en el cuadro anterior que hay una gran desigualdad en cuanto a los ingresos que dejan algunos clientes, ya que considerando el top 25, el ingreso menor es de 31,300 y el ingreso máximo es de 279,489.

Monetary_3Q %>%
  filter(Monetary > 0) %>% 
  ggplot(aes(Monetary)) +
  geom_histogram() +
  scale_x_continuous(labels = scales::comma) +
  scale_y_continuous(labels = scales::comma) +
  labs(title = "Ingreso Clientes Cuartil 3", 
       y = "Número de Clientes",
       x = "Ingreso")

Monetary_Outliers %>%
  filter(Monetary < 250000) %>% 
  ggplot(aes(Monetary)) +
  geom_histogram() +
  scale_x_continuous(labels = scales::comma) +
  scale_y_continuous(labels = scales::comma) +
  labs(title = "Ingreso Atípico", 
       y = "Número de Clientes",
       x = "Ingreso")

En los gráficos anteriores se quitaron los ingresos negativos y los dos ingresos más altos para eliminar la distorsión en las visualizaciones. Al igual que con las frecuencias de compra los ingresos también presentan grandes desigualdades. Esta información es de utilidad para caracterizar a los clústers.

A continuación, se muestra una tabla resumen que explica las diferencias en los tres grupos.

cliente.order.resum$Cluster <- as.factor(scale.cliente.order.resum$Cluster)

cliente.order.resum %>% 
  group_by(Cluster) %>%
  summarise('Número.de.Clientes' = n(),
            'Promedio.Ultima.Compra' = round(mean(ultima.compra)),
            'Frecuencia.Promedio.Compra' = round(mean(n.cestas)),
            'Gasto.Promedio' = round(mean(total.cesta)),
            'Ingreso.Total.Cluster' = sum(total.cesta)) %>% 
  kable(align = "c", 
        caption = "Resumen por Tipo de Clúster",
        format.args = list(big.mark = ","), 
        digits = 0) %>%
  kable_paper("hover", full_width = T)

Resumen por Clúster.

En general, es necesario analizar distribuciones para cada variable agrupada por el clúster asignado. Vamos a utilizar diagramas de caja (boxplots) para analizar las distribuciones de las variables relevantes. A continuación, presentamos diagramas de caja para analizar la distribución de días desde la última compra, distribución de las transacciones o periodicidad de las compras y la distribución del dinero gastado en cada uno de los tres grupos.

r <- cliente.order.resum %>%
  ggplot(aes(x = Cluster, y = ultima.compra, fill = Cluster)) +
  geom_boxplot(fill = c("#FFB400", "#C20008", "#13AFEF")) +
  labs(x = "Cluster", y = "Número de días",
       title = "Recency: Distribución de Días Desde la Última Factura") +
  scale_fill_brewer(palette = "RdBu") +
  theme_minimal()

f <- cliente.order.resum %>%
  ggplot(aes(x = Cluster, y = n.cestas, fill = Cluster)) +
  geom_boxplot(fill = c("#FFB400", "#C20008", "#13AFEF")) +
  labs(x = "Cluster", y = "Número de Transacciones",
       title = "Frequency: Distribución de Transacciones") +
  scale_fill_brewer(palette = "RdBu") +
  theme_minimal()

m <- cliente.order.resum %>%
  ggplot(aes(x = Cluster, y = total.cesta, fill = Cluster)) +
  geom_boxplot(fill = c("#FFB400", "#C20008", "#13AFEF")) +
  scale_y_continuous(labels = scales::comma) +
  labs(x = "Cluster", y = "Dinero Gastado",
       title = "Monetary: Distribución del Valor por Factura") +
  scale_fill_brewer(palette = "RdBu") +
  theme_minimal()

RFM por Clúster.

A partir del análisis visual y de la tabla resumen anterior, se pueden detectar algunas características simples sobre los clientes en cada grupo.

cliente.order.resum %>% 
  ggplot(aes(Cluster, fill = Cluster)) +
  scale_y_continuous(labels = scales::comma) +
  geom_bar() +
  geom_text(stat = 'count', 
            aes(label = format(stat(count), digits = 0, big.mark = ",")), 
            vjust = -0.3, 
            size = 4
            ) +
  labs(title = "Número de Clientes por Clúster")

Clientes por Clúster.

Grupo 1 formado por 33 clientes:

• Gastan por cada factura en promedio 46,577.
• Hacen pedidos al mayoreo.
• Se tardan, en promedio, 22 días para volver a comprar.
• Son clientes habituales mayoristas.

Grupo 2 formado por 7 clientes:

• Tienden a gastar una gran cantidad de dinero en cada factura, 171,563, en promedio.
• Hacen, en promedio, el mayor número de pedidos (mayoreo).
• Son los clientes de alto valor.

Grupo 3 formado por 4,298 clientes:

• Tienden a gastar una cantidad de moderada a baja por factura, 1,431, en promedio.
• El número de transacciones es extremadamente bajo, 4 pedidos en promedio.
• Estos clientes son menos activos, ya que tardan, en promedio, 3 meses antes de realizar su última compra.
• Podemos clasificar al grupo como típicos cazadores de gangas (No Mayoristas).

Productos de interés dentro de cada Cluster

A continuación, analicemos la tendencia de cada uno de los tres grupos, para comparar un producto en una categoría específica.

product.cluster <- cliente.order.resum %>%
  dplyr::select(-CustomerID, -n.cestas, -min.cesta, -avg.cesta, 
                -max.cesta, -total.cesta, -primera.compra, -ultima.compra)

product.cluster <- product.cluster %>%
  gather(key = "Categoria", value = "BasketValue", -Cluster)

#g4
g4 <- product.cluster %>% 
  filter(Categoria %in% c("Occasion & Seasonal", "Home", 
                                "Vehicle", "Tools & Hardware",
                                "Cleaning, Safety & Other", "Musical Instrument", "Office",
                                "Art & Craft", "Baby" , "Electronics")) %>%
  dplyr::group_by(Cluster, Categoria) %>% 
  summarise(BasketValue = sum(BasketValue)) %>% 
  ggplot(aes(x = Categoria, BasketValue)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = scales::comma(round(BasketValue, 0))), 
            size = 3, 
            color = 'black',
            position = position_dodge(0.9), vjust = -0.5) +
   scale_y_continuous(labels = scales::comma) +
  labs(x = "Categoria", y = "Ingresos por Ventas",
       title = "Top 10: Ingresos por Categoría y Clúster") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  facet_wrap(~Cluster)

Ingresos por Categoría.

En los gráficos anteriores se muestran los ingresos por categoría de producto de acuerdo con su correspondiente grupo. Podemos resumir la tendencia a comprar en una categoría específica.

Grupo 1:

• Gastan más en Tools & Hardware seguido de Cleaning, Safety & Other. Por el contrario, gastan menos en Art & Craft y en artículos Baby.

Grupo 2:

• Estos clientes gastan más en Cleaning, Safety & Other y en Occasion & Seasonal. Las categorías en donde gastan menos son Art & Craft y Office.

Grupo 3:

• El grupo más numeroso gasta más en Occasion & Seasonal y Cleaning, Safety & Other. Al igual que en los otros dos grupos, la categoría donde menos gastan es en Art & Craft seguida por Electronics.

sk <- product.cluster %>% 
  dplyr::group_by(Cluster, Categoria) %>% 
  summarise(venta.Total = sum(BasketValue))

sk$Cluster <- as.character(sk$Cluster)

# En la gráfica se mueven los grupos a la hora de generar el archivo html: el grupo 1 es el 3, el grupo 2 es el 1  y el grupo 3 es el 2.
sankey_ly(x = sk, 
          cat_cols = c("Cluster", "Categoria"), 
          num_col = "venta.Total", 
          title = "Distribución de Ingresos por Clúster Según Productos Comprados") 

Resumen Estadístico por Clúster

Veamos algunas estadísticas por grupo:

resumen <- psych::describeBy(cliente.order.resum[,2:34], cliente.order.resum[,'Cluster'])

kable(resumen[[1]], 
      format = "html",
      digits = 2, 
      size = 5,
      caption = "Resumen Clúster 3",
      format.args = list(big.mark = ","),
      table.attr = "style='width:50%;'") %>%
  kable_styling(bootstrap_options = c("striped", "hover"))

Resumen Clúster 3

	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
n.cestas	1	4,298	3.87	4.91	2.00	2.84	1.48	1.00	93.00	92.00	5.23	55.60	0.07
min.cesta	2	4,298	13.48	91.96	5.04	5.39	6.21	0.00	3,861.00	3,861.00	29.43	1,066.16	1.40
avg.cesta	3	4,298	35.29	229.56	17.70	18.92	9.21	2.14	13,305.50	13,303.36	47.13	2,624.14	3.50
max.cesta	4	4,298	116.03	633.60	51.92	69.76	39.17	3.75	38,970.00	38,966.25	54.10	3,289.44	9.66
total.cesta	5	4,298	1,430.72	2,258.39	658.27	946.56	675.48	3.75	39,916.50	39,912.75	4.74	38.02	34.45
primera.compra	6	4,298	221.65	117.66	247.00	227.64	146.78	0.00	373.00	373.00	-0.36	-1.24	1.79
ultima.compra	7	4,298	92.73	100.06	51.00	76.08	60.79	0.00	373.00	373.00	1.24	0.41	1.53
Art & Craft	8	4,298	30.86	66.90	7.72	15.86	11.45	0.00	1,268.38	1,268.38	5.78	57.81	1.02
Baby	9	4,298	83.88	631.85	20.40	39.33	30.25	0.00	39,916.50	39,916.50	58.46	3,672.50	9.64
Carriers & Accessories	10	4,298	29.78	110.48	0.00	11.56	0.00	0.00	3,408.96	3,408.96	15.89	383.10	1.69
Cleaning, Safety & Other	11	4,298	143.13	287.92	51.68	82.93	76.62	0.00	4,962.90	4,962.90	6.29	63.63	4.39
Clothing	12	4,298	11.03	35.37	0.00	4.52	0.00	0.00	994.32	994.32	12.48	245.78	0.54
Electronics	13	4,298	59.34	126.89	17.89	31.94	26.52	0.00	2,875.00	2,875.00	6.62	83.16	1.94
Food & Beverage	14	4,298	2.23	10.21	0.00	0.06	0.00	0.00	170.05	170.05	8.87	105.07	0.16
Footwear	15	4,298	9.08	48.27	0.00	1.21	0.00	0.00	2,115.36	2,115.36	23.27	884.63	0.74
Furniture	16	4,298	47.92	118.09	13.70	23.32	20.31	0.00	2,737.80	2,737.80	7.79	103.47	1.80
Garden&Patio	17	4,298	21.84	73.58	0.00	7.71	0.00	0.00	1,742.88	1,742.88	10.35	157.03	1.12
Health & Beauty	18	4,298	22.92	84.09	0.00	9.96	0.00	0.00	3,861.00	3,861.00	26.02	1,063.42	1.28
Health & Beauty continued	19	4,298	38.75	108.66	5.10	17.44	7.56	0.00	2,540.40	2,540.40	9.57	144.09	1.66
Home	20	4,298	115.41	353.69	39.00	60.76	57.82	0.00	16,235.44	16,235.44	25.03	1,030.40	5.39
Jewelry	21	4,298	41.79	114.31	9.95	19.41	14.75	0.00	3,672.00	3,672.00	11.85	273.42	1.74
Media	22	4,298	44.05	129.94	10.50	20.05	15.57	0.00	3,119.50	3,119.50	11.26	194.75	1.98
Musical Instrument	23	4,298	88.90	220.94	20.11	40.96	29.82	0.00	3,993.25	3,993.25	6.70	67.87	3.37
Occasion & Seasonal	24	4,298	146.11	273.52	53.70	86.57	77.27	0.00	3,509.70	3,509.70	4.84	33.78	4.17
Office	25	4,298	69.81	168.84	19.50	34.87	28.91	0.00	3,177.40	3,177.40	7.82	98.39	2.58
Others	26	4,298	63.82	302.47	9.48	21.59	14.06	0.00	12,385.70	12,385.70	23.57	801.75	4.61
Pets	27	4,298	37.54	105.41	8.38	18.11	12.42	0.00	3,794.40	3,794.40	15.29	431.35	1.61
Photography	28	4,298	34.17	153.12	0.00	13.19	0.00	0.00	6,374.40	6,374.40	25.46	897.03	2.34
Sport & Recreation	29	4,298	36.61	147.34	0.00	12.11	0.00	0.00	5,885.52	5,885.52	19.83	645.16	2.25
Tools & Hardware	30	4,298	100.00	231.72	34.29	54.39	50.84	0.00	5,195.00	5,195.00	8.90	134.23	3.53
Toy	31	4,298	29.17	86.12	0.00	12.90	0.00	0.00	3,250.00	3,250.00	15.80	484.27	1.31
Vehicle	32	4,298	118.16	229.03	46.00	71.21	68.20	0.00	4,521.10	4,521.10	6.42	71.66	3.49
Watches	33	4,298	4.43	22.10	0.00	0.17	0.00	0.00	489.60	489.60	10.32	145.80	0.34

kable(resumen[[2]], 
      format = "html",
      digits = 2,
      size = 5,
      caption = "Resumen Clúster 1",
      format.args = list(big.mark = ","),
      table.attr = "style='width:50%;'") %>%
  kable_styling(bootstrap_options = c("striped", "hover"))

Resumen Clúster 1

	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
n.cestas	1	33	41.33	40.65	29.00	34.37	23.72	1.00	209.00	208.00	2.37	6.59	7.08
min.cesta	2	33	2,431.94	13,427.60	2.50	6.94	3.28	0.06	77,183.60	77,183.54	5.22	26.11	2,337.45
avg.cesta	3	33	4,334.72	16,310.32	114.51	193.55	128.74	5.28	77,183.60	77,178.32	3.66	12.15	2,839.26
max.cesta	4	33	8,772.67	31,584.99	1,051.20	1,355.98	953.61	207.50	168,469.60	168,262.10	4.21	17.47	5,498.24
total.cesta	5	33	46,577.20	28,389.09	37,153.85	42,505.89	16,570.56	12,627.94	168,472.50	155,844.56	2.41	7.71	4,941.91
primera.compra	6	33	347.36	55.10	369.00	360.33	5.93	101.00	373.00	272.00	-3.20	10.50	9.59
ultima.compra	7	33	22.15	67.73	4.00	5.41	4.45	0.00	325.00	325.00	3.63	12.08	11.79
Art & Craft	8	33	945.46	841.41	767.72	851.07	1,005.90	0.00	3,207.54	3,207.54	0.88	0.28	146.47
Baby	9	33	1,489.38	1,665.56	892.28	1,213.28	1,322.89	0.00	6,248.14	6,248.14	1.21	0.83	289.94
Carriers & Accessories	10	33	1,124.47	2,218.16	274.20	564.42	406.53	0.00	9,605.20	9,605.20	2.77	7.12	386.13
Cleaning, Safety & Other	11	33	6,403.91	13,198.27	3,352.32	4,069.43	4,276.29	0.00	77,183.60	77,183.60	4.65	22.08	2,297.52
Clothing	12	33	182.97	329.81	0.00	112.09	0.00	0.00	1,343.45	1,343.45	1.87	2.92	57.41
Electronics	13	33	1,557.27	1,231.19	1,395.27	1,471.75	1,228.53	0.00	4,426.04	4,426.04	0.52	-0.76	214.32
Food & Beverage	14	33	56.82	117.97	0.00	27.90	0.00	0.00	472.44	472.44	2.57	6.05	20.54
Footwear	15	33	158.81	243.36	0.00	111.42	0.00	0.00	1,012.00	1,012.00	1.71	2.63	42.36
Furniture	16	33	1,139.61	1,026.18	1,243.80	1,045.24	1,212.03	0.00	3,356.94	3,356.94	0.53	-0.77	178.63
Garden&Patio	17	33	544.16	1,101.59	147.00	326.36	217.94	0.00	6,045.00	6,045.00	3.79	15.93	191.76
Health & Beauty	18	33	485.88	633.53	251.86	372.36	373.41	0.00	2,590.80	2,590.80	1.54	1.89	110.28
Health & Beauty continued	19	33	1,017.00	1,829.70	483.90	624.77	717.43	0.00	9,789.88	9,789.88	3.46	13.29	318.51
Home	20	33	2,575.46	1,785.52	2,596.20	2,508.61	1,997.89	0.00	7,283.84	7,283.84	0.38	-0.46	310.82
Jewelry	21	33	963.15	1,215.17	595.20	724.18	882.44	0.00	4,204.86	4,204.86	1.45	1.25	211.53
Media	22	33	1,525.10	1,710.05	934.34	1,243.76	1,385.25	0.00	6,477.20	6,477.20	1.41	1.54	297.68
Musical Instrument	23	33	2,989.99	3,518.09	2,035.22	2,331.21	2,645.58	0.00	16,953.80	16,953.80	2.12	5.38	612.42
Occasion & Seasonal	24	33	5,344.06	4,656.08	4,417.52	4,829.44	3,999.94	0.00	21,855.80	21,855.80	1.38	2.53	810.52
Office	25	33	2,501.34	2,535.42	1,707.50	2,179.83	2,060.07	0.00	8,860.41	8,860.41	0.94	-0.32	441.36
Others	26	33	1,728.02	2,699.21	930.25	1,101.95	1,275.11	0.00	13,110.16	13,110.16	2.68	7.59	469.87
Pets	27	33	570.55	600.55	414.72	481.44	614.86	0.00	2,116.80	2,116.80	0.92	0.02	104.54
Photography	28	33	1,022.43	1,399.78	335.52	783.75	497.44	0.00	5,408.40	5,408.40	1.38	1.12	243.67
Sport & Recreation	29	33	744.25	962.54	550.09	588.45	815.56	0.00	4,413.53	4,413.53	1.76	3.92	167.56
Tools & Hardware	30	33	7,748.39	29,024.20	2,211.14	2,327.06	2,819.18	0.00	168,469.60	168,469.60	5.14	25.50	5,052.46
Toy	31	33	528.75	532.09	398.73	472.43	591.16	0.00	1,815.00	1,815.00	0.72	-0.74	92.63
Vehicle	32	33	3,122.00	3,171.05	2,297.85	2,655.25	2,229.95	0.00	12,521.04	12,521.04	1.27	0.82	552.01
Watches	33	33	107.97	411.78	0.00	19.52	0.00	0.00	2,347.40	2,347.40	4.88	23.52	71.68

kable(resumen[[3]], 
      format = "html",
      digits = 2,
      size = 5,
      caption = "Resumen Clúster 2",
      format.args = list(big.mark = ","),
      table.attr = "style='width:50%;'") %>%
  kable_styling(bootstrap_options = c("striped", "hover"))

Resumen Clúster 2

	vars	n	mean	sd	median	trimmed	mad	min	max	range	skew	kurtosis	se
n.cestas	1	7	74.14	58.31	60.00	74.14	19.27	21.00	201.00	180.00	1.34	0.31	22.04
min.cesta	2	7	6.32	10.94	1.45	6.32	1.57	0.39	30.60	30.21	1.49	0.50	4.14
avg.cesta	3	7	276.54	235.03	174.95	276.54	221.80	25.35	602.45	577.11	0.39	-1.81	88.83
max.cesta	4	7	4,268.32	2,607.32	3,828.00	4,268.32	3,127.69	1,687.17	8,142.75	6,455.58	0.34	-1.78	985.48
total.cesta	5	7	171,562.96	75,520.15	143,711.17	171,562.96	75,137.60	80,850.84	280,206.02	199,355.18	0.31	-1.76	28,543.93
primera.compra	6	7	363.14	13.25	367.00	363.14	8.90	337.00	373.00	36.00	-0.99	-0.69	5.01
ultima.compra	7	7	11.57	14.32	8.00	11.57	10.38	0.00	38.00	38.00	0.80	-1.11	5.41
Art & Craft	8	7	3,104.55	1,833.85	2,873.60	3,104.55	1,540.29	44.52	5,261.72	5,217.20	-0.29	-1.39	693.13
Baby	9	7	9,533.88	12,037.87	4,863.19	9,533.88	3,686.71	0.00	35,048.05	35,048.05	1.24	-0.03	4,549.89
Carriers & Accessories	10	7	1,626.56	1,415.76	1,125.00	1,626.56	644.04	0.00	4,279.93	4,279.93	0.73	-0.93	535.11
Cleaning, Safety & Other	11	7	20,310.17	17,658.43	15,567.53	20,310.17	14,240.33	4,792.38	55,464.53	50,672.15	0.97	-0.59	6,674.26
Clothing	12	7	653.88	856.31	348.00	653.88	515.94	0.00	2,174.40	2,174.40	0.75	-1.30	323.65
Electronics	13	7	5,781.72	3,974.52	5,525.24	5,781.72	4,396.75	1,052.72	12,957.03	11,904.31	0.55	-1.09	1,502.23
Food & Beverage	14	7	56.81	73.46	7.50	56.81	11.12	0.00	182.78	182.78	0.55	-1.53	27.76
Footwear	15	7	1,238.00	1,286.40	614.32	1,238.00	910.79	0.00	2,684.89	2,684.89	0.18	-2.15	486.21
Furniture	16	7	9,086.36	7,294.38	6,545.60	9,086.36	3,887.58	2,448.00	24,455.02	22,007.02	1.18	-0.06	2,757.02
Garden&Patio	17	7	3,452.47	3,658.43	2,260.00	3,452.47	2,002.46	0.00	10,686.60	10,686.60	0.95	-0.64	1,382.76
Health & Beauty	18	7	2,469.25	2,456.07	2,104.99	2,469.25	2,516.58	0.00	7,057.16	7,057.16	0.73	-1.00	928.31
Health & Beauty continued	19	7	4,578.19	6,367.24	2,659.96	4,578.19	1,595.78	0.00	18,729.04	18,729.04	1.48	0.54	2,406.59
Home	20	7	17,478.23	14,455.69	12,284.09	17,478.23	11,895.80	3,113.04	45,618.98	42,505.94	0.85	-0.75	5,463.74
Jewelry	21	7	3,510.52	1,763.59	2,878.53	3,510.52	1,012.10	1,652.40	6,646.38	4,993.98	0.66	-1.25	666.58
Media	22	7	4,928.19	2,869.91	4,370.36	4,928.19	2,148.57	843.00	9,589.56	8,746.56	0.22	-1.34	1,084.73
Musical Instrument	23	7	8,214.99	9,629.72	4,954.68	8,214.99	3,001.82	159.00	29,051.85	28,892.85	1.32	0.22	3,639.69
Occasion & Seasonal	24	7	18,409.69	5,419.33	18,767.34	18,409.69	3,325.49	9,660.40	27,395.74	17,735.34	0.04	-0.93	2,048.32
Office	25	7	5,172.52	2,698.59	5,100.34	5,172.52	1,140.85	647.42	9,761.95	9,114.53	0.02	-0.67	1,019.97
Others	26	7	6,567.59	3,321.77	8,142.75	6,567.59	3,712.50	2,166.92	10,646.80	8,479.88	-0.15	-1.95	1,255.51
Pets	27	7	5,366.30	5,702.52	4,027.07	5,366.30	2,603.52	1,008.00	17,730.54	16,722.54	1.33	0.24	2,155.35
Photography	28	7	3,535.44	3,333.40	3,101.13	3,535.44	3,697.50	243.12	8,595.60	8,352.48	0.42	-1.72	1,259.91
Sport & Recreation	29	7	4,186.33	5,834.71	2,011.95	4,186.33	1,960.46	0.00	17,067.82	17,067.82	1.45	0.45	2,205.31
Tools & Hardware	30	7	9,234.60	6,412.73	10,200.85	9,234.60	4,334.59	595.34	17,793.65	17,198.31	-0.31	-1.59	2,423.79
Toy	31	7	7,433.22	4,339.21	7,687.04	7,433.22	3,252.68	2,519.83	15,505.48	12,985.65	0.59	-0.94	1,640.07
Vehicle	32	7	15,538.20	9,573.42	14,445.80	15,538.20	8,963.47	90.00	27,710.47	27,620.47	-0.22	-1.47	3,618.41
Watches	33	7	95.32	172.22	0.00	95.32	0.00	0.00	458.00	458.00	1.25	-0.13	65.09

Segmentación adicional: árbol de decisión

Se puede bajar el análisis aún más para poder descubir más patrones de consumo de los clientes en cada grupo, por lo que, a continuación, se hará una segmentación más detallada con apoyo de un árbol de decisión solo al grupo 3, ya que es donde se encuentra el grueso de los clientes.

Se seleccionó el Valor Monetario como valor para la segmentación adicional, utilizando la frecuencia y la actualidad como estimadores de la misma.

arbol.cluster.3 <- cliente.order.resum %>%
  filter(Cluster == '3') %>%
  dplyr::select(n.cestas, total.cesta, ultima.compra)

fit.arbol <- rpart(total.cesta ~ ., 
                 data = arbol.cluster.3,
                 method = 'anova', 
                 control = rpart.control(cp = 0.0127102))

fig <- rpart.plot(fit.arbol, type = 1, extra = 1, box.palette = c("gray", "lightblue"))

Arbol.

Esta subsegmentación del Clúster 3 dividió el clúster en 5 clústeres diferentes más pequeños.

Veamos los resultados de clientes de bajo valor a clientes de alto valor (de derecha a izquierda en el árbol):

• 2,326 clientes presentan menos de 3 cestas de compras con un valor monetario promedio de 475.
• 895 clientes que compran más de 3 veces pero menos de 5 veces, valor monetario promedio de 1,295 (significativamente más alto que el grupo anterior).
• 777 clientes compran entre 6 y 10 cestas con un valos promedio de 2,508.
• Son 212 clientes que compran más de 11 pero menos de 19 cestas con un valor monetario promedio de 5,243.
• Los restantes 88 clientes de este grupo 3 compran más de 19 cestas con un valor promedio de 9,370.

Este último subsegmento de 88 clientes son los consumidores más valiosos dentro del clúster 3. Con este hallazgo se pueden empezar a implementar estrategias y/o campañas más focalizadas ya sea para fidelizar a este subsegmento o para incrementar el valor monetario promedio de los subsegmentos más bajos dentro de este clúster.

Reglas de Asociación

Venta cruzada

Ya para terminar aprovecharemos la información sobre la descripción de los productos para hacer otro análisis que también tiene que ver con la identificación de patrones de consumo: reglas de asociación. Utilizaremos el algoritmo Apriori.

La venta cruzada es la capacidad de vender más productos a un cliente mediante el análisis de las tendencias de compra de los clientes, así como las tendencias y patrones generales de compra que son comunes con los patrones de compra del cliente.

Por lo tanto, vamos a investigar las transacciones del cliente para descubrir posibles recomendaciones a las necesidades originales del cliente con el objetivo de ofrecerlas como una sugerencia con la esperanza y la intención de que las compren beneficiando tanto al cliente como al establecimiento.

Todo el concepto de minería de reglas de asociación se basa en el concepto de que el comportamiento de compra del cliente tiene un patrón que puede explotarse para vender más artículos al cliente en el futuro.

La técnica de reglas de asociación es un método de machine learning basado en reglas para descubrir relaciones interesantes entre variables en grandes bases de datos. Su objetivo es identificar reglas sólidas descubiertas en bases de datos utilizando algunas medidas de interés.

• Soporte: se define como la cantidad de veces que un conjunto de elementos (itemset) aparece en el conjunto de datos.
• Confianza: la confianza es una indicación de la frecuencia con la que se ha descubierto que la regla es cierta. Es una medida del número de veces que se encuentra que existe una regla en el conjunto de datos.
• Lift: la elevación de la regla se define como la relación entre el soporte observado y el soporte esperado en el caso de que los elementos de la regla fueran independientes.

Algoritmo Apriori

Nuevamente, nos enfocaremos solo en el clúster 3, ya que es donde se encuentra el mayor número de clientes, sin embargo, bien se podría analizar toda la base de datos sin ningún ptoblema.

# Esto se hace una sola vez, por tanto solo se comenta:
#cliente.order.resum$CustomerID <- as.character(cliente.order.resum$CustomerID)

# df3 <- cliente.order.resum %>% 
#   filter(Cluster == '3') %>% 
#   select(CustomerID, Cluster) %>% 
#   inner_join(df, by = "CustomerID") %>% 
#   select(CustomerID, InvoiceNo, Description, InvoiceDate, BasketPrice, Quantity, UnitPrice)



# reglas <- df3 %>% 
# mutate(Description = as.factor(Description)) %>% 
#    dplyr::select(InvoiceNo, Description, InvoiceDate)
# 
# transacciones <- ddply(reglas, c("InvoiceNo", "InvoiceDate"),
#                         function(df1)paste(df1$Description,
#                                            collapse = ","))
# transacciones$InvoiceNo <- NULL
# transacciones$InvoiceDate <- NULL

# colnames(transacciones) <- c("Productos")

# write.csv(transacciones,"transacciones.c3.csv", quote = FALSE, row.names = FALSE)

tr <- read.transactions("transacciones.c3.csv", format = 'basket', sep = ',')

summary(tr)

## transactions as itemMatrix in sparse format with
##  19867 rows (elements/itemsets/transactions) and
##  7420 columns (items) and a density of 0.002047314 
## 
## most frequent items:
## WHITE HANGING HEART T-LIGHT HOLDER           REGENCY CAKESTAND 3 TIER 
##                               1649                               1529 
##            JUMBO BAG RED RETROSPOT      ASSORTED COLOUR BIRD ORNAMENT 
##                               1255                               1206 
##                      PARTY BUNTING                            (Other) 
##                               1194                             294968 
## 
## element (itemset/transaction) length distribution:
## sizes
##    1    2    3    4    5    6    7    8    9   10   11   12   13   14   15   16 
## 3041 1397  986  783  764  678  622  600  609  549  581  506  476  498  512  490 
##   17   18   19   20   21   22   23   24   25   26   27   28   29   30   31   32 
##  439  408  470  398  368  288  298  251  221  233  210  193  202  195  153  141 
##   33   34   35   36   37   38   39   40   41   42   43   44   45   46   47   48 
##  118  127  119  102  102   77  101   89   82   76   78   56   55   67   60   50 
##   49   50   51   52   53   54   55   56   57   58   59   60   61   62   63   64 
##   53   45   54   39   37   42   37   34   27   30   23   24   26   16   25   23 
##   65   66   67   68   69   70   71   72   73   74   75   76   77   78   79   80 
##   19   25   22   19   12   17   15   11   12   14    7   14   11    7    6   12 
##   81   82   83   84   85   86   87   88   89   90   91   92   93   94   95   96 
##   14    9    7    5    8    9   10    4    5    5    3    9    5    3    3    4 
##   97   98   99  100  101  102  103  104  105  107  108  109  110  111  112  113 
##    4    4    2    2    2    4    4    1    1    5    4    3    2    2    1    2 
##  114  116  117  118  120  121  122  125  126  127  131  133  134  140  141  142 
##    2    3    2    3    1    2    3    2    1    2    1    1    1    1    2    2 
##  143  146  147  150  153  154  157  168  171  204  236  249  250 
##    1    2    1    1    1    1    1    2    1    1    1    1    1 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    3.00   10.00   15.19   21.00  250.00 
## 
## includes extended item information - examples:
##                       labels
## 1                   1 HANGER
## 2     10 COLOUR SPACEBOY PEN
## 3 12 COLOURED PARTY BALLOONS

reglas.asociacion <- apriori(tr, parameter = list(supp = 0.01, conf = 0.8, maxlen = 5))

## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport maxtime support minlen
##         0.8    0.1    1 none FALSE            TRUE       5    0.01      1
##  maxlen target  ext
##       5  rules TRUE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 198 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[7420 item(s), 19867 transaction(s)] done [0.16s].
## sorting and recoding items ... [402 item(s)] done [0.00s].
## creating transaction tree ... done [0.02s].
## checking subsets of size 1 2 3 4 done [0.01s].
## writing ... [12 rule(s)] done [0.00s].
## creating S4 object  ... done [0.00s].

summary(reglas.asociacion)

## set of 12 rules
## 
## rule length distribution (lhs + rhs):sizes
## 2 3 
## 5 7 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.000   2.000   3.000   2.583   3.000   3.000 
## 
## summary of quality measures:
##     support          confidence        coverage            lift      
##  Min.   :0.01017   Min.   :0.8262   Min.   :0.01017   Min.   :24.46  
##  1st Qu.:0.01052   1st Qu.:0.8628   1st Qu.:0.01052   1st Qu.:28.86  
##  Median :0.01052   Median :1.0000   Median :0.01052   Median :68.98  
##  Mean   :0.01133   Mean   :0.9477   Mean   :0.01213   Mean   :63.53  
##  3rd Qu.:0.01055   3rd Qu.:1.0000   3rd Qu.:0.01253   3rd Qu.:95.06  
##  Max.   :0.01555   Max.   :1.0000   Max.   :0.01883   Max.   :95.06  
##      count      
##  Min.   :202.0  
##  1st Qu.:209.0  
##  Median :209.0  
##  Mean   :225.1  
##  3rd Qu.:209.5  
##  Max.   :309.0  
## 
## mining info:
##  data ntransactions support confidence
##    tr         19867    0.01        0.8

inspect(reglas.asociacion)

##      lhs                                  rhs                                  support confidence   coverage     lift count
## [1]  {SET 3 RETROSPOT TEA}             => {SUGAR}                           0.01051996  1.0000000 0.01051996 95.05742   209
## [2]  {SUGAR}                           => {SET 3 RETROSPOT TEA}             0.01051996  1.0000000 0.01051996 95.05742   209
## [3]  {SET 3 RETROSPOT TEA}             => {COFFEE}                          0.01051996  1.0000000 0.01051996 68.98264   209
## [4]  {SUGAR}                           => {COFFEE}                          0.01051996  1.0000000 0.01051996 68.98264   209
## [5]  {SHED}                            => {KEY FOB}                         0.01016761  1.0000000 0.01016761 68.74394   202
## [6]  {SET 3 RETROSPOT TEA,                                                                                                 
##       SUGAR}                           => {COFFEE}                          0.01051996  1.0000000 0.01051996 68.98264   209
## [7]  {COFFEE,                                                                                                              
##       SET 3 RETROSPOT TEA}             => {SUGAR}                           0.01051996  1.0000000 0.01051996 95.05742   209
## [8]  {COFFEE,                                                                                                              
##       SUGAR}                           => {SET 3 RETROSPOT TEA}             0.01051996  1.0000000 0.01051996 95.05742   209
## [9]  {GREEN REGENCY TEACUP AND SAUCER,                                                                                     
##       PINK REGENCY TEACUP AND SAUCER}  => {ROSES REGENCY TEACUP AND SAUCER} 0.01555343  0.8262032 0.01882519 24.46226   309
## [10] {PINK REGENCY TEACUP AND SAUCER,                                                                                      
##       ROSES REGENCY TEACUP AND SAUCER} => {GREEN REGENCY TEACUP AND SAUCER} 0.01555343  0.8679775 0.01791916 29.03049   309
## [11] {PINK REGENCY TEACUP AND SAUCER,                                                                                      
##       REGENCY CAKESTAND 3 TIER}        => {GREEN REGENCY TEACUP AND SAUCER} 0.01062063  0.8473896 0.01253335 28.34190   211
## [12] {PINK REGENCY TEACUP AND SAUCER,                                                                                      
##       REGENCY CAKESTAND 3 TIER}        => {ROSES REGENCY TEACUP AND SAUCER} 0.01041929  0.8313253 0.01253335 24.61392   207

con los argumentos seleccionados, se crearon 12 reglas de asociación con los datos del clúster 3.

Evaluación:

Vamos a calcular el test exacto de Fisher (test de significancia para obtener si las reglas representan patrones reales).

testFisher <- interestMeasure(reglas.asociacion,
                measure = "fishersExactTest",
                transactions = tr)

summary(testFisher)

##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
##  0.000e+00  0.000e+00  0.000e+00 6.145e-274  0.000e+00 7.375e-273

Todos los p-valores del test son pequeños (menores a 0), lo que refleja que es muy probable que las reglas reflejen patrones de comportamiento en los pedidos.

Visualización:

En la gráfica siguiente se representan redes asociadas a las reglas encontradas, pulsando sobre el circulo perteneciente a cada regla se pueden obtener sus parámetros support, confidence, lift y count.

plot(reglas.asociacion, method = "graph",  engine = "htmlwidget")

Creando reglas

inspectDT(reglas.asociacion)

En la tabla anterior, se pueden observar las principales Reglas de Asociación de productos encontradas y se leen de la siguiente manera:

1. LHS: Producto (o combinación de productos vendidos).
2. RHS: Producto que probablemente se venda a partir de LHS.
3. support: El soporte nos dice qué tan frecuente es un elemento o un conjunto de elementos en todos los datos, es decir, nos dice qué tan popular o frecuente es un conjunto de elementos en el conjunto de datos analizado.
4. confidence: La confianza nos dice qué probabilidad hay de que alguien compre el producto en la columna RHS cuando ya ha comprado el de la columna LHS.
5. lift: El Levantamiento nos dice qué tan probable es RHS cuando LHS ya ha ocurrido, teniendo en cuenta el soporte de ambos; si este es < 1 es poco probable; si es 1 no es probable; si es > 1 es muy probable.
6. count: Cantidad de veces que ha ocurrido esa venta.

Conclusiones

Con este análisis de segmentación pudimos incorporar más técnicas de análisis que nos ayudaron a encontrar más patrones de consumo de los clientes como lo fueron un árbol de decisión y las reglas de asociación. Lo anterior, es una muestra de que es posible afinar y detallar cada vez más los análisis combinando diferentes algoritmos.

En cuanto a los clientes habituales del Clúster 1, es posible que se les anime a regresar dentro del mismo mes de su última compra si se les informa sobre productos nuevos y/o exclusivos. Además, sería altamente recomendable enviarles publicidad para darles a conocer sobre descuentos en Tools & Hadware y Cleaning, Safety & Other o sobre nuevos productos en éstas categorías.

Para el Clúster 2, todos los clientes de alto valor pueden ser empresarios, por lo que solicitan cantidades de productos al por mayor. Podemos prepararles una oferta para que obtengan un descuento adicional cuando compren al por mayor. Además, diseñar programas de postventa.

Son 88 clientes los de mayor valor dentro del clúster 3, por lo que, podemos considerarlos dentro de las mismas estrategias del clúster 2. Para otros clientes del Clúster 3, podemos ofrecer promociones seleccionadas para productos de sus categorías de interés y enviar periódicamente las ofertas de descuento por correo electrónico o mostrar el mensaje justo después de que el usuario inicie sesión en el sitio web.

Con respecto a las reglas encontradas pudimos identificar que la mayoría de las transacciones tienen que ver con productos similares de cocina como café, té, azúcar y tazas. Esto suena lógico, ya que son alimentos que suelen comprarse en un mismo ticket.

Tal vez sería adecuado complementar este análisis con la creación de un sistema de recomendación, sin embargo, queda fuera del alcance del presente trabajo.