In greatgray/scorecard: GGCM Model Performance Scorecard

require(scales)
require(gplots)
require(magrittr)
require(ggplot2)

knitr::opts_chunk$set(echo = FALSE,
                      warning = FALSE,
                      message = FALSE)

## Set options
options(scipen = 999, # prevent scientific notation on large numbers
        stringsAsFactors = F) # prevent R from turning everything to factors

## read parameters
scorecard_dir <- params$scorecard_dir
scorecard_ws <- params$scorecard_ws

# find the workspace to use
# the workspace should have been written by scorecard_update
if ( stringr::str_length(scorecard_ws) > 3) {
  message("Using argument-specified workspace")
} else {
  message("Using latest scorecard workspace")
  # workspace not overridden in environment, so find in directory
  # find the scorecard workspace directory and load files
  if (is.na(scorecard_dir) || stringr::str_length(scorecard_dir) < 1) {
    stop("Scorecard output directory missing: use scorecard_dir")
  }

  # identify all workspaces in the directory, choose latest one by name
  scorecard_wss <- dir(scorecard_dir,
                       pattern = "scorecard_workspace",
                       full.names = TRUE)
  scorecard_wss <- base::sort(scorecard_wss,
                              decreasing = TRUE)
  scorecard_ws <- scorecard_wss[1]
}

# read the workspace and recover variable values
message(paste("Using workspace", scorecard_ws))

# check that workspace file can be read
if ( as.numeric(file.access(scorecard_ws, mode = 4)) < 0 ) {
  stop(paste("Cannot read workspace file:", scorecard_ws))
}

workspace <- new.env()
load(scorecard_ws, envir = workspace)
scorecard_table <- get("scorecard_table", envir = workspace) # a list
refresh_date <- get("refresh_date", env = workspace)

activated_list <- list()
for ( i in 1:length(scorecard_table) ) {
  x <- scorecard_table[[i]]
  if ( x$status == 'activated' )
    activated_list <<- append(activated_list, list(x))
}

Introduction

The following models are activated and represent specific model configurations under current investment. Actual performance measures are based on assessments determined from the trade transaction history file.

The analysis results for this report were computed on r refresh_date.

for ( n in 1:length(activated_list)) {
  row <- activated_list[[n]]
  cat("# Model", ' ', row$id, '\n' )
  cat('\n')
  cat("* Partner: ", row$partner, '\n' )
  cat("* Live date: ", row$live, '\n' )
  cat("* Initial equity: ", dollar(row$initeq), '\n' )
  cat('\n')  

  cat("## Configuration",'\n')
  cat("* Version: ", row$model$version, '\n' )
  cat("* Basket: ", row$model$config$basket, '\n')
  if ( row$model$model == "RSO" ) {
    rmc <- row$model$config
    cat("* Smoothing: ", rmc$smoothing[1], " fast, ", rmc$smoothing[2], "slow", '\n')
    cat("* Rebalance: ", rmc$rebalance, '\n')
    cat("* Trailing stop: ", percent(rmc$trailstop), '\n')
    cat("* Top N: ", rmc$topn, '\n')
  }
  if ( row$model$model == "3ROC" ) {
    rmc <- row$model$config
    cat("* Periods: ", rmc$periods, '\n')
    cat("* Weghts: ", rmc$weights, '\n')
    cat("* Rebalance: ", rmc$rebalance, '\n')
    cat("* Trailing stop: ", percent(rmc$trailstop), '\n')
    cat("* Top N: ", rmc$topn, '\n')
  }

  cat("\n")
  cat("## Performance Summary",'\n')
  rmb <- row$model$backtest
  cat("* Period: ", rmb$start, " to ", rmb$stop, "\n")
  cat("* Backtest initial equity: ", dollar(rmb$initeq), "\n" )
  cat("* Transaction fee: ", dollar(rmb$transaction), "\n" )
  cat("* Benchmark: ", rmb$benchmark, "\n")
  cat("\n")

  cat("Mode | CAGR | MDD | Sortino | Calmar","\n")
  cat("-----|------|-----|---------|-------","\n")

  cat("Expected","|")
  cat(paste0(rmb$cagr,"%"), "|")
  cat(paste0(rmb$mdd,"%"), "|")
  cat(rmb$sortino, "|")
  cat(rmb$calmar, "\n")

  rba <- row$actual
  cat("Actual", "|")
  cat(sprintf("%.1f%%", rba$cagr), "|")
  cat(sprintf("%.1f%%", rba$mdd), "|")
  cat(sprintf("%.1f", rba$sortino), "|")
  cat(sprintf("%.1f", rba$calmar), "\n")

  rbo <- row$oos
  cat("Out-of-Sample", "|")
  cat(sprintf("%.1f%%", rbo$cagr), "|")
  cat(sprintf("%.1f%%", rbo$mdd), "|")
  cat(sprintf("%.1f", rbo$sortino), "|")
  cat(sprintf("%.1f", rbo$calmar), "\n")

  rbh <- row$buyhold
  cat("Buy-Hold", "|")
  cat(sprintf("%.1f%%",rbh$cagr), "|")
  cat(sprintf("%.1f%%", rbh$mdd), "|")
  cat(sprintf("%.1f", rbh$sortino), "|")
  cat(sprintf("%.1f", rbh$calmar), "\n")

  cat("Benchmark", "|")
  cat(sprintf("%.1f%%", row$benchmark.cagr), "|")
  cat(sprintf("%.1f%%", row$benchmark.mdd), "|")
  cat(sprintf("%.1f", row$benchmark.sortino), "|")
  cat(sprintf("%.1f", row$benchmark.calmar), "\n")

  cat("\n")
  cat("## Actual Performance","\n")
  rba <- row$actual
  plot(rba$p5)
  cat("\n","\n")

  cat("### Recent Signals","\n")
  rbo <- row$oos
  textplot(rbo$recent_df,
           cmar=1,
           halign="center")
           # cex=0.9)
  cat("\n","\n")

  cat("### Trade Statistics","\n")
  rba <- row$actual
  cat("\n")
  gplots::textplot(t(rba$stats))
  cat("\n","\n")
  cat("### Component Contribution","\n")
  cat("\n")
  plot(rba$p2)
  cat("\n","\n")
  plot(rba$p3)
  cat("\n","\n")
  # plot(rba$p4)
  p <- scorecard:::gg_charts_summary_2(rba$r)
  p <- p + ggtitle("Component Returns and Drawdown")
  plot(p)
  cat("\n","\n")
  for ( j in 1:length(rba$cplots) ) {
    if ( is.environment(rba$cplots[[j]] ) ) {
      plot(rba$cplots[[j]])
      cat("\n","\n")
    }
  }

  cat("### Account Summary","\n")
  cat("\n")

  ad <- as.Date(zoo::index(rba$account),format="%y-%m-%d")
  a <- as.data.frame(rba$account) %>%
    dplyr::mutate(Date=ad) %>%
    dplyr::select(Date, Additions, Realized.PL, Unrealized.PL, 
                  Net.Performance, End.Eq, Cumulative)
  colnames(a) <- c("Date", "Adds", "Realized", "Unrealized",
                   "Net Perf", "End Eq", "Return")
  pander::pandoc.table(a,
                       digits=c(10,6,6,6,6,6,5),
                       round= c( 0,0,0,0,0,0,3),
                       big.mark=',',
                       keep.trailing.zeros=TRUE,
                       justify = 'right',
                       decimal.mark = '.',
                       caption = 'Account History')

  cat("\n")

#  cat("Date | Adds | Withs | Realized | Unrealized | Fees | Net Perf | End Eq | Cumul","\n")
#  cat("-----|------|-------|----------|------------|------|----------|--------|------","\n")
#  ad <- as.Date(zoo::index(rba$account),format="%y-%m-%d")
#  for ( r in 1:nrow(rba$account) ) {
#    ar <- rba$account[r]
#    cat(as.character(ad[r]), "|")
#    cat(sprintf("%6.0f", ar$Additions), "|")
#    cat(sprintf("%6.0f", ar$Withdrawals), "|")
#    cat(sprintf("%6.0f", ar$Realized.PL), "|")
#    cat(sprintf("%6.0f", ar$Unrealized.PL), "|")
#    cat(sprintf("%5.2f", ar$Txn.Fees), "|")
#    cat(sprintf("%6.0f", ar$Net.Performance), "|")
#    cat(sprintf("%6.0f", ar$End.Eq), "|")
#    cat(sprintf("%5.3f", ar$Cumulative), "|")
#    cat("\n")
#  }

  cat("\n")

  cat("## Out of Sample Performance","\n")
  cat("\n")
  rbo <- row$oos

  cat("### Rank History","\n")
  plot(rbo$rank_p)
  cat("\n","\n")

}

Transaction History

The following are the actual transactions used in this analysis.

# kable(tail(transactions.df, -25), row.names=FALSE)
knitr::kable(get("transactions.df", 
                 env = workspace), row.names=FALSE)

greatgray/scorecard documentation built on May 17, 2019, 8:34 a.m.