Skip to content

Commit

Permalink
Refactor dropTA to use panel functionality
Browse files Browse the repository at this point in the history
Since S4 method and chartSeries.chob are deprecated, dropTA, listTA and
get.chob functions are refactored to use panel functionality of
xts::plot.xts.

The way TAs are removed is based on which frame they are added to.
  • Loading branch information
erichung0404 committed Aug 8, 2016
1 parent 3f56737 commit 8fb26c5
Show file tree
Hide file tree
Showing 3 changed files with 28 additions and 17 deletions.
8 changes: 5 additions & 3 deletions R/TA.R
Original file line number Diff line number Diff line change
Expand Up @@ -286,9 +286,11 @@ function(type=c('chartSeries','barChart','candleChart')) {
}# }}}
# listTA {{{
`listTA` <-
function(dev) {
if(missing(dev)) dev <- dev.cur()
sapply(get.chob()[[dev]]@passed.args$TA,function(x) x@call)
function(chob) {
if(missing(chob)) chob <- get.chob()
# return function calls of addTA
chob$Env$call_list[-1]
#sapply(get.chob()[[dev]]@passed.args$TA,function(x) x@call)
} # }}}

chartNULL <- function(...) return(invisible(NULL))
2 changes: 1 addition & 1 deletion R/chob.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ function(x,pos)
`get.chob` <-
function()
{
x <- .chob$.chob
x <- xts:::.plotxtsEnv$.xts_chob
return(x)
#x <- get('.chob',as.environment("package:quantmod"))
#attr(x,'.Environment') <- NULL
Expand Down
35 changes: 22 additions & 13 deletions R/dropTA.R
Original file line number Diff line number Diff line change
Expand Up @@ -61,18 +61,15 @@ function(ta,pos,occ=1,dev) {
}

`dropTA` <-
function(ta,occ=1,dev,all=FALSE) {
function(ta,occ=1,chob,all=FALSE) {

if(all) return(do.call('dropTA', list(1:length(listTA()))))

if(missing(ta)) stop("no TA indicator specified")

# default to the current device if none specified
if(missing(dev)) dev <- dev.cur()
ta.list <- listTA(dev)

# get the current chob
lchob <- get.chob()[[dev]]
if(missing(chob)) chob <- get.chob()
ta.list <- listTA(chob)

sel.ta <- NULL

Expand All @@ -91,22 +88,34 @@ function(ta,occ=1,dev,all=FALSE) {
if(!is.na(which.ta)) {

# decrease window count if necessary
if(lchob@passed.args$TA[[which.ta]]@new)
lchob@windows <- lchob@windows - 1
#if([email protected]$TA[[which.ta]]@new)
# lchob@windows <- lchob@windows - 1

sel.ta <- c(sel.ta,which.ta)
} else {
stop("nothing to remove")
}
}

if(is.null(sel.ta)) stop("nothing to remove")

# remove TA from current list
lchob@passed.args$TA <- lchob@passed.args$TA[-sel.ta]
if(length(lchob@passed.args$TA) < 1)
lchob@passed.args$TA <- list()
ta.list <- ta.list[-sel.ta]
for(li in sel.ta) {
# number of actions of chartSeries object without TA is 9
frame <- attr(chob$Env$actions[[9 + sel.ta]], "frame")
if(abs(frame)==2)
chob$Env$actions[[9 + sel.ta]] <- NULL
else
chob$remove_frame(frame)
chob$Env$TA[[sel.ta]] <- NULL
ncalls <- length(chob$Env$call_list)
# plot.xts(...) is included in call_list but listTA() is not
chob$Env$call_list[1 + sel.ta] <- NULL
}

# redraw chart
do.call("chartSeries.chob",list(lchob))
chob

write.chob(lchob,lchob@device)
#write.chob(lchob,lchob@device)
}

0 comments on commit 8fb26c5

Please sign in to comment.