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

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


Для начала я загружаю первые 1000 URL-адресов:

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

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

Затем я использую код для очистки содержимого с этих URL-адресов:

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(), хотя результат тот же. Приветствуется любая помощь в решении проблем с подключением к серверу.


r asynchronous web-scraping xpath rcurl
person Aleksandr    schedule 15.02.2015    source источник
comment
Параллелизовать веб-запросы грубо, потому что вы забиваете чей-то сервер.   -  person hadley    schedule 18.02.2015
comment
Спасибо за ответ. Я заметил это, поэтому я ищу альтернативное решение, чтобы избежать такого поведения. Подход, когда каждый URL анализируется последовательно один за другим с определенным интервалом времени, сработал, хотя он неэффективен и требует много времени. Любая идея о том, как улучшить алгоритм с использованием подхода распараллеливания, будет высоко оценена.   -  person Aleksandr    schedule 18.02.2015

Ответы (1)


arrow_upward
2
arrow_downward

Я искал несколько минут и нашел ответ здесь (второй ответ) пустая строка

Вам нужно использовать

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 ссылок. Однако я не тестировал часть синтаксического анализа.

person BartekCh    schedule 17.02.2015
comment
Спасибо за ответ. Я пробовал закручивать часть, она работала только для небольшого размера выборки (число URL ‹ ~100). Функция разбора возвращает пустой список. Я считаю, что это из-за нескольких запросов к серверу. Я также попытался перейти на сервер и щелкнуть некоторые URL-адреса вручную после выполнения кода. В результате появилась капча, так что я думаю, что сервер отклоняет такие тяжелые запросы. Это может объяснить, почему функция синтаксического анализа возвращает пустую таблицу. - person Aleksandr; 17.02.2015
comment
Это работало для более длинных векторов URL для меня. Возможно, это как-то зависит от загрузки сервера или чего-то еще. Может быть, попробовать скручивать страницы по одной, с некоторым перерывом между ними (например, Sys.sleep(1+ runif(1)*4)), но тогда это займет гораздо больше времени. Вы должны быть терпеливым :) - person BartekCh; 19.02.2015
comment
Ну, всего около 140 тысяч URL-адресов, поэтому, если я включу system.sleep(), это займет пару дней, чтобы справиться с задачей. Еще одно решение в моем списке попыток — использовать разные прокси-серверы, которые будут меняться последовательно. - person Aleksandr; 19.02.2015
comment
Некоторое улучшение и немного другой подход решили мою проблему. curl <- getCurlHandle() curlSetOpt(proxy='127.0.0.1:9150',proxytype=5,curl=curl) html <- getURL(url=base,curl=curl, .opts = list(ssl.verifypeer = FALSE),followlocation=TRUE) doc <- htmlParse(html, encoding = "UTF-8") - person Aleksandr; 02.07.2015