How to create a technical indicator in quantmod package

Question

I am new to R, and I have to face some problems creating a technical indicator. In particular, I want to create the Fibonacci indicator, which will be added to chartSeries and will consist of 5 horizontal lines. The data I work with is the stock closing price. Thus, the chart that I want to create will have one horizontal line at the point of maximum closing price, one horizontal line at the point of minimum closing price and three horizontal lines between the two previous ones. The code I wrote in order to take the five values ​​of the time series of stock closing prices is as follows:

 Fibonacci <- function(x) { x <- try.xts(x, error = as.matrix) n <- nrow(x) min <- runMin(x,n=n) max <- runMax(x,n=n) high <- 0.62*(max-min) + min middle <- 0.5*(max-min) + min low <- 0.38*(max-min) + min res <-cbind(na.spline(min),na.spline(max),na.spline(high), na.spline(middle),na.spline(low)) colnames(res)<- c("min","max","high","middle","low") reclass (res, x) } 

I also wrote the following code to add a technical indicator to the existing chartSeries chart of the chartSeries package:

 addFibonacci<- function(col = "red",overlay = TRUE){ stopifnot("package:TTR" %in% search() || require("TTR", quietly = TRUE)) lchob <- quantmod:::get.current.chob() x <- as.matrix( lchob@xdata ) chobTA <- new("chobTA") chobTA@new <- !overlay if (!is.OHLC(x)) stop("Fibonacci requires HL series") else { fibon <- Fibonacci(Cl(x)) } [e-mail] <- fibon[ lchob@xsubset ] chobTA@call <- match.call() chobTA@on <- 1 chobTA@params <- list(xrange = lchob@xrange , colors = lchob@colors , color.vol = [e-mail] , multi.col = [e-mail] , spacing = lchob@spacing , width = lchob@width , bp = lchob@bp , x.labels = [e-mail] , time.scale = [e-mail] , col = col) if (is.null(sys.call(-1))) { TA <- [e-mail] $TA [e-mail] $TA <- c(TA, chobTA) lchob@windows <- lchob@windows + ifelse( chobTA@new , 1, 0) chartSeries.chob <- quantmod:::chartSeries.chob do.call(chartSeries.chob, list(lchob)) invisible(chobTA) } else { return(chobTA) } } 

The problem is that the indicator is not added to the chart, and I also get the following error message:

 Error in do.call( [e-mail] $TA[[j]]@name, list( [e-mail] $TA[[j]])) : 'what' must be a character string or a function 

Any ideas for what I'm doing wrong?

Answer 1

Instead of writing the add* function from scratch, you can simply use newTA :

 > library(quantmod) > getSymbols("AAPL") [1] "AAPL" > addFibonacci <- newTA(Fibonacci,on=1) > chartSeries(AAPL, TA="addFibonacci()") Error in addFibonacci() : could not find function "get.current.chob" 

Hmm, apparently get.current.chob not exported ... that's good, we can just change the function ourselves. After calling addFibonacci <- newTA(Fibonacci,on=1) , addFibonacci is defined as:

 addFibonacci <- function (..., on = 1, legend = "auto") { #lchob <- get.current.chob() lchob <- quantmod:::get.current.chob() x <- as.matrix( lchob@xdata ) x <- Fibonacci(x = x) yrange <- NULL chobTA <- new("chobTA") if (NCOL(x) == 1) { [e-mail] <- x[ lchob@xsubset ] } else [e-mail] <- x[ lchob@xsubset , ] chobTA@name <- "chartTA" if (any(is.na(on))) { chobTA@new <- TRUE } else { chobTA@new <- FALSE chobTA@on <- on } chobTA@call <- match.call() legend.name <- gsub("^add", "", deparse(match.call())) gpars <- c(list(...), list())[unique(names(c(list(), list(...))))] chobTA@params <- list(xrange = lchob@xrange , yrange = yrange, colors = lchob@colors , color.vol = [e-mail] , multi.col = [e-mail] , spacing = lchob@spacing , width = lchob@width , bp = lchob@bp , x.labels = [e-mail] , time.scale = [e-mail] , isLogical = is.logical(x), legend = legend, legend.name = legend.name, pars = list(gpars)) if (is.null(sys.call(-1))) { TA <- [e-mail] $TA [e-mail] $TA <- c(TA, chobTA) lchob@windows <- lchob@windows + ifelse( chobTA@new , 1, 0) chartSeries.chob <- chartSeries.chob do.call("chartSeries.chob", list(lchob)) invisible(chobTA) } else { return(chobTA) } } 

And you can see where I replaced the call to get.current.chob() with quantmod:::get.current.chob() . Now it should work.

 chartSeries(AAPL, TA="addFibonacci()") 

Success!

Answer 2

While I was testing the Quantmod package, I was trying to test this example.
But I got a new error as shown below.

 > getSymbols("AAPL") [1] "AAPL" > chartSeries(AAPL, TA="addFibonacci()") Error in runMin(x, n = n) : ncol(x) > 1. runMin only supports univariate 'x' 

The source code I used is Joshua Ulrich's answer.
I wonder if this error is caused by a version difference.
my version of Quantmod is 0.4-14.

 library(quantmod) Fibonacci <- function(x) { x <- try.xts(x, error = as.matrix) n <- nrow(x) min <- runMin(x,n=n) max <- runMax(x,n=n) high <- 0.62*(max-min) + min middle <- 0.5*(max-min) + min low <- 0.38*(max-min) + min res <-cbind(na.spline(min),na.spline(max),na.spline(high), na.spline(middle),na.spline(low)) colnames(res)<- c("min","max","high","middle","low") reclass (res, x) } addFibonacci <- function (..., on = 1, legend = "auto") { #lchob <- get.current.chob() lchob <- quantmod:::get.current.chob() x <- as.matrix( lchob@xdata ) x <- Fibonacci(x = x) yrange <- NULL chobTA <- new("chobTA") if (NCOL(x) == 1) { [e-mail] <- x[ lchob@xsubset ] } else [e-mail] <- x[ lchob@xsubset , ] chobTA@name <- "chartTA" if (any(is.na(on))) { chobTA@new <- TRUE } else { chobTA@new <- FALSE chobTA@on <- on } chobTA@call <- match.call() legend.name <- gsub("^add", "", deparse(match.call())) gpars <- c(list(...), list())[unique(names(c(list(), list(...))))] chobTA@params <- list(xrange = lchob@xrange , yrange = yrange, colors = lchob@colors , color.vol = [e-mail] , multi.col = [e-mail] , spacing = lchob@spacing , width = lchob@width , bp = lchob@bp , x.labels = [e-mail] , time.scale = [e-mail] , isLogical = is.logical(x), legend = legend, legend.name = legend.name, pars = list(gpars)) if (is.null(sys.call(-1))) { TA <- [e-mail] $TA [e-mail] $TA <- c(TA, chobTA) lchob@windows <- lchob@windows + ifelse( chobTA@new , 1, 0) chartSeries.chob <- chartSeries.chob do.call("chartSeries.chob", list(lchob)) invisible(chobTA) } else { return(chobTA) } } getSymbols("AAPL") addFibonacci <- newTA(Fibonacci,on=1) chartSeries(AAPL, TA="addFibonacci()")