En Colombia, el sector construcción es una de las actividades económicas mas importantes por su participación en el PIB, en generación de empleo e inversión nacional y extranjera.
Uno de los materiales indispensables en este sector es la producción de cemento, es por eso que dentro del presente articulo presentamos el comportamiento que han tenido dos variables importantes en este sector que afectan directamente la cantidad de cemento que se produce en el país, estas variables son la cantidad de metros cúbicos de concreto premezclado y el área aprobada en licencias de construcción en el país, el analisis se hace para el periodo comprendido entre enero 2012 y diciembre 2025.
Para adentrar en el
****Instalar/Cargar librerias necesarias para el análisis***
#Cargar librerías necesarias
library(readxl) # Para leer archivos Excel
library(tseries) # Para pruebas de estacionariedad
library(forecast) # Para modelado ARIMA y pronósticos
library(ggplot2) # Para visualización de datos
library(plotly) # Para gráficos interactivos
library(timetk) #timetk simplifica y acelera el análisis exploratorio, visualización, y preparación de datos temporales para modelado. Es ideal para quienes trabajan con series temporales en un flujo de trabajo "tidy" y buscan integrar análisis visuales, detección de patrones y forecasting en un solo paquete.
Cargar base de datos
library(readxl)
data_col <- read_excel("C:/Users/aleja/Downloads/Fernanda Arteaga/Analitica de datos/II Evaluación/Datos construcción.xlsx",
col_types = c("date", "numeric", "numeric",
"numeric"))
View(data_col)
PASO INDISPENSABLE: Declarar la (s) variable (s) como serie (s) temporal (es):
Variable 1
# Convertir/declarar variable 1=Producción de cenemto en serie de tiempo mensual
variable1_ts <- ts(data_col$PNCEM, start = c(2012, 1), frequency = 12)
Variable 2
# Convertir/declarar el Metros cubicos de concreto premezclado en serie de tiempo mensual
variable2_ts <- ts(data_col$CONCRETO, start = c(2012, 1), frequency = 12)
Variable 3
# Convertir/declarar el area de licencias de construcción aprobada en serie de tiempo mensual
variable3_ts <- ts(data_col$LICC, start = c(2012, 1), frequency = 12)
A continuación se muestre el comportamiento de las variables para el periodo de analisis que abarca desde enero 2012 a diciembre 2025.
Gráfico inicial de la variable 1 en niveles -Original
library(ggplot2)
library(plotly)
# Convertir la serie temporal a un vector numérico para lograr graficar con ggplot2
data_col$variable1 <- as.numeric(variable1_ts)
# Crear el gráfico
grafico_serie <- ggplot(data_col, aes(x = seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = nrow(data_col)),
y = variable1)) +
geom_line(color = "orange", linewidth = 0.4) + # Cambiado 'size' por 'linewidth'
geom_point(color = "black", size = 0.1) +
ggtitle("Variable 1: Serie original - Producción de cemento (Toneladas)") +
xlab("Tiempo") +
ylab("Unidad Variable 1") +
theme_minimal()
ggplotly(grafico_serie)
library(ggplot2)
library(plotly)
# Convertir la serie temporal a un vector numérico para lograr graficar con ggplot2
data_col$variable1 <- as.numeric(variable2_ts)
# Crear el gráfico
grafico_serie <- ggplot(data_col, aes(x = seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = nrow(data_col)),
y = variable1)) +
geom_line(color = "orange", linewidth = 0.4) + # Cambiado 'size' por 'linewidth'
geom_point(color = "black", size = 0.1) +
ggtitle("Variable 2: Concreto premezclado (Metros cubicos)") +
xlab("Tiempo") +
ylab("Unidad Variable 1") +
theme_minimal()
ggplotly(grafico_serie)
library(ggplot2)
library(plotly)
# Convertir la serie temporal a un vector numérico para lograr graficar con ggplot2
data_col$variable1 <- as.numeric(variable3_ts)
# Crear el gráfico
grafico_serie <- ggplot(data_col, aes(x = seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = nrow(data_col)),
y = variable1)) +
geom_line(color = "orange", linewidth = 0.4) + # Cambiado 'size' por 'linewidth'
geom_point(color = "black", size = 0.1) +
ggtitle("Variable 3: Licencias de construcción (área aprobada)") +
xlab("Tiempo") +
ylab("Unidad Variable 1") +
theme_minimal()
ggplotly(grafico_serie)
Comportamiento de las variables en conjunto:
library(ggplot2)
library(plotly)
# Convertir las 3 series a numérico
data_col$variable1_ts <- as.numeric(variable1_ts)
data_col$variable2_ts <- as.numeric(variable2_ts)
data_col$variable3_ts <- as.numeric(variable3_ts)
# Crear el gráfico
grafico_series <- ggplot(data_col, aes(
x = seq.Date(
from = as.Date("2012-01-01"),
by = "month",
length.out = nrow(data_col)
)
)) +
geom_line(aes(y = variable1_ts, color = "Ton. Producción de cemento"), linewidth = 0.6) +
geom_line(aes(y = variable2_ts, color = "Mt. Concreto Premezclado"), linewidth = 0.6) +
geom_line(aes(y = variable3_ts, color = "Área. Licencias de construcción"), linewidth = 0.6) +
labs(
title = "Evolución de las tres variables",
x = "Tiempo",
y = "Valor",
color = "Variables"
) +
theme_minimal()
ggplotly(grafico_series)
La grafica anterior permite observar que la producción de concreto premezclado y producción de cemento tienen un comportamiento similar, sin que esto signifique que la una sea causa de la otra. Es importante resaltar que aunque cada variable tiene medidas diferentes, en materia de analisis sobre el comportamiento de las mismas, el grafico presentado permite evaluar el mismo.
Sin embargo, en materia de área de licencias de construcción aprobada, el comportamiento es ligeramente mas volatil con picos bastantes altos.
Se tiene entonces y de acuerdo al grafico presentado que las tres series están expuestas a factores comunes relacionados con la dinámica económica y constructora.
Importante resaltar que para el año 2020 la caida de las 3 variables es significativa y su principal razón es la pandemia COVID 19 lo que estanco todo tipo de actividades economicas.
A continuación se hace la extracción de señales para cada una de las variables con el proposito de identificar una serie temporal en los diferentes componentes que explican su comportamiento de cada una de las variables.
Extracción señales variable 1
# Cargar librerías necesarias
library(ggplot2)
library(plotly)
# Descomposición de la serie temporal
stl_decomp_var1 <- stl(variable1_ts, s.window = "periodic")
# Convertir la descomposición a un data frame para graficar con ggplot2
stl_df_var1 <- data.frame(
Time = rep(time(variable1_ts), 4), # Tiempo repetido para cada componente (son 4 componentes)
Value = c(stl_decomp_var1$time.series[, "seasonal"],
stl_decomp_var1$time.series[, "trend"],
stl_decomp_var1$time.series[, "remainder"],
variable1_ts),
Component = rep(c("Estacional", "Tendencia", "Residuo", "Serie Original"), each = length(variable1_ts))
)
# Crear gráfico con ggplot2
p <- ggplot(stl_df_var1, aes(x = Time, y = Value, color = Component)) +
geom_line() +
facet_wrap(~Component, scales = "free_y", ncol = 1) +
theme_minimal() +
labs(title = "Descomposición temporal de la variable -Producción de cemento (Ton)",
x = "Tiempo",
y = "Valor")
# Convertir a gráfico interactivo con plotly
ggplotly(p)
Extracción señales variable 2
# Cargar librerías necesarias
library(ggplot2)
library(plotly)
# Descomposición de la serie temporal
stl_decomp_var2 <- stl(variable2_ts, s.window = "periodic")
# Convertir la descomposición a un data frame para graficar con ggplot2
stl_df_var2 <- data.frame(
Time = rep(time(variable2_ts), 4), # Tiempo repetido para cada componente
Value = c(stl_decomp_var2$time.series[, "seasonal"],
stl_decomp_var2$time.series[, "trend"],
stl_decomp_var2$time.series[, "remainder"],
variable2_ts),
Component = rep(c("Estacional", "Tendencia", "Residuo", "Serie Original"), each = length(variable2_ts))
)
# Crear gráfico con ggplot2
p <- ggplot(stl_df_var2, aes(x = Time, y = Value, color = Component)) +
geom_line() +
facet_wrap(~Component, scales = "free_y", ncol = 1) +
theme_minimal() +
labs(title = "Descomposición temporal de la variable - Concreto premezclado (Metros cubicos)",
x = "Tiempo",
y = "Valor")
# Convertir a gráfico interactivo con plotly
ggplotly(p)
Extracción señales variable 3
# Cargar librerías necesarias
library(ggplot2)
library(plotly)
# Descomposición de la serie temporal
stl_decomp_var3 <- stl(variable3_ts, s.window = "periodic")
# Convertir la descomposición a un data frame para graficar con ggplot2
stl_df_var3 <- data.frame(
Time = rep(time(variable3_ts), 4), # Tiempo repetido para cada componente
Value = c(stl_decomp_var3$time.series[, "seasonal"],
stl_decomp_var3$time.series[, "trend"],
stl_decomp_var3$time.series[, "remainder"],
variable3_ts),
Component = rep(c("Estacional", "Tendencia", "Residuo", "Serie Original"), each = length(variable3_ts))
)
# Crear gráfico con ggplot2
p <- ggplot(stl_df_var3, aes(x = Time, y = Value, color = Component)) +
geom_line() +
facet_wrap(~Component, scales = "free_y", ncol = 1) +
theme_minimal() +
labs(title = "Descomposición temporal de la variable 3",
x = "Tiempo",
y = "Valor")
# Convertir a gráfico interactivo con plotly
ggplotly(p)
Tras realizar la extracción de variables se encontró que estas tienen un componente estacional con una periodicidad anual, razón por la cual es necesario realizar un ajuste estacional.
Después de la descomposición temporal de cada variable, se extrae la variable ajustada por estacionalidad para graficarla junto con la serie original:
Se crea la variable1 ajustada por estacionalidad
# Extraer los componentes de la descomposición
variable1_sa <- variable1_ts - stl_decomp_var1$time.series[, "seasonal"]
Se crea la variable2 ajustada por estacionalidad
# Extraer los componentes de la descomposición
variable2_sa <- variable2_ts - stl_decomp_var2$time.series[, "seasonal"]
Se crea la variable3 ajustada por estacionalidad
# Extraer los componentes de la descomposición
variable3_sa <- variable3_ts - stl_decomp_var3$time.series[, "seasonal"]
Ahora si se puede graficar las series originales versus la ajustada por estacionalidad
Gráfico serie original VS ajustada Variable 1
# Crear vector de fechas correctamente alineado con la serie
fechas_var1 <- seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = length(variable1_ts))
# Gráfico mejorado con fechas en el eje X
grafico_ajustada_var1 <- ggplot() +
geom_line(aes(x = fechas_var1, y = variable1_ts), color = "orange", size = 0.5, linetype = "solid", name = "Serie Original") +
geom_line(aes(x = fechas_var1, y = variable1_sa), color = "black", size = 0.6, linetype = "solid", name = "Serie Ajustada") +
ggtitle("Producción de cemento (Ton):Serie Original vs Serie Ajustada por Estacionalidad") +
xlab("Tiempo") +
ylab("Unidad de medida variable 1") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas para mejor visualización
# Convertir a gráfico interactivo
ggplotly(grafico_ajustada_var1)
Gráfico serie original VS ajustada Variable 2
# Crear vector de fechas correctamente alineado con la serie
fechas_var2 <- seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = length(variable2_ts))
# Gráfico mejorado con fechas en el eje X
grafico_ajustada_var2 <- ggplot() +
geom_line(aes(x = fechas_var2, y = variable2_ts), color = "orange", size = 0.5, linetype = "solid", name = "Serie Original") +
geom_line(aes(x = fechas_var2, y = variable2_sa), color = "black", size = 0.6, linetype = "solid", name = "Serie Ajustada") +
ggtitle("Concreto premezclado (metro cubico):Serie Original vs Serie Ajustada por Estacionalidad") +
xlab("Tiempo") +
ylab("Unidad de medida variable 2") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas para mejor visualización
# Convertir a gráfico interactivo
ggplotly(grafico_ajustada_var2)
Gráfico serie original VS ajustada Variable 3
# Crear vector de fechas correctamente alineado con la serie
fechas_var3 <- seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = length(variable3_ts))
# Gráfico mejorado con fechas en el eje X
grafico_ajustada_var3 <- ggplot() +
geom_line(aes(x = fechas_var3, y = variable3_ts), color = "orange", size = 0.5, linetype = "solid", name = "Serie Original") +
geom_line(aes(x = fechas_var3, y = variable3_sa), color = "black", size = 0.6, linetype = "solid", name = "Serie Ajustada") +
ggtitle("Licencias de construcción (Área aprobada):Serie Original vs Serie Ajustada por Estacionalidad") +
xlab("Tiempo") +
ylab("Unidad de medida variable 3") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas para mejor visualización
# Convertir a gráfico interactivo
ggplotly(grafico_ajustada_var3)
Ahora graficamos serie original vs tendencia
Primero se debe obtener la tendencia de cada variable y luego graficarla
Tendencia Variable 1
library(ggplot2)
library(plotly)
# Convertir la serie a un vector numérico
variable1_vec <- as.numeric(variable1_ts)
tendencia_var1 <- as.numeric(stl_decomp_var1$time.series[, "trend"])
# Asegurar que 'fechas' tenga la misma longitud
fechas <- seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = length(variable1_ts))
# Gráfico interactivo de la serie original vs tendencia
grafico_tendencia_var1 <- ggplot() +
geom_line(aes(x = fechas, y = variable1_vec, color = "Serie Original"), size = 0.7, linetype = "solid") +
geom_line(aes(x = fechas, y = tendencia_var1, color = "Tendencia"), size = 0.8, linetype = "solid") +
scale_color_manual(values = c("Serie Original" = "orange", "Tendencia" = "black")) +
ggtitle("Producción de cemento: Serie Original vs Tendencia") +
xlab("Tiempo") +
ylab("Unidad de medida Variable 1") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje X
# Convertir a gráfico interactivo con plotly
ggplotly(grafico_tendencia_var1)
Tendencia Variable 2
library(ggplot2)
library(plotly)
# Convertir la serie a un vector numérico
variable2_vec <- as.numeric(variable2_ts)
tendencia_var2 <- as.numeric(stl_decomp_var2$time.series[, "trend"])
# Asegurar que 'fechas' tenga la misma longitud
fechas <- seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = length(variable2_ts))
# Gráfico interactivo de la serie original vs tendencia
grafico_tendencia_var2 <- ggplot() +
geom_line(aes(x = fechas, y = variable2_vec, color = "Serie Original"), size = 0.7, linetype = "solid") +
geom_line(aes(x = fechas, y = tendencia_var2, color = "Tendencia"), size = 0.8, linetype = "solid") +
scale_color_manual(values = c("Serie Original" = "orange", "Tendencia" = "black")) +
ggtitle("Concreto premezclado (Metros cubicos): Serie Original vs Tendencia") +
xlab("Tiempo") +
ylab("Unidad de medida Variable 2") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje X
# Convertir a gráfico interactivo con plotly
ggplotly(grafico_tendencia_var2)
Tendencia Variable 3
library(ggplot2)
library(plotly)
# Convertir la serie a un vector numérico
variable3_vec <- as.numeric(variable3_ts)
tendencia_var3 <- as.numeric(stl_decomp_var3$time.series[, "trend"])
# Asegurar que 'fechas' tenga la misma longitud
fechas <- seq.Date(from = as.Date("2012-01-01"), by = "month", length.out = length(variable3_ts))
# Gráfico interactivo de la serie original vs tendencia
grafico_tendencia_var3 <- ggplot() +
geom_line(aes(x = fechas, y = variable3_vec, color = "Serie Original"), size = 0.7, linetype = "solid") +
geom_line(aes(x = fechas, y = tendencia_var3, color = "Tendencia"), size = 0.8, linetype = "solid") +
scale_color_manual(values = c("Serie Original" = "orange", "Tendencia" = "black")) +
ggtitle("Licencias de construcción (Área aprobada): Serie Original vs Tendencia") +
xlab("Tiempo") +
ylab("Unidad de medida Variable 3") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje X
# Convertir a gráfico interactivo con plotly
ggplotly(grafico_tendencia_var3)
Ahora calculamos la tasa de crecimiento de la serie original vs tendencia:
Tasa de crecimiento de la serie de tendencia y original para la variable 1
#Cálculo de la tasa de crecimiento anual correctamente alineada
tasa_crecimiento_var1 <- (variable1_ts[(13:length(variable1_ts))] / variable1_ts[1:(length(variable1_ts) - 12)] - 1) * 100
tasa_tendencia_var1 <- (tendencia_var1[(13:length(tendencia_var1))] / tendencia_var1[1:(length(tendencia_var1) - 12)] - 1) * 100
# Crear vector de fechas corregido, es decir que inicie desde enero 2013
fechas_corregidas_var1 <- seq(from = as.Date("2013-01-01"), by = "month", length.out = length(tasa_crecimiento_var1))
# Verificar longitudes
print(length(fechas_corregidas_var1))
## [1] 156
print(length(tasa_crecimiento_var1))
## [1] 156
print(length(tasa_tendencia_var1))
## [1] 156
*Gráfico variable original y tendencia variable 1: tasa de crecimiento anual**
library(ggplot2)
library(plotly)
# Gráfico de la tasa de crecimiento anual variable 1
grafico_crecimiento_var1 <- ggplot() +
geom_line(aes(x = fechas_corregidas_var1, y = tasa_crecimiento_var1), color = "orange", size = 0.7) +
geom_line(aes(x = fechas_corregidas_var1, y = tasa_tendencia_var1), color = "black", size = 0.8, linetype = "dashed") +
ggtitle("Producción de cemento (Ton): Tasa de crecimiento anual % de la serie Original y la tendencia") +
xlab("Tiempo") +
ylab("% de Crecimiento Anual") +
theme_minimal()
# Convertir a gráfico interactivo
ggplotly(grafico_crecimiento_var1)
Ahora calculamos la tasa de crecimiento de la serie original vs tendencia: variable 2
#Cálculo de la tasa de crecimiento anual correctamente alineada
tasa_crecimiento_var2 <- (variable2_ts[(13:length(variable2_ts))] / variable2_ts[1:(length(variable2_ts) - 12)] - 1) * 100
tasa_tendencia_var2 <- (tendencia_var2[(13:length(tendencia_var2))] / tendencia_var2[1:(length(tendencia_var2) - 12)] - 1) * 100
# Crear vector de fechas corregido
fechas_corregidas_var2 <- seq(from = as.Date("2013-01-01"), by = "month", length.out = length(tasa_crecimiento_var2))
# Verificar longitudes
print(length(fechas_corregidas_var2))
## [1] 156
print(length(tasa_crecimiento_var2))
## [1] 156
print(length(tasa_tendencia_var2))
## [1] 156
# Gráfico de la tasa de crecimiento anual variable 2
grafico_crecimiento_var2 <- ggplot() +
geom_line(aes(x = fechas_corregidas_var2, y = tasa_crecimiento_var2), color = "orange", size = 0.7) +
geom_line(aes(x = fechas_corregidas_var2, y = tasa_tendencia_var2), color = "black", size = 0.8, linetype = "dashed") +
ggtitle("Concreto premezclado (Met Cúbico): Tasa de crecimiento anual % de la serie Original y la Tendencia") +
xlab("Tiempo") +
ylab("% de Crecimiento Anual") +
theme_minimal()
# Convertir a gráfico interactivo
ggplotly(grafico_crecimiento_var2)
Ahora calculamos la tasa de crecimiento de la serie original vs tendencia: variable 3
#Cálculo de la tasa de crecimiento anual correctamente alineada
tasa_crecimiento_var3 <- (variable3_ts[(13:length(variable3_ts))] / variable3_ts[1:(length(variable3_ts) - 12)] - 1) * 100
tasa_tendencia_var3 <- (tendencia_var3[(13:length(tendencia_var3))] / tendencia_var3[1:(length(tendencia_var3) - 12)] - 1) * 100
# Crear vector de fechas corregido
fechas_corregidas_var3 <- seq(from = as.Date("2013-01-01"), by = "month", length.out = length(tasa_crecimiento_var3))
# Verificar longitudes
print(length(fechas_corregidas_var3))
## [1] 156
print(length(tasa_crecimiento_var3))
## [1] 156
print(length(tasa_tendencia_var3))
## [1] 156
# Gráfico de la tasa de crecimiento anual variable 2
grafico_crecimiento_var3 <- ggplot() +
geom_line(aes(x = fechas_corregidas_var3, y = tasa_crecimiento_var3), color = "orange", size = 0.7) +
geom_line(aes(x = fechas_corregidas_var3, y = tasa_tendencia_var3), color = "black", size = 0.8, linetype = "dashed") +
ggtitle("Licencias de construcción (Área aprobada): Tasa de crecimiento anual % de la serie Original y la tendencia") +
xlab("Tiempo") +
ylab("% de Crecimiento Anual") +
theme_minimal()
# Convertir a gráfico interactivo
ggplotly(grafico_crecimiento_var3)
Analizar la tasa de crecimiento anual ayuda a detectar cambios en el entorno económico que afectan el sector. Se pueden prever crisis o períodos de auge y prepararse para ellos.
División en conjunto de entrenamiento y prueba para la variable 1 que es la elegida para pronosticar
El código siguiente divide una serie temporal (variable1_ts) en dos subconjuntos:
Conjunto de entrenamiento (train): Datos desde enero de 2012 hasta diciembre de 2024. Conjunto de prueba (test): Datos desde enero de 2025 hasta diciembre de 2025.
Esto se hace para evaluar el desempeño de modelos de predicción en datos no vistos.
# Esta división idealmente podria se 80%-70% de los datos para entrenamiento y 20%-30% para prueba o test
# En este ejemplo el conjunto de entrenamiento es: Enero 2012-Septiembre 2024 y el conjunto de prueba o test: noviembre 2024-diciembre 2024
train_size <- length(variable1_ts) - 12 # Se deja fuera los últimos 3 valores para usarlos como set de prueba.
train_ts <- window(variable1_ts, end = c(2024, 12)) # Entrenamiento hasta septiembre 2024
test_ts <- window(variable1_ts, start = c(2025, 1)) # Prueba inicia desde oct2024
Identificación automática del modelo ARIMA
library(forecast)
# Ajustar un modelo ARIMA automático sin estacionalidad, por eso se pone seasonal=FALSE
auto_arima_model_no_seasonal <- auto.arima(train_ts, seasonal = FALSE)
# Mostrar el modelo seleccionado
summary(auto_arima_model_no_seasonal)
## Series: train_ts
## ARIMA(1,1,1)
##
## Coefficients:
## ar1 ma1
## 0.3311 -0.8944
## s.e. 0.0941 0.0458
##
## sigma^2 = 1.105e+10: log likelihood = -2011.7
## AIC=4029.4 AICc=4029.56 BIC=4038.53
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 10757.97 104114.2 71724.91 -1.490755 8.833092 0.8967655
## ACF1
## Training set -0.03495811
Estimación del modelo identificado automatico y validación de Significancia de coeficientes
library(lmtest)
# Evaluar la significancia estadística de los coeficientes del modelo ARIMA
coeftest(auto_arima_model_no_seasonal)
##
## z test of coefficients:
##
## Estimate Std. Error z value Pr(>|z|)
## ar1 0.331132 0.094125 3.518 0.0004348 ***
## ma1 -0.894380 0.045792 -19.532 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Ajuste del modelo ARIMA(4,1,2) automático sin parte estacional y crearlo como variable darima_auto para luego poder graficarlo y crear la tabla
darima_auto <- Arima(train_ts,
order = c(1, 1, 1)) # Especificamos directamente (p=1, d=1, q=1)
# Mostrar resumen del modelo ajustado
summary(darima_auto)
## Series: train_ts
## ARIMA(1,1,1)
##
## Coefficients:
## ar1 ma1
## 0.3311 -0.8944
## s.e. 0.0941 0.0458
##
## sigma^2 = 1.105e+10: log likelihood = -2011.7
## AIC=4029.4 AICc=4029.56 BIC=4038.53
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 10757.97 104114.2 71724.91 -1.490755 8.833092 0.8967655
## ACF1
## Training set -0.03495811
##Validación de residuales o errores del modelo**
# Diagnóstico del modelo (los residuos deben ser ruido blanco)
checkresiduals(darima_auto) # Verificar si los residuos son aleatorios y no presentan patrones
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,1,1)
## Q* = 46.827, df = 22, p-value = 0.001546
##
## Model df: 2. Total lags used: 24
Box.test(
residuals(darima_auto),
lag = 12,
type = "Ljung-Box",
fitdf = 2
)
##
## Box-Ljung test
##
## data: residuals(darima_auto)
## X-squared = 29.478, df = 10, p-value = 0.001042
Los residuos del modelo ARIMA(1,1,1) todavía presentan autocorrelación significativa.
Pronóstico modelo ARIMA automático dentro de muestra o en el set de prueba
# Generar pronóstico para el conjunto de prueba
forecast_arima_auto <- forecast(darima_auto, h = length(test_ts)) # Predecir los valores futuros
# Crear dataframe para gráfico interactivo del pronóstico
forecast_data_auto <- data.frame(Tiempo = time(forecast_arima_auto$mean),
Pronostico = as.numeric(forecast_arima_auto$mean),
Observado = as.numeric(test_ts))
# Graficar pronóstico junto con los valores observados reales
p4auto <- ggplot(forecast_data_auto, aes(x = Tiempo)) +
geom_line(aes(y = Pronostico, color = "Pronóstico")) +
geom_line(aes(y = Observado, color = "Observado")) +
ggtitle("Pronóstico vs Observado") +
xlab("Tiempo") + ylab("variable1")
ggplotly(p4auto) # Convertir el gráfico en interactivo
Interpretación modelo automatico (1,1,1):El modelo automático (1,1,1) no es un modelo util, no es valido porque no capturan ni los puntos de quiebre y tampoco muestra el comportamiento real. Por esta razón no se avanza con el modelo.
Se procede a realizar el modela SARIMA puessto que el modelo tradicional anterior es un modelo no util. Así se espera una mejora al modelo arima tradicional ya que recoge el efecto estacional de las variables.
Identificación dautomática del modelo SARIMA
# Identificación automática modelo SARIMA
auto_arima_model <- auto.arima(train_ts) # Busca automáticamente los mejores parámetros del modelo ARIMA
print(auto_arima_model)
## Series: train_ts
## ARIMA(1,1,1)(0,0,1)[12]
##
## Coefficients:
## ar1 ma1 sma1
## 0.3726 -0.9185 0.3112
## s.e. 0.0947 0.0459 0.0770
##
## sigma^2 = 9.968e+09: log likelihood = -2003.76
## AIC=4015.52 AICc=4015.79 BIC=4027.7
A continuación, se crea el objeto darima para luegO poder graficar los valores reales y observados:
# Cargar el paquete necesario
library(forecast)
# Ajustar el modelo SARIMA(0,1,1)(0,0,1)[12] #Modelo identificado en el paso anterior
darima <- Arima(train_ts,
order = c(0, 1, 1), # (p,d,q) -> (0,1,1)
seasonal = list(order = c(0, 0, 1), # (P,D,Q) -> (1,0,0)
period = 12)) # Periodicidad estacional de 12 meses
# Mostrar resumen del modelo ajustado
summary(darima)
## Series: train_ts
## ARIMA(0,1,1)(0,0,1)[12]
##
## Coefficients:
## ma1 sma1
## -0.6520 0.2995
## s.e. 0.1053 0.0764
##
## sigma^2 = 1.068e+10: log likelihood = -2009.37
## AIC=4024.74 AICc=4024.9 BIC=4033.87
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 3735.591 102345.5 64948.53 -2.061364 8.203788 0.8120415 0.1310891
##Validación de residuales del modelo automatico SARIMA
**En el correlograma de residuos siguiente se observa que, mejora la correlación de los residuos frente a los dos modelos anteriores*
# Diagnóstico del modelo (los residuos deben ser ruido blanco)
checkresiduals(darima) # Verificar si los residuos son aleatorios y no presentan patrones
##
## Ljung-Box test
##
## data: Residuals from ARIMA(0,1,1)(0,0,1)[12]
## Q* = 24.659, df = 22, p-value = 0.3137
##
## Model df: 2. Total lags used: 24
Pronóstico con el modelo SARIMA dentro del set de prueba-Gráfico líneas
# Generar pronóstico para el conjunto de prueba
forecast_arima <- forecast(darima, h = length(test_ts)) # Predecir los valores futuros
# Crear dataframe para gráfico interactivo del pronóstico
forecast_data <- data.frame(Tiempo = time(forecast_arima$mean),
Pronostico = as.numeric(forecast_arima$mean),
Observado = as.numeric(test_ts))
# Graficar pronóstico junto con los valores observados reales
p4 <- ggplot(forecast_data, aes(x = Tiempo)) +
geom_line(aes(y = Pronostico, color = "Pronóstico")) +
geom_line(aes(y = Observado, color = "Observado")) +
ggtitle("Pronóstico vs Observado") +
xlab("Tiempo") + ylab("Unidad Variable 1")
ggplotly(p4) # Convertir el gráfico en interactivo
Pronóstico del modelo automático SARIMA en el set de prueba-Tabla
# Cargar librerías necesarias
library(forecast)
library(dplyr)
# Generar pronóstico con el modelo ARIMA identificado
arima_forecast <- forecast(auto_arima_model, h = length(test_ts))
# Crear un dataframe con los valores observados y pronosticados
forecast_table <- data.frame(
Tiempo = time(arima_forecast$mean), # Extraer las fechas del pronóstico
Observado = as.numeric(test_ts), # Valores reales
Pronosticado = as.numeric(arima_forecast$mean) # Valores pronosticados
)
# Mostrar la tabla
print(forecast_table)
## Tiempo Observado Pronosticado
## 1 2025.000 961894.1 1105499
## 2 2025.083 1066674.8 1129406
## 3 2025.167 1200759.4 1135013
## 4 2025.250 1079403.9 1152150
## 5 2025.333 1212393.3 1128942
## 6 2025.417 1097446.2 1128285
## 7 2025.500 1262045.0 1145619
## 8 2025.583 1257260.6 1161376
## 9 2025.667 1237727.4 1130025
## 10 2025.750 1271214.1 1151660
## 11 2025.833 1226493.9 1146083
## 12 2025.917 1200229.7 1137998
Pronóstico del modelo automático SARIMA fuera de muestra, es decir, en enero 2025
Es decir, le sumamos al periodo de prueba una observación más. Es decir, se estan pronosticando 3 observaciones o meses.
# Cargar librerías necesarias
library(forecast)
# Hacer un pronóstico para el siguiente mes (1 período adicional)
next_forecast <- forecast(auto_arima_model, h = length(test_ts) + 3)
# Extraer el pronóstico del próximo mes
next_month_forecast <- data.frame(
Tiempo = time(next_forecast$mean), # Extraer la fecha del pronóstico
Pronostico = as.numeric(next_forecast$mean) # Valor pronosticado
)
# Mostrar el pronóstico completo
print(next_month_forecast)
## Tiempo Pronostico
## 1 2025.000 1105499
## 2 2025.083 1129406
## 3 2025.167 1135013
## 4 2025.250 1152150
## 5 2025.333 1128942
## 6 2025.417 1128285
## 7 2025.500 1145619
## 8 2025.583 1161376
## 9 2025.667 1130025
## 10 2025.750 1151660
## 11 2025.833 1146083
## 12 2025.917 1137998
## 13 2026.000 1142876
## 14 2026.083 1144693
## 15 2026.167 1145371
# Extraer solo el valor del trimestre adicional (último de la tabla)
next_month <- tail(next_month_forecast, 1)
print(paste("Pronóstico para enero 2025:", next_month$Tiempo, "=", next_month$Pronostico))
## [1] "Pronóstico para enero 2025: 2026.16666666667 = 1145370.54448311"
El modelo SARIMA (0,1,1)(0,0,1)[12] mostro mejor desempeño mostró en la comparación entre los datos reales y los pronosticados dentro del periodo de prueba (Ene, feb y marzo 2026). Destacó por su mayor precisión en la captura de los puntos de quiebre, lo que lo hace el más confiable.
No obstante, al analizar los residuos de los modelos, se identifican posibles áreas de mejora para robustecer los pronósticos en los tres casos evaluados. Algunas estrategias podrían incluir la aplicación de una transformación logarítmica o trabajar desde el inicio con la serie ajustada por estacionalidad.
modelo_sarima <- auto.arima(
train_ts,
seasonal = TRUE,
stepwise = FALSE,
approximation = FALSE
)
summary(modelo_sarima)
## Series: train_ts
## ARIMA(1,1,1)(1,0,0)[12]
##
## Coefficients:
## ar1 ma1 sar1
## 0.3943 -0.9239 0.3348
## s.e. 0.0977 0.0484 0.0759
##
## sigma^2 = 9.808e+09: log likelihood = -2002.59
## AIC=4013.18 AICc=4013.45 BIC=4025.36
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 8448.329 97759.77 64864.66 -1.502661 8.054301 0.8109929
## ACF1
## Training set -0.03353599
# Diagnóstico del modelo (los residuos deben ser ruido blanco)
checkresiduals(modelo_sarima) # Verificar si los residuos son aleatorios y no presentan patrones
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,1,1)(1,0,0)[12]
## Q* = 11.217, df = 21, p-value = 0.9584
##
## Model df: 3. Total lags used: 24
# Generar pronóstico para el conjunto de prueba
forecast_arima <- forecast(modelo_sarima, h = length(test_ts)) # Predecir los valores futuros
# Crear dataframe para gráfico interactivo del pronóstico
forecast_data <- data.frame(Tiempo = time(forecast_arima$mean),
Pronostico = as.numeric(forecast_arima$mean),
Observado = as.numeric(test_ts))
# Graficar pronóstico junto con los valores observados reales
p4 <- ggplot(forecast_data, aes(x = Tiempo)) +
geom_line(aes(y = Pronostico, color = "Pronóstico")) +
geom_line(aes(y = Observado, color = "Observado")) +
ggtitle("Pronóstico vs Observado") +
xlab("Tiempo") + ylab("Unidad Variable 1")
ggplotly(p4) # Convertir el gráfico en interactivo
Box.test(
residuals(modelo_sarima),
lag = 12,
type = "Ljung-Box",
fitdf = 3
)
##
## Box-Ljung test
##
## data: residuals(modelo_sarima)
## X-squared = 5.9086, df = 9, p-value = 0.749
pronostico <- forecast(modelo_sarima, h = length(test_ts))
accuracy(pronostico, test_ts)
## ME RMSE MAE MPE MAPE MASE
## Training set 8448.329 97759.77 64864.66 -1.502661 8.054301 0.8109929
## Test set 38725.267 88136.10 83032.93 2.743728 7.089190 1.0381480
## ACF1 Theil's U
## Training set -0.03353599 NA
## Test set 0.21061642 0.8034557
El modelo SARIMA(1,1,1)(1,0,0)[12] presentó un mejor desempeño para entrenamiento y prueba. Se obtuvo un p-value de 0,749, por lo que no se encontró evidencia estadísticamente significativa de autocorrelación en los residuos.
# Cargar librerías necesarias
library(forecast)
library(dplyr)
# Generar pronóstico con el modelo SARIMA identificado
sarima_forecast <- forecast(modelo_sarima, h = length(test_ts))
# Crear un dataframe con los valores observados y pronosticados
forecast_table_sarima <- data.frame(
Tiempo = time(sarima_forecast$mean), # Fechas del pronóstico
Observado = as.numeric(test_ts), # Valores reales
Pronosticado = as.numeric(sarima_forecast$mean) # Valores pronosticados
)
# Mostrar la tabla
print(forecast_table_sarima)
## Tiempo Observado Pronosticado
## 1 2025.000 961894.1 1086799
## 2 2025.083 1066674.8 1122037
## 3 2025.167 1200759.4 1132897
## 4 2025.250 1079403.9 1144597
## 5 2025.333 1212393.3 1127455
## 6 2025.417 1097446.2 1117832
## 7 2025.500 1262045.0 1147582
## 8 2025.583 1257260.6 1158816
## 9 2025.667 1237727.4 1132624
## 10 2025.750 1271214.1 1156921
## 11 2025.833 1226493.9 1136680
## 12 2025.917 1200229.7 1144599
# Cargar librerías necesarias
library(forecast)
# Hacer un pronóstico para el siguiente mes (1 período adicional)
next_forecast <- forecast(modelo_sarima, h = length(test_ts) + 3)
# Extraer el pronóstico del próximo mes
next_month_forecast <- data.frame(
Tiempo = time(next_forecast$mean), # Extraer la fecha del pronóstico
Pronostico = as.numeric(next_forecast$mean) # Valor pronosticado
)
# Mostrar el pronóstico completo
print(next_month_forecast)
## Tiempo Pronostico
## 1 2025.000 1086799
## 2 2025.083 1122037
## 3 2025.167 1132897
## 4 2025.250 1144597
## 5 2025.333 1127455
## 6 2025.417 1117832
## 7 2025.500 1147582
## 8 2025.583 1158816
## 9 2025.667 1132624
## 10 2025.750 1156921
## 11 2025.833 1136680
## 12 2025.917 1144599
## 13 2026.000 1121348
## 14 2026.083 1133145
## 15 2026.167 1136780
# Extraer solo el valor del trimestre adicional (último de la tabla)
next_month <- tail(next_month_forecast, 1)
print(paste("Pronóstico para enero 2025:", next_month$Tiempo, "=", next_month$Pronostico))
## [1] "Pronóstico para enero 2025: 2026.16666666667 = 1136779.99816516"
El sector construcción muestra estabilidad con una suave tendencia de crecimiento. Se observa entonces que si bien para enero 2026 la proyección de producción de cemento es de una leve caida, en los meses de febrero y marzo se espera que se recupere nuevamente.
En materia de uso de modelos, inicialmente se uso el modelo ARIMA (1,1,1), sin embargo este modelo y dada la estacionalidad que presentan las variables resulto no ser viable, pues no lograba captar los puntos de quiebre y su pronostico era lineal. Por esta razón, fue necesario el uso de un model SARIMA que tuviera en cuenta la estacionalidad presentada los meses 12 de cada año quedando de la siguiente manera:
ARIMA(1,1,1)(1,0,0)[12]