[R] quantmod getOptionChain Not Work

[R. Michael Weylandt]

Sorry about that: two small mistakes and I imagine there are a few
more I've missed.  This should actually work:

###########################################


library(XML)

readYahooOptions <- function(Symbols, Exp, ...){
  parse.expiry <- function(x) {
    if(is.null(x))
      return(NULL)

    if(inherits(x, "Date") || inherits(x, "POSIXt"))
      return(format(x, "%Y-%m"))

    if (nchar(x) == 5L) {
      x <- sprintf(substring(x, 4, 5), match(substring(x,
                                                       1, 3),
month.abb), fmt = "20%s-%02i")
    }
    else if (nchar(x) == 6L) {
      x <- paste(substring(x, 1, 4), substring(x, 5, 6),
                 sep = "-")
    }
    return(x)
  }

  clean.opt.table <- function(tableIn){
    tableOut <- sapply(tableIn[,-2], function(x) as.numeric(gsub(",","",x)))
    rownames(tableOut) <- tableIn[,2]
    tableOut
  }

  if(missing(Exp))
    optURL <- paste(paste("http://finance.yahoo.com/q/op?s",Symbols,sep="="),"Options",sep="+")
  else
    optURL <- paste(paste("http://finance.yahoo.com/q/op?s=",Symbols,"&m=",parse.expiry(Exp),sep=""),"Options",sep="+")

  if(!missing(Exp) && is.null(Exp)) {
    optPage <- readLines(optURL)
    optPage <- optPage[grep("View By Expiration", optPage)]
    allExp <- gregexpr("m=", optPage)[[1]][-1] + 2
    allExp <- substring(optPage, allExp, allExp + 6)
    allExp <- allExp[seq_len(length(allExp)-1)] # Last one seems useless ?
    return(structure(lapply(allExp, readYahooOptions,
Symbols=Symbols), .Names=format(as.yearmon(allExp))))
  }

  stopifnot(require("XML"))

  optURL <- readHTMLTable(optURL)

  # Not smart to hard code these but it's a 'good-enough' hack for now
  # Also, what is table 9 on this page?

  list(calls = clean.opt.table(optURL[[10]]),
       puts = clean.opt.table(optURL[[14]]),
       symbol = Symbols)
}



On Fri, Mar 23, 2012 at 6:44 PM, R. Michael Weylandt
<michael.weylandt at gmail.com> wrote:
> I just got around to taking a look at this, but below is a fix. It
> seems like yahoo finance redesigned the page and rather than reparsing
> all their HTML, I'll use Duncan TL's XML package to make life happier.
> (I loathe HTML parsing....)
>
> This isn't thoroughly tested and it'll break if yahoo redesigns things
> again (I hardcode the table numbers for now) but it seems to work well
> enough. Let me know if you have any errors with it. If Jeff likes it,
> it should be a drop-in replacement for the getOptionChain.yahoo for
> quantmod with a name change.
>
> Feedback welcome,
>
> Michael
>
> #############################################
>
> library(XML)
>
> readYahooOptions <- function(Symbols, Exp, ...){
>  parse.expiry <- function(x) {
>    if(is.null(x))
>      return(NULL)
>
>    if(inherits(x, "Date") || inherits(x, "POSIXt"))
>      return(format(x, "%Y-%m"))
>
>    if (nchar(x) == 5L) {
>      x <- sprintf(substring(x, 4, 5), match(substring(x,
>                                                       1, 3),
> month.abb), fmt = "20%s-%02i")
>    }
>    else if (nchar(x) == 6L) {
>      x <- paste(substring(x, 1, 4), substring(x, 5, 6),
>                 sep = "-")
>    }
>    return(x)
>  }
>
>  clean.opt.table <- function(tableIn){
>    tableOut <- lapply(tableIn[,-2], function(x) as.numeric(gsub(",","",x)))
>    rownames(tableOut) <- tableIn[,2]
>  }
>
>  if(missing(Exp))
>    optURL <- paste(paste("http://finance.yahoo.com/q/op?s",Symbols,sep="="),"Options",sep="+")
>  else
>    optURL <- paste(paste("http://finance.yahoo.com/q/op?s=",Symbols,"&m=",parse.expiry(Exp),sep=""),"Options",sep="+")
>
>  if(!missing(Exp) && is.null(Exp)) {
>    optPage <- readLines(optURL)
>    optPage <- optPage[grep("View By Expiration", optPage)]
>    allExp <- gregexpr("m=", optPage)[[1]][-1] + 2
>    allExp <- substring(optPage, allExp, allExp + 6)
>    allExp <- allExp[seq_len(length(allExp)-1)] # Last one seems
> useless ? Always true?
>    return(structure(lapply(allExp, readYahooOptions,
> Symbols=Symbols), .Names=format(as.yearmon(allExp))))
>  }
>
>  stopifnot(require("XML"))
>
>  optURL <- readHTMLTable(optURL)
>
>  # Not smart to hard code these but it's a 'good-enough' hack for now
>  # Also, what is table 9 on this page?
>  CALLS <- optURL[[10]]
>  PUTS <- optURL[[14]]
>
>  list(calls = CALLS, puts = PUTS, symbol = Symbols)
> }
>
>
> ###########################################################
>
> On Sun, Mar 4, 2012 at 2:18 PM, Sparks, John James <jspark4 at uic.edu> wrote:
>> Dear R Helpers,
>>
>> I am still having trouble with the getOptionChain command in quantmod.  I
>> have the latest version of quantmod, etc. so I was under the impression
>> that the problem was solved with updates to the package.
>>
>> If someone could let me know what I need to install in order to make this
>> work, I would really appreciate it.
>>
>> My error message as session info are shown below.  Thanks a bunch.
>> --John Sparks
>>
>> R version 2.14.2 (2012-02-29)
>> Platform: i386-pc-mingw32/i386 (32-bit)
>>
>> locale:
>> [1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United
>> States.1252    LC_MONETARY=English_United States.1252 LC_NUMERIC=C
>> [5] LC_TIME=English_United States.1252
>>
>> attached base packages:
>> [1] stats     graphics  grDevices utils     datasets  methods   base
>>
>> other attached packages:
>> [1] pomp_0.40-2      deSolve_1.10-3   subplex_1.1-3    mvtnorm_0.9-9992
>> quantmod_0.3-17  TTR_0.21-0       xts_0.8-2        zoo_1.7-7
>> Defaults_1.1-1
>>
>> loaded via a namespace (and not attached):
>> [1] grid_2.14.2    lattice_0.20-0 tools_2.14.2
>>> AAPL.OPT<-getOptionChain("AAPL")
>> Error in puts[, 2] : incorrect number of dimensions
>>> AAPL.OPT<-getOptionChain("AAPL",NULL)
>> Error in puts[, 2] : incorrect number of dimensions
>>>
>>
>> ______________________________________________
>> R-help at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-help
>> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
>> and provide commented, minimal, self-contained, reproducible code.