Serie de Tiempo

Se eligio una serie de tiempo del precio de cierre de la empresa Tesla a 2 años. Esta serie registra el valor de cierre diario de las acciones de Tesla en el mercado bursátil a lo largo del tiempo.

library(ggplot2)
library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
df <- read.csv("C:/Users/gabri/OneDrive/Documentos/Universidad/Septimo semestre/Metodos Cuantitativos/Taller 2/Datos históricos de Tesla (TSLA) (1).csv", header = TRUE, sep = ",")

df <- df %>% select(Fecha, Último)
df$Fecha <- as.Date(df$Fecha, format = "%d.%m.%Y")
df$Último <- as.numeric(gsub(",", ".", df$Último))



ggplot(df, aes(x = Fecha, y = Último)) +
  geom_line(color = "blue") + 
  labs(title = "Serie de Tiempo de Tesla",
       x = "Fecha",
       y = "Precio") +
  theme_minimal()

Tendencia: Como se puede ver los precios de las acciones de Tesla han mostrado una tendencia general al alza en los últimos años, reflejando el crecimiento de la empresa y su posición en el mercado de vehículos eléctricos y energías renovables.

Estacionalidad: Puede existir cierta estacionalidad relacionada con ciclos de lanzamiento de productos, reportes trimestrales de ganancias o eventos del sector automotriz. Aunque como vemos el ultimo repunte la acción gano al rededor del 30% de su valor, gracias a el evento de las elecciones precidenciales en USA.

Volatilidad: Esta Acción puede tomarse como una de las mas volatiles del mercado, en la grafica se ve claramente como esta sube y baja drasticamente a medidad que la serie de tiempo avanza.

Promedios moviles

library(zoo)
## 
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
df_movil <- df

df_movil <- df_movil[order(df_movil$Fecha), ]
df_movil$Fecha <- as.Date(df_movil$Fecha)


df_movil$PromedioMovil <- rollmean(df_movil$Último, k = 5, fill = NA, align = "right")


df_movil_filtrado <- df_movil[!is.na(df_movil$PromedioMovil), ]


n_futuro <- 20  
fechas_futuras <- seq(from = max(df_movil$Fecha), by = "days", length.out = n_futuro + 1)[-1]


ultimo_promedio <- tail(df_movil_filtrado$PromedioMovil, 1)
df_prediccion <- data.frame(
  Fecha = fechas_futuras,
  PromedioMovil = rep(ultimo_promedio, n_futuro)
)


df_movil_extendido <- rbind(
  df_movil_filtrado[, c("Fecha", "PromedioMovil")],  
  df_prediccion                                      
)

ggplot(df_movil_extendido, aes(x = Fecha, y = PromedioMovil)) +
  geom_line(color = "blue") + 
  geom_point(data = df_prediccion, aes(x = Fecha, y = PromedioMovil), color = "red") +
  labs(title = "Pronóstico de serie de tiempo de Tesla",
       x = "Fecha",
       y = "Promedio Móvil") +
  theme_minimal()

ggplot(df_prediccion, aes(x = Fecha, y = PromedioMovil)) +
  geom_line(color = "red") +
  geom_point(color = "red") +
  labs(title = "Predicción de Serie de Tiempo (Tesla)",
       x = "Fecha",
       y = "Promedio Móvil") +
  theme_minimal()

Suavización exponencial

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.1
## ✔ readr     2.1.5     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(forecast)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
# Modelo de suavización exponencial

df <- df[order(df$Fecha), ]
ses_model <- ses(df$Último, h = 30)  
plot(ses_model)

# Extraer las predicciones en formato tabla
forecast_table <- as.data.frame(ses_model)

# Mostrar la tabla en consola
print(forecast_table)
##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 524       357.9293 347.6832 368.1754 342.2593 373.5994
## 525       357.9293 343.4399 372.4188 335.7696 380.0890
## 526       357.9293 340.1838 375.6749 330.7898 385.0688
## 527       357.9293 337.4387 378.4200 326.5916 389.2671
## 528       357.9293 335.0202 380.8385 322.8929 392.9658
## 529       357.9293 332.8337 383.0249 319.5489 396.3097
## 530       357.9293 330.8231 385.0356 316.4739 399.3848
## 531       357.9293 328.9516 386.9071 313.6116 402.2470
## 532       357.9293 327.1938 388.6649 310.9234 404.9353
## 533       357.9293 325.5313 390.3274 308.3808 407.4779
## 534       357.9293 323.9500 391.9087 305.9624 409.8963
## 535       357.9293 322.4391 393.4196 303.6517 412.2070
## 536       357.9293 320.9900 394.8687 301.4354 414.4233
## 537       357.9293 319.5955 396.2631 299.3029 416.5558
## 538       357.9293 318.2501 397.6086 297.2452 418.6135
## 539       357.9293 316.9488 398.9098 295.2551 420.6036
## 540       357.9293 315.6876 400.1711 293.3262 422.5325
## 541       357.9293 314.4630 401.3957 291.4533 424.4054
## 542       357.9293 313.2719 402.5868 289.6317 426.2270
## 543       357.9293 312.1118 403.7469 287.8575 428.0012
## 544       357.9293 310.9803 404.8783 286.1270 429.7316
## 545       357.9293 309.8755 405.9832 284.4374 431.4213
## 546       357.9293 308.7955 407.0631 282.7857 433.0730
## 547       357.9293 307.7388 408.1199 281.1695 434.6892
## 548       357.9293 306.7038 409.1549 279.5867 436.2720
## 549       357.9293 305.6894 410.1693 278.0352 437.8235
## 550       357.9293 304.6942 411.1644 276.5133 439.3454
## 551       357.9293 303.7174 412.1413 275.0193 440.8394
## 552       357.9293 302.7578 413.1009 273.5517 442.3069
## 553       357.9293 301.8146 414.0440 272.1093 443.7494

índices estacionales

descomponer la serie de tiempo

tesla_ts <- ts(df$Último, frequency = 7, 
               start = c(as.numeric(format(min(df$Fecha), "%Y")), 
                         as.numeric(format(min(df$Fecha), "%j")) / 7))


tesla_decomp <- decompose(tesla_ts, type = "multiplicative")
plot(tesla_decomp)

tesla_df <- df


indices_estacionales <- tesla_decomp$seasonal


tesla_df$seasonal_index <- rep(indices_estacionales, length.out = nrow(tesla_df))


tesla_df$deseasonalized <- tesla_df$Último / tesla_df$seasonal_index  



plot(ts(tesla_df$deseasonalized, frequency = 365), main = "Serie Desestacionalizada")

tesla_df$time <- seq_along(tesla_df$Último)

trend_model <- lm(deseasonalized ~ time, data = tesla_df)


tesla_df$trend <- predict(trend_model, newdata = tesla_df)


tesla_df$forecast <- tesla_df$trend * tesla_df$seasonal_index 


plot(tesla_df$Fecha, tesla_df$Último, type = "l", main = "Pronóstico de Tesla", xlab = "Fecha", ylab = "Precio")
lines(tesla_df$Fecha, tesla_df$forecast, col = "blue", lty = 2)
legend("topleft", legend = c("Real", "Pronóstico"), col = c("black", "blue"), lty = c(1, 2))

Regresiones polinomicas

Ajustar modelos polinomicos

library(ggplot2)
tesla_data <- df

tesla_data$Time <- 1:nrow(tesla_data) # Variable de tiempo


model_linear <- lm(Último ~ Fecha, data = tesla_data)


model_poly2 <- lm(Último ~ poly(Time, 2), data = tesla_data)


model_poly3 <- lm(Último ~ poly(Time, 3), data = tesla_data)


tesla_data$Pred_Linear <- predict(model_linear, tesla_data)
tesla_data$Pred_Poly2 <- predict(model_poly2, tesla_data)
tesla_data$Pred_Poly3 <- predict(model_poly3, tesla_data)

ggplot(data = tesla_data, aes(x = Fecha)) +
  geom_line(aes(y = Último, color = "Real")) +
  geom_line(aes(y = Pred_Linear, color = "Tendencia Lineal")) +
  geom_line(aes(y = Pred_Poly2, color = "Polinomio Grado 2")) +
  geom_line(aes(y = Pred_Poly3, color = "Polinomio Grado 3")) +
  labs(title = "Modelos ajustados al precio de Tesla",
       x = "Tiempo", y = "Precio",
       color = "Modelos")

Viabilidad de los modelos
library(Metrics)
## 
## Adjuntando el paquete: 'Metrics'
## The following object is masked from 'package:forecast':
## 
##     accuracy
rmse_linear <- rmse(tesla_data$Último, tesla_data$Pred_Linear)
rmse_poly2 <- rmse(tesla_data$Último, tesla_data$Pred_Poly2)
rmse_poly3 <- rmse(tesla_data$Último, tesla_data$Pred_Poly3)


cat("RMSE Modelos:\n")
## RMSE Modelos:
cat("Lineal: ", rmse_linear, "\n")
## Lineal:  41.2746
cat("Polinomio Grado 2: ", rmse_poly2, "\n")
## Polinomio Grado 2:  41.22769
cat("Polinomio Grado 3: ", rmse_poly3, "\n")
## Polinomio Grado 3:  32.27497
Pronóstico
future_time <- data.frame(Time = (max(tesla_data$Time) + 1):(max(tesla_data$Time) + 30))


future_time$Forecast <- predict(model_poly2, future_time)


ggplot(data = tesla_data, aes(x = Time, y = Último)) +
  geom_line(color = "blue") +
  geom_line(data = future_time, aes(x = Time, y = Forecast), color = "red") +
  labs(title = "Pronóstico del precio de Tesla",
       x = "Tiempo", y = "Precio",
       color = "Tipo")

Análisis de viabilidad

Lineal: Sencillo, pero no captura ciclos ni cambios no lineales en la tendencia.

Polinomio Grado 2: Adecua bien las tendencias cíclicas simples, pero puede sobreajustarse si la serie es más compleja.

Polinomio Grado 3: Captura patrones más complejos, pero es más propenso al sobreajuste y puede generar resultados extremos para predicciones a largo plazo.

Análisis de correlación

La variable explicativa elegida fue el Volumen de acciones de cada dia.

df_corr <- read.csv("C:/Users/gabri/OneDrive/Documentos/Universidad/Septimo semestre/Metodos Cuantitativos/Taller 2/Datos históricos de Tesla (TSLA) (1).csv", header = TRUE, sep = ",")


df_corr <- df_corr %>% select(Fecha,Último,Vol.)

df_corr$Fecha <- as.Date(df_corr$Fecha, format = "%d.%m.%Y")


df_corr$Último <- as.numeric(gsub(",", ".", df_corr$Último))

# Convertir 'Vol.' en millones
df_corr$Vol. <- as.numeric(gsub(",", ".", gsub("M", "", df_corr$Vol.))) * 1e6

df_corr <- df_corr[order(df_corr$Fecha), ]

correlacion <- cor(df_corr$Último, df_corr$Vol.)
print(correlacion)
## [1] -0.1488436
library(tseries)

adf.test(df_corr$Último)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  df_corr$Último
## Dickey-Fuller = -1.8796, Lag order = 8, p-value = 0.6292
## alternative hypothesis: stationary
adf.test(df_corr$Vol.)
## Warning in adf.test(df_corr$Vol.): p-value smaller than printed p-value
## 
##  Augmented Dickey-Fuller Test
## 
## data:  df_corr$Vol.
## Dickey-Fuller = -4.2571, Lag order = 8, p-value = 0.01
## alternative hypothesis: stationary
# Calcular las diferencias y mantener la longitud del data frame
df_corr$Precio_Tesla_Diff <- c(NA, diff(df_corr$Último))
df_corr$Variable_Explicativa_Diff <- c(NA, diff(df_corr$Vol.))
df_corr[is.na(df_corr)] <- 0



# Utilizando las series diferenciadas si es necesario
modelo <- lm(Precio_Tesla_Diff ~ Variable_Explicativa_Diff, data = df_corr)
summary(modelo)
## 
## Call:
## lm(formula = Precio_Tesla_Diff ~ Variable_Explicativa_Diff, data = df_corr)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -32.369  -4.148   0.003   4.108  42.814 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)  
## (Intercept)               2.904e-01  3.475e-01   0.836   0.4036  
## Variable_Explicativa_Diff 3.015e-08  1.258e-08   2.397   0.0169 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.946 on 521 degrees of freedom
## Multiple R-squared:  0.01091,    Adjusted R-squared:  0.009007 
## F-statistic: 5.744 on 1 and 521 DF,  p-value: 0.01689
library(lmtest)
dwtest(modelo)
## 
##  Durbin-Watson test
## 
## data:  modelo
## DW = 1.9879, p-value = 0.4503
## alternative hypothesis: true autocorrelation is greater than 0
plot(residuals(modelo), type = "l", main = "Residuales del Modelo", xlab = "Tiempo", ylab = "Residuales")

futuro_explicativa <- data.frame(Variable_Explicativa_Diff = c(77000000, 58000000, 50000000))


predicciones_diff <- predict(modelo, newdata = futuro_explicativa)


ultimo_precio <- tail(df_corr$Último, n=1)
predicciones <- cumsum(c(ultimo_precio, predicciones_diff))


plot(predicciones, type = "l", main = "Pronóstico del Precio de Tesla", xlab = "Tiempo", ylab = "Precio")

Modelos estocásticos (ARIMA)

adf.test(tesla_ts)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  tesla_ts
## Dickey-Fuller = -1.8796, Lag order = 8, p-value = 0.6292
## alternative hypothesis: stationary

como no es estacionaria aplico diferencias

tesla_diff <- diff(tesla_ts)
plot(tesla_diff, main="Serie Diferenciada", ylab="Diferencia del Precio", xlab="Tiempo")

adf.test(tesla_diff)
## Warning in adf.test(tesla_diff): p-value smaller than printed p-value
## 
##  Augmented Dickey-Fuller Test
## 
## data:  tesla_diff
## Dickey-Fuller = -6.1571, Lag order = 8, p-value = 0.01
## alternative hypothesis: stationary
model <- auto.arima(tesla_ts)
summary(model)
## Series: tesla_ts 
## ARIMA(0,1,0) 
## 
## sigma^2 = 63.8:  log likelihood = -1825.33
## AIC=3652.66   AICc=3652.67   BIC=3656.92
## 
## Training set error measures:
##                     ME     RMSE      MAE        MPE     MAPE      MASE
## Training set 0.2880831 7.979772 5.725903 0.03453089 2.722876 0.3394044
##                    ACF1
## Training set 0.01212273
checkresiduals(model)

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(0,1,0)
## Q* = 12.132, df = 14, p-value = 0.5957
## 
## Model df: 0.   Total lags used: 14
forecasted <- forecast(model, h=30)
plot(forecasted, main="Pronóstico del Precio de Tesla")

Medidas de errores

Promedios moviles

library(Metrics)

# Comparar las predicciones del promedio móvil con los datos reales
rmse_mov <- rmse(df_movil_filtrado$Último, df_movil_filtrado$PromedioMovil)
mae_mov <- mae(df_movil_filtrado$Último, df_movil_filtrado$PromedioMovil)
mape_mov <- mape(df_movil_filtrado$Último, df_movil_filtrado$PromedioMovil)

cat("Errores del Método de Promedio Móvil:\n")
## Errores del Método de Promedio Móvil:
cat("RMSE:", rmse_mov, "\n")
## RMSE: 8.849833
cat("MAE:", mae_mov, "\n")
## MAE: 6.480096
cat("MAPE:", mape_mov, "\n")
## MAPE: 0.03078842

Suavización exponencial

# Extraer las predicciones realizadas por el modelo SES
ses_predictions <- as.numeric(fitted(ses_model))

# Calcular errores
rmse_ses <- rmse(df$Último, ses_predictions)
mae_ses <- mae(df$Último, ses_predictions)
mape_ses <- mape(df$Último, ses_predictions)

cat("Errores del Modelo de Suavización Exponencial:\n")
## Errores del Modelo de Suavización Exponencial:
cat("RMSE:", rmse_ses, "\n")
## RMSE: 7.979778
cat("MAE:", mae_ses, "\n")
## MAE: 5.725534
cat("MAPE:", mape_ses, "\n")
## MAPE: 0.02722696

Regresiones Polinómicas

mae_linear <- mae(tesla_data$Último, tesla_data$Pred_Linear)
mae_poly2 <- mae(tesla_data$Último, tesla_data$Pred_Poly2)
mae_poly3 <- mae(tesla_data$Último, tesla_data$Pred_Poly3)

mape_linear <- mape(tesla_data$Último, tesla_data$Pred_Linear)
mape_poly2 <- mape(tesla_data$Último, tesla_data$Pred_Poly2)
mape_poly3 <- mape(tesla_data$Último, tesla_data$Pred_Poly3)

cat("MAE Modelos:\n")
## MAE Modelos:
cat("Lineal: ", mae_linear, "\n")
## Lineal:  33.62609
cat("Polinomio Grado 2: ", mae_poly2, "\n")
## Polinomio Grado 2:  33.47805
cat("Polinomio Grado 3: ", mae_poly3, "\n")
## Polinomio Grado 3:  27.0839
cat("MAPE Modelos:\n")
## MAPE Modelos:
cat("Lineal: ", mape_linear, "\n")
## Lineal:  0.1649799
cat("Polinomio Grado 2: ", mape_poly2, "\n")
## Polinomio Grado 2:  0.1640958
cat("Polinomio Grado 3: ", mape_poly3, "\n")
## Polinomio Grado 3:  0.1361568

ARIMA

# Extraer predicciones y valores reales
arima_predictions <- as.numeric(fitted(model))
arima_real <- tesla_ts[1:length(arima_predictions)]  # Alinear con el tamaño de las predicciones

# Calcular errores
rmse_arima <- rmse(arima_real, arima_predictions)
mae_arima <- mae(arima_real, arima_predictions)
mape_arima <- mape(arima_real, arima_predictions)

cat("Errores del Modelo ARIMA:\n")
## Errores del Modelo ARIMA:
cat("RMSE:", rmse_arima, "\n")
## RMSE: 7.979772
cat("MAE:", mae_arima, "\n")
## MAE: 5.725903
cat("MAPE:", mape_arima, "\n")
## MAPE: 0.02722876

Comparación

error_comparison <- data.frame(
  Método = c("Promedio Móvil", "Suavización Exponencial", "Regresión Lineal", 
             "Regresión Polinómica Grado 2", "Regresión Polinómica Grado 3", "ARIMA"),
  RMSE = c(rmse_mov, rmse_ses, rmse_linear, rmse_poly2, rmse_poly3, rmse_arima),
  MAE = c(mae_mov, mae_ses, mae_linear, mae_poly2, mae_poly3, mae_arima),
  MAPE = c(mape_mov, mape_ses, mape_linear, mape_poly2, mape_poly3, mape_arima)
)

print(error_comparison)
##                         Método      RMSE       MAE       MAPE
## 1               Promedio Móvil  8.849833  6.480096 0.03078842
## 2      Suavización Exponencial  7.979778  5.725534 0.02722696
## 3             Regresión Lineal 41.274596 33.626092 0.16497985
## 4 Regresión Polinómica Grado 2 41.227686 33.478048 0.16409579
## 5 Regresión Polinómica Grado 3 32.274969 27.083897 0.13615681
## 6                        ARIMA  7.979772  5.725903 0.02722876

En conclusión el modelo arima y de siauvización exponencial tienen los RMSE y MAE más bajos . Loque indica que son los modelos mas precisos evaluados desde la misma serie de tiempo

Desición

En mi análisis, la mejor decisión es utilizar el promedio móvil, ya que, aunque no es el método con el menor error, es el que mejor representa la actualidad del mercado y el precio de la acción. Además, sabemos que, en el mercado de capitales, los precios de hace varios meses no necesariamente influyen en los precios futuros.