R/make_monthly_figures.R

In causality-loop/mnmt: Mot Nam, Mot Thang

#' @importFrom data.table ':='
#' @importFrom magrittr '%$%' '%T>%'
.datatable.aware = TRUE

if (getRversion() >= '2.15.1')
  utils::globalVariables(c('index', 'VIX.Close'), utils::packageName())

make_monthly_figures <- function(leverageFactors, tradeMonth = NA)
{
  lf <- leverageFactors

  # symbols
  kda_symbols <- c('SPY', 'VWO', 'AGG')

  ikm_symbols <- suppressMessages(tidyquant::tq_index('DOW')) %>%
    data.frame %>%
    .[,1] %>%
    sort

  symbols <- c(kda_symbols, ikm_symbols) %>% unique

  # rets and close
  vix <- quantmod::getSymbols('^VIX', env = NULL, from = '1990-01-01', to = Sys.Date()+1)

  price_list <- list()
  for (i in symbols) {
    price_list[[i]] <- quantmod::getSymbols(i, env = NULL, from = Sys.Date()-430, to = Sys.Date()+1)
  }
  names(price_list) <- symbols

  rets <- parallel::mclapply(price_list, function(x) {
    data.table::data.table(price_list[[1]], keep.rownames = TRUE) %$%
      xts::xts(.[,5], index) %>%
      zoo::na.approx(na.rm = F) %>%
      {. / quantmod::Lag(.) - 1}
  }) %>%
    do.call(what = xts::merge.xts) %>%
    .[-1] %>%
    `names<-`(symbols)

  # vix ema
  vix_dt <- data.table::data.table(vix, keep.rownames = TRUE)[, 
    .(index, VIX.Close)]
  pseq <- c(1:9, seq(10, 95, 5), seq(100, 200, 10))
  pgrid <- expand.grid(gt = pseq, lt = pseq) %>%  .[.$gt > .$lt, ]

  for (i in seq(nrow(pgrid))) {
    gt <- pgrid[i,1]
    lt <- pgrid[i,2]
    vix_dt[, paste0(gt, '.', lt) := (data.table::shift(
      TTR::EMA(VIX.Close, gt) > TTR::EMA(VIX.Close, lt))) %T>%
      { .[!.] <- NA }]
  }

  # ikm rets
  dow_rets <- rets[,ikm_symbols]
  spy_rets <- rets[,'SPY']
  vix_rets <- vix_dt %>%
    {xts::xts(.[,-c(1:2)], .[,index])} %>%
    xts::merge.xts(spy_rets, all = FALSE) %>%
    .[, -ncol(.)] %>%
    {. * as.numeric(spy_rets)}

  # bav rets
  ## if you want, you can make this into a function / lapply thing later if
  ## there's multiple symbols
  pseq <- c(2:9, seq(10, 95, 5), seq(100, 200, 10))
  sma_dt <- data.table::data.table(rets[,'SPY'], keep.rownames = TRUE) %>%
    data.table::setnames(2, 'Ret')

  for (i in pseq) {
    sma_dt[, paste0('SMA', i) :=
             data.table::shift(Ret < (-TTR::SMA(abs(Ret), i))) %T>%
             {.[!.] <- NA}]
  }

  bav_rets <-
    xts::xts(sma_dt[,-c(1:2)], sma_dt[,index]) * as.numeric(rets[,'SPY'])
  # just make into a list bc BAV still takes a list
  bav_ret_list <- list(bav_rets)

  # out - KDA/IKM units, vix ema, BAV sma
  kda <- KDA(rets[, kda_symbols], lf[4]) %>% .[,names(.) != 'CASH']
  ikm <- IKM(dow_rets, vix_rets, lf[3])
  ikm[[1]] %<>% .[,names(.) != 'CASH']
  bav <- BAV(bav_ret_list) %>% .[[1]]

  if (is.na(tradeMonth)) {
    kda_units <- xts::last(kda)
    ikm_units <- xts::last(ikm[[1]])
    vix_ema_col <- xts::last(ikm[[2]])
    bav_sma_col <- xts::last(bav)
  } else {
    tm <- zoo::as.yearmon(tradeMonth) - 1/12
    kda_units <- kda[zoo::as.yearmon(zoo::index(kda)) == tm]
    ikm_units <- ikm[[1]][zoo::as.yearmon(zoo::index(ikm[[1]])) == tm]
    vix_ema_col <- ikm[[2]][zoo::as.yearmon(zoo::index(ikm[[2]])) == tm]
    bav_sma_col <- bav[zoo::as.yearmon(zoo::index(bav)) == tm]
  }

  monthly_figures <- list(kda = kda_units,
                          ikm = ikm_units,
                          vix = vix_ema_col,
                          bav = bav_sma_col)

  saveRDS(monthly_figures, 'data/monthly_figures.rds')
}