Modelo lineal 702
Hannia Ch. Camacho
2024-11-05
1 cargar los paquetes necesarios
2 Cargar base de datos
df <- read.csv("Data/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.16943 Modificaciones de columnas
# Modificación del dataframe
df_mod <- df %>%
select(Order.Date, Sales) %>% # Seleccionamos dos columnas: Order.Date y Sales
mutate(Order.Date = mdy(Order.Date)) %>% # Convertimos Order.Date a formato fecha
mutate(Fecha = floor_date(Order.Date, unit = "month")) %>% # Ajustamos la fecha al inicio del mes
group_by(Fecha) %>% # Agrupamos por mes
summarise(Ventas = sum(Sales, na.rm = TRUE)) %>% # Sumamos las ventas por mes
mutate(Mes = month(Fecha, label = TRUE, abbr = TRUE)) # Extraemos el mes en formato abreviado
head(df_mod)## # A tibble: 6 × 3
## Fecha Ventas Mes
## <date> <dbl> <ord>
## 1 2014-01-01 14237. ene
## 2 2014-02-01 4520. feb
## 3 2014-03-01 55691. mar
## 4 2014-04-01 28295. abr
## 5 2014-05-01 23648. may
## 6 2014-06-01 34595. jun4 Visualizacion
df_mod %>%
ggplot(., aes(x=Mes, y=Ventas)) +
geom_point() +
geom_line() +
geom_smooth(method = "lm", formula = "y ~ x")
# 5 grafica de caja y bigotes
# Esta gráfica me sirve para encontrar valores atípicos
df_mod %>%
ggplot(aes(x = as.factor(Mes), y = Ventas)) +
geom_boxplot() +
labs(
title = "Gráfica de caja y bigotes",
x = "Mes",
y = "Ventas"
) +
theme_minimal()
6 Revisar si la variable y tiene una distribucion aprox normal
# Revisar que la variable Y tenga una distribucion más o menos normal
df_mod %>%
ggplot(., aes(x=Ventas)) +
geom_histogram(bins = 30, aes(y=..density..)) +
geom_density()## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# 7 Analisis de correlacion
# 3 Calculamos coeficientes de correlación de Pearson
# Convertir 'Mes' a variable numérica para calcular la correlación
df_mod$Mes_num <- month(df_mod$Fecha) # Asignar número de mes
# Realizamos el test de correlación de Pearson
cor.test(df_mod$Mes_num, df_mod$Ventas)##
## Pearson's product-moment correlation
##
## data: df_mod$Mes_num and df_mod$Ventas
## t = 7.1429, df = 46, p-value = 5.565e-09
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.5554957 0.8368724
## sample estimates:
## cor
## 0.72517248 Modelo de regresion
modelo_lineal <- lm(Ventas ~ Mes, data = df_mod)
stargazer(modelo_lineal, type = "text")##
## ===============================================
## Dependent variable:
## ---------------------------
## Ventas
## -----------------------------------------------
## Mes.L 62,631.080***
## (6,766.123)
##
## Mes.Q 15,155.300**
## (6,766.123)
##
## Mes.C 8,840.639
## (6,766.123)
##
## Mes4 -11,904.070*
## (6,766.123)
##
## Mes5 -7,908.013
## (6,766.123)
##
## Mes6 10,056.680
## (6,766.123)
##
## Mes7 -16,580.660**
## (6,766.123)
##
## Mes8 -3,411.541
## (6,766.123)
##
## Mes9 -28,897.670***
## (6,766.123)
##
## Mes10 -9,330.918
## (6,766.123)
##
## Mes11 -8,162.104
## (6,766.123)
##
## Constant 47,858.350***
## (1,953.211)
##
## -----------------------------------------------
## Observations 48
## R2 0.779
## Adjusted R2 0.712
## Residual Std. Error 13,532.250 (df = 36)
## F Statistic 11.540*** (df = 11; 36)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01# el modelo que buscamos estimar es: y= a+bx
# En este caso
# Constant = a
# Pediente = b
# Mes = x9 coeficientes de modelo
#Obtener los coeficientes del modelo, es decir a y b
coeficientes <- coef(modelo_lineal)
intercepto <- coeficientes ["(Intercept"]
pendiente <- coeficientes ["Mes"]
# Crear el texto de la ecuacion
ecuacion <- paste0("y =", round(intercepto, 2),
"+",
round(pendiente,2), "x")
ecuacion## [1] "y =NA+NAx"10 Prediccion
# Extender la serie temporal para 6 meses
df_futuro <- data.frame(Fecha = seq.Date(from = max(df_mod$Fecha)+months(1),
by = "month",
length.out = 6),
Mes = seq(from = 49, to = 54, by = 1))
# Generar las predicciones para 6 meses con intervalos de confianza
predicciones <- predict(modelo_lineal,
nedata = df_futuro,
interval = "confidence")
predicciones## fit lwr upr
## 1 23731.21 10008.875 37453.54
## 2 14937.81 1215.479 28660.15
## 3 51251.37 37529.039 64973.71
## 4 34440.53 20718.199 48162.87
## 5 38757.20 25034.869 52479.54
## 6 38179.67 24457.336 51902.00
## 7 36809.52 23087.191 50531.86
## 8 39761.02 26038.682 53483.35
## 9 76912.49 63190.153 90634.82
## 10 50080.75 36358.413 63803.08
## 11 88115.27 74392.934 101837.60
## 12 81323.38 67601.042 95045.71
## 13 23731.21 10008.875 37453.54
## 14 14937.81 1215.479 28660.15
## 15 51251.37 37529.039 64973.71
## 16 34440.53 20718.199 48162.87
## 17 38757.20 25034.869 52479.54
## 18 38179.67 24457.336 51902.00
## 19 36809.52 23087.191 50531.86
## 20 39761.02 26038.682 53483.35
## 21 76912.49 63190.153 90634.82
## 22 50080.75 36358.413 63803.08
## 23 88115.27 74392.934 101837.60
## 24 81323.38 67601.042 95045.71
## 25 23731.21 10008.875 37453.54
## 26 14937.81 1215.479 28660.15
## 27 51251.37 37529.039 64973.71
## 28 34440.53 20718.199 48162.87
## 29 38757.20 25034.869 52479.54
## 30 38179.67 24457.336 51902.00
## 31 36809.52 23087.191 50531.86
## 32 39761.02 26038.682 53483.35
## 33 76912.49 63190.153 90634.82
## 34 50080.75 36358.413 63803.08
## 35 88115.27 74392.934 101837.60
## 36 81323.38 67601.042 95045.71
## 37 23731.21 10008.875 37453.54
## 38 14937.81 1215.479 28660.15
## 39 51251.37 37529.039 64973.71
## 40 34440.53 20718.199 48162.87
## 41 38757.20 25034.869 52479.54
## 42 38179.67 24457.336 51902.00
## 43 36809.52 23087.191 50531.86
## 44 39761.02 26038.682 53483.35
## 45 76912.49 63190.153 90634.82
## 46 50080.75 36358.413 63803.08
## 47 88115.27 74392.934 101837.60
## 48 81323.38 67601.042 95045.7111 Juntar datos
# Verificar la estructura de las predicciones
str(predicciones)## num [1:48, 1:3] 23731 14938 51251 34441 38757 ...
## - attr(*, "dimnames")=List of 2
## ..$ : chr [1:48] "1" "2" "3" "4" ...
## ..$ : chr [1:3] "fit" "lwr" "upr"# Convertir predicciones a un data frame si es necesario
df_predicciones <- as.data.frame(predicciones)
# Asegurar que las predicciones tengan las columnas esperadas
colnames(df_predicciones) <- c("Ventas", "Bajo", "Alto")
# Verificar la estructura de df_futuro
str(df_futuro)## 'data.frame': 6 obs. of 2 variables:
## $ Fecha: Date, format: "2018-01-01" "2018-02-01" ...
## $ Mes : num 49 50 51 52 53 54# Verificar que el número de filas de df_futuro y df_predicciones coincidan
if (nrow(df_futuro) == nrow(df_predicciones)) {
# Unir las predicciones y los intervalos de confianza con las fechas
df_futuro <- bind_cols(df_futuro, df_predicciones) # Unir por las columnas
# Unir con la base de datos original
df_total <- bind_rows(df_mod, df_futuro)
# Mostrar las últimas filas de df_total
tail(df_total, 7)
} else {
cat("El número de filas en df_futuro y df_predicciones no coincide.\n")
}## El número de filas en df_futuro y df_predicciones no coincide.12 Visualizacion
# Asegurarse de que 'df_futuro' y 'df_predicciones' tengan el mismo número de filas
if (nrow(df_futuro) == nrow(df_predicciones)) {
# Unir las predicciones con las fechas de df_futuro
df_futuro <- bind_cols(df_futuro, df_predicciones)
# Verificar que la unión se haya realizado correctamente
print(head(df_futuro))
# Crear df_total combinando df_mod y df_futuro
df_total <- bind_rows(df_mod, df_futuro)
# Ver las últimas filas de df_total
print(tail(df_total, 7))
# Crear la gráfica
df_total %>%
ggplot(aes(x = Fecha, y = Ventas)) + # Asegurarse de que 'Ventas' esté correctamente mapeado
geom_point(data = df_mod, aes(x = Fecha, y = Ventas)) + # Usar 'Ventas' en lugar de 'ventas'
geom_line(data = df_mod, aes(x = Fecha, y = Ventas)) + # Usar 'Ventas' en lugar de 'ventas'
geom_smooth(method = "lm", formula = y ~ x, color = "blue", data = df_mod) +
geom_ribbon(data = df_futuro, aes(ymin = Bajo, ymax = Alto), fill = "lightblue") +
geom_point(data = df_futuro, aes(x = Fecha, y = Ventas), color = "red") +
geom_line(data = df_futuro, aes(x = Fecha, y = Ventas, color = "red", linetype = "dashed"))
} else {
cat("El número de filas en 'df_futuro' y 'df_predicciones' no coincide.\n")
}## El número de filas en 'df_futuro' y 'df_predicciones' no coincide.