[R-SIG-Finance] Using abline with chartSeries
Samo Pahor
samo.pahor at gmail.com
Thu Apr 19 14:53:58 CEST 2012
Hi,
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).
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.
I failed with this task. There are three problems with my attempts and the
code produced does not work:
- scoping of variables (resulting in Error: object ... not found)
- plotting to correct frame (on= )
- shrinking of some technical indicator drawn with add_TA on frame > 1
after lines are added
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.
Any hint what to change in order to solve at least scoping variable problem
(resulting in Error: object ... not found) highly appreciated.
Best,
Samo
# Here are graphics (mainly quantmod::chart_Series related) extension
functions like:
# - add_VerticalLine
# - add_HorizontalLine
# - add_Line
# - add_Text
#
###############################################################################
require(quantmod)
# xCoordinateOfLine is an xts series containing only dates where vertical
lines should be drawn
add_VerticalLine<-function(xCoordinatesOfLines, on=1, belowBar=FALSE,
howMuchBelow=0.999, ...) {
lenv <- new.env()
lenv$add_verticalline <- function(x, xCoordinatesOfLines, belowBar,
howMuchBelow, ...) {
xdata <- x$Env$xdata
xsubset <- x$Env$xsubset
xcoords <- seq(1:NROW(xdata[xsubset]))[index(xdata[xsubset]) %in%
index(xCoordinatesOfLines[xsubset])]
if (NROW(xcoords) > 0) {
if (belowBar) {
segments(xcoords,
rep(min(Lo(xdata[xsubset])), NROW(xcoords)),
xcoords,
howMuchBelow*Lo(xdata[xsubset])[index(xdata[xsubset]) %in%
index(xCoordinatesOfLines[xsubset])], ...) #rep(x$get_ylim()[[2]][2],
NROW(xcoords)), ...)
} else {
abline(v=xcoords, ...)
}
}
}
mapply(function(name, value) {assign(name,value,envir=lenv)},
names(list(xCoordinatesOfLines=xCoordinatesOfLines, belowBar=belowBar,
howMuchBelow=howMuchBelow,...)),
list(xCoordinatesOfLines=xCoordinatesOfLines, belowBar=belowBar,
howMuchBelow=howMuchBelow,...))
exp <- parse(text=gsub("list","add_verticalline",
as.expression(substitute(list(x=current.chob(),
xCoordinatesOfLines=xCoordinatesOfLines, belowBar=belowBar,
howMuchBelow=howMuchBelow, ...)))), srcfile=NULL)
plot_object <- current.chob()
lenv$xdata <- plot_object$Env$xdata
# TODO: what is correct frame number here?
plot_object$set_frame(2*on)
# plot_object$set_frame(sign(on)*abs(on)+1L)
plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
plot_object
}
#datesForLines <- c("2012-02-06", "2012-02-07")
#verticalLines <- xts(rep(1, length(datesForLines)), order.by
=as.Date(datesForLines))
#SPX <- getSymbols("^GSPC", from="2000-01-01", auto.assign=FALSE)
#chart_Series(SPX, subset="2012")
#abline(v=c((NROW(SPX["2012/"]) - 2), (NROW(SPX["2012/"]) - 1)), col='red',
lwd=2)
#add_VerticalLine(verticalLines, belowBar=TRUE, on=1, col=c('red', 'blue'),
lwd=2)
add_HorizontalLine<-function(yCoordinatesOfLines, on=1, ...) {
lenv <- new.env()
lenv$add_horizontalline <- function(x, yCoordinatesOfLines, ...) {
xdata <- x$Env$xdata
xsubset <- x$Env$xsubset
x0coords <- rep(1, NROW(yCoordinatesOfLines))
x1coords <- rep(NROW(xdata[xsubset]), NROW(yCoordinatesOfLines))
if ((NROW(x0coords) > 0) & (NROW(x1coords) > 0)) {
segments(x0coords,
yCoordinatesOfLines,
x1coords,
yCoordinatesOfLines, ...)
# abline(h=yCoordinatesOfLines, ...)
}
}
mapply(function(name, value) {assign(name,value,envir=lenv)},
names(list(yCoordinatesOfLines=yCoordinatesOfLines,...)),
list(yCoordinatesOfLines=yCoordinatesOfLines,...))
exp <- parse(text=gsub("list","add_horizontalline",
as.expression(substitute(list(x=current.chob(),
yCoordinatesOfLines=yCoordinatesOfLines, ...)))), srcfile=NULL)
plot_object <- current.chob()
# TODO: what is correct frame number here?
lenv$xdata <- plot_object$Env$xdata
# plot_object$set_frame(sign(on)*abs(on)+1L)
plot_object$set_frame(2*on)
plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
plot_object
}
#yCoordinatesForLines <- c(1270, 1320, 1350)
#
#SPX <- getSymbols("^GSPC", from="2000-01-01", auto.assign=FALSE)
#chart_Series(SPX, subset="2012/")
#add_HorizontalLine(yCoordinatesForLines, col=c('red', 'blue', 'green'),
lwd=2)
add_Line<-function(x0, y0, x1, y1, on=1, ...) {
lenv <- new.env()
lenv$add_line <- function(x, x0, y0, x1, y1, ...) {
xdata <- x$Env$xdata
xsubset <- x$Env$xsubset
x0coords <- seq(1:NROW(xdata[xsubset]))[index(xdata[xsubset]) %in%
index(x0[xsubset])]
x1coords <- seq(1:NROW(xdata[xsubset]))[index(xdata[xsubset]) %in%
index(x1[xsubset])]
# TODO: make sure you truncate x1coords so that, if we have x0coord
line should be drawn to last bar in subset
if ((NROW(x0coords) > 0) & (NROW(x1coords) > 0)) {
segments(x0coords,
y0[xsubset],
x1coords,
y1[xsubset], ...)
}
}
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,...))
exp <- parse(text=gsub("list","add_line",
as.expression(substitute(list(x=current.chob(),
x0=x0, y0=y0, x1=x1, y1=y1,
...)))), srcfile=NULL)
plot_object <- current.chob()
lenv$xdata <- plot_object$Env$xdata
# TODO: what is correct frame number here?
plot_object$set_frame(sign(on)*abs(on)+1L)
plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
plot_object
}
#SPX <- getSymbols("^GSPC", from="2000-01-01", auto.assign=FALSE)
#
#x0Dates <- c("2012-01-05", "2012-01-18")
#x1Dates <- c("2012-01-10", "2012-01-24")
#x0 <- xts(rep(1, length(x0Dates)), order.by=as.Date(x0Dates))
#y0 <- Cl(SPX[x0Dates])
#x1 <- xts(rep(1, length(x1Dates)), order.by=as.Date(x1Dates))
#y1 <- Cl(SPX[x1Dates])
#
#subset <- "2012-01-06/2012-01-22"
#
#chart_Series(SPX, subset=subset)
#add_Line.primitive(x0, y0, x1, y1, col=c('red', 'green'), lwd=2)
add_Text<-function(xTextCoordinates, yTextCoordinates, text, on=1, ...) {
lenv <- new.env()
lenv$add_text <- function(x, xTextCoordinates, yTextCoordinates, text,
...) {
xdata <- x$Env$xdata
xsubset <- x$Env$xsubset
xcoords <- seq(1:NROW(xdata[xsubset]))[index(xdata[xsubset]) %in%
index(xTextCoordinates[xsubset])]
if (NROW(xcoords) > 0) {
text(xcoords, yTextCoordinates[xsubset], text[subset], ...)
}
}
mapply(function(name, value) {assign(name,value,envir=lenv)},
names(list(xTextCoordinates=xTextCoordinates,
yTextCoordinates=yTextCoordinates, text=text,...)),
list(xTextCoordinates=xTextCoordinates, yTextCoordinates=yTextCoordinates,
text=text,...))
exp <- parse(text=gsub("list","add_text",
as.expression(substitute(list(x=current.chob(),
xTextCoordinates=xTextCoordinates, yTextCoordinates=yTextCoordinates,
text=text, ...)))), srcfile=NULL)
plot_object <- current.chob()
lenv$xdata <- plot_object$Env$xdata
# TODO: what is correct frame number here?
plot_object$set_frame(sign(on)*abs(on)+1L)
plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
plot_object
}
#textDates <- c("2012-01-05", "2012-01-18")
#textRaw <- c("Test 1", "Test 2")
#text <- xts(textRaw, order.by=as.Date(textDates))
#yTextCoordinates <- xts(Cl(SPX[textDates]), order.by=as.Date(textDates))
#
#subset <- "2012"
#
#SPX <- getSymbols("^GSPC", from="2000-01-01", auto.assign=FALSE)
#
#chart_Series(SPX, subset=subset)
#add_Text(text, yTextCoordinates, text, col=c('red', 'green'))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://stat.ethz.ch/pipermail/r-sig-finance/attachments/20120419/583008fb/attachment.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: quantmod_graphics_extesions.R
Type: application/octet-stream
Size: 6677 bytes
Desc: not available
URL: <https://stat.ethz.ch/pipermail/r-sig-finance/attachments/20120419/583008fb/attachment.obj>
More information about the R-SIG-Finance
mailing list