diff --git a/R/addAroon.R b/R/addAroon.R index 8f54022d..c4067b5a 100644 --- a/R/addAroon.R +++ b/R/addAroon.R @@ -8,79 +8,143 @@ `addAroon` <- function (n = 20, ..., on = NA, legend = "auto") { - lchob <- get.current.chob() - x <- as.matrix(lchob@xdata) - x <- cbind(Hi(x),Lo(x)) - x <- aroon(HL = x, n = n)[,-3] - yrange <- NULL - chobTA <- new("chobTA") - if (NCOL(x) == 1) { - chobTA@TA.values <- x[lchob@xsubset] + lenv <- new.env() + lenv$chartAroon <- function(x, n, ..., on, legend) { + xdata <- x$Env$xdata + xsubset <- x$Env$xsubset + xdata <- cbind(Hi(xdata),Lo(xdata)) + Aroon <- aroon(HL=xdata,n=n)[xsubset,-3] + spacing <- x$Env$theme$spacing + x.pos <- 1 + spacing * (1:NROW(Aroon) - 1) + xlim <- x$Env$xlim + ylim <- c(0,100) + theme <- x$Env$theme + + lines(x.pos, Aroon[,1], col = theme$aroon$col$aroonUp, + lwd = 1, lend = 2, ...) + lines(x.pos, Aroon[,2], col = theme$aroon$col$aroonDn, + lwd = 1, lend = 2, ...) } - else chobTA@TA.values <- x[lchob@xsubset, ] - chobTA@name <- "chartTA" - if (any(is.na(on))) { - chobTA@new <- TRUE + if(!is.character(legend) || legend == "auto") + legend <- gsub("^add", "", deparse(match.call())) + mapply(function(name, value) { + assign(name, value, envir = lenv) + }, names(list(n = n, ..., on = on, legend = legend)), + list(n = n, ..., on = on, legend = legend)) + exp <- parse(text = gsub("list", "chartAroon", as.expression(substitute(list(x = current.chob(), + n = n, ..., on = on, legend = legend)))), srcfile = NULL) + exp <- c(exp, expression( + lc <- xts:::legend.coords("topleft", xlim, range(Aroon,na.rm=TRUE)), + legend(x = lc$x, y = lc$y, + legend = c(paste(legend, ":"), + paste("aroonUp :",format(last(Aroon[,1]),nsmall = 3L)), + paste("aroonDn :",format(last(Aroon[,2]),nsmall = 3L))), + text.col = c(theme$fg, theme$aroon$col$aroonUp, theme$aroon$col$aroonDn), + xjust = lc$xjust, + yjust = lc$yjust, + bty = "n", + y.intersp=0.95))) + exp <- c(expression( + # add inbox color + rect(xlim[1], 0, xlim[2], 100, col=theme$fill), + # add grid lines and left-side axis labels + segments(xlim[1], y_grid_lines(c(0, 100)), + xlim[2], y_grid_lines(c(0, 100)), + col = theme$grid, lwd = x$Env$grid.ticks.lwd, lty = 3), + text(xlim[1], y_grid_lines(c(0, 100)), y_grid_lines(c(0, 100)), + col = theme$labels, srt = theme$srt, + offset = 0.5, pos = 2, cex = theme$cex.axis, xpd = TRUE), + # add border of plotting area + rect(xlim[1], 0, xlim[2], 100, border=theme$labels)), exp) + + lchob <- current.chob() + if (is.null(lchob$Env$theme$aroon$col$arronUp)) { + lchob$Env$theme$aroon$col$aroonUp <- 3 + lchob$Env$theme$aroon$col$aroonDn <- 4 + } + xdata <- lchob$Env$xdata + xdata <- cbind(Hi(xdata),Lo(xdata)) + xsubset <- lchob$Env$xsubset + Aroon <- aroon(HL=xdata,n=n)[xsubset,-3] + lchob$Env$Aroon <- Aroon +# lenv$xdata <- structure(Aroon, .Dimnames = list(NULL, "aroon")) + if(is.na(on)) { + lchob$add_frame(ylim=c(0,100),asp=1,fixed=TRUE) + lchob$next_frame() } else { - chobTA@new <- FALSE - chobTA@on <- on + lchob$set_frame(sign(on)*(abs(on)+1L)) } - chobTA@call <- match.call() - legend.name <- gsub("^add", "", deparse(match.call())) - gpars <- c(list(...), list(col = 3:4))[unique(names(c(list(col = 3:4), - list(...))))] - chobTA@params <- list(xrange = lchob@xrange, yrange = yrange, - colors = lchob@colors, color.vol = lchob@color.vol, - multi.col = lchob@multi.col, - spacing = lchob@spacing, width = lchob@width, bp = lchob@bp, - x.labels = lchob@x.labels, time.scale = lchob@time.scale, - isLogical = is.logical(x), legend = legend, legend.name = legend.name, - pars = list(gpars)) - return(chobTA) + lchob$replot(exp, env=c(lenv,lchob$Env), expr=TRUE) + lchob } `addAroonOsc` <- function (n = 20, ..., on = NA, legend = "auto") { - lchob <- get.current.chob() - x <- as.matrix(lchob@xdata) - x <- cbind(Hi(x),Lo(x)) - x <- aroon(HL = x, n = n)[,3] - yrange <- NULL - chobTA <- new("chobTA") - if (NCOL(x) == 1) { - chobTA@TA.values <- x[lchob@xsubset] - } - else chobTA@TA.values <- x[lchob@xsubset, ] - chobTA@name <- "chartTA" - if (any(is.na(on))) { - chobTA@new <- TRUE + lenv <- new.env() + lenv$chartAroonOsc <- function(x, n, ..., on, legend) { + xdata <- x$Env$xdata + xsubset <- x$Env$xsubset + xdata <- cbind(Hi(xdata),Lo(xdata)) + AroonOsc <- aroon(HL=xdata,n=n)[xsubset,3] + spacing <- x$Env$theme$spacing + x.pos <- 1 + spacing * (1:NROW(AroonOsc) - 1) + xlim <- x$Env$xlim + ylim <- range(AroonOsc,na.rm=TRUE) + theme <- x$Env$theme + + lines(x.pos, AroonOsc, col = theme$aroon$col$aroonOsc, + lwd = 1, lend = 2, ...) } - else { - chobTA@new <- FALSE - chobTA@on <- on + if(!is.character(legend) || legend == "auto") + legend <- gsub("^addAroonOsc", "Aroon Oscillator", deparse(match.call())) + mapply(function(name, value) { + assign(name, value, envir = lenv) + }, names(list(n = n, ..., on = on, legend = legend)), + list(n = n, ..., on = on, legend = legend)) + exp <- parse(text = gsub("list", "chartAroonOsc", as.expression(substitute(list(x = current.chob(), + n = n, ..., on = on, legend = legend)))), srcfile = NULL) + exp <- c(exp, expression( + lc <- xts:::legend.coords("topleft", xlim, range(AroonOsc,na.rm=TRUE)), + legend(x = lc$x, y = lc$y, + legend = c(paste(legend, ":"), + paste(format(last(AroonOsc),nsmall = 3L))), + text.col = c(theme$fg, 4), + xjust = lc$xjust, + yjust = lc$yjust, + bty = "n", + y.intersp=0.95))) + exp <- c(expression( + # add inbox color + rect(xlim[1], c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc)*1.05)[1], xlim[2], c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc)*1.05)[2], col=theme$fill), + # add grid lines and left-side axis labels + segments(xlim[1], y_grid_lines(c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05)), + xlim[2], y_grid_lines(c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05)), + col = theme$grid, lwd = x$Env$grid.ticks.lwd, lty = 3), + text(xlim[1], y_grid_lines(c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05)), y_grid_lines(c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05)), + col = theme$labels, srt = theme$srt, + offset = 0.5, pos = 2, cex = theme$cex.axis, xpd = TRUE), + # add border of plotting area + rect(xlim[1], c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05)[1], xlim[2], c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05)[2], border=theme$labels)), exp) + + lchob <- current.chob() + if (is.null(lchob$Env$theme$aroon$col$aroonOsc)) { + lchob$Env$theme$aroon$col$aroonOsc <- 3 } - chobTA@call <- match.call() - legend.name <- gsub("^addAroonOsc", "Aroon Oscillator ", deparse(match.call())) - gpars <- c(list(...), list(col = 3:4))[unique(names(c(list(col = 3:4), - list(...))))] - chobTA@params <- list(xrange = lchob@xrange, yrange = yrange, - colors = lchob@colors, color.vol = lchob@color.vol, multi.col = lchob@multi.col, - spacing = lchob@spacing, width = lchob@width, bp = lchob@bp, - x.labels = lchob@x.labels, time.scale = lchob@time.scale, - isLogical = is.logical(x), legend = legend, legend.name = legend.name, - pars = list(gpars)) - if (is.null(sys.call(-1))) { - TA <- lchob@passed.args$TA - lchob@passed.args$TA <- c(TA, chobTA) - lchob@windows <- lchob@windows + ifelse(chobTA@new, 1, - 0) - do.call("chartSeries.chob", list(lchob)) - invisible(chobTA) + xdata <- lchob$Env$xdata + xdata <- cbind(Hi(xdata),Lo(xdata)) + xsubset <- lchob$Env$xsubset + AroonOsc <- aroon(HL=xdata,n=n)[xsubset,3] + lchob$Env$AroonOsc <- AroonOsc + if(is.na(on)) { + lchob$add_frame(ylim=c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05),asp=1,fixed=TRUE) + lchob$next_frame() } else { - return(chobTA) + lchob$set_frame(sign(on)*(abs(on)+1L)) } + lchob$replot(exp, env=c(lenv,lchob$Env), expr=TRUE) + lchob }