d1.backtest.addMyPredictions <- function(mydecisions, mystrategy,myaccount) {
add.indicator(
strategy = mystrategy,
name = "getForecast",
arguments = list(
decisions = mydecisions,
activetimestamp = quote (index(mktdata)),
activeticker = quote(sub("\\..*", "", colnames(
as.data.frame(mktdata)
)[1])),
label = "mydecisions"
)
)
#)
add.signal(
strategy = mystrategy,
name = "sigThreshold",
arguments = list(
column = "mydecisions.getForecast.ind",
threshold = 0,
relationship = "gte",
cross = FALSE
),
label = "long"
)
add.signal(
strategy = mystrategy,
name = "sigThreshold",
arguments = list(
column = "mydecisions.getForecast.ind",
threshold = 0,
relationship = "lt",
cross = FALSE
),
label = "short"
)
add.rule(
strategy = mystrategy,
name = 'myrule',
arguments = list(
sigcol = "long",
sigval = TRUE,
orderqty = mydecisions,
ordertype = "market",
orderside = NULL,
#threshold = 0.0005,
prefer = "High",
myaccount = myaccount,
TxnFees = 0,
replace = FALSE
),
type = "enter",
label = "EnterLONG"
)
add.rule(
strategy = mystrategy,
name = 'myrule',
arguments = list(
sigcol = "short",
sigval = TRUE,
orderqty = mydecisions,
ordertype = "market",
orderside = NULL,
#threshold = 0.0005,
prefer = "High",
myaccount = myaccount,
TxnFees = -0,
replace = FALSE
),
type = "enter",
label = "EnterSHORT"
)
}
myrule <-
function (mktdata = mktdata,
timestamp,
sigcol,
sigval,
orderqty = 0,
myaccount,
ordertype,
orderside = NULL,
orderset = NULL,
threshold = NULL,
tmult = FALSE,
replace = TRUE,
delay = 1e-04,
osFUN = "osNoOp",
pricemethod = c("market", "opside", "active"),
portfolio,
symbol,
...,
ruletype,
TxnFees = 0,
prefer = NULL,
sethold = FALSE,
label = "",
order.price = NULL,
chain.price = NULL,
time.in.force = "")
{
if (!is.function(osFUN))
osFUN <- match.fun(osFUN)
if (hasArg(curIndex))
curIndex <- eval(match.call(expand.dots = TRUE)$curIndex,
parent.frame())
else
curIndex <- mktdata[timestamp, which.i = TRUE]
##Alessandro contribution to accept pre-gen decisions
if (!class(orderqty) == "numeric") {
weight = orderqty[as.Date(date) == as.Date(timestamp) &
ticker == symbol, weight]
trading.pl = sum(getPortfolio(portfolio)$summary$Net.Trading.PL)
total.equity = getEndEq(myaccount,timestamp) + trading.pl
curQty = getPosQty(Portfolio = portfolio,
Symbol = symbol,
Date = timestamp)
openQty = as.numeric(getOrders(portfolio,symbol))
openQty = ifelse(length(openQty)==0,0,openQty)
curQty = curQty + openQty
targetSize = total.equity * weight
ClosePrice <- as.numeric(Cl(mktdata[timestamp, ]))
tradeQty = targetSize/ClosePrice - curQty #TODO: add fx
orderqty <- round(tradeQty)
}
if (curIndex > 0 && curIndex <= nrow(mktdata) && (ruletype ==
"chain" || (!is.na(mktdata[curIndex, sigcol]) && mktdata[curIndex,
sigcol] == sigval))) {
pricemethod <- pricemethod[1]
if (hasArg(prefer))
prefer =
match.call(expand.dots = TRUE)$prefer
else
prefer = NULL
if (!is.null(threshold)) {
if (!is.numeric(threshold)) {
col.idx <- grep(threshold, colnames(mktdata))
if (length(col.idx) < 1)
stop(
paste(
"no indicator column in mktdata matches threshold name \"",
threshold,
"\"",
sep = ""
)
)
if (length(col.idx) > 1)
stop(
paste(
"more than one indicator column in mktdata matches threshold name \"",
threshold,
"\"",
sep = ""
)
)
threshold <- as.numeric(mktdata[curIndex, col.idx])
}
}
if (is.null(orderside) & !isTRUE(orderqty == 0)) {
curqty <- getPosQty(Portfolio = portfolio,
Symbol = symbol,
Date = timestamp)
if (curqty > 0) {
orderside <- "long"
}
else if (curqty < 0) {
orderside <- "short"
}
else {
if (orderqty > 0)
orderside <- "long"
else
orderside <- "short"
}
}
if (orderqty == "all") {
if (orderside == "long") {
tmpqty <- 1
}
else {
tmpqty <- -1
}
}
else {
tmpqty <- orderqty
}
if (!is.null(order.price)) {
orderprice <- order.price
}
else if (!is.null(chain.price)) {
orderprice <- chain.price
}
else {
switch(
pricemethod,
market = ,
opside = ,
active = {
if (is.BBO(mktdata)) {
if (tmpqty > 0)
prefer = "ask"
else
prefer = "bid"
}
orderprice <- try(getPrice(x = mktdata[curIndex,], prefer = prefer)[, 1])
},
passive = ,
work = ,
join = {
if (is.BBO(mktdata)) {
if (tmpqty > 0)
prefer = "bid"
else
prefer = "ask"
}
orderprice <- try(getPrice(x = mktdata[curIndex,], prefer = prefer)[, 1])
},
maker = {
if (hasArg(price) & length(match.call(expand.dots = TRUE)$price) >
1) {
orderprice <- try(match.call(expand.dots = TRUE)$price)
} else {
if (!is.null(threshold)) {
baseprice <- last(getPrice(x = mktdata[curIndex,])[, 1])
if (hasArg(tmult) & isTRUE(match.call(expand.dots = TRUE)$tmult)) {
baseprice <- last(getPrice(x = mktdata[curIndex,])[, 1])
if (length(threshold) > 1) {
orderprice <- baseprice * threshold
} else {
orderprice <- c(baseprice * threshold,
baseprice * (1 + 1 - threshold))
}
} else {
if (length(threshold) > 1) {
orderprice <- baseprice + threshold
} else {
orderprice <- c(baseprice + threshold,
baseprice + (-threshold))
}
}
} else {
stop(
"maker orders without specified prices and without threholds not (yet?) supported"
)
if (is.BBO(mktdata)) {
} else {
}
}
}
if (length(orderqty) == 1)
orderqty <- c(orderqty,-orderqty)
}
)
if (inherits(orderprice, "try-error"))
orderprice <- NULL
if (length(orderprice) > 1 && pricemethod != "maker")
orderprice <- last(orderprice[timestamp])
if (!is.null(orderprice) && !is.null(ncol(orderprice)))
orderprice <- orderprice[, 1]
}
if (is.null(orderset))
orderset = NA
if (orderqty != "all") {
orderqty <- osFUN(
strategy = strategy,
data = mktdata,
timestamp = timestamp,
orderqty = orderqty,
ordertype = ordertype,
orderside = orderside,
portfolio = portfolio,
symbol = symbol,
... = ...,
ruletype = ruletype,
orderprice = as.numeric(orderprice)
)
}
if (!is.null(orderqty) && orderqty != 0 && length(orderprice)) {
addOrder(
portfolio = portfolio,
symbol = symbol,
timestamp = timestamp,
qty = orderqty,
price = as.numeric(orderprice),
ordertype = ordertype,
side = orderside,
orderset = orderset,
threshold = threshold,
status = "open",
replace = replace,
delay = delay,
tmult = tmult,
... = ...,
prefer = prefer,
TxnFees = TxnFees,
label = label,
time.in.force = time.in.force
)
}
}
if (sethold)
hold <<- TRUE
}
getForecast <- function(decisions, activetimestamp, activeticker,reactOn = 'forecast')
{
fcst = decisions[as.Date(date) %in% as.Date(activetimestamp) &
ticker == unique(activeticker)]
setkey(fcst, date)
#fill NaN dates
allDates = data.table(allDates = as.Date(activetimestamp))
fcstFilled = merge(allDates,
fcst[,dateAsDate:=as.Date(date)],
by.x = 'allDates',
by.y = 'dateAsDate',
all.x = T)
fcstFilled[is.na(predict), predict := 0]
setkey(fcstFilled, allDates)
#Manipulations - required by quantstrat:
if (reactOn == 'forecast'){
output = xts(fcstFilled$predict, fcstFilled$allDates)
} else if (reactOn == 'decision'){
output = xts(fcstFilled$decision, fcstFilled$allDates)
}
colnames(output) = 'mydecisions'
return(output)
}
d1.backtest.backtestBy <- function(DT,method,nameBasket="mybasket"){
# Description
# ------------------------------------------
# Backtest a strategy according to the allocation strategy specified in 'method'
# Inputs
# -----------------------------------------
# @param DT: data.table, must contain a "predict" column
# @param method: choose among: 'quintile'
DT[,predict_q:=d1.stat.quantile(predict),by=date]
DT[,weight:=0]
switch(method,
quintile =
DT[predict_q==5,
weight:=1/length(weight),by=date][predict_q==1,
weight:=-1/length(weight),by=date]
)
d1.backtest.run(DT)
}
d1.backtest.run <- function(DT){
# DESCRIPTION -------------------------------
# Use quantstrat to backtest. This runs once a day, for every day
# contained in the input table DT
# INPUTS ------------------------------------
# DT with a column of 'weight', date
init_eq=1e6
d1.debug.info("Init basket...")
DT[,dateAsDate:=as.Date(date)]
start_date = DT[,min(dateAsDate)]
mybasket = "mybasket"
mystrategy = "mystrategy"
myaccount = "myaccount"
rm.strat(mybasket)
rm.strat(myaccount)
initPortf(name = mybasket,
symbols = securities,
initDate = start_date)
initAcct(
name = myaccount,
portfolios = mybasket,
initDate = start_date,
initEq = init_eq
)
initOrders(portfolio = mybasket,
symbols = securities,
initDate = start_date)
strategy(mystrategy, store = TRUE)
d1.backtest.addMyPredictions(DT, mystrategy,myaccount)
# run day by day( (otherwise equity is not properly updated)
for (d in DT[,unique(dateAsDate)][-1]){
d = as.Date(d)
d1.debug.info("Backtesting day",d)
end_date = d
# Uses cached data (=cached during d1.md.buildUniverse)
getSymbols(Symbols = securities, src = "cached", index.class = "POSIXct",
from = d, to = d, adjust = T, env=.GlobalEnv,warnings=F)
results = applyStrategy(mystrategy, portfolios = mybasket)
updatePortf(mybasket)
updateAcct(myaccount)
updateEndEq(myaccount)
acc = getAccount(myaccount)
d1.debug.info("Equity Value on date",d,":",last(acc$summary$End.Eq))
d1.debug.info("Return thus far:",last(acc$summary$End.Eq)/init_eq*100-100,"%")
}
rets <- PortfReturns(Account=myaccount)
acc = getAccount(myaccount)
xyplot(acc$summary, type = "h", col = 4)
charts.PerformanceSummary(rets, colorset = bluefocus)
summaryP <- getPortfolio("mybasket")
}
d1.backtest.cacheSymbols <- function(securities,pattern=".cached"){
# Description ---------------------------------
# Cache Symbols loaded from quantstrat::getSymbols
# Inputs --------------------------------------
# @param securities | list(character) |
for (p in securities){
assign(paste(p,pattern,sep=""),get(p),.GlobalEnv)
}
}
getSymbols.cached <-
function (Symbols, env, return.class = "xts", index.class = "Date",
from = "2007-01-01", to = Sys.Date(), ...)
{
importDefaults("getSymbols.yahoo")
this.env <- environment()
for (var in names(list(...))) {
assign(var, list(...)[[var]], this.env)
}
if (!hasArg(adjust))
adjust <- FALSE
default.return.class <- return.class
default.from <- from
default.to <- to
if (!hasArg(verbose))
verbose <- FALSE
if (!hasArg(auto.assign))
auto.assign <- TRUE
tmp <- tempfile()
on.exit(unlink(tmp))
for (i in 1:length(Symbols)) {
active = Symbols[[i]]
active.ch = paste(active,".cached",sep="")
dt = get(active.ch)[paste(from,'/',to,sep="")]
if (auto.assign)
assign(Symbols[[i]], dt , env)
}
if (auto.assign)
return(Symbols)
return(dt)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.