Tarea Series de tiempo

Series de tiempo

carge de librerias

suppressWarnings({library(forecast)
library(TSstudio)
library(plotly)
library(dplyr)
library(lubridate)
library(stats)
library(datasets)
library(base)
library(quantmod)})

Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 

Loading required package: ggplot2

Attaching package: '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

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

Attaching package: 'lubridate'

The following objects are masked from 'package:base':

    date, intersect, setdiff, union

Loading required package: xts

Loading required package: zoo

Attaching package: 'zoo'

The following objects are masked from 'package:base':

    as.Date, as.Date.numeric

######################### Warning from 'xts' package ##########################
#                                                                             #
# The dplyr lag() function breaks how base R's lag() function is supposed to  #
# work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
# source() into this session won't work correctly.                            #
#                                                                             #
# Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
# conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
# dplyr from breaking base R's lag() function.                                #
#                                                                             #
# Code in packages is not affected. It's protected by R's namespace mechanism #
# Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
#                                                                             #
###############################################################################

Attaching package: 'xts'

The following objects are masked from 'package:dplyr':

    first, last

Loading required package: TTR

punto 1

1.Considere la serie de tiempo asociada con las acciones de Tecnoglass desde que comenzó a comercializarse hasta la fecha del día de hoy. Puede utilizar la API de Yahoo Finance para obtener esta serie de tiempo (ver yahoofinancer).

# simbolo de Tecnoglass -> TGLS
ticker <- "TGLS"

# Calcular la fecha de inicio y fin
end_date <- Sys.Date() # Fecha actual del sistema
start_date <- "2012-05-09" # Año de inicio de las acciones (se puede validar en la pagina de yahoo finance)

# Convertir las fechas a cadenas en el formato "yyyy-mm-dd"
end_date_str <- format(end_date, "%Y-%m-%d")

# Obtener los datos de Yahoo Finance
getSymbols(ticker, src = "yahoo", from = start_date, to = end_date_str)

[1] "TGLS"

# Ver los datos obtenidos
#head(print(get(ticker)))

con el codigo anterior cargamos los datos y asi es como se verian,

# convertir a df
df_TGLS<- data.frame(date = index(TGLS), coredata(TGLS))

df_Close_TGLS <- df_TGLS$TGLS.Close

head(df_TGLS)

        date TGLS.Open TGLS.High TGLS.Low TGLS.Close TGLS.Volume TGLS.Adjusted
1 2012-05-10      9.97     10.00     9.50       9.80        6900      7.708229
2 2012-05-11      9.70      9.70     9.70       9.70         300      7.629574
3 2012-05-14      9.80      9.80     9.80       9.80         100      7.708229
4 2012-05-15      9.75      9.75     9.75       9.75         300      7.668901
5 2012-05-16      9.75      9.75     9.75       9.75           0      7.668901
6 2012-05-17      9.60      9.60     9.60       9.60         800      7.550920

PUNTO 2

2.Repita TODOS los pasos indicados en esta sección para encontrar modelos ARIMA para predecir el precio de las acciones de Tecnoglass con los siguientes horizontes: 7, 14 días, 21 días, 28 días. Utilizar siempre predicciones usando rolling con ventana de predicción continua de un día. Cualquier cantidad de pasos extra para enriquecer su análisis predictivo serán aceptados siempre y cuando sean acordes con lo que indica la teoría de análisis de series de tiempo.

# Obtener el data frame de las acciones de Tecnoglass
df_TGLS <- get(ticker)

# Convertir la columna de cierre de precios a una serie temporal
ts_TGLS <- ts(df_TGLS$TGLS.Close, start = start(df_TGLS), frequency = 1)



ts_plot(ts_TGLS,
        title = "Monthly Airline Passenger Numbers 1949-1960",
        Ytitle = "Thousands of Passengers",
        Xtitle = "Year")

de aqui podemos ver que este proceso es no estacionario ya que podemos ver que en los ultimos registros se incrementa el valor.

ts_plot(diff(ts_TGLS, lag = 1),
        title = "Tecnoglas Series - First Differencing",
        Xtitle = "Year",
        Ytitle = "Differencing ")

Aunque la media ahora es constante la varianza sigue aumentando esto se puede ver viendo que la amplitud de los ultimos registros va en aumento.

Ahora utilizando un ciclo for se va a encontrar el mejor order para la serie de tiempo, pero primero vamos a dividir el conjunto de datos.

CON AIC

n_TGLS <- length(df_Close_TGLS)
n_test <- 28  # Esto se puede cambiar
train_size <- n_TGLS - n_test


train <- df_Close_TGLS[1:train_size]
dates_train <- df_TGLS$date[1:train_size]
test_complete <- df_Close_TGLS[(train_size + 1):(train_size + n_test)]
dates_complete <- df_TGLS$date[(train_size + 1):(train_size + n_test)]

best_aic <- Inf
best_order <- NULL
best_mdl <- NULL

pq_rng <- 0:4
d_rng <- 0:2

suppressWarnings(for (i in pq_rng) {
  for (d in d_rng) {
    for (j in pq_rng) {
      tryCatch({
        # print(paste(i, d, j))
        tmp_mdl <- try(arima(train, order = c(i, d, j)), silent = TRUE)
        if (!inherits(tmp_mdl, "try-error")) {
          tmp_aic <- AIC(tmp_mdl)
          if (tmp_aic < best_aic) {
            best_aic <- tmp_aic
            best_order <- c(i, d, j)
            best_mdl <- tmp_mdl
          }
        }
      }, error = function(e) {})
    }
  }
})

cat(sprintf("aic: %6.5f | order: %s\n", best_aic, paste(best_order, collapse = ", ")))

aic: 5339.85558 | order: 2, 1, 4

best_order1<-c(best_order)

Teniendo en cuenta la metrica aic se encontro que ese era el mejor orden y ahora utilizaremos el rolling para realizar predicciones.

arima_rolling <- function(history, test, best_order,d) {
  predictions <- vector()
  c<-test$column_name[1:d]
  for (t in 1:length(c)) {
    model <- Arima(history, order=best_order1)
    model_fit <- forecast(model,d)
    yhat <- model_fit$mean[t]
    predictions <- c(predictions, yhat)
    obs <- test[t, ]
    #history <- rbind(history, obs)
    #print(paste("predicted=", yhat, ", expected=", obs))
  }
  return(predictions)
}

test_complete_df <- data.frame(column_name = test_complete)

yhat_7  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=7)
yhat_14  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=14)
yhat_21  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=21)
yhat_28  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=28)

ahora veamos las metricas que nos esta dando estas predicciones para entender mejor se utilizara esta funcion que nos devolvera un df con todas las metricas de interes.

forecast_accuracy <- function(forecast, actual, str_name) {
  mape <- mean(abs(forecast - actual) / abs(actual))  # MAPE
  mae <- mean(abs(forecast - actual))                 # MAE
  rmse <- sqrt(mean((forecast - actual)^2))           # RMSE
  mse <- mean((forecast - actual)^2)                  # MSE
  r2 <- cor(forecast, actual)^2                       # R2
  
  df_acc <- data.frame(MAE = mae,
                       MSE = mse,
                       MAPE = mape,
                       RMSE = rmse,
                       R2 = r2,
                       row.names = str_name)
  
  return(df_acc)
}

x7<-forecast_accuracy(forecast=yhat_7,actual=test_complete[1:7], "week 1")

x14<-forecast_accuracy(forecast=yhat_14,actual=test_complete[1:14], "week 2")

x21<-forecast_accuracy(forecast=yhat_21,actual=test_complete[1:21], "week 3")

x28<-forecast_accuracy(forecast=yhat_28,actual=test_complete[1:28], "week 4")

total_rolling_aic<-rbind(x7,x14,x21,x28)
total_rolling_aic

            MAE       MSE       MAPE     RMSE           R2
week 1 2.082572  4.486277 0.04637260 2.118083 4.137932e-02
week 2 3.918130 23.448831 0.08074401 4.842399 1.259897e-06
week 3 5.806820 46.545288 0.11473252 6.822411 6.768314e-03
week 4 7.795749 83.760292 0.14651869 9.152065 6.870161e-03

con ese R2 cuadrado podemos decir que es malo el modelo de series de tiempo que tenemos actualmente pero que el promedio de error este en un aproximadamente 4% es un buen resultado que eso es lo que pasa con la primera semana a medida que se aumenta la ventana va aumentando el error y disminuyendo el recuadrado.

analyze_residuals <- function(predictions_list, actual_data,d) {
  results <- list()
  residuals_list <- list() 
  
  residuals <- actual_data - predictions_list
    
  # Prueba de normalidad (Shapiro-Wilk)
  shapiro_test <- shapiro.test(residuals)
  shapiro_pvalue <- shapiro_test$p.value
    
  # Prueba de independencia (Ljung-Box)
  # El número de lags recomendado por defecto es min(10, length(residuals) / 5)
  lb_lags <- min(10, length(residuals) / 5)
  lb_test <- Box.test(residuals, lag = lb_lags, type = "Ljung-Box")
    
    # Almacenar resultados
  results <- list(
      "Prediction Length" = d,
      "Shapiro P-Value" = shapiro_pvalue,
      "Ljung-Box P-Value" = lb_test$p.value
    )
    
    # Imprimir conclusiones
  cat(paste0("Residuos para la predicción de ", d, " días:\n"))
  cat(paste0("Test de Shapiro-Wilk P-Value: ", shapiro_pvalue, "\n"))
  if (shapiro_pvalue < 0.05) {
    cat("Rechazar la hipótesis nula: Los residuos no son normales.\n")
  } else {
    cat("No rechazar la hipótesis nula: Los residuos parecen ser normales.\n")
  }
    
    cat(paste0("Test de Ljung-Box P-Value: ", lb_test$lb_pvalue[1], "\n"))
    if (lb_test$p.value < 0.05) {
      cat("Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.\n")
    } else {
      cat("No rechazar la hipótesis nula: Los residuos parecen ser independientes.\n")
    }
    
    cat("\n")
  
  return(results)
}

con esta funcion simplificamos el proceso de analisis de residuos para las series de tiempo con rollingback

## para 7 dias
analyze_residuals(yhat_7,test_complete[1:7],7)

Residuos para la predicción de 7 días:
Test de Shapiro-Wilk P-Value: 0.810787041182961
No rechazar la hipótesis nula: Los residuos parecen ser normales.
Test de Ljung-Box P-Value: 
No rechazar la hipótesis nula: Los residuos parecen ser independientes.

$`Prediction Length`
[1] 7

$`Shapiro P-Value`
[1] 0.810787

$`Ljung-Box P-Value`
[1] 0.6827367

podemos concluir que con esta ventana se puede confiar en las inferencias que hace el modelo ya que cumple con los supuestos.

ahora para 14 dias

analyze_residuals(yhat_14,test_complete[1:14],14)

Residuos para la predicción de 14 días:
Test de Shapiro-Wilk P-Value: 0.000894617234839748
Rechazar la hipótesis nula: Los residuos no son normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 14

$`Shapiro P-Value`
[1] 0.0008946172

$`Ljung-Box P-Value`
[1] 0.005858441

con esta ventana ya no se puede confiar en las inferencias que hace el modelo, ya que no esta cumpliendo con los residuos.

analyze_residuals(yhat_21,test_complete[1:21],21)

Residuos para la predicción de 21 días:
Test de Shapiro-Wilk P-Value: 0.00121712931698376
Rechazar la hipótesis nula: Los residuos no son normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 21

$`Shapiro P-Value`
[1] 0.001217129

$`Ljung-Box P-Value`
[1] 3.894185e-10

como se puede ver tampoco se puede confiar, esto puede sustentar el porque al aumentar la ventana de tiempo va aumentando los errores.

analyze_residuals(yhat_28,test_complete[1:28],28)

Residuos para la predicción de 28 días:
Test de Shapiro-Wilk P-Value: 0.0093674942118775
Rechazar la hipótesis nula: Los residuos no son normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 28

$`Shapiro P-Value`
[1] 0.009367494

$`Ljung-Box P-Value`
[1] 1.431189e-12

concluimos que con solo la ventana de tiempo de 7 dias se cumplen los supuestos y solo se podra confiar en las predicciones de ese modelo.

Sin rollingback

entrenamos solo un modelo y pronosticamos con el horizonte que se define

model <- arima(train, order=best_order1)
forecast_7<-forecast(model,7)
forecast_14<-forecast(model,14)
forecast_21<-forecast(model,21)
forecast_28<-forecast(model,28)

ahora analizaremos los residuos de este modelo para ver si cumplen los supuestos necesarios.

checkresiduals(forecast_7)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,4)
Q* = 5.8603, df = 4, p-value = 0.2098

Model df: 6.   Total lags used: 10

con la ventana de 7 no se cumple ni un supuesto ya que por el lag 16 ya hay una autocorrelacion signficativa y los residuos no parecen distribuir normal por lo que hay un cesgo a la izquierda.

checkresiduals(forecast_14)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,4)
Q* = 5.8603, df = 4, p-value = 0.2098

Model df: 6.   Total lags used: 10

se puede concluir lo mismo de esta.

checkresiduals(forecast_21)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,4)
Q* = 5.8603, df = 4, p-value = 0.2098

Model df: 6.   Total lags used: 10

lo msimo se puede ver aca pero se puede agregar que los residuos no parecen distribuir normales es por la cola larga que tiene a la izquierda aunque no parece muy densa.

checkresiduals(forecast_28)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,4)
Q* = 5.8603, df = 4, p-value = 0.2098

Model df: 6.   Total lags used: 10

AHORA COMO METRICA EL BIC

Repita el análisis desarrollado en los pasos anteriores, considerando ahora el criterio de inferencia Bayesiana (BIC) y el criterio de información de Hannan–Quinn (HQIC) para encontrar el mejor modelo ARIMA y, compare los errores con aquellos obtenidos con el criterio de Akaike.

best_bic <- Inf
best_order <- NULL
best_mdl <- NULL

pq_rng <- 0:4
d_rng <- 0:2

suppressWarnings(for (i in pq_rng) {
  for (d in d_rng) {
    for (j in pq_rng) {
      tryCatch({
        # print(paste(i, d, j))
        tmp_mdl <- try(arima(train, order = c(i, d, j)), silent = TRUE)
        if (!inherits(tmp_mdl, "try-error")) {
          tmp_bic <- BIC(tmp_mdl)
          if (tmp_bic < best_bic) {
            best_bic <- tmp_bic
            best_order <- c(i, d, j)
            best_mdl <- tmp_mdl
          }
        }
      }, error = function(e) {})
    }
  }
})

cat(sprintf("BIC: %6.5f | order: %s\n", best_bic, paste(best_order, collapse = ", ")))

BIC: 5369.86658 | order: 0, 1, 0

best_order1<-c(best_order)

Con Rolling

ahora teniendo en cuenta ese order vamos a hacer el rollingback y mirar los resultados como se hizo en el anterior caso.

test_complete_df <- data.frame(column_name = test_complete)

yhat_7  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=7)
yhat_14  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=14)
yhat_21  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=21)
yhat_28  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=28)

teniendo ya los y_hat miraremos las metricas.

x7<-forecast_accuracy(forecast=yhat_7,actual=test_complete[1:7], "week 1")

Warning in cor(forecast, actual): the standard deviation is zero

x14<-forecast_accuracy(forecast=yhat_14,actual=test_complete[1:14], "week 2")

Warning in cor(forecast, actual): the standard deviation is zero

x21<-forecast_accuracy(forecast=yhat_21,actual=test_complete[1:21], "week 3")

Warning in cor(forecast, actual): the standard deviation is zero

x28<-forecast_accuracy(forecast=yhat_28,actual=test_complete[1:28], "week 4")

Warning in cor(forecast, actual): the standard deviation is zero

total_rolling_aic<-rbind(x7,x14,x21,x28)
total_rolling_aic

            MAE      MSE       MAPE     RMSE R2
week 1 2.162857  4.83280 0.04815886 2.198363 NA
week 2 4.014285 24.20030 0.08280846 4.919380 NA
week 3 5.909523 47.79566 0.11684475 6.913441 NA
week 4 7.902142 85.49215 0.14862598 9.246196 NA

el R2 en NA quiere decir que no hay desviaciones en esos y_hat (todos iguales para cada week) por lo que se revisaria.

ahora pasaremos al analisis de los supuestos, viendo esas metricas nos dara a entender que lo mas probable es que no se cumpla.

analyze_residuals(yhat_7,test_complete[1:7],7)

Residuos para la predicción de 7 días:
Test de Shapiro-Wilk P-Value: 0.872707940972841
No rechazar la hipótesis nula: Los residuos parecen ser normales.
Test de Ljung-Box P-Value: 
No rechazar la hipótesis nula: Los residuos parecen ser independientes.

$`Prediction Length`
[1] 7

$`Shapiro P-Value`
[1] 0.8727079

$`Ljung-Box P-Value`
[1] 0.6589102

analyze_residuals(yhat_14,test_complete[1:14],14)

Residuos para la predicción de 14 días:
Test de Shapiro-Wilk P-Value: 0.000982208332347104
Rechazar la hipótesis nula: Los residuos no son normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 14

$`Shapiro P-Value`
[1] 0.0009822083

$`Ljung-Box P-Value`
[1] 0.005578635

analyze_residuals(yhat_21,test_complete[1:21],21)

Residuos para la predicción de 21 días:
Test de Shapiro-Wilk P-Value: 0.00130329398780393
Rechazar la hipótesis nula: Los residuos no son normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 21

$`Shapiro P-Value`
[1] 0.001303294

$`Ljung-Box P-Value`
[1] 3.983308e-10

analyze_residuals(yhat_28,test_complete[1:28],28)

Residuos para la predicción de 28 días:
Test de Shapiro-Wilk P-Value: 0.00992973149929236
Rechazar la hipótesis nula: Los residuos no son normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 28

$`Shapiro P-Value`
[1] 0.009929731

$`Ljung-Box P-Value`
[1] 1.463829e-12

esta teniendo un comportamiento curioso ya que en la primera ventana se cumple los supuestos aunque la y_hat sea igual.

Sin rolling BIC

model <- arima(train, order=best_order1)
forecast_7<-forecast(model,7)
forecast_14<-forecast(model,14)
forecast_21<-forecast(model,21)
forecast_28<-forecast(model,28)

ahora al pasar sin rolling calculamos el forecast para los horizontes predisupuestos

checkresiduals(forecast_7)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,0)
Q* = 37.805, df = 10, p-value = 4.104e-05

Model df: 0.   Total lags used: 10

No esta cumpliendo los supuestos de independencia mira que en el lag 10 ya hay autocorrelacion significativa.

checkresiduals(forecast_14)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,0)
Q* = 37.805, df = 10, p-value = 4.104e-05

Model df: 0.   Total lags used: 10

checkresiduals(forecast_21)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,0)
Q* = 37.805, df = 10, p-value = 4.104e-05

Model df: 0.   Total lags used: 10

checkresiduals(forecast_28)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,0)
Q* = 37.805, df = 10, p-value = 4.104e-05

Model df: 0.   Total lags used: 10

en todas no esta cumpliendo los supuestos de los residuos por lo que para nignuna ventana se puede confiar en las inferencias que hace nuestro modelo.

Teniendo en cuenta el HQIC

best_order <- NULL
best_mdl <- NULL

# Inicializar el mejor HQIC con un valor grande
best_hqic <- Inf

pq_rng <- 0:4
d_rng <- 0:2

suppressWarnings(for (i in pq_rng) {
  for (d in d_rng) {
    for (j in pq_rng) {
      tryCatch({
        # print(paste(i, d, j))
        tmp_mdl <- try(arima(train, order = c(i, d, j)), silent = TRUE)
        if (!inherits(tmp_mdl, "try-error")) {
          # Calcular el número de parámetros en el modelo
          k <- length(tmp_mdl$coef)
          # Calcular AIC
          aic <- AIC(tmp_mdl)
          # Calcular el número de observaciones
          n <- length(train)
          # Calcular AICc
          tmp_hqic <- aic + 2*k*(k+1)/(n-k-1)
          if (tmp_hqic < best_hqic) {
            best_hqic <- tmp_hqic
            best_order <- c(i, d, j)
            best_mdl <- tmp_mdl
          }
        }
      }, error = function(e) {})
    }
  }
})

cat(sprintf("hqic: %6.5f | order: %s\n", best_hqic, paste(best_order, collapse = ", ")))

hqic: 5339.88391 | order: 2, 1, 4

best_order1 <- c(best_order) 

teniendo en cuenta este mejor orden se procedera a hacer el rollingback, metricas y analisis de residuos.

con rolling back

test_complete_df <- data.frame(column_name = test_complete)

yhat_7  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=7)
yhat_14  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=14)
yhat_21  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=21)
yhat_28  = arima_rolling(history=train, test=test_complete_df,best_order=best_order1,d=28)

teniendo ya las predicciones miremos las metricas de estos horizontes

x7<-forecast_accuracy(forecast=yhat_7,actual=test_complete[1:7], "week 1")

x14<-forecast_accuracy(forecast=yhat_14,actual=test_complete[1:14], "week 2")

x21<-forecast_accuracy(forecast=yhat_21,actual=test_complete[1:21], "week 3")

x28<-forecast_accuracy(forecast=yhat_28,actual=test_complete[1:28], "week 4")

total_rolling_hqic<-rbind(x7,x14,x21,x28)
total_rolling_hqic

            MAE       MSE       MAPE     RMSE           R2
week 1 2.082572  4.486277 0.04637260 2.118083 4.137932e-02
week 2 3.918130 23.448831 0.08074401 4.842399 1.259897e-06
week 3 5.806820 46.545288 0.11473252 6.822411 6.768314e-03
week 4 7.795749 83.760292 0.14651869 9.152065 6.870161e-03

teniendo en cuenta estas metricas podemos concluir lo mismo que a medida que se aumenta el horizonte las metricas van empeorando, esto puede decir que si se trata de predicir a un futuro lejano el modelo no va a ser capaz de predecir correctamente esto.

ahora pasemos al analisis de residuos

analyze_residuals(yhat_7,test_complete[1:7],7)

Residuos para la predicción de 7 días:
Test de Shapiro-Wilk P-Value: 0.810787041182961
No rechazar la hipótesis nula: Los residuos parecen ser normales.
Test de Ljung-Box P-Value: 
No rechazar la hipótesis nula: Los residuos parecen ser independientes.

$`Prediction Length`
[1] 7

$`Shapiro P-Value`
[1] 0.810787

$`Ljung-Box P-Value`
[1] 0.6827367

analyze_residuals(yhat_14,test_complete[1:14],14)

Residuos para la predicción de 14 días:
Test de Shapiro-Wilk P-Value: 0.000894617234839748
Rechazar la hipótesis nula: Los residuos no son normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 14

$`Shapiro P-Value`
[1] 0.0008946172

$`Ljung-Box P-Value`
[1] 0.005858441

analyze_residuals(yhat_21,test_complete[1:21],21)

Residuos para la predicción de 21 días:
Test de Shapiro-Wilk P-Value: 0.00121712931698376
Rechazar la hipótesis nula: Los residuos no son normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 21

$`Shapiro P-Value`
[1] 0.001217129

$`Ljung-Box P-Value`
[1] 3.894185e-10

analyze_residuals(yhat_28,test_complete[1:7],28)

Residuos para la predicción de 28 días:
Test de Shapiro-Wilk P-Value: 0.229223918680026
No rechazar la hipótesis nula: Los residuos parecen ser normales.
Test de Ljung-Box P-Value: 
Rechazar la hipótesis nula: Los residuos muestran autocorrelación significativa.

$`Prediction Length`
[1] 28

$`Shapiro P-Value`
[1] 0.2292239

$`Ljung-Box P-Value`
[1] 5.049916e-05

como con las otras formas de buscar los mejores parametros (hiperparametrizando por AIC y BIC) en la primera ventana es cuando cumple los supuestos y se puede confiar en las inferencias.

sin rolling back

model <- arima(train, order=best_order1)
forecast_7<-forecast(model,7)
forecast_14<-forecast(model,14)
forecast_21<-forecast(model,21)
forecast_28<-forecast(model,28)

checkresiduals(forecast_7)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,4)
Q* = 5.8603, df = 4, p-value = 0.2098

Model df: 6.   Total lags used: 10

por el lag 14 hay una autocorrelacion significativa por lo que no esta cumpliendo el supuesto de independencia.

checkresiduals(forecast_14)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,4)
Q* = 5.8603, df = 4, p-value = 0.2098

Model df: 6.   Total lags used: 10

checkresiduals(forecast_21)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,4)
Q* = 5.8603, df = 4, p-value = 0.2098

Model df: 6.   Total lags used: 10

checkresiduals(forecast_28)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,4)
Q* = 5.8603, df = 4, p-value = 0.2098

Model df: 6.   Total lags used: 10

en ninguna de las ventanas cumple los supuestos, por lo que sin el rollingback no se puede confiar en las predicciones de los modelos, no se agrega debajo de cada ventana ya que las conclusiones serian las mismas.