Proyecto Final-Supertienda

Este análisis se basa en un conjunto de datos con temática de supermercado, la dataset cuenta con información de ventas sobre pedidos de variados productos distribuidos en diferentes países de Latinoamérica, esto incluye el estado, la región, la fecha del pedido, la fecha de envío, el producto pedido, etc. El dataset además consta de un periodo de 4 años entre 2018 y 2021.

library(tidyverse)
library(DT)
library(plotly)
library(dplyr)
library(magrittr)

Objetivos

• Conocer las ventas y ganancias por País
• Región con mas Ventas
• Analizar la región sur
• Ventas por paises de la región sur
• Ventas por categorías en la región sur y porcentaje de estas ventas
• Basket análisis
• Análisis de componente principales

Estructura DataSet

##  [1] "Id de la fila"       "Id del pedido"       "Fecha del pedido"   
##  [4] "Fecha de envío"      "Método de envío"     "Id. del cliente"    
##  [7] "Nombre del cliente"  "Segmento"            "Ciudad"             
## [10] "Provincia"           "País"                "Región"             
## [13] "Id. del producto"    "Categoría"           "Subcategoría"       
## [16] "Nombre del producto" "Ventas"              "Cantidad"           
## [19] "Descuento"           "Ganancia"

## tibble [10,254 × 20] (S3: tbl_df/tbl/data.frame)
##  $ Id de la fila      : num [1:10254] 1682 5919 5920 9013 9014 ...
##  $ Id del pedido      : chr [1:10254] "MX-2021-111899" "MX-2021-113922" "MX-2021-113922" "MX-2019-163888" ...
##  $ Fecha del pedido   : POSIXct[1:10254], format: "2021-04-02" "2021-10-08" ...
##  $ Fecha de envío     : POSIXct[1:10254], format: "2021-04-06" "2021-10-11" ...
##  $ Método de envío    : chr [1:10254] "Estándar" "Rápido" "Rápido" "Estándar" ...
##  $ Id. del cliente    : chr [1:10254] "AM-11365" "BS-12130" "BS-12130" "AT-10090" ...
##  $ Nombre del cliente : chr [1:10254] "Araceli Manzanares" "Benjamín Saavedra" "Benjamín Saavedra" "Alejandro Trejo" ...
##  $ Segmento           : chr [1:10254] "Empresa" "Cliente" "Cliente" "Cliente" ...
##  $ Ciudad             : chr [1:10254] "Cruzeiro do Sul" "Rio Branco" "Rio Branco" "Rio Branco" ...
##  $ Provincia          : chr [1:10254] "Acre" "Acre" "Acre" "Acre" ...
##  $ País               : chr [1:10254] "Brasil" "Brasil" "Brasil" "Brasil" ...
##  $ Región             : chr [1:10254] "Sur" "Sur" "Sur" "Sur" ...
##  $ Id. del producto   : chr [1:10254] "MAT-AR-10004857" "MOB-LI-10000647" "MAT-CA-10002956" "MOB-MO-10002100" ...
##  $ Categoría          : chr [1:10254] "Material de oficina" "Mobiliario" "Material de oficina" "Mobiliario" ...
##  $ Subcategoría       : chr [1:10254] "Arte" "Librerías" "Carpetas" "Mobiliario" ...
##  $ Nombre del producto: chr [1:10254] "Boston Rotuladores, Tamaños variados" "Dania Conjunto de estantes, Metal" "Avery Anillas, Transparente" "Tenex Bandeja apiladora, Negro" ...
##  $ Ventas             : num [1:10254] 591 2251 129 505 3377 ...
##  $ Cantidad           : num [1:10254] 3 2 5 3 3 2 2 3 5 2 ...
##  $ Descuento          : num [1:10254] 0 0 0 0 0 0 0 0 0 0 ...
##  $ Ganancia           : num [1:10254] 206.4 922.8 11 95.4 641.4 ...

##  Id de la fila   Id del pedido      Fecha del pedido                
##  Min.   :    1   Length:10254       Min.   :2018-01-03 00:00:00.00  
##  1st Qu.: 2574   Class :character   1st Qu.:2019-07-10 00:00:00.00  
##  Median : 5146   Mode  :character   Median :2020-07-05 12:00:00.00  
##  Mean   : 5146                      Mean   :2020-05-20 19:23:29.25  
##  3rd Qu.: 7719                      3rd Qu.:2021-05-22 00:00:00.00  
##  Max.   :10288                      Max.   :2021-12-31 00:00:00.00  
##  Fecha de envío                  Método de envío    Id. del cliente   
##  Min.   :2018-01-07 00:00:00.0   Length:10254       Length:10254      
##  1st Qu.:2019-07-13 00:00:00.0   Class :character   Class :character  
##  Median :2020-07-09 00:00:00.0   Mode  :character   Mode  :character  
##  Mean   :2020-05-24 19:24:53.5                                        
##  3rd Qu.:2021-05-25 18:00:00.0                                        
##  Max.   :2022-01-06 00:00:00.0                                        
##  Nombre del cliente   Segmento            Ciudad           Provincia        
##  Length:10254       Length:10254       Length:10254       Length:10254      
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##      País              Región          Id. del producto    Categoría        
##  Length:10254       Length:10254       Length:10254       Length:10254      
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##  Subcategoría       Nombre del producto     Ventas            Cantidad    
##  Length:10254       Length:10254        Min.   :   15.66   Min.   : 1.00  
##  Class :character   Class :character    1st Qu.:  328.80   1st Qu.: 2.00  
##  Mode  :character   Mode  :character    Median :  803.96   Median : 3.00  
##                                         Mean   : 2103.38   Mean   : 3.74  
##                                         3rd Qu.: 2277.90   3rd Qu.: 5.00  
##                                         Max.   :34740.80   Max.   :14.00  
##    Descuento         Ganancia        
##  Min.   :0.0000   Min.   :-18062.40  
##  1st Qu.:0.0000   1st Qu.:    -7.74  
##  Median :0.0000   Median :    80.00  
##  Mean   :0.1357   Mean   :   214.74  
##  3rd Qu.:0.4000   3rd Qu.:   325.80  
##  Max.   :0.8000   Max.   : 13132.80

## [1] "El dataset no tiene valores NA y tiene las siguentes dimensiones:"
## [2] "10254"                                                            
## [3] "20"

Desarrollo del Análisis

Supertienda <- Supertienda %>% 
  mutate (
    Segmento = factor(Segmento),
    Ciudad= factor(Ciudad),
    Provincia= factor(Provincia),
    País= factor(País),
    Categoría=factor(Categoría),
    Subcategoría=factor(Subcategoría),
    Región= factor(Región)
  )

Supertienda %>% 
  group_by( País, Región) %>% 
  summarise(Ventas = sum(Ventas),Ganancias = sum(Ganancia)) %>%
  mutate("Margen Ganancia"=Ganancias/Ventas*100) %>% 
  DT::datatable(rownames = FALSE,
    filter= "top"
     )

ggplot(Supertienda, aes(x= Región, y= Ventas, fill= Región )) +
  geom_bar(stat='Identity') +
  theme(legend.position='none', panel.background = element_rect(fill='white'))+
  scale_y_continuous(label = function(x) paste0(x/100,'K')) +
  ggtitle('Ventas por Regiones')

Supertienda %>% 
  group_by(Categoría, Subcategoría, País ) %>% 
  filter(Región== "Sur") %>% 
  summarise(Ventas = sum(Ventas),Ganancias = sum(Ganancia)) %>%
  mutate("Margen Ganancia"=Ganancias/Ventas*100) %>% 
  DT::datatable(rownames = FALSE,
    filter= "top"
     )

ST_Pais<-Supertienda %>% 
 filter(Región=="Sur") %>% 
   group_by(País) %>% 
   summarize(Ventas=sum(Ventas))

ST_bar <- plot_ly(ST_Pais,x=~País,y=~Ventas, type="bar",color =~País)

ST_bar<-  ST_bar %>% layout(title='Ventas por Paises de la región Sur',
                            showlegend = FALSE,
                            xaxis = list(showgrid = FALSE, zeroline = TRUE, showticklabels = TRUE),
                            yaxis = list(showgrid = FALSE, zeroline = TRUE, showticklabels = TRUE))

ST_bar

Supertienda %>% 
  filter(Región=="Sur") %>% 
  ggplot(aes(Ganancia,Ventas,color=País))+
   geom_point(stat='Identity')+
  ggtitle('Ventas y Ganancias por Paises') +
  theme(legend.position='top', panel.background = element_rect(fill='white'))

ST_BARH<-Supertienda %>% 
  filter(Región=="Sur") %>% 
  group_by(Categoría,País) %>% 
  summarize(Ventas=sum(Ventas))

ST_BARV_1<-plot_ly(ST_BARH,x=~Ventas,y=~Categoría,type="bar",orientation="h",color=~País,colors = "Dark2")

ST_BARV_1 <- ST_BARV_1 %>% layout(title='Ventas por paises y  Categoria Region Sur',
                                  xaxis = list(showgrid = FALSE, zeroline = TRUE, showticklabels = TRUE),
                                  yaxis = list(showgrid = FALSE, zeroline = TRUE, showticklabels = TRUE))

ST_BARV_1

ST<- Supertienda %>% 
  group_by(Categoría) %>%
  filter(Región=="Sur") %>% 
  summarise(Ventas=sum(Ventas))

ST_PIE <- plot_ly(ST,labels=~Categoría, values=~Ventas,type = 'pie')

ST_PIE<-ST_PIE %>% layout(title = 'Porcentaje de ventas por categoría',
           xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
           yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

ST_PIE

Basket Análisis

#librerías

library(arules)
library(gridExtra)
library(arulesViz)
library(lubridate)

Transformación de la fecha

Data_Supertienda<- Supertienda

Data_Supertienda <- Data_Supertienda %>%
  mutate(
    Subcategoría=factor(Subcategoría),IDCliente= `Id. del cliente`,
    Fecha =ymd(Supertienda$`Fecha del pedido`))

Data_Supertienda <- Data_Supertienda %>% 
  filter(Región=="Sur")

Se crea un variable que contenga las subcategoría, Id del cliente y fecha

Se elimina columnas que no se requieren para el análisis

Data_Supertienda_1<- Data_Supertienda %>%
  arrange(IDCliente) %>% 
  group_by(Fecha, IDCliente) %>% 
  mutate(itemlist=glue::glue_collapse(glue::glue("{Subcategoría}"), sep = ','))

Data_Supertienda_1$País <- NULL
Data_Supertienda_1$Ciudad<- NULL
Data_Supertienda_1$`Id del pedido`<- NULL
Data_Supertienda_1$`Id. del cliente`<- NULL
Data_Supertienda_1$`Id. del producto`<- NULL
Data_Supertienda_1$`Nombre del cliente`<- NULL
Data_Supertienda_1$`Fecha del pedido`<- NULL
Data_Supertienda_1$`Fecha de envío`<- NULL
Data_Supertienda_1$Provincia<- NULL
Data_Supertienda_1$`Nombre del producto`<- NULL
Data_Supertienda_1$Fecha<- NULL
Data_Supertienda_1$Categoría<- NULL
Data_Supertienda_1$Cantidad<- NULL
Data_Supertienda_1$Ventas<- NULL
Data_Supertienda_1$Ganancia<-NULL
Data_Supertienda_1$Segmento<- NULL
Data_Supertienda_1$Región<- NULL
Data_Supertienda_1$Descuento<- NULL
Data_Supertienda_1$`Método de envío`<- NULL
Data_Supertienda_1$Subcategoría<-NULL
Data_Supertienda_1$`Id de la fila`<- NULL
Data_Supertienda_1$IDCliente<- NULL

Data_Supertienda_1$itemlist<-as.character(Data_Supertienda_1$itemlist)

Data_Supertienda_1

## # A tibble: 2,982 × 1
##    itemlist                                           
##    <chr>                                              
##  1 Accesorios,Suministros                             
##  2 Accesorios,Suministros                             
##  3 Arte,Sillas                                        
##  4 Arte,Sillas                                        
##  5 Accesorios                                         
##  6 Librerías,Carpetas,Librerías                       
##  7 Librerías,Carpetas,Librerías                       
##  8 Librerías,Carpetas,Librerías                       
##  9 Sillas,Almacenamiento,Carpetas,Almacenamiento,Papel
## 10 Sillas,Almacenamiento,Carpetas,Almacenamiento,Papel
## # … with 2,972 more rows
## # ℹ Use `print(n = ...)` to see more rows

# Guardo data

write.csv(Data_Supertienda_1, "itemlist.csv", quote = FALSE, row.names = TRUE)


Pedidos <- read.transactions(
  "itemlist.csv",
  rm.duplicates = TRUE,
  format = "basket",
  sep = ",",
  cols = 1
)

## distribution of transactions with duplicates:
## items
##   1   2   3   4   5   6   8 
## 520 145  52  26  10  10  26

Pedidos

## transactions in sparse format with
##  2983 transactions (rows) and
##  18 items (columns)

itemFrequencyPlot(
  Pedidos,
  topN =10, 
  type = "absolute",
  main = "Frecuencia absoluta"
)

La frecuencia absoluta nos muestra el top 10 de las subcategoría mas compradas.

Data_Supertienda %>%
  filter(Región=="Sur") %>% 
  mutate(Year=as.factor(year(`Fecha del pedido`))) %>% 
  group_by(Year) %>% 
  summarise(
    Pedidos=n()
  ) %>% 
  ggplot(aes(x=Year,y=Pedidos))+
  geom_bar(stat='identity',show.legend = F,color="Black", fill= "Orange")+
  geom_label(aes(label=Pedidos))+
  ylab("pedidos")+
  xlab("Año")+
  ggtitle("Pedidos por año")+
  theme_bw()

Data_Supertienda %>%
  filter(Región=="Sur") %>% 
  group_by(Subcategoría) %>% 
  summarise(
    Pedidos=n()
  ) %>% 
  ggplot(aes(x=Pedidos,y=Subcategoría,fill=Subcategoría))+
  geom_bar(stat='identity',show.legend = F,color="black",position = "dodge")+
  geom_text(aes(x=Pedidos,label=Pedidos))+
  theme( panel.background = element_rect(fill='white'))+
   ylab("Subcategoría")+
  xlab("Pedidos")+
  ggtitle("Pedidos por Subcategoría")

Data_Supertienda %>%
  filter(Región=="Sur") %>% 
  group_by(País) %>% 
  summarise(
    Pedidos=n()
  ) %>% 
  ggplot(aes(x=Pedidos,y=País,fill=País))+
  geom_bar(stat='identity',show.legend = F,color="black",position = "dodge")+
  geom_text(aes(x=Pedidos,label=Pedidos))+
  theme( panel.background = element_rect(fill='white'))+
  ylab("Región")+
  xlab("Pedidos")+
  ggtitle("Pedidos por País")

Supertienda_1 <- Supertienda

Supertienda_1 <- Supertienda_1[,c(-1:-16)]

Supertienda_1

## # A tibble: 10,254 × 4
##    Ventas Cantidad Descuento Ganancia
##     <dbl>    <dbl>     <dbl>    <dbl>
##  1   591         3         0    206. 
##  2  2251.        2         0    923. 
##  3   129         5         0     11  
##  4   505.        3         0     95.4
##  5  3377.        3         0    641. 
##  6   168.        2         0     62  
##  7  1837.        2         0    753. 
##  8   540         3         0     37.8
##  9  3182         5         0    159  
## 10   707.        2         0     42.4
## # … with 10,244 more rows
## # ℹ Use `print(n = ...)` to see more rows

Análisis pca

pca_Supertienda <- prcomp(Supertienda_1, center=TRUE, scale = TRUE)

pca_Supertienda

## Standard deviations (1, .., p=4):
## [1] 1.3197605 1.0581178 0.8432891 0.6538213
## 
## Rotation (n x k) = (4 x 4):
##                  PC1        PC2        PC3        PC4
## Ventas     0.5653528 -0.3437098  0.4991577  0.5595367
## Cantidad   0.3320481 -0.6718934 -0.6371539 -0.1798281
## Descuento -0.4272924 -0.6041149  0.5309373 -0.4130036
## Ganancia   0.6225283  0.2558673  0.2509622 -0.6957072

names(pca_Supertienda)

## [1] "sdev"     "rotation" "center"   "scale"    "x"

summary(pca_Supertienda)

## Importance of components:
##                           PC1    PC2    PC3    PC4
## Standard deviation     1.3198 1.0581 0.8433 0.6538
## Proportion of Variance 0.4354 0.2799 0.1778 0.1069
## Cumulative Proportion  0.4354 0.7154 0.8931 1.0000

# Tomamos  las desviación estándar para obtener la varianza

desv_stand <- pca_Supertienda[[1]]

desv_stand

## [1] 1.3197605 1.0581178 0.8432891 0.6538213

varianza <- desv_stand^2

varianza

## [1] 1.7417678 1.1196133 0.7111365 0.4274824

Podemos ver que PC1 y PC2 son mayor a 1 por lo cual tienen mayor correlación y seran tomados en cuenta para los análisis

plot(pca_Supertienda$x[,1],pca_Supertienda$x[,2], xlab="PCA 1", ylab="PCA 2")

autovalores <- pca_Supertienda$sdev * pca_Supertienda$sdev  
autovectores <- pca_Supertienda$rotation 

pca_var_SP <- round(autovalores/sum(autovalores)*100, digits = 2)

barplot(pca_var_SP, xlab = "Componente principal", ylab = "Variación porcentual" )

screeplot(pca_Supertienda, type= "l", main= "Screen SP")

ggbiplot(pca_Supertienda, ellipse = TRUE,
         groups =Supertienda$Región )