“Market Basket Supermercados”

---

Paso 1. Importar base de datos

#1 Ajustes a la base de datos se reemplazaron las comas por espacios.  
#2 Se separó la fecha en día y hora con sus respectivos formatos.

#file.choose()
bd1<-read.csv("C:\\Users\\danyc\\OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey\\Desktop\\Excel y CSV\\ventasfin1.csv")

Paso 2. Entender base de datos

summary(bd1)

##     BillNo            Itemname            Quantity            Date          
##  Length:522064      Length:522064      Min.   :-9600.00   Length:522064     
##  Class :character   Class :character   1st Qu.:    1.00   Class :character  
##  Mode  :character   Mode  :character   Median :    3.00   Mode  :character  
##                                        Mean   :   10.09                     
##                                        3rd Qu.:   10.00                     
##                                        Max.   :80995.00                     
##                                                                             
##      Time               Price              CustomerID       Country         
##  Length:522064      Min.   :-11062.060   Min.   :12346    Length:522064     
##  Class :character   1st Qu.:     1.250   1st Qu.:13950    Class :character  
##  Mode  :character   Median :     2.080   Median :15265    Mode  :character  
##                     Mean   :     3.827   Mean   :15317                      
##                     3rd Qu.:     4.130   3rd Qu.:16837                      
##                     Max.   : 13541.330   Max.   :18287                      
##                                          NA's   :134041

str(bd1)

## 'data.frame':    522064 obs. of  8 variables:
##  $ BillNo    : chr  "536365" "536365" "536365" "536365" ...
##  $ Itemname  : chr  "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Quantity  : int  6 6 8 6 6 2 6 6 6 32 ...
##  $ Date      : chr  "1/12/2010" "1/12/2010" "1/12/2010" "1/12/2010" ...
##  $ Time      : chr  "8:26:00" "8:26:00" "8:26:00" "8:26:00" ...
##  $ Price     : num  2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ CustomerID: int  17850 17850 17850 17850 17850 17850 17850 17850 17850 13047 ...
##  $ Country   : chr  "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...

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

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

count(bd1, Country, sort = TRUE)

##                 Country      n
## 1        United Kingdom 487622
## 2               Germany   9042
## 3                France   8408
## 4                 Spain   2485
## 5           Netherlands   2363
## 6               Belgium   2031
## 7           Switzerland   1967
## 8              Portugal   1501
## 9             Australia   1185
## 10               Norway   1072
## 11                Italy    758
## 12               Sweden    451
## 13          Unspecified    446
## 14              Austria    398
## 15               Poland    330
## 16                Japan    321
## 17               Israel    295
## 18            Hong Kong    284
## 19            Singapore    222
## 20              Iceland    182
## 21                  USA    179
## 22               Greece    145
## 23                Malta    112
## 24 United Arab Emirates     68
## 25                  RSA     58
## 26              Lebanon     45
## 27            Lithuania     35
## 28               Brazil     32
## 29              Bahrain     18
## 30         Saudi Arabia      9

Observaciones:

#1. Hay 3 tickets que inician con “A”. R:Ya #2. Hay productos con “?”. R:Ya #3. Hay cantidades negativas. R:YA #4. Fecha esta como carácter. R:Ya #5. Hora esta como carácter. R:Ya #6. Hay precios negativos. R:Ya #7. Faltan ID de clientes. R:Ya

Herramienta “El Generador de Valor de Datos”

Paso 1. Definir el área del negocio que buscamos impactar o mejorar y su KPI

El área serían directamente las ventas de nuestros productos.

Los KPI´s a impactar son:

a. Ventas de productos
b. Tamaño de las compras (Basket size)

Paso 2. Seleccionar plantilla(-s) para crear valor a partir de los datos de los clientes.

Visión / Segmentación / Personalización / Contextualización

Paso 3. Generar ideas o conceptos específicos.

Generar un analisis de datos que permitan dar entrada a la generación de ventas cruzadas dentro del mercado.

Paso 4. Reunir los datos requeridos.

Se necesita una base de datos limpia de ventas de los productos en el Supermercado que ya tenemos para depurar en este caso.

Paso 5. Plan de ejecución.

Departamento de Marketing
Generación de insights y limpieza de bases de datos para generar estratégias de cross selling channels. (Data Minning)

Departamento de Compras
Tener en stock los productos para lo que se hará con las promociones.

Departamento de gerentes de tienda
Asegurarse del posicionamiento de los productos en la tienda.

Paso 3. Limpieza de base de datos

¿Cuántos NA tengo en la base de datos?

sum(is.na(bd1))

## [1] 134041

¿Cuántos NA tengo por variable?

sapply(bd1, function(x) sum(is.na(x)))

##     BillNo   Itemname   Quantity       Date       Time      Price CustomerID 
##          0          0          0          0          0          0     134041 
##    Country 
##          0

Eliminar renglones negativos

bd2<-bd1
bd2 <- bd2[bd2$Price> 0.001, ]

summary(bd2)

##     BillNo            Itemname            Quantity           Date          
##  Length:519547      Length:519547      Min.   :    1.0   Length:519547     
##  Class :character   Class :character   1st Qu.:    1.0   Class :character  
##  Mode  :character   Mode  :character   Median :    3.0   Mode  :character  
##                                        Mean   :   10.4                     
##                                        3rd Qu.:   10.0                     
##                                        Max.   :80995.0                     
##                                                                            
##      Time               Price             CustomerID       Country         
##  Length:519547      Min.   :    0.040   Min.   :12346    Length:519547     
##  Class :character   1st Qu.:    1.250   1st Qu.:13950    Class :character  
##  Mode  :character   Median :    2.080   Median :15265    Mode  :character  
##                     Mean   :    3.888   Mean   :15317                      
##                     3rd Qu.:    4.130   3rd Qu.:16837                      
##                     Max.   :13541.330   Max.   :18287                      
##                                         NA's   :131566

Convertir de carácter a fecha

bd3<-bd2
bd3$Date <- as.Date(bd3$Date, format= "%d/%m%y")
tibble(bd3)

## # A tibble: 519,547 × 8
##    BillNo Itemname                Quant…¹ Date   Time    Price Custome…² Country
##    <chr>  <chr>                     <int> <date> <chr>   <dbl>     <int> <chr>  
##  1 536365 "WHITE HANGING HEART T…       6 NA     8:26:00  2.55     17850 United…
##  2 536365 "WHITE METAL LANTERN"         6 NA     8:26:00  3.39     17850 United…
##  3 536365 "CREAM CUPID HEARTS CO…       8 NA     8:26:00  2.75     17850 United…
##  4 536365 "KNITTED UNION FLAG HO…       6 NA     8:26:00  3.39     17850 United…
##  5 536365 "RED WOOLLY HOTTIE WHI…       6 NA     8:26:00  3.39     17850 United…
##  6 536365 "SET 7 BABUSHKA NESTIN…       2 NA     8:26:00  7.65     17850 United…
##  7 536365 "GLASS STAR FROSTED T-…       6 NA     8:26:00  4.25     17850 United…
##  8 536366 "HAND WARMER UNION JAC…       6 NA     8:28:00  1.85     17850 United…
##  9 536366 "HAND WARMER RED POLKA…       6 NA     8:28:00  1.85     17850 United…
## 10 536367 "ASSORTED COLOUR BIRD …      32 NA     8:34:00  1.69     13047 United…
## # … with 519,537 more rows, and abbreviated variable names ¹​Quantity,
## #   ²​CustomerID

Convertir de caracteres a enteros

bd4<-bd3
bd4$Date.1 <- substr(bd4$Date, start = 1, stop=2)
tibble(bd4)

## # A tibble: 519,547 × 9
##    BillNo Itemname         Quant…¹ Date   Time    Price Custome…² Country Date.1
##    <chr>  <chr>              <int> <date> <chr>   <dbl>     <int> <chr>   <chr> 
##  1 536365 "WHITE HANGING …       6 NA     8:26:00  2.55     17850 United… <NA>  
##  2 536365 "WHITE METAL LA…       6 NA     8:26:00  3.39     17850 United… <NA>  
##  3 536365 "CREAM CUPID HE…       8 NA     8:26:00  2.75     17850 United… <NA>  
##  4 536365 "KNITTED UNION …       6 NA     8:26:00  3.39     17850 United… <NA>  
##  5 536365 "RED WOOLLY HOT…       6 NA     8:26:00  3.39     17850 United… <NA>  
##  6 536365 "SET 7 BABUSHKA…       2 NA     8:26:00  7.65     17850 United… <NA>  
##  7 536365 "GLASS STAR FRO…       6 NA     8:26:00  4.25     17850 United… <NA>  
##  8 536366 "HAND WARMER UN…       6 NA     8:28:00  1.85     17850 United… <NA>  
##  9 536366 "HAND WARMER RE…       6 NA     8:28:00  1.85     17850 United… <NA>  
## 10 536367 "ASSORTED COLOU…      32 NA     8:34:00  1.69     13047 United… <NA>  
## # … with 519,537 more rows, and abbreviated variable names ¹​Quantity,
## #   ²​CustomerID

bd4$Date.1<- as.integer(bd4$Date.1)
tibble(bd4)

## # A tibble: 519,547 × 9
##    BillNo Itemname         Quant…¹ Date   Time    Price Custome…² Country Date.1
##    <chr>  <chr>              <int> <date> <chr>   <dbl>     <int> <chr>    <int>
##  1 536365 "WHITE HANGING …       6 NA     8:26:00  2.55     17850 United…     NA
##  2 536365 "WHITE METAL LA…       6 NA     8:26:00  3.39     17850 United…     NA
##  3 536365 "CREAM CUPID HE…       8 NA     8:26:00  2.75     17850 United…     NA
##  4 536365 "KNITTED UNION …       6 NA     8:26:00  3.39     17850 United…     NA
##  5 536365 "RED WOOLLY HOT…       6 NA     8:26:00  3.39     17850 United…     NA
##  6 536365 "SET 7 BABUSHKA…       2 NA     8:26:00  7.65     17850 United…     NA
##  7 536365 "GLASS STAR FRO…       6 NA     8:26:00  4.25     17850 United…     NA
##  8 536366 "HAND WARMER UN…       6 NA     8:28:00  1.85     17850 United…     NA
##  9 536366 "HAND WARMER RE…       6 NA     8:28:00  1.85     17850 United…     NA
## 10 536367 "ASSORTED COLOU…      32 NA     8:34:00  1.69     13047 United…     NA
## # … with 519,537 more rows, and abbreviated variable names ¹​Quantity,
## #   ²​CustomerID

Ordenar de menor a mayor los tickets

bd5<-bd4[order(bd4$BillNo),]
tail(bd5)

##         BillNo                        Itemname Quantity Date     Time    Price
## 522060  581587     PACK OF 20 SPACEBOY NAPKINS       12 <NA> 12:50:00     0.85
## 522061  581587     CHILDREN'S APRON DOLLY GIRL        6 <NA> 12:50:00     2.10
## 522062  581587    CHILDRENS CUTLERY DOLLY GIRL        4 <NA> 12:50:00     4.15
## 522063  581587 CHILDRENS CUTLERY CIRCUS PARADE        4 <NA> 12:50:00     4.15
## 522064  581587    BAKING SET 9 PIECE RETROSPOT        3 <NA> 12:50:00     4.95
## 288773 A563185                 Adjust bad debt        1 <NA> 14:50:00 11062.06
##        CustomerID        Country Date.1
## 522060      12680         France     NA
## 522061      12680         France     NA
## 522062      12680         France     NA
## 522063      12680         France     NA
## 522064      12680         France     NA
## 288773         NA United Kingdom     NA

Eliminar renglones

bd6<-bd5
bd6<-bd6[bd6$BillNo < 581588,]
summary(bd1)

##     BillNo            Itemname            Quantity            Date          
##  Length:522064      Length:522064      Min.   :-9600.00   Length:522064     
##  Class :character   Class :character   1st Qu.:    1.00   Class :character  
##  Mode  :character   Mode  :character   Median :    3.00   Mode  :character  
##                                        Mean   :   10.09                     
##                                        3rd Qu.:   10.00                     
##                                        Max.   :80995.00                     
##                                                                             
##      Time               Price              CustomerID       Country         
##  Length:522064      Min.   :-11062.060   Min.   :12346    Length:522064     
##  Class :character   1st Qu.:     1.250   1st Qu.:13950    Class :character  
##  Mode  :character   Median :     2.080   Median :15265    Mode  :character  
##                     Mean   :     3.827   Mean   :15317                      
##                     3rd Qu.:     4.130   3rd Qu.:16837                      
##                     Max.   : 13541.330   Max.   :18287                      
##                                          NA's   :134041

tail(bd6)

##        BillNo                        Itemname Quantity Date     Time Price
## 522059 581587      CHILDRENS CUTLERY SPACEBOY        4 <NA> 12:50:00  4.15
## 522060 581587     PACK OF 20 SPACEBOY NAPKINS       12 <NA> 12:50:00  0.85
## 522061 581587     CHILDREN'S APRON DOLLY GIRL        6 <NA> 12:50:00  2.10
## 522062 581587    CHILDRENS CUTLERY DOLLY GIRL        4 <NA> 12:50:00  4.15
## 522063 581587 CHILDRENS CUTLERY CIRCUS PARADE        4 <NA> 12:50:00  4.15
## 522064 581587    BAKING SET 9 PIECE RETROSPOT        3 <NA> 12:50:00  4.95
##        CustomerID Country Date.1
## 522059      12680  France     NA
## 522060      12680  France     NA
## 522061      12680  France     NA
## 522062      12680  France     NA
## 522063      12680  France     NA
## 522064      12680  France     NA

Convertir tickets de caracter a entero

bd7<- bd6
bd7$BillNo <- as.integer(bd7$BillNo)
tibble(bd7)

## # A tibble: 519,546 × 9
##    BillNo Itemname         Quant…¹ Date   Time    Price Custome…² Country Date.1
##     <int> <chr>              <int> <date> <chr>   <dbl>     <int> <chr>    <int>
##  1 536365 "WHITE HANGING …       6 NA     8:26:00  2.55     17850 United…     NA
##  2 536365 "WHITE METAL LA…       6 NA     8:26:00  3.39     17850 United…     NA
##  3 536365 "CREAM CUPID HE…       8 NA     8:26:00  2.75     17850 United…     NA
##  4 536365 "KNITTED UNION …       6 NA     8:26:00  3.39     17850 United…     NA
##  5 536365 "RED WOOLLY HOT…       6 NA     8:26:00  3.39     17850 United…     NA
##  6 536365 "SET 7 BABUSHKA…       2 NA     8:26:00  7.65     17850 United…     NA
##  7 536365 "GLASS STAR FRO…       6 NA     8:26:00  4.25     17850 United…     NA
##  8 536366 "HAND WARMER UN…       6 NA     8:28:00  1.85     17850 United…     NA
##  9 536366 "HAND WARMER RE…       6 NA     8:28:00  1.85     17850 United…     NA
## 10 536367 "ASSORTED COLOU…      32 NA     8:34:00  1.69     13047 United…     NA
## # … with 519,536 more rows, and abbreviated variable names ¹​Quantity,
## #   ²​CustomerID

str(bd7)

## 'data.frame':    519546 obs. of  9 variables:
##  $ BillNo    : int  536365 536365 536365 536365 536365 536365 536365 536366 536366 536367 ...
##  $ Itemname  : chr  "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Quantity  : int  6 6 8 6 6 2 6 6 6 32 ...
##  $ Date      : Date, format: NA NA ...
##  $ Time      : chr  "8:26:00" "8:26:00" "8:26:00" "8:26:00" ...
##  $ Price     : num  2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ CustomerID: int  17850 17850 17850 17850 17850 17850 17850 17850 17850 13047 ...
##  $ Country   : chr  "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...
##  $ Date.1    : int  NA NA NA NA NA NA NA NA NA NA ...

Eliminar comas y puntos de los artículos

#bd8<-bd7
#bd8$Itemname<- sub(","," ", bd8$Itemname, fixed=TRUE)
#bd8$Itemname<- sub("."," ", bd8$Itemname, fixed=TRUE)
# No se usó porque los artículos tienen comas entre texto y esas no se eliminaron con este fx.

Paso 4. Generar Basket

Generar función de basket

#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

bd_limpia<-bd7
basket <- ddply(bd_limpia, c("BillNo"), function(bd_limpia)paste(bd_limpia$Itemname, collapse = ","))

Eliminar Número de Ticket

basket$BillNo<-NULL

Renombrar el nombre de la columna

colnames(basket)<- c("Articulo")

Exportar preparación de basket

#write.csv(basket, "basket.csv" , quote = FALSE, row.names = FALSE)

Importar transacciones

#install.packages("arules")
#install.packages("arulesViz")
#library(arules)
#library(arulesViz)
#library(Matrix)
#file.choose()
#tr<-read.transactions ( "C:\\Users\\danyc\\OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey\\Desktop\\basket.csv",format = "basket", sep = ",")

Generar asociaciónes

reglas.asociacion <- apriori(tr, parameter = list(supp=0.001, conf=0.8, maxlen=10))

## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport maxtime support minlen
##         0.8    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: 19 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[8583 item(s), 19559 transaction(s)] done [0.54s].
## sorting and recoding items ... [2646 item(s)] done [0.03s].
## creating transaction tree ... done [0.02s].
## checking subsets of size 1 2 3 4 5 6 7

## Warning in apriori(tr, parameter = list(supp = 0.001, conf = 0.8, maxlen = 10)):
## Mining stopped (time limit reached). Only patterns up to a length of 7 returned!

##  done [5.64s].
## writing ... [3309481 rule(s)] done [3.17s].
## creating S4 object  ... done [5.65s].

#summary(reglas.asociacion)
#inspect(reglas.asociacion)

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

Grafíca Market Basket

top10reglas <- head(reglas.asociacion, n = 10, by= "confidence")
inspect(top10reglas)

##      lhs                                    rhs                                  support confidence    coverage     lift count
## [1]  {SILVER MINI TAPE MEASURE}          => {JUMBO BAG PINK VINTAGE PAISLEY} 0.001124802          1 0.001124802 27.24095    22
## [2]  {SILVER MINI TAPE MEASURE}          => {STRAWBERRY CHARLOTTE BAG}       0.001124802          1 0.001124802 32.32893    22
## [3]  {SILVER MINI TAPE MEASURE}          => {LUNCH BAG CARS BLUE}            0.001124802          1 0.001124802 20.24741    22
## [4]  {SILVER MINI TAPE MEASURE}          => {WOODLAND CHARLOTTE BAG}         0.001124802          1 0.001124802 28.84808    22
## [5]  {SILVER MINI TAPE MEASURE}          => {RED RETROSPOT CHARLOTTE BAG}    0.001124802          1 0.001124802 22.98355    22
## [6]  {PINK POLKADOT BOWL,                                                                                                     
##       SET/20 FRUIT SALAD PAPER NAPKINS}  => {STRAWBERRY CHARLOTTE BAG}       0.001022547          1 0.001022547 32.32893    20
## [7]  {PINK POLKADOT BOWL,                                                                                                     
##       SET/20 FRUIT SALAD PAPER NAPKINS}  => {LUNCH BAG CARS BLUE}            0.001022547          1 0.001022547 20.24741    20
## [8]  {PINK POLKADOT BOWL,                                                                                                     
##       SET/20 FRUIT SALAD PAPER NAPKINS}  => {WOODLAND CHARLOTTE BAG}         0.001022547          1 0.001022547 28.84808    20
## [9]  {PINK POLKADOT BOWL,                                                                                                     
##       SET/20 FRUIT SALAD PAPER NAPKINS}  => {RED RETROSPOT CHARLOTTE BAG}    0.001022547          1 0.001022547 22.98355    20
## [10] {SET/20 FRUIT SALAD PAPER NAPKINS,                                                                                       
##       STRAWBERRY CHARLOTTE BAG}          => {LUNCH BAG CARS BLUE}            0.001073675          1 0.001073675 20.24741    21

plot(top10reglas,method = "graph", engine ="htmlwidget")

Conclusión y Aprendizaje

Dentro de esta actividad de generación de market basket podemos definir que este es un análisis matemático que encuentra diversos tipos de patrones, en este caso en específico se analizó un supermercado y el market basket nos ayudó a ver cómo los clientes se comportan con los productos y de esta manera crear insights para la generación de promociones.

En la gráfica de nuestro Market Basket podemos observar dos fuertes asociaciones que se marcan en colores rojo fuerte (regla 2 y regla 6) lo cual nos indica que si se llegará a poner una promoción del producto correlacionado que es el “Strawberry Charlotte Bag” lo más probable es que se mueva mucho más rápido de lo normal debido a que ya es algo que está ocurriendo.

Esto se puede utilizar como gancho para comprar estos en promocion dentro del comercio en linea del super o hacer una promocion de tercias regalando un producto similar a los que se muestran en el market basket y asi aumentar tambien las ventas de dicho producto de otra marca.

Las demás relaciones también pudieran funcionar de la misma manera pero se denota una fuerza menor en las comprar teniendo como significado una correlación, en efecto pero no tan marcada como la antes mencionada.

La estrategia para este súper sería crear este market basket en general de todos los productos para ver si hay algo interesante y después adentrarse por departamentos justamente para sugerir una promoción o bien un cambio “product placement” en los estantes y juntar las reglas más marcadas para darle al cliente ese touchpoint de exposición del producto.