#' Plot a quantler object
#'
#' A generic function of class quantler.
#'
#' @param x A quantler object
#' @param plotlevel A character variable must be one of c('1day', '60mins',
#' '1min')
#' @param segments A logical variable. When segments is TRUE this function will
#' return a list contians all the sub pictures, and when FALSE plot all the
#' segments together.
#'
#' @return A picture or a list contains all the segments of the picture.
#' @examples
#' data(stradeinfo_bp)
#' test.qtler <- backtest(stradeinfo_bp, cash = 100000, is.tax=T, tax.rate = 0.002)
#' plot(test.qtler)
#' @export
setMethod(
"plot",
signature(x = "quantler", y = "missing"),
function(x, ..., plotlevel = "1day", is.simple = F, segments = F) {
if (!is.quantler(x)) stop("x must be a quantler object")
if (length(plotlevel) == 0 || !plotlevel %in% c("1day", "60mins", "1min")) {
stop("Not correct form of plot.level")
}
if (is.na(is.simple) || !is.logical(is.simple)) stop("Not correct form of is.simple")
if (is.na(segments) || !is.logical(segments)) stop("Not correct form of segments")
trade.info <- x@trade.info
stock.date <- trade.info$stock.date
len <- nrow(trade.info)
strategy.type <- x@bt.features$strategy.type
trade.value <- x@bt.features$trade.value
stock.benchmarkwin <- x@bt.features$stock.benchmarkwin
strategy.type <- x@bt.features$strategy.type
tax.rate <- x@bt.features$tax.rate
cash <- x@bt.features$cash
if (plotlevel == "1day") {
loc.day <- c(which(diff(stock.date) >= 1), len)
if (length(strategy.type) == 2) {
temp.df1 <- data.frame(
trade.info[loc.day, c("stock.price", "stock.date", "strategy.b", "strategy.s")],
strategy.income = trade.value[loc.day],
stock.benchmarkwin = stock.benchmarkwin[loc.day]
)
} else if (strategy.type == "buy") {
temp.df1 <- data.frame(
trade.info[loc.day, c("stock.price", "stock.date", "strategy.b")],
strategy.income = trade.value[loc.day],
stock.benchmarkwin = stock.benchmarkwin[loc.day]
)
} else {
temp.df1 <- data.frame(
trade.info[loc.day, c("stock.price", "stock.date", "strategy.s")],
strategy.income = trade.value[loc.day],
stock.benchmarkwin = stock.benchmarkwin[loc.day]
)
}
} else if (plotlevel == "1min" & x@data.level == "1min") {
if (length(strategy.type) == 2) {
temp.df1 <- data.frame(
trade.info[, c("stock.price", "stock.date", "stock.time", "strategy.b", "strategy.s")],
strategy.income = trade.value,
stock.benchmarkwin = stock.benchmarkwin
)
} else if (strategy.type == "buy") {
temp.df1 <- data.frame(
trade.info[, c("stock.price", "stock.date", "stock.time", "strategy.b")],
strategy.income = trade.value,
stock.benchmarkwin = stock.benchmarkwin
)
} else {
temp.df1 <- data.frame(
trade.info[, c("stock.price", "stock.date", "stock.time", "strategy.s")],
strategy.income = trade.value,
stock.benchmarkwin = stock.benchmarkwin
)
}
temp.df1$id <- 1:nrow(temp.df1)
temp.df1.breaks <- round(seq(1, nrow(temp.df1), length.out = 5))
} else {
stop("Plot level dose not match the given data!")
}
# all.features$strprice.df <- temp.df1
# 2.2 指标表
feature.name <- c(
"Benchmark Return(%)",
"Strategy Return(%)",
"Benchmark Daily Return(%)",
"Strategy Daily Return(%)",
"Benchmark Annual Return(%)",
"Strategy Annual Return(%)",
"Average Buy Return(long)",
"Average Sell Return(short)",
"Algorithm Volatility(%)",
"Benchmark Volatility(%)",
"Sharpe Ratio(%)",
"Information Ratio(%)",
"Max Drawdown(%)",
"Beta",
"Alpha",
"Win Rate(%)",
"Daily Win Rate(%)",
"Win Loss Ratio(%)",
"Correct Rate Long(%)",
"Correct Rate Short(%)"
)
temp.df3 <- data.frame(
feature = feature.name,
value = round(c(
x@bt.features$benchmark.return,
x@bt.features$strategy.return,
x@bt.features$benchmark.day.return,
x@bt.features$strategy.day.return,
x@bt.features$benchmark.annual.return,
x@bt.features$strategy.annual.return,
x@bt.features$mean.win.rate.b,
x@bt.features$mean.win.rate.s,
x@bt.features$alg.vol,
x@bt.features$ben.vol,
x@bt.features$sharpe.ratio,
x@bt.features$info.ratio,
x@bt.features$max.drawdown,
x@bt.features$beta / 100,
x@bt.features$alpha / 100,
x@bt.features$win.rate,
x@bt.features$win.day.rate,
x@bt.features$win.lose.rate,
x@bt.features$acc.rate.b,
x@bt.features$acc.rate.s
) * 100, 2),
col = c(1, 2, 1, 2, 1, 2, 1, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3),
id = length(feature.name):1,
stringsAsFactors = F
)
if (!is.simple) { # 简化显示输出
# 2.3 交易分布,汇总
if (length(strategy.type) == 1) {
# 交易分布
if (strategy.type == "sell") {
temp.xts4 <- xts(trade.info$strategy.s, stock.date)
} else {
temp.xts4 <- xts(trade.info$strategy.b, stock.date)
}
if (x@data.level == "60mins") {
temp.xts4.monthly <- apply.monthly(temp.xts4, function(x) {
buy <- length(x[x > 0])
hold <- length(x[x == 0])
sell <- -length(x[x < 0])
c(buy, hold, sell)
})
temp.df4 <- as.data.frame(temp.xts4.monthly)
names(temp.df4) <- c("buy", "hold", "sell")
temp.df4$date <- substr(time(temp.xts4.monthly), 1, 7)
} else if (x@data.level == "1min") {
temp.xts4.daily <- apply.daily(temp.xts4, function(x) {
buy <- length(x[x > 0])
hold <- length(x[x == 0])
sell <- -length(x[x < 0])
c(buy, hold, sell)
})
temp.df4 <- as.data.frame(temp.xts4.daily)
names(temp.df4) <- c("buy", "hold", "sell")
temp.df4$date <- time(temp.xts4.daily)
} else if (x@data.level == "1day") {
temp.xts4.daily <- apply.daily(temp.xts4, function(x) {
buy <- length(x[x > 0])
hold <- length(x[x == 0])
sell <- -length(x[x < 0])
c(buy, hold, sell)
})
temp.df4 <- as.data.frame(temp.xts4.daily)
names(temp.df4) <- c("buy", "hold", "sell")
temp.df4$date <- time(temp.xts4.daily)
}
temp.df4.long <- reshape2::melt(temp.df4[, c("date", "buy", "sell")], id = "date")
# 交易次数
temp.df5 <- transform(temp.df4, sell = -sell)
temp.df5.long <- reshape2::melt(temp.df5, id = "date")
temp.df5.short <- plyr::ddply(temp.df5.long, .(variable), function(x) {
sum(x$value)
})
} else {
# 交易分布
temp.xts4 <- xts(trade.info[, c("strategy.b", "strategy.s")], stock.date)
if (x@data.level == "60mins") {
temp.xts4.monthly <- apply.monthly(temp.xts4, function(x) {
b <- x[, 1]
s <- x[, 2]
buy.b <- length(b[b > 0])
hold.b <- length(b[b == 0])
sell.b <- -length(b[b < 0])
buy.s <- length(s[s > 0])
hold.s <- length(s[s == 0])
sell.s <- -length(s[s < 0])
c(buy.b, hold.b, sell.b, buy.s, hold.s, sell.s)
})
temp.df4 <- as.data.frame(temp.xts4.monthly)
names(temp.df4) <- c("buy.b", "hold.b", "sell.b", "buy.s", "hold.s", "sell.s")
temp.df4$date <- substr(time(temp.xts4.monthly), 1, 7)
} else if (x@data.level == "1min") {
temp.xts4.daily <- apply.daily(temp.xts4, function(x) {
b <- x[, 1]
s <- x[, 2]
buy.b <- length(b[b > 0])
hold.b <- length(b[b == 0])
sell.b <- -length(b[b < 0])
buy.s <- length(s[s > 0])
hold.s <- length(s[s == 0])
sell.s <- -length(s[s < 0])
c(buy.b, hold.b, sell.b, buy.s, hold.s, sell.s)
})
temp.df4 <- as.data.frame(temp.xts4.daily)
names(temp.df4) <- c("buy.b", "hold.b", "sell.b", "buy.s", "hold.s", "sell.s")
temp.df4$date <- time(temp.xts4.daily)
} else if (x@data.level == "1day") {
temp.xts4.daily <- apply.daily(temp.xts4, function(x) {
b <- x[, 1]
s <- x[, 2]
buy.b <- length(b[b > 0])
hold.b <- length(b[b == 0])
sell.b <- -length(b[b < 0])
buy.s <- length(s[s > 0])
hold.s <- length(s[s == 0])
sell.s <- -length(s[s < 0])
c(buy.b, hold.b, sell.b, buy.s, hold.s, sell.s)
})
temp.df4 <- as.data.frame(temp.xts4.daily)
names(temp.df4) <- c("buy.b", "hold.b", "sell.b", "buy.s", "hold.s", "sell.s")
temp.df4$date <- time(temp.xts4.daily)
}
temp.df4.long <- reshape2::melt(temp.df4[, c("date", "buy.b", "sell.b", "buy.s", "sell.s")], id = "date")
temp.df4.long$class <- "sell"
temp.df4.long$class[which(temp.df4.long$variable %in% c("buy.b", "hold.b", "sell.b"))] <- "buy"
# 交易次数
temp.df5 <- transform(temp.df4, sell.b = -sell.b, sell.s = -sell.s)
temp.df5.long <- reshape2::melt(temp.df5, id = "date")
temp.df5.short <- plyr::ddply(temp.df5.long, .(variable), function(x) {
sum(x$value)
})
temp.df5.short$class <- "buy"
temp.df5.short$class[which(temp.df5.short$variable %in% c("buy.s", "hold.s", "sell.s"))] <- "sell"
temp.df5.short$state <- c("buy", "hold", "sell", "buy", "hold", "sell")
}
# 2.4 收益率数据
if (length(strategy.type) > 1) {
temp.df6.s <- data.frame(
trade.value.rate = x@bt.features$win.rate.s$pertrade.winrate, # 每笔交易收益率
stock.time = trade.info$stock.time[which(trade.info$strategy.s == -1)], # 交易完成时间
class = "c.short", rate = tax.rate, stringsAsFactors = F
)
temp.df6.b <- data.frame(
trade.value.rate = x@bt.features$win.rate.b$pertrade.winrate,
stock.time = trade.info$stock.time[which(trade.info$strategy.b == -1)],
class = "b.long", rate = tax.rate, stringsAsFactors = F
)
temp.df6.temp <- dplyr::full_join(temp.df6.s[, c("stock.time", "trade.value.rate")],
temp.df6.b[, c("stock.time", "trade.value.rate")],
by = "stock.time"
)
temp.df6.temp$trade.value.rate.x[is.na(temp.df6.temp$trade.value.rate.x)] <- 0
temp.df6.temp$trade.value.rate.y[is.na(temp.df6.temp$trade.value.rate.y)] <- 0
temp.rate <- temp.df6.temp$trade.value.rate.x + temp.df6.temp$trade.value.rate.y
temp.df6.temp$rate <- tax.rate
temp.df6.temp$rate[((temp.df6.temp$trade.value.rate.x != 0) + (temp.df6.temp$trade.value.rate.y != 0)) == 2] <- tax.rate * 2
temp.df6.all <- data.frame(
stock.time = temp.df6.temp$stock.time,
trade.value.rate = temp.rate,
class = "a.both",
rate = temp.df6.temp$rate, stringsAsFactors = F
)
temp.df6 <- dplyr::bind_rows(temp.df6.all, temp.df6.b, temp.df6.s)
} else if (strategy.type == "buy") {
temp.df6 <- data.frame(
trade.value.rate = x@bt.features$win.rate.b$pertrade.winrate,
stock.time = trade.info$stock.time[which(trade.info$strategy.b == -1)],
class = "b.buy", rate = tax.rate, stringsAsFactors = F
)
} else {
temp.df6 <- data.frame(
trade.value.rate = x@bt.features$win.rate.s$pertrade.winrate,
stock.time = trade.info$stock.time[which(trade.info$strategy.s == -1)],
class = "c.short", rate = tax.rate, stringsAsFactors = F
)
}
# 收益率统计
temp.df6.rate <- plyr::ddply(temp.df6, .(class), function(x) {
up <- sum(x$trade.value.rate > tax.rate) / nrow(x)
down <- sum(x$trade.value.rate < -tax.rate) / nrow(x)
yup <- max(x$trade.value.rate) / 2
ydown <- min(x$trade.value.rate) / 2
temp <- data.frame(
value = paste(round(c(up, down) * 100, 1), "%", sep = ""),
y = c(yup, ydown)
)
})
temp.df6.rate$time <- min(temp.df6$stock.time)
}
# (3)绘图模块
# 3.1 绘图主题
theme1 <- theme(
legend.position = "none",
panel.background = element_rect(fill = "black", colour = "grey40"),
panel.grid.major = element_line(colour = "grey20", linetype = "dashed"),
panel.grid.minor = element_line(colour = "grey10", linetype = "dashed"),
axis.text = element_text(face = "bold", size = 10, colour = "orange"),
plot.background = element_rect(fill = "black", colour = "black", size = 2),
plot.title = element_text(face = "bold", size = 12, colour = "gold", hjust = .5)
)
theme2 <- theme(
legend.position = "none",
panel.background = element_rect(fill = "black", colour = "grey20"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
strip.background = element_rect(fill = "darkmagenta", colour = "black"),
strip.text = element_text(face = "bold", size = 10, colour = "gold"),
legend.background = element_rect(fill = "black", colour = "black"),
legend.text = element_text(colour = "gold"),
axis.text = element_text(face = "bold", size = 12, colour = "orange"),
plot.background = element_rect(fill = "black", colour = "black", size = 2),
plot.title = element_text(face = "bold", size = 12, colour = "gold", hjust = .5)
)
theme3 <- theme(
legend.position = "none",
panel.background = element_rect(fill = "black", colour = "grey70"),
panel.grid.major.x = element_line(colour = "grey10", linetype = "dashed"),
panel.grid.minor.x = element_line(colour = "grey10", linetype = "dashed"),
axis.line.y = element_line(colour = "black", linetype = "dotted"),
axis.ticks.y = element_line(colour = "white"),
panel.grid.major.y = element_line(colour = "grey10", linetype = "dashed"),
panel.grid.minor.y = element_line(colour = "grey40", linetype = "dashed"),
axis.text.x = element_text(face = "bold", size = 12, colour = "orange"),
axis.text.x.top = element_text(face = "bold", size = 12, colour = "red"),
axis.text.y = element_text(face = "bold", size = 12, colour = "orange"),
axis.text.y.right = element_text(face = "bold", size = 12, colour = "red"),
plot.background = element_rect(fill = "black", colour = "black", size = 2),
plot.title = element_text(face = "bold", size = 12, colour = "gold", hjust = .5)
)
# 3.2 绘图
if (plotlevel == "1day") { # a.基准收益率
pic1 <- ggplot(temp.df1) +
geom_hline(yintercept = cash, col = "orange", size = .5) + theme1 +
geom_line(aes(x = stock.date, y = strategy.income), col = "gold") +
geom_line(aes(x = stock.date, y = stock.benchmarkwin), col = "red") +
ggtitle("strategy-return(yellow) vs benchmarket-return(red)")
pic2 <- ggplot(temp.df1) + # b.回撤
geom_hline(yintercept = cash, col = "orange", size = .5) + theme1 +
geom_line(aes(x = stock.date, y = strategy.income), col = "gold") +
geom_point(
data = temp.df1[x@bt.features$max.drawdown.loc, ],
aes(x = stock.date, y = strategy.income), col = "lemonchiffon", size = 2
) +
geom_line(
data = temp.df1[x@bt.features$max.drawdown.loc, ],
aes(x = stock.date, y = strategy.income), col = "greenyellow", size = 1
) +
ggtitle(paste(
"Strategy return : max drawdown: ",
round(x@bt.features$max.drawdown * 100, 2),
"%",
sep = ""
))
pic4 <- ggplot(temp.df1) + # c.超额收益
geom_hline(yintercept = 0, col = "orange", size = .5) +
geom_line(aes(x = stock.date, y = strategy.income - stock.benchmarkwin), col = "magenta") +
theme1 +
ggtitle("Excess Return")
} else if (plotlevel == "1min") {
pic1 <- ggplot(temp.df1) +
geom_hline(yintercept = cash, col = "orange", size = .5) +
theme1 +
geom_line(aes(x = id, y = strategy.income), col = "gold", alpha = .8) +
geom_line(aes(x = id, y = stock.benchmarkwin), col = "red", alpha = .8) +
scale_x_continuous(breaks = temp.df1.breaks, labels = temp.df1$stock.date[temp.df1.breaks]) +
ggtitle("strategy-return(yellow) vs benchmarket-return(red)")
pic2 <- ggplot(temp.df1) + # b.回撤
geom_hline(yintercept = cash, col = "orange", size = .5) +
theme1 +
geom_line(aes(x = id, y = strategy.income), col = "gold") +
geom_point(
data = temp.df1[x@bt.features$max.drawdown.loc, ],
aes(x = id, y = strategy.income), col = "lemonchiffon", size = 2
) +
geom_line(
data = temp.df1[x@bt.features$max.drawdown.loc, ],
aes(x = id, y = strategy.income), col = "greenyellow", size = 1
) +
scale_x_continuous(breaks = temp.df1.breaks, labels = temp.df1$stock.date[temp.df1.breaks]) +
ggtitle(paste(
"Strategy return : max drawdown: ",
round(x@bt.features$max.drawdown * 100, 2), "%",
sep = ""
))
pic4 <- ggplot(temp.df1) + # c.超额收益
geom_hline(yintercept = 0, col = "orange", size = .5) +
geom_line(aes(x = id, y = strategy.income - stock.benchmarkwin), col = "magenta") +
theme1 +
scale_x_continuous(breaks = temp.df1.breaks, labels = temp.df1$stock.date[temp.df1.breaks]) +
ggtitle("Excess Return")
}
pic3 <- ggplot(temp.df3) + # d.指数表
geom_hline(yintercept = 0, col = "white") +
geom_vline(xintercept = nrow(temp.df3) - 7.5, col = "white") +
geom_vline(xintercept = nrow(temp.df3) - 12.5, col = "white") +
theme3 +
geom_vline(xintercept = nrow(temp.df3) - 14.5, col = "white") +
theme3 +
geom_bar(stat = "identity", aes(x = id, y = value, fill = factor(col)), width = .25) +
geom_point(aes(x = id, y = value, col = factor(col)), size = 3) +
scale_fill_manual(values = c("1" = "red", "2" = "gold", "3" = "royalblue3")) +
scale_x_continuous(
position = "bottom", expand = c(0.025, 0), breaks = nrow(temp.df3):1,
labels = temp.df3$feature,
sec.axis = sec_axis(~., name = "", breaks = nrow(temp.df3):1, labels = temp.df3$value)
) +
ggtitle(paste("Stock Code:", trade.info$stock.code[1])) +
coord_flip()
if (!is.simple) {
if (length(strategy.type) == 1) { # e.交易分布
pic5 <- ggplot(temp.df4.long) +
geom_bar(aes(x = date, y = value, fill = variable),
width = .8, stat = "identity",
position = "dodge"
) +
geom_hline(yintercept = 0, col = "orange", size = .5) +
theme2 +
scale_fill_manual(values = c("sell" = "royalblue3", "buy" = "red"))
if (strategy.type == "buy") pic5 <- pic5 + ggtitle("Trade distribution of long position")
if (strategy.type == "sell") pic5 <- pic5 + ggtitle("Trade distribution of short position")
} else {
pic5 <- ggplot(temp.df4.long) +
facet_wrap(~class, nrow = 2, strip.position = "left") +
geom_bar(aes(x = date, y = value, fill = variable),
width = .8, stat = "identity",
position = "dodge"
) +
geom_hline(yintercept = 0, col = "orange", size = .5) +
theme2 +
scale_fill_manual(
values = c(
"sell.b" = "royalblue3", "buy.b" = "red",
"sell.s" = "royalblue1", "buy.s" = "orangered"
))
}
if (length(strategy.type) == 1) { # f.交易次数
pic6 <- ggplot(temp.df5.short) +
geom_bar(aes(x = reorder(variable, V1), y = V1, fill = reorder(variable, V1)),
stat = "identity", width = .8
) +
geom_text(aes(x = reorder(variable, V1), y = max(V1) / 2, label = V1),
col = "orange", size = 8
) + theme2 +
scale_fill_manual(name = NULL, values = c("buy" = "red", "hold" = "mediumblue", "sell" = "royalblue3"))
if (strategy.type == "buy") pic6 <- pic6 + ggtitle("Trade num of long position")
if (strategy.type == "sell") pic6 <- pic6 + ggtitle("Trade num of short position")
} else {
pic6 <- ggplot(temp.df5.short) +
facet_wrap(~class, ncol = 1, strip.position = "left") +
geom_bar(aes(x = reorder(state, V1), y = V1, fill = reorder(state, V1)),
stat = "identity", width = .8
) +
geom_text(aes(x = reorder(state, V1), y = max(V1) / 2, label = V1),
col = "orange", size = 5
) +
theme2 +
scale_fill_manual(
name = NULL,
values = c("buy" = "red", "hold" = "mediumblue", "sell" = "royalblue3")
) +
ggtitle("Number of Trades")
}
pic7 <- ggplot(temp.df6) + # g.收益率分布
facet_wrap(~class, strip.position = "left", ncol = 1, scale = "free_y") +
geom_hline(yintercept = 0, col = "orange3", size = .5) +
geom_segment(
aes(x = stock.time, xend = stock.time, yend = 0, y = trade.value.rate, col = class),
alpha = .5
) +
geom_point(aes(x = stock.time, y = trade.value.rate, col = class), size = .5) +
geom_line(aes(x = stock.time, y = rate), col = "orange", linetype = "dashed") +
geom_line(aes(x = stock.time, y = -rate), col = "orange", linetype = "dashed") +
geom_text(
data = temp.df6.rate,
aes(x = time, y = y, label = value), size = 4, col = "orange"
) +
theme2 +
scale_color_manual(values = c(
"a.both" = "greenyellow", "b.long" = "orangered", "c.short" = "royalblue1"
))
}
pic0 <- ggplot() + theme1
if (is.simple) {
if (!segments) {
lay <- rbind(
c(1, 1, 2, 2, 2, 2),
c(1, 1, 2, 2, 2, 2),
c(1, 1, 3, 3, 4, 4)
)
gridExtra::grid.arrange(pic3, pic1, pic4, pic2, ncol = 2, layout_matrix = lay)
} else {
pic <- list("pic1" = pic1, "pic2" = pic2, "pic3" = pic3, "pic4" = pic4)
return(pic)
}
} else {
if (!segments) {
lay <- rbind(
c(1, 1, 2, 2, 2, 2),
c(1, 1, 2, 2, 2, 2),
c(1, 1, 3, 3, 3, 3),
c(5, 5, 5, 6, 4, 4),
c(5, 5, 5, 7, 7, 7)
) # h.组合绘图
# pic <- gridExtra::arrangeGrob(pic3, pic1, pic4, pic2, pic7, pic6, pic5, ncol = 2,layout_matrix = lay)
gridExtra::grid.arrange(
pic3, pic1, pic4, pic2, pic7, pic6, pic5, ncol = 2,
layout_matrix = lay
)
} else {
pic <- list(
"pic1" = pic1, "pic2" = pic2, "pic3" = pic3, "pic4" = pic4,
"pic5" = pic5, "pic6" = pic6, "pic7" = pic7
)
return(pic)
}
}
# pic <- grid.arrange(pic3, pic1, pic4, pic2, pic7, pic6, pic5, ncol = 2,layout_matrix = lay)
# pic <- arrangeGrob(pic3, pic1, pic2, pic4, pic5, pic6, ncol = 2,layout_matrix = lay)
# print(pic)
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.