Market Basket Analysis - Instacart

Teoría

El Market Basket Analysis es una técnica en el ámbito de análisis y minería de datos en el campo del comercio. Su objetivo rincial es descrubrir patrones de asociación entre productos que suelen ser comparados juntos por los clientes.

Las 3 métricas principales para evaluar reglas de asociación son:

• Confidence (Confianza): Probabilidad de comprar B sabiendo que se compró A. Ej. Pan –> Mantequilla 0.8 De cada 100 clientes que compraron pan, 80 compraron mantequilla también.
• Lift (Elevación): Cuánto más probable es comprr B cuando se compra A en comparación de la probabilidad de comprar B sin saber si se compró A. Ej. Lift > 1 Compra A impulsa B. Lift = 1 No tienen relación de compra. Lift < 1 A reduce la compra de B.
• Support (Soporte): Popularidad del producto dentro de las transacciones. Ej. Pan y Mantequilla 0.05 El 5% de todas las transacciones compraron estos dos productos juntos.

Contexto

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. Utiliza el algoritmo Apriori, el cual permite conectar múltiples tablas relacionales para poder identificar las reglas de asociación y combinaciones de productos.

Instalar paquetes y llamar librerías

# install.packages("tidyverse") # Paquete global para manipulación y análisis de datos
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.1     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.3     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

# install.packages("janitor") # Examinar y limpiar bases de datos sucias
library(janitor)

## 
## Attaching package: 'janitor'
## 
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test

# install.packages("Matrix") # Para trabajar con matrices
library(Matrix)

## 
## Attaching package: 'Matrix'
## 
## The following objects are masked from 'package:tidyr':
## 
##     expand, pack, unpack

# install.packages("arules") #Genera reglas de asociación
library(arules)

## 
## Attaching package: 'arules'
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
## 
## The following objects are masked from 'package:base':
## 
##     abbreviate, write

# install.packages("arulesViz") # Visualizar reglas de asociación
library(arulesViz)
# install.packages("plyr")
library(plyr)

## ------------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## ------------------------------------------------------------------------------
## 
## Attaching package: 'plyr'
## 
## The following objects are masked from 'package:dplyr':
## 
##     arrange, count, desc, mutate, rename, summarise, summarize
## 
## The following object is masked from 'package:purrr':
## 
##     compact

Importar la base de datos

# file.choose()
aisles <- read.csv("/Users/elisarivas/Desktop/IA concentración/M2/archive (2)/aisles.csv")
departments <- read.csv("/Users/elisarivas/Desktop/IA concentración/M2/archive (2)/departments.csv")
order_prod_prior <- read.csv("/Users/elisarivas/Desktop/IA concentración/M2/archive (2)/order_products__prior.csv")
order_prod_train <- read.csv("/Users/elisarivas/Desktop/IA concentración/M2/archive (2)/order_products__train.csv")
orders <- read.csv("/Users/elisarivas/Desktop/IA concentración/M2/archive (2)/orders.csv")
products <- read.csv("/Users/elisarivas/Desktop/IA concentración/M2/archive (2)/products.csv")

order <- rbind(order_prod_prior, order_prod_train)
df <- left_join(order_prod_train, products, by = "product_id")

Entender la base de datos

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)
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

Limpiar la base de datos

Técnica 1. Eliminar valores irrelevantes

# Eliminar columnas (ejemplo)
# df <- subset(df, select=-c(PLU)) 

# Eliminar renglones
df <- df[df$order_id>0, ]

Técnica 2. Eliminar valores repetidos

df <- distinct(df)

Técnica 3. Corregir errores tipográficos y similares

# (Ejemplo)
# df$product_name <- ceiling(df$product_name)

Técnica 4. Convertir tipos de datos

# (Ejemplo)
# df$department_id <- as.factor(df$department_id)

Técnica 5. Tratar valores faltantes

# Borrar todos los NA's
# df <- na.omit(df)

# Reemplazar los NA's con CEROS
# df[is.na(df)] <- 0

# Reemplazar los NA's con el PROMEDIO
# df$altura[is.na(df$altura)] <- mean(df$altura, na.rn=TRUE)

Técnica 6. Herramientas estadísticas

boxplot(df$add_to_cart_order, horizontal = TRUE)

Generar basket

#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)

Market Basket Analysis

tr <- read.transactions("/Users/elisarivas/Desktop/IA concentración/M2/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.81s].
## sorting and recoding items ... [1813 item(s)] done [0.03s].
## creating transaction tree ... done [0.10s].
## checking subsets of size 1 2 3 4 done [0.07s].
## writing ... [1339 rule(s)] done [0.01s].
## creating S4 object  ... done [0.06s].

reglas.asociacion <- sort(reglas.asociacion, by= "confidence", decreasing = TRUE)
#summary(reglas.asociacion)
#str(reglas.asociacion)

top10reglas <- head(reglas.asociacion, n=10, by="confidence")
plot(top10reglas, method= "graph", engine ="htmlwidget")