R/IKM.R

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

IKM <- function(dow_rets, vix_rets, leverageFactor)
{
  # i never change these args
  posTopMomOnly = TRUE
  negBotMomOnly = TRUE
  topN <- 1
  botN <- 1
  offset <- 0
  momWeights <- c(12, 4, 2, 1)
  crash_protection <- TRUE

  # use for other universes besides Dow
  # if (topN + botN <= 0)
  #   stop("The sum of topN and botN must be > 0")

  rets <- dow_rets

  ep <- xts::endpoints(rets) + offset
  ep[ep < 1] <- 1
  ep[ep > nrow(rets)] <- nrow(rets)
  ep <- unique(ep)
  epDiff <- diff(ep)

  # if the last month only has one day
  if(xts::last(epDiff)==1)
    ep <- ep[-length(ep)]

  emptyVec <- data.frame(t(rep(0, ncol(rets)))) %>%
    `names<-`(names(rets))

  allWts <- list()
  allVix <- list()

  # pb <- txtProgressBar(min = 1, max = length(ep)-12, initial = 1)
  # cat("Working\n")

  for(i in 1:(length(ep)-12)) {

    # setTxtProgressBar(pb,i)

    # weights
    retSubset <- rets[c((ep[i]+1):ep[(i+12)]),]
    epSub <- ep[i:(i+12)]
    sixMonths <- rets[(epSub[7]+1):epSub[13],]
    threeMonths <- rets[(epSub[10]+1):epSub[13],]
    oneMonth <- rets[(epSub[12]+1):epSub[13],]

    moms <- PerformanceAnalytics::Return.cumulative(oneMonth) * momWeights[1] +
      PerformanceAnalytics::Return.cumulative(threeMonths) * momWeights[2] +
      PerformanceAnalytics::Return.cumulative(sixMonths) * momWeights[3] +
      PerformanceAnalytics::Return.cumulative(retSubset) * momWeights[4]

    moms <- as.numeric(moms) %>% `names<-`(colnames(moms))

    ## rm cols with any NAs and get top/bot
    naSymbols <- names(moms)[apply(retSubset, 2, function(x) any(is.na(x)))]
    topMoms <-
      utils::head(sort(moms[!(names(moms) %in% naSymbols)], decreasing = TRUE),
                  topN)
    botMoms <- utils::head(sort(moms[!(names(moms) %in% naSymbols)]), botN)

    if (posTopMomOnly) {
      topAssets <- names(topMoms[topMoms > 0])
    } else {
      topAssets <- names(topMoms)
    }

    if (negBotMomOnly) {
      botAssets <- names(botMoms[botMoms <= 0])
    } else {
      botAssets <- names(botMoms)
    }

    selectedAssets <- names(moms) %in% c(topAssets, botAssets)

    if (sum(selectedAssets) == 0) {
      investedAssets <- emptyVec
    } else if (sum(selectedAssets) >= 2) {
      idx <- which(selectedAssets)
      cors <- (stats::cor(oneMonth[,idx]) * momWeights[1] +
                 stats::cor(threeMonths[,idx]) * momWeights[2] +
                 stats::cor(sixMonths[,idx]) * momWeights[3] +
                 stats::cor(retSubset[,idx]) * momWeights[4]) / sum(momWeights)
      vols <- PerformanceAnalytics::StdDev(oneMonth[,idx])
      covs <- t(vols) %*% vols * cors
      minVolRets <- t(matrix(rep(1, sum(selectedAssets))))
      minVolWt <- tseries::portfolio.optim(x=minVolRets,
                                           covmat = covs)$pw * leverageFactor
      names(minVolWt) <- colnames(covs)
      investedAssets <- emptyVec
      investedAssets[,selectedAssets] <- minVolWt
    } else { # sum(selectedAssets) == 1
      investedAssets <- emptyVec
      investedAssets[,selectedAssets] <- leverageFactor
    }

    wts <- xts::xts(investedAssets, xts::last(zoo::index(retSubset)))
    allWts[[i]] <- wts

    # vix
    vixSubset <- vix_rets[c((ep[i]+1):ep[(i+12)]),]

    sharpes <-
      apply(vixSubset, 2, function(x) {
        mean(x, na.rm=TRUE)/stats::sd(x, na.rm=TRUE)}) %>%
      stats::na.omit() %>%
      t

    # "last" bc i want to favor EMAs longer in length
    vix <- xts::xts(max.col(sharpes, ties.method = "last"),
                    xts::last(zoo::index(vixSubset)))
    allVix[[i]] <- vix
  }

  allWts <- do.call(rbind, allWts)
  allWts$CASH <- 1-rowSums(allWts)
  allVix <- do.call(rbind, allVix)

  # close(pb)

  list(allWts, allVix)
}