diff --git a/R/addCMO.R b/R/addCMO.R index fb0f5a2e..181fe681 100644 --- a/R/addCMO.R +++ b/R/addCMO.R @@ -3,47 +3,80 @@ `addCMO` <- function(n=14) { - lchob <- get.current.chob() - - x <- as.matrix(lchob@xdata) - - chobTA <- new("chobTA") - chobTA@new <- TRUE + lenv <- new.env() + lenv$chartCMO <- function(x, n) { + xdata <- x$Env$xdata + xsubset <- x$Env$xsubset + xx <- if(has.Cl(xdata)) { + Cl(xdata) + } else if(NCOL(xdata)==1) { + xdata + } else { + xdata[,1] + } + cmo <- CMO(xx,n=n)[xsubset] + spacing <- x$Env$theme$spacing + x.pos <- 1 + spacing * (1:NROW(cmo) - 1) + xlim <- x$Env$xlim + ylim <- c(-max(abs(cmo), na.rm = TRUE), + max(abs(cmo), na.rm = TRUE))*1.05 + theme <- x$Env$theme + + lines(x.pos, cmo, col = "#0033CC", lwd = 1, lend = 2) + } + mapply(function(name, value) { + assign(name, value, envir = lenv) + }, names(list(n = n)), list(n = n)) + exp <- parse(text = gsub("list", "chartCMO", as.expression(substitute(list(x = current.chob(), + n = n)))), srcfile = NULL) + exp <- c(exp, expression( + lc <- xts:::legend.coords("topleft", xlim, c(-max(abs(cmo), na.rm = TRUE),max(abs(cmo), na.rm = TRUE))*1.05), + legend(x = lc$x, y = lc$y, + legend = c(paste(legend, ":"), + paste(sprintf("%.3f",last(cmo)), sep = "")), + text.col = c(theme$fg, "#0033CC"), + xjust = lc$xjust, + yjust = lc$yjust, + bty = "n", + y.intersp=0.95))) + exp <- c(expression( + # add inbox color + rect(xlim[1], -max(abs(cmo), na.rm = TRUE)*1.05, xlim[2], max(abs(cmo), na.rm = TRUE)*1.05, col=theme$fill), + # add grid lines and left-side axis labels + segments(xlim[1], y_grid_lines(c(-max(abs(cmo), na.rm = TRUE),max(abs(cmo), na.rm = TRUE))*1.05), + xlim[2], y_grid_lines(c(-max(abs(cmo), na.rm = TRUE),max(abs(cmo), na.rm = TRUE))*1.05), + col = theme$grid, lwd = x$Env$grid.ticks.lwd, lty = 3), + text(xlim[1], y_grid_lines(c(-max(abs(cmo), na.rm = TRUE),max(abs(cmo), na.rm = TRUE))*1.05), y_grid_lines(c(-max(abs(cmo), na.rm = TRUE),max(abs(cmo), 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], -max(abs(cmo), na.rm = TRUE)*1.05, xlim[2], max(abs(cmo), na.rm = TRUE)*1.05, border=theme$labels), + segments(xlim[1], 0, xlim[2], 0, col = "#666666", lty = "dotted")), exp) + + lchob <- current.chob() + + x <- lchob$Env$xdata + xsubset <- lchob$Env$xsubset # needs to accept any arguments for x, not just close xx <- if(has.Cl(x)) { Cl(x) - } else if(is.null(dim(x))) { + } else if(NCOL(x)==1) { x } else { x[,1] } - cmo <- CMO(xx,n=n) - - chobTA@TA.values <- cmo[lchob@xsubset] - chobTA@name <- "chartCMO" - chobTA@call <- match.call() - chobTA@params <- list(xrange=lchob@xrange, - 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, - n=n) - 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) - } else { - return(chobTA) - } + cmo <- CMO(xx,n=n)[xsubset] + lchob$Env$cmo <- cmo + if(!is.character(legend) || legend == "auto") + lchob$Env$legend <- paste("Chande Momentum Oscillator (", n, ") ", sep="") + lchob$add_frame(ylim=c(-max(abs(cmo), na.rm = TRUE), + max(abs(cmo), na.rm = TRUE))*1.05,asp=1,fixed=TRUE) + lchob$next_frame() + lchob$replot(exp, env=c(lenv,lchob$Env), expr=TRUE) + lchob } #}}} # chartCMO {{{ `chartCMO` <-