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 bojetivo inicial 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 asociación son:

  • Confidence (Confianza): Probabilidad de comprar B sabiendo que se compro A. Ej. Pan –> Mantequilla 0.8 de cada 100 cientes que compraron pan, 80 compraron mantequilla también.
  • Lift (Elevación): Cuánto mas probable es comprar B cuando se compra A en comparación de la probabilidad de comprar B sin saber que se compro 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

El dataset de Instacart contiene información de millones de pedidos realizados por usuarios de una plataforma de comercio electrónico.

A diferencia de una base tradicional de ventas, la información se encuentra dividida en diferentes tablas relacionadas entre sí. El objetivo de este análisis es integrar las bases de datos, limpiar la información y aplicar Market Basket Analysis mediante el algoritmo Apriori para identificar productos que suelen comprarse juntos.

Estos patrones pueden utilizarse para diseñar promociones, mejorar sistemas de recomendación y apoyar decisiones de inventario.

Instalar paquetes y llamar librerías

library(tidyverse)
library(janitor)
library(arules)
library(arulesViz)

Importamos las bases de datos

orders <- read.csv("/Users/salvadorrodriguezgutierrez/Downloads/orders.csv")

prior <- read.csv("/Users/salvadorrodriguezgutierrez/Downloads/order_products__prior.csv")

products <- read.csv("/Users/salvadorrodriguezgutierrez/Downloads/products.csv")

head(orders)
##   order_id user_id eval_set order_number order_dow order_hour_of_day
## 1  2539329       1    prior            1         2                 8
## 2  2398795       1    prior            2         3                 7
## 3   473747       1    prior            3         3                12
## 4  2254736       1    prior            4         4                 7
## 5   431534       1    prior            5         4                15
## 6  3367565       1    prior            6         2                 7
##   days_since_prior_order
## 1                     NA
## 2                     15
## 3                     21
## 4                     29
## 5                     28
## 6                     19
head(prior)
##   order_id product_id add_to_cart_order reordered
## 1        2      33120                 1         1
## 2        2      28985                 2         1
## 3        2       9327                 3         0
## 4        2      45918                 4         1
## 5        2      30035                 5         0
## 6        2      17794                 6         1
head(products)
##   product_id                                                      product_name
## 1          1                                        Chocolate Sandwich Cookies
## 2          2                                                  All-Seasons Salt
## 3          3                              Robust Golden Unsweetened Oolong Tea
## 4          4 Smart Ones Classic Favorites Mini Rigatoni With Vodka Cream Sauce
## 5          5                                         Green Chile Anytime Sauce
## 6          6                                                      Dry Nose Oil
##   aisle_id department_id
## 1       61            19
## 2      104            13
## 3       94             7
## 4       38             1
## 5        5            13
## 6       11            11
str(orders)
## 'data.frame':    3421083 obs. of  7 variables:
##  $ order_id              : int  2539329 2398795 473747 2254736 431534 3367565 550135 3108588 2295261 2550362 ...
##  $ user_id               : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ eval_set              : chr  "prior" "prior" "prior" "prior" ...
##  $ order_number          : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ order_dow             : int  2 3 3 4 4 2 1 1 1 4 ...
##  $ order_hour_of_day     : int  8 7 12 7 15 7 9 14 16 8 ...
##  $ days_since_prior_order: num  NA 15 21 29 28 19 20 14 0 30 ...
str(prior)
## 'data.frame':    32434489 obs. of  4 variables:
##  $ order_id         : int  2 2 2 2 2 2 2 2 2 3 ...
##  $ product_id       : int  33120 28985 9327 45918 30035 17794 40141 1819 43668 33754 ...
##  $ add_to_cart_order: int  1 2 3 4 5 6 7 8 9 1 ...
##  $ reordered        : int  1 1 0 1 0 1 1 1 0 1 ...
str(products)
## 'data.frame':    49688 obs. of  4 variables:
##  $ product_id   : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ product_name : chr  "Chocolate Sandwich Cookies" "All-Seasons Salt" "Robust Golden Unsweetened Oolong Tea" "Smart Ones Classic Favorites Mini Rigatoni With Vodka Cream Sauce" ...
##  $ aisle_id     : int  61 104 94 38 5 11 98 116 120 115 ...
##  $ department_id: int  19 13 7 1 13 11 7 1 16 7 ...

Análisis inicial de las bases de datos

# Número de usuarios
n_distinct(orders$user_id)
## [1] 206209
# Número de pedidos
n_distinct(orders$order_id)
## [1] 3421083
# Número de productos
n_distinct(products$product_id)
## [1] 49688
# Revisar los tipos de conjunto en orders
dplyr::count(orders, eval_set, sort = TRUE)
##   eval_set       n
## 1    prior 3214874
## 2    train  131209
## 3     test   75000
# Revisar si los productos fueron recomprados
dplyr::count(prior, reordered, sort = TRUE)
##   reordered        n
## 1         1 19126536
## 2         0 13307953

Integramos las bases de datos

df <- prior %>%
  left_join(products, by = "product_id")

# Revisar que la unión funcionó
head(df, 10)
##    order_id product_id add_to_cart_order reordered
## 1         2      33120                 1         1
## 2         2      28985                 2         1
## 3         2       9327                 3         0
## 4         2      45918                 4         1
## 5         2      30035                 5         0
## 6         2      17794                 6         1
## 7         2      40141                 7         1
## 8         2       1819                 8         1
## 9         2      43668                 9         0
## 10        3      33754                 1         1
##                                             product_name aisle_id department_id
## 1                                     Organic Egg Whites       86            16
## 2                                  Michigan Organic Kale       83             4
## 3                                          Garlic Powder      104            13
## 4                                         Coconut Butter       19            13
## 5                                      Natural Sweetener       17            13
## 6                                                Carrots       83             4
## 7                       Original Unflavored Gelatine Mix      105            13
## 8               All Natural No Stir Creamy Almond Butter       88            13
## 9                                Classic Blend Cole Slaw      123             4
## 10 Total 2% with Strawberry Lowfat Greek Strained Yogurt      120            16
# Revisar la estructura de la nueva base
str(df)
## 'data.frame':    32434489 obs. of  7 variables:
##  $ order_id         : int  2 2 2 2 2 2 2 2 2 3 ...
##  $ product_id       : int  33120 28985 9327 45918 30035 17794 40141 1819 43668 33754 ...
##  $ add_to_cart_order: int  1 2 3 4 5 6 7 8 9 1 ...
##  $ reordered        : int  1 1 0 1 0 1 1 1 0 1 ...
##  $ product_name     : chr  "Organic Egg Whites" "Michigan Organic Kale" "Garlic Powder" "Coconut Butter" ...
##  $ aisle_id         : int  86 83 104 19 17 83 105 88 123 120 ...
##  $ department_id    : int  16 4 13 13 13 4 13 13 4 16 ...

Limpieza de los datos

# Revisar valores faltantes
# colSums(is.na(df))

# Revisar filas duplicadas
# sum(duplicated(df))

# Eliminar duplicados
# df <- distinct(df)

# Eliminar registros sin nombre de producto
# df <- df %>%
#  filter(!is.na(product_name))

# Revisar nuevamente
# colSums(is.na(df))
# sum(duplicated(df))
LS0tCnRpdGxlOiAiTWFya2V0IEJhc2tldCBBbmFseXNpcyAtIEluc3RhY2FydCIKYXV0aG9yOiAiU2FsdmFkb3IgUm9kcmlndWV6IEEwMDgzNzg2MyIKZGF0ZTogIjIwMjYtMDgtMTkiCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKICAgIHRoZW1lOiBjb3NtbwotLS0KCiMgW1Rlb3LDrWFde3N0eWxlPSJjb2xvcjogcmVkIn0KCkVsICoqTWFya2V0IEJhc2tldCBBbmFseXNpcyoqIGVzIHVuYSB0w6ljbmljYSBlbiBlbCDDoW1iaXRvIGRlIGFuw6FsaXNpcyB5IG1pbmVyw61hIGRlIGRhdG9zIGVuIGVsIGNhbXBvIGRlbCBjb21lcmNpby4gU3UgYm9qZXRpdm8gaW5pY2lhbCBlcyBkZXNjdWJyaXIgcGF0cm9uZXMgZGUgYXNvY2lhY2nDs24gZW50cmUgcHJvZHVjdG9zIHF1ZSBzdWVsZW4gc2VyIGNvbXByYWRvcyBqdW50b3MgcG9yIGxvcyBjbGllbnRlcy4KCkxhcyAzIG3DqXRyaWNhcyBwcmluY2lwYWxlcyBwYXJhIGV2YWx1YXIgcmVnbGFzIGRlIGFzb2NpYWNpw7NuIHNvbjoKCi0gKkNvbmZpZGVuY2UqIChDb25maWFuemEpOiBQcm9iYWJpbGlkYWQgZGUgY29tcHJhciBCIHNhYmllbmRvIHF1ZSBzZSBjb21wcm8gQS4gRWouIFBhbiAtLVw+IE1hbnRlcXVpbGxhIDAuOCBkZSBjYWRhIDEwMCBjaWVudGVzIHF1ZSBjb21wcmFyb24gcGFuLCA4MCBjb21wcmFyb24gbWFudGVxdWlsbGEgdGFtYmnDqW4uCi0gKkxpZnQqIChFbGV2YWNpw7NuKTogQ3XDoW50byBtYXMgcHJvYmFibGUgZXMgY29tcHJhciBCIGN1YW5kbyBzZSBjb21wcmEgQSBlbiBjb21wYXJhY2nDs24gZGUgbGEgcHJvYmFiaWxpZGFkIGRlIGNvbXByYXIgQiBzaW4gc2FiZXIgcXVlIHNlIGNvbXBybyBBLiBFai4gTGlmdCBcPiAxIENvbXByYSBBIGltcHVsc2EgQi4gTGlmdCA9IDEgTm8gdGllbmVuIHJlbGFjacOzbiBkZSBjb21wcmEuIExpZnQgXDwgMSBBIHJlZHVjZSBsYSBjb21wcmEgZGUgQi4KLSAqU3VwcG9ydCogKFNvcG9ydGUpOiBQb3B1bGFyaWRhZCBkZWwgcHJvZHVjdG8gZGVudHJvIGRlIGxhcyB0cmFuc2FjY2lvbmVzLiBFai4gUGFuIHkgTWFudGVxdWlsbGEgMC4wNSBFbCA1JSBkZSB0b2RhcyBsYXMgdHJhbnNhY2Npb25lcyBjb21wcmFyb24gZXN0b3MgZG9zIHByb2R1Y3RvcyBqdW50b3MKCiMgW0NvbnRleHRvXXtzdHlsZT0iY29sb3I6IHJlZCJ9CgpFbCBkYXRhc2V0IGRlIEluc3RhY2FydCBjb250aWVuZSBpbmZvcm1hY2nDs24gZGUgbWlsbG9uZXMgZGUgcGVkaWRvcyByZWFsaXphZG9zIHBvciB1c3VhcmlvcyBkZSB1bmEgcGxhdGFmb3JtYSBkZSBjb21lcmNpbyBlbGVjdHLDs25pY28uCgpBIGRpZmVyZW5jaWEgZGUgdW5hIGJhc2UgdHJhZGljaW9uYWwgZGUgdmVudGFzLCBsYSBpbmZvcm1hY2nDs24gc2UgZW5jdWVudHJhIGRpdmlkaWRhIGVuIGRpZmVyZW50ZXMgdGFibGFzIHJlbGFjaW9uYWRhcyBlbnRyZSBzw60uIEVsIG9iamV0aXZvIGRlIGVzdGUgYW7DoWxpc2lzIGVzIGludGVncmFyIGxhcyBiYXNlcyBkZSBkYXRvcywgbGltcGlhciBsYSBpbmZvcm1hY2nDs24geSBhcGxpY2FyIE1hcmtldCBCYXNrZXQgQW5hbHlzaXMgbWVkaWFudGUgZWwgYWxnb3JpdG1vIEFwcmlvcmkgcGFyYSBpZGVudGlmaWNhciBwcm9kdWN0b3MgcXVlIHN1ZWxlbiBjb21wcmFyc2UganVudG9zLgoKRXN0b3MgcGF0cm9uZXMgcHVlZGVuIHV0aWxpemFyc2UgcGFyYSBkaXNlw7FhciBwcm9tb2Npb25lcywgbWVqb3JhciBzaXN0ZW1hcyBkZSByZWNvbWVuZGFjacOzbiB5IGFwb3lhciBkZWNpc2lvbmVzIGRlIGludmVudGFyaW8uCgojIFtJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzXXtzdHlsZT0iY29sb3I6IHJlZCJ9CgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQoKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoamFuaXRvcikKbGlicmFyeShhcnVsZXMpCmxpYnJhcnkoYXJ1bGVzVml6KQpgYGAKCiMgW0ltcG9ydGFtb3MgbGFzIGJhc2VzIGRlIGRhdG9zXXtzdHlsZT0iY29sb3I6IHJlZCJ9CgpgYGB7cn0Kb3JkZXJzIDwtIHJlYWQuY3N2KCIvVXNlcnMvc2FsdmFkb3Jyb2RyaWd1ZXpndXRpZXJyZXovRG93bmxvYWRzL29yZGVycy5jc3YiKQoKcHJpb3IgPC0gcmVhZC5jc3YoIi9Vc2Vycy9zYWx2YWRvcnJvZHJpZ3Vlemd1dGllcnJlei9Eb3dubG9hZHMvb3JkZXJfcHJvZHVjdHNfX3ByaW9yLmNzdiIpCgpwcm9kdWN0cyA8LSByZWFkLmNzdigiL1VzZXJzL3NhbHZhZG9ycm9kcmlndWV6Z3V0aWVycmV6L0Rvd25sb2Fkcy9wcm9kdWN0cy5jc3YiKQoKaGVhZChvcmRlcnMpCmhlYWQocHJpb3IpCmhlYWQocHJvZHVjdHMpCnN0cihvcmRlcnMpCnN0cihwcmlvcikKc3RyKHByb2R1Y3RzKQpgYGAKCiMgW0Fuw6FsaXNpcyBpbmljaWFsIGRlIGxhcyBiYXNlcyBkZSBkYXRvc117c3R5bGU9ImNvbG9yOiByZWQifQoKYGBge3J9CiMgTsO6bWVybyBkZSB1c3VhcmlvcwpuX2Rpc3RpbmN0KG9yZGVycyR1c2VyX2lkKQoKIyBOw7ptZXJvIGRlIHBlZGlkb3MKbl9kaXN0aW5jdChvcmRlcnMkb3JkZXJfaWQpCgojIE7Dum1lcm8gZGUgcHJvZHVjdG9zCm5fZGlzdGluY3QocHJvZHVjdHMkcHJvZHVjdF9pZCkKCiMgUmV2aXNhciBsb3MgdGlwb3MgZGUgY29uanVudG8gZW4gb3JkZXJzCmRwbHlyOjpjb3VudChvcmRlcnMsIGV2YWxfc2V0LCBzb3J0ID0gVFJVRSkKCiMgUmV2aXNhciBzaSBsb3MgcHJvZHVjdG9zIGZ1ZXJvbiByZWNvbXByYWRvcwpkcGx5cjo6Y291bnQocHJpb3IsIHJlb3JkZXJlZCwgc29ydCA9IFRSVUUpCmBgYAoKIyBbSW50ZWdyYW1vcyBsYXMgYmFzZXMgZGUgZGF0b3Nde3N0eWxlPSJjb2xvcjogcmVkIn0KCmBgYHtyfQpkZiA8LSBwcmlvciAlPiUKICBsZWZ0X2pvaW4ocHJvZHVjdHMsIGJ5ID0gInByb2R1Y3RfaWQiKQoKIyBSZXZpc2FyIHF1ZSBsYSB1bmnDs24gZnVuY2lvbsOzCmhlYWQoZGYsIDEwKQoKIyBSZXZpc2FyIGxhIGVzdHJ1Y3R1cmEgZGUgbGEgbnVldmEgYmFzZQpzdHIoZGYpCmBgYAoKIyBbTGltcGllemEgZGUgbG9zIGRhdG9zXXtzdHlsZT0iY29sb3I6IHJlZCJ9CgpgYGB7cn0KIyBSZXZpc2FyIHZhbG9yZXMgZmFsdGFudGVzCiMgY29sU3Vtcyhpcy5uYShkZikpCgojIFJldmlzYXIgZmlsYXMgZHVwbGljYWRhcwojIHN1bShkdXBsaWNhdGVkKGRmKSkKCiMgRWxpbWluYXIgZHVwbGljYWRvcwojIGRmIDwtIGRpc3RpbmN0KGRmKQoKIyBFbGltaW5hciByZWdpc3Ryb3Mgc2luIG5vbWJyZSBkZSBwcm9kdWN0bwojIGRmIDwtIGRmICU+JQojICBmaWx0ZXIoIWlzLm5hKHByb2R1Y3RfbmFtZSkpCgojIFJldmlzYXIgbnVldmFtZW50ZQojIGNvbFN1bXMoaXMubmEoZGYpKQojIHN1bShkdXBsaWNhdGVkKGRmKSkKYGBg