R/PropMoving.R

In 3schwartz/cryptoPlay: CryptoPlaying (Title Case)

#' PropMoving
#'   Probability ajusted momentum strategy
#'
#' @param x xts object often in the form of closing, bid or ask prices
#' @param k # of days to take SimpleMovingAverage over (init 200)
#' @param nd # of trading days (init 365.25 since this is made for crypto. Else use 250)
#' @param rf Risk free rate used calculating the Sharperatio. (init 1)
#' @param alpha quantile used calculating the VaR and ES
#' @param Initpocket Initial pocket to implement the strategy
#' @param TransCost Transaction cost, here it is assumed the same for buy and sell
#' @param confidence.level int Confidence level upon which certainty is defined
#' @param rf.asset int risk free asset used to calculate the t-statistic. In furture improvement this should be a vector
#'
#' @return List with xts objects of cum. returns, weights and table of values of performance.
#'  If Initpocket and TransCost is not null,xts object of these will be returned.
#'  Warnings will come if there isn't enough money to implement the strategy.
#' @export
#'
#' @examples
#' BTC <- getSymbols("BTC-USD", auto.assign = FALSE)
#' PropMoving(quantmod::Cl(BTC))
PropMoving <- function(x, k = 200, nd = 365.25, rf = 1, alpha = 0.05,
                       Initpocket = NULL, TransCost = NULL,
                       confidence.level = 0.60,
                       rf.asset = 0) {

  x.mat <- as.matrix(x)
  roc <- x.mat[-1] / x.mat[-length(x.mat)] - 1

  ir <- sqrt(k) * SMACpp(roc - rf.asset, k) / sdRollCpp(roc - rf.asset, k)
  momentum.p <- pt(ir, k - 1)

  weights <- weightsProp(momentum.p, cf = confidence.level, k = k)

  dailyDiff <- diff(x.mat)
  StraReturn <- dailyDiff[-1] * weights[- length(weights)]

  CumReturn <- cumsum(na.omit(StraReturn))

  all(which(1 - momentum.p > 0.6) == which(momentum.p < 0.4))

  model <- list()
  model$return <- list()

  model$return$Prop <- xts::xts(CumReturn, order.by = zoo::index(x[(nrow(x)-length(CumReturn)+1):nrow(x)]))
  model$Prop.weights <- xts::xts(na.omit(weights), order.by = zoo::index(x[(nrow(x)-length(na.omit(weights))+1):nrow(x)]))


  ##################################
  ### Calculate values for table ###
  ##################################
  Period <- paste(row.names(x.mat)[1], " to ", row.names(x.mat)[length(x.mat)])

  nOfYears <- as.numeric(as.Date(row.names(x.mat)[length(x.mat)])- as.Date(row.names(x.mat)[1]))/nd

  CGR <- CumReturn[length(CumReturn)] / x.mat[1,]

  CAGR <- CGR / nOfYears

  vol <- sd(CumReturn)

  SharpeRatio <- (CGR - rf) / vol

  VaR <- quantile(StraReturn, alpha, na.rm = TRUE)
  ES <- mean(StraReturn[StraReturn <= VaR], na.rm = TRUE)

  change <- as.numeric(weights[-length(weights)] != weights[-1])
  numberTrades <- sum(change, na.rm = TRUE)

  table <- data.frame(c(Period,
                        round(matrix(c(CGR, CAGR, vol, SharpeRatio, VaR, ES)),
                              digits = 2), numberTrades))
  colnames(table) <- paste0("Prop",k)
  rownames(table) <- c("Period",
                       "CGR",
                       "CAGR",
                       "vol",
                       "SharpeRatio",
                       "VaR",
                       "ES",
                       "#trades")

  model$table <- table


  if(!is.null(TransCost)) {

    traCost <- change * TransCost
    StraReturnTC <- StraReturn - traCost

    if(!is.null(Initpocket)) {
      suppressWarnings(StartDayInvest <- which(weights == 1 & x.mat <= Initpocket)[1])
      if(is.na(StartDayInvest)) {
        warning("Not enough money to initialize strategy")
      } else {
        StraReturnTCpocket <- StraReturnTC
        StraReturnTCpocket[StartDayInvest-1] <- Initpocket - (x.mat[StartDayInvest] + TransCost)
        CumReturnTCPocket <- cumsum(na.omit(StraReturnTCpocket[(StartDayInvest-1):length(StraReturnTCpocket)]))
        if(any(CumReturnTCPocket < 0)) {warning("Bad luck, pocket gets empty!")}
        model$return$Prop.TCPocket <- xts::xts(CumReturnTCPocket, order.by = zoo::index(x[(nrow(x)-length(CumReturnTCPocket)+1):nrow(x)]))
      }
    }

    CumReturnTC <- cumsum(na.omit(StraReturnTC))
    # if(any(CumReturnTC < 0)) {warning("Bankers ate you up!")}
    model$return$Prop.TC <- xts::xts(CumReturnTC, order.by = zoo::index(x[(nrow(x)-length(CumReturnTC)+1):nrow(x)]))


    ######### Updating table ###########
    ####################################
    CGR.TC <- CumReturnTC[length(CumReturnTC)] / x.mat[1,]
    CAGR.TC <- CGR.TC / nOfYears
    vol.TC <- sd(CumReturnTC)
    SharpeRatio.TC <- (CGR.TC - rf) / vol.TC

    VaR.TC <- quantile(StraReturnTC, alpha, na.rm = TRUE)
    ES.TC <- mean(StraReturn[StraReturnTC <= VaR], na.rm = TRUE)

    model$table <- cbind(model$table, name.foo = c(Period,
                                                   round(matrix(c(CGR.TC, CAGR.TC, vol.TC,
                                                                  SharpeRatio.TC, VaR.TC, ES.TC)),
                                                         digits = 2), numberTrades))
    colnames(model$table)[2] <- paste0("Prop",k,".TC")
  }
  return(model)
}