Segmentacion de consumidores usando RFM

Integrantes

• Carlo Vega
• Jhampier Tapia
• Jair Guillerno
• Victor Valera
• Arturo Sanabria

Analisis RFM

“Este es un conjunto de datos transnacionales que contiene todas las transacciones que ocurrieron entre el 01/12/2010 y el 09/12/2011 para un comercio minorista en línea no registrado y con sede en el Reino Unido. La empresa vende principalmente regalos únicos para todas las ocasiones. Muchos clientes de la empresa son mayoristas”

Lectura de datos

df <- 
  readr::read_csv(file = 'data.csv', 
                  locale = readr::locale(encoding = 'UTF-8'))

dplyr::glimpse(df)

## Rows: 541,909
## Columns: 8
## $ InvoiceNo   <chr> "536365", "536365", "536365", "536365", "536365", "536365"~
## $ StockCode   <chr> "85123A", "71053", "84406B", "84029G", "84029E", "22752", ~
## $ Description <chr> "WHITE HANGING HEART T-LIGHT HOLDER", "WHITE METAL LANTERN~
## $ Quantity    <dbl> 6, 6, 8, 6, 6, 2, 6, 6, 6, 32, 6, 6, 8, 6, 6, 3, 2, 3, 3, ~
## $ InvoiceDate <chr> "12/1/2010 8:26", "12/1/2010 8:26", "12/1/2010 8:26", "12/~
## $ UnitPrice   <dbl> 2.55, 3.39, 2.75, 3.39, 3.39, 7.65, 4.25, 1.85, 1.85, 1.69~
## $ CustomerID  <dbl> 17850, 17850, 17850, 17850, 17850, 17850, 17850, 17850, 17~
## $ Country     <chr> "United Kingdom", "United Kingdom", "United Kingdom", "Uni~

Tratamiento de los datos

Se remueven las cantiades negativas y consumidores con NA asignados.

# Remocion de negativos y NA's
df1 <- 
  df %>% 
  dplyr::filter(Quantity > 0 , 
                UnitPrice > 0) %>% 
  tidyr::drop_na()

head(df1, n = 10)

Recodificacion de variables

df2 <- 
  df1 %>% 
  dplyr::mutate(InvoiceDate = as.Date(x = InvoiceDate, format = '%m/%d/%Y')) %>% 
  dplyr::mutate_if(is.character, as.factor) %>% 
  dplyr::mutate(total_dolar = Quantity*UnitPrice)

skimr::skim(df2)

Data summary

Name	df2
Number of rows	397884
Number of columns	9
_______________________
Column type frequency:
Date	1
factor	4
numeric	4
________________________
Group variables	None

Variable type: Date

skim_variable	n_missing	complete_rate	min	max	median	n_unique
InvoiceDate	0	1	2010-12-01	2011-12-09	2011-07-31	305

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
InvoiceNo	0	1	FALSE	18532	576: 542, 579: 533, 580: 529, 578: 442
StockCode	0	1	FALSE	3665	851: 2035, 224: 1723, 850: 1618, 848: 1408
Description	0	1	FALSE	3866	WHI: 2028, REG: 1723, JUM: 1618, ASS: 1408
Country	0	1	FALSE	37	Uni: 354321, Ger: 9040, Fra: 8341, EIR: 7236

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Quantity	0	1	12.99	179.33	1	2.00	6.00	12.00	80995.00	▇▁▁▁▁
UnitPrice	0	1	3.12	22.10	0	1.25	1.95	3.75	8142.75	▇▁▁▁▁
CustomerID	0	1	15294.42	1713.14	12346	13969.00	15159.00	16795.00	18287.00	▇▇▇▇▇
total_dolar	0	1	22.40	309.07	0	4.68	11.80	19.80	168469.60	▇▁▁▁▁

Calculate RFM data set

df_RFM <- 
  df2 %>% 
  dplyr::group_by(CustomerID) %>% 
  dplyr::summarise(Recency = Sys.Date() - max(InvoiceDate), 
                   Recency = as.numeric(Recency), 
                   frequenci = dplyr::n_distinct(InvoiceNo), 
                   monitery = sum(total_dolar)/frequenci) %>% 
  dplyr::ungroup()

summary(df_RFM)

kableExtra::kable(head(df_RFM))

##    CustomerID       Recency       frequenci          monitery       
##  Min.   :12346   Min.   :3423   Min.   :  1.000   Min.   :    3.45  
##  1st Qu.:13813   1st Qu.:3440   1st Qu.:  1.000   1st Qu.:  178.62  
##  Median :15300   Median :3473   Median :  2.000   Median :  293.90  
##  Mean   :15300   Mean   :3515   Mean   :  4.272   Mean   :  419.17  
##  3rd Qu.:16779   3rd Qu.:3565   3rd Qu.:  5.000   3rd Qu.:  430.11  
##  Max.   :18287   Max.   :3796   Max.   :209.000   Max.   :84236.25

CustomerID	Recency	frequenci	monitery
12346	3748	1	77183.6000
12347	3425	7	615.7143
12348	3498	4	449.3100
12349	3441	1	1757.5500
12350	3733	1	334.4000
12352	3459	8	313.2550

Recency

Recencia – Cuanto paso desde el ultimo consumo

df_RFM %>% 
  dplyr::filter(monitery < 7000, 
                frequenci < 200) %>% 
  ggplot2::ggplot() + 
  ggplot2::aes(Recency) + 
  ggplot2::geom_histogram(col = 'red', fill = 'skyblue', bins = 50) + 
  ggplot2::theme_minimal() + 
  ggplot2::theme(text = ggplot2::element_text(family = 'serif'))

Frequency

Frecuencia – Cuan frecuente fueron la compra?

df_RFM %>% 
  dplyr::filter(monitery < 7000, 
                frequenci < 200) %>% 
  ggplot2::ggplot() + 
  ggplot2::aes(frequenci) + 
  ggplot2::geom_histogram(col = 'red', fill = 'skyblue', bins = 50) + 
  ggplot2::theme_minimal() + 
  ggplot2::theme(text = ggplot2::element_text(family = 'serif'))

Monetary

Valor monetario – Cuanto gastaron?

df_RFM %>% 
  dplyr::filter(frequenci < 200) %>% 
  ggplot2::ggplot() + 
  ggplot2::aes(monitery) + 
  ggplot2::geom_histogram(col = 'red', fill = 'skyblue', bins = 50) + 
  ggplot2::theme_minimal() + 
  ggplot2::theme(text = ggplot2::element_text(family = 'serif'))

Ya que la variable cantidad monetaria es altamente insesgada, se usara una transformacion logaritmica para visualizarla mejor.

df_RFM$monitery <- log(df_RFM$monitery)

df_RFM %>% 
  dplyr::filter(frequenci < 200) %>% 
  ggplot2::ggplot() + 
  ggplot2::aes(monitery) + 
  ggplot2::geom_histogram(col = 'red', fill = 'skyblue', bins = 50) + 
  ggplot2::theme_minimal() + 
  ggplot2::theme(text = ggplot2::element_text(family = 'serif'))

RFM Analisis

rfm_result <- 
  rfm::rfm_table_customer(df_RFM, 
                          customer_id = CustomerID,
                          recency_days = Recency,
                          n_transactions = frequenci,
                          total_revenue = monitery)

Heat Map

rfm::rfm_heatmap(rfm_result)

Bar Chart

rfm::rfm_bar_chart(rfm_result)

Histogram

rfm::rfm_histograms(rfm_result)

Customers by Orders

rfm::rfm_order_dist(rfm_result)

Refinamiento del analisis

BDF %>% 
  ggplot2::ggplot() + 
  ggplot2::aes(x = cus_seg, fill = cus_seg) + 
  ggplot2::geom_bar() + 
  ggplot2::geom_text(
    ggplot2::aes(label = scales::percent(..count../sum(..count..))
                 ), 
    stat = 'count', position = position_dodge(1)
    ) + 
  ggplot2::labs(title = "Segmentacion de clientes", 
                x = "Segmento", 
                y = "Total del consumidor") + 
  ggplot2::coord_flip() + 
  ggplot2::theme(text = ggplot2::element_text(family = 'serif')) + 
  ggplot2::theme_minimal()

Analisis Cluster

df_RFM2 <- 
  df_RFM %>% 
  tibble::column_to_rownames(var = 'CustomerID') %>% 
  scale %>% 
  tibble::as_tibble()

summary(df_RFM2)

##     Recency          frequenci           monitery      
##  Min.   :-0.9205   Min.   :-0.42505   Min.   :-5.8832  
##  1st Qu.:-0.7505   1st Qu.:-0.42505   1st Qu.:-0.6153  
##  Median :-0.4205   Median :-0.29514   Median : 0.0493  
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.4968   3rd Qu.: 0.09457   3rd Qu.: 0.5576  
##  Max.   : 2.8091   Max.   :26.59496   Max.   : 7.6012

Exploracion

# Histogramas y correlaciones:
# Para las correlaciones se probara la normalidad de las variables para aplicar 
# correlacion por Pearson, de no enontrarse normalidad se aplicara Spearman

# Ho: La variable sigue una distribucion normal
# H1: La variable no sigue una distribbucion normal
# Prueba de normalidad: Anderson Darling, 5% de significancia.

n.test <- apply(X = df_RFM2, MARGIN = 2, FUN = nortest::ad.test)
n.test

## $Recency
## 
##  Anderson-Darling normality test
## 
## data:  newX[, i]
## A = 300.15, p-value < 2.2e-16
## 
## 
## $frequenci
## 
##  Anderson-Darling normality test
## 
## data:  newX[, i]
## A = 660.15, p-value < 2.2e-16
## 
## 
## $monitery
## 
##  Anderson-Darling normality test
## 
## data:  newX[, i]
## A = 15.519, p-value < 2.2e-16

# En este caso, todas las variables rechazan la normalidad, se aplicara la 
# correlacion por spearman

PerformanceAnalytics::chart.Correlation(df_RFM2, method = c("spearman"))

## Warning in cor.test.default(as.numeric(x), as.numeric(y), method = method):
## Cannot compute exact p-value with ties

## Warning in cor.test.default(as.numeric(x), as.numeric(y), method = method):
## Cannot compute exact p-value with ties

## Warning in cor.test.default(as.numeric(x), as.numeric(y), method = method):
## Cannot compute exact p-value with ties

Definicion del cluster optimo

# Grafica de la comparativa de los clusteres usando el metodo silhouette
factoextra::fviz_nbclust(df_RFM2, kmeans, method = "silhouette")

# Grafico de los clusteres
res <- kmeans(df_RFM2, 2, nstart = 25)

Grafico de los clusteres

factoextra::fviz_cluster(res, data = df_RFM2,
             # palette = c("#E7B800", "#00AFBB"),
             geom = "point",
             ellipse.type = "convex", 
             ggtheme = theme_bw()
             )

Promedios por cluster y variables

df_RFM2 <- 
  df_RFM2 %>% 
  dplyr::mutate(cluster = as.factor(res$cluster)) %>% 
  tidyr::drop_na()

data_long <- 
  df_RFM2 %>% 
  tidyr::gather(key = 'var', 
                value = 'valor', c(1:3), 
                factor_key = TRUE)

ggplot(data_long, aes(as.factor(x = var), 
                      y = valor,group=cluster, colour = cluster)) + 
  stat_summary(fun = mean, geom="pointrange", size = 1)+
  stat_summary(geom="line") + labs(x="Atributos", y="Frecuencia",
                                   title="Clientes")

Conclusion:

• A partir del analisis previo, decidimos elegir 2 clusteres a pesar de que los grupos se esten solapando.

Comportamiento de las variables por cluster

Resumen de las variables por cluster

df_RFM2 %>%
  dplyr::group_by(cluster) %>%
  dplyr::group_map(~ summary(.))

## [[1]]
##     Recency          frequenci          monitery      
##  Min.   :-0.9205   Min.   :-0.4250   Min.   :-3.4853  
##  1st Qu.:-0.8105   1st Qu.:-0.2951   1st Qu.:-0.4623  
##  Median :-0.6305   Median :-0.1652   Median : 0.1424  
##  Mean   :-0.5160   Mean   : 0.1210   Mean   : 0.1451  
##  3rd Qu.:-0.3106   3rd Qu.: 0.2245   3rd Qu.: 0.6472  
##  Max.   : 2.3291   Max.   :26.5950   Max.   : 7.6012  
## 
## [[2]]
##     Recency          frequenci          monitery      
##  Min.   :-0.5605   Min.   :-0.4250   Min.   :-5.8832  
##  1st Qu.: 0.9193   1st Qu.:-0.4250   1st Qu.:-1.0135  
##  Median : 1.4692   Median :-0.4250   Median :-0.4126  
##  Mean   : 1.4861   Mean   :-0.3485   Mean   :-0.4180  
##  3rd Qu.: 2.0392   3rd Qu.:-0.2951   3rd Qu.: 0.2233  
##  Max.   : 2.8091   Max.   : 3.8618   Max.   : 2.9900

Boxplot por cluster del monto

data_long %>% 
  dplyr::filter(var %in% 'monitery') %>% 
  dplyr::group_by(cluster) %>% 
  ggplot2::ggplot() + 
  ggplot2::aes(x = cluster, y = valor, fill = cluster) + 
  ggplot2::geom_boxplot() + 
  ggplot2::theme_minimal() + 
  ggplot2::theme(text = ggplot2::element_text(family = 'serif'))

Boxplot por cluster y variables

data_long %>%
  dplyr::group_by(cluster) %>% 
  ggplot2::ggplot() + 
  ggplot2::aes(x = cluster, y = valor, fill = cluster) + 
  ggplot2::geom_boxplot() + 
  ggplot2::theme_minimal() + 
  ggplot2::theme(text = ggplot2::element_text(family = 'serif')) + 
  ggplot2::facet_grid(var ~ ., scales = 'free')

Notas:

Etiquetado de los clusteres

• Segmento 1: Clientes con mayores consumos.
• Segmento 2: Clientes con menores consumos.
• Se podria aplicar una campaña de descuentos a los clientes con menores consumos para tratar de generar engagment con ellos al considerarnos una compañia que se preocupa por su consumo e ingresos.

Conclusiones generales

• Clientes 555:

  • Quiénes son: Clientes altamente comprometidos que han comprado lo más reciente, con mayor frecuencia, y han generado la mayor cantidad de ingresos.

  • Para los clientes mejor puntuados luego del analisis planteamos darles un upgrade a clientes premium, accediendo a delivery gratis, promociones unicas, lo cual los hará sentirse comodos siguiendos con el mismo nivel de consumo, frecuencia y monto de compras, aparte de información especial de usos de los productos comprados.

• Clientes XX1:

  • Quiénes son: Los clientes que han generado más ingresos en tu tienda.

  • Se plantea brindarles un plan de fidelización donde tengan niveles por montos de consumo en un lapso bimestral, donde cuando pasen la valla al siguiente nivel desbloqueen beneficios como soporte especializado, delivery gratis en algos productos y descuentos especiales.

• Clientes X13, X14:

  • Quiénes son: Clientes que suelen volver, pero no gastan mucho.

  • En este segmento ya hemos conseguido crear fidelidad. Concéntrate en aumentar la monetización a través de recomendaciones de productos en compras pasadas e incentivos relacionados con los umbrales de gasto. Planteamos aplicar brindarle por sus compras opciones a sorteos para incentivar el gasto manteniendo la frecuencia y aumentando el monto para volverlos clientes ideales.

• Clientes 44X:

  • Quiénes son: Grandes clientes del pasado que no han comprado en un tiempo.

  • Se crear un plan de encuestas pudiendo obtener datos el porque de su disminución de consumo para en base a esto generar datos y oportunidades de mejora o quizás creación de nuevas campañas.