INFORME

Detalles de los Casos

“Super Store” es una gran cadena de almacenes, que ante un entorno altamente competitivo necesita comprender mejor el desempeño de sus sucursales. Para lo cual se le ha encargado realizar un análisis para identificar a que productos, regiones, categorías y segmentos debería enforcarse o renunciar.

Para ello debe desarrollar:

  1. Análisis del desempeño del negocio.
  2. Pronóstico de las ventas y la rentabilidad para el siguiente año de operaciones para cada uno de las regiones y categorías. (Presente los principales indicadores para evaluar la calidad de su modelo de pronóstico).
  3. Diseñe y proponga un plan de negocio que permita incrementar la rentabilidad para “Super Store”.

Solución del caso

Importación y resumen de datos 

# Importar el archivo CSV
df <- read.csv("Superstore Dataset.csv", header = TRUE, sep = ",")
#head(df)

kable(head(df, n = 3))
Row.ID Order.ID Order.Date Ship.Date Ship.Mode Customer.ID Customer.Name Segment Country City State Postal.Code Region Product.ID Category Sub.Category Product.Name Sales Quantity Discount Profit
1 CA-2016-152156 11/8/2016 11/11/2016 Second Class CG-12520 Claire Gute Consumer United States Henderson Kentucky 42420 South FUR-BO-10001798 Furniture Bookcases Bush Somerset Collection Bookcase 261.96 2 0 41.9136
2 CA-2016-152156 11/8/2016 11/11/2016 Second Class CG-12520 Claire Gute Consumer United States Henderson Kentucky 42420 South FUR-CH-10000454 Furniture Chairs Hon Deluxe Fabric Upholstered Stacking Chairs, Rounded Back 731.94 3 0 219.5820
3 CA-2016-138688 6/12/2016 6/16/2016 Second Class DV-13045 Darrin Van Huff Corporate United States Los Angeles California 90036 West OFF-LA-10000240 Office Supplies Labels Self-Adhesive Address Labels for Typewriters by Universal 14.62 2 0 6.8714 
#summary(df)

# Verificar la estructura de los datos importados
str(df)
## 'data.frame':    9994 obs. of  21 variables:
##  $ Row.ID       : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ Order.ID     : chr  "CA-2016-152156" "CA-2016-152156" "CA-2016-138688" "US-2015-108966" ...
##  $ Order.Date   : chr  "11/8/2016" "11/8/2016" "6/12/2016" "10/11/2015" ...
##  $ Ship.Date    : chr  "11/11/2016" "11/11/2016" "6/16/2016" "10/18/2015" ...
##  $ Ship.Mode    : chr  "Second Class" "Second Class" "Second Class" "Standard Class" ...
##  $ Customer.ID  : chr  "CG-12520" "CG-12520" "DV-13045" "SO-20335" ...
##  $ Customer.Name: chr  "Claire Gute" "Claire Gute" "Darrin Van Huff" "Sean O'Donnell" ...
##  $ Segment      : chr  "Consumer" "Consumer" "Corporate" "Consumer" ...
##  $ Country      : chr  "United States" "United States" "United States" "United States" ...
##  $ City         : chr  "Henderson" "Henderson" "Los Angeles" "Fort Lauderdale" ...
##  $ State        : chr  "Kentucky" "Kentucky" "California" "Florida" ...
##  $ Postal.Code  : int  42420 42420 90036 33311 33311 90032 90032 90032 90032 90032 ...
##  $ Region       : chr  "South" "South" "West" "South" ...
##  $ Product.ID   : chr  "FUR-BO-10001798" "FUR-CH-10000454" "OFF-LA-10000240" "FUR-TA-10000577" ...
##  $ Category     : chr  "Furniture" "Furniture" "Office Supplies" "Furniture" ...
##  $ Sub.Category : chr  "Bookcases" "Chairs" "Labels" "Tables" ...
##  $ Product.Name : chr  "Bush Somerset Collection Bookcase" "Hon Deluxe Fabric Upholstered Stacking Chairs, Rounded Back" "Self-Adhesive Address Labels for Typewriters by Universal" "Bretford CR4500 Series Slim Rectangular Table" ...
##  $ Sales        : num  262 731.9 14.6 957.6 22.4 ...
##  $ Quantity     : int  2 3 2 5 2 7 4 6 3 5 ...
##  $ Discount     : num  0 0 0 0.45 0.2 0 0 0.2 0.2 0 ...
##  $ Profit       : num  41.91 219.58 6.87 -383.03 2.52 ...

Se observa que los atributos de fecha no contienen dicho formato y se procede a cambiar

# Convertir las columnas Order.Date y Ship.Date al formato de fecha MM/DD/YYYY
df$Order.Date <- as.Date(df$Order.Date, format = "%m/%d/%Y")
df$Ship.Date <- as.Date(df$Ship.Date, format = "%m/%d/%Y")

Verificar si existe faltante de datos

md.pattern(df)

##      Row.ID Order.ID Order.Date Ship.Date Ship.Mode Customer.ID Customer.Name
## 9988      1        1          1         1         1           1             1
## 6         1        1          1         1         1           1             1
##           0        0          0         0         0           0             0
##      Segment Country City State Postal.Code Region Product.ID Category
## 9988       1       1    1     1           1      1          1        1
## 6          1       1    1     1           1      1          1        1
##            0       0    0     0           0      0          0        0
##      Sub.Category Product.Name Sales Quantity Discount Profit   
## 9988            1            1     1        1        1      1  0
## 6               1            1     0        0        0      0  4
##                 0            0     6        6        6      6 24

Se observa que 6 registros contienen los atributos de Sales, Quantity, Discount y Profit como nulos (sin valores), debido a que no representan una gran cantidad se decide eliminar estos registros.

# Eliminar registros con Sales vacío
df <- subset(df, !is.na(Sales))

print(dim(df))
## [1] 9988   21

Se extrae el mes y Año del Order Date y se agrupa la venta y el ingreso por año y mes

# Extraer el año y el mes en nuevas columnas
df$YYYY_Order <- year(df$Order.Date)
df$MM_Order <- month(df$Order.Date)

# Agrupar por YYYY_Order y MM_Order y calcular la suma de Sales y Profit
df_agrupado <- df %>%
  group_by(YYYY_Order, MM_Order) %>%
  summarise(Sales_Total = sum(Sales),
            Profit_Total = sum(Profit))
## `summarise()` has grouped output by 'YYYY_Order'. You can override using the
## `.groups` argument.
# Verificar los resultados
kable(head(df_agrupado, n = 10))
YYYY_Order MM_Order Sales_Total Profit_Total
2014 1 14236.895 2450.1907
2014 2 4519.892 862.3084
2014 3 55691.009 498.7299
2014 4 28178.561 3466.9382
2014 5 23648.287 2738.7096
2014 6 34595.128 4976.5244
2014 7 33946.393 -841.4826
2014 8 27909.468 5318.1050
2014 9 81777.351 8328.0994
2014 10 31453.393 3448.2573

Se estima modelo de RLM para la Venta (RLM SALES):

Para estimar el modelo de RLM usamos como variable dependiente la venta y como variables independientes el año y el mes en el que se genera la orden.

modelo <- lm(Sales_Total ~ YYYY_Order + MM_Order, data = df_agrupado)
residuos <- resid(modelo)
summary(modelo)
## 
## Call:
## lm(formula = Sales_Total ~ YYYY_Order + MM_Order, data = df_agrupado)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -31058  -8823  -1817   8408  37256 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.484e+07  4.044e+06  -3.669 0.000642 ***
## YYYY_Order   7.370e+03  2.007e+03   3.673 0.000635 ***
## MM_Order     5.237e+03  6.499e+02   8.058 2.84e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 15540 on 45 degrees of freedom
## Multiple R-squared:  0.6354, Adjusted R-squared:  0.6192 
## F-statistic: 39.21 on 2 and 45 DF,  p-value: 1.383e-10
# Escribir el dataframe en un archivo Excel
#write.xlsx(df, "archivo.xlsx", row.names = FALSE)

Del modelo de RLM de Venta podemos sacar las siguientes conclusiones:

  1. Las variables independientes son significativas para el modelo ya que presentan un valor P menor que 0.05, esta prueba nos indica que los coeficientes de dichas variables son estadísticamente diferente de cero.

  2. Es importante destacar que el modelo exhibe un coeficiente de determinación ajustado (R² ajustado) de 0.6192, lo cual es un indicador positivo. Este valor sugiere que el modelo tiene un buen rendimiento al explicar una gran parte de la variabilidad en la variable de respuesta (Y) y el modelo no se comporta como una herramienta aleatoria.

Evaluación de supuestos del Modelo de RLM SALES

Homocedasticidad

#Homocedasticidad. Gráfico de residuos estandarizados vs. valores ajustados
plot(modelo, which = 3)

Se puede observar la aleatoriedad de los residuales lo cual es bueno para el modelo ya que no se esta violando el principio de Homocedasticidad, en otras palabras la varianza de los errores no es constante a lo largo de las observaciones.

Errores aleatorios con distribución normal

#Normalidad. Gráfico de cuantiles de los residuos vs. cuantiles teóricos normales
qqnorm(residuos)

shapiro.test(residuos)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos
## W = 0.97633, p-value = 0.4365

Como regla general, si el valor p es mayor que un nivel de significancia dado (por ejemplo, 0.05), no rechazaríamos la hipótesis nula. En este caso el valor p (0.4365) es mayor que 0.05, no hay suficiente evidencia para rechazar la hipótesis nula y podríamos asumir que los residuos siguen una distribución normal.

Los errores tienen media cero

# Prueba estadística de la media de los residuos
print(mean(residuos))
## [1] 1.39902e-13

Al calcular la media de los residuales encontramos que el valor es muy cercano a cero, En este caso, la diferencia entre la media de los residuos y cero es tan pequeña que se puede considerar prácticamente cero en términos prácticos.

Los errores son mutuamente independientes

# Gráfico de residuos vs. orden de observación
plot(residuos, type = "o", ylab = "Residuos", xlab = "Orden de Observación")
abline(h = 0, col = "red", lty = 2)

# Calcula el estadístico Durbin-Watson
dwtest(modelo)
## 
##  Durbin-Watson test
## 
## data:  modelo
## DW = 2.3935, p-value = 0.8711
## alternative hypothesis: true autocorrelation is greater than 0

Al examinar tanto el gráfico de los residuos como los resultados de la prueba Durbin-Watson, se llega a la conclusión de que los errores en el modelo son mutuamente independientes. En particular, el valor del estadístico Durbin-Watson (DW) es 2.3935, lo cual está cercano a 2. Un valor de DW cercano a 2 generalmente sugiere que los residuos son independientes entre sí. Además, dado que el p-valor asociado con la prueba es mayor que 0.05, no se encuentra evidencia significativa de autocorrelación en los residuos.

El modelo de RLM SALES ha superado la evaluación de supuestos y se considera óptimo para el pronóstico. A continuación, se presenta el pronostico de la venta para el siguiente año (2018).

# Crear un dataframe para almacenar los resultados de los pronósticos
pronosticos <- data.frame(YYYY_Order = rep(2018, 12), MM_Order = 1:12)

# Hacer pronósticos para cada mes del 2018
pronosticos$Sales_Pronosticadas <- predict(modelo, newdata = pronosticos)

# Mostrar los pronósticos
print(pronosticos)
##    YYYY_Order MM_Order Sales_Pronosticadas
## 1        2018        1            37439.15
## 2        2018        2            42676.06
## 3        2018        3            47912.97
## 4        2018        4            53149.89
## 5        2018        5            58386.80
## 6        2018        6            63623.71
## 7        2018        7            68860.62
## 8        2018        8            74097.54
## 9        2018        9            79334.45
## 10       2018       10            84571.36
## 11       2018       11            89808.27
## 12       2018       12            95045.19
# Escribir los pronósticos en un archivo Excel
write.xlsx(pronosticos, "pronosticos.xlsx", row.names = FALSE)
## Warning: Please use 'rowNames' instead of 'row.names'