R/order.R

Defines functions order

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

if (getRversion() >= '2.15.1')
  utils::globalVariables(c('.', 'Symbol', 'Qty', 'maintenanceRequirement',
                           'marketValue'), utils::packageName())

order <- function(trade, leverageFactors, maxLeverage, wealthScale,
                  fullPath, dates)
{
  no_file <- !file.exists('data/monthly_figures.rds')
  is_esom_day <- Sys.Date() %in% c(dates$EOM, dates$SOM)

  if (no_file & !is_esom_day) {
    tm <- format(zoo::as.yearmon(Sys.Date()), '%Y-%m')
    cat('\nMaking monthly figures because file does not exist\n\n')
    make_monthly_figures(leverageFactors, tm)
  } else if (is_esom_day) {
    cat('\nMaking monthly figures because today == EoM or SoM\n\n')
    make_monthly_figures(leverageFactors)
  }

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

  if (!file.exists('data/ikm_symbols.rds'))
    saveRDS(ikm_symbols, 'data/ikm_symbols.rds')

  yesterday_ikm_symbols <- readRDS('data/ikm_symbols.rds')
  saveRDS(ikm_symbols, 'data/ikm_symbols.rds')

  dowComponentsChanged <- !identical(ikm_symbols, yesterday_ikm_symbols) &
    !(Sys.Date() %in% c(dates$EOM, dates$SOM))

  if (dowComponentsChanged) {
    tm <- format(zoo::as.yearmon(Sys.Date()), '%Y-%m')
    cat('\nMaking monthly figures because Dow components changed\n\n')
    make_monthly_figures(leverageFactors, tm)
  }

  if (!file.exists('data/gann_sigs.rds')) {
    cat('\nMaking Gann signals because file does not exist\n\n')
    make_gann_sigs()
  } else if (Sys.Date() %in% dates$EOW) {
    cat('\nMaking Gann signals because today == EoW\n\n')
    make_gann_sigs()
  }

  order_list <- make_orders(leverageFactors = leverageFactors,
                            maxLeverage = maxLeverage,
                            wealthScale = wealthScale)

	# do not include account info in output
  if (!trade) return(order_list[1:4])

  accountID <- order_list[[5]]

  get_quote <- function(symbol) {
    col_names <- c('symbol', 'bidPrice', 'bidSize', 'askPrice', 'askSize',
                   'lastPrice', 'closePrice', 'totalVolume',  'mark',
                   'exchange', 'exchangeName', 'marginable',  'shortable',
                   'volatility', 'securityStatus',  'regularMarketLastPrice',
                   'regularMarketLastSize', 'delayed', 'realtimeEntitled')

    rameritrade::td_priceQuote(symbol)[, col_names] %>% 
      data.table::data.table()
  }

  place_order <- function(accountNumber, ticker, quantity, instruction) {
    rameritrade::td_placeOrder(accountNumber = accountNumber,
                               ticker = ticker,
                               quantity = quantity,
                               instruction = instruction)
  }

  # sells
  sell_dt <- order_list$SELL
  security_info_sells <- list()
  if (nrow(sell_dt) > 0) {
    for (i in 1:nrow(sell_dt)) {
      symbol <- sell_dt[i, Symbol]
      security_info_sells[[i]] <- get_quote(symbol)
      qty <- as.integer(sell_dt[i, Qty])
      place_order(accountID, symbol, qty, 'SELL')
    }

    # give time for orders to process
    cat('\nWaiting for SELL orders to process (15 sec)\n\n')
    Sys.sleep(15)
  }

  # buys
  buy_dt <- order_list$BUY
  security_info_buys <- list()
  if (nrow(buy_dt) > 0) {
    for (i in 1:nrow(buy_dt)) {
      symbol <- buy_dt[i, Symbol]
      security_info_buys[[i]] <- get_quote(symbol)
      qty <- as.integer(buy_dt[i, Qty])
      place_order(accountID, symbol, qty, 'BUY')
    }

    # give time for orders to process
    cat('\nWaiting for BUY orders to process (15 sec)\n\n')
    Sys.sleep(15)
  }

  account <- rameritrade::td_accountData()
  account_info <- data.table::data.table(account$balances)[
    , date := Sys.Date()] %>%
    data.table::setcolorder('date')

  # store data
  make_blank_order_dt <- function(side) {
    col_names <- c('date', 'symbol', 'side', 'bidPrice', 'bidSize',
                   'askPrice', 'askSize', 'lastPrice', 'closePrice',
                   'totalVolume', 'mark', 'exchange', 'exchangeName',
                   'marginable', 'shortable', 'volatility', 'securityStatus',
                   'regularMarketLastPrice', 'regularMarketLastSize', 'delayed',
                   'realtimeEntitled')

    data.table::data.table(
      t(c(as.character(Sys.Date()), NA, side, rep(NA, 18)))) %>%
      `names<-`(col_names) %>%
      .[, date := as.Date(date)] %>%
      data.table::setcolorder('date')
  }

  if (length(security_info_buys) > 0) {
    buy_info <- do.call(rbind, security_info_buys)[
      , `:=` (date = Sys.Date(), side = 'BUY')] %>%
      data.table::setcolorder(c('date', 'symbol', 'side'))
  } else {
    buy_info <- make_blank_order_dt('BUY')
  }

  if (length(security_info_sells) > 0) {
    sell_info <- do.call(rbind, security_info_sells)[
      , `:=` (date = Sys.Date(), side = 'SELL')] %>%
      data.table::setcolorder(c('date', 'symbol', 'side'))
  } else {
    sell_info <- make_blank_order_dt('SELL')
  }

  trade_info <- rbind(buy_info, sell_info) %>% unique

  make_blank_dt <- function(col_names) {
    data.table::data.table(
      t(rep(NA, length(col_names)))) %>%
      `names<-`(col_names)
  }

  pos_col_names <- c('instrument.symbol', 'averagePrice', 'longQuantity',
                     'shortQuantity', 'previousSessionLongQuantity',
                     'maintenanceRequirement', 'marketValue',
                     'currentDayProfitLoss', 'currentDayProfitLossPercentage',
                     'currentDayCost', 'isClosingOnlyRestricted')

  if (length(account$positions) > 0) {
    pos_info <- data.table::data.table(account$positions[, pos_col_names])[
      , `:=` (date = Sys.Date(),
              borrowStatus = maintenanceRequirement / marketValue)] %>%
      data.table::setnames('instrument.symbol', 'symbol') %>%
      data.table::setcolorder(c('date', 'symbol', 'borrowStatus'))
  } else {
    pos_info <- make_blank_dt(pos_col_names)[
      , `:=` (date = Sys.Date(), borrowStatus = NA)] %>%
      data.table::setnames('instrument.symbol', 'symbol') %>%
      data.table::setcolorder(c('date', 'symbol', 'borrowStatus'))
  }

  oen_col_names <- c('instrument.symbol', 'instruction', 'orderId',
                     'orderLegType', 'positionEffect', 'quantity', 'session',
                     'duration', 'orderType', 'total_qty', 'filledQuantity',
                     'remainingQuantity', 'requestedDestination',
                     'destinationLinkName', 'orderStrategyType', 'status',
                     'enteredTime', 'closeTime')

  if (length(account$orders$orderEntry) > 0) {
    order_entry_info <-
      data.table::data.table(account$orders$orderEntry[, oen_col_names])[
      , date := Sys.Date()] %>%
      data.table::setnames(c('instrument.symbol', 'instruction'),
                           c('symbol', 'side')) %>%
      data.table::setcolorder('date')
  } else {
    order_entry_info <- make_blank_dt(oen_col_names)[
      , date := Sys.Date()] %>%
      data.table::setnames(c('instrument.symbol', 'instruction'),
                           c('symbol', 'side')) %>%
      data.table::setcolorder('date')
  }

  oex_col_names <- c('instrument.symbol', 'instruction', 'orderId',
                     'total_qty', 'duration', 'orderType', 'enteredTime')

  if (length(account$orders$orderExecution) > 0) {
    order_exec_info <-
      data.table::data.table(account$orders$orderExecution[, oex_col_names])[
      , date := Sys.Date()] %>%
      data.table::setnames(c('instrument.symbol', 'instruction'),
                           c('symbol', 'side')) %>%
        data.table::setcolorder('date')
  } else {
    order_exec_info <- make_blank_dt(oex_col_names)[, date := Sys.Date()] %>%
      data.table::setnames(c('instrument.symbol', 'instruction'),
                           c('symbol', 'side')) %>%
        data.table::setcolorder('date')
  }

  rds_data <- list(dates = dates,
                   ikm_symbols = ikm_symbols,
                   monthly_figures = readRDS('data/monthly_figures.rds'),
                   gann_sigs = readRDS('data/gann_sigs.rds'))

  trade_report <- list(trade = trade_info,
                       account = account_info,
                       positions = pos_info,
                       order_entry = order_entry_info,
                       order_exec = order_exec_info,
                       input_data = list(order_list),
                       rds_data = list(rds_data))

  names(trade_report[6][[1]]) <- as.character(Sys.Date())
  names(trade_report[7][[1]]) <- as.character(Sys.Date())

  if (file.exists(paste0(fullPath, 'tradeReport.rds'))) {
    trade_report_old <- readRDS(paste0(fullPath, 'tradeReport.rds'))

    trade_report_sans_input_data <- parallel::mclapply(1:5, function(x) {
      rbind(trade_report_old[[x]], trade_report[[x]])
    }) %>% `names<-`(names(trade_report)[1:5])

    trade_report_input_data <- c(trade_report_old[[6]], trade_report[[6]])
    trade_report_rds_data <- c(trade_report_old[[7]], trade_report[[7]])

    trade_report <- c(trade_report_sans_input_data,
                      list(trade_report_input_data),
                      list(trade_report_rds_data)) %T>%
      {names(.)[6:7] <- c('input_data', 'rds_data')}
  }

  saveRDS(trade_report, paste0(fullPath, 'tradeReport.rds'))
}
causality-loop/mnmt documentation built on June 17, 2022, 5:14 a.m.