Instacart

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

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/dayranoelya/Downloads/archive/aisles.csv")
#departments <-read.csv("/Users/dayranoelya/Downloads/archive/departments.csv")
order_products_prior <- read.csv("/Users/dayranoelya/Downloads/archive/order_products__prior.csv")
order_products_train <- read.csv("/Users/dayranoelya/Downloads/archive/order_products__train.csv")
#orders <- read.csv("/Users/dayranoelya/Downloads/archive/orders.csv")
products <- read.csv("/Users/dayranoelya/Downloads/archive/products.csv")
order <- rbind("order_products_prior, order_products_train")
df <- left_join(order_products_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

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/dayranoelya/Downloads/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.24s].
## sorting and recoding items ... [1813 item(s)] done [0.01s].
## creating transaction tree ... done [0.03s].
## checking subsets of size 1 2 3 4 done [0.03s].
## writing ... [1339 rule(s)] done [0.00s].
## creating S4 object  ... done [0.02s].

#summary(reglas.asociacion)
#str(reglas.asociacion)

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