R/tools.R

In rengelke/quantTraiding_trato: Trading Strategies Development Tool Kit

#
#' Clean Global Environment with Exceptions
#'
#' @param keep
#'
#' @return NULL
#' @export cleanGlobalEnv
#'
#' @examples cleanGlobalEnv(keep = c("warn"))
cleanGlobalEnv <- function (keep = c("warn", "output")) {

  keep <- match.arg(keep, c("warn", "output"))
  list_remove <- ls()[-grepl(keep, ls())]
  if (length(list_remove) == 0) {
    rm(list = ls())
  } else {
    rm(list = list_remove)
  }
}
#
#
# # -----------------------------------------------------------------------
#' Samples a Subset of N Rows From a Matrix Object
#'
#' @param x An matrix, data.frame or xts object
#' @param n_sub Numerical value indicating how many rows should be sampled
#'
#' @return Subset of n-rows of x ordered by ?index?
#' @export
#'
#' @examples subSample(____)
subSample <- function(x, n_sub = 40) {
  # Assuming subsampling by row, preserving all returns and cross symbol dependence structure at a given timestamp
  ii <- sample(1:NROW(x), size = n_sub, replace = FALSE)
  # sort in order to preserve time ordering?
  ii <- sort(ii)
  xs <- x[ii, ]
  xs
}
#
#
# # -----------------------------------------------------------------------
#' Function to Add Messages to "Messages" List
#'
#' @param message character string containing the message
#'
#' @return adds message to global "messages" list
#' @export
#'
#' @examples addMessage("Hello World!")
addMessage <- function(message) {

  if (!isTRUE(is.character(message))) {
    stop("Message must be a character string")
  }

  if (isTRUE("messages" %in% ls(envir = .GlobalEnv))) {
    messages <- get("messages", envir = .GlobalEnv)
  } else {
    messages <- list()
  }

  m <- length(messages)+1
  messages[[m]] <- message

  messages <<- messages
  #alternatively:
  #assign(messages, messages, envir = .GlobalEnv)

}
#
#
# # -----------------------------------------------------------------------
#' Extends xts Object by n Days
#'
#' @param data xts object
#' @param n days to extend
#' @param weekday TRUE/FALSE if weekdays only
#'
#' @return xts object extended by n days
#' @import xts
#' @export
#'
#' @examples extendXts(data)
extendXts <- function (data, n = 1, weekday = TRUE) {

  n_col <- dim(data)[2]
  last_day <- last(index(data), 1)
  next_day <- last_day + 1
  ext_day <- last_day + 9*n

  ext_period <- trato::seqDate(next_day, ext_day)
  ext_period_alldays <- seq(next_day, ext_day, by="days")

  if (isTRUE(weekday) & n == 1) {
    ext_period <- ext_period[1]
  }
  if (isTRUE(weekday) & n >= 1) {
    ext_period <- ext_period[1:n]
  }
  if (!isTRUE(weekday) & n == 1) {
    ext_period <- ext_period_alldays[1]
  }
  if (!isTRUE(weekday) & n >= 1) {
    ext_period <- ext_period_alldays[1:n]
  }

  rbind.xts(data,
            as.xts(
              matrix(
                as.numeric(rep(NA, n_col)), nrow=n),
              order.by = as.Date(ext_period)
            )
  )
}
#
#
# # -----------------------------------------------------------------------

#' Function to Fix the Index in OHLC Market Data
#'
#' @param data xts object
#'
#' @return OHLC object
#' @export
#' @import xts
#' @import quantmod
#'
#' @examples fixOHLC(getSymbols("^GDAXI"))
fixOHLC <- function (data) {

  if (!all(has.OHLC(data))) {
    warning("Market data is missing open, high, low or close column")
  }

  #last working day
  last_day <- trato:::date_seq[trato:::date_seq < Sys.Date()] %>%
    last()
  if (!(last_day %in% index(data))) {
    warning(paste0("Last working day [", last_day, "] data is missing"))
  }

  if (!is.index.unique(data)) {
    warning("Removing duplicate index values")
    data <- data[unique(index(data)), ]
  }

  data_compare <- merge.xts(data,
                            xts(, order.by = trato:::date_seq,
                                dateFormat = "Date"),
                            join = "left")

  if (!is.index.unique(data_compare)) {
    warning("Warning: Removed duplicate index entries in xts.")
    data_compare <- data_compare[unique(index(data_compare)), ]
  }

  #missing days
  is_missing <- is.na(data_compare[, 1])
  #days missing per year
  n_days <- sum(is_missing, na.rm = TRUE) / (length(index(data))/365.25)
  #max sequential missing values
  n_days_seq <- max(TTR::runSum(is_missing), na.rm = TRUE)

  if (n_days >= 12) {
    warning("Market data contains more than 12 missing days per year")
  } else if (n_days >= 18) {
    stop("Market data contains more than 18 missing days per year")
  }
  if (n_days_seq > 4) {
    warning("Market data contains more than 4 sequential missing days")
  } else if (n_days_seq > 7) {
    warning("Market data contains more than 7 sequential missing days")
  } else if (n_days_seq > 10) {
    stop("Market data contains more than 10 sequential missing days")
  }

  OHLC(na.approx(na.locf(data_compare, maxgap = 2)))

}