En esta oportunidad quiero trabajar con dos desarrollos muy interesantes a nivel de implementación, la primera tiene que ver con un web scraping, dado un proyecto en el cual estoy trabajando con una persona que admiro demasiado, el doctor Carlos Ospino y por otro lado respondiendo a un reto, sobre trading financiero por parte de Daniel Cordoba, el cual me a obligado a pensar fuera de la caja con una serie de metodologias. Por lo anterior el trabajo que hoy desarrollaré es intentar predecir el precio del dolar, con modelos de memoria corta.
La fuente de datos es investing, y la bibliografía que consulte para esta post es la siguiente:
Dicho lo anterior, manos a la obra!
Anotación especial: No trabajaré con variables macroeconómicas, dado que este es un ejercicio, más junto a Daniel Cordoba, estamos desarrollando un proyecto de un modelo de Machine Learning for Time Series en R, el cual estará disponible en algunos meses.
hacer web scraping es un arte practicamente, hay que tener presente como esta el protocolo http, si es 200 se puede trabajar perfectamente, de lo contrario, tocaría hacer un par de cosas sobre el texto que intenta leer a nivel de tranformación .html. Si desea tener más información al respecto le recomiendo ver el siguiente link, por otro lado, si desea integrar y mantener un deploy sobre esto, por experiencia le recomiendo trabajar con Flask, hace parte de las buenas prácticas.
Para revisar el status code, puede ejecutar el siguiente código
url<-"https://es.investing.com/currencies/usd-cop-historical-data"
url%>%
GET()%>%
http_status()
## $category
## [1] "Success"
##
## $reason
## [1] "OK"
##
## $message
## [1] "Success: (200) OK"
Ahora, voy a descargar la tabla de mi interés y empezar a desarrollar un corto análisis.
url<-"https://es.investing.com/currencies/usd-cop-historical-data"
dolar_table<-url%>%
read_html()%>%
html_node('#curr_table')%>%
html_table()%>%
tbl_df()
## Warning: `tbl_df()` is deprecated as of dplyr 1.0.0.
## Please use `tibble::as_tibble()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
dolar_table
## # A tibble: 23 x 6
## Fecha Último Apertura Máximo Mínimo `% var.`
## <chr> <chr> <chr> <chr> <chr> <chr>
## 1 12.06.2020 3.778,50 3.773,00 3.782,33 3.736,96 0,23%
## 2 11.06.2020 3.769,89 3.673,50 3.775,51 3.668,50 2,67%
## 3 10.06.2020 3.672,00 3.657,50 3.691,50 3.643,00 0,49%
## 4 09.06.2020 3.654,16 3.609,99 3.666,24 3.603,82 1,26%
## 5 08.06.2020 3.608,61 3.573,20 3.613,26 3.564,00 0,99%
## 6 05.06.2020 3.573,20 3.588,50 3.592,37 3.542,06 -0,25%
## 7 04.06.2020 3.582,00 3.607,00 3.625,17 3.582,00 -0,69%
## 8 03.06.2020 3.607,00 3.636,44 3.647,75 3.562,29 -0,75%
## 9 02.06.2020 3.634,15 3.719,90 3.725,25 3.617,49 -2,23%
## 10 01.06.2020 3.716,90 3.730,00 3.734,00 3.702,84 -0,35%
## # … with 13 more rows
Bueno, hay que hacerle un par de modificaciones a la tabla para poder trabajar con ella.
Serie<-dolar_table%>%
rename('Cierre'='Último')%>%
mutate(Fecha=(gsub('\\.','-',Fecha)),
Apertura=gsub("\\.","",Apertura),
Apertura=gsub(",",".",Apertura),
Apertura=as.numeric(Apertura),
Cierre=gsub("\\.","",Cierre),
Cierre=gsub(",",".",Cierre),
Cierre=as.numeric(Cierre))%>%
select(c(Fecha,Apertura,Cierre))
Serie$Fecha<-lubridate::dmy(Serie$Fecha)
Serie
## # A tibble: 23 x 3
## Fecha Apertura Cierre
## <date> <dbl> <dbl>
## 1 2020-06-12 3773 3778.
## 2 2020-06-11 3674. 3770.
## 3 2020-06-10 3658. 3672
## 4 2020-06-09 3610. 3654.
## 5 2020-06-08 3573. 3609.
## 6 2020-06-05 3588. 3573.
## 7 2020-06-04 3607 3582
## 8 2020-06-03 3636. 3607
## 9 2020-06-02 3720. 3634.
## 10 2020-06-01 3730 3717.
## # … with 13 more rows
Para este análisis me basaré puntualmente en el cierre
El comportamiento del dolar ha sido bastante dinámico, por lo tanto trabajar con un modelo de memoría corta puede ser un camino correcto, aunque no estoy muy seguro que el mejor,pero veamos esto a través de los resultados.
Lo primero que quiero evaluar es el tipo de comportamiento de los datos, a través de la tendencia. Lo más importante adestacar es que se trata de una regresión Loess o local1, por lo cual entender los segmentos de tiempo será la clave de este asunto.
Serie%>%
ggplot(aes(Fecha,Cierre))+
geom_smooth(se=FALSE)+
labs(title = 'Tendencia del comportamiento del dolar',
subtitle = 'a través de la estructura de una regresión mixta')
Me llama bastante la atención del mínimo local de $3.600, acá puede que exista un cambio de estructura de la información, pero también puede que exista una correlación escalonada con factores exógenos. Para entender mejor esto, voy a trabajar con algunas tranformaciones
Lo primero es convertir los datos en una serie de tiempo, paso seguido descomponer la serie a ver que insigths podemos extraer de los comportamientos individualizados y pot último es determinar que tipo de modelo aplicar. Todo lo anterior lo desarrollaré en un solo código.
Serie%>%
arrange(Fecha)%>%
select(Cierre)%>%
ts()%>%
mstl()%>%
autoplot()
Particularmente la estacionalidad y la tendencia de los componentes parece indicar presencia de una correlación fuerte entre los períodos de tiempo, pero a la par no dejo de sentir algo de ruido y se evidencia una tendencia al alza de manera no constante!
Es interesante ver este comportamiento, pues muestra que en efecto un modelo de memoria corta podría ser el indicado.
Serie%>%
arrange(Fecha)%>%
select(Cierre)%>%
ts()%>%
ggtsdisplay()
Increible los datos pierden potencia de correlación con su pasado, hay que ser cauto a la hora de tratar la serie, a demás todo parece indicar que existe un modelo AR (1), más tengo mis reservas aun, puede que se trate de un factor de integración simplemente y que realmente la serie tenga un comportamiento de caminata aleatoría por los cambios de nivel.
VOy a trabajar con la serie diferenciada a ver si encuentro la tendencia que es lo que más llama mi atención
Serie%>%
arrange(Fecha)%>%
select(Cierre)%>%
ts()%>%
diff()%>%
mstl()%>%
autoplot()
Bueno, en efecto hay una tendencia bastante fuerte [-20,20], pero este efecto por la magnitud que tiene confirma mi sospecha de caminata aleatoria, for la fuerza del despliegue que tiene la curva, lo cual me lleva a concluir que existe una constante de integración o en términos técnicos un Random walk with drift
Gracias a todos los insigths que tenemos, ya se puede construir un modelo ARIMA, de la siguiente manera
Serie_ts<-Serie%>%
arrange(Fecha)%>%
select(Cierre)%>%
ts()
sarima(Serie_ts,p=0,d=1,q=0)
## initial value 3.673162
## iter 1 value 3.673162
## final value 3.673162
## converged
## initial value 3.673162
## iter 1 value 3.673162
## final value 3.673162
## converged
## $fit
##
## Call:
## stats::arima(x = xdata, order = c(p, d, q), seasonal = list(order = c(P, D,
## Q), period = S), xreg = constant, transform.pars = trans, fixed = fixed,
## optim.control = list(trace = trc, REPORT = 1, reltol = tol))
##
## Coefficients:
## constant
## -5.9777
## s.e. 8.3951
##
## sigma^2 estimated as 1550: log likelihood = -112.03, aic = 228.05
##
## $degrees_of_freedom
## [1] 21
##
## $ttable
## Estimate SE t.value p.value
## constant -5.9777 8.3951 -0.7121 0.4843
##
## $AIC
## [1] 10.36602
##
## $AICc
## [1] 10.37511
##
## $BIC
## [1] 10.4652
La evidencia indica que este es el modelo adecuado, los errores tiene un buen desempeño. Pero para concluirlo este es un modelo de Ruido Blanco
Por lo tanto paso hacer el modelo para pronósticar.
El dolar el día 12 de Junio cerro en $3.776,50 y el modelo pronóstico $3.778,499
Al principio sospeche que existia un AR(1), en el modelo, y la evidencia arroja que es un ARIMA (0,1,0), que es lo mismo que ruido, por lo tanto dada la predicción real del dolar evaluare que tan real es la idea del Autoregresivo.
trend <- seq_along(Serie_ts)
(fit1 <- auto.arima(Serie_ts, d=0, xreg=trend))
## Series: Serie_ts
## Regression with ARIMA(1,0,0) errors
##
## Coefficients:
## ar1 intercept xreg
## 0.8769 3870.7974 -7.4602
## s.e. 0.0965 77.5559 5.0639
##
## sigma^2 estimated as 1663: log likelihood=-117.05
## AIC=242.09 AICc=244.32 BIC=246.64
(fit2<-auto.arima(Serie_ts,d=1))
## Series: Serie_ts
## ARIMA(0,1,0)
##
## sigma^2 estimated as 1587: log likelihood=-112.28
## AIC=226.55 AICc=226.75 BIC=227.64
fc1 <- forecast(fit1,
xreg = length(Serie_ts) + 1:4)
fc2 <- forecast(fit2, h=4)
autoplot(Serie_ts) +
autolayer(fc2, series="Tendencia estocástica") +
autolayer(fc1, series="Tendencia determinístico")+
labs(title = 'Comparación del modelo determinístico vs estocástico')
En efecto hay una tendencia AR1, y la predicción del dolar bajo este foco fue 99.6% acertada.
Esto fue todo por esta oportunidad, espero que les haya gustado!
Dejo los datos del modelo determinístico para ver que tanto se ajustan los valores con la realidad.
| Point Forecast | Lo 80 | Hi 80 | Lo 95 | Hi 95 | |
|---|---|---|---|---|---|
| 24 | 3761.278 | 3709.022 | 3813.534 | 3681.359 | 3841.196 |
| 25 | 3745.257 | 3675.757 | 3814.758 | 3638.966 | 3851.549 |
| 26 | 3730.291 | 3650.012 | 3810.570 | 3607.514 | 3853.068 |
| 27 | 3716.249 | 3628.578 | 3803.920 | 3582.168 | 3850.330 |
Y acá dejo los valores de la predicción a través de una red neuronal
## Point Forecast
## 24 3752.112
## 25 3735.441
## 26 3716.923
## 27 3702.513