Pass function calls and indicator values to the environment

To coordinate with functions that manipulate TA such as swapTA(), moveTA() and dropTA(), TA values is passed to a new name list "TA" and function calls are passed to call_list.
joshuaulrich · Aug 12, 2016 · b68c0ea · b68c0ea
1 parent a4ee734
commit b68c0ea
Show file tree

Hide file tree

Showing 16 changed files with 289 additions and 86 deletions.
diff --git a/R/addAroon.R b/R/addAroon.R
@@ -45,6 +45,7 @@ function (n = 20, ..., on = NA, legend = "auto")
              bty = "n", 
              y.intersp=0.95)))
     exp <- c(expression(
+      Aroon <- TA$Aroon,
       # add inbox color
       rect(xlim[1], 0, xlim[2], 100, col=theme$fill),
       # add grid lines and left-side axis labels
@@ -58,6 +59,8 @@ function (n = 20, ..., on = NA, legend = "auto")
       rect(xlim[1], 0, xlim[2], 100, border=theme$labels)), exp)
 
     lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     if (is.null(lchob$Env$theme$aroon$col$arronUp)) {
       lchob$Env$theme$aroon$col$aroonUp <- 3
       lchob$Env$theme$aroon$col$aroonDn <- 4
@@ -66,7 +69,7 @@ function (n = 20, ..., on = NA, legend = "auto")
     xdata <- cbind(Hi(xdata),Lo(xdata))
     xsubset <- lchob$Env$xsubset
     Aroon <- aroon(HL=xdata,n=n)[xsubset,-3]
-    lchob$Env$Aroon <- Aroon
+    lchob$Env$TA$Aroon <- Aroon
 #    lenv$xdata <- structure(Aroon, .Dimnames = list(NULL, "aroon"))
     if(is.na(on)) {
       lchob$add_frame(ylim=c(0,100),asp=1,fixed=TRUE)
@@ -116,6 +119,7 @@ function (n = 20, ..., on = NA, legend = "auto")
              bty = "n", 
              y.intersp=0.95)))
     exp <- c(expression(
+      AroonOsc <- TA$AroonOsc,
       # add inbox color
       rect(xlim[1], c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc)*1.05)[1], xlim[2], c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc)*1.05)[2], col=theme$fill),
       # add grid lines and left-side axis labels
@@ -129,14 +133,16 @@ function (n = 20, ..., on = NA, legend = "auto")
       rect(xlim[1], c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05)[1], xlim[2], c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05)[2], border=theme$labels)), exp)
 
     lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     if (is.null(lchob$Env$theme$aroon$col$aroonOsc)) {
       lchob$Env$theme$aroon$col$aroonOsc <- 3
     }
     xdata <- lchob$Env$xdata
     xdata <- cbind(Hi(xdata),Lo(xdata))
     xsubset <- lchob$Env$xsubset
     AroonOsc <- aroon(HL=xdata,n=n)[xsubset,3]
-    lchob$Env$AroonOsc <- AroonOsc
+    lchob$Env$TA$AroonOsc <- AroonOsc
     if(is.na(on)) {
       lchob$add_frame(ylim=c(min(AroonOsc,na.rm=TRUE)*0.95, max(AroonOsc, na.rm=TRUE)*1.05),asp=1,fixed=TRUE)
       lchob$next_frame()

diff --git a/R/addCLV.R b/R/addCLV.R
@@ -40,6 +40,7 @@ function (..., on = NA, legend = "auto")
              bty = "n", 
              y.intersp=0.95)))
     exp <- c(expression(      
+      clv <- TA$clv,
       # add inbox color
       rect(xlim[1], range(clv, na.rm=TRUE)[1], xlim[2], range(clv, na.rm=TRUE)[2], col=theme$fill),
       # add grid lines and left-side axis labels
@@ -53,13 +54,15 @@ function (..., on = NA, legend = "auto")
       rect(xlim[1], range(clv, na.rm=TRUE)[1], xlim[2], range(clv, na.rm=TRUE)[2], border=theme$labels)), exp)
 
     lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     if (is.null(lchob$Env$theme$clv$col)) {
       lchob$Env$theme$clv$col <- 5
     }
     xdata <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
     clv <- CLV(HLC=HLC(xdata))[xsubset]
-    lchob$Env$clv <- clv
+    lchob$Env$TA$clv <- clv
     if(is.na(on)) {
       lchob$add_frame(ylim=range(clv,na.rm=TRUE),asp=1,fixed=TRUE)
       lchob$next_frame()

diff --git a/R/addCMF.R b/R/addCMF.R
@@ -38,6 +38,7 @@
            bty = "n", 
            y.intersp=0.95)))
   exp <- c(expression(    
+    cmf <- TA$cmf,
     # 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
@@ -52,6 +53,8 @@
     segments(xlim[1], 0, xlim[2], 0, col = "#999999")), exp)
 
   lchob <- current.chob()
+  ncalls <- length(lchob$Env$call_list)
+  lchob$Env$call_list[[ncalls + 1]] <- match.call()
   xdata <- lchob$Env$xdata
   xdata <- if(is.OHLC(xdata)) {
     cbind(Hi(xdata),Lo(xdata),Cl(xdata))
@@ -60,7 +63,7 @@
   vo <- lchob$Env$vo
 
   cmf <- CMF(xdata,vo,n=n)[xsubset]
-  lchob$Env$cmf <- cmf
+  lchob$Env$TA$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), 

diff --git a/R/addCMO.R b/R/addCMO.R
@@ -40,6 +40,7 @@
            bty = "n", 
            y.intersp=0.95)))
   exp <- c(expression(
+    cmo <- TA$cmo,
     # 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
@@ -54,6 +55,8 @@
     segments(xlim[1], 0, xlim[2], 0, col = "#666666", lty = "dotted")), exp)
 
   lchob <- current.chob()
+  ncalls <- length(lchob$Env$call_list)
+  lchob$Env$call_list[[ncalls + 1]] <- match.call()
 
   x <- lchob$Env$xdata
   xsubset <- lchob$Env$xsubset
@@ -69,7 +72,7 @@
   }
 
   cmo <- CMO(xx,n=n)[xsubset]
-  lchob$Env$cmo <- cmo
+  lchob$Env$TA$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), 

diff --git a/R/addChaikin.R b/R/addChaikin.R
@@ -43,6 +43,7 @@ function (..., on = NA, legend = "auto")
              bty = "n", 
              y.intersp=0.95)))
     exp <- c(expression(      
+      ChaikinAD <- TA$ChaikinAD,
       # add inbox color
       rect(xlim[1], range(ChaikinAD, na.rm=TRUE)[1], xlim[2], range(ChaikinAD, na.rm=TRUE)[2], col=theme$fill),
       # add grid lines and left-side axis labels
@@ -56,14 +57,16 @@ function (..., on = NA, legend = "auto")
       rect(xlim[1], range(ChaikinAD, na.rm=TRUE)[1], xlim[2], range(ChaikinAD, na.rm=TRUE)[2], border=theme$labels)), exp)
 
     lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     if (is.null(lchob$Env$theme$chaikin$col$chaikinad)) {
       lchob$Env$theme$chaikin$col$chaikinad <- 3
     }
     xdata <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
     vo <- lchob$Env$vo
     ChaikinAD <- chaikinAD(HLC = HLC(xdata), volume = vo)[xsubset]
-    lchob$Env$ChaikinAD <- ChaikinAD
+    lchob$Env$TA$ChaikinAD <- ChaikinAD
     if(is.na(on)) {
       lchob$add_frame(ylim=range(ChaikinAD,na.rm=TRUE),asp=1,fixed=TRUE)
       lchob$next_frame()
@@ -111,7 +114,8 @@ function (n = 10, maType, ..., on = NA, legend = "auto")
              yjust = lc$yjust, 
              bty = "n", 
              y.intersp=0.95)))
-    exp <- c(expression(      
+    exp <- c(expression(   
+      ChaikinVol <- TA$ChaikinVol,
       # add inbox color
       rect(xlim[1], range(ChaikinVol, na.rm=TRUE)[1], xlim[2], range(ChaikinVol, na.rm=TRUE)[2], col=theme$fill),
       # add grid lines and left-side axis labels
@@ -124,13 +128,15 @@ function (n = 10, maType, ..., on = NA, legend = "auto")
       # add border of plotting area
       rect(xlim[1], range(ChaikinVol, na.rm=TRUE)[1], xlim[2], range(ChaikinVol, na.rm=TRUE)[2], border=theme$labels)), exp)
     lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     if (is.null(lchob$Env$theme$chaikin$col$chaikinvol)) {
       lchob$Env$theme$chaikin$col$chaikinvol <- "#F5F5F5"
     }
     xdata <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
     ChaikinVol <- chaikinVolatility(HL = HLC(xdata)[,-3], n = n, maType = maType)[xsubset]
-    lchob$Env$ChaikinVol <- ChaikinVol
+    lchob$Env$TA$ChaikinVol <- ChaikinVol
     if(is.na(on)) {
       lchob$add_frame(ylim=range(ChaikinVol,na.rm=TRUE),asp=1,fixed=TRUE)
       lchob$next_frame()

diff --git a/R/addEMV.R b/R/addEMV.R
@@ -12,9 +12,9 @@ function (volume, n = 9, maType, vol.divisor = 10000, ..., on = NA,
     lenv$chartEMV <- function(x, volume, n, maType, vol.divisor, ..., on, legend) {
       xdata <- x$Env$xdata
       xsubset <- x$Env$xsubset
-      volume <- x$Env$volume
+      volume <- x$Env$TA$volume
       emv <- EMV(HL=HLC(xdata)[,-3], volume = volume, n = n, maType = maType, 
-                 on = on, legend = legend)[xsubset]
+                 legend = legend)[xsubset]
       spacing <- x$Env$theme$spacing
       x.pos <- 1 + spacing * (1:NROW(emv) - 1)
       xlim <- x$Env$xlim
@@ -24,6 +24,9 @@ function (volume, n = 9, maType, vol.divisor = 10000, ..., on = NA,
       lines(x.pos, emv$emv, col = 6, lwd = 1, lend = 2, ...)
       lines(x.pos, emv$maEMV, col = 7, lwd = 1, lend = 2, ...)
     }
+    lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     if(missing(volume)) volume <- lchob$Env$vo
     if(missing(maType)) maType <- "SMA"
     if(!is.character(legend) || legend == "auto")
@@ -49,6 +52,7 @@ function (volume, n = 9, maType, vol.divisor = 10000, ..., on = NA,
              bty = "n", 
              y.intersp=0.95)))
     exp <- c(expression(
+      emv <- TA$emv,
       # add inbox color
       rect(xlim[1], range(emv,na.rm=TRUE)[1]*1.05, xlim[2], range(emv,na.rm=TRUE)[2]*1.05, col=theme$fill),
       # add grid lines and left-side axis labels
@@ -61,13 +65,12 @@ function (volume, n = 9, maType, vol.divisor = 10000, ..., on = NA,
       # add border of plotting area
       rect(xlim[1], range(emv,na.rm=TRUE)[1]*1.05, xlim[2], range(emv,na.rm=TRUE)[2]*1.05, border=theme$labels)), exp)
 
-    lchob <- current.chob()
     xdata <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
     emv <- EMV(HL = HLC(xdata)[,-3], volume = volume, n = n, maType = maType, 
                vol.divisor = vol.divisor)[xsubset]
-    lchob$Env$emv <- emv
-    lchob$Env$volume <- volume
+    lchob$Env$TA$emv <- emv
+    lchob$Env$TA$volume <- volume
     if(is.na(on)) {
       lchob$add_frame(ylim=range(emv,na.rm=TRUE)*1.05,asp=1,fixed=TRUE)
       lchob$next_frame()

diff --git a/R/addKST.R b/R/addKST.R
@@ -50,6 +50,7 @@ function (n = c(10, 10, 10, 15), nROC = c(10, 15, 20, 30), nSig = 9,
              bty = "n", 
              y.intersp=0.95)))
     exp <- c(expression(
+      kst <- TA$kst,
       # add inbox color
       rect(xlim[1], range(kst, na.rm=TRUE)[1] * 1.05, xlim[2], range(kst, na.rm=TRUE)[2] * 1.05, col=theme$fill),
       # add grid lines and left-side axis labels
@@ -63,13 +64,15 @@ function (n = c(10, 10, 10, 15), nROC = c(10, 15, 20, 30), nSig = 9,
       rect(xlim[1], range(kst, na.rm=TRUE)[1] * 1.05, xlim[2], range(kst, na.rm=TRUE)[2] * 1.05, border=theme$labels)), exp)
 
     lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     x <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
     x <- x[xsubset]
     x <- coredata(Cl(x))
     kst <- KST(price = x, n = n, nROC = nROC, nSig = nSig, maType = maType, 
         wts = wts)
-    lchob$Env$kst <- kst
+    lchob$Env$TA$kst <- kst
     if(is.na(on)) {
       lchob$add_frame(ylim=range(kst, na.rm=TRUE) * 1.05,asp=1,fixed=TRUE)
       lchob$next_frame()

diff --git a/R/addMFI.R b/R/addMFI.R
@@ -41,6 +41,7 @@ function (n = 14, ..., on = NA, legend = "auto")
              bty = "n", 
              y.intersp=0.95)))
     exp <- c(expression(
+      mfi <- TA$mfi,
       # add inbox color
       rect(xlim[1], 0, xlim[2], 100, col=theme$fill),
       # add grid lines and left-side axis labels
@@ -54,12 +55,14 @@ function (n = 14, ..., on = NA, legend = "auto")
       rect(xlim[1], 0, xlim[2], 100, border=theme$labels)), exp)
 
     lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     x <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
     volume <- lchob$Env$vo
     x <- HLC(x)
     mfi <- MFI(HLC = x, volume = volume, n = n)[xsubset]
-    lchob$Env$mfi <- mfi
+    lchob$Env$TA$mfi <- mfi
     if(any(is.na(on))) {
       lchob$add_frame(ylim=c(0,100),asp=1,fixed=TRUE)
       lchob$next_frame()

diff --git a/R/addOBV.R b/R/addOBV.R
@@ -42,6 +42,7 @@ function (..., on = NA, legend = "auto")
              bty = "n", 
              y.intersp=0.95)))
     exp <- c(expression(
+      obv <- TA$obv,
       # add inbox color
       rect(xlim[1], range(obv, na.rm=TRUE)[1] * 1.05, xlim[2], range(obv, na.rm=TRUE)[2] * 1.05, col=theme$fill),
       # add grid lines and left-side axis labels
@@ -55,11 +56,13 @@ function (..., on = NA, legend = "auto")
       rect(xlim[1], range(obv, na.rm=TRUE)[1] * 1.05, xlim[2], range(obv, na.rm=TRUE)[2] * 1.05, border=theme$labels)), exp)
 
     lchob <- current.chob()
+    ncalls <- length(lchob$Env$call_list)
+    lchob$Env$call_list[[ncalls + 1]] <- match.call()
     x <- try.xts(lchob$Env$xdata, error=FALSE)
     xsubset <- lchob$Env$xsubset
     vo <- lchob$Env$vo
     obv <- OBV(price = Cl(x), volume = vo)[xsubset]
-    lchob$Env$obv <- obv
+    lchob$Env$TA$obv <- obv
     if(is.na(on)) {
       lchob$add_frame(ylim=range(obv, na.rm=TRUE) * 1.05 ,asp=1,fixed=TRUE)
       lchob$next_frame()

diff --git a/R/addSMI.R b/R/addSMI.R
@@ -57,6 +57,7 @@
                sprintf("%.3f",last(smi[,2])), sep = ""), col = SIGNAL, 
          pos = 4)))
   exp <- c(expression(
+    smi <- TA$smi,
     # add inbox color
     rect(xlim[1], -max(abs(smi[,1]), na.rm = TRUE)*1.05, xlim[2], max(abs(smi[,1]), na.rm = TRUE)*1.05, col=theme$fill),
     # add grid lines and left-side axis labels
@@ -70,6 +71,8 @@
     rect(xlim[1], -max(abs(smi[,1]), na.rm = TRUE)*1.05, xlim[2], max(abs(smi[,1]), na.rm = TRUE)*1.05, border=theme$labels)), exp)
 
   lchob <- current.chob()
+  ncalls <- length(lchob$Env$call_list)
+  lchob$Env$call_list[[ncalls + 1]] <- match.call()
 
   x <- lchob$Env$xdata
   xsubset <- lchob$Env$xsubset
@@ -84,7 +87,7 @@
 
   smi <- SMI(xx, n=n, nFast=fast,
              nSlow=slow, nSig=signal, maType=ma.type)[xsubset]
-  lchob$Env$smi <- smi
+  lchob$Env$TA$smi <- smi
 
   lchob$add_frame(ylim=c(-max(abs(smi[,1]), na.rm = TRUE), 
                          max(abs(smi[,1]), na.rm = TRUE))*1.05, asp=1, fixed=TRUE)