R/predict_dd.R
In rengelke/tradr:
#' Trim SAR and Supertrend indicator values
#'
#' @param x xts object with SAR or Supertrend indicator values
#'
#' @return
#'
#' @examples scale_sar(TTR::SAR(price_data))
scale_sar <- function (x) {
x %>% replace(.>=1.25, 1.25) %>% replace(.<=0.75, 0.75)
}
#' Calculate Drawdown Indicators
#'
#' @param x xts price series containing Open, High, Low, Close columns
#' @param sp500 xts price series containing Open, High, Low, Close columns for S&P500
#' @param vix xts object containing Volatility Index data
#' @param model_fit_ddend xgboost model fit for drawdown end period prediction
#'
#' @import xts
#' @import quantmod
#' @import TTR
#' @import PerformanceAnalytics
#' @importFrom magrittr %>% %<>%
#'
#' @return
#'
#' @examples calc_dd_indicators(price_data, vix, sp500, model_fit_ddend)
calc_dd_indicators <- function (x, vix, sp500, model_fit_ddend) {
x$dd <- x %>% Cl() %>% dailyReturn() %>% Drawdowns() %>% magrittr::multiply_by(., -1)
x$ddpeak_ema15 <- x %>% Cl() %>% dailyReturn() %>% DrawdownPeak() %>% magrittr::multiply_by(., -1) %>% EMA(5)
x$maxdd025 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 25, FUN = maxDrawdown, align = "right")
x$maxdd050 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 50, FUN = maxDrawdown, align = "right")
x$maxdd100 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 100, FUN = maxDrawdown, align = "right")
x$maxdd200 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 200, FUN = maxDrawdown, align = "right")
x$maxdd300 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 300, FUN = maxDrawdown, align = "right")
tmp <- x
tmp$dd_cross <- ifelse(tmp$dd > 0.25, 1, 0) %>% diff()
tmp$price_at_ddcross <- ifelse(tmp$dd_cross == 1, Cl(tmp), NA) %>% na.locf()
tmp$price_to_ddcross <- ( Cl(tmp)/tmp$price_at_ddcross ) %>% na.fill(fill=1)
x$price_to_ddx <- tmp$price_to_ddcross %>% EMA(10)
tmp <- x
tmp$dd_cross <- ifelse(tmp$ddpeak_ema15 > 0.20, 1, 0) %>% diff()
tmp$price_at_ddcross <- ifelse(tmp$dd_cross == 1, Cl(tmp), NA) %>% na.locf()
tmp$price_to_ddcross <- ( Cl(tmp)/tmp$price_at_ddcross ) %>% na.fill(fill=1)
x$price_to_ddpeakx <- tmp$price_to_ddcross %>% EMA(10)
x$vix <- vix %>% magrittr::divide_by(., 100) %>% .[index(x)]
x$vix %<>% na.locf()
x$vola100 <- (OHLC(x) %>% volatility(n = 100)) / (OHLC(sp500) %>% volatility(n = 100) %>% .[index(x)])
x$vola100 %<>% na.locf()
x$vola150 <- (OHLC(x) %>% volatility(n = 150)) / (OHLC(sp500) %>% volatility(n = 150) %>% .[index(x)])
x$vola150 %<>% na.locf()
x$vola200 <- (OHLC(x) %>% volatility(n = 200)) / (OHLC(sp500) %>% volatility(n = 200) %>% .[index(x)])
x$vola200 %<>% na.locf()
x$vola050_roc50 <- OHLC(x) %>% volatility(n = 50) %>% ROC(50)
x$vola100_roc10 <- OHLC(x) %>% volatility(n = 100) %>% ROC(10)
x$vola100_roc50 <- OHLC(x) %>% volatility(n = 100) %>% ROC(50)
x$vola100_roc100 <- OHLC(x) %>% volatility(n = 100) %>% ROC(100)
x$vola200_roc50 <- OHLC(x) %>% volatility(n = 200) %>% ROC(50)
x$vola200_roc200 <- OHLC(x) %>% volatility(n = 200) %>% ROC(200)
x$price_to_SMA300 <- Cl(x) / (Cl(x) %>% SMA(n = 300))
x$price_to_SMA200 <- Cl(x) / (Cl(x) %>% SMA(n = 200))
x$price_to_SMA150 <- Cl(x) / (Cl(x) %>% SMA(n = 150))
x$price_to_SMA100 <- Cl(x) / (Cl(x) %>% SMA(n = 100))
x$price_to_SMA50 <- Cl(x) / (Cl(x) %>% SMA(n = 50))
x$price_to_max050 <- Cl(x) / (Cl(x) %>% rollmax(k=50, align = "right"))
x$price_to_max100 <- Cl(x) / (Cl(x) %>% rollmax(k=100, align = "right"))
x$price_to_max200 <- Cl(x) / (Cl(x) %>% rollmax(k=200, align = "right"))
x$price_to_max300 <- Cl(x) / (Cl(x) %>% rollmax(k=300, align = "right"))
x$price_to_min050 <- Cl(x) / (Cl(x) %>% rollapply(width=50, FUN = min, align = "right"))
x$price_to_min100 <- Cl(x) / (Cl(x) %>% rollapply(width=100, FUN = min, align = "right"))
x$price_to_min200 <- Cl(x) / (Cl(x) %>% rollapply(width=200, FUN = min, align = "right"))
x$price_to_min300 <- Cl(x) / (Cl(x) %>% rollapply(width=300, FUN = min, align = "right"))
x$sma300_to_sma200_min50 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollapply(width=50, FUN = min, align = "right"); x$sma300_to_sma200_min50 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_min100 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollapply(width=100, FUN = min, align = "right"); x$sma300_to_sma200_min100 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_min200 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollapply(width=200, FUN = min, align = "right"); x$sma300_to_sma200_min200 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_min300 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollapply(width=300, FUN = min, align = "right"); x$sma300_to_sma200_min300 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_max50 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmax(k=50, align = "right"); x$sma300_to_sma200_max50 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_max100 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmax(k=100, align = "right"); x$sma300_to_sma200_max100 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_max200 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmax(k=200, align = "right"); x$sma300_to_sma200_max200 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_max300 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmax(k=300, align = "right"); x$sma300_to_sma200_max300 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_mean50 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmean(k=50, align = "right"); x$sma300_to_sma200_mean50 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_mean100 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmean(k=100, align = "right"); x$sma300_to_sma200_mean100 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_mean200 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmean(k=200, align = "right"); x$sma300_to_sma200_mean200 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_mean300 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmean(k=300, align = "right"); x$sma300_to_sma200_mean300 %<>% na.locf(fromLast=TRUE)
x$bband025_sqz <- (HLC(x) %>% BBands(n = 25, sd = 2) %$% up) / (HLC(x) %>% BBands(n = 25, sd = 2) %$% dn)
x$bband050_sqz <- (HLC(x) %>% BBands(n = 50, sd = 1.8) %$% up) / (HLC(x) %>% BBands(n = 50, sd = 1.8) %$% dn)
x$bband100_sqz <- (HLC(x) %>% BBands(n = 100, sd = 1.8) %$% up) / (HLC(x) %>% BBands(n = 100, sd = 1.8) %$% dn)
x$price_to_bband100up <- Cl(x) / (HLC(x) %>% BBands(n = 100, sd = 1.8) %$% up)
x$price_to_bband100dn <- Cl(x) / (HLC(x) %>% BBands(n = 100, sd = 1.8) %$% dn)
x$roc002_ema02 <- (Cl(x) %>% ROC(n = 2)) %>% EMA(2)
x$roc005_ema02 <- (Cl(x) %>% ROC(n = 5)) %>% EMA(2)
x$roc012_ema04 <- (Cl(x) %>% ROC(n = 12)) %>% EMA(4)
x$roc024_ema05 <- (Cl(x) %>% ROC(n = 24)) %>% EMA(5)
x$roc048_ema05 <- (Cl(x) %>% ROC(n = 48)) %>% EMA(5)
x$roc100_ema10 <- (Cl(x) %>% ROC(n = 100)) %>% EMA(10)
x$roc150_ema15 <- (Cl(x) %>% ROC(n = 150)) %>% EMA(15)
x$roc200_ema20 <- (Cl(x) %>% ROC(n = 200)) %>% EMA(20)
x$roc300_ema25 <- (Cl(x) %>% ROC(n = 300)) %>% EMA(25)
x$price_to_spB25m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 25) %$% spanB)
x$price_to_spB50m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 50) %$% spanB)
x$price_to_spB75m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 75) %$% spanB)
x$price_to_spB100m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 100) %$% spanB)
x$price_to_spB125m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 125) %$% spanB)
x$price_to_spB150m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 150) %$% spanB)
x$price_to_spB200m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 200) %$% spanB)
x$price_to_spB100m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 100) %$% spanB)
x$price_to_spB125m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 125) %$% spanB)
x$price_to_spB150m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 150) %$% spanB)
x$price_to_spB200m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 200) %$% spanB)
x$price_to_spA25m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 25) %$% spanA)
x$price_to_spA50m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 50) %$% spanA)
x$price_to_spA75m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 75) %$% spanA)
x$price_to_spA100m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 100) %$% spanA)
x$price_to_spA125m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 125) %$% spanA)
x$price_to_spA150m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 150) %$% spanA)
x$price_to_spA200m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 200) %$% spanA)
x$price_to_spA100m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 100) %$% spanA)
x$price_to_spA125m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 125) %$% spanA)
x$price_to_spA150m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 150) %$% spanA)
x$price_to_spA200m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 200) %$% spanA)
x$price_to_sar.0001f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.0001, 0.0005))) ) %>% tradr:::scale_sar()
x$price_to_sar.00025f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.00025, 0.00125))) ) %>% tradr:::scale_sar()
x$price_to_sar.00025f10 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.00025, 0.0025))) ) %>% tradr:::scale_sar()
x$price_to_sar.001f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.001, 0.005))) ) %>% tradr:::scale_sar()
x$price_to_sar.002f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.002, 0.01))) ) %>% tradr:::scale_sar()
x$price_to_sar.005f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.005, 0.025))) ) %>% tradr:::scale_sar()
x$price_to_sar.01f10 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.01, 0.1))) ) %>% tradr:::scale_sar()
x$price_to_sar.02f10 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.02, 0.2))) ) %>% tradr:::scale_sar()
x$price_to_st3 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 3)) ) %>% tradr:::scale_sar()
x$price_to_st5 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 5)) ) %>% tradr:::scale_sar()
x$price_to_st7 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 7)) ) %>% tradr:::scale_sar()
x$price_to_st9 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 9)) ) %>% tradr:::scale_sar()
x$price_to_st12 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 12)) ) %>% tradr:::scale_sar()
x$price_to_st15 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 15)) ) %>% tradr:::scale_sar()
x$price_to_st7_up <- ifelse(x$price_to_st7 < 1, Cl(x), NA) %>%
na.locf() %>%
divide_by(Cl(x), .)
x$price_to_st9_up <- ifelse(x$price_to_st9 < 1, Cl(x), NA) %>%
na.locf() %>%
divide_by(Cl(x), .)
x$stoch050_003 <- x %>% HLC() %>% TTR::stoch(50, 3) %>% .[, 2]
x$stoch100_010 <- x %>% HLC() %>% TTR::stoch(100, 10) %>% .[, 2]
x$stoch150_010 <- x %>% HLC() %>% TTR::stoch(150, 10) %>% .[, 2]
x$stoch200_020 <- x %>% HLC() %>% TTR::stoch(200, 20) %>% .[, 2]
x$stoch200_050 <- x %>% HLC() %>% TTR::stoch(200, 50) %>% .[, 2]
x$stoch250_050 <- x %>% HLC() %>% TTR::stoch(250, 50) %>% .[, 2]
x$stoch300_050 <- x %>% HLC() %>% TTR::stoch(300, 50) %>% .[, 2]
x$wpr025 <- x %>% HLC() %>% TTR::WPR(25)
x$wpr075 <- x %>% HLC() %>% TTR::WPR(75)
x$wpr150 <- x %>% HLC() %>% TTR::WPR(150)
x$wpr300 <- x %>% HLC() %>% TTR::WPR(300)
x$stoch100_10_to_stoch100_05 <- (x %>% HLC() %>% TTR::stoch(100, 5, 10) %>% .[, 3]) /
(x %>% HLC() %>% TTR::stoch(100, 5, 10) %>% .[, 2])
x$stoch150_20_to_stoch150_10 <- (x %>% HLC() %>% TTR::stoch(250, 10, 20) %>% .[, 3]) /
(x %>% HLC() %>% TTR::stoch(250, 10, 20) %>% .[, 2])
x$stoch200_30_to_stoch200_20 <- (x %>% HLC() %>% TTR::stoch(200, 20, 30) %>% .[, 3]) /
(x %>% HLC() %>% TTR::stoch(200, 20, 30) %>% .[, 2])
x$stoch020_020_roc10 <- x %>% HLC() %>% TTR::stoch(20, 20) %>% .[, 2] %>% momentum(10)
x$stoch100_010_roc25 <- x %>% HLC() %>% TTR::stoch(100, 10) %>% .[, 2] %>% momentum(25)
x$stoch200_025_roc25 <- x %>% HLC() %>% TTR::stoch(100, 25) %>% .[, 2] %>% momentum(25)
pred_tbl <- x %>% na.omit() %>% fortify.zoo()
x$ddend <- pred_tbl %>%
dplyr::mutate(ddend = predict(model_fit_ddend,
newdata = ., type = "prob") %>%
.[, "ddend"]) %>%
dplyr::select(ddend) %>%
xts(., order.by = pred_tbl$Index)
x$ddend_ema15 <- x$ddend %>% na.locf() %>% EMA(15)
tmp <- x$dd
tmp$ddend <- x$ddend
tmp$ddentry_s <- ifelse(tmp$ddend > 0.2, tmp$dd, NA) %>%
rollmean(k=3, align="right")
tmp$ddentry_lag <- lag(tmp$ddentry_s)
tmp$ddentry_f <- ifelse(is.na(tmp$ddentry_lag), tmp$ddentry_s, NA)
tmp$ddentry_f %<>% ifelse(tmp$dd == 0, 0, .) %>%
na.locf() %>% na.fill(fill = 0)
x$ddentry <- ifelse(tmp$ddentry_f == 0, 0, tmp$dd/tmp$ddentry_f)
x
}
#' Predict Drawdown
#'
#' @param x xts price series
#' @param sp500 xts price series for S&P500
#' @param vix xts data series for Volatility Index
#' @param model_fit_ddend xgboost model fit for drawdown end period prediction
#' @param model_fit_dd xgboost model fit for drawdown period prediction
#'
#' @import xts
#' @import quantmod
#' @importFrom magrittr %>% %<>%
#'
#' @return xts object containing drawdown adjusted weights
#' @export
#'
#' @examples predict_dd(price_data, sp500, vix, model_fit_dd, model_fit_dd_end)
predict_dd <- function (x, sp500, vix, model_fit_dd, model_fit_ddend) {
px <- cbind(x, x, x, x) %>%
`colnames<-`(c("Open", "High", "Low", "Close"))
tmp <- px[1:300, ]
idx_diff <- index(tmp)[1] - index(tmp)[nrow(tmp)] - 1
tmp <- xts(tmp, order.by = as.Date(index(tmp) + idx_diff))
tmp %<>% replace(.>=0, NA)
tmp[1, ] <- px[1, ] * 1.05
tmp[nrow(tmp), ] <- px[1, ]
tmp %<>% na.approx()
px_mod <- rbind(tmp, px)
data_indicators <- px_mod %>% list() %>%
purrr::map(., ~ .x %>% tradr:::calc_dd_indicators(.,
sp500 = sp500, vix = vix,
model_fit_ddend = model_fit_ddend))
data_indicators %<>% .[[1]] %>%
na.locf(fromLast = TRUE) %>%
.[index(px), ]
data_indicators %<>%
replace(!is.finite(.), NA) %>%
na.locf()
pred_dd <- predict(model_fit_dd,
newdata = data_indicators, "prob") %>%
.[, "dd"]
idx <- px %>% index()
R <- px %>% Cl() %>% dailyReturn()
R$weights <- (1 - pred_dd) %>% EMA(15) %>%
replace(.>= 0.95, 1) %>%
na.fill(fill=1)
R$weights
}
rengelke/tradr documentation built on Jan. 2, 2022, 2:03 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' Trim SAR and Supertrend indicator values
#'
#' @param x xts object with SAR or Supertrend indicator values
#'
#' @return
#'
#' @examples scale_sar(TTR::SAR(price_data))
scale_sar <- function (x) {
x %>% replace(.>=1.25, 1.25) %>% replace(.<=0.75, 0.75)
}
#' Calculate Drawdown Indicators
#'
#' @param x xts price series containing Open, High, Low, Close columns
#' @param sp500 xts price series containing Open, High, Low, Close columns for S&P500
#' @param vix xts object containing Volatility Index data
#' @param model_fit_ddend xgboost model fit for drawdown end period prediction
#'
#' @import xts
#' @import quantmod
#' @import TTR
#' @import PerformanceAnalytics
#' @importFrom magrittr %>% %<>%
#'
#' @return
#'
#' @examples calc_dd_indicators(price_data, vix, sp500, model_fit_ddend)
calc_dd_indicators <- function (x, vix, sp500, model_fit_ddend) {
x$dd <- x %>% Cl() %>% dailyReturn() %>% Drawdowns() %>% magrittr::multiply_by(., -1)
x$ddpeak_ema15 <- x %>% Cl() %>% dailyReturn() %>% DrawdownPeak() %>% magrittr::multiply_by(., -1) %>% EMA(5)
x$maxdd025 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 25, FUN = maxDrawdown, align = "right")
x$maxdd050 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 50, FUN = maxDrawdown, align = "right")
x$maxdd100 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 100, FUN = maxDrawdown, align = "right")
x$maxdd200 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 200, FUN = maxDrawdown, align = "right")
x$maxdd300 <- rollapply(x %>% Cl() %>% dailyReturn(), width = 300, FUN = maxDrawdown, align = "right")
tmp <- x
tmp$dd_cross <- ifelse(tmp$dd > 0.25, 1, 0) %>% diff()
tmp$price_at_ddcross <- ifelse(tmp$dd_cross == 1, Cl(tmp), NA) %>% na.locf()
tmp$price_to_ddcross <- ( Cl(tmp)/tmp$price_at_ddcross ) %>% na.fill(fill=1)
x$price_to_ddx <- tmp$price_to_ddcross %>% EMA(10)
tmp <- x
tmp$dd_cross <- ifelse(tmp$ddpeak_ema15 > 0.20, 1, 0) %>% diff()
tmp$price_at_ddcross <- ifelse(tmp$dd_cross == 1, Cl(tmp), NA) %>% na.locf()
tmp$price_to_ddcross <- ( Cl(tmp)/tmp$price_at_ddcross ) %>% na.fill(fill=1)
x$price_to_ddpeakx <- tmp$price_to_ddcross %>% EMA(10)
x$vix <- vix %>% magrittr::divide_by(., 100) %>% .[index(x)]
x$vix %<>% na.locf()
x$vola100 <- (OHLC(x) %>% volatility(n = 100)) / (OHLC(sp500) %>% volatility(n = 100) %>% .[index(x)])
x$vola100 %<>% na.locf()
x$vola150 <- (OHLC(x) %>% volatility(n = 150)) / (OHLC(sp500) %>% volatility(n = 150) %>% .[index(x)])
x$vola150 %<>% na.locf()
x$vola200 <- (OHLC(x) %>% volatility(n = 200)) / (OHLC(sp500) %>% volatility(n = 200) %>% .[index(x)])
x$vola200 %<>% na.locf()
x$vola050_roc50 <- OHLC(x) %>% volatility(n = 50) %>% ROC(50)
x$vola100_roc10 <- OHLC(x) %>% volatility(n = 100) %>% ROC(10)
x$vola100_roc50 <- OHLC(x) %>% volatility(n = 100) %>% ROC(50)
x$vola100_roc100 <- OHLC(x) %>% volatility(n = 100) %>% ROC(100)
x$vola200_roc50 <- OHLC(x) %>% volatility(n = 200) %>% ROC(50)
x$vola200_roc200 <- OHLC(x) %>% volatility(n = 200) %>% ROC(200)
x$price_to_SMA300 <- Cl(x) / (Cl(x) %>% SMA(n = 300))
x$price_to_SMA200 <- Cl(x) / (Cl(x) %>% SMA(n = 200))
x$price_to_SMA150 <- Cl(x) / (Cl(x) %>% SMA(n = 150))
x$price_to_SMA100 <- Cl(x) / (Cl(x) %>% SMA(n = 100))
x$price_to_SMA50 <- Cl(x) / (Cl(x) %>% SMA(n = 50))
x$price_to_max050 <- Cl(x) / (Cl(x) %>% rollmax(k=50, align = "right"))
x$price_to_max100 <- Cl(x) / (Cl(x) %>% rollmax(k=100, align = "right"))
x$price_to_max200 <- Cl(x) / (Cl(x) %>% rollmax(k=200, align = "right"))
x$price_to_max300 <- Cl(x) / (Cl(x) %>% rollmax(k=300, align = "right"))
x$price_to_min050 <- Cl(x) / (Cl(x) %>% rollapply(width=50, FUN = min, align = "right"))
x$price_to_min100 <- Cl(x) / (Cl(x) %>% rollapply(width=100, FUN = min, align = "right"))
x$price_to_min200 <- Cl(x) / (Cl(x) %>% rollapply(width=200, FUN = min, align = "right"))
x$price_to_min300 <- Cl(x) / (Cl(x) %>% rollapply(width=300, FUN = min, align = "right"))
x$sma300_to_sma200_min50 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollapply(width=50, FUN = min, align = "right"); x$sma300_to_sma200_min50 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_min100 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollapply(width=100, FUN = min, align = "right"); x$sma300_to_sma200_min100 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_min200 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollapply(width=200, FUN = min, align = "right"); x$sma300_to_sma200_min200 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_min300 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollapply(width=300, FUN = min, align = "right"); x$sma300_to_sma200_min300 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_max50 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmax(k=50, align = "right"); x$sma300_to_sma200_max50 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_max100 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmax(k=100, align = "right"); x$sma300_to_sma200_max100 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_max200 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmax(k=200, align = "right"); x$sma300_to_sma200_max200 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_max300 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmax(k=300, align = "right"); x$sma300_to_sma200_max300 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_mean50 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmean(k=50, align = "right"); x$sma300_to_sma200_mean50 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_mean100 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmean(k=100, align = "right"); x$sma300_to_sma200_mean100 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_mean200 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmean(k=200, align = "right"); x$sma300_to_sma200_mean200 %<>% na.locf(fromLast=TRUE)
x$sma300_to_sma200_mean300 <- ( (Cl(x) %>% SMA(n = 300)) / (Cl(x) %>% SMA(n = 200)) ) %>%
rollmean(k=300, align = "right"); x$sma300_to_sma200_mean300 %<>% na.locf(fromLast=TRUE)
x$bband025_sqz <- (HLC(x) %>% BBands(n = 25, sd = 2) %$% up) / (HLC(x) %>% BBands(n = 25, sd = 2) %$% dn)
x$bband050_sqz <- (HLC(x) %>% BBands(n = 50, sd = 1.8) %$% up) / (HLC(x) %>% BBands(n = 50, sd = 1.8) %$% dn)
x$bband100_sqz <- (HLC(x) %>% BBands(n = 100, sd = 1.8) %$% up) / (HLC(x) %>% BBands(n = 100, sd = 1.8) %$% dn)
x$price_to_bband100up <- Cl(x) / (HLC(x) %>% BBands(n = 100, sd = 1.8) %$% up)
x$price_to_bband100dn <- Cl(x) / (HLC(x) %>% BBands(n = 100, sd = 1.8) %$% dn)
x$roc002_ema02 <- (Cl(x) %>% ROC(n = 2)) %>% EMA(2)
x$roc005_ema02 <- (Cl(x) %>% ROC(n = 5)) %>% EMA(2)
x$roc012_ema04 <- (Cl(x) %>% ROC(n = 12)) %>% EMA(4)
x$roc024_ema05 <- (Cl(x) %>% ROC(n = 24)) %>% EMA(5)
x$roc048_ema05 <- (Cl(x) %>% ROC(n = 48)) %>% EMA(5)
x$roc100_ema10 <- (Cl(x) %>% ROC(n = 100)) %>% EMA(10)
x$roc150_ema15 <- (Cl(x) %>% ROC(n = 150)) %>% EMA(15)
x$roc200_ema20 <- (Cl(x) %>% ROC(n = 200)) %>% EMA(20)
x$roc300_ema25 <- (Cl(x) %>% ROC(n = 300)) %>% EMA(25)
x$price_to_spB25m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 25) %$% spanB)
x$price_to_spB50m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 50) %$% spanB)
x$price_to_spB75m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 75) %$% spanB)
x$price_to_spB100m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 100) %$% spanB)
x$price_to_spB125m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 125) %$% spanB)
x$price_to_spB150m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 150) %$% spanB)
x$price_to_spB200m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 200) %$% spanB)
x$price_to_spB100m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 100) %$% spanB)
x$price_to_spB125m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 125) %$% spanB)
x$price_to_spB150m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 150) %$% spanB)
x$price_to_spB200m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 200) %$% spanB)
x$price_to_spA25m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 25) %$% spanA)
x$price_to_spA50m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 50) %$% spanA)
x$price_to_spA75m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 75) %$% spanA)
x$price_to_spA100m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 100) %$% spanA)
x$price_to_spA125m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 125) %$% spanA)
x$price_to_spA150m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 150) %$% spanA)
x$price_to_spA200m26 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 26, nSlow = 200) %$% spanA)
x$price_to_spA100m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 100) %$% spanA)
x$price_to_spA125m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 125) %$% spanA)
x$price_to_spA150m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 150) %$% spanA)
x$price_to_spA200m52 <- Cl(x) / (x %>% HLC() %>% tradr::ichimoku(nMed = 52, nSlow = 200) %$% spanA)
x$price_to_sar.0001f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.0001, 0.0005))) ) %>% tradr:::scale_sar()
x$price_to_sar.00025f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.00025, 0.00125))) ) %>% tradr:::scale_sar()
x$price_to_sar.00025f10 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.00025, 0.0025))) ) %>% tradr:::scale_sar()
x$price_to_sar.001f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.001, 0.005))) ) %>% tradr:::scale_sar()
x$price_to_sar.002f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.002, 0.01))) ) %>% tradr:::scale_sar()
x$price_to_sar.005f5 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.005, 0.025))) ) %>% tradr:::scale_sar()
x$price_to_sar.01f10 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.01, 0.1))) ) %>% tradr:::scale_sar()
x$price_to_sar.02f10 <- ( Cl(x) / (x %>% HLC() %>% .[, -3] %>% TTR::SAR(accel = c(0.02, 0.2))) ) %>% tradr:::scale_sar()
x$price_to_st3 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 3)) ) %>% tradr:::scale_sar()
x$price_to_st5 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 5)) ) %>% tradr:::scale_sar()
x$price_to_st7 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 7)) ) %>% tradr:::scale_sar()
x$price_to_st9 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 9)) ) %>% tradr:::scale_sar()
x$price_to_st12 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 12)) ) %>% tradr:::scale_sar()
x$price_to_st15 <- ( Cl(x) / (x %>% HLC() %>% supertrend(f = 15)) ) %>% tradr:::scale_sar()
x$price_to_st7_up <- ifelse(x$price_to_st7 < 1, Cl(x), NA) %>%
na.locf() %>%
divide_by(Cl(x), .)
x$price_to_st9_up <- ifelse(x$price_to_st9 < 1, Cl(x), NA) %>%
na.locf() %>%
divide_by(Cl(x), .)
x$stoch050_003 <- x %>% HLC() %>% TTR::stoch(50, 3) %>% .[, 2]
x$stoch100_010 <- x %>% HLC() %>% TTR::stoch(100, 10) %>% .[, 2]
x$stoch150_010 <- x %>% HLC() %>% TTR::stoch(150, 10) %>% .[, 2]
x$stoch200_020 <- x %>% HLC() %>% TTR::stoch(200, 20) %>% .[, 2]
x$stoch200_050 <- x %>% HLC() %>% TTR::stoch(200, 50) %>% .[, 2]
x$stoch250_050 <- x %>% HLC() %>% TTR::stoch(250, 50) %>% .[, 2]
x$stoch300_050 <- x %>% HLC() %>% TTR::stoch(300, 50) %>% .[, 2]
x$wpr025 <- x %>% HLC() %>% TTR::WPR(25)
x$wpr075 <- x %>% HLC() %>% TTR::WPR(75)
x$wpr150 <- x %>% HLC() %>% TTR::WPR(150)
x$wpr300 <- x %>% HLC() %>% TTR::WPR(300)
x$stoch100_10_to_stoch100_05 <- (x %>% HLC() %>% TTR::stoch(100, 5, 10) %>% .[, 3]) /
(x %>% HLC() %>% TTR::stoch(100, 5, 10) %>% .[, 2])
x$stoch150_20_to_stoch150_10 <- (x %>% HLC() %>% TTR::stoch(250, 10, 20) %>% .[, 3]) /
(x %>% HLC() %>% TTR::stoch(250, 10, 20) %>% .[, 2])
x$stoch200_30_to_stoch200_20 <- (x %>% HLC() %>% TTR::stoch(200, 20, 30) %>% .[, 3]) /
(x %>% HLC() %>% TTR::stoch(200, 20, 30) %>% .[, 2])
x$stoch020_020_roc10 <- x %>% HLC() %>% TTR::stoch(20, 20) %>% .[, 2] %>% momentum(10)
x$stoch100_010_roc25 <- x %>% HLC() %>% TTR::stoch(100, 10) %>% .[, 2] %>% momentum(25)
x$stoch200_025_roc25 <- x %>% HLC() %>% TTR::stoch(100, 25) %>% .[, 2] %>% momentum(25)
pred_tbl <- x %>% na.omit() %>% fortify.zoo()
x$ddend <- pred_tbl %>%
dplyr::mutate(ddend = predict(model_fit_ddend,
newdata = ., type = "prob") %>%
.[, "ddend"]) %>%
dplyr::select(ddend) %>%
xts(., order.by = pred_tbl$Index)
x$ddend_ema15 <- x$ddend %>% na.locf() %>% EMA(15)
tmp <- x$dd
tmp$ddend <- x$ddend
tmp$ddentry_s <- ifelse(tmp$ddend > 0.2, tmp$dd, NA) %>%
rollmean(k=3, align="right")
tmp$ddentry_lag <- lag(tmp$ddentry_s)
tmp$ddentry_f <- ifelse(is.na(tmp$ddentry_lag), tmp$ddentry_s, NA)
tmp$ddentry_f %<>% ifelse(tmp$dd == 0, 0, .) %>%
na.locf() %>% na.fill(fill = 0)
x$ddentry <- ifelse(tmp$ddentry_f == 0, 0, tmp$dd/tmp$ddentry_f)
x
}
#' Predict Drawdown
#'
#' @param x xts price series
#' @param sp500 xts price series for S&P500
#' @param vix xts data series for Volatility Index
#' @param model_fit_ddend xgboost model fit for drawdown end period prediction
#' @param model_fit_dd xgboost model fit for drawdown period prediction
#'
#' @import xts
#' @import quantmod
#' @importFrom magrittr %>% %<>%
#'
#' @return xts object containing drawdown adjusted weights
#' @export
#'
#' @examples predict_dd(price_data, sp500, vix, model_fit_dd, model_fit_dd_end)
predict_dd <- function (x, sp500, vix, model_fit_dd, model_fit_ddend) {
px <- cbind(x, x, x, x) %>%
`colnames<-`(c("Open", "High", "Low", "Close"))
tmp <- px[1:300, ]
idx_diff <- index(tmp)[1] - index(tmp)[nrow(tmp)] - 1
tmp <- xts(tmp, order.by = as.Date(index(tmp) + idx_diff))
tmp %<>% replace(.>=0, NA)
tmp[1, ] <- px[1, ] * 1.05
tmp[nrow(tmp), ] <- px[1, ]
tmp %<>% na.approx()
px_mod <- rbind(tmp, px)
data_indicators <- px_mod %>% list() %>%
purrr::map(., ~ .x %>% tradr:::calc_dd_indicators(.,
sp500 = sp500, vix = vix,
model_fit_ddend = model_fit_ddend))
data_indicators %<>% .[[1]] %>%
na.locf(fromLast = TRUE) %>%
.[index(px), ]
data_indicators %<>%
replace(!is.finite(.), NA) %>%
na.locf()
pred_dd <- predict(model_fit_dd,
newdata = data_indicators, "prob") %>%
.[, "dd"]
idx <- px %>% index()
R <- px %>% Cl() %>% dailyReturn()
R$weights <- (1 - pred_dd) %>% EMA(15) %>%
replace(.>= 0.95, 1) %>%
na.fill(fill=1)
R$weights
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.