Act. en Linea Tema 3
Allinson Romero Paz
2024-12-02
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 Contruccion de variables
# Nota la prediccion que vamos a hacer considera valores corrientes
df_mod <- df %>% #Llama la base de datos
filter(State == "New York") %>%
select(Order.Date, Sales) %>% # Selecciona dos columnas Order.Date y Sales
mutate(Order.Date = mdy(Order.Date)) %>% # Cambia formato a fecha
mutate(Fecha = floor_date(Order.Date, unit = "month")) %>% #Asigna las fechas a primero de mes
group_by(Fecha) %>%
summarise(Ventas = sum(Sales)) %>%
mutate(Mes = seq_along(Fecha)) #crear variable x para facilitar la regresión
head(df_mod)## # A tibble: 6 × 3
## Fecha Ventas Mes
## <date> <dbl> <int>
## 1 2014-01-01 3.93 1
## 2 2014-02-01 65.0 2
## 3 2014-03-01 4936. 3
## 4 2014-04-01 491. 4
## 5 2014-05-01 1169. 5
## 6 2014-06-01 5743. 6#4 visualización del objetivo
df_mod %>%
ggplot(., aes(x=Mes, y=Ventas)) +
geom_point()+
geom_line() +
geom_smooth(method = "lm", formula = "y ~ x")
#5 Gráficas de caja y vigotes
#Esta grafica me sirve para detectar valores atipicos
df_mod %>%
ggplot(., aes(x=Ventas)) +
geom_boxplot()
#6 Analisis de normalidad
# Revisar que la variable y tenga una distribución 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 Análisis de correlación
#3 calculamos el coeficiente de correlacion de pearson
with(df_mod, cor.test(Mes, Ventas))##
## Pearson's product-moment correlation
##
## data: Mes and Ventas
## t = 1.9685, df = 46, p-value = 0.05505
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.005857389 0.521567723
## sample estimates:
## cor
## 0.2787412#Está correlación va de -1 a 1
#Valores extremos indican correlación más fuerte
# Puede ser pocitiva (suben o bajan juntas) o
# negativa (si una suba la otra baja y viceversa)library(stargazer)##
## Please cite as:## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.## R package version 5.2.3. https://CRAN.R-project.org/package=stargazer#8 Modelo de regresión
modelo_lineal <- lm(Ventas ~ Mes, data = df_mod)
stargazer(modelo_lineal, type = "text")##
## ===============================================
## Dependent variable:
## ---------------------------
## Ventas
## -----------------------------------------------
## Mes 123.003*
## (62.485)
##
## Constant 3,463.011*
## (1,758.658)
##
## -----------------------------------------------
## Observations 48
## R2 0.078
## Adjusted R2 0.058
## Residual Std. Error 5,997.222 (df = 46)
## F Statistic 3.875* (df = 1; 46)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01# El modelo que buscamos estimar es: y = a + bx
# En este caso
# Constant = a
# Pendiente = b
# Mes = x9 Coeficientes del 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 ecuación
ecuacion <- paste0("y = ",
round(intercepto, 2),
" + ",
round(pendiente, 2),
"x")
ecuacion## [1] "y = 3463.01 + 123x"10 Generacion de predicciones
# Vamos a extraer la serie temporal 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,
newdata = df_futuro,
interval = "confidence")
predicciones## fit lwr upr
## 1 9490.167 5950.172 13030.16
## 2 9613.170 5963.166 13263.18
## 3 9736.174 5975.171 13497.18
## 4 9859.177 5986.273 13732.08
## 5 9982.180 5996.547 13967.81
## 6 10105.183 6006.062 14204.30#11 Juntar datos
# Convertir a data frame
df_predicciones <- as.data.frame(predicciones)
colnames(df_predicciones) <- c("Ventas", "Bajo", "Alto")
#Unir las predicciones con las fechas
df_futuro <- cbind(df_futuro, df_predicciones) #cbind unir por columnas
#Unir con la base de datos original
df_total <- bind_rows(df_mod, df_futuro)
tail(df_total, 7)## # A tibble: 7 × 5
## Fecha Ventas Mes Bajo Alto
## <date> <dbl> <dbl> <dbl> <dbl>
## 1 2017-12-01 6705. 48 NA NA
## 2 2018-01-01 9490. 49 5950. 13030.
## 3 2018-02-01 9613. 50 5963. 13263.
## 4 2018-03-01 9736. 51 5975. 13497.
## 5 2018-04-01 9859. 52 5986. 13732.
## 6 2018-05-01 9982. 53 5997. 13968.
## 7 2018-06-01 10105. 54 6006. 14204.df_total %>%
ggplot(., aes(x = Fecha, y = Ventas)) +
geom_point(data = df_mod) + #Valores historicos
geom_line(data = df_mod) + #Linea de valores historicos
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(y = Ventas), color = "red") + #Valores predichos
geom_line(data = df_futuro, aes(y = Ventas), color = "red", linetype = "dashed") +
labs(title = "Predicción de ventas enero-junio 2018",
x = "Mes",
y = "Ventas")