R/calc_trade_stats.R

In rengelke/tradr:

#' Calculate Trade Statistics from Returns and Weights
#'
#' @param R xts containing returns
#' @param weights xts containing weights
#'
#' @import xts
#' @importFrom magrittr %>% %<>%
#'
#' @return
#' @export
#'
#' @examples calc_trade_stats(R, weights)
calc_trade_stats <- function(R, weights) {

    symbols <- R %>% colnames()
    symbols %<>% .[!(.) == "CORR"]

    symbols %>% purrr::map_dfr(
        ~ {
            if (all(weights[, .x] == 0, na.rm = TRUE)) {
                tstats <- c(.x, NA, NA, NA) %>% t() %>%
                    as.data.frame() %>%
                    `colnames<-`(c("symbol", "period", "return", "drawdown")) %>%
                    dplyr::mutate(return = as.numeric(return),
                                  drawdown = as.numeric(drawdown))
            } else {

                buys <- weights[, .x] %>% diff() %>% .[. != 0, ] %>% .[. > 0, ]
                if (xts::first(weights[, .x]) > 0) buys %<>% rbind(weights[1, .x], .)
                sells <- weights[, .x] %>% diff() %>% .[. != 0, ] %>% .[. < 0, ]

                if (!all(index(buys)[1:length(index(sells))]<index(sells))) {
                    stop("Buy/sell index in trading statistic calculation not consistent")
                }

                tstats <-
                    seq_along(buys) %>% lapply(function (i) {
                        buy_day <- index(buys)[i]
                        if (length(index(sells)) >= i) {
                            sell_day <- index(sells)[i]-1
                        } else {
                            sell_day <- index(R[, .x]) %>% last()
                        }

                        trade_period <- paste0(buy_day, "::", sell_day)
                        trade_period
                        R[trade_period, .x] %>% sum() %>% round(3) %>%
                            as.data.frame() %>%
                            dplyr::mutate(period = trade_period) %>%
                            dplyr::mutate(drawdown = PerformanceAnalytics::Drawdowns(R[trade_period, .x]) %>%
                                              min(na.rm = TRUE) %>% round(3)) %>%
                            dplyr::mutate(symbol = .x)
                    }) %>%
                    do.call(rbind, .) %>%
                    `colnames<-`(c("return", "period", "drawdown", "symbol")) %>%
                    dplyr::select(symbol, period, return, drawdown)
            }
            tstats
        }) #.x
}