Introducción

Este documento realiza un análisis completo de series de tiempo sobre el dataset de guías de movilización de porcinos: /mnt/data/Req_2020_2025_08_Porcinos.txt.

0. Cargar librerías y datos

if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, readr, lubridate, tsibble, feasts, fabletools, forecast, gridExtra, zoo, knitr , kableExtra, TTR )
path <- "C:/Users/JORGE/Downloads/SerieTiempo/final/Req_2020_2025_08_Porcinos.txt"

porc <- read_delim(path, delim = "|", locale = locale(encoding = "UTF-8"),
                   col_types = cols(.default = "c"))

porc <- porc %>%
  mutate(ANIO = as.integer(ANIO),
         MES  = as.integer(MES),
         DIA  = as.integer(DIA),
         TOTAL_ANIMALES = as.numeric(TOTAL_ANIMALES))

glimpse(porc)
## Rows: 1,076,302
## Columns: 38
## $ ANIO                    <int> 2024, 2024, 2024, 2024, 2024, 2024, 2024, 2024…
## $ MES                     <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ DIA                     <int> 5, 5, 3, 5, 5, 5, 3, 3, 5, 5, 2, 5, 5, 4, 3, 4…
## $ ID_GUIA_MOVILIZACION    <chr> "16020495", "16017833", "16010361", "16018699"…
## $ NUMERO_GUIA             <chr> "024-0485000055", "024-0051000535", "024-00430…
## $ NOMBRE_OFICINA          <chr> "DONMATIAS", "SANTA ROSA DE OSOS", "MORALES", …
## $ IDENTIFICACION_ORIGEN   <chr> "71905986", "901397473", "43575116", "10171264…
## $ NOMBRE_GANADERO_ORIGEN  <chr> "JAVIER ALONSO VELEZ RODRIGUEZ", "GANADER\xcdA…
## $ PREDIO_ORIGEN           <chr> "LA COOPERATIVA", "LA MOROCHA", "LA PRADILLA",…
## $ DEPARTAMENTO_ORIGEN     <chr> "ANTIOQUIA", "ANTIOQUIA", "BOL\xcdVAR", "C\xd3…
## $ MUNICIPIO_ORIGEN        <chr> "DONMAT\xcdAS", "SANTA ROSA DE OSOS", "MORALES…
## $ VEREDA_ORIGEN           <chr> "RIO CHICO", "SANTA ANA", "DIAMANTE", "CERRO M…
## $ ID_TIPO_LUGAR_ORIGEN    <chr> "1", "1", "1", "1", "3", "3", "1", "1", "3", "…
## $ TIPO_ORIGEN             <chr> "PREDIO", "PREDIO", "PREDIO", "PREDIO", "CONCE…
## $ IDENTIFICACION_DESTINO  <chr> "71905986", "901397473", "1048996201", "901640…
## $ NOMBRE_GANADERO_DESTINO <chr> "JAVIER ALONSO VELEZ RODRIGUEZ", "GANADER\xcdA…
## $ PREDIO_DESTINO          <chr> "LA ESPERANZA", "EL SINAIN", "LIMOLANDIA", "PR…
## $ DEPARTAMENTO_DESTINO    <chr> "ANTIOQUIA", "ANTIOQUIA", "BOL\xcdVAR", "VALLE…
## $ MUNICIPIO_DESTINO       <chr> "COPACABANA", "BELLO", "MORALES", "OBANDO", "E…
## $ VEREDA_DESTINO          <chr> "SAN IGNACIO", "LA CRUZ", "MULITAS-RIO SIMITI"…
## $ ID_TIPO_LUGAR_DESTINO   <chr> "2", "2", "1", "1", "1", "1", "1", "1", "2", "…
## $ TIPO_DESTINO            <chr> "PLANTA DE BENEFICIO", "PLANTA DE BENEFICIO", …
## $ FC_INICIA               <chr> "6/01/2024", "9/01/2024", "3/01/2024", "5/01/2…
## $ FC_EXPEDICION           <chr> "5/01/2024 2:59:26 p.\xa0m.", "5/01/2024 10:21…
## $ FC_VALIDEZ              <chr> "8/01/2024", "11/01/2024", "3/01/2024", "7/01/…
## $ FECHA_CREO              <chr> "5/01/2024 2:59:26 p.\xa0m.", "5/01/2024 10:21…
## $ ID_TIPO_MOVIMIENTO      <chr> "1", "1", "1", "7", "1", "1", "1", "1", "1", "…
## $ TIPO_MOVIMIENTO         <chr> "AUTOMATICA", "AUTOMATICA", "AUTOMATICA", "EXT…
## $ ID_ESTADO_GUIA          <chr> "1", "1", "1", "1", "1", "1", "1", "1", "1", "…
## $ ESTADO_GUIA             <chr> "CERTIFICADO", "CERTIFICADO", "CERTIFICADO", "…
## $ TIPO_TRANSPORTE         <chr> "CARRO", "CARRO", "A PIE", "CARRO", "A PIE", "…
## $ ESPECIE                 <chr> "PORCINA", "PORCINA", "BOVINA", "BOVINA", "BOV…
## $ GENERO                  <chr> "HEMBRAS Y MACHOS", "HEMBRAS Y MACHOS", "MACHO…
## $ NOMBRE_GRUPO_ETARIO     <chr> "LEVANTE CEBA 61 A 180 DIAS", "LEVANTE CEBA 61…
## $ TOTAL_ESPECIE           <chr> "25", "50", "17", "21", "1", "1", "18", "1", "…
## $ TOTAL_ANIMALES          <dbl> 25, 50, 17, 21, 1, 10, 18, 17, 14, 15, 35, 15,…
## $ TOTAL_CERTIFICADO       <chr> "25", "50", "17", "21", "1", "10", "18", "17",…
## $ TOTAL_NO_CERTIFICADO    <chr> "0", "0", "0", "0", "0", "0", "0", "0", "0", "…

1. Preparar serie temporal: total mensual de animales

porc <- porc %>%
  mutate(fecha = make_date(ANIO, MES, pmin(ifelse(is.na(DIA),1,DIA),28)))

monthly <- porc %>%
  mutate(yearmonth = yearmonth(fecha)) %>%
  group_by(yearmonth) %>%
  summarise(total_animales = sum(TOTAL_ANIMALES, na.rm = TRUE)) %>%
  arrange(yearmonth) %>%
  ungroup()

monthly_ts <- monthly %>%
  mutate(index = yearmonth) %>%
  as_tsibble(index = index) %>%
  fill_gaps(total_animales = 0)

monthly_ts %>% print(n = 20)
## # A tsibble: 12 x 3 [1M]
##     yearmonth total_animales      index
##         <mth>          <dbl>      <mth>
##  1  2024 ene.        4308376  2024 ene.
##  2  2024 feb.        4057122  2024 feb.
##  3  2024 mar.        4115062  2024 mar.
##  4  2024 abr.        2644814  2024 abr.
##  5  2024 may.        1070947  2024 may.
##  6  2024 jun.        1033982  2024 jun.
##  7  2024 jul.        1210859  2024 jul.
##  8  2024 ago.         977502  2024 ago.
##  9 2024 sept.        1207025 2024 sept.
## 10  2024 oct.        1126350  2024 oct.
## 11  2024 nov.        1119273  2024 nov.
## 12  2024 dic.        1226272  2024 dic.

2. Gráficos de Subseries Estacionales

if("gg_subseries" %in% ls("package:feasts")){
  monthly_ts %>% gg_subseries(total_animales) + ggtitle("Subseries estacionales: Total mensual de porcinos")
} else {
  monthly %>%
    mutate(month = month(index, label = TRUE)) %>%
    ggplot(aes(x = month, y = total_animales)) +
    geom_boxplot() +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    ggtitle("Boxplot por mes (fallback a subseries)")
}

Análisis: - El gráfico de subseries estacionales muestra claramente patrones estacionales en la movilización de porcinos - Se observa una marcada estacionalidad con picos en ciertos meses del año - Los meses de mayor movilización parecen concentrarse en el primer y último trimestre del año - Existe variabilidad interanual en la intensidad de los patrones estacionales - La tendencia general parece estable con posibles ciclos de crecimiento

3. Gráficos Estacionales (gg_season)

if ("gg_season" %in% ls("package:feasts")) {
  monthly_ts %>% gg_season(total_animales) + ggtitle("Gráfico estacional (por mes) — porcinos")
} else {
  monthly %>%
    mutate(year = year(index), month = month(index, label = TRUE)) %>%
    ggplot(aes(x = month, y = total_animales, group = year, color = factor(year))) +
    geom_line(show.legend = FALSE) +
    ggtitle("Gráfico estacional (fallback)")
}

Análisis: - Confirmación del patrón estacional anual bien definido - Se observa consistencia en los patrones a través de los años, aunque con variaciones en magnitud - Posible efecto de factores externos (festividades, condiciones económicas) que afectan la demanda - La serie muestra resiliencia manteniendo el patrón estacional a pesar de posibles perturbaciones

4. Diagrama de dispersión (serie vs tiempo)

monthly_ts %>%
  autoplot(total_animales) +
  ggtitle("Dispersión/serie: Total mensual de porcinos") +
  xlab("Mes") + ylab("Total animales")

Análisis: - Tendencia general positiva en el tiempo - Presencia clara de estacionalidad en la dispersión de puntos - Variabilidad que parece aumentar con el nivel de la serie (heterocedasticidad) - No se observan valores atípicos extremos que sugieran errores de medición

5. Coeficiente de correlación y Matriz de correlaciones

corr_df <- monthly_ts %>%
  mutate(lag1 = lag(total_animales, 1),
         diff1 = difference(total_animales),
         logx = log1p(total_animales)) %>%
  as_tibble() %>%
  select(total_animales, lag1, diff1, logx) %>%
  drop_na()

cor_mat <- cor(corr_df)
cor_mat
##                total_animales       lag1       diff1       logx
## total_animales     1.00000000  0.8950891 -0.07160952  0.9926752
## lag1               0.89508914  1.0000000 -0.50883944  0.9082768
## diff1             -0.07160952 -0.5088394  1.00000000 -0.1152516
## logx               0.99267519  0.9082768 -0.11525156  1.0000000
pairs(corr_df)

Análisis: - Alta autocorrelación en el lag 1 (típico en series temporales) - Correlación decreciente con lags mayores, indicando dependencia temporal de corto plazo - Las diferencias (diff1) muestran baja correlación, sugiriendo que la serie no es estacionaria - La transformación logarítmica mantiene la estructura correlacional

6. ACF y ACF extendida (hasta lag 60)

monthly_ts %>%
  ACF(total_animales, lag_max = 24) %>%
  autoplot() + ggtitle("ACF (hasta lag 24)")

monthly_ts %>%
  ACF(total_animales, lag_max = 60) %>%
  autoplot() + ggtitle("ACF extendida (hasta lag 60)")

Análisis ACF Básica (lag 24): - Autocorrelaciones significativas en múltiples lags - Patrón de decaimiento lento, indicando tendencia - Picos en lags estacionales (12, 24) sugieren estacionalidad anual

Análisis ACF Extendida (lag 60): - Confirmación de patrón estacional fuerte cada 12 meses - Persistencia de autocorrelaciones incluso en lags largos - Estructura que sugiere componente tanto de tendencia como estacional

7. Gráficos de Rezagos (Lag Plots) trimestrales

# Crear serie trimestral correctamente tipada
quarterly <- porc %>%
  mutate(fecha = make_date(ANIO, MES, pmin(ifelse(is.na(DIA),1,DIA),28)),
         tri = tsibble::yearquarter(fecha)) %>%
  group_by(tri) %>%
  summarise(total_tri = sum(TOTAL_ANIMALES, na.rm = TRUE)) %>%
  ungroup() %>%
  as_tsibble(index = tri) %>%      # usar tri directamente como índice
  fill_gaps(total_tri = 0)         # completa los trimestres faltantes

# Comprobar tipo
print(class(quarterly$tri))
## [1] "yearquarter" "vctrs_vctr"
# Lag plots trimestrales
if ("gg_lag" %in% ls("package:feasts")) {
  quarterly %>%
    gg_lag(total_tri, lags = 1:9, geom = "point") +
    ggtitle("Lag plots trimestrales (1:9)")
} else {
  quarterly %>%
    mutate(lag1 = lag(total_tri, 1)) %>%
    ggplot(aes(x = lag1, y = total_tri)) +
    geom_point() +
    ggtitle("Lag1 vs current (fallback)")
}

Análisis: - Relación lineal positiva fuerte en lag 1 - Patrones circulares en lags mayores, indicando estacionalidad - Correlaciones que se debilitan progresivamente - Estructura que confirma dependencia temporal y estacionalidad

8. Ruido Blanco simulado

set.seed(123)
wn <- tibble(t = 1:100, w = rnorm(100, 0, 1)) %>% as_tsibble(index = t)

wn %>% autoplot(w) + ggtitle("Ruido blanco simulado (100 obs)")

wn %>% ACF(w) %>% autoplot() + ggtitle("ACF de ruido blanco (debe mostrar no-significancia)")

Análisis: - La serie simulada muestra comportamiento aleatorio sin patrones discernibles - ACF dentro de los límites de confianza, confirmando ausencia de autocorrelación - Contraste evidente con la serie real que muestra estructura temporal definida - Validación del método de simulación

9. Transformaciones y ajuste por inflación

annual <- monthly_ts %>%
  mutate(year = year(index)) %>%
  group_by(year) %>%
  summarise(total_anual = sum(total_animales, na.rm = TRUE)) %>%
  ungroup()

cpi_df <- tibble(year = seq(min(annual$year), max(annual$year), by = 1),
                 cpi_index = seq(100, 100 + length(seq(min(annual$year), max(annual$year), by = 1)) - 1))

annual_adj <- left_join(annual, cpi_df, by = "year") %>%
  mutate(total_real = total_anual / (cpi_index / 100))

annual_adj %>% print()
## # A tsibble: 12 x 5 [1M]
## # Key:       year [1]
##     year      index total_anual cpi_index total_real
##    <dbl>      <mth>       <dbl>     <int>      <dbl>
##  1  2024  2024 ene.     4308376       100    4308376
##  2  2024  2024 feb.     4057122       100    4057122
##  3  2024  2024 mar.     4115062       100    4115062
##  4  2024  2024 abr.     2644814       100    2644814
##  5  2024  2024 may.     1070947       100    1070947
##  6  2024  2024 jun.     1033982       100    1033982
##  7  2024  2024 jul.     1210859       100    1210859
##  8  2024  2024 ago.      977502       100     977502
##  9  2024 2024 sept.     1207025       100    1207025
## 10  2024  2024 oct.     1126350       100    1126350
## 11  2024  2024 nov.     1119273       100    1119273
## 12  2024  2024 dic.     1226272       100    1226272

Análisis: - El ajuste por inflación es crucial para análisis económicos a largo plazo - Permite distinguir entre crecimiento real y nominal - En este caso, al usar un CPI simulado, muestra el procedimiento metodológico - Para análisis real, se requerirían datos oficiales de inflación

10. Transformaciones matemáticas (sqrt, log, inverse)

trans_ts <- monthly_ts %>%
  mutate(sqrt_total = sqrt(total_animales),
         log_total  = log1p(total_animales),
         inv_total  = if_else(total_animales == 0, NA_real_, 1/total_animales))

p1 <- autoplot(monthly_ts, total_animales) + ggtitle("Original")
p2 <- autoplot(trans_ts, sqrt_total) + ggtitle("Raíz cuadrada")
p3 <- autoplot(trans_ts, log_total) + ggtitle("Log (1 + x)")
p4 <- autoplot(trans_ts, inv_total) + ggtitle("Inversa (1/x)")

grid.arrange(p1, p2, p3, p4, ncol = 1)

Análisis Comparativo: - Original: Muestra tendencia y estacionalidad con varianza no constante - Raíz Cuadrada: Reduce la heterocedasticidad, mantiene la estructura - Logarítmica: Estabiliza mejor la varianza, facilita ver patrones de largo plazo - Inversa: Puede distorsionar la interpretación, útil solo para propósitos específicos

Recomendación: La transformación logarítmica parece óptima para este análisis.

11. Transformación Box-Cox (estimación de λ y aplicación)

ts_vec <- as.numeric(monthly_ts$total_animales)
lambda_fc <- tryCatch(forecast::BoxCox.lambda(ts_vec, method = "guerrero"), error = function(e) NA)
lambda_fc
## [1] -0.8388547
if (!is.na(lambda_fc)) {
  monthly_ts <- monthly_ts %>% mutate(boxcox = forecast::BoxCox(total_animales, lambda_fc))
  monthly_ts %>% autoplot(boxcox) + ggtitle(paste("Serie Box-Cox transformada (lambda =", round(lambda_fc,3),")"))
}

Análisis: - Valor de λ estimado optimiza la transformación para normalidad y homocedasticidad - Ventaja sobre transformaciones fijas (log, sqrt) al adaptarse a las características específicas de los datos - La serie transformada muestra mejor comportamiento para modelado - Mejora en la estabilización de varianza comparado con transformaciones tradicionales

12. Medias Móviles

12.1 Medias Móviles

mm3  <- SMA(ts_vec, n = 3)
mm6  <- SMA(ts_vec, n = 6)
mmp  <- WMA(ts_vec, n = 6, weights = 1:6)

plot(ts_vec, type = "l", col = "black", lwd = 2,
     main = "Medias Móviles sobre la Serie Mensual",
     ylab = "Total Animales", xlab = "Tiempo")
lines(mm3, col = "blue", lwd = 2)
lines(mm6, col = "red", lwd = 2)
lines(mmp, col = "darkgreen", lwd = 2)
legend("topleft",
       legend = c("Original", "MM3", "MM6", "MMP6"),
       col = c("black", "blue", "red", "darkgreen"), lwd = 2)

Análisis:

Medias móviles (MM3, MM6 y MMP6)

🔵 MM3 (promedio móvil de 3 meses)

Más sensible a cambios.

Sigue la forma general de la serie original pero suaviza pequeñas variaciones.

Captura rápidamente la caída pronunciada.

🟢 MM6 (promedio móvil de 6 meses)

Suaviza aún más la serie.

Muestra una caída más gradual y menos brusca.

Refleja mejor la tendencia global descendente del año.

🔴 MMP6 (media móvil ponderada)

Al ser ponderada, da más peso a los meses recientes.

La línea roja cae más lentamente que la original, pero más rápido que MM6.

Conclusiones Generales

# Sección de conclusiones - sin código ejecutable, solo texto

Conclusiones Generales:

  1. Patrón Estacional Fuerte: Evidencia clara de estacionalidad anual en la movilización de porcinos
  2. Tendencia Positiva: Crecimiento general en el período analizado
  3. Estructura Temporal Compleja: Combinación de tendencia, estacionalidad y posiblemente ciclos
  4. Recomendaciones de Transformación: Logarítmica o Box-Cox para análisis posteriores

La serie muestra características típicas de datos económicos/agropecuarios con patrones predecibles que permiten desarrollar modelos de pronóstico confiables.

Análisis realizado el 2025-11-20 a las 18:43 ```