2015-03-08 4 views
6

Я выскабливание http://www.progarchives.com/album.asp?id= и получить предупреждение:выскабливание .asp сайт с R

Warning message:
XML content does not seem to be XML:
http://www.progarchives.com/album.asp?id=2
http://www.progarchives.com/album.asp?id=3 http://www.progarchives.com/album.asp?id=4
http://www.progarchives.com/album.asp?id=5

Скребок работает для каждой страницы по отдельности, но не для URLs b1=2:b2=1000.

library(RCurl) 
library(XML) 

getUrls <- function(b1,b2){ 
    root="http://www.progarchives.com/album.asp?id=" 
    urls <- NULL 
    for (bandid in b1:b2){ 
    urls <- c(urls,(paste(root,bandid,sep=""))) 
    } 
    return(urls) 
} 

prog.arch.scraper <- function(url){ 
SOURCE <- getUrls(b1=2,b2=1000) 
PARSED <- htmlParse(SOURCE) 
album <- xpathSApply(PARSED,"//h1[1]",xmlValue) 
date <- xpathSApply(PARSED,"//strong[1]",xmlValue) 
band <- xpathSApply(PARSED,"//h2[1]",xmlValue) 
return(c(band,album,date)) 
} 

prog.arch.scraper(urls) 

ответ

6

Вот альтернативный подход с rvest и dplyr:

library(rvest) 
library(dplyr) 
library(pbapply) 

base_url <- "http://www.progarchives.com/album.asp?id=%s" 

get_album_info <- function(id) { 

    pg <- html(sprintf(base_url, id)) 
    data.frame(album=pg %>% html_nodes(xpath="//h1[1]") %>% html_text(), 
      date=pg %>% html_nodes(xpath="//strong[1]") %>% html_text(), 
      band=pg %>% html_nodes(xpath="//h2[1]") %>% html_text(), 
      stringsAsFactors=FALSE) 

} 

albums <- bind_rows(pblapply(2:10, get_album_info)) 

head(albums) 

## Source: local data frame [6 x 3] 
## 
##      album       date  band 
## 1     FOXTROT Studio Album, released in 1972 Genesis 
## 2    NURSERY CRYME Studio Album, released in 1971 Genesis 
## 3    GENESIS LIVE   Live, released in 1973 Genesis 
## 4  A TRICK OF THE TAIL Studio Album, released in 1976 Genesis 
## 5 FROM GENESIS TO REVELATION Studio Album, released in 1969 Genesis 
## 6   GRATUITOUS FLASH Studio Album, released in 1984 Abel Ganz 

Я не чувствовал, как barraging сайт с тонны Reqs так ударяться последовательность для вашего использования. pblapply дает вам свободный индикатор выполнения.

Чтобы быть добрым к сайту (esp, поскольку он явно не запрещает очищать), вы можете нажать Sys.sleep(10) в конце функции get_album_info.

UPDATE

Для обработки ошибок сервера (в данном случае 500, но она будет работать для других, тоже), вы можете использовать try:

library(rvest) 
library(dplyr) 
library(pbapply) 
library(data.table) 

base_url <- "http://www.progarchives.com/album.asp?id=%s" 

get_album_info <- function(id) { 

    pg <- try(html(sprintf(base_url, id)), silent=TRUE) 

    if (inherits(pg, "try-error")) { 
    data.frame(album=character(0), date=character(0), band=character(0)) 
    } else { 
    data.frame(album=pg %>% html_nodes(xpath="//h1[1]") %>% html_text(), 
       date=pg %>% html_nodes(xpath="//strong[1]") %>% html_text(), 
       band=pg %>% html_nodes(xpath="//h2[1]") %>% html_text(), 
       stringsAsFactors=FALSE) 
    } 

} 

albums <- rbindlist(pblapply(c(9:10, 23, 28, 29, 30), get_album_info)) 

##      album       date   band 
## 1: THE DANGERS OF STRANGERS Studio Album, released in 1988 Abel Ganz 
## 2: THE DEAFENING SILENCE Studio Album, released in 1994 Abel Ganz 
## 3:    AD INFINITUM Studio Album, released in 1998 Ad Infinitum 

Вы не получите какой-либо записи для ошибочных страниц (в этом случае он просто возвращает записи идентификатора 9, 10 и 30).

+0

Спасибо! Он работал, за исключением того, что я получаю сообщение об ошибке, говорящее, что нет функции '" bind_rows ". Я снова установил все пакеты, но все равно не повезло. – torentino

+0

'rbindlist' сделал трюк. Я уже давно хотел попасть в «rvest», чтобы ваш код заставил меня заглянуть в него более подробно. Спасибо @hrbrmstr. Еще один вопрос: что делает 'sprintf' фактически внутри функции html? – torentino

+0

Есть примерно 48 000 страниц, которые мне интересны, но я заметил, что скребок останавливается, когда дело касается сломанных страниц, т. Е. 'Внутренняя ошибка'. Один из способов борьбы с ними - проверить на каждой странице заметку, которые были разбиты, и объединить хорошие объекты внутри объекта «альбомы», но это требует много времени. Есть ли у вас предложения по работе со сломанными страницами? Приветствия. – torentino

4

Вместо xpathApply() вы можете подмножить первый узел в наборах узлов каждого пути и вызвать xmlValue(). Вот что я придумал,

library(XML) 
library(RCurl) 

## define the urls and xpath queries 
urls <- sprintf("http://www.progarchives.com/album.asp?id=%s", 2:10) 
path <- c(album = "//h1", date = "//strong", band = "//h2") 

## define a re-usable curl handle for the c-level nodes 
curl <- getCurlHandle() 
## allocate the result list 
out <- vector("list", length(urls)) 

## do the work  
for(u in urls) { 
    content <- getURL(u, curl = curl) 
    doc <- htmlParse(content, useInternalNodes = TRUE) 
    out[[u]] <- lapply(path, function(x) xmlValue(doc[x][[1]])) 
    free(doc) 
} 

## structure the result 
data.table::rbindlist(out) 
#       album       date  band 
# 1:     FOXTROT Studio Album, released in 1972 Genesis 
# 2:    NURSERY CRYME Studio Album, released in 1971 Genesis 
# 3:    GENESIS LIVE   Live, released in 1973 Genesis 
# 4:  A TRICK OF THE TAIL Studio Album, released in 1976 Genesis 
# 5: FROM GENESIS TO REVELATION Studio Album, released in 1969 Genesis 
# 6:   GRATUITOUS FLASH Studio Album, released in 1984 Abel Ganz 
# 7:   GULLIBLES TRAVELS Studio Album, released in 1985 Abel Ganz 
# 8: THE DANGERS OF STRANGERS Studio Album, released in 1988 Abel Ganz 
# 9:  THE DEAFENING SILENCE Studio Album, released in 1994 Abel Ganz 

Update: Для обработки запросов на id не существует, мы можем написать условие с RCurl::url.exists(), который обрабатывает плохие. Таким образом, следующая функция getAlbums() возвращает вектор символа либо полученных значений xml, либо NA, в зависимости от состояния URL-адреса. Вы можете это изменить, если хотите, конечно. Это был всего лишь метод, который приходил на ум в самые короткие часы.

getAlbums <- function(url, id = numeric(), xPath = list()) { 
    urls <- sprintf("%s?id=%d", url, id) 
    curl <- getCurlHandle() 
    out <- vector("list", length(urls)) 
    for(u in urls) { 
     out[[u]] <- if(url.exists(u)) { 
      content <- getURL(u, curl = curl) 
      doc <- htmlParse(content, useInternalNodes = TRUE) 
      lapply(path, function(x) xmlValue(doc[x][[1]])) 
     } else { 
      warning(sprintf("returning 'NA' for urls[%d] ", id[urls == u])) 
      structure(as.list(path[NA]), names = names(path)) 
     } 
     if(exists("doc")) free(doc) 
    } 
    data.table::rbindlist(out) 
} 

url <- "http://www.progarchives.com/album.asp" 
id <- c(9:10, 23, 28, 29, 30) 
path <- c(album = "//h1", date = "//strong", band = "//h2") 
getAlbums(url, id, path) 
#      album       date   band 
# 1: THE DANGERS OF STRANGERS Studio Album, released in 1988 Abel Ganz 
# 2: THE DEAFENING SILENCE Studio Album, released in 1994 Abel Ganz 
# 3:      NA        NA   NA 
# 4:      NA        NA   NA 
# 5:      NA        NA   NA 
# 6:    AD INFINITUM Studio Album, released in 1998 Ad Infinitum 
# 
# Warning messages: 
# 1: In albums(url, id, path) : returning 'NA' for urls[23] 
# 2: In albums(url, id, path) : returning 'NA' for urls[28] 
# 3: In albums(url, id, path) : returning 'NA' for urls[29] 
+0

@ Ричард Скривен. Благодаря! Это отлично работает, за исключением того, что я сталкиваюсь с той же проблемой, что и выше, с разбитыми ссылками. – torentino

+0

Работает! Спасибо за обновление и обработку ошибок. – torentino