R/calc_returns.R

In rengelke/tradr:

#' Calculate Returns from a List of xts Prices
#'
#' @param price_list list of xts asset prices
#' @param type type of daily returns; "opop" open to opne, "clcl" close to close
#' @param trim numeric value indicating limit for positive daily returns
#' @param alpha numeric value indicating probability to filter at 1-alpha
#'
#' @return xts object of asset returns
#' @import xts
#' @import quantmod
#' @export
#'
#'
#' @examples calc_returns(stock_prices, type = "opop", trim = 0.055)
calc_returns <- function (price_list, type = c("clcl"), trim = NULL, alpha = NULL) {

  type <- match.arg(type, c("opop", "clcl"), several.ok = FALSE)

  if (type == "opop") {
    R <- lapply(price_list,
           function (x) dailyReturn(Op(x))) %>%
      do.call(cbind.xts, .) %>%
      lag.xts(., k = -1) %>%
      `colnames<-`(names(price_list)) %>%
      na.fill(fill = 0)
  }
  if (type == "clcl") {
    R <- lapply(price_list,
           function (x) dailyReturn(Cl(x))) %>%
      do.call(cbind.xts, .) %>%
      `colnames<-`(names(price_list)) %>%
      na.fill(fill = 0)
  }
  if (!is.null(trim)) {
    R <- R %>% apply(., 2, function(x) ifelse(x > trim, trim, x)) %>%
      xts::xts(., order.by = index(R), dateFormat = "Date")
  }

  if (!is.null(alpha)) {
    R <- R %>% as.list() %>%
      purrr::map(~ {
        if (.x %>% magrittr::equals(0) %>% all(na.rm = TRUE)) {
          .x
        } else {
          .x %>% .[.!=0, ] %>%
            PerformanceAnalytics::clean.boudt(alpha = 0.01, trim = 0.001) %>%
            .[[1]] %>% xts::xts(dateFormat = "Date")
        }
      }) %>%
      do.call(cbind.xts, .) %>%
      `colnames<-`(names(price_list)) %>%
      na.fill(fill = 0)
  }
  R
}