Market Basket Analysis

Instalar paquetes y llamar librerías

#install.packages("tidyverse") # Paquete para manipulación de datos
library(tidyverse)

## Warning: package 'ggplot2' was built under R version 4.3.2

## Warning: package 'tidyr' was built under R version 4.3.2

## Warning: package 'purrr' was built under R version 4.3.3

## Warning: package 'lubridate' was built under R version 4.3.3

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── 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("dplyr")
library(dplyr)
# install.packages("lubridate")
library(lubridate)
#install.packages("Matrix")
library(Matrix)

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

#install.packages("arules")
library(arules)

## Warning: package 'arules' was built under R version 4.3.3

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

#install.packages("datasets")
library(datasets)
#install.packages("arulesViz")
library(arulesViz)

## Warning: package 'arulesViz' was built under R version 4.3.2

#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, failwith, id, mutate, rename, summarise,
##     summarize
## 
## The following object is masked from 'package:purrr':
## 
##     compact

Importar base de datos

bd <- read_csv("~/Desktop/Bootcamp R/abarrotes.csv")

## Rows: 200625 Columns: 22
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (12): vcClaveTienda, DescGiro, Fecha, Marca, Fabricante, Producto, Nomb...
## dbl   (7): Codigo Barras, PLU, Precio, Ult.Costo, Unidades, F.Ticket, Mts 2
## time  (3): Hora, Hora inicio, Hora cierre
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

summary(bd)

##  vcClaveTienda        DescGiro         Codigo Barras            PLU        
##  Length:200625      Length:200625      Min.   :8.347e+05   Min.   : 1.00   
##  Class :character   Class :character   1st Qu.:7.501e+12   1st Qu.: 1.00   
##  Mode  :character   Mode  :character   Median :7.501e+12   Median : 1.00   
##                                        Mean   :5.950e+12   Mean   : 2.11   
##                                        3rd Qu.:7.501e+12   3rd Qu.: 1.00   
##                                        Max.   :1.750e+13   Max.   :30.00   
##                                                            NA's   :199188  
##     Fecha               Hora             Marca            Fabricante       
##  Length:200625      Length:200625     Length:200625      Length:200625     
##  Class :character   Class1:hms        Class :character   Class :character  
##  Mode  :character   Class2:difftime   Mode  :character   Mode  :character  
##                     Mode  :numeric                                         
##                                                                            
##                                                                            
##                                                                            
##    Producto             Precio          Ult.Costo         Unidades     
##  Length:200625      Min.   :-147.00   Min.   :  0.38   Min.   : 0.200  
##  Class :character   1st Qu.:  11.00   1st Qu.:  8.46   1st Qu.: 1.000  
##  Mode  :character   Median :  16.00   Median : 12.31   Median : 1.000  
##                     Mean   :  19.42   Mean   : 15.31   Mean   : 1.262  
##                     3rd Qu.:  25.00   3rd Qu.: 19.23   3rd Qu.: 1.000  
##                     Max.   :1000.00   Max.   :769.23   Max.   :96.000  
##                                                                        
##     F.Ticket      NombreDepartamento NombreFamilia      NombreCategoria   
##  Min.   :     1   Length:200625      Length:200625      Length:200625     
##  1st Qu.: 33964   Class :character   Class :character   Class :character  
##  Median :105993   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :193990                                                           
##  3rd Qu.:383005                                                           
##  Max.   :450040                                                           
##                                                                           
##     Estado              Mts 2      Tipo ubicación         Giro          
##  Length:200625      Min.   :47.0   Length:200625      Length:200625     
##  Class :character   1st Qu.:53.0   Class :character   Class :character  
##  Mode  :character   Median :60.0   Mode  :character   Mode  :character  
##                     Mean   :56.6                                        
##                     3rd Qu.:60.0                                        
##                     Max.   :62.0                                        
##                                                                         
##  Hora inicio       Hora cierre      
##  Length:200625     Length:200625    
##  Class1:hms        Class1:hms       
##  Class2:difftime   Class2:difftime  
##  Mode  :numeric    Mode  :numeric   
##                                     
##                                     
## 

str(bd)

## spc_tbl_ [200,625 × 22] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ vcClaveTienda     : chr [1:200625] "MX001" "MX001" "MX001" "MX001" ...
##  $ DescGiro          : chr [1:200625] "Abarrotes" "Abarrotes" "Abarrotes" "Abarrotes" ...
##  $ Codigo Barras     : num [1:200625] 7.5e+12 7.5e+12 7.5e+12 7.5e+12 7.5e+12 ...
##  $ PLU               : num [1:200625] NA NA NA NA NA NA NA NA NA NA ...
##  $ Fecha             : chr [1:200625] "19/06/2020" "19/06/2020" "19/06/2020" "19/06/2020" ...
##  $ Hora              : 'hms' num [1:200625] 08:16:21 08:23:33 08:24:33 08:24:33 ...
##   ..- attr(*, "units")= chr "secs"
##  $ Marca             : chr [1:200625] "NUTRI LECHE" "DAN UP" "BIMBO" "PEPSI" ...
##  $ Fabricante        : chr [1:200625] "MEXILAC" "DANONE DE MEXICO" "GRUPO BIMBO" "PEPSI-COLA MEXICANA" ...
##  $ Producto          : chr [1:200625] "Nutri Leche 1 Litro" "DANUP STRAWBERRY P/BEBER 350GR NAL" "Rebanadas Bimbo 2Pz" "Pepsi N.R. 400Ml" ...
##  $ Precio            : num [1:200625] 16 14 5 8 19.5 16 14 5 8 19.5 ...
##  $ Ult.Costo         : num [1:200625] 12.3 14 5 8 15 ...
##  $ Unidades          : num [1:200625] 1 1 1 1 1 1 1 1 1 1 ...
##  $ F.Ticket          : num [1:200625] 1 2 3 3 4 1 2 3 3 4 ...
##  $ NombreDepartamento: chr [1:200625] "Abarrotes" "Abarrotes" "Abarrotes" "Abarrotes" ...
##  $ NombreFamilia     : chr [1:200625] "Lacteos y Refrigerados" "Lacteos y Refrigerados" "Pan y Tortilla" "Bebidas" ...
##  $ NombreCategoria   : chr [1:200625] "Leche" "Yogurt" "Pan Dulce Empaquetado" "Refrescos Plástico (N.R.)" ...
##  $ Estado            : chr [1:200625] "Nuevo León" "Nuevo León" "Nuevo León" "Nuevo León" ...
##  $ Mts 2             : num [1:200625] 60 60 60 60 60 60 60 60 60 60 ...
##  $ Tipo ubicación    : chr [1:200625] "Esquina" "Esquina" "Esquina" "Esquina" ...
##  $ Giro              : chr [1:200625] "Abarrotes" "Abarrotes" "Abarrotes" "Abarrotes" ...
##  $ Hora inicio       : 'hms' num [1:200625] 08:00:00 08:00:00 08:00:00 08:00:00 ...
##   ..- attr(*, "units")= chr "secs"
##  $ Hora cierre       : 'hms' num [1:200625] 22:00:00 22:00:00 22:00:00 22:00:00 ...
##   ..- attr(*, "units")= chr "secs"
##  - attr(*, "spec")=
##   .. cols(
##   ..   vcClaveTienda = col_character(),
##   ..   DescGiro = col_character(),
##   ..   `Codigo Barras` = col_double(),
##   ..   PLU = col_double(),
##   ..   Fecha = col_character(),
##   ..   Hora = col_time(format = ""),
##   ..   Marca = col_character(),
##   ..   Fabricante = col_character(),
##   ..   Producto = col_character(),
##   ..   Precio = col_double(),
##   ..   Ult.Costo = col_double(),
##   ..   Unidades = col_double(),
##   ..   F.Ticket = col_double(),
##   ..   NombreDepartamento = col_character(),
##   ..   NombreFamilia = col_character(),
##   ..   NombreCategoria = col_character(),
##   ..   Estado = col_character(),
##   ..   `Mts 2` = col_double(),
##   ..   `Tipo ubicación` = col_character(),
##   ..   Giro = col_character(),
##   ..   `Hora inicio` = col_time(format = ""),
##   ..   `Hora cierre` = col_time(format = "")
##   .. )
##  - attr(*, "problems")=<externalptr>

head(bd, n=10)

## # A tibble: 10 × 22
##    vcClaveTienda DescGiro  `Codigo Barras`   PLU Fecha Hora     Marca Fabricante
##    <chr>         <chr>               <dbl> <dbl> <chr> <time>   <chr> <chr>     
##  1 MX001         Abarrotes   7501020540666    NA 19/0… 08:16:21 NUTR… MEXILAC   
##  2 MX001         Abarrotes   7501032397906    NA 19/0… 08:23:33 DAN … DANONE DE…
##  3 MX001         Abarrotes   7501000112845    NA 19/0… 08:24:33 BIMBO GRUPO BIM…
##  4 MX001         Abarrotes   7501031302741    NA 19/0… 08:24:33 PEPSI PEPSI-COL…
##  5 MX001         Abarrotes   7501026027543    NA 19/0… 08:26:28 BLAN… FABRICA D…
##  6 MX001         Abarrotes   7501020540666    NA 19/0… 08:16:21 NUTR… MEXILAC   
##  7 MX001         Abarrotes   7501032397906    NA 19/0… 08:23:33 DAN … DANONE DE…
##  8 MX001         Abarrotes   7501000112845    NA 19/0… 08:24:33 BIMBO GRUPO BIM…
##  9 MX001         Abarrotes   7501031302741    NA 19/0… 08:24:33 PEPSI PEPSI-COL…
## 10 MX001         Abarrotes   7501026027543    NA 19/0… 08:26:28 BLAN… FABRICA D…
## # ℹ 14 more variables: Producto <chr>, Precio <dbl>, Ult.Costo <dbl>,
## #   Unidades <dbl>, F.Ticket <dbl>, NombreDepartamento <chr>,
## #   NombreFamilia <chr>, NombreCategoria <chr>, Estado <chr>, `Mts 2` <dbl>,
## #   `Tipo ubicación` <chr>, Giro <chr>, `Hora inicio` <time>,
## #   `Hora cierre` <time>

tail(bd, n=10)

## # A tibble: 10 × 22
##    vcClaveTienda DescGiro `Codigo Barras`   PLU Fecha  Hora     Marca Fabricante
##    <chr>         <chr>              <dbl> <dbl> <chr>  <time>   <chr> <chr>     
##  1 MX005         Depósito   7622210464811    NA 07/08… 19:30:13 TRID… CADBURY A…
##  2 MX005         Depósito   7622210464811    NA 25/07… 18:42:24 TRID… CADBURY A…
##  3 MX005         Depósito   7622210464811    NA 18/07… 22:45:58 TRID… CADBURY A…
##  4 MX005         Depósito   7622210464811    NA 12/07… 00:36:34 TRID… CADBURY A…
##  5 MX005         Depósito   7622210464811    NA 12/07… 01:08:25 TRID… CADBURY A…
##  6 MX005         Depósito   7622210464811    NA 23/10… 22:17:37 TRID… CADBURY A…
##  7 MX005         Depósito   7622210464811    NA 10/10… 20:30:20 TRID… CADBURY A…
##  8 MX005         Depósito   7622210464811    NA 10/10… 22:40:43 TRID… CADBURY A…
##  9 MX005         Depósito   7622210464811    NA 27/06… 22:30:19 TRID… CADBURY A…
## 10 MX005         Depósito   7622210464811    NA 26/06… 23:43:34 TRID… CADBURY A…
## # ℹ 14 more variables: Producto <chr>, Precio <dbl>, Ult.Costo <dbl>,
## #   Unidades <dbl>, F.Ticket <dbl>, NombreDepartamento <chr>,
## #   NombreFamilia <chr>, NombreCategoria <chr>, Estado <chr>, `Mts 2` <dbl>,
## #   `Tipo ubicación` <chr>, Giro <chr>, `Hora inicio` <time>,
## #   `Hora cierre` <time>

Entender la base de datos

#count(bd,vcClaveTienda, sort= TRUE)
#count(bd,DescGiro, sort= TRUE)
#count(bd, Fecha, sort= TRUE)
#count(bd,Marca, sort= TRUE)
#count(bd,Fabricante, sort= TRUE)
#count(bd,Producto, sort= TRUE)
#count(bd,NombreDepartamento, sort= TRUE)
#count(bd,NombreFamilia, sort= TRUE)
#count(bd,NombreCategoria, sort= TRUE)
#count(bd,Estado, sort= TRUE)
#count(bd,`Tipo ubicación`, sort= TRUE)
#count(bd,Giro, sort= TRUE)

Limpiar la base de datos

Técnica 1. Remover valores irrelevantes

bd1 <- bd
bd1 <- subset(bd1, select = -c(PLU,`Codigo Barras`))

# Eliminar renglones
bd2 <- bd1
bd2 <- bd2[bd2$Precio >0, ]
summary(bd1$Precio)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -147.00   11.00   16.00   19.42   25.00 1000.00

summary(bd2$Precio)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.50   11.00   16.00   19.45   25.00 1000.00

Técnica 2. Remover valores duplicados

# Cuántos rengoles duplicados tenemos?
sum(duplicated(bd2))

## [1] 5

# Cuáles son los renglones duplicados?
bd2[duplicated(bd2),]

## # A tibble: 5 × 20
##   vcClaveTienda DescGiro  Fecha      Hora     Marca   Fabricante Producto Precio
##   <chr>         <chr>     <chr>      <time>   <chr>   <chr>      <chr>     <dbl>
## 1 MX001         Abarrotes 19/06/2020 08:16:21 NUTRI … MEXILAC    Nutri L…   16  
## 2 MX001         Abarrotes 19/06/2020 08:23:33 DAN UP  DANONE DE… DANUP S…   14  
## 3 MX001         Abarrotes 19/06/2020 08:24:33 BIMBO   GRUPO BIM… Rebanad…    5  
## 4 MX001         Abarrotes 19/06/2020 08:24:33 PEPSI   PEPSI-COL… Pepsi N…    8  
## 5 MX001         Abarrotes 19/06/2020 08:26:28 BLANCA… FABRICA D… Deterge…   19.5
## # ℹ 12 more variables: Ult.Costo <dbl>, Unidades <dbl>, F.Ticket <dbl>,
## #   NombreDepartamento <chr>, NombreFamilia <chr>, NombreCategoria <chr>,
## #   Estado <chr>, `Mts 2` <dbl>, `Tipo ubicación` <chr>, Giro <chr>,
## #   `Hora inicio` <time>, `Hora cierre` <time>

# Eliminar renglones duplicados
bd3 <- bd2
bd3 <- distinct(bd3)

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

# Cantidades en enteros
bd4 <- bd3
bd4$Unidades <- ceiling(bd4$Unidades)

Técnica 4. Convertir tipos de datos

# Convertir de caracter a fecha
bd5 <- bd4
bd5$Fecha <- as.Date(bd5$Fecha, format = "%d/%m/%Y")


# Convertir de caracter a entero
bd6 <- bd5
bd6$Hora <- substr(bd6$Hora, start=1, stop=2)
bd6$Hora <- as.integer(bd6$Hora)

Técnica 5. Reemplazar valores faltantes

# Cuántos NAs tengo en la base de datos
sum(is.na(bd6))

## [1] 0

sum(is.na(bd))

## [1] 199188

# Cuántos NAs tengo por variable?
sapply(bd, function(x) sum(is.na(x)))

##      vcClaveTienda           DescGiro      Codigo Barras                PLU 
##                  0                  0                  0             199188 
##              Fecha               Hora              Marca         Fabricante 
##                  0                  0                  0                  0 
##           Producto             Precio          Ult.Costo           Unidades 
##                  0                  0                  0                  0 
##           F.Ticket NombreDepartamento      NombreFamilia    NombreCategoria 
##                  0                  0                  0                  0 
##             Estado              Mts 2     Tipo ubicación               Giro 
##                  0                  0                  0                  0 
##        Hora inicio        Hora cierre 
##                  0                  0

# Opción 1. Borrar todos los NAs de una tabla
# bd1 <- na.omit(bd) - borra todos los NAs de una tabla (filas)

# Opción 2. Reemplazar los NAs con Ceros
# bd1 <- bd
# bd1[is.na(bd1)] <- 0

# Opción 3. Reemplazar los NAs con el Promedio
# bd1 <- bd
# bd1$PLU[is.na(bd1$PLU)]<- mean(bd1$PLU, na.rm=TRUE)

Técnica 6. Correciones por métodos estadísticos

boxplot(bd6$Precio, horizontal = TRUE)

boxplot(bd6$Unidades, horizontal = TRUE)

Agregar columnas

# Agregar día de la semana
bd6$Dia_Semana <- wday(bd6$Fecha)

# Agregar el subtotal de la Venta
bd6$Subtotal <- bd6$Precio*bd6$Unidades

Exportar la base de datos

# write.csv(bd6, file="abarrotes_limpia.csv", row.names= FALSE)

Generar Market Basket Analysis

# Ordenar de menos a mayor la columna Ticket
bd7<-bd6
bd7<-bd7[order(bd7$F.Ticket), ]

# Generar el canasto
basket<-ddply(bd7,c("F.Ticket"),function(bd7)paste(bd7$Marca,collapse=","))

# Eliminar la columna Ticket 
basket$F.Ticket<-NULL

#Renombrar nombre de columna o Mrac 
colnames(basket)<-c("Marca")

#Exportar basket
#write.csv(basket, file="basket1.csv", row.names= FALSE)

# Importar la base de transacciones
#file.choose()
#tr <- read.transactions("/Users/yessicaacosta/Desktop/Bootcamp R/basket1.csv", format="basket")
#summary(tr)
#reglas.asociacion <- apriori(tr, parameter = list(supp=0.001, conf=0.1))
#summary(reglas.asociacion)
#inspect(reglas.asociacion)

# Ordenar reglas de asociación
#reglas.asociacion <- sort(reglas.asociacion, by= "confidence", decreasing= "TRUE")

# Graficar TOP10 de reglas de asociación
#plot(reglas.asociacion, method="graph", engine="htmlwidget")

Conclusion

Dentro de este ejercicios comenzamos haciendo una limpieza de la base de datos, para después manipularla para generar un análisis del negocio. Si bien al final no se logró hacer ebn código las asociaciones entre las diferentes categorías, al ver la imagen podemos entender la relación que existe entre ellas. Es útil e importante realizar este tipo de ejercicios para tener un mayor entendimiento del negocio y poder generar estrategias a raíz de los diferentes hallazgos.