Skip to content

Instantly share code, notes, and snippets.

@jaymon0703

jaymon0703/mcsim_wMultipleStats.R

Last active September 19, 2016 09:56
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jaymon0703/1ee084513584215d14079169b156efd8 to your computer and use it in GitHub Desktop.
Save jaymon0703/1ee084513584215d14079169b156efd8 to your computer and use it in GitHub Desktop.
Download ZIP
mcsim with Sharpe Ratio added
Raw
mcsim_wMultipleStats.R
#' Monte Carlo simulate strategy results
#'
#' This function resamples the daily transaction, cash equity, or percent-return
#' P&L from a portfolio of trading results. It may be applied to both real
#' (post-trade) and backtested transactions.
#'
#' The general argument here is that you can compare the performance of real
#' portfolio equity or a backtest equity curve to a sampled version of the same.
#'
#' We've chosen to use daily frequency for the resampling period. If your holding
#' period is longer than one day, on average, the samples will increase
#' variability in the overall path. If your average holding period is shorter
#' than a day, the \code{\link{mcsim}} function will still provide a useful
#' benchmark for comparing to other strategies, but you may additionally wish to
#' sample round turn trades, as provided in (TODO: add link once function exists).
#'
#' A few of the arguments and methods probably deserve more discussion as well.
#'
#' \code{use} describes the method to use to generate the initial daily P\&L to
#' be sampled from. The options are:
#' \itemize{
#' \item{equity}{will use daily portfolio cash P&L}
#' \item{txn}{will use transaction \code{Net.Trading.PL}}
#' \item{returns}{will use \code{\link{PortfReturns} to generate percent returns}}
#' }
#'
#' Sampling may be performed either with or without replacement.
#' \itemize{
#' \item{without replacement}{If sampled **without** replacement, the replicated
#' equity curves will use all the same data as the input series, only reordered.
#' This will lead to all the replicates having identical final P\&L and mean
#' returns, but different paths along the way.}
#' \item{with replacement}{If sampled **with** replacement, individual
#' observations may be re-used. This will tend to create more variability than
#' replicates without replacement.}
#' }
#'
#' If the post-trade or backtested equity curve exhibits autocorrelation, runs,
#' streaks, etc. it may be advantageous to utilize a block resampling method.
#' The length of the block "\code{l}" may be fixed or variable.
#' If a \code{varblock} method is used, the distribution of block lengths will
#' be uniform random for \code{replacement=FALSE} and geometric random for
#' \code{replacement=TRUE}. By sampling blocks, the resampled returns will
#' contain more of the structure of the original series. If \code{varblock=TRUE},
#' the blocks will be of variable length, centered around \code{l}.
#'
#' @param Portfolio string identifier of portfolio name
#' @param Account string identifier of account name
#' @param n number of simulations, default = 1000
#' @param replacement sample with or without replacement, default TRUE
#' @param \dots any other passthrough parameters
#' @param use determines whether to use 'equity', 'txn', or 'returns' P\&L, default = "equity" ie. daily
#' @param l block length, default = 1
#' @param varblock boolean to determine whether to use variable block length, default FALSE
#' @param gap numeric number of periods from start of series to start on, to eliminate leading NA's
#' @return a list object of class 'mcsim' containing:
#' \itemize{
#' \item{\code{replicates}:}{an xts object containing all the resampled time series replicates}
#' \item{\code{dailypl}:}{an xts object containing daily P&L from the original backtest}
#' \item{\code{initeq}:}{a numeric variable containing the initEq of the portfolio, for starting portfolio value}
#' \item{\code{num}:}{a numeric variable reporting the number of replicaes in the simulation}
#' \item{\code{length}:}{a numeric variable reporting the block length used in the simulation, if any}
#' \item{\code{samplestats}:}{a numeric dataframe of various statistics for each replicate series}
#' \item{\code{w}:}{a string containing information on whether the simulation is with or without replacement}
#' \item{\code{use}:}{ a string with the value of the 'use' parameter, for checking later}
#' \item{\code{seed}:}{ the value of \code{.Random.seed} for replication, if required}
#' \item{\code{call}:}{an object of type \code{call} that contains the \code{mcsim} call}
#' }
#'
#' Note that this object and its slots may change in the future.
#' Slots \code{replicates},\code{dailypl},\code{initeq}, and \code{call} are likely
#' to exist in all future versions of this function, but other slots may be added
#' and removed as \code{S3method}'s are developed.
#'
#' @note
#' Requires boot package
#' @importFrom boot tsboot boot.array
#' @importFrom foreach foreach %dopar%
#' @author Jasen Mackie, Brian G. Peterson
#' @seealso
#' \code{\link{boot}}
#' \code{\link{plot.mcsim}}
#' \code{\link{hist.mcsim}}
#' @examples
#' \dontrun{
#'
#' demo('longtrend', ask=FALSE)
#'
#' nrsim <- mcsim("longtrend", "longtrend", n=1000, replacement=FALSE, l=1, gap=10)
#' nrblocksim <- mcsim("longtrend", "longtrend", n=1000, replacement=FALSE, l=10, gap=10)
#' rsim <- mcsim("longtrend", "longtrend", n=1000, replacement=TRUE, l=1, gap=10)
#' varsim <- mcsim("longtrend", "longtrend", n=1000, replacement=TRUE, l=10, varblock=TRUE, gap=10)
#' nrvarsim <- mcsim("longtrend", "longtrend", n=1000, replacement=FALSE, l=10, varblock=TRUE, gap=10)
#'
#' quantile(varsim)
#' quantile(nrsim)
#' quantile(nrvarsim)
#'
#' plot(nrsim, normalize=TRUE)
#' plot(nrsim, normalize=FALSE)
#' plot(varsim)
#' plot(rsim)
#' hist(rsim)
#' hist(varsim)
#'
#' } #end dontrun
#'
#' @export
mcsim_wSharpe <- function( Portfolio
, Account
, n = 1000
, replacement = TRUE
, ...
, use=c('equity','txns','returns')
, l = 1
, varblock = FALSE
, gap = 1
){
seed = .GlobalEnv$.Random.seed # store the random seed for replication, if needed
use=use[1] #take the first value if the user didn't specify
switch (use,
Eq =, eq =, Equity =, equity =, cumPL = {
dailyPL <- dailyEqPL(Portfolio, incl.total = TRUE)
dailyPL <- dailyPL[gap:nrow(dailyPL), ncol(dailyPL)]
},
Txns =, txns =, Trades =, trades = {
dailyPL <- dailyTxnPL(Portfolio, incl.total = TRUE)
dailyPL <- dailyPL[gap:nrow(dailyPL), ncol(dailyPL)]
},
Rets =, rets =, Returns=, returns =, percent = {
dailyPL <- PortfReturns(Account = Account, Portfolios = Portfolio)
use <- 'returns' # standardize for later checks
}
)
# p <- getPortfolio(Portfolio)
a <- getAccount(Account)
initEq <- attributes(a)$initEq
use=c('equity','txns')
tmp <- NULL
k <- NULL
EndEqdf <- data.frame(dailyPL)
if(isTRUE(replacement)) {
if(isTRUE(varblock)) {
sim <- 'geom'
# tsboot will use a geometric random distribution of block length centered on l
} else {
sim <- 'fixed'
# tsboot will use a fixed block length l
}
fnames <- function(x, indices) {
Mean <- mean(x)
Median <- median(x)
sd <- StdDev(xts(x, index(dailyPL))) # need to use xts for StdDev to work
maxdd <- -max(cummax(cumsum(x))-cumsum(x))
# sharpedata <- xts(ROC(cumsum(x + initEq)),index(dailyPL))
# sharpedata[is.na(sharpedata)] <- 0
# sharpe <- SharpeRatio(sharpedata, FUN = "StdDev")
sharpe <- Mean/sd # this is a rough version of sharpe using 'cash' mean & stddev as opposed to 'returns'
fnames <- c(Mean, Median, sd, maxdd, sharpe)
return(fnames)
}
tsb <- tsboot(coredata(dailyPL), statistic = fnames, n, l, sim = sim, ...)
colnames(tsb$t) <- c("mean","median","stddev","maxDD","sharpe")
#tsb <- tsboot(coredata(dailyPL), function(x) { -max(cummax(cumsum(x))-cumsum(x)) }, n, l, sim = sim, ...)
inds <- t(boot.array(tsb))
#k <- NULL
tsbootARR <- NULL
tsbootxts <- NULL
EndEqdf[is.na(EndEqdf)] <- 0
for(k in 1:ncol(inds)){
tmp <- cbind(tmp, EndEqdf[inds[,k],])
}
#tsbootARR <- apply(tmp, 2, function(x) cumsum(x))
#which(is.na(tsbootARR))
#tsbootxts <- xts(tsbootARR, index(dailyPL))
tsbootxts <- xts(tmp, index(dailyPL))
sampleoutput <- as.data.frame(tsb$t)
roctsbootxts <- ROC(cumsum(tsbootxts)+initEq, type = "discrete")
roctsbootxts[is.na(roctsbootxts)] <- 0
samplepercoutput <- data.frame(matrix(nrow = n, ncol = 5))
colnames(samplepercoutput) <- c("mean","median","stddev","maxDD","sharpe")
samplepercoutput$mean <- apply(roctsbootxts, 2, function(x) { mean(x) } )
samplepercoutput$median <- apply(roctsbootxts, 2, function(x) { median(x) } )
samplepercoutput$stddev <- apply(roctsbootxts, 2, function(x) { StdDev(x) } )
samplepercoutput$maxDD <- apply(roctsbootxts, 2, function(x) { maxDrawdown(x, invert = FALSE) } )
samplepercoutput$sharpe <- apply(roctsbootxts, 2, function(x) { mean(x)/StdDev(x) } )
withorwithout <- "WITH REPLACEMENT"
} else if(!isTRUE(replacement)) {
tsbootxts <- foreach (k=1:n, .combine=cbind.xts ) %dopar% {
if(isTRUE(l>1)) {
# do a block resample, without replacement
# first, resample the index
x <- 1:length(dailyPL)
# now sample blocks
if (isTRUE(varblock)){
# this method creates variable length blocks with a uniform random
# distribution centered on 'l'
s <- sort(sample(x=x[2:length(x)-1],size = floor(length(x)/l),replace = FALSE))
} else {
# fixed block length
# this method chooses a random start from 1:l(ength) and then
# samples fixed blocks of length l to the end of the series
s <- seq(sample.int(l,1),length(x),by=l)
}
blocks<-split(x, findInterval(x,s))
# now reassemble the target index order
idx <- unlist(blocks[sample(names(blocks),size = length(blocks),replace = FALSE)]) ; names(idx)<-NULL
tmp <- as.vector(dailyPL)[idx]
} else {
# block length is 1, just sample with or without replacement
tmp <- sample(as.vector(dailyPL), replace = replacement)
}
#tsbootARR <- cumsum(tmp)
tsbootxts <- xts(tmp, index(dailyPL))
}
#browser()
sampleoutput <- data.frame(matrix(nrow = n, ncol = 5))
colnames(sampleoutput) <- c("mean","median","stddev","maxDD","sharpe")
sampleoutput$mean <- apply(tsbootxts, 2, function(x) { mean(x) } )
sampleoutput$median <- apply(tsbootxts, 2, function(x) { median(x) } )
sampleoutput$stddev <- apply(tsbootxts, 2, function(x) { StdDev(x) } )
sampleoutput$maxDD <- apply(tsbootxts, 2, function(x) { -max(cummax(cumsum(x))-cumsum(x)) } )
sampleoutput$sharpe <- apply(tsbootxts, 2, function(x) { mean(x)/StdDev(x) } )
roctsbootxts <- ROC(cumsum(tsbootxts)+initEq, type = "discrete")
roctsbootxts[is.na(roctsbootxts)] <- 0
samplepercoutput <- data.frame(matrix(nrow = n, ncol = 5))
colnames(samplepercoutput) <- c("mean","median","stddev","maxDD","sharpe")
samplepercoutput$mean <- apply(roctsbootxts, 2, function(x) { mean(x) } )
samplepercoutput$median <- apply(roctsbootxts, 2, function(x) { median(x) } )
samplepercoutput$stddev <- apply(roctsbootxts, 2, function(x) { StdDev(x) } )
samplepercoutput$maxDD <- apply(roctsbootxts, 2, function(x) { maxDrawdown(x, invert = FALSE) } )
samplepercoutput$sharpe <- apply(roctsbootxts, 2, function(x) { mean(x)/StdDev(x) } )
withorwithout <- "WITHOUT REPLACEMENT"
}
percdailyPL <- ROC(cumsum(dailyPL)+initEq, type = "discrete")
percdailyPL[is.na(percdailyPL)] <- 0
# percdailyPL <- cumprod(1+percchange)
ret <- list(replicates=tsbootxts
, percreplicates=roctsbootxts
, dailypl=dailyPL
, percdailypl=percdailyPL
, initeq=initEq
, num=n, length=l
, samplestats=sampleoutput
, percsamplestats=samplepercoutput
, w=withorwithout
, use = use
, seed = seed
, call=match.call()
) #end return list
class(ret) <- "mcsim"
ret
}
#' plot method for objects of type \code{mcsim}
#'
#' @param x object of type 'mcsim' to plot
#' @param y not used, to match generic signature, may hold overlay data in the future
#' @param \dots any other passthrough parameters
#' @param normalize TRUE/FALSE whether to normalize the plot by initEq, default TRUE
#' @author Jasen Mackie, Brian G. Peterson
#' @seealso \code{\link{mcsim}}
#' @export
plot.mcsim <- function(x, y, ..., normalize=TRUE) {
ret <- x
if(isTRUE(normalize) && ret$initeq>1 && ret$use != 'returns'){
x1 <- cumprod(1 + ret$percreplicates)
x2 <- cumprod(1+ ret$percdailypl)
} else {
x1 <- cumsum(ret$replicates)
x2 <- cumsum(ret$dailypl)
}
p <- plot.xts(x1
, col = "lightgray"
, main = paste0("Sample Backtest ",ret$w)
, grid.ticks.on = 'years'
)
p <- lines(x2, col = "red")
p
}
#' hist method for objects of type \code{mcsim}
#'
#' @param x object of type mcsim to plot
#' @param \dots any other passthrough parameters
#' @param normalize TRUE/FALSE whether to normalize the hist by div, default TRUE
#' @author Jasen Mackie, Brian G. Peterson
#'
#' @importFrom graphics axis box hist lines par text
#'
#' @export
hist.mcsim <- function(x, ..., normalize=TRUE,
methods = c("mean",
"median",
"stddev",
"maxDD",
"sharpe")) {
ret <- x
if(isTRUE(normalize) && ret$initeq>1 && ret$use != 'returns') {
xname <- paste(ret$num, "replicates with block length", ret$length)
h <- NULL
for (method in methods) {
switch (method,
mean = {
dev.new()
h <- hist(ret$percsamplestats$mean, main = paste("Mean distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "Mean Return", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = mean(ret$percdailypl)
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest Mean Return")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$percsamplestats$mean)), col = "darkgray", lty = 2)
c.label = ("Sample Median Mean Return")
text(median(na.omit(ret$percsamplestats$mean)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90)
},
median = {
dev.new()
h <- hist(ret$percsamplestats$median, main = paste("Median distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "Median Return", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = median(ret$percdailypl)
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest Median Return")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$percsamplestats$median)), col = "darkgray", lty = 2)
c.label = ("Sample Median Median Return")
text(median(na.omit(ret$percsamplestats$median)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90)
},
stddev = {
dev.new()
h <- hist(ret$percsamplestats$stddev, main = paste("stddev distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "stddev", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = StdDev(ret$percdailypl)
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest stddev")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$percsamplestats$stddev)), col = "darkgray", lty = 2)
c.label = ("Sample Median stddev")
text(median(na.omit(ret$percsamplestats$stddev)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90)
},
maxDD = {
dev.new()
h <- hist(ret$percsamplestats$maxDD, main = paste("Drawdown distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "Max Drawdown", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = maxDrawdown(ret$percdailypl, invert = FALSE)
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest Max Drawdown")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$percsamplestats$maxDD)), col = "darkgray", lty = 2) # TODO...fix i subset
c.label = ("Sample Median Max Drawdown")
text(median(na.omit(ret$percsamplestats$maxDD)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90) # TODO...fix i subset
},
sharpe = {
dev.new()
h <- hist(ret$percsamplestats$sharpe, main = paste("sharpe distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "sharpe", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = (mean(ret$percdailypl)/StdDev(ret$percdailypl))
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest quasi-sharpe ratio")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$percsamplestats$sharpe)), col = "darkgray", lty = 2)
c.label = ("Sample Median quasi-sharpe ratio")
text(median(na.omit(ret$percsamplestats$sharpe)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90)
}
)
}
} else {
# do not normalize
xname <- paste(ret$num, "replicates with block length", ret$length)
h <- NULL
for (method in methods) {
switch (method,
mean = {
dev.new()
h <- hist(ret$samplestats$mean, main = paste("Mean distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "Mean Return", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = mean(ret$dailypl)
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest Mean Return")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$samplestats$mean)), col = "darkgray", lty = 2)
c.label = ("Sample Median Mean Return")
text(median(na.omit(ret$samplestats$mean)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90)
},
median = {
dev.new()
h <- hist(ret$samplestats$median, main = paste("Median distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "Median Return", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = median(ret$dailypl)
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest Median Return")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$samplestats$median)), col = "darkgray", lty = 2)
c.label = ("Sample Median Median Return")
text(median(na.omit(ret$samplestats$median)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90)
},
stddev = {
dev.new()
h <- hist(ret$samplestats$stddev, main = paste("stddev distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "stddev", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = StdDev(ret$dailypl)
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest stddev")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$samplestats$stddev)), col = "darkgray", lty = 2)
c.label = ("Sample Median stddev")
text(median(na.omit(ret$samplestats$stddev)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90)
},
maxDD = {
dev.new()
h <- hist(ret$samplestats$maxDD, main = paste("Drawdown distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "Max Drawdown", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = -max(cummax(cumsum(ret$dailypl))-cumsum(ret$dailypl))
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest Max Drawdown")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$samplestats$maxDD)), col = "darkgray", lty = 2) # TODO...fix i subset
c.label = ("Sample Median Max Drawdown")
text(median(na.omit(ret$samplestats$maxDD)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90) # TODO...fix i subset
},
sharpe = {
dev.new()
h <- hist(ret$samplestats$sharpe, main = paste("sharpe distribution", ret$w, "of" , xname), breaks="FD"
, xlab = "sharpe", ylab = "Density"
, col = "lightgray", border = "white", freq=FALSE
)
h
box(col = "darkgray")
b = (mean(ret$dailypl)/StdDev(ret$dailypl))
abline(v = b, col = "red", lty = 2)
b.label = ("Backtest quasi-sharpe ratio")
h = rep(0.2 * par("usr")[3] + 1 * par("usr")[4], length(b))
text(b, h, b.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90, col = "red")
abline(v=median(na.omit(ret$samplestats$sharpe)), col = "darkgray", lty = 2)
c.label = ("Sample Median quasi-sharpe ratio")
text(median(na.omit(ret$samplestats$sharpe)), h, c.label, offset = 0.2, pos = 2, cex = 0.8, srt = 90)
}
)
}
}
}
#' quantile method for objects of type \code{mcsim}
#'
#' @param x object of type 'mcsim' to produce replicate quantiles
#' @param \dots any other passthrough parameters
#' @param normalize TRUE/FALSE whether to normalize the plot by initEq, default TRUE
#' @author Jasen Mackie, Brian G. Peterson
#'
#' @export
quantile.mcsim <- function(x, ..., normalize=TRUE) {
ret <- x
q <- quantile(ret$replicates)
q
}
#' summary method for objects of type \code{mcsim}
#'
#' @param x object of type 'mcsim' to produce a sample and backtest summary
#' @param \dots any other passthrough parameters
#' @param normalize TRUE/FALSE whether to use normalized percent-based summary stats, default TRUE
#' @author Jasen Mackie, Brian G. Peterson
#'
#' @export
summary.mcsim <- function(x, ..., normalize=TRUE) {
ret <- x
if(isTRUE(normalize)){
sampletable <- apply(ret$percsamplestats, 2, function(x) { median(x) } )
class(sampletable)
backtesttable <- NULL
for (name in names(sampletable)) {
switch (name,
mean = {
backtesttable <- cbind(backtesttable, mean(ret$percdailypl))
},
median = {
backtesttable <- cbind(backtesttable, median(ret$percdailypl))
},
stddev = {
backtesttable <- cbind(backtesttable, StdDev(ret$percdailypl))
},
maxDD = {
backtesttable <- cbind(backtesttable, maxDrawdown(ret$percdailypl, invert = FALSE))
},
sharpe = {
backtesttable <- cbind(backtesttable, mean(ret$percdailypl)/StdDev(ret$percdailypl))
}
)
}
summarytable <- rbind(sampletable, backtesttable)
rownames(summarytable) <- c("Sampled Median", "Backtest")
summarytable
} else {
sampletable <- apply(ret$samplestats, 2, function(x) { median(x) } )
class(sampletable)
backtesttable <- NULL
for (name in names(sampletable)) {
switch (name,
mean = {
backtesttable <- cbind(backtesttable, mean(ret$dailypl))
},
median = {
backtesttable <- cbind(backtesttable, median(ret$dailypl))
},
stddev = {
backtesttable <- cbind(backtesttable, StdDev(ret$dailypl))
},
maxDD = {
backtesttable <- cbind(backtesttable, -max(cummax(cumsum(ret$dailypl))-cumsum(ret$dailypl)))
},
sharpe = {
backtesttable <- cbind(backtesttable, mean(ret$dailypl)/StdDev(ret$dailypl))
}
)
}
summarytable <- rbind(sampletable, backtesttable)
rownames(summarytable) <- c("Sampled Median", "Backtest")
summarytable
}
}
###############################################################################
# Blotter: Tools for transaction-oriented trading systems development
# for R (see http://r-project.org/)
# Copyright (c) 2008-2016 Peter Carl and Brian G. Peterson
#
# This library is distributed under the terms of the GNU Public License (GPL)
# for full details see the file COPYING
#
# $Id$
#
###############################################################################
@jaymon0703
Copy link
Author

Browse[3]>
Error in if (eval(0 > tmp)) { : missing value where TRUE/FALSE needed
In addition: Warning message:
In log(x) : NaNs produced
Called from: FUNCT(R = R, p = p, ... = ..., invert = FALSE)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment