diff --git a/R/addCMF.R b/R/addCMF.R index 909ff27f..e6168314 100644 --- a/R/addCMF.R +++ b/R/addCMF.R @@ -2,41 +2,72 @@ # addCMF {{{ `addCMF` <- function(n=20) { - lchob <- get.current.chob() + lenv <- new.env() + lenv$chartCMF <- function(x, n) { + xdata <- x$Env$xdata + xsubset <- x$Env$xsubset + xdata <- cbind(Hi(xdata),Lo(xdata),Cl(xdata)) + vo <- x$Env$vo + cmf <- CMF(xdata,vo,n=n)[xsubset] + spacing <- x$Env$theme$spacing + x.pos <- 1 + spacing * (1:NROW(cmf) - 1) + xlim <- x$Env$xlim + ylim <- c(-max(abs(cmf), na.rm = TRUE), + max(abs(cmf), na.rm = TRUE))*1.05 + theme <- x$Env$theme - x <- as.matrix(lchob@xdata) - - chobTA <- new("chobTA") - chobTA@new <- TRUE - - xx <- if(is.OHLC(x)) { - cbind(Hi(x),Lo(x),Cl(x)) + cmf.positive <- ifelse(cmf >= 0,cmf,0) + cmf.negative <- ifelse(cmf < 0,cmf,0) + + polygon(c(x.pos,rev(x.pos)),cbind(cmf.positive,rep(0,length(cmf))),col=theme$up.col) + polygon(c(x.pos,rev(x.pos)),cbind(cmf.negative,rep(0,length(cmf))),col=theme$dn.col) + } + mapply(function(name, value) { + assign(name, value, envir = lenv) + }, names(list(n = n)), list(n = n)) + exp <- parse(text = gsub("list", "chartCMF", as.expression(substitute(list(x = current.chob(), + n = n)))), srcfile = NULL) + exp <- c(exp, expression( + lc <- xts:::legend.coords("topleft", xlim, c(-max(abs(cmf), na.rm = TRUE),max(abs(cmf), na.rm = TRUE))*1.05), + legend(x = lc$x, y = lc$y, + legend = c(paste(legend, ":"), + paste(sprintf("%.3f",last(cmf)), sep = "")), + text.col = c(theme$fg, ifelse(last(cmf) > 0,theme$up.col,theme$dn.col)), + xjust = lc$xjust, + yjust = lc$yjust, + bty = "n", + y.intersp=0.95))) + exp <- c(expression( + # add inbox color + rect(xlim[1], -max(abs(cmf), na.rm = TRUE)*1.05, xlim[2], max(abs(cmf), 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(cmf), na.rm = TRUE),max(abs(cmf), na.rm = TRUE))*1.05), + xlim[2], y_grid_lines(c(-max(abs(cmf), na.rm = TRUE),max(abs(cmf), 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(cmf), na.rm = TRUE),max(abs(cmf), na.rm = TRUE))*1.05), y_grid_lines(c(-max(abs(cmf), na.rm = TRUE),max(abs(cmf), 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(cmf), na.rm = TRUE)*1.05, xlim[2], max(abs(cmf), na.rm = TRUE)*1.05, border=theme$labels), + segments(xlim[1], 0, xlim[2], 0, col = "#999999")), exp) + + lchob <- current.chob() + xdata <- lchob$Env$xdata + xdata <- if(is.OHLC(xdata)) { + cbind(Hi(xdata),Lo(xdata),Cl(xdata)) } else stop("CMF only applicaple to HLC series") - - cmf <- CMF(xx,Vo(x),n=n) - - chobTA@TA.values <- cmf[lchob@xsubset] - chobTA@name <- "chartCMF" - 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) - } + xsubset <- lchob$Env$xsubset + vo <- lchob$Env$vo + + cmf <- CMF(xdata,vo,n=n)[xsubset] + lchob$Env$cmf <- cmf + if(!is.character(legend) || legend == "auto") + lchob$Env$legend <- paste("Chaikin Money Flow (", n, ")", sep="") + lchob$add_frame(ylim=c(-max(abs(cmf), na.rm = TRUE), + max(abs(cmf), na.rm = TRUE))*1.05,asp=1,fixed=TRUE) + lchob$next_frame() + lchob$replot(exp, env=c(lenv,lchob$Env), expr=TRUE) + lchob } #}}} # chartCMF {{{ `chartCMF` <-