#install.packages("quantmod")

Tecnoglass

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).

library(quantmod)
## Warning: package 'quantmod' was built under R version 4.3.3
## Loading required package: xts
## Warning: package 'xts' was built under R version 4.3.3
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## Loading required package: TTR
## Warning: package 'TTR' was built under R version 4.3.3
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(plotly)
## Warning: package 'plotly' was built under R version 4.3.3
## 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
library(ggplot2)
library(forecast)
## Warning: package 'forecast' was built under R version 4.3.3
# Símbolo de Tecnoglass en Yahoo Finance
ticker <- "TGLS"

# Descarga los datos históricos desde una fecha específica hasta hoy
# Puedes ajustar las fechas según tus necesidades
start_date <- as.Date("2016-04-13")
end_date <- Sys.Date() -1

# Obtén los datos
getSymbols(ticker, src = "yahoo", from = start_date, to = end_date)
## [1] "TGLS"
df_TGLS= data.frame(TGLS)
df_TGLS$Date <- rownames(df_TGLS)
df_TGLS$Date <- as.Date(df_TGLS$Date, format = "%Y-%m-%d")

plot_ly(data = df_TGLS, x = ~Date, y = ~TGLS.Close, type = "scatter", mode = "lines",
        text = ~paste("Fecha: ", Date, "<br>Precio de cierre: $", TGLS.Close)) %>%
  layout(title = "Gráfico interactivo de Precio de Cierre de TGLS",
         xaxis = list(title = "Fecha"),
         yaxis = list(title = "Precio de cierre"))

Se observa que la serie de tiempo no es estacionaria, al evidenciarse tendencia y varianza no constante.A partir de mayo del 2021 se evidencia un alza en los precios de cierre de las acciones de Tecnoglass, el COO de Tecnoglass anunció que abrirían una nueva planta en mayo con una inversión de US$40 millones. Esta planta se consideraría la fábrica de vidrio “más grande y moderna del mundo”.

library(TSstudio)
## Warning: package 'TSstudio' was built under R version 4.3.3
# Check the information of the new ts object
ts_info(TGLS)
##  The TGLS series is a xts object with 6 variables and 2014 observations
##  Frequency: daily 
##  Start time: 2016-04-13 
##  End time: 2024-04-12
library(xts)
TGLS_xts <- xts(TGLS$TGLS.Close, frequency = 365)
# Check the information of the new ts object
ts_info(TGLS_xts)
##  The TGLS_xts series is a xts object with 1 variable and 2014 observations
##  Frequency: daily 
##  Start time: 2016-04-13 
##  End time: 2024-04-12
# Check the information of the new ts object
TGLS_ts = ts(TGLS_xts, frequency = 365)
ts_decompose(TGLS_ts)

En la gráfica se observa un patrón estacional adicional a la tendencia identificada previamente.

library(tseries)
## Warning: package 'tseries' was built under R version 4.3.3
adf_result <- adf.test(TGLS_ts)

# Imprimir los resultados
cat("ADF Statistic:", adf_result$statistic, "\n")
## ADF Statistic: -1.001061
cat("p-value:", adf_result$p.value, "\n")
## p-value: 0.938563
# Interpretación de los resultados
if (adf_result$p.value < 0.05) {
  cat("Conclusión: Rechazamos la hipótesis nula. La serie temporal es estacionaria.\n")
} else {
  cat("Conclusión: No rechazamos la hipótesis nula. La serie temporal es no estacionaria.\n")
}
## Conclusión: No rechazamos la hipótesis nula. La serie temporal es no estacionaria.
TGLS_split <- ts_split(ts(TGLS$TGLS.Close), sample.out = 28)

train <- TGLS_split$train
test <- TGLS_split$test
par(mfrow=c(1,2))
acf(train, lag.max = 60)
pacf(train, lag.max = 60)

Como la serie es no estacionaria, procederemos con la diferenciación.

En la gráfica proporcionada, el número de retrasos significativos en el PACF (Función de Autocorrelación Parcial) se puede determinar observando los picos que exceden el umbral de significancia. En este caso, parece que el primer pico significativo está en el retraso 1.

La autocorrelación de la serie con sus rezagos decae lentamente en el tiempo de forma lineal. La eliminación de la tendencia de la serie y de la correlación entre la serie y sus rezagos puede hacerse por diferenciación.

par(mfrow=c(1,3))
acf(diff(TGLS_ts, lag = 1), lag.max = 60)
pacf(diff(TGLS_ts, lag = 1), lag.max = 60)
ts_plot(diff(TGLS_xts, lag = 1),
        title = "First Differencing",
        Xtitle = "Year",
        Ytitle = "Differencing Close Tecnoglass")

adf_result <- adf.test(diff(TGLS_ts, lag = 1))
## Warning in adf.test(diff(TGLS_ts, lag = 1)): p-value smaller than printed
## p-value
# Imprimir los resultados
cat("ADF Statistic:", adf_result$statistic, "\n")
## ADF Statistic: -12.40225
cat("p-value:", adf_result$p.value, "\n")
## p-value: 0.01
# Interpretación de los resultados
if (adf_result$p.value < 0.05) {
  cat("Conclusión: Rechazamos la hipótesis nula. La serie temporal es estacionaria.\n")
} else {
  cat("Conclusión: No rechazamos la hipótesis nula. La serie temporal es no estacionaria.\n")
}
## Conclusión: Rechazamos la hipótesis nula. La serie temporal es estacionaria.

2. Repita TODOS los pasos indicados en esta sección para encontrar modelos ARIMA para predecir el precio de Bitcoin con los siguientes horizontes: 7, 14, 21 y 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.

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

pq_rng <- seq(0, 7)
d_rng <- seq(0, 2)

for (i in pq_rng) {
  for (d in d_rng) {
    for (j in pq_rng) {
      tryCatch({
        tmp_mdl <- arima(train, order = c(i, d, j))
        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) {})
    }
  }
}
## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1
## Warning in log(s2): NaNs produced
## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1
## Warning in log(s2): NaNs produced

## Warning in log(s2): NaNs produced
## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1
## Warning in log(s2): NaNs produced
## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1
## Warning in log(s2): NaNs produced

## Warning in log(s2): NaNs produced
## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1
## Warning in log(s2): NaNs produced
## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1

## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1
## Warning in log(s2): NaNs produced
## Warning in arima(train, order = c(i, d, j)): possible convergence problem:
## optim gave code = 1
print(best_order)
## [1] 5 1 7
best_order <- c(5,1,7)

Rolling forecasting para predecir cifras futuras de forma continua durante un periodo de tiempo, este caso se utilizaran los periodos 7, 14,21 y 28 días.

forecast_accuracy <- function(forecast, actual) {
  mape <- mean(abs((forecast - actual) / actual))
  mae <- mean(abs(forecast - actual))
  rmse <- sqrt(mean((forecast - actual)^2))
  mse <- mean((forecast - actual)^2)
  r2 <- 1 - sum((actual - forecast)^2) / sum((actual - mean(actual))^2)
  return(list(MAPE = mape, MAE = mae, RMSE = rmse, MSE = mse, R2 = r2))
}