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.weyla...@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 <jspa...@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@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.
______________________________________________
R-help@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.
