Prediccion de Ventas con Modelo Lineal
LUIS FELIPE RAMIREZ
2024-11-09
#1 cARGAR LOS PAQUETES NECESARIOS
#2 leer base de datos
df<- read.csv("Sample - Superstore.csv")
head(df)## Row.ID Order.ID Order.Date Ship.Date Ship.Mode Customer.ID
## 1 1 CA-2016-152156 11/8/2016 11/11/2016 Second Class CG-12520
## 2 2 CA-2016-152156 11/8/2016 11/11/2016 Second Class CG-12520
## 3 3 CA-2016-138688 6/12/2016 6/16/2016 Second Class DV-13045
## 4 4 US-2015-108966 10/11/2015 10/18/2015 Standard Class SO-20335
## 5 5 US-2015-108966 10/11/2015 10/18/2015 Standard Class SO-20335
## 6 6 CA-2014-115812 6/9/2014 6/14/2014 Standard Class BH-11710
## Customer.Name Segment Country City State
## 1 Claire Gute Consumer United States Henderson Kentucky
## 2 Claire Gute Consumer United States Henderson Kentucky
## 3 Darrin Van Huff Corporate United States Los Angeles California
## 4 Sean O'Donnell Consumer United States Fort Lauderdale Florida
## 5 Sean O'Donnell Consumer United States Fort Lauderdale Florida
## 6 Brosina Hoffman Consumer United States Los Angeles California
## Postal.Code Region Product.ID Category Sub.Category
## 1 42420 South FUR-BO-10001798 Furniture Bookcases
## 2 42420 South FUR-CH-10000454 Furniture Chairs
## 3 90036 West OFF-LA-10000240 Office Supplies Labels
## 4 33311 South FUR-TA-10000577 Furniture Tables
## 5 33311 South OFF-ST-10000760 Office Supplies Storage
## 6 90032 West FUR-FU-10001487 Furniture Furnishings
## Product.Name Sales
## 1 Bush Somerset Collection Bookcase 261.9600
## 2 Hon Deluxe Fabric Upholstered Stacking Chairs, Rounded Back 731.9400
## 3 Self-Adhesive Address Labels for Typewriters by Universal 14.6200
## 4 Bretford CR4500 Series Slim Rectangular Table 957.5775
## 5 Eldon Fold 'N Roll Cart System 22.3680
## 6 Eldon Expressions Wood and Plastic Desk Accessories, Cherry Wood 48.8600
## Quantity Discount Profit
## 1 2 0.00 41.9136
## 2 3 0.00 219.5820
## 3 2 0.00 6.8714
## 4 5 0.45 -383.0310
## 5 2 0.20 2.5164
## 6 7 0.00 14.1694#3 construccion de variables
#Nota, la prediccion que vamos hacer es de ventas en valores corrrientes
df_reg <- df %>% # LLmar la base de datos
filter(State == "Texas") %>% # Elegir estado
select(Order.Date, Sales) %>% # Selecionar 2 clumnas Order.Datey Sales
mutate(Order.Date = mdy(Order.Date)) %>% # Cambiar Fecha
mutate(Fecha = floor_date(Order.Date, unit="month")) %>%
group_by(Fecha) %>%
summarise(Ventas = sum(Sales)) %>%
mutate(Mes = seq_along(Fecha)) # Crear variable x
head(df_reg) ## # A tibble: 6 × 3
## Fecha Ventas Mes
## <date> <dbl> <int>
## 1 2014-01-01 144. 1
## 2 2014-02-01 74.4 2
## 3 2014-03-01 2896. 3
## 4 2014-04-01 2723. 4
## 5 2014-05-01 1955. 5
## 6 2014-06-01 2586. 6#4 Visualización
df_reg %>%
ggplot(., aes(x=Mes, y=Ventas)) +
geom_point()+
geom_line() +
geom_smooth(method = "lm", formula = "y ~ x")
#5 Graficas de cajas y bigotes
# Esta grafica sirve para encontrar valores atipicos
df_reg %>%
ggplot(. , aes(x=Ventas)) +
geom_boxplot()
#6 revisar sila variable y tiene una distribucion aproximadamente normal
df_reg %>%
ggplot(., aes(x=Ventas)) +
geom_histogram(bins=30, aes(y=after_stat(density))) +
geom_density()
#7 Anlisis de correlacion
#Calculamos coeficiente de correlacion de Pearson, con Mes como X
with(df_reg, cor.test(Mes, Ventas))##
## Pearson's product-moment correlation
##
## data: Mes and Ventas
## t = 0.28617, df = 46, p-value = 0.776
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.2449128 0.3224282
## sample estimates:
## cor
## 0.04215544# LA CORRELACION VA DE -1 A 1
# VALORES EXTREMOS INDICAN CORRELACION MAS FUERTE
# PUEDE SER POSITIVA (SUBEN O BAJAN JUNTAS), O NEGATIVA (SI UNA SUBE
#LA OTRA BAJA)#8 MODELO DE REGRESION
modelo_lineal <- lm(Ventas ~ Mes, data = df_reg)
stargazer(modelo_lineal, type = "text")##
## ===============================================
## Dependent variable:
## ---------------------------
## Ventas
## -----------------------------------------------
## Mes 9.318
## (32.562)
##
## Constant 3,317.290***
## (916.472)
##
## -----------------------------------------------
## Observations 48
## R2 0.002
## Adjusted R2 -0.020
## Residual Std. Error 3,125.272 (df = 46)
## F Statistic 0.082 (df = 1; 46)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01# el odelo es y = a + bx
# constant = a
# pendiente = b#9 obtener los coeficientes del modelo
coeficientes <- coef(modelo_lineal)
intercepto <- coeficientes["(Intercept)"]
pendiente <- coeficientes["Mes"]
coeficientes## (Intercept) Mes
## 3317.289628 9.318149#10 Datos prediccion
#Extender la serie temporal para 6 meses
df_futuro <- data.frame(Fecha = seq.Date(from =max(df_reg$Fecha) + month(1),
by = "month",
length.out = 6),
Mes = seq(49, 54, 1))
#generar predicciones
predicciones <- predict(modelo_lineal, newdata = df_futuro, interval = "confidence")
#Convertir las predicciones a un data frame
df_predicciones <- as.data.frame(predicciones)
colnames(df_predicciones) <- c("Ventas","Bajo", "Alto") # Nombrar las columnas
#unir las predicciones y los intervalos de confianza al data frame futuro
df_futuro <- cbind(df_futuro, df_predicciones)
df_futuro## Fecha Mes Ventas Bajo Alto
## 1 2017-12-02 49 3773.879 1929.117 5618.641
## 2 2018-01-02 50 3783.197 1881.107 5685.287
## 3 2018-02-02 51 3792.515 1832.582 5752.449
## 4 2018-03-02 52 3801.833 1783.586 5820.081
## 5 2018-04-02 53 3811.152 1734.159 5888.144
## 6 2018-05-02 54 3820.470 1684.336 5956.603#11 Combinar data Frames
# Combinar datos actuales con las predicciones futuras
df_total <- bind_rows(df_reg, df_futuro)
# Mostrar las últimas filas con las predicciones y los intervalos
tail(df_total, 6)## # A tibble: 6 × 5
## Fecha Ventas Mes Bajo Alto
## <date> <dbl> <dbl> <dbl> <dbl>
## 1 2017-12-02 3774. 49 1929. 5619.
## 2 2018-01-02 3783. 50 1881. 5685.
## 3 2018-02-02 3793. 51 1833. 5752.
## 4 2018-03-02 3802. 52 1784. 5820.
## 5 2018-04-02 3811. 53 1734. 5888.
## 6 2018-05-02 3820. 54 1684. 5957.#12 Graficar con prediccion
# Graficar los valores pasados y predicciones con intervalos de confianza
ggplot(df_total, aes(x = Fecha, y = Ventas)) +
geom_point(data = df_reg) + # Valores históricos
geom_line(data = df_reg) + # Linea de valores históricos
geom_smooth(method = "lm", formula = y ~ x, color = "blue", data = df_reg) +
geom_ribbon(data = df_futuro, aes(ymin = Bajo, ymax =Alto), fill = "lightblue") +
geom_point(data = df_futuro, aes(y = Ventas), color = "red") + #Valores predichos
geom_line(data = df_futuro, aes(y = Ventas), color = "red", linetype = "dashed") +
labs(tittle = "Predicción de ventas enero-junio 2018",
x = "Mes",
y = "Ventas")