From 435e7a33fc6f51f59373a04aeb7c44830dec811a Mon Sep 17 00:00:00 2001 From: Eric Hung Date: Sun, 14 Aug 2016 14:13:19 +0800 Subject: [PATCH] Update last price when subsetting Updating the last price displayed on chart when zoomChart is called to view subset series. --- R/addAroon.R | 6 +++--- R/addCLV.R | 2 +- R/addCMF.R | 4 ++-- R/addCMO.R | 2 +- R/addChaikin.R | 4 ++-- R/addEMV.R | 4 ++-- R/addKST.R | 14 ++++++-------- R/addMFI.R | 2 +- R/addOBV.R | 2 +- R/addSMI.R | 4 ++-- R/addTA.R | 16 ++++++++-------- R/addTDI.R | 4 ++-- R/addVo.R | 15 ++++++--------- R/addVolatility.R | 2 +- R/addWPR.R | 2 +- 15 files changed, 39 insertions(+), 44 deletions(-) diff --git a/R/addAroon.R b/R/addAroon.R index 89aecba4..4c73c090 100644 --- a/R/addAroon.R +++ b/R/addAroon.R @@ -37,8 +37,8 @@ function (n = 20, ..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, range(Aroon,na.rm=TRUE)), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste("aroonUp :",format(last(Aroon[,1]),nsmall = 3L)), - paste("aroonDn :",format(last(Aroon[,2]),nsmall = 3L))), + paste("aroonUp :",format(last(Aroon[xsubset,1]),nsmall = 3L)), + paste("aroonDn :",format(last(Aroon[xsubset,2]),nsmall = 3L))), text.col = c(theme$fg, theme$aroon$col$aroonUp, theme$aroon$col$aroonDn), xjust = lc$xjust, yjust = lc$yjust, @@ -112,7 +112,7 @@ function (n = 20, ..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, range(AroonOsc,na.rm=TRUE)), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste(format(last(AroonOsc),nsmall = 3L))), + paste(format(last(AroonOsc[xsubset]),nsmall = 3L))), text.col = c(theme$fg, 4), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addCLV.R b/R/addCLV.R index 3740b8ab..5be6c432 100644 --- a/R/addCLV.R +++ b/R/addCLV.R @@ -33,7 +33,7 @@ function (..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, range(clv,na.rm=TRUE)), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste(format(last(clv),nsmall = 3L))), + paste(format(last(clv[xsubset]),nsmall = 3L))), text.col = c(theme$fg, 5), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addCMF.R b/R/addCMF.R index 501a58c4..496a311d 100644 --- a/R/addCMF.R +++ b/R/addCMF.R @@ -31,8 +31,8 @@ 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)), + paste(sprintf("%.3f",last(cmf[xsubset])), sep = "")), + text.col = c(theme$fg, ifelse(last(cmf[xsubset]) > 0,theme$up.col,theme$dn.col)), xjust = lc$xjust, yjust = lc$yjust, bty = "n", diff --git a/R/addCMO.R b/R/addCMO.R index ba37ffe8..d76031e0 100644 --- a/R/addCMO.R +++ b/R/addCMO.R @@ -33,7 +33,7 @@ lc <- xts:::legend.coords("topleft", xlim, c(-max(abs(cmo), na.rm = TRUE),max(abs(cmo), na.rm = TRUE))*1.05), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste(sprintf("%.3f",last(cmo)), sep = "")), + paste(sprintf("%.3f",last(cmo[xsubset])), sep = "")), text.col = c(theme$fg, "#0033CC"), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addChaikin.R b/R/addChaikin.R index 86ebc846..e6307727 100644 --- a/R/addChaikin.R +++ b/R/addChaikin.R @@ -36,7 +36,7 @@ function (..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, range(ChaikinAD,na.rm=TRUE)), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste(format(last(ChaikinAD),nsmall = 3L))), + paste(format(last(ChaikinAD[xsubset]),nsmall = 3L))), text.col = c(theme$fg, theme$chaikin$col$chaikinad), xjust = lc$xjust, yjust = lc$yjust, @@ -108,7 +108,7 @@ function (n = 10, maType, ..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, range(ChaikinVol,na.rm=TRUE)), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste(format(last(ChaikinVol),nsmall = 3L))), + paste(format(last(ChaikinVol[xsubset]),nsmall = 3L))), text.col = c(theme$fg, theme$chaikin$col$chaikinvol), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addEMV.R b/R/addEMV.R index fdcb70a3..426dc890 100644 --- a/R/addEMV.R +++ b/R/addEMV.R @@ -44,8 +44,8 @@ function (volume, n = 9, maType, vol.divisor = 10000, ..., on = NA, lc <- xts:::legend.coords("topleft", xlim, range(emv,na.rm=TRUE)*1.05), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste("emv :", sprintf("%.3f",last(emv$emv))), - paste("maEMV :", sprintf("%.3f",last(emv$maEMV)))), + paste("emv :", sprintf("%.3f",last(emv$emv[xsubset]))), + paste("maEMV :", sprintf("%.3f",last(emv$maEMV[xsubset])))), text.col = c(theme$fg, 6, 7), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addKST.R b/R/addKST.R index 70dbe500..608ccb6e 100644 --- a/R/addKST.R +++ b/R/addKST.R @@ -13,10 +13,9 @@ function (n = c(10, 10, 10, 15), nROC = c(10, 15, 20, 30), nSig = 9, lenv$chartKST <- function(x, n, nROC, nSig, maType, wts, ..., on, legend) { xdata <- x$Env$xdata xsubset <- x$Env$xsubset - xdata <- xdata[xsubset] - xdata <- coredata(Cl(xdata)) + xdata <- Cl(xdata) kst <- KST(price = xdata, n = n, nROC = nROC, nSig = nSig, maType = maType, - wts = wts) + wts = wts)[xsubset] spacing <- x$Env$theme$spacing x.pos <- 1 + spacing * (1:NROW(kst) - 1) xlim <- x$Env$xlim @@ -42,8 +41,8 @@ function (n = c(10, 10, 10, 15), nROC = c(10, 15, 20, 30), nSig = 9, lc <- xts:::legend.coords("topleft", xlim, range(kst, na.rm=TRUE) * 1.05), legend(x = lc$x, y = lc$y, legend = c(legend, - paste("kst :",format(last(kst[,1]),nsmall = 3L)), - paste("signal :",format(last(kst[,2]),nsmall = 3L))), + paste("kst :",format(last(kst[xsubset,1]),nsmall = 3L)), + paste("signal :",format(last(kst[xsubset,2]),nsmall = 3L))), text.col = c(theme$fg, 6, 7), xjust = lc$xjust, yjust = lc$yjust, @@ -68,10 +67,9 @@ function (n = c(10, 10, 10, 15), nROC = c(10, 15, 20, 30), nSig = 9, lchob$Env$call_list[[ncalls + 1]] <- match.call() x <- lchob$Env$xdata xsubset <- lchob$Env$xsubset - x <- x[xsubset] - x <- coredata(Cl(x)) + x <- Cl(x) kst <- KST(price = x, n = n, nROC = nROC, nSig = nSig, maType = maType, - wts = wts) + wts = wts)[xsubset] lchob$Env$TA$kst <- kst if(is.na(on)) { lchob$add_frame(ylim=range(kst, na.rm=TRUE) * 1.05,asp=1,fixed=TRUE) diff --git a/R/addMFI.R b/R/addMFI.R index 1e7c420d..93fe15d5 100644 --- a/R/addMFI.R +++ b/R/addMFI.R @@ -34,7 +34,7 @@ function (n = 14, ..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, c(0,100)), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste(format(last(mfi),nsmall = 3L))), + paste(format(last(mfi[xsubset]),nsmall = 3L))), text.col = c(theme$fg, 8), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addOBV.R b/R/addOBV.R index 7d851e1c..df7d8596 100644 --- a/R/addOBV.R +++ b/R/addOBV.R @@ -35,7 +35,7 @@ function (..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, range(obv, na.rm=TRUE) * 1.05), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste(format(last(obv),nsmall = 3L))), + paste(format(last(obv[xsubset]),nsmall = 3L))), text.col = c(theme$fg, 4), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addSMI.R b/R/addSMI.R index 448845db..3f0922ad 100644 --- a/R/addSMI.R +++ b/R/addSMI.R @@ -49,12 +49,12 @@ pos = 4), text(0, max(abs(smi[,1]), na.rm = TRUE)*.9, - paste("\n\n\nSMI: ",sprintf("%.3f",last(smi[,1])), sep = ""), col = COLOR, + paste("\n\n\nSMI: ",sprintf("%.3f",last(smi[xsubset,1])), sep = ""), col = COLOR, pos = 4), text(0, max(abs(smi[,1]), na.rm = TRUE)*.9, paste("\n\n\n\n\nSignal: ", - sprintf("%.3f",last(smi[,2])), sep = ""), col = SIGNAL, + sprintf("%.3f",last(smi[xsubset,2])), sep = ""), col = SIGNAL, pos = 4))) exp <- c(expression( smi <- TA$smi, diff --git a/R/addTA.R b/R/addTA.R index e4da8501..4e5fd320 100644 --- a/R/addTA.R +++ b/R/addTA.R @@ -52,7 +52,7 @@ paste("Momentum (", n, "):"),col=theme$fg, pos=4), text(0, max(abs(mom),na.rm=TRUE) *.9, - paste("\n\n\n",sprintf("%.2f",last(mom)),sep=''), + paste("\n\n\n",sprintf("%.2f",last(mom[xsubset])),sep=''), col = COLOR, pos = 4))) exp <- c(expression( mom <- TA$mom, @@ -175,7 +175,7 @@ function(x) { paste("Commodity Channel Index (", n, ",", c,"):",sep=''),col=theme$fg,pos=4), text(0, max(abs(cci),na.rm=TRUE)*.9, - paste("\n\n\n",sprintf("%.2f",last(cci)),sep=''), col = 'red', + paste("\n\n\n",sprintf("%.2f",last(cci[xsubset])),sep=''), col = 'red', pos = 4))) exp <- c(expression( cci <- TA$cci, @@ -584,8 +584,8 @@ function(x) { col = theme$fg, pos = 4), text(0, max(abs(dpo), na.rm = TRUE)*.9, - paste("\n\n\n",sprintf("%.3f",last(na.omit(dpo))), sep = ""), - col = ifelse(last(na.omit(dpo)) > 0,theme$up.col,theme$dn.col), + paste("\n\n\n",sprintf("%.3f",last(na.omit(dpo[xsubset]))), sep = ""), + col = ifelse(last(na.omit(dpo[xsubset])) > 0,theme$up.col,theme$dn.col), pos = 4))) exp <- c(expression( @@ -721,7 +721,7 @@ function(x) { pos = 4), text(0, max(rsi,na.rm=TRUE)*.9, - paste("\n\n\n",sprintf("%.3f",last(rsi)), sep = ""), col = '#0033CC', + paste("\n\n\n",sprintf("%.3f",last(rsi[xsubset])), sep = ""), col = '#0033CC', pos = 4))) exp <- c(expression( rsi <- TA$rsi, @@ -1355,8 +1355,8 @@ function(x) { legend(lc$x, lc$y, legend=c(paste("Moving Average Convergence Divergence (", paste(fast,slow,signal,sep=','),"):", sep = ""), - paste("MACD:",sprintf("%.3f",last(macd[,1]))), - paste("Signal:",sprintf("%.3f",last(macd[,2])))), + paste("MACD:",sprintf("%.3f",last(macd[xsubset,1]))), + paste("Signal:",sprintf("%.3f",last(macd[xsubset,2])))), text.col=c(theme$fg, col[3], col[4]), xjust=lc$xjust, yjust=lc$yjust, @@ -1652,7 +1652,7 @@ function(x) { } # }}} # addPoints {{{ -`addPoints` <- function(x,y=NULL,type='p',pch=20, +`addPoints` <- function(x,y,type='p',pch=20, offset=1,col=2,bg=2,cex=1, on=1,overlay=TRUE) { diff --git a/R/addTDI.R b/R/addTDI.R index f26f5cb4..1a273399 100644 --- a/R/addTDI.R +++ b/R/addTDI.R @@ -35,8 +35,8 @@ function (n = 20, multiple = 2, ..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, range(tdi, na.rm=TRUE)*1.05), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - paste("tdi :",format(last(tdi[,1]),nsmall = 3L)), - paste("di :",format(last(tdi[,1]),nsmall = 3L))), + paste("tdi :",format(last(tdi[xsubset,1]),nsmall = 3L)), + paste("di :",format(last(tdi[xsubset,1]),nsmall = 3L))), text.col = c(theme$fg, 5, 6), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addVo.R b/R/addVo.R index f1984837..0b63c062 100644 --- a/R/addVo.R +++ b/R/addVo.R @@ -6,7 +6,7 @@ lenv$chartVo <- function(x, ...) { xdata <- x$Env$xdata xsubset <- x$Env$xsubset - vo <- x$Env$vo[xsubset] + vo <- x$Env$TA$vo[xsubset] spacing <- x$Env$theme$spacing width <- x$Env$theme$width @@ -16,9 +16,6 @@ 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 @@ -48,7 +45,7 @@ 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=',')), + legend = c(paste("Volume (",vol.scale[[2]],"):",sep=''),format(last(vo[xsubset])*vol.scale[[1]],big.mark=',')), text.col = c(theme$fg, last(theme$bar.col)), xjust = lc$xjust, yjust = lc$yjust, @@ -62,7 +59,7 @@ 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)), + text(xlim[1], y_grid_lines(c(min(vo,na.rm=TRUE), max(vo,na.rm=TRUE)*1.05)), y_grid_lines(range(vo, 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 @@ -76,7 +73,6 @@ x <- lchob$Env$xdata theme <- lchob$Env$theme vo <- xdata[xsubset] - lchob$Env$TA$vo <- vo if(lchob$Env$color.vol) { # calculate colors for bars, if applicable. @@ -121,9 +117,10 @@ 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$TA$vo <- 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$add_frame(ylim=c(min(lchob$Env$TA$vo, na.rm=TRUE), + max(lchob$Env$TA$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 diff --git a/R/addVolatility.R b/R/addVolatility.R index 11881bc4..2da6e2ef 100644 --- a/R/addVolatility.R +++ b/R/addVolatility.R @@ -34,7 +34,7 @@ function (n = 10, calc = "close", N = 260, ..., on = NA, legend = "auto") lc <- xts:::legend.coords("topleft", xlim, c(min(vol, na.rm=TRUE) * 0.95,max(vol, na.rm=TRUE) * 1.05)), legend(x = lc$x, y = lc$y, legend = c(paste(legend, ":"), - format(last(vol),nsmall = 3L)), + sprintf("%.3f",last(vol[xsubset]))), text.col = c(theme$fg, 8), xjust = lc$xjust, yjust = lc$yjust, diff --git a/R/addWPR.R b/R/addWPR.R index 80cc9c06..81c4ee75 100644 --- a/R/addWPR.R +++ b/R/addWPR.R @@ -41,7 +41,7 @@ pos = 4), text(0, max(abs(wpr), na.rm = TRUE)*.9, - paste("\n\n\n",sprintf("%.3f",last(wpr)), sep = ""), col = COLOR, + paste("\n\n\n",sprintf("%.3f",last(wpr[xsubset])), sep = ""), col = COLOR, pos = 4))) exp <- c(expression( wpr <- TA$wpr,