# Description: creates a graph representation of a trading strategy
# created within quantstrat framework
# Date: 2015-11-20
# Author: cloudcello
# Email: ef256aff@opayq.com
#
# Version: 0.0.1
#
#' @export
getNodesIndicators <- function(strategy, verbose=FALSE) {
# hack for the 'rsi' qs demo:
if(inherits(strategy,"strategy")){
st <- strategy
} else {
#assume it's a strategy 'handle'
st <- getStrategy(strategy)
}
# str(st)
# 'su' == strategy 'unit'
su <- st$indicators
node_nbr <- length(su)
result_final <- vector(mode="list", length = node_nbr)
for (i in seq(node_nbr)) {
outp <- paste(su[[i]]$label, sep = '~')
if(verbose) print(outp)
outp_len <- 1L
# su2 <- su[[i]]$arguments #$columns
su2 <- unlist(su[[i]]$arguments)
su2 <- su2[names(su2)!="label"]
su2 <- su2[su2!="TRUE"]
su2 <- su2[su2!="FALSE"]
#inp -- inputs into the 'node'
inp_len <- length(su2) # how many inputs there are
if(verbose) cat(paste0("# of args: ",inp_len,'\n'))
if(inp_len==0) stop("cannot find inputs in this signal")
linkdata_len <- (outp_len) + (inp_len)
result <- vector(mode = "character", length = linkdata_len)
result[1] <- outp
for (ii in seq(inp_len)) {
inp <- (paste(outp,as.expression(su2[[ii]]), sep = '~'))
if(verbose) print(inp)
result[1+ii] <- inp
}
if(verbose) print(result)
result_final[[i]] <- result
}
result_final
}
#' @export
getNodesSignals <- function(strategy, verbose=FALSE) {
# lbl_out <- "~" #"oSi"
# lbl_inp <- "~" #"iSi"
# hack for the 'rsi' qs demo:
if(inherits(strategy,"strategy")){
st <- strategy
} else {
#assume it's a strategy 'handle'
st <- getStrategy(strategy)
}
# strategy structure 'unit'
su <- st$signals
# str(su)
node_nbr <- length(su)
result_final <- vector(mode="list", length = node_nbr)
for (i in seq(node_nbr)) {
outp <- paste(su[[i]]$label, sep = '~')
if(verbose) print(outp)
outp_len <- 1L
# su2 <- su[[i]]$arguments$columns
su2 <- unlist(su[[i]]$arguments)
su2 <- su2[names(su2)!="label"]
su2 <- su2[su2!="TRUE"]
su2 <- su2[su2!="FALSE"]
inp_len <- length(su2)
if(verbose) cat(paste0("# of args: ",inp_len,'\n'))
if(inp_len==0) stop("cannot find inputs in this signal")
linkdata_len <- outp_len + inp_len
result <- vector(mode = "character", length = linkdata_len)
result[1] <- outp
# result[seq(2:(inp_len+1))]<-su2[seq(inp_len)]
for (ii in seq(inp_len)) {
inp <- (paste(su2[[ii]], sep='~'))
if(verbose) print(inp)
result[1+ii] <- inp
}
if(verbose) print(result)
result_final[[i]] <- result
}
result_final
}
getNodesRules <- function(strategy, verbose=FALSE) {
# hack for the 'rsi' qs demo:
if(inherits(strategy,"strategy")){
st <- strategy
} else {
#assume it's a strategy 'handle'
st <- getStrategy(strategy)
}
# su <- st$rules$exit
getNodeRuleType <- function(su=su, ...) {
node_nbr <- length(su)
if(node_nbr==0) return(NULL)
result_final <- vector(mode="list", length = node_nbr)
for (i in seq(node_nbr)) {
# i <- 1
outp <- paste(su[[i]]$type,su[[i]]$label, sep = '~')
if(verbose) print(outp)
outp_len <- 1L
# su2 <- su[[i]]$arguments$sigcol #$columns
su2 <- unlist(su[[i]]$arguments)
su2 <- su2[names(su2)!="label"]
su2 <- su2[su2!="TRUE"]
su2 <- su2[su2!="FALSE"]
su2 <- su2[su2!="NULL"]
su2names <- names(su2)
#inp -- inputs into the 'node'
inp_len <- length(su2names) # how many inputs there are
if(verbose) cat(paste0("# of args: ", inp_len,'\n'))
if(inp_len==0) stop("cannot find inputs in this signal")
linkdata_len <- (outp_len) + (inp_len)
result <- vector(mode = "character", length = linkdata_len)
result[1] <- outp
idx <- 2
for (ii in su2names) {
# inp <- (paste(as.expression(su2[[ii]]), sep = '~'))
# inp <- paste0(as.expression(su2[[ii]]),"")
inp <- su2[ii]
# class(stratRSI$rules$enter[[1]]$arguments$osFUN)
if(is.function(inp)) {inp <- ii} #assign arg name instead / FIXME
if(verbose) print(inp)
result[idx] <- inp
idx <- idx + 1
}
if(verbose) print(result)
result_final[[i]] <- result
}
result_final
}
c(getNodeRuleType(st$rules$enter),
getNodeRuleType(st$rules$exit),
getNodeRuleType(st$rules$order))
}
getTuples <- function(parsable_data=parsable_data){
result <- NULL
for(i in seq(length(parsable_data))) {
tuple_input <- parsable_data[[i]]
tuples_nbr <- length(tuple_input)-1
if(tuples_nbr<1L) { stop(paste0("strange input ", tuple_input)) }
tuples <- vector(mode="list", length = tuples_nbr)
for(ii in seq(tuples_nbr)) {
tuple <- c(tuple_input[1],tuple_input[ii+1])
tuples[[ii]] <- tuple
}
result <- c(result,tuples)
}
result
}
#' @export
plot.strategy <- function(strategy=NULL, envir = NULL) {
require(quantstrat)
require(igraph)
if(!is.null(envir)){
strategy <- get.strategy(strategy, envir = envir)
# if(inherits(strategy,"strategy")){
# strategy <- strategy
# } else {
# #assume it's a strategy 'handle'
# strategy <- getStrategy(strategy)
# }
}
indics <- getNodesIndicators(strategy) #, verbose = TRUE)
sigs <- getNodesSignals(strategy) #, verbose = TRUE)
rules <- getNodesRules(strategy)#, verbose = TRUE)
parsable_data <- c(indics, sigs, rules)
# create parsable_data_tuples
tuples <- getTuples(parsable_data)
tuples_nbr <- length(tuples)
# populate matrix by unique values
pduniq <- unique( unlist(parsable_data) )
node_nbr <- length(pduniq)
M <- matrix(nrow = node_nbr, ncol = node_nbr, byrow = TRUE, data = 0)
colnames(M) <- pduniq
rownames(M) <- pduniq
# M
# establish links e.g.: M["lbl.nSlow","lbl.30"] <- 'link'
for(i in seq(tuples_nbr)) {
from_name <- tuples[[i]][1]
to_name <- tuples[[i]][2]
M[ to_name, from_name ] <- 1 # diagram package uses 'strings' like 'fw'
}
# M
net <- graph.adjacency(M, mode="directed", weighted=NULL, diag=TRUE)
opar <- par()
# set margins
par("mar")
par(mar=c(1,1,1,1))
par(ask=FALSE) # shut R up
plot.igraph(net,vertex.label=V(net)$name,
layout=layout.fruchterman.reingold,
vertex.label.color="black",
edge.color="black",
edge.width=E(net)$weight/3,
edge.arrow.size=0.5
)
# restore graphics parameters
#
owarn <- options("warn")
options(warn=-1)
# suppressWarnings(par(opar))
par(opar)
options(owarn)
}
#' @export
plot.strategy.exp <- function(strategy=NULL, envir = NULL) {
require(quantstrat)
require(igraph)
if(!is.null(envir)){
strategy <- get.strategy(strategy, envir = envir)
# if(inherits(strategy,"strategy")){
# strategy <- strategy
# } else {
# #assume it's a strategy 'handle'
# strategy <- getStrategy(strategy)
# }
}
indics <- getNodesIndicators(strategy) #, verbose = TRUE)
sigs <- getNodesSignals(strategy) #, verbose = TRUE)
rules <- getNodesRules(strategy)#, verbose = TRUE)
parsable_data <- c(indics, sigs, rules)
# create parsable_data_tuples
tuples <- getTuples(parsable_data)
tuples_nbr <- length(tuples)
# populate matrix by unique values
pduniq <- unique( unlist(parsable_data) )
node_nbr <- length(pduniq)
M <- matrix(nrow = node_nbr, ncol = node_nbr, byrow = TRUE, data = 0)
colnames(M) <- pduniq
rownames(M) <- pduniq
# M
# establish links e.g.: M["lbl.nSlow","lbl.30"] <- 'link'
for(i in seq(tuples_nbr)) {
from_name <- tuples[[i]][1]
to_name <- tuples[[i]][2]
M[ to_name, from_name ] <- 1 # diagram package uses 'strings' like 'fw'
}
# M
net <- graph.adjacency(M, mode="directed", weighted=NULL, diag=TRUE)
opar <- par()
# set margins
par("mar")
par(mar=c(1,1,1,1))
par(ask=FALSE) # shut R up
# plot.igraph(net,vertex.label=V(net)$name,
# layout=layout.fruchterman.reingold,
# vertex.label.color="black",
# edge.color="black",
# edge.width=E(net)$weight/3,
# edge.arrow.size=0.5
# )
# taken from http://kateto.net/network-visualization
# start ---
tkid <- tkplot(net,
edge.arrow.size=.8,
edge.color="orange",
vertex.color="orange",
vertex.frame.color="#cccccc",
vertex.label.color="black") # tkid is the id of the tkplot that will open
# l <- tkplot.getcoords(tkid) # grab the coordinates from tkplot
# plot(net, layout=l)
# end ---
# restore graphics parameters
#
owarn <- options("warn")
options(warn=-1)
# suppressWarnings(par(opar))
par(opar)
options(owarn)
}
if(0){
require(quantstrat)
require(igraph)
# plot.strategy(stratRSI)
# plot.strategy("luxor")
plot.strategy("pairStrat", envir = parent.frame())
# plot.strategy("stratRSI", envir = parent.frame())
strategy <- getStrategy("pairStrat", envir = parent.frame())
# strategy.st <- "luxor"
# strategy <- getStrategy(strategy.st)
demo(luxor.1.strategy.basic)
demo(rsi)
demo(faber)
demo(bee)
demo(rocema)
demo(pair_trade)
demo(macd)
strategy.st <- stratRSI
strategy.st <- "faber"
strategy <- getStrategy("stratRSI", envir = parent.frame())
strategy <- getStrategy("bee", envir = parent.frame())
strategy <- getStrategy("pairStrat", envir = parent.frame())
strategy <- getStrategy("macd")
strategy <- stratRSI
plot.strategy("luxor")
plot.strategy.exp("luxor")
# install.packages("tkplot")
# library(tkplot)
tkcreate(canvas, "text",
width/2, 25,
text="My title",
justify="center",
font=tcltk::tkfont.create(family="helvetica",size=20,weight="bold", color="red"))
tkid <- tkplot(net) #tkid is the id of the tkplot that will open
l <- tkplot.getcoords(tkid) # grab the coordinates from tkplot
plot(net, layout=l)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.