From 9839f7b673633117f6e89c95bc05db181be44678 Mon Sep 17 00:00:00 2001 From: Eric Hung Date: Fri, 15 Jul 2016 21:21:38 +0800 Subject: [PATCH 1/3] Refactor addVo to follow skeleton_TA As chartSeries is now a wrapper for chart_Series and chartSeries.chob is deprecated, code of add* functions that manipulate chob and chobTA objects breaks. So add* functions are refactored to use skeleton_TA structure to coordinate with chart_Series called by chartSeries. In addVo.R, however, quantmod::chartVo is untouched. A new chartVo is passed to lenv environment in addVo according to skeleton_TA structure. quantmod::chartVo will be deprecated. --- R/addVo.R | 149 ++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 99 insertions(+), 50 deletions(-) diff --git a/R/addVo.R b/R/addVo.R index 8187de3c..410aff2a 100644 --- a/R/addVo.R +++ b/R/addVo.R @@ -1,13 +1,81 @@ # addVo {{{ -`addVo` <- function(log.scale=FALSE) { - lchob <- get.current.chob() - x <- as.matrix(lchob@xdata) - if(!lchob@show.vol || !has.Vo(x)) - return(invisible(new('chobTA', new=FALSE, name="chartNULL", call=match.call()))) - - Volumes <- Vo(x) - max.vol <- max(Volumes,na.rm=TRUE) +`addVo` <- function(log.scale=FALSE, ...) { + lenv <- new.env() + + lenv$chartVo <- function(x, ...) { + xdata <- x$Env$xdata + xsubset <- x$Env$xsubset + vo <- x$Env$vo + + spacing <- x$Env$theme$spacing + width <- x$Env$theme$width + + x.range <- x$get_xlim() + x.range <- seq(x.range[1],x.range[2]*spacing) + + # multi.col <- x$Env$multi.col + color.vol <- x$Env$color.vol + log.scale <- ifelse(x$Env$log.scale,"y","") + + vol.scale <- x$Env$vol.scale + + x.pos <- 1 + spacing * (1:length(vo) - 1) + + bar.col <- if(x$Env$color.vol) { + x$Env$theme$bar.col + } else x$Env$theme$border.col + + border.col <- x$Env$theme$border.col + min.vol <- min(vo) + + if(x$Env$theme$thin) { + # plot thin volume bars if appropriate + segments(x.pos,min.vol,x.pos,vo,col=bar.col) + } else { + rect(x.pos-spacing/3,min.vol,x.pos+spacing/3,vo, + col=bar.col,border=border.col) + } + legend.text <- list(list( + legend=c(paste("Volume (",vol.scale[[2]],"):",sep=''),format(last(vo)*vol.scale[[1]],big.mark=',')), + text.col=c(x$Env$theme$fg, last(bar.col)) + )) + lc <- xts:::legend.coords("topleft", x$Env$xlim, range(vo)) + legend(x = lc$x, y = lc$y, + legend = c(paste("Volume (",vol.scale[[2]],"):",sep=''),format(last(x$Env$TA.values)*vol.scale[[1]],big.mark=',')), + text.col = c(x$Env$theme$fg, last(bar.col)), + xjust = lc$xjust, + yjust = lc$yjust, + bty = "n", + y.intersp=0.95) + } + + # map all passed args (if any) to 'lenv' environment + mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(...)), list(...)) + exp <- parse(text=gsub("list","chartVo",as.expression(substitute(list(x=current.chob(),...)))), + srcfile=NULL) + lchob <- current.chob() + xdata <- lchob$Env$vo + xsubset <- lchob$Env$xsubset + x <- lchob$Env$xdata + theme <- lchob$Env$theme + vo <- xdata[xsubset] + lenv$xdata <- xdata + + lenv$grid_lines <- function(xdata,x) { seq(0,1) } + # add inbox color + exp <- c(expression(rect(xlim[1], range(vo)[1], xlim[2], range(vo)[2],col=theme$fill)), + # add grid lines and left-side axis labels + expression(segments(xlim[1], y_grid_lines(range(vo)), xlim[2], + y_grid_lines(range(vo)), col = theme$grid, lwd = grid.ticks.lwd, + lty = 3), + text(xlim[1], y_grid_lines(range(vo)), y_grid_lines(range(TA.values)), + col = theme$labels, srt = theme$srt, + offset = 0.5, pos = 2, cex = theme$cex.axis, xpd = TRUE)), + # add border of plotting area + expression(rect(xlim[1], range(vo)[1], xlim[2], range(vo)[2],border=theme$labels)),exp) + + max.vol <- max(vo,na.rm=TRUE) vol.scale <- list(100, "100s") if (max.vol > 10000) vol.scale <- list(1000, "1000s") @@ -18,66 +86,47 @@ if (max.vol > 1e+07) vol.scale <- list(1e+06, "millions") - if(lchob@color.vol & is.OHLC(x)) { + if(lchob$Env$color.vol) { # calculate colors for bars, if applicable. Opens <- Op(x) Closes <- Cl(x) - if(lchob@multi.col) { + if(lchob$Env$multi.col) { # colored bars - 4 color last.Closes <- as.numeric(Lag(Closes)) last.Closes[1] <- Closes[1] bar.col <- ifelse(Opens < Closes, ifelse(Opens < last.Closes, - lchob@colors$dn.up.col, - lchob@colors$up.up.col), + lchob$Env$theme$dn.up.col, + lchob$Env$theme$up.up.col), ifelse(Opens < last.Closes, - lchob@colors$dn.dn.col, - lchob@colors$up.dn.col)) + lchob$Env$theme$dn.dn.col, + lchob$Env$theme$up.dn.col)) } else { # colored bars - 2 color bar.col <- ifelse(Opens < Closes, - lchob@colors$up.col, - lchob@colors$dn.col) + lchob$Env$theme$up.col, + lchob$Env$theme$dn.col) } # 1 color bars - } else bar.col <- ifelse(!is.null(lchob@colors$Vo.bar.col), - lchob@colors$Vo.bar.col,lchob@colors$border) - border.col <- ifelse(is.null(lchob@colors$border), - bar.col,lchob@colors$border) + } else bar.col <- ifelse(rep(!is.null(lchob$Env$theme$Vo.bar.col), NROW(x)), + lchob$Env$theme$Vo.bar.col,lchob$Env$theme$border) + border.col <- ifelse(rep(is.null(lchob$Env$theme$border),NROW(x)), + bar.col,lchob$Env$theme$border) - bar.col <- bar.col[lchob@xsubset] + bar.col <- bar.col[lchob$Env$xsubset] + + lchob$Env$theme$border.col <- border.col + lchob$Env$theme$bar.col <- bar.col - chobTA <- new("chobTA") - chobTA@new <- TRUE + lchob$Env$vol.scale <- vol.scale + lchob$Env$TA.values <- vo/vol.scale[[1]] - chobTA@TA.values <- (Volumes/vol.scale[[1]])[lchob@xsubset] - chobTA@name <- "chartVo" - chobTA@call <- match.call() + lchob$Env$theme$thin <- ifelse(lchob$Env$type %in% c('bars','matchsticks'),TRUE,FALSE) - 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, - vol.scale=vol.scale, - x.labels=lchob@x.labels, - log.scale=log.scale, - bar.col=bar.col,border.col=border.col, - time.scale=lchob@time.scale) - - chobTA@params$thin <- ifelse(lchob@type %in% c('bars','matchsticks'),TRUE,FALSE) - - 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) - } + lchob$add_frame(ylim=range(vo),asp=1) # need to have a value set for ylim + lchob$next_frame() + lchob$replot(exp,env=c(lenv, lchob$Env),expr=TRUE) + lchob } # }}} # chartVo {{{ `chartVo` <- From ddb677c34801300741161c63f6f6eb5c1c5fe09e Mon Sep 17 00:00:00 2001 From: Eric Hung Date: Tue, 26 Jul 2016 17:26:14 +0800 Subject: [PATCH 2/3] Fix y limit bug of subset series When subset is specified in chartSeries, addVo() doesn't apply correct subset volume to the chart. To fix this issue, subset setting is applied to chartVo function in chartSeries and pass subset volume to the environment. y-axis limit of the frame is expanded to reserve space from the top. --- R/addVo.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/addVo.R b/R/addVo.R index 410aff2a..931d50aa 100644 --- a/R/addVo.R +++ b/R/addVo.R @@ -60,20 +60,21 @@ x <- lchob$Env$xdata theme <- lchob$Env$theme vo <- xdata[xsubset] + lchob$Env$vo <- vo + yrange <- c(range(vo, na.rm=TRUE)[1], range(vo, na.rm=TRUE)[2] * 1.05) lenv$xdata <- xdata - lenv$grid_lines <- function(xdata,x) { seq(0,1) } # add inbox color - exp <- c(expression(rect(xlim[1], range(vo)[1], xlim[2], range(vo)[2],col=theme$fill)), + exp <- c(expression(yrange <- c(range(vo, na.rm=TRUE)[1], range(vo, na.rm=TRUE)[2] * 1.05), rect(xlim[1], yrange[1], xlim[2], yrange[2],col=theme$fill)), # add grid lines and left-side axis labels - expression(segments(xlim[1], y_grid_lines(range(vo)), xlim[2], - y_grid_lines(range(vo)), col = theme$grid, lwd = grid.ticks.lwd, + expression(segments(xlim[1], y_grid_lines(yrange), xlim[2], + y_grid_lines(yrange), col = theme$grid, lwd = grid.ticks.lwd, lty = 3), - text(xlim[1], y_grid_lines(range(vo)), y_grid_lines(range(TA.values)), + text(xlim[1], y_grid_lines(yrange), y_grid_lines(range(TA.values)), col = theme$labels, srt = theme$srt, offset = 0.5, pos = 2, cex = theme$cex.axis, xpd = TRUE)), # add border of plotting area - expression(rect(xlim[1], range(vo)[1], xlim[2], range(vo)[2],border=theme$labels)),exp) + expression(rect(xlim[1], yrange[1], xlim[2], yrange[2],border=theme$labels)),exp) max.vol <- max(vo,na.rm=TRUE) vol.scale <- list(100, "100s") @@ -123,7 +124,7 @@ lchob$Env$theme$thin <- ifelse(lchob$Env$type %in% c('bars','matchsticks'),TRUE,FALSE) - lchob$add_frame(ylim=range(vo),asp=1) # need to have a value set for ylim + lchob$add_frame(ylim=yrange, asp=1, fixed=TRUE) # need to have a value set for ylim lchob$next_frame() lchob$replot(exp,env=c(lenv, lchob$Env),expr=TRUE) lchob From 6f49edf2d1047fe28ed20c228de5fd70361d756b Mon Sep 17 00:00:00 2001 From: Eric Hung Date: Tue, 2 Aug 2016 16:57:20 +0800 Subject: [PATCH 3/3] Fix addVo() subsetting bug When reChart is called to draw subset volume, bar colors are wrong and subset functionality fails. The volume chart starts from the first day of the series no matter what subset period is specified. Pull out the panel settings from chartVo and wrap in expression. --- R/addVo.R | 111 ++++++++++++++++++++++++++---------------------------- 1 file changed, 54 insertions(+), 57 deletions(-) diff --git a/R/addVo.R b/R/addVo.R index 931d50aa..6ea6d7e9 100644 --- a/R/addVo.R +++ b/R/addVo.R @@ -6,27 +6,30 @@ lenv$chartVo <- function(x, ...) { xdata <- x$Env$xdata xsubset <- x$Env$xsubset - vo <- x$Env$vo + vo <- x$Env$vo[xsubset] spacing <- x$Env$theme$spacing width <- x$Env$theme$width - x.range <- x$get_xlim() - x.range <- seq(x.range[1],x.range[2]*spacing) + x.pos <- 1 + spacing * (1:NROW(vo) - 1) + xlim <- x$Env$xlim + ylim <- c(min(vo, na.rm=TRUE), max(vo, na.rm=TRUE) * 1.05) + theme <- x$Env$theme + + vol.scale <- x$Env$vol.scale + TA.values <- x$Env$TA.values + + thin <- theme$thin # multi.col <- x$Env$multi.col color.vol <- x$Env$color.vol log.scale <- ifelse(x$Env$log.scale,"y","") - vol.scale <- x$Env$vol.scale - - x.pos <- 1 + spacing * (1:length(vo) - 1) + bar.col <- if(color.vol) { + theme$bar.col + } else theme$border.col - bar.col <- if(x$Env$color.vol) { - x$Env$theme$bar.col - } else x$Env$theme$border.col - - border.col <- x$Env$theme$border.col + border.col <- theme$border.col min.vol <- min(vo) if(x$Env$theme$thin) { @@ -36,56 +39,40 @@ rect(x.pos-spacing/3,min.vol,x.pos+spacing/3,vo, col=bar.col,border=border.col) } - legend.text <- list(list( - legend=c(paste("Volume (",vol.scale[[2]],"):",sep=''),format(last(vo)*vol.scale[[1]],big.mark=',')), - text.col=c(x$Env$theme$fg, last(bar.col)) - )) - lc <- xts:::legend.coords("topleft", x$Env$xlim, range(vo)) - legend(x = lc$x, y = lc$y, - legend = c(paste("Volume (",vol.scale[[2]],"):",sep=''),format(last(x$Env$TA.values)*vol.scale[[1]],big.mark=',')), - text.col = c(x$Env$theme$fg, last(bar.col)), - xjust = lc$xjust, - yjust = lc$yjust, - bty = "n", - y.intersp=0.95) } # map all passed args (if any) to 'lenv' environment mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(...)), list(...)) exp <- parse(text=gsub("list","chartVo",as.expression(substitute(list(x=current.chob(),...)))), srcfile=NULL) + exp <- c(exp, expression( + lc <- xts:::legend.coords("topleft", xlim, range(vo,na.rm=TRUE)), + legend(x = lc$x, y = lc$y, + legend = c(paste("Volume (",vol.scale[[2]],"):",sep=''),format(last(TA.values)*vol.scale[[1]],big.mark=',')), + text.col = c(theme$fg, last(theme$bar.col)), + xjust = lc$xjust, + yjust = lc$yjust, + bty = "n", + y.intersp=0.95))) + exp <- c(expression( + # add inbox color + rect(xlim[1], c(min(vo,na.rm=TRUE), max(vo,na.rm=TRUE)*1.05)[1], xlim[2], c(min(vo,na.rm=TRUE), max(vo,na.rm=TRUE)*1.05)[2], col=theme$fill), + # add grid lines and left-side axis labels + segments(xlim[1], y_grid_lines(c(min(vo,na.rm=TRUE), max(vo,na.rm=TRUE)*1.05)), + xlim[2], y_grid_lines(c(min(vo,na.rm=TRUE), max(vo,na.rm=TRUE)*1.05)), + col = theme$grid, lwd = x$Env$grid.ticks.lwd, lty = 3), + text(xlim[1], y_grid_lines(c(min(vo,na.rm=TRUE), max(vo,na.rm=TRUE)*1.05)), y_grid_lines(range(TA.values, na.rm=TRUE)), + 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(vo,na.rm=TRUE), max(vo,na.rm=TRUE)*1.05)[1], xlim[2], c(min(vo,na.rm=TRUE), max(vo,na.rm=TRUE)*1.05)[2], border=theme$labels)), exp) + lchob <- current.chob() xdata <- lchob$Env$vo xsubset <- lchob$Env$xsubset x <- lchob$Env$xdata theme <- lchob$Env$theme vo <- xdata[xsubset] - lchob$Env$vo <- vo - yrange <- c(range(vo, na.rm=TRUE)[1], range(vo, na.rm=TRUE)[2] * 1.05) - lenv$xdata <- xdata - - # add inbox color - exp <- c(expression(yrange <- c(range(vo, na.rm=TRUE)[1], range(vo, na.rm=TRUE)[2] * 1.05), rect(xlim[1], yrange[1], xlim[2], yrange[2],col=theme$fill)), - # add grid lines and left-side axis labels - expression(segments(xlim[1], y_grid_lines(yrange), xlim[2], - y_grid_lines(yrange), col = theme$grid, lwd = grid.ticks.lwd, - lty = 3), - text(xlim[1], y_grid_lines(yrange), y_grid_lines(range(TA.values)), - col = theme$labels, srt = theme$srt, - offset = 0.5, pos = 2, cex = theme$cex.axis, xpd = TRUE)), - # add border of plotting area - expression(rect(xlim[1], yrange[1], xlim[2], yrange[2],border=theme$labels)),exp) - - max.vol <- max(vo,na.rm=TRUE) - vol.scale <- list(100, "100s") - if (max.vol > 10000) - vol.scale <- list(1000, "1000s") - if (max.vol > 1e+05) - vol.scale <- list(10000, "10,000s") - if (max.vol > 1e+06) - vol.scale <- list(1e+05, "100,000s") - if (max.vol > 1e+07) - vol.scale <- list(1e+06, "millions") if(lchob$Env$color.vol) { # calculate colors for bars, if applicable. @@ -108,23 +95,33 @@ lchob$Env$theme$up.col, lchob$Env$theme$dn.col) } - # 1 color bars - } else bar.col <- ifelse(rep(!is.null(lchob$Env$theme$Vo.bar.col), NROW(x)), + # 1 color bars + } else bar.col <- ifelse(rep(!is.null(lchob$Env$theme$Vo.bar.col), NROW(xdata[,1])), lchob$Env$theme$Vo.bar.col,lchob$Env$theme$border) - border.col <- ifelse(rep(is.null(lchob$Env$theme$border),NROW(x)), + border.col <- ifelse(rep(is.null(lchob$Env$theme$border),NROW(xdata[,1])), bar.col,lchob$Env$theme$border) - + bar.col <- bar.col[lchob$Env$xsubset] lchob$Env$theme$border.col <- border.col lchob$Env$theme$bar.col <- bar.col - + + lchob$Env$theme$thin <- ifelse(lchob$Env$type %in% c('bars','matchsticks'),TRUE,FALSE) + + max.vol <- max(vo,na.rm=TRUE) + vol.scale <- list(100, "100s") + if (max.vol > 10000) + vol.scale <- list(1000, "1000s") + if (max.vol > 1e+05) + vol.scale <- list(10000, "10,000s") + if (max.vol > 1e+06) + vol.scale <- list(1e+05, "100,000s") + if (max.vol > 1e+07) + vol.scale <- list(1e+06, "millions") lchob$Env$vol.scale <- vol.scale lchob$Env$TA.values <- vo/vol.scale[[1]] - - lchob$Env$theme$thin <- ifelse(lchob$Env$type %in% c('bars','matchsticks'),TRUE,FALSE) - lchob$add_frame(ylim=yrange, asp=1, fixed=TRUE) # need to have a value set for ylim + lchob$add_frame(ylim=c(min(vo, na.rm=TRUE), max(vo, na.rm=TRUE) * 1.05), asp=1, fixed=TRUE) # need to have a value set for ylim lchob$next_frame() lchob$replot(exp,env=c(lenv, lchob$Env),expr=TRUE) lchob