From f7f62f41f8ddb6cdfb82872eb44679d5416b1d95 Mon Sep 17 00:00:00 2001 From: Eric Hung Date: Thu, 28 Jul 2016 19:02:36 +0800 Subject: [PATCH] Refactor addZigZag to follow skeleton_TA structure chartZigZag function is given to create zigzag based on skeleton_TA structure. --- R/addZigZag.R | 101 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 66 insertions(+), 35 deletions(-) diff --git a/R/addZigZag.R b/R/addZigZag.R index 7d18ae6d..b108ed09 100644 --- a/R/addZigZag.R +++ b/R/addZigZag.R @@ -8,44 +8,75 @@ function (change = 10, percent = TRUE, retrace = FALSE, lastExtreme = TRUE, ..., on = -1, legend = "auto") { - lchob <- get.current.chob() - x <- as.matrix(lchob@xdata) - x <- cbind(Hi(x),Lo(x)) - x <- ZigZag(HL = x, change = change, percent = percent, retrace = retrace, - lastExtreme = lastExtreme) - yrange <- NULL - chobTA <- new("chobTA") - if (NCOL(x) == 1) { - chobTA@TA.values <- x[lchob@xsubset] + lenv <- new.env() + lenv$chartZigZag <- function(x, change, percent, retrace, lastExtreme, ..., on, legend) { + xdata <- x$Env$xdata + xsubset <- x$Env$xsubset + xdata <- cbind(Hi(xdata),Lo(xdata)) + zigzag <- ZigZag(HL = xdata, change = change, percent = percent, retrace = retrace, + lastExtreme = lastExtreme)[xsubset] + spacing <- x$Env$theme$spacing + x.pos <- 1 + spacing * (1:NROW(zigzag) - 1) + xlim <- x$Env$xlim + ylim <- c(min(zigzag, na.rm=TRUE)*0.975, max(zigzag, na.rm=TRUE)*1.05) + theme <- x$Env$theme + + if(any(is.na(on))) { + legend.name <- c(paste(legend, ":"), + paste(format(last(na.omit(zigzag)),nsmall = 3L))) + text.col <- c(x$Env$theme$fg, 4) + # add inbox color + rect(xlim[1], ylim[1], xlim[2], ylim[2], col=theme$fill) + # add grid lines and left-side axis labels + segments(xlim[1], y_grid_lines(ylim), + xlim[2], y_grid_lines(ylim), + col = theme$grid, lwd = x$Env$grid.ticks.lwd, lty = 3) + text(xlim[1], y_grid_lines(ylim), y_grid_lines(ylim), + 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], ylim[1], xlim[2], ylim[2], border=theme$labels) + yjust <- 1 + } else { + ylim <- x$get_ylim()[[2]] + legend.name <- paste(legend, ":", format(last(na.omit(zigzag)),nsmall = 3L)) + text.col <- 4 + yjust <- 1.5 + } + lines(x.pos, zigzag, col = 4, lwd = 4, lend = 2, ...) + lc <- xts:::legend.coords("topleft", xlim, ylim) + legend(x = lc$x, y = lc$y, + legend = legend.name, + text.col = text.col, + xjust = lc$xjust, + yjust = yjust, + bty = "n", + y.intersp=0.95) } - else chobTA@TA.values <- x[lchob@xsubset, ] - chobTA@name <- "chartTA" + if(!is.character(legend) || legend == "auto") + legend <- gsub("^add", "", deparse(match.call())) + mapply(function(name, value) { + assign(name, value, envir = lenv) + }, names(list(change = change, percent = percent, retrace = retrace, lastExtreme = lastExtreme, ..., on = on, legend = legend)), + list(change = change, percent = percent, retrace = retrace, lastExtreme = lastExtreme, ..., on = on, legend = legend)) + exp <- parse(text = gsub("list", "chartZigZag", as.expression(substitute(list(x = current.chob(), + change = change, percent = percent, retrace = retrace, lastExtreme = lastExtreme, ..., on = on, legend = legend)))), srcfile = NULL) + lchob <- current.chob() + x <- lchob$Env$xdata + xsubset <- lchob$Env$xsubset + x <- cbind(Hi(x),Lo(x)) + zigzag <- ZigZag(HL = x, change = change, percent = percent, retrace = retrace, + lastExtreme = lastExtreme)[xsubset] + lchob$Env$zigzag <- zigzag + if (any(is.na(on))) { - chobTA@new <- TRUE - } - else { - chobTA@new <- FALSE - chobTA@on <- on - } - chobTA@call <- match.call() - legend.name <- gsub("^add", "", deparse(match.call())) - gpars <- c(list(...), list(col = 4, lwd = 3))[unique(names(c(list(col = 4, - lwd = 3), 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) + lchob$add_frame(ylim=c(min(zigzag, na.rm=TRUE)*0.975, + max(zigzag, 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 }