library(readxl) # Para leer archivos Excel
library(tseries) # Para pruebas de estacionariedad
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(forecast) # Para modelado ARIMA y pronósticos
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)
library(readxl)
data_col <- read_excel("C:/Extraccion de señales/VALLE MENSUAL.xlsx", col_types = c("date",
"numeric"))
micro_ts <- ts(data_col$PEAJ, start = c(2003, 1), frequency = 12)
micro_ts
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct
## 2003 126372 127553 133477 122253 135242 135723 154467 134949 139062 137077
## 2004 124686 134115 139309 131233 138613 133830 145647 142900 104012 154691
## 2005 133323 138548 138009 148975 144459 152570 141812 155972 152468 147257
## 2006 141378 147635 161650 139162 152854 175669 175004 170946 175981 174559
## 2007 164282 161105 181846 159190 181635 174000 176256 182359 179406 179109
## 2008 168332 163954 161442 173655 164361 168859 185212 146575 191556 184489
## 2009 165498 159412 172259 149913 183166 158769 187328 172803 177691 180482
## 2010 174935 169876 180367 177444 186658 194516 200213 205483 212046 209952
## 2011 203017 162096 238378 196802 220772 204736 230408 235700 231876 220023
## 2012 220673 215773 228878 196841 226518 238681 239532 242906 231876 225243
## 2013 219522 194894 190224 224427 220127 211205 236668 199715 252150 259103
## 2014 216772 221498 236260 231200 255138 232104 262883 245485 254662 254474
## 2015 241253 242923 226452 251783 250666 243628 264117 257276 262371 271406
## 2016 250994 241885 252140 253534 256067 206997 217314 311845 278667 272559
## 2017 244507 253115 248122 254709 202263 275327 277330 268203 267848 256356
## 2018 246692 245523 250352 267973 272853 267620 277152 302392 282098 289234
## 2019 275994 269796 261828 254760 290754 264878 289939 292007 290339 304359
## 2020 288710 287089 259649 232304 271096 249798 281780 276890 292859 299014
## 2021 290041 296623 314885 268417 377 189033 313590 277356 274015 224261
## 2022 286483 277772 304773 272582 287796 288711 292082 306132 311371 284250
## 2023 253312 211511 267049 256738 280674 280195 267263 279690 287338 285077
## 2024 278778 268717 274690 290211 288110 279135 298074 310308 285635 313315
## Nov Dec
## 2003 137445 127652
## 2004 146193 134874
## 2005 150734 155755
## 2006 171426 159783
## 2007 179053 165144
## 2008 170707 181316
## 2009 174636 174933
## 2010 195112 188643
## 2011 219008 222367
## 2012 222391 215578
## 2013 234742 230092
## 2014 246780 242635
## 2015 249992 252884
## 2016 266253 266687
## 2017 256968 251578
## 2018 278807 260093
## 2019 286975 287236
## 2020 291256 295327
## 2021 228856 292826
## 2022 0 294836
## 2023 276044 269406
## 2024 308366 0
# Calcular estadísticas descriptivas básicas
descriptive_stats <- data.frame(
Min = min(micro_ts),
Max = max(micro_ts),
Media = mean(micro_ts),
Mediana = median(micro_ts),
DesviacionEstandar = sd(micro_ts),
CoefVar = sd(micro_ts) / mean(micro_ts)
)
print(descriptive_stats)
## Min Max Media Mediana DesviacionEstandar CoefVar
## 1 0 314885 219599.5 229485 59045.31 0.2688772
library(ggplot2)
library(plotly)
# 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.Transito de vehiculos de carga por peajes") +
xlab("Tiempo") +
ylab("Número vehiculos") +
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. Transito de vehiculos de carga por los peajes",
x = "Tiempo",
y = "numero de vehiculos")
# 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("2003-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. Transito vehiculos carga:Serie Original vs Serie Ajustada por Estacionalidad") +
xlab("Tiempo") +
ylab("Número de vehiculos") +
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. Transito vehiculos de carga:Serie Original vs Tendencia") +
xlab("Tiempo") +
ylab("Número de vehiculos de carga") +
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("2004-01-01"), by = "month", length.out = length(tasa_crecimiento))
# Verificar longitudes
print(length(fechas_corregidas))
## [1] 252
print(length(tasa_crecimiento))
## [1] 252
print(length(tasa_tendencia))
## [1] 252
# 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. Transito de vehiculos de Carga: 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)
#Cálculo de la tasa de crecimiento anual correctamente alineada
tasa_crecimiento <- (micro_ts[(241:length(micro_ts))] / micro_ts[1:(length(micro_ts) - 240)] - 1) * 100
tasa_tendencia <- (tendencia[(241:length(tendencia))] / tendencia[1:(length(tendencia) - 240)] - 1) * 100
# Crear vector de fechas corregido
fechas_corregidas <- seq(from = as.Date("2023-01-01"), by = "month", length.out = length(tasa_crecimiento))
# Verificar longitudes
print(length(fechas_corregidas))
## [1] 24
# 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. Transito de vehiculos de Carga: 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)