El Market Basket Analysis es una técnica en el ámbito de análisis y minería de datos en el camo del comercio. Su objetivo rincial es descubrir patrones de asociación entre productos que suelen ser comprados juntos por los clientes.
Las 3 métricas principales para evaluar reglas de asoación son:
Este caso de estudio utiliza el dataset real de Instacart en Kaggle, el cual registra más de 3 millones de pedidos de 200,000 usuarios con un catálogo de 50,000 productos, con el objetivo de descubrir los hábitos de consumo y predecir las compras repetidas de los clientes. A diferencia de un modelo inmobiliario tradicional, este ecosistema carece de datos de precios, por lo que se aborda mediante un Market Basket Analysis (Análisis de la Canasta de Compra) utilizando el algoritmo Apriori; esto permite conectar múltiples tablas relacionales para identificar reglas de asociación y combinaciones frecuentes de productos (como qué artículos se agregan juntos al carrito), información que las empresas de comercio electrónico utilizan estratégicamente para optimizar recomendaciones en la app, diseñar promociones y organizar sus inventarios.
# install.packages("tidyverse") # Paquete global para manipulación y análisis de datos
library(tidyverse)
# install.packages("janitor") # Examinar y limpiar bases de datos sucias
library(janitor)
# install.packages("Matrix") # Para trabajar con matrices
library(Matrix)
# install.packages("arules") # Genera reglas de asociación
library(arules)
# install.packages("arulesViz") # Visualizar reglas de asociación
library(arulesViz)
# install.packages("plyr")
library(plyr)
# file.choose()
#order1 <- read.csv("C:\\Users\\raulc\\Downloads\\archive\\order_products__prior.csv")
order2 <- read.csv("C:\\Users\\raulc\\Downloads\\archive\\order_products__train.csv")
products <- read.csv("C:\\Users\\raulc\\Downloads\\archive\\products.csv")
#order <- rbind(order1,order2)
df <- left_join(order2, products, by = "product_id")
summary(df)
## order_id product_id add_to_cart_order reordered
## Min. : 1 Min. : 1 Min. : 1.000 Min. :0.0000
## 1st Qu.: 843370 1st Qu.:13380 1st Qu.: 3.000 1st Qu.:0.0000
## Median :1701880 Median :25298 Median : 7.000 Median :1.0000
## Mean :1706298 Mean :25556 Mean : 8.758 Mean :0.5986
## 3rd Qu.:2568023 3rd Qu.:37940 3rd Qu.:12.000 3rd Qu.:1.0000
## Max. :3421070 Max. :49688 Max. :80.000 Max. :1.0000
## product_name aisle_id department_id
## Length :1384617 Min. : 1.0 Min. : 1.00
## N.unique : 39123 1st Qu.: 31.0 1st Qu.: 4.00
## N.blank : 0 Median : 83.0 Median : 8.00
## Min.nchar: 3 Mean : 71.3 Mean : 9.84
## Max.nchar: 159 3rd Qu.:107.0 3rd Qu.:16.00
## Max. :134.0 Max. :21.00
str(df)
## 'data.frame': 1384617 obs. of 7 variables:
## $ order_id : int 1 1 1 1 1 1 1 1 36 36 ...
## $ product_id : int 49302 11109 10246 49683 43633 13176 47209 22035 39612 19660 ...
## $ add_to_cart_order: int 1 2 3 4 5 6 7 8 1 2 ...
## $ reordered : int 1 1 0 0 1 0 0 1 0 1 ...
## $ product_name : chr "Bulgarian Yogurt" "Organic 4% Milk Fat Whole Milk Cottage Cheese" "Organic Celery Hearts" "Cucumber Kirby" ...
## $ aisle_id : int 120 108 83 83 95 24 24 21 2 115 ...
## $ department_id : int 16 16 4 4 15 4 4 16 16 7 ...
top10 <- df %>%
dplyr::count(product_name, sort = TRUE) %>%
head(10)
top10
## product_name n
## 1 Banana 18726
## 2 Bag of Organic Bananas 15480
## 3 Organic Strawberries 10894
## 4 Organic Baby Spinach 9784
## 5 Large Lemon 8135
## 6 Organic Avocado 7409
## 7 Organic Hass Avocado 7293
## 8 Strawberries 6494
## 9 Limes 6033
## 10 Organic Raspberries 5546
head(df)
## order_id product_id add_to_cart_order reordered
## 1 1 49302 1 1
## 2 1 11109 2 1
## 3 1 10246 3 0
## 4 1 49683 4 0
## 5 1 43633 5 1
## 6 1 13176 6 0
## product_name aisle_id department_id
## 1 Bulgarian Yogurt 120 16
## 2 Organic 4% Milk Fat Whole Milk Cottage Cheese 108 16
## 3 Organic Celery Hearts 83 4
## 4 Cucumber Kirby 83 4
## 5 Lightly Smoked Sardines in Olive Oil 95 15
## 6 Bag of Organic Bananas 24 4
# Ordenar de menor a mayor la columna Ticket
df <- df[order(df$order_id), ]
# Generar Basket
basket <- ddply(df, c("order_id"), function(df)paste(df$product_name, collapse=","))
# Eliminar número de ticket
basket$order_id <- NULL
# Cambiar el título de la columna V1 por Marca
colnames(basket) <- c("Producto")
# Exportar basket
write.csv(basket, "basket2.csv", quote = FALSE, row.names = FALSE)
# file.choose()
tr <- read.transactions("C:\\Users\\raulc\\OneDrive\\Escritorio\\basket2.csv", format = "basket", sep=",")
reglas.asociacion <- apriori(tr, parameter = list(supp=0.001, conf=0.2, maxlen=10))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.2 0.1 1 none FALSE TRUE 5 0.001 1
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 131
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[49936 item(s), 131210 transaction(s)] done [0.61s].
## sorting and recoding items ... [1813 item(s)] done [0.01s].
## creating transaction tree ... done [0.05s].
## checking subsets of size 1 2 3 4 done [0.05s].
## writing ... [1339 rule(s)] done [0.00s].
## creating S4 object ... done [0.01s].
#summary(reglas.asociacion)
#inspect(reglas.asociacion)
reglas.asociacion <- sort(reglas.asociacion, by= "confidence", decreasing = TRUE)
#summary(reglas.asociacion)
#inspect(reglas.asociacion)
top10reglas <- head(reglas.asociacion, n=10, by="confidence")
plot(top10reglas, method= "graph", engine = "htmlwidget")