Параллелизация для очистки веб-контента с помощью R

Question

Я пытаюсь очистить данные из сети, используя асинхронный подход, как упомянуто in this post. Вот URL, с которых я хочу очистить данные. Я хранил URL-адреса в list.Rdata файл. Ссылки можно скачать здесь: https://www.dropbox.com/s/wl2per5npuq5h8y/list.Rdata?dl=1.

Для начала я загрузить первые 1000 URLs:

library(RCurl) 
library(rvest) 
library(XML) 
library(httr) 
library(reshape2) 
library(reshape) 

load("list.Rdata") 
list <- list[1:1000] 
un <- unlist(list) 

Затем я использую код, чтобы скоблить содержание от того, что URLs:

get.asynch <- function(urls){ 
    txt <- getURIAsynchronous(urls) 
    doc <- htmlParse(txt,asText=TRUE,encoding = "UTF-8") 
    base <- xpathSApply(doc, "//table//tr//td",xmlValue) 
    # Pavadinimas 
    uab <- ifelse(length(xpathSApply(doc, "//head//title",xmlValue))==1,gsub(". Rekvizitai.lt","", xpathSApply(doc, "//head//title",xmlValue)), "-") 
    # Imones kodas 
    ik <- ifelse(is.na(agrep("Imones kodas",base))==TRUE, "-", base[agrep("Imones kodas",base)+1]) 
    # PVM kodas 
    pk <- ifelse(is.na(match("PVM kodas",base))==TRUE, "-", base[match("PVM kodas",base)+1]) 
    # Vadovas 
    vad <- ifelse(is.na(match("Vadovas",base))==TRUE, "-", base[match("Vadovas",base)+1]) 
    # Adresas 
    ad <- ifelse(is.na(match("Adresas",base))==TRUE, "-", base[match("Adresas",base)+1]) 
    # Telefonas 
    tel <- ifelse(is.na(match("Telefonas",base))==TRUE, "-", paste("http://rekvizitai.vz.lt", xpathSApply(doc, "//table//tr//td//@src")[1], sep ="")) 
    # Mobilusis 
    mob <- ifelse(is.na(match("Mobilusis",base))==TRUE, "-", paste("http://rekvizitai.vz.lt", xpathSApply(doc, "//table//tr//td//@src")[2], sep ="")) 
    # Tinklalapis 
    url <- ifelse(is.na(match("Tinklalapis",base))==TRUE, "-", gsub("\t","",base[match("Tinklalapis",base)+1])) 
    # Skype 
    sk <- ifelse(is.na(match("Skype",base))==TRUE, "-", base[match("Skype",base)+1]) 
    # Bankas 
    bnk <- ifelse(is.na(match("Bankas",base))==TRUE, "-", base[match("Bankas",base)+1]) 
    # Atsiskaitomoji saskaita 
    ats <- ifelse(is.na(match("Atsiskaitomoji saskaita",base))==TRUE, "-", base[match("Atsiskaitomoji saskaita",base)+1]) 
    # Darbo laikas 
    dl <- ifelse(is.na(match("Darbo laikas",base))==TRUE, "-", base[match("Darbo laikas",base)+1]) 
    # Darbuotojai 
    drb <- ifelse(is.na(match("Darbuotojai",base))==TRUE, "-", gsub("\\D","",base[match("Darbuotojai",base)+1])) 
    # SD draudejo kodas 
    sd <- ifelse(is.na(match("SD draudejo kodas",base))==TRUE, "-", base[match("SD draudejo kodas",base)+1]) 
    # Apyvarta (be PVM) 
    apv <- ifelse(is.na(match("Apyvarta (be PVM)",base))==TRUE, "-", base[match("Apyvarta (be PVM)",base)+1]) 
    # Transportas 
    trn <- ifelse(is.na(match("Transportas",base))==TRUE, "-", base[match("Transportas",base)+1]) 
    # Ivertinimas 
    iv <- ifelse(length(xpathSApply(doc, "//span[@class='average']", xmlValue)) !=0, xpathSApply(doc, "//span[@class='average']", xmlValue),"-") 
    # Vertintoju skaicius 
    vert <- ifelse(length(xpathSApply(doc, "//span[@class='votes']", xmlValue)) !=0, xpathSApply(doc, "//span[@class='votes']", xmlValue),"-") 
    # Veiklos sritys 
    veikl <-xpathSApply(doc,"//div[@class='floatLeft about']//a | //div[@class='floatLeft about half']//a | //div[@class='about floatLeft']//a", 
         xmlValue)[1] 
    # Lentele 
    df <- cbind(uab, ik, pk, vad, ad, tel, mob, url, sk, bnk, ats, dl, drb, sd, apv, trn, iv, vert, veikl) 
} 

Далее, я использую свою функцию для разбора содержимого и получить ошибку. Я уверен, что эта ошибка является результатом тяжелого запроса на сервер.

> system.time(table <- do.call(rbind,lapply(un,get.asynch))) 
Error in which(value == defs) : 
    argument "code" is missing, with no default Timing stopped at: 0.89 0.03 6.82 

Я ищу решения, чтобы избежать такого поведения. Я попробовал функцию Sys.sleep(), хотя результат тот же. Любая помощь в том, как преодолеть проблему подключения к серверу, будет приветствоваться.

Answer 1

Я искал в течение нескольких минут и нашел ответ здесь (второй ответ) R getURL() returning empty string

Вы должны использовать

txt <- getURIAsynchronous(un, .opts = curlOptions(followlocation = TRUE))

Существует еще одна проблема - вы на самом деле не сделайте это асинхронно. С lapply(un,get.asynch) вы отправляете URL-адреса на get.asynch по одному. Для этого вам понадобится что-то вроде get.asynch(un), но тогда вам придется переписать остальную часть кода. Я бы разделил его на две части: керлинг

txts <- getURIAsynchronous(un, .opts=curlOptions(followlocation = TRUE)) 

и разборе

parse <- function(txt) { 
    doc <- htmlParse(txt,asText=TRUE,encoding = "UTF-8") 
    base <- xpathSApply(doc, "//table//tr//td",xmlValue) 
    ... 
} 
table <- do.call(rbind, lapply(txts, parse)) 

Керлинг работал нормально для меня, по крайней мере, на первых 100 ссылок. Однако я не тестировал парсинг.