Series de tiempo

Series de tiempo

Las series de tiempo son conjuntos de datos ordenados temporalmente, donde las observaciones se registran en intervalos regulares. Estas observaciones pueden ser medidas de una variable específica a lo largo del tiempo, como la temperatura diaria, el precio de las acciones, la producción mensual de una fábrica, entre otros.

Al analizar series de tiempo, se busca identificar patrones, tendencias, estacionalidades y posibles eventos anómalos. Algunas características comunes de las series de tiempo incluyen:

Tendencia: La dirección general en la que se mueve la serie a lo largo del tiempo. Puede ser ascendente, descendente o permanecer constante.

Estacionalidad: Patrones recurrentes o ciclos que se repiten a intervalos fijos, como estacionalidades anuales, mensuales o diarias.

Ciclos: Variaciones de más largo plazo que no se deben a estacionalidades y que pueden ser influenciadas por factores económicos, sociales o políticos.

Componente irregular: Variaciones impredecibles y no sistemáticas que pueden deberse a eventos aleatorios o factores no modelados.

El análisis de series temporales es útil en diversas áreas, como la predicción de tendencias futuras, la identificación de patrones estacionales, la detección de anomalías y la toma de decisiones basada en datos históricos.

Algunas técnicas comunes utilizadas en el análisis de series temporales incluyen:

Descomposición de series temporales: Separar la serie en sus componentes de tendencia, estacionalidad y componente irregular.

Modelos ARIMA (Autoregressive Integrated Moving Average): Un enfoque estadístico para modelar y predecir series temporales.

Modelos de suavizado exponencial: Métodos que asignan pesos a las observaciones pasadas para predecir valores futuros.

Modelos de regresión: Utilizar variables explicativas para modelar la relación entre la serie temporal y otros factores.

Redes neuronales recurrentes (RNN) y modelos de aprendizaje profundo: Enfoques más avanzados que pueden capturar patrones complejos en series temporales.

El análisis de series temporales es una herramienta valiosa en diversos campos, como finanzas, economía, meteorología, ciencia de datos y más.

PESCA DE BACALAO

colnames(pescadebacalao)<- c("mes","AÑO1", "AÑO2")

tabla_kable <- kable(pescadebacalao, format = "html", caption = "Capturas mensuales de bacalao")

# Aplicar estilos con kableExtra
tabla_kable_styled <- tabla_kable %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

# Imprimir la tabla
tabla_kable_styled

dc2<-data.frame(
  tiempo=1:24,
  valor= c(pescadebacalao$AÑO1, pescadebacalao$AÑO2)
)
  
dc2

##    tiempo valor
## 1       1   362
## 2       2   381
## 3       3   317
## 4       4   297
## 5       5   399
## 6       6   402
## 7       7   375
## 8       8   349
## 9       9   386
## 10     10   328
## 11     11   389
## 12     12   343
## 13     13   276
## 14     14   334
## 15     15   394
## 16     16   334
## 17     17   384
## 18     18   314
## 19     19   344
## 20     20   337
## 21     21   345
## 22     22   362
## 23     23   314
## 24     24   365

# Crear un gráfico de tendencia con ggplot2
grafico_tendencia <- ggplot(dc2, aes(x = tiempo, y = valor)) +
  geom_line() +
  labs(title = "pesca de bacalao", x = "Tiempo", y = "Valor")

# Imprimir el gráfico
print(grafico_tendencia)

modregresion24<- lm(valor~1, data = dc2)
anova(modregresion24)

## Analysis of Variance Table
## 
## Response: valor
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 23  26315  1144.1

summary(modregresion24)

## 
## Call:
## lm(formula = valor ~ 1, data = dc2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -75.292 -18.792  -4.292  30.458  50.708 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  351.292      6.904   50.88   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 33.82 on 23 degrees of freedom

modregresion2<- lm(valor~tiempo, data = dc2)
anova(modregresion2)

## Analysis of Variance Table
## 
## Response: valor
##           Df  Sum Sq Mean Sq F value Pr(>F)
## tiempo     1   846.2  846.25   0.731 0.4018
## Residuals 22 25468.7 1157.67

summary(modregresion2)

## 
## Call:
## lm(formula = valor ~ tiempo, data = dc2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -74.863 -18.363  -0.436  25.606  45.132 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 362.0145    14.3363  25.252   <2e-16 ***
## tiempo       -0.8578     1.0033  -0.855    0.402    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 34.02 on 22 degrees of freedom
## Multiple R-squared:  0.03216,    Adjusted R-squared:  -0.01183 
## F-statistic: 0.731 on 1 and 22 DF,  p-value: 0.4018

VENTA DE CALCULADORAS

vdc <- data.frame(
  mesvdc = c('enero', 'febrero', 'marzo', 'abril', 'mayo', 'junio', 'julio', 'agosto', 'septiembre', 'octubre', 'noviembre', 'diciembre'),
  AÑO1vdc = c(197, 211, 203, 247, 239, 269, 308, 262, 258, 256, 261, 288),
  AÑO2vdc = c(296, 276, 305, 308, 356, 393, 363, 386, 443, 308, 358, 384)
)
View(vdc)

colnames(vdc)<- c("mesvdc","AÑO1vdc", "AÑO2vdc")

tabla_kablevdc <- kable(vdc, format = "html", caption = "capturas mensuales ventas de calculadoras")

# Aplicar estilos con kableExtra
tabla_kable_styledvdc <- tabla_kablevdc %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

# Imprimir la tabla
tabla_kable_styledvdc

dcvdc<-data.frame(
  tiempovdc=1:24,
  valorvdc= c(vdc$AÑO1, vdc$AÑO2)
)
  
dcvdc

##    tiempovdc valorvdc
## 1          1      197
## 2          2      211
## 3          3      203
## 4          4      247
## 5          5      239
## 6          6      269
## 7          7      308
## 8          8      262
## 9          9      258
## 10        10      256
## 11        11      261
## 12        12      288
## 13        13      296
## 14        14      276
## 15        15      305
## 16        16      308
## 17        17      356
## 18        18      393
## 19        19      363
## 20        20      386
## 21        21      443
## 22        22      308
## 23        23      358
## 24        24      384

# Crear un gráfico de tendencia con ggplot2
grafico_tendenciavdc <- ggplot(dcvdc, aes(x = tiempovdc, y = valorvdc)) +
  geom_line() +
  labs(title = "ventas de calculadoras", x = "Tiempo", y = "Valor")

# Imprimir el gráfico
print(grafico_tendenciavdc)

MODELO LINEAL

modregresionvdc<- lm(valorvdc~tiempovdc, data = dcvdc)
anova(modregresionvdc)

## Analysis of Variance Table
## 
## Response: valorvdc
##           Df Sum Sq Mean Sq F value    Pr(>F)    
## tiempovdc  1  74974   74974  74.748 1.589e-08 ***
## Residuals 22  22067    1003                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

summary(modregresionvdc)

## 
## Call:
## lm(formula = valorvdc ~ tiempovdc, data = dcvdc)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -67.665 -19.227  -6.958  17.682  75.410 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 198.0290    13.3444  14.840 6.10e-13 ***
## tiempovdc     8.0743     0.9339   8.646 1.59e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 31.67 on 22 degrees of freedom
## Multiple R-squared:  0.7726, Adjusted R-squared:  0.7623 
## F-statistic: 74.75 on 1 and 22 DF,  p-value: 1.589e-08

ANOVA

# Ajustar el modelo lineal y realizar el análisis de varianza
lm_result_vdc <- lm(valorvdc ~ 1 + tiempovdc, data = as.data.frame(dcvdc))
anova_result_vdc <- anova(lm_result_vdc)

anova_result_vdc

## Analysis of Variance Table
## 
## Response: valorvdc
##           Df Sum Sq Mean Sq F value    Pr(>F)    
## tiempovdc  1  74974   74974  74.748 1.589e-08 ***
## Residuals 22  22067    1003                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Ajustar el modelo lineal y realizar el análisis de varianza
lm_result_vdc <- lm(valorvdc ~ 1 + tiempovdc, data = as.data.frame(dcvdc))
anova_result_vdc <- anova(lm_result_vdc)

# Muestra el resultado del análisis de varianza
print(anova_result_vdc)

## Analysis of Variance Table
## 
## Response: valorvdc
##           Df Sum Sq Mean Sq F value    Pr(>F)    
## tiempovdc  1  74974   74974  74.748 1.589e-08 ***
## Residuals 22  22067    1003                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

PRONOSTICOS

# Ajustar el modelo lineal
lm_result_vdc <- lm(valorvdc ~ 1 + tiempovdc, data = as.data.frame(dcvdc))

# Generar pronósticos
pronosticos <- predict(lm_result_vdc, newdata = as.data.frame(dcvdc))

pronosticos

##        1        2        3        4        5        6        7        8 
## 206.1033 214.1777 222.2520 230.3264 238.4007 246.4751 254.5494 262.6238 
##        9       10       11       12       13       14       15       16 
## 270.6981 278.7725 286.8468 294.9212 302.9955 311.0699 319.1442 327.2186 
##       17       18       19       20       21       22       23       24 
## 335.2929 343.3672 351.4416 359.5159 367.5903 375.6646 383.7390 391.8133

# Crear un gráfico con los datos originales y los pronósticos

ggplot(dcvdc, aes(x = tiempovdc, y = valorvdc)) +
  geom_point() +  # Puntos para datos originales
  geom_line(aes(y = pronosticos), color = "red") +  # Línea para pronósticos
  labs(title = "Pronósticos con Modelo Lineal", x = "Tiempo", y = "Valor")

SOLICITUDES DE PRESTAMOS

datos_universidad_estatal <- tsibble(
  Year = 1:24,
  value = c(297, 249, 340, 406, 464, 481, 549, 553, 556, 642, 670, 712, 808, 809, 867, 855, 965, 921, 956, 990, 1019, 1021, 1033, 1127),
  index = Year
)

autoplot(datos_universidad_estatal, series = "value") +
  labs(title = "Solicitudes de Préstamo a lo Largo de los Años", y = "Solicitudes") +
  geom_hline(yintercept = mean(datos_universidad_estatal$value), linetype = "dashed", color = "red") +
  theme_minimal()

## Plot variable not specified, automatically selected `.vars = value`

## Warning in geom_line(...): Ignoring unknown parameters: `series`

MODELO LINEAL

datos_universidad_estatal |>
  model(TSLM(value ~ Year + I(Year^2))) |>
  report()

## Series: value 
## Model: TSLM 
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -56.063 -17.274  -5.134  21.455  63.531 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 199.6196    20.8480   9.575 4.12e-09 ***
## Year         50.9366     3.8424  13.256 1.14e-11 ***
## I(Year^2)    -0.5677     0.1492  -3.805  0.00104 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 31.25 on 21 degrees of freedom
## Multiple R-squared: 0.9871,  Adjusted R-squared: 0.9859
## F-statistic: 802.3 on 2 and 21 DF, p-value: < 2.22e-16

ANOVA

lm(value ~ 1 + Year + I(Year^2), data = as.data.frame(datos_universidad_estatal)) |>
  anova()

## Analysis of Variance Table
## 
## Response: value
##           Df  Sum Sq Mean Sq  F value    Pr(>F)    
## Year       1 1552596 1552596 1590.178 < 2.2e-16 ***
## I(Year^2)  1   14134   14134   14.477  0.001035 ** 
## Residuals 21   20504     976                       
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

PRONOSTICOS

# Ajustar el modelo lineal con una tendencia cuadrática
modelo_lm2 <- lm(value ~ 1 + Year + I(Year^2), data = as.data.frame(datos_universidad_estatal))

# Crear nuevos datos para pronosticar
nuevos_datos <- data.frame(Year = 25:30)  # Cambia según tus necesidades

# Generar pronósticos con intervalo de confianza del 95%
pronosticos_nuevos <- predict(modelo_lm2, newdata = nuevos_datos, interval = "confidence", level = 0.95)

# Crear un marco de datos con los pronósticos y los intervalos de confianza
datos_pronosticos <- data.frame(
  Year = nuevos_datos$Year,
  .fitted = pronosticos_nuevos[, "fit"],
  .lower = pronosticos_nuevos[, "lwr"],
  .upper = pronosticos_nuevos[, "upr"]
)

# Crear un gráfico con datos originales y pronósticos
ggplot() +
  geom_line(data = datos_universidad_estatal, aes(x = Year, y = value), color = "black", size = 1) +
  geom_point(data = datos_universidad_estatal, aes(x = Year, y = value), color = "black", size = 3) +
  geom_line(data = datos_pronosticos, aes(x = Year, y = .fitted), color = "blue", size = 1) +
  geom_ribbon(data = datos_pronosticos, aes(x = Year, ymin = .lower, ymax = .upper), fill = "blue", alpha = 0.2) +
  labs(title = "Datos Originales y Pronósticos", y = "Solicitudes") +
  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.

\(PRUEBA DURBIN-WATSON\)

El estadístico de Durbin-Watson es una prueba utilizada en análisis de regresión para verificar la presencia de autocorrelación de primer orden en los residuos. La autocorrelación de primer orden ocurre cuando hay una correlación entre los errores sucesivos en una serie temporal o en datos de series temporales.

La prueba de Durbin-Watson produce un estadístico que varía entre 0 y 4. Un valor cercano a 2 sugiere que no hay autocorrelación de primer orden en los residuos. Valores significativamente menores que 2 indican autocorrelación positiva, mientras que valores significativamente mayores que 2 indican autocorrelación negativa.

DW cercano a 2 sugiere la ausencia de autocorrelación.

DW significativamente menor que 2 sugiere autocorrelación positiva.

DW significativamente mayor que 2 sugiere autocorrelación negativa.

Es importante tener en cuenta que la interpretación exacta puede depender del contexto y de la naturaleza específica de los datos y el modelo utilizado.

promedio_cuartos <- tsibble(
  datosC = seq(yearmonth("2007 Jan"), length.out = 168, by = 1),
  valorC = c(501,488,504,578,545,632,728,725,585,542,480,530,518,489,528,599,572,659,739,758,602,587,497,558,555,523,532,623,598,683,774,780,609,604,531,592,578,543,565,648,615,697,785,830,645,643,551,606,585,553,576,665,656,720,826,838,652,661,584,664,623,553,599,657,680,759,878,881,705,684,577,656,645,593,617,686,679,773,906,934,713,710,600,676,645,602,601,709,706,817,930,983,745,735,620,698,665,626,649,740,729,824,937,994,781,759,643,728,691,649,656,735,748,837,995,1040,809,793,692,763,723,655,658,761,768,885,1067,1038,812,790,692,782,758,709,715,784,794,893,1046,1075,812,822,714,802,748,731,748,827,788,937,1076,1125,840,864,717,813,811,732,745,844,833,935,1110,1124,868,860,762,877),
)

## Using `datosC` as index variable.

promedio_cuartos |>
  autoplot(valorC) +
  labs(title = "Promedios Habitacioness", y = "Promedios")

promedio_cuartos |>
  autoplot(sqrt(valorC)) +
  labs(title = "Raíces Promedios Habs", y = "Raíces Promedios")

promedio_cuartos |>
  autoplot(log(valorC)) +
  labs(title = "Logaritmo Promedios", y = "Logaritmo Promedios")

promedio_cuartos <- promedio_cuartos %>%
  mutate(
    Mes = month(datosC),
    M1 = as.numeric(Mes == 1),
    M2 = as.numeric(Mes == 2),
    M3 = as.numeric(Mes == 3),
    M4 = as.numeric(Mes == 4),
    M5 = as.numeric(Mes == 5),
    M6 = as.numeric(Mes == 6),
    M7 = as.numeric(Mes == 7),
    M8 = as.numeric(Mes == 8),
    M9 = as.numeric(Mes == 9),
    M10 = as.numeric(Mes == 10),
    M11 = as.numeric(Mes == 11)
  )

model <- promedio_cuartos %>%
  model(TSLM(log(valorC) ~ trend() + M1 + M2 + M3 + M4 + M5 + M6 + M7 + M8 + M9 + M10 + M11))

report(model)

## Series: valorC 
## Model: TSLM 
## Transformation: log(valorC) 
## 
## Residuals:
##        Min         1Q     Median         3Q        Max 
## -0.0593245 -0.0138500  0.0008501  0.0138988  0.0500432 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.290e+00  6.528e-03 963.555  < 2e-16 ***
## trend()      2.722e-03  3.432e-05  79.321  < 2e-16 ***
## M1          -4.382e-02  8.142e-03  -5.383 2.67e-07 ***
## M2          -1.143e-01  8.140e-03 -14.041  < 2e-16 ***
## M3          -8.667e-02  8.139e-03 -10.649  < 2e-16 ***
## M4           3.726e-02  8.138e-03   4.579 9.54e-06 ***
## M5           1.819e-02  8.137e-03   2.235   0.0268 *  
## M6           1.447e-01  8.136e-03  17.787  < 2e-16 ***
## M7           2.868e-01  8.135e-03  35.258  < 2e-16 ***
## M8           3.090e-01  8.134e-03  37.987  < 2e-16 ***
## M9           5.379e-02  8.134e-03   6.614 5.74e-10 ***
## M10          3.735e-02  8.133e-03   4.593 9.00e-06 ***
## M11         -1.144e-01  8.133e-03 -14.066  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.02152 on 155 degrees of freedom
## Multiple R-squared: 0.9883,  Adjusted R-squared: 0.9874
## F-statistic:  1091 on 12 and 155 DF, p-value: < 2.22e-16

# Descomponer la fecha en componentes
promedio_cuartos <- promedio_cuartos %>%
  mutate(
    Mes = month(datosC),
    Año = year(datosC),
    M1 = as.numeric(Mes == 1),
    M2 = as.numeric(Mes == 2),
    M3 = as.numeric(Mes == 3),
    M4 = as.numeric(Mes == 4),
    M5 = as.numeric(Mes == 5),
    M6 = as.numeric(Mes == 6),
    M7 = as.numeric(Mes == 7),
    M8 = as.numeric(Mes == 8),
    M9 = as.numeric(Mes == 9),
    M10 = as.numeric(Mes == 10),
    M11 = as.numeric(Mes == 11)
  )

# Ajustar el modelo de regresión lineal
modelo_lm3 <- lm(log(valorC) ~ 1 + Año + M1 + M2 + M3 + M4 + M5 + M6 + M7 + M8 + M9 + M10 + M11, data = as.data.frame(promedio_cuartos))

# Realizar un análisis de varianza (ANOVA)
anova_resultado <- anova(modelo_lm3)
print(anova_resultado)

## Analysis of Variance Table
## 
## Response: log(valorC)
##            Df  Sum Sq Mean Sq  F value    Pr(>F)    
## Año         1 2.91327 2.91327 6291.773 < 2.2e-16 ***
## M1          1 0.16137 0.16137  348.513 < 2.2e-16 ***
## M2          1 0.49831 0.49831 1076.206 < 2.2e-16 ***
## M3          1 0.43657 0.43657  942.851 < 2.2e-16 ***
## M4          1 0.05573 0.05573  120.367 < 2.2e-16 ***
## M5          1 0.11095 0.11095  239.608 < 2.2e-16 ***
## M6          1 0.01896 0.01896   40.952 1.759e-09 ***
## M7          1 0.57243 0.57243 1236.282 < 2.2e-16 ***
## M8          1 1.06252 1.06252 2294.722 < 2.2e-16 ***
## M9          1 0.05755 0.05755  124.287 < 2.2e-16 ***
## M10         1 0.07639 0.07639  164.987 < 2.2e-16 ***
## M11         1 0.09603 0.09603  207.391 < 2.2e-16 ***
## Residuals 155 0.07177 0.00046                       
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Aplicar el test de Durbin-Watson
dw_test <- dwtest(modelo_lm3)
print(dw_test)

## 
##  Durbin-Watson test
## 
## data:  modelo_lm3
## DW = 1.1704, p-value = 8.863e-08
## alternative hypothesis: true autocorrelation is greater than 0

El resultado del test de Durbin-Watson (DW) que proporcionaste indica que el estadístico DW es 1.1704 y el valor p asociado es 8.863e-08. Este es un resultado significativo, ya que el valor p es muy pequeño (menor que 0.05), lo que sugiere evidencia en contra de la hipótesis nula de que no hay autocorrelación positiva en los residuos del modelo.

promedio_cuartos |>
  model(TSLM(log(valorC) ~ trend() + season())) |>
  forecast(h = "2 years") |>
  autoplot(promedio_cuartos) +
  labs(y = "promedios", title = "Promedios habitaciones")

promedio_cuartos |>
  model(TSLM(valorC ~ trend() + season())) |>
  forecast(h = "2 years") |>
  hilo(level = c(97.5))

## # A tsibble: 24 x 5 [1M]
## # Key:       .model [1]
##    .model                   datosC       valorC .mean                    `97.5%`
##    <chr>                     <mth>       <dist> <dbl>                     <hilo>
##  1 TSLM(valorC ~ trend(… 2021 ene.  N(822, 510)  822. [ 771.0949,  872.3721]97.5
##  2 TSLM(valorC ~ trend(… 2021 feb.  N(779, 510)  779. [ 728.2378,  829.5150]97.5
##  3 TSLM(valorC ~ trend(… 2021 mar.  N(797, 510)  797. [ 745.8806,  847.1578]97.5
##  4 TSLM(valorC ~ trend(… 2021 abr.  N(880, 510)  880. [ 828.9521,  930.2293]97.5
##  5 TSLM(valorC ~ trend(… 2021 may.  N(869, 510)  869. [ 818.5949,  919.8721]97.5
##  6 TSLM(valorC ~ trend(… 2021 jun.  N(965, 510)  965. [ 914.3092, 1015.5864]97.5
##  7 TSLM(valorC ~ trend(… 2021 jul. N(1090, 510) 1090. [1039.0235, 1140.3007]97.5
##  8 TSLM(valorC ~ trend(… 2021 ago. N(1113, 510) 1113. [1062.4521, 1163.7293]97.5
##  9 TSLM(valorC ~ trend(… 2021 sep.  N(903, 510)  903. [ 851.9521,  953.2293]97.5
## 10 TSLM(valorC ~ trend(… 2021 oct.  N(894, 510)  894. [ 843.0949,  944.3721]97.5
## # ℹ 14 more rows

Analisis de los promedios de habitaciones ocupadas al mes, ocupando un modelo trigonometrico

promedio_cuartos |>
  model(TSLM(log(valorC)~ trend() + fourier(K = 2))) |> 
  report()

## Series: valorC 
## Model: TSLM 
## Transformation: log(valorC) 
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.100542 -0.045572 -0.002805  0.046947  0.122897 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          6.333e+00  8.740e-03 724.597  < 2e-16 ***
## trend()              2.733e-03  8.975e-05  30.445  < 2e-16 ***
## fourier(K = 2)C1_12 -1.598e-01  6.144e-03 -26.015  < 2e-16 ***
## fourier(K = 2)S1_12 -2.433e-02  6.152e-03  -3.954 0.000115 ***
## fourier(K = 2)C2_12  6.712e-02  6.144e-03  10.924  < 2e-16 ***
## fourier(K = 2)S2_12  1.638e-02  6.145e-03   2.665 0.008483 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.0563 on 162 degrees of freedom
## Multiple R-squared: 0.9162,  Adjusted R-squared: 0.9137
## F-statistic: 354.4 on 5 and 162 DF, p-value: < 2.22e-16

promedio_cuartos |>
  model(TSLM(log(valorC)~ trend() + fourier(K = 2))) |>
  forecast(h = "3 years") |>
  autoplot(promedio_cuartos) +
  labs(y = "promedios", title = "Promedios habitaciones")

promedio_cuartos |>
  model(TSLM(valorC ~ trend() + season())) |>
  forecast(h = "3 years") |>
  hilo(level = c(95.0))

## # A tsibble: 36 x 5 [1M]
## # Key:       .model [1]
##    .model                     datosC       valorC .mean                    `95%`
##    <chr>                       <mth>       <dist> <dbl>                   <hilo>
##  1 TSLM(valorC ~ trend() … 2021 ene.  N(822, 510)  822. [ 777.4533,  866.0137]95
##  2 TSLM(valorC ~ trend() … 2021 feb.  N(779, 510)  779. [ 734.5961,  823.1566]95
##  3 TSLM(valorC ~ trend() … 2021 mar.  N(797, 510)  797. [ 752.2390,  840.7995]95
##  4 TSLM(valorC ~ trend() … 2021 abr.  N(880, 510)  880. [ 835.3104,  923.8709]95
##  5 TSLM(valorC ~ trend() … 2021 may.  N(869, 510)  869. [ 824.9533,  913.5137]95
##  6 TSLM(valorC ~ trend() … 2021 jun.  N(965, 510)  965. [ 920.6676, 1009.2280]95
##  7 TSLM(valorC ~ trend() … 2021 jul. N(1090, 510) 1090. [1045.3819, 1133.9423]95
##  8 TSLM(valorC ~ trend() … 2021 ago. N(1113, 510) 1113. [1068.8104, 1157.3709]95
##  9 TSLM(valorC ~ trend() … 2021 sep.  N(903, 510)  903. [ 858.3104,  946.8709]95
## 10 TSLM(valorC ~ trend() … 2021 oct.  N(894, 510)  894. [ 849.4533,  938.0137]95
## # ℹ 26 more rows

western <- tsibble(
  date = rep(yearmonth("2007 Jan") + 0:14),
  value = c(11,14,16,22,28,36,46,67,82,99,119,156,257,284,403),
  index = date
) 
modelo <- western |>
  model(TSLM(log(value) ~ trend()))

# Reporte del modelo
modelo |>
  report()

## Series: value 
## Model: TSLM 
## Transformation: log(value) 
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.11668 -0.04172 -0.01747  0.06304  0.13951 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 2.070120   0.041032   50.45 2.67e-16 ***
## trend()     0.256880   0.004513   56.92  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.07552 on 13 degrees of freedom
## Multiple R-squared: 0.996,   Adjusted R-squared: 0.9957
## F-statistic:  3240 on 1 and 13 DF, p-value: < 2.22e-16

lm(log(value) ~ date, data = as.data.frame(western)) |>
  anova()

## Analysis of Variance Table
## 
## Response: log(value)
##           Df  Sum Sq Mean Sq F value    Pr(>F)    
## date       1 18.4802 18.4802  3410.2 < 2.2e-16 ***
## Residuals 13  0.0704  0.0054                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

lm(log(value) ~ date, data = as.data.frame(western)) |>
  durbinWatsonTest(simulate = TRUE)

##  lag Autocorrelation D-W Statistic p-value
##    1     -0.03401941       1.92181   0.628
##  Alternative hypothesis: rho != 0

western |>
  model(TSLM(log(value) ~ trend())) |>
  forecast(h = "2 years") |>
  autoplot(western) +
  labs(y = "restaurantes", title = "Cadena de restaurantes")

western |>
  model(TSLM(log(value) ~ trend())) |>
  forecast(h = "2 years") |>
  hilo(level = c(95.0))

## # A tsibble: 24 x 5 [1M]
## # Key:       .model [1]
##    .model                  date             value .mean                    `95%`
##    <chr>                  <mth>            <dist> <dbl>                   <hilo>
##  1 TSLM(log(value) ~… 2008 abr. t(N(6.2, 0.0074))  485. [ 408.2010,  571.7222]95
##  2 TSLM(log(value) ~… 2008 may. t(N(6.4, 0.0077))  627. [ 525.7035,  742.0646]95
##  3 TSLM(log(value) ~… 2008 jun. t(N(6.7, 0.0081))  811. [ 676.7880,  963.5040]95
##  4 TSLM(log(value) ~… 2008 jul.   t(N(7, 0.0085)) 1048. [ 871.0040, 1251.4384]95
##  5 TSLM(log(value) ~… 2008 ago.  t(N(7.2, 0.009)) 1356. [1120.6093, 1625.9190]95
##  6 TSLM(log(value) ~… 2008 sep. t(N(7.5, 0.0095)) 1753. [1441.3355, 2113.0588]95
##  7 TSLM(log(value) ~… 2008 oct.   t(N(7.7, 0.01)) 2268. [1853.3712, 2746.8676]95
##  8 TSLM(log(value) ~… 2008 nov.    t(N(8, 0.011)) 2933. [2382.6236, 3571.6444]95
##  9 TSLM(log(value) ~… 2008 dic.  t(N(8.2, 0.011)) 3793. [3062.3347, 4645.0939]95
## 10 TSLM(log(value) ~… 2009 ene.  t(N(8.5, 0.012)) 4905. [3935.1563, 6042.3887]95
## # ℹ 14 more rows