Refactor addVo to follow skeleton_TA structure

R/addVo.R

@@ -1,83 +1,130 @@
 
 # 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)
-  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")
+`addVo` <- function(log.scale=FALSE, ...) {
+  lenv <- new.env()
 
-  if(lchob@color.vol & is.OHLC(x)) {
+  lenv$chartVo <- function(x, ...) {
+    xdata <- x$Env$xdata
+    xsubset <- x$Env$xsubset
+    vo <- x$Env$vo[xsubset]
+
+    spacing <- x$Env$theme$spacing
+    width <- x$Env$theme$width
+
+    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","")
+
+    bar.col <- if(color.vol) {
+      theme$bar.col
+    } else theme$border.col
+
+    border.col <- 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)
+    }
+  }
+
+  # 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]
+
+  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)
-
-  bar.col <- bar.col[lchob@xsubset]
-
-  chobTA <- new("chobTA")
-  chobTA@new <- TRUE
-
-  chobTA@TA.values <- (Volumes/vol.scale[[1]])[lchob@xsubset]
-  chobTA@name <- "chartVo"
-  chobTA@call <- match.call()
+    # 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(xdata[,1])),
+                       bar.col,lchob$Env$theme$border)
 
-  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)
-  } 
+  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$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
 } # }}}
 # chartVo {{{
 `chartVo` <-