QuantMod getOptionChain “subscript out of bounds”

问题:

I am trying to use the function getOptionChain() from the QuantMod library to download option chains for VIX, SP500 and Eurostoxx 50 but the following doesn't work:

library(quantmod)
VIX.OPT <- getOptionChain("^VIX")

I'm getting this error:

Error in lapply(strsplit(opt, "<tr>"), function(.) gsub(",", "", gsub("N/A",  : 
  subscript out of bounds
In addition: Warning message:
In readLines(paste(paste("http://finance.yahoo.com/q/op?s", Symbols,  :
  incomplete final line found on 'http://finance.yahoo.com/q/op?s=^VIX+Options'

How can I fix this?

回答1:

I'm working on a patch for this. So far this works, but you must specify the opex date exactly (3rd friday of month).

Example calls:

getOptionChain("^VIX")
$calls
                   Strike  Bid  Ask Last   Vol     OI
VIX141119C00010000   10.0 7.10 7.40 7.10    18   1974
VIX141119C00010500   10.5 6.60 6.90 6.90   330    510
VIX141119C00011000   11.0 6.10 6.40 6.10   108   1469 ...

getOptionChain("^VIX", '2014-12-16') #note VIX dec expiry is NOT 12/19, weird
$calls
                   Strike  Bid  Ask Last   Vol     OI
VIX141217C00010000   10.0 7.10 7.40 7.50     1    964
VIX141217C00011000   11.0 6.20 6.40 6.53   100    673
VIX141217C00012000   12.0 5.20 5.40 5.50     4    873 ...

Format matches the old version (I THINK).

This patch introduces a new dependency on the rjson package.

To use the patch, install rjson (install.packages("rjson")) and then run the following from your R console AFTER loading quantmod:

getOptionChain.yahoo.patch <- function(Symbols, Exp, ...)
{
    library("XML")
    library("rjson")

    millisToDate <- function(x)
    {
        return (as.Date(x / 86400000, origin = "1970-01-01"))
    }

    dateToMillis <- function(x)
    {
        as.numeric(x+1) * 86400000  /1000
    }

    parse.expiry <- function(x) {
        if(is.null(x))
          return(NULL)

        if(is.character(x))
        {
            x <- as.Date(x)
        }

        if(inherits(x, "Date") || inherits(x, "POSIXt"))
          return(dateToMillis(x))

         return(NULL)
    }

    getOptionChainJson <- function(sym, Exp)
    {
      if(missing(Exp))
        {
            url <- paste("http://finance.yahoo.com/q/op?s",sym,sep="=")
            opt <- readLines(url)
        }
      else
        {   
            url <- paste("http://finance.yahoo.com/q/op?s=",sym,"&date=",parse.expiry(Exp),sep="")
            opt <- readLines(url)
        }

        opt <- opt[grep("percentChangeRaw", opt)]
        opt <- unlist(strsplit(opt, "<script>"))
        json <- opt[3]
        json <- gsub("<script>", "", json)
        json <- gsub("</script>", "", json)
        json <- gsub(";", "", json)
        json <- unlist(strsplit(json, "="))[4]

        j <- fromJSON(json)
        price <- j$models$applet_model$data$optionData$quote$regularMarketPrice
        calls <- j$models$applet_model$data$optionData$options$calls
        puts <- j$models$applet_model$data$optionData$options$puts
        return (list(calls=chainToDf(calls), puts=chainToDf(puts), price = price, sym = sym))
    }

    chainToDf <- function(theList)
    {
        x <- do.call(rbind.data.frame, theList)

        rownames(x) <- x$contractSymbol
        y <- x[,c("strike", "bid", "ask", "lastPrice", "volume", "openInterest")]
        theNames <- c("Strike", "Bid", "Ask", "Last", "Vol", "OI")
        names(y) <- theNames
        for(i in theNames)
        {
            y[,i] <- as.numeric(as.character(y[,i]))
        }

        #y$contractSymbol <- as.character(x$contractSymbol)
        #y$expiration <- millisToDate(as.numeric(as.character(x$expiration)) * 1000)

        return(y)
    }

    getOptionChainJson(Symbols, Exp)
}
assignInNamespace("getOptionChain.yahoo", getOptionChain.yahoo.patch, "quantmod")

回答2:

I haven't been able to find a working solution based on Yahoo's data. I'm still using QuantMod and Yahoo for stock data and now use Google for option chain data. Here's a first attempt at a working solution:

library(rjson)

getOptionChain <- function (symbol) {
  # symbol = "WMT"  

  url <- "https://www.google.com/finance/option_chain?q="
  # url <- paste(url, symbol, "&expd=15&expm=01&expy=2016&output=json", sep="")
  url <- paste(url, symbol, "&output=json", sep="")

  google.options.json <- readLines(url, warn = FALSE)

  options.json <- google.options.json
  options.json <- gsub("[{]", "{\"", options.json)
  options.json <- gsub("[:]", "\":", options.json)
  options.json <- gsub("[,] ", "$$$", options.json)
  options.json <- gsub("[,]", ",\"", options.json)
  options.json <- gsub("[,]\"[{]", ",{", options.json)
  options.json <- gsub("[$][$][$]", ", ", options.json)

  options.list <- fromJSON(options.json)

  #get the options chain without an expiry date and then determine longest option

  last.expiration <- length(options.list[["expirations"]])
  month <- sprintf("%02d", options.list[["expirations"]][[last.expiration]]$m)
  day <- sprintf("%02d", options.list[["expirations"]][[last.expiration]]$d )
  year <- options.list[["expirations"]][[last.expiration]]$y

  #now request option chain for the longest expiry

  url <- "https://www.google.com/finance/option_chain?q="
  url <- paste(url, symbol, "&expd=", day, "&expm=", month, "&expy=", year, "&output=json", sep="")

  google.options.json <- readLines(url, warn = FALSE)

  options.json <- google.options.json
  options.json <- gsub("[{]", "{\"", options.json)
  options.json <- gsub("[:]", "\":", options.json)
  options.json <- gsub("[,] ", "$$$", options.json)
  options.json <- gsub("[,]", ",\"", options.json)
  options.json <- gsub("[,]\"[{]", ",{", options.json)
  options.json <- gsub("[$][$][$]", ", ", options.json)

  options.list <- fromJSON(options.json)

  options <- ldply (options.list[["calls"]], data.frame)
  options <- rename(options, c("s" = "contract.name",
                     "p" = "price",
                     "b" = "bid", 
                     "a" = "ask",
                     "c" = "change",
                     "cp" = "change.percentage",
                     "oi" = "open.interest",
                     "vol" = "volume"))
  options <- options[c( "contract.name", 
                    "strike",
                    "price", 
                    "change", 
                    "change.percentage",
                    "bid", 
                    "ask", 
                    "volume",
                    "open.interest")]


  options$expiry <- paste(options.list[["expiry"]]$m, options.list[["expiry"]]$d, options.list[["expiry"]]$y, sep = "/")

  last.expiration <- length(options.list[["expirations"]])
  options$longest.available.expiry <- paste(options.list[["expirations"]][[last.expiration]]$m,
                       options.list[["expirations"]][[last.expiration]]$d, 
                       options.list[["expirations"]][[last.expiration]]$y, sep = "/")

  options$underlying.price <- options.list[["underlying_price"]]

  return(options)
}

回答3:

There is a mistake in your getOptionChain.yahoo.patch code. You are adding a day in dateToMillis which is wrong, or at least different from how the code worked before if I am not mistaken. should be:

dateToMillis <- function(x)
{
    as.numeric(x) * 86400000  /1000
}