从雅虎财经拉动历史分析师意见R

Question

雅虎财经有data on historic analyst opinions股票。我感兴趣的是拉这个数据为R进行分析，这里是我到目前为止有：

getOpinions <- function(symbol) { 
    require(XML) 
    require(xts) 
    yahoo.URL <- "http://finance.yahoo.com/q/ud?" 
    tables <- readHTMLTable(paste(yahoo.URL, "s=", symbol, sep = ""), stringsAsFactors=FALSE) 
    Data <- tables[[11]] 
    Data$Date <- as.Date(Data$Date,'%d-%b-%y') 
    Data <- xts(Data[,-1],order.by=Data[,1]) 
    Data 
} 

getOpinions('AAPL') 

我很担心这个代码将打破，如果表中的位置（目前11）的变化，但我想不出一种优雅的方式来检测哪个表具有我想要的数据。我试过the solution posted here，但它似乎不适用于这个问题。

如果雅虎重新安排他们的网站，是否有更好的方式来刮取这种不太可能破坏的数据？

编辑：它看起来已经有一个包（fImport）在那里做这个。

library(fImport) 
yahooBriefing("AAPL") 

这里是他们的解决方案，它不返回XTS对象，可能会打破，如果页面布局的变化（在fImport的yahooKeystats功能已经损坏）：

function (query, file = "tempfile", source = NULL, save = FALSE, 
    try = TRUE) 
{ 
    if (is.null(source)) 
     source = "http://finance.yahoo.com/q/ud?s=" 
    if (try) { 
     z = try(yahooBriefing(query, file, source, save, try = FALSE)) 
     if (class(z) == "try-error" || class(z) == "Error") { 
      return("No Internet Access") 
     } 
     else { 
      return(z) 
     } 
    } 
    else { 
     url = paste(source, query, sep = "") 
     download.file(url = url, destfile = file) 
     x = scan(file, what = "", sep = "\n") 
     x = x[grep("Briefing.com", x)] 
     x = gsub("</", "<", x, perl = TRUE) 
     x = gsub("/", "/", x, perl = TRUE) 
     x = gsub(" class=.yfnc_tabledata1.", "", x, perl = TRUE) 
     x = gsub(" align=.center.", "", x, perl = TRUE) 
     x = gsub(" cell.......=...", "", x, perl = TRUE) 
     x = gsub(" border=...", "", x, perl = TRUE) 
     x = gsub(" color=.red.", "", x, perl = TRUE) 
     x = gsub(" color=.green.", "", x, perl = TRUE) 
     x = gsub("<.>", "", x, perl = TRUE) 
     x = gsub("<td>", "@", x, perl = TRUE) 
     x = gsub("<..>", "", x, perl = TRUE) 
     x = gsub("<...>", "", x, perl = TRUE) 
     x = gsub("<....>", "", x, perl = TRUE) 
     x = gsub("<table>", "", x, perl = TRUE) 
     x = gsub("<td nowrap", "", x, perl = TRUE) 
     x = gsub("<td height=....", "", x, perl = TRUE) 
     x = gsub("&amp;", "&", x, perl = TRUE) 
     x = unlist(strsplit(x, ">")) 
     x = x[grep("-...-[90]", x, perl = TRUE)] 
     nX = length(x) 
     x[nX] = gsub("@$", "", x[nX], perl = TRUE) 
     x = unlist(strsplit(x, "@")) 
     x[x == ""] = "NA" 
     x = matrix(x, byrow = TRUE, ncol = 9)[, -c(2, 4, 6, 8)] 
     x[, 1] = as.character(strptime(x[, 1], format = "%d-%b-%y")) 
     colnames(x) = c("Date", "ResearchFirm", "Action", "From", 
      "To") 
     x = x[nrow(x):1, ] 
     X = as.data.frame(x) 
    } 
    X 
} 

Answer 1

这里一个黑客，你可以使用。在您的功能中，添加以下内容

# GET THE POSITION OF TABLE WITH MAX. ROWS 
position = which.max(sapply(tables, NROW)) 
Data  = tables[[position]] 

只要页面上最长的表格是您所寻找的，就会工作。

如果你想多一点健壮，这里是另一种方法

# GET POSITION OF TABLE CONTAINING RESEARCH FIRM IN ITS NAMES 
position = sapply(tables, function(tab) 'Research Firm' %in% names(tab)) 
Data  = tables[position == TRUE]