Извлечение исторических мнений аналитиков из Yahoo Yahoo в R - PullRequest
Новая
       74

Извлечение исторических мнений аналитиков из Yahoo Yahoo в R

4 голосов
/ 23 сентября 2011

Yahoo Finance располагает данными об исторических мнениях аналитиков по акциям.Я заинтересован в том, чтобы перенести эти данные в 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)изменения, но я не могу придумать элегантный способ определить, какая таблица содержит данные, которые я хочу.Я попробовал решение, опубликованное здесь , но, похоже, оно не работает для этой проблемы.

Есть ли лучший способ очистить эти данные, которые с меньшей вероятностью сломаются, если Yahoo повторноорганизует их сайт?

изменить: похоже, что уже есть пакет ( fImport ) для этого. 

library(fImport)
yahooBriefing("AAPL")

Вот их решение, которое нене возвращает объект xts и, вероятно, сломается при изменении макета страницы (функция yahooKeystats в fImport уже не работает): 

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
}

1 Ответ

3 голосов
/ 23 сентября 2011

Вот хак, который вы можете использовать. Внутри вашей функции добавьте следующее 

# 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]
...