R/make_orders.R

Defines functions make_orders

#' @importFrom data.table ':='
.datatable.aware = TRUE

if (getRversion() >= '2.15.1')
  utils::globalVariables(c('.', '.N', '.SD', 'EMA_gt', 'EMA_lt', 'Units',
                           'Symbol', 'BAV', 'GANN', 'IKM', 'KDA', 'NAV',
                           'SPY.Close', 'symbol', 'askPrice', 
                           'instrument.symbol', 'longQuantity', 'Should_Have', 
                           'Do_Have', 'Qty', 'VIX.Close'),
                         utils::packageName())

make_orders <- function(leverageFactors, maxLeverage, wealthScale)
{
  lf <- leverageFactors
  dl <- maxLeverage

  # load
  monthly_figures <- readRDS('data/monthly_figures.rds')
  gann_sigs <- readRDS('data/gann_sigs.rds')

  # VIX
  vix <- quantmod::getSymbols('^VIX', env = NULL, from = '1990-01-01', to = Sys.Date()+1)
  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, ] %>%
    `rownames<-`(seq(nrow(.)))
  pg <- pgrid[monthly_figures$vix, ]

  vix_sig <- vix_dt[
    , EMA_gt := TTR::EMA(VIX.Close, pg[,1])][
    , EMA_lt := TTR::EMA(VIX.Close, pg[,2])][
    , .SD[.N]][
    , Sig := EMA_gt > EMA_lt][
    , Sig] %>%
    as.numeric

  # BAV
  pseq <- c(2:9, seq(10, 95, 5), seq(100, 200, 10))
  ps <- pseq[monthly_figures$bav]
  spy <- quantmod::getSymbols('SPY', env = NULL, from = Sys.Date()-430, to = Sys.Date()+1)
  spy_rets <- data.table::data.table(spy, keep.rownames = TRUE) %$%
    xts::xts(SPY.Close, index) %>%
    {. / quantmod::Lag(.) - 1}
  sma_dt <- data.table::data.table(spy_rets, keep.rownames = TRUE) %>%
    data.table::setnames(2, 'Ret') %>%
    stats::na.omit()

  bav_sig <- sma_dt[
    , Sig := Ret < (-TTR::SMA(abs(Ret), ps))][
    , .SD[.N]][
    , Sig] %>%
    as.numeric

  # UNITS
  kda_units <- data.table::data.table(t(monthly_figures$kda),
                                      keep.rownames = TRUE) %>%
    `names<-`(c('Symbol', 'Units')) %>%
    .[Units > 0] %>%
    .[Symbol != 'CASH'] # redundant; corrected in make_monthly_figures

  ikm_units <- data.table::data.table(t(monthly_figures$ikm),
                                      keep.rownames = TRUE) %>%
    `names<-`(c('Symbol', 'Units')) %>%
    .[, Units := Units * vix_sig] %>%
    .[Units > 0] %>%
    .[Symbol != 'CASH'] # redundant; corrected in make_monthly_figures

  bav_units <- data.table::data.table(Symbol = 'SPY', Units = bav_sig * lf[1])
  gann_units <- data.table::data.table(t(gann_sigs), keep.rownames = TRUE) %>%
    `names<-`(c('Symbol', 'Units')) %>%
    .[Units > 0] %>%
    .[, .SD[1]] %>%
    .[, Units := Units * lf[2]]

  if (is.na(gann_units[, Symbol])) gann_units[1,2] <- 0

  # models placed in order of priority (different ordering than leverageFactors)
  mod_units <- data.table::data.table(BAV = bav_units[, Units],
                                      GANN = gann_units[, Units],
                                      IKM = sum(ikm_units[, Units]),
                                      KDA = sum(kda_units[, Units]))[
    , BAV := min(BAV, dl)][
    , GANN := min(GANN, dl-BAV)][
    , IKM := min(IKM, dl-BAV-GANN)][
    , KDA := min(KDA, dl-BAV-GANN-IKM)][]

  bav_units[,2] <- mod_units[, BAV]
  gann_units[,2] <- mod_units[, GANN]
  ikm_units[, Units := Units * (mod_units[, IKM] / sum(ikm_units[, Units]))]
  kda_units[, Units := Units * (mod_units[, KDA] / sum(kda_units[, Units]))]

  account <- rameritrade::td_accountData()
  wealth <- account$balances$liquidationValue * wealthScale

  unit_dt <- rbind(bav_units, gann_units, ikm_units, kda_units) %>%
    .[Units > 0] %>%
    .[, .(Units = sum(Units)), by = Symbol] %>%
    .[order(Symbol)] %>%
    .[, NAV := Units * wealth] %>%
    .[NAV > 0] %>%
    .[, !'Units']

  # switch from research symbols to ETFs with better expense ratios
  unit_dt[
    , Symbol := sub('SPY', 'SPLG', Symbol)][
    , Symbol := sub('QQQ', 'QQQM', Symbol)][
    , Symbol := sub('EWJ', 'BBJP', Symbol)][
    , Symbol := sub('EEM', 'VWO', Symbol)][
    , Symbol := sub('VNQ', 'XLRE', Symbol)][
    , Symbol := sub('RWX', 'VNQI', Symbol)][
    , Symbol := sub('TLT', 'SPTL', Symbol)][
    , Symbol := sub('GLD', 'GLDM', Symbol)][
    , Symbol := sub('DBC', 'PDBC', Symbol)]

  if (length(unit_dt[, Symbol]) > 0) {

    pq <- rameritrade::td_priceQuote(unit_dt[, Symbol])

    ask_prices <- data.table::data.table(pq)[
      , .(symbol, askPrice)] %>%
      data.table::setnames(1, 'Symbol')

    qts_i_should_have <- data.table::merge.data.table(
      ask_prices, unit_dt, by = 'Symbol')[
      , .(Symbol, Qty = round(NAV/askPrice))]

    if (nrow(account$positions) > 0) {
			qts_i_do_have <- data.table::data.table(account$positions)[
				, .(instrument.symbol, longQuantity)] %>%
				`names<-`(c('Symbol', 'Qty'))

			# mod old symbols
			new_qts <- data.table::merge.data.table(qts_i_do_have,
																							qts_i_should_have, by = 'Symbol') %>%
				data.table::setnames(c(2,3), c('Do_Have', 'Should_Have')) %>%
				.[, .(Symbol, Qty = Should_Have - Do_Have)]

			old_symbol_buys <- new_qts[Qty > 0]
			old_symbol_sells <- new_qts[Qty < 0]

			# buy new symbols
			new_symbol_opens <- qts_i_should_have[!(Symbol %in% qts_i_do_have[, Symbol])]

			# close positions
			old_symbol_closes <- qts_i_do_have[!(Symbol %in% qts_i_should_have[, Symbol])]

			sell_dt <- rbind(old_symbol_closes, old_symbol_sells)[, Qty := abs(Qty)]
			buy_dt <- rbind(new_symbol_opens, old_symbol_buys)
		} else {
			sell_dt <- data.table::data.table()
			buy_dt <- qts_i_should_have
		}

	} else {

    if (nrow(account$positions) > 0) {
			sell_dt <- data.table::data.table(account$positions)[
				, .(instrument.symbol, longQuantity)] %>%
				`names<-`(c('Symbol', 'Qty')) %>%
				.[, Qty := abs(Qty)] %>%
        # this is actually needed or else the value won't show up in the output!
        .[]

			buy_dt <- data.table::data.table()
		} else {
			sell_dt <- data.table::data.table()
			buy_dt <- data.table::data.table()
		}

	}

  list(SELL = sell_dt,
       BUY = buy_dt,
       vixEMA = pg,
       bavSMA = ps,
			 accountID = account$balances$accountId)
}
causality-loop/mnmt documentation built on June 17, 2022, 5:14 a.m.