Cargar librerias
#Cargar librerías necesarias
library(readxl) # Para leer archivos Excel
## Warning: package 'readxl' was built under R version 4.4.3
library(tseries) # Para pruebas de estacionariedad
## Warning: package 'tseries' was built under R version 4.4.3
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(forecast) # Para modelado ARIMA y pronósticos
## Warning: package 'forecast' was built under R version 4.4.3
library(ggplot2) # Para visualización de datos
library(plotly) # Para gráficos interactivos
##
## Adjuntando el paquete: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(timetk)
## Warning: package 'timetk' was built under R version 4.4.3
Cargar base de datos
library(readxl)
data_col <- read_excel("~/MAESTRIA FINANZAS/ANALITICA DE DATOS/VALLE MENSUAL.xlsx", col_types = c("date",
"numeric"))
Un paso indispensable es declarar la variable como serie temporal
# Convertir/declarar el número de despachos de cemento mensual
micro_ts <- ts(data_col$CEM, start = c(2000, 1), frequency = 12)
micro_ts
## Jan Feb Mar Apr May Jun Jul
## 2000 46023.15 49433.00 57308.18 38433.93 45427.30 45573.00 49908.00
## 2001 41229.44 45828.31 50789.37 43241.58 50993.81 41103.81 48503.03
## 2002 51072.00 42303.00 44918.00 48929.00 48861.00 46445.00 53836.00
## 2003 42816.00 49584.00 55752.00 52813.50 57495.00 49664.40 61527.00
## 2004 52364.90 55681.50 64476.00 42413.00 52583.00 56039.00 59757.00
## 2005 52678.00 78917.50 62765.00 70616.00 62612.00 73883.00 69902.50
## 2006 70986.40 63694.00 76136.00 66677.80 74510.00 78462.50 78214.50
## 2007 78672.00 75346.00 86293.50 73413.00 84558.00 86221.00 82429.00
## 2008 76758.50 78680.00 74644.00 85036.00 79860.00 76962.00 86463.00
## 2009 55484.70 58461.00 70195.00 70511.07 65784.82 57528.66 67413.81
## 2010 62091.36 62335.79 66310.42 60209.25 70474.58 63582.92 69524.43
## 2011 64593.17 62124.11 78159.92 67648.36 79289.24 64913.04 75443.63
## 2012 61149.38 66968.57 72051.74 63652.29 71515.40 71479.04 71931.63
## 2013 61174.85 70373.83 62269.44 72614.63 73644.05 72988.15 80997.32
## 2014 65109.60 77927.44 78383.43 69261.23 77726.54 70809.92 82732.05
## 2015 74821.90 75437.81 82443.62 75158.36 80580.01 77325.44 84914.20
## 2016 79339.83 79501.74 80230.51 83170.50 81778.42 83476.99 83774.77
## 2017 73124.30 77413.62 84993.52 72754.30 78560.19 80318.80 92374.83
## 2018 80718.33 82307.95 82405.20 91364.17 85127.86 82013.33 85051.61
## 2019 76989.18 80397.71 89457.21 86149.45 95200.64 102558.64 104847.57
## 2020 86415.57 85290.59 53449.33 21510.91 62331.68 83388.51 109495.94
## 2021 85723.80 85558.68 93889.63 80196.45 11484.85 90060.65 100220.57
## 2022 86362.81 96066.29 107584.41 102477.34 105464.84 106563.00 106978.60
## 2023 86829.96 93156.51 98143.09 85294.83 93770.48 87302.85 89831.22
## 2024 76706.61 86687.77 79603.65 93193.33 90586.13 82654.14 93021.20
## Aug Sep Oct Nov Dec
## 2000 51468.00 48622.50 51112.00 51392.10 47564.60
## 2001 49516.00 45754.50 49254.00 54066.50 43505.00
## 2002 52538.00 52319.80 56939.00 54956.20 58807.00
## 2003 60444.00 61224.50 61513.00 60051.00 54652.00
## 2004 58678.00 60097.00 56267.00 59651.00 49417.90
## 2005 75913.00 76091.50 71507.00 75418.00 76052.90
## 2006 83653.00 88858.50 84770.00 84325.00 72339.92
## 2007 86256.40 91427.00 93074.40 93437.00 80111.50
## 2008 72322.40 74695.00 78184.00 65679.00 70118.00
## 2009 65707.77 67762.13 63104.58 66700.51 57529.09
## 2010 67716.96 70616.36 69680.33 71341.90 68744.43
## 2011 76882.60 78412.60 78106.47 74224.16 74231.37
## 2012 73201.40 70848.98 65867.29 74150.43 67740.15
## 2013 78728.29 75584.14 82531.21 79999.50 71059.12
## 2014 77188.73 83775.77 83769.56 78142.32 75642.76
## 2015 87391.18 86552.37 91227.57 82435.09 85272.36
## 2016 93753.76 86288.52 81434.08 86135.55 82347.01
## 2017 86504.35 84577.98 88766.00 85932.96 76970.48
## 2018 93971.45 86388.20 93504.06 90297.97 80813.05
## 2019 94116.32 94104.89 93903.71 91102.60 82238.62
## 2020 101584.08 108789.55 104548.65 99776.55 83281.35
## 2021 92312.50 102952.51 106703.42 109449.43 106525.93
## 2022 116519.83 119923.12 103457.76 101643.13 95019.27
## 2023 97194.83 96880.64 93050.02 92923.66 85260.29
## 2024 95121.98 96166.48 96964.03 97538.61 88121.63
# Gráfico interactivo de la serie original
grafico_serie <- ggplot(data_col, aes(x = seq.Date(from = as.Date("2000-01-01"), by = "month", length.out = nrow(data_col)), y = micro_ts)) +
geom_line(color = "grey", size = 0.4) +
geom_point(color = "black", size = 0.1) +
ggtitle("Figura 1.Cantidad de despachos de cemento que se hacen en el valle") +
xlab("Tiempo") +
ylab("Número de despachos realizados en el valle") +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
ggplotly(grafico_serie)
## Don't know how to automatically pick scale for object of type <ts>. Defaulting
## to continuous.
# Cargar librerías necesarias
library(ggplot2)
library(plotly)
# Descomposición de la serie temporal
stl_decomp <- stl(micro_ts, s.window = "periodic")
# Convertir la descomposición a un data frame para graficar con ggplot2
stl_df <- data.frame(
Time = rep(time(micro_ts), 12), # Tiempo repetido para cada componente
Value = c(stl_decomp$time.series[, "seasonal"],
stl_decomp$time.series[, "trend"],
stl_decomp$time.series[, "remainder"],
micro_ts),
Component = rep(c("Estacional", "Tendencia", "Residuo", "Serie Original"), each = length(micro_ts))
)
# Crear gráfico con ggplot2
p <- ggplot(stl_df, aes(x = Time, y = Value, color = Component)) +
geom_line() +
facet_wrap(~Component, scales = "free_y", ncol = 1) +
theme_minimal() +
labs(title = "Figura A. Descomposición del número de despacho de cemento en el valle",
x = "Tiempo",
y = "Valor")
# Convertir a gráfico interactivo con plotly
ggplotly(p)
# Extraer los componentes de la descomposición
micro_sa <- micro_ts - stl_decomp$time.series[, "seasonal"]
# Crear vector de fechas correctamente alineado con la serie
fechas <- seq.Date(from = as.Date("2000-01-01"), by = "month", length.out = length(micro_ts))
# Gráfico mejorado con fechas en el eje X
grafico_ajustada <- ggplot() +
geom_line(aes(x = fechas, y = micro_ts), color = "grey", size = 0.5, linetype = "solid", name = "Serie Original") +
geom_line(aes(x = fechas, y = micro_sa), color = "black", size = 0.6, linetype = "solid", name = "Serie Ajustada") +
ggtitle("Figura 2. numero despachos cemento:Serie Original vs Serie Ajustada por Estacionalidad") +
xlab("Tiempo") +
ylab("Número de despachos de cemento realizados en el valle") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas para mejor visualización
## Warning in geom_line(aes(x = fechas, y = micro_ts), color = "grey", size = 0.5,
## : Ignoring unknown parameters: `name`
## Warning in geom_line(aes(x = fechas, y = micro_sa), color = "black", size =
## 0.6, : Ignoring unknown parameters: `name`
# Convertir a gráfico interactivo
ggplotly(grafico_ajustada)
## Don't know how to automatically pick scale for object of type <ts>. Defaulting
## to continuous.
# Extraer la tendencia de la descomposición STL
tendencia <- stl_decomp$time.series[, "trend"]
# Gráfico interactivo de la serie original vs tendencia
grafico_tendencia <- ggplot() +
geom_line(aes(x = fechas, y = micro_ts), color = "grey", size = 0.7, linetype = "solid", name = "Serie Original") +
geom_line(aes(x = fechas, y = tendencia), color = "black", size = 0.8, linetype = "solid", name = "Tendencia") +
ggtitle("Figura 3. despachos de cemento:Serie Original vs Tendencia") +
xlab("Tiempo") +
ylab("Número de despacho de cemento") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje X para mejor visualización
## Warning in geom_line(aes(x = fechas, y = micro_ts), color = "grey", size = 0.7,
## : Ignoring unknown parameters: `name`
## Warning in geom_line(aes(x = fechas, y = tendencia), color = "black", size =
## 0.8, : Ignoring unknown parameters: `name`
# Convertir a gráfico interactivo
ggplotly(grafico_tendencia)
## Don't know how to automatically pick scale for object of type <ts>. Defaulting
## to continuous.
#Cálculo de la tasa de crecimiento anual correctamente alineada
tasa_crecimiento <- (micro_ts[(13:length(micro_ts))] / micro_ts[1:(length(micro_ts) - 12)] - 1) * 100
tasa_tendencia <- (tendencia[(13:length(tendencia))] / tendencia[1:(length(tendencia) - 12)] - 1) * 100
# Crear vector de fechas corregido
fechas_corregidas <- seq(from = as.Date("2001-01-01"), by = "month", length.out = length(tasa_crecimiento))
# Verificar longitudes
print(length(fechas_corregidas))
## [1] 288
print(length(tasa_crecimiento))
## [1] 288
print(length(tasa_tendencia))
## [1] 288
# Gráfico de la tasa de crecimiento anual
grafico_crecimiento <- ggplot() +
geom_line(aes(x = fechas_corregidas, y = tasa_crecimiento), color = "grey", size = 0.7) +
geom_line(aes(x = fechas_corregidas, y = tasa_tendencia), color = "black", size = 0.8, linetype = "dashed") +
ggtitle("Figura 4. numero de despachos cemento: Tasa de crecimiento anual % de la serie Original vs Tendencia") +
xlab("Tiempo") +
ylab("% de Crecimiento Anual") +
theme_minimal()
# Convertir a gráfico interactivo
ggplotly(grafico_crecimiento)