Hi,<br><br>I am following the conversation in "Using abline with chartSeries" and " Modify the chart object to save plotted text" since I tried to do similar things (adding proper functions for add_Text, add_Line, add_HorizontalLine and add_VerticalLine that would use internal quantmod chob objects and environment and handle all the parameters correctly).<br>
<br>I have chosen the path suggested by Joshua and Brian in this thread. Attached please find my code (with commented "tests") as a result to add a few extensions.<br><br>I failed with this task. There are three problems with my attempts and the code produced does not work:<br>
- scoping of variables (resulting in Error: object ... not found)<br>- plotting to correct frame (on= )<br>- shrinking of some technical indicator drawn with add_TA on frame > 1 after lines are added<br>
<br>Since Stergios and Worik are better at using/understanding R than I am and they could get fixed what I tried to do since it also corresponds directly to their requirements I am "sharing" this.<br><br>Any hint what to change in order to solve at least scoping variable problem (resulting in Error: object ... not found) highly appreciated.<br>
<br>Best, <br>Samo<br><br># Here are graphics (mainly quantmod::chart_Series related) extension functions like:<br># - add_VerticalLine<br># - add_HorizontalLine<br># - add_Line<br># - add_Text<br>#<br>###############################################################################<br>
<br>require(quantmod)<br><br># xCoordinateOfLine is an xts series containing only dates where vertical lines should be drawn<br>add_VerticalLine<-function(xCoordinatesOfLines, on=1, belowBar=FALSE, howMuchBelow=0.999, ...) {<br>
lenv <- new.env()<br> lenv$add_verticalline <- function(x, xCoordinatesOfLines, belowBar, howMuchBelow, ...) {<br> xdata <- x$Env$xdata<br> xsubset <- x$Env$xsubset<br> xcoords <- seq(1:NROW(xdata[xsubset]))[index(xdata[xsubset]) %in% index(xCoordinatesOfLines[xsubset])]<br>
if (NROW(xcoords) > 0) {<br> if (belowBar) {<br> segments(xcoords,<br> rep(min(Lo(xdata[xsubset])), NROW(xcoords)),<br> xcoords,<br> howMuchBelow*Lo(xdata[xsubset])[index(xdata[xsubset]) %in% index(xCoordinatesOfLines[xsubset])], ...) #rep(x$get_ylim()[[2]][2], NROW(xcoords)), ...)<br>
} else {<br> abline(v=xcoords, ...)<br> }<br> }<br> }<br> mapply(function(name, value) {assign(name,value,envir=lenv)}, names(list(xCoordinatesOfLines=xCoordinatesOfLines, belowBar=belowBar, howMuchBelow=howMuchBelow,...)), list(xCoordinatesOfLines=xCoordinatesOfLines, belowBar=belowBar, howMuchBelow=howMuchBelow,...))<br>
exp <- parse(text=gsub("list","add_verticalline", as.expression(substitute(list(x=current.chob(),<br> xCoordinatesOfLines=xCoordinatesOfLines, belowBar=belowBar, howMuchBelow=howMuchBelow, ...)))), srcfile=NULL)<br>
plot_object <- current.chob()<br> lenv$xdata <- plot_object$Env$xdata<br> # TODO: what is correct frame number here?<br> plot_object$set_frame(2*on)<br># plot_object$set_frame(sign(on)*abs(on)+1L)<br>
plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)<br> plot_object<br>}<br><br>#datesForLines <- c("2012-02-06", "2012-02-07")<br><br>#verticalLines <- xts(rep(1, length(datesForLines)), <a href="http://order.by">order.by</a>=as.Date(datesForLines))<br>
<br>#SPX <- getSymbols("^GSPC", from="2000-01-01", auto.assign=FALSE)<br>#chart_Series(SPX, subset="2012")<br>#abline(v=c((NROW(SPX["2012/"]) - 2), (NROW(SPX["2012/"]) - 1)), col='red', lwd=2)<br>
#add_VerticalLine(verticalLines, belowBar=TRUE, on=1, col=c('red', 'blue'), lwd=2)<br><br>add_HorizontalLine<-function(yCoordinatesOfLines, on=1, ...) {<br> lenv <- new.env()<br> lenv$add_horizontalline <- function(x, yCoordinatesOfLines, ...) {<br>
xdata <- x$Env$xdata<br> xsubset <- x$Env$xsubset<br> <br> x0coords <- rep(1, NROW(yCoordinatesOfLines))<br> x1coords <- rep(NROW(xdata[xsubset]), NROW(yCoordinatesOfLines))<br>
<br> if ((NROW(x0coords) > 0) & (NROW(x1coords) > 0)) {<br> segments(x0coords,<br> yCoordinatesOfLines,<br> x1coords,<br> yCoordinatesOfLines, ...) <br>
# abline(h=yCoordinatesOfLines, ...)<br> }<br> }<br> mapply(function(name, value) {assign(name,value,envir=lenv)}, names(list(yCoordinatesOfLines=yCoordinatesOfLines,...)), list(yCoordinatesOfLines=yCoordinatesOfLines,...))<br>
exp <- parse(text=gsub("list","add_horizontalline", as.expression(substitute(list(x=current.chob(),<br> yCoordinatesOfLines=yCoordinatesOfLines, ...)))), srcfile=NULL)<br>
plot_object <- current.chob()<br> # TODO: what is correct frame number here?<br> lenv$xdata <- plot_object$Env$xdata<br># plot_object$set_frame(sign(on)*abs(on)+1L)<br> plot_object$set_frame(2*on)<br>
plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)<br> plot_object<br>}<br><br>#yCoordinatesForLines <- c(1270, 1320, 1350)<br>#<br>#SPX <- getSymbols("^GSPC", from="2000-01-01", auto.assign=FALSE)<br>
#chart_Series(SPX, subset="2012/")<br>#add_HorizontalLine(yCoordinatesForLines, col=c('red', 'blue', 'green'), lwd=2)<br><br>add_Line<-function(x0, y0, x1, y1, on=1, ...) {<br> lenv <- new.env()<br>
lenv$add_line <- function(x, x0, y0, x1, y1, ...) {<br> xdata <- x$Env$xdata<br> xsubset <- x$Env$xsubset<br> x0coords <- seq(1:NROW(xdata[xsubset]))[index(xdata[xsubset]) %in% index(x0[xsubset])]<br>
x1coords <- seq(1:NROW(xdata[xsubset]))[index(xdata[xsubset]) %in% index(x1[xsubset])]<br> <br> # TODO: make sure you truncate x1coords so that, if we have x0coord line should be drawn to last bar in subset<br>
<br> if ((NROW(x0coords) > 0) & (NROW(x1coords) > 0)) {<br> segments(x0coords,<br> y0[xsubset],<br> x1coords,<br> y1[xsubset], ...)<br>
}<br> }<br> mapply(function(name, value) {assign(name,value,envir=lenv)}, names(list(x0=x0, y0=y0, x1=x1, y1=y1,...)), list(x0=x0, y0=y0, x1=x1, y1=y1,...))<br> exp <- parse(text=gsub("list","add_line", as.expression(substitute(list(x=current.chob(),<br>
x0=x0, y0=y0, x1=x1, y1=y1, ...)))), srcfile=NULL)<br> plot_object <- current.chob()<br> lenv$xdata <- plot_object$Env$xdata<br> # TODO: what is correct frame number here?<br>
plot_object$set_frame(sign(on)*abs(on)+1L)<br> plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)<br> plot_object<br>}<br><br>#SPX <- getSymbols("^GSPC", from="2000-01-01", auto.assign=FALSE)<br>
#<br>#x0Dates <- c("2012-01-05", "2012-01-18")<br>#x1Dates <- c("2012-01-10", "2012-01-24")<br>#x0 <- xts(rep(1, length(x0Dates)), <a href="http://order.by">order.by</a>=as.Date(x0Dates))<br>
#y0 <- Cl(SPX[x0Dates])<br>#x1 <- xts(rep(1, length(x1Dates)), <a href="http://order.by">order.by</a>=as.Date(x1Dates))<br>#y1 <- Cl(SPX[x1Dates])<br>#<br>#subset <- "2012-01-06/2012-01-22"<br>#<br>#chart_Series(SPX, subset=subset)<br>
#add_Line.primitive(x0, y0, x1, y1, col=c('red', 'green'), lwd=2)<br><br>add_Text<-function(xTextCoordinates, yTextCoordinates, text, on=1, ...) {<br> lenv <- new.env()<br> lenv$add_text <- function(x, xTextCoordinates, yTextCoordinates, text, ...) {<br>
xdata <- x$Env$xdata<br> xsubset <- x$Env$xsubset<br> xcoords <- seq(1:NROW(xdata[xsubset]))[index(xdata[xsubset]) %in% index(xTextCoordinates[xsubset])]<br> <br> if (NROW(xcoords) > 0) {<br>
text(xcoords, yTextCoordinates[xsubset], text[subset], ...)<br> }<br> }<br> mapply(function(name, value) {assign(name,value,envir=lenv)}, names(list(xTextCoordinates=xTextCoordinates, yTextCoordinates=yTextCoordinates, text=text,...)), list(xTextCoordinates=xTextCoordinates, yTextCoordinates=yTextCoordinates, text=text,...))<br>
exp <- parse(text=gsub("list","add_text", as.expression(substitute(list(x=current.chob(),<br> xTextCoordinates=xTextCoordinates, yTextCoordinates=yTextCoordinates, text=text, ...)))), srcfile=NULL)<br>
plot_object <- current.chob()<br> lenv$xdata <- plot_object$Env$xdata<br> # TODO: what is correct frame number here?<br> plot_object$set_frame(sign(on)*abs(on)+1L)<br> plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)<br>
plot_object<br>}<br><br>#textDates <- c("2012-01-05", "2012-01-18")<br>#textRaw <- c("Test 1", "Test 2")<br>#text <- xts(textRaw, <a href="http://order.by">order.by</a>=as.Date(textDates))<br>
#yTextCoordinates <- xts(Cl(SPX[textDates]), <a href="http://order.by">order.by</a>=as.Date(textDates))<br>#<br>#subset <- "2012"<br>#<br>#SPX <- getSymbols("^GSPC", from="2000-01-01", auto.assign=FALSE)<br>
#<br>#chart_Series(SPX, subset=subset)<br>#add_Text(text, yTextCoordinates, text, col=c('red', 'green'))<br><br>