Sử dụng parallelisation để cạo các trang web với R

Question

Tôi đang cố gắng loại bỏ một lượng lớn trang web để phân tích chúng sau này. Vì số lượng URL rất lớn nên tôi đã quyết định sử dụng gói parallel cùng với XML.

Cụ thể, tôi đang sử dụng chức năng htmlParse() từ XML, hoạt động tốt khi được sử dụng với sapply, nhưng tạo đối tượng trống của lớp HTMLInternalDocument khi được sử dụng với parSapply.

url1<- "http://forums.philosophyforums.com/threads/senses-of-truth-63636.html" 
url2<- "http://forums.philosophyforums.com/threads/the-limits-of-my-language-impossibly-mean-the-limits-of-my-world-62183.html" 
url3<- "http://forums.philosophyforums.com/threads/how-language-models-reality-63487.html" 

myFunction<- function(x){ 
cl<- makeCluster(getOption("cl.cores",detectCores())) 
ok<- parSapply(cl=cl,X=x,FUN=htmlParse) 
return(ok) 
} 

urls<- c(url1,url2,url3) 

#Works 
output1<- sapply(urls,function(x)htmlParse(x)) 
str(output1[[1]]) 
> Classes 'HTMLInternalDocument', 'HTMLInternalDocument', 'XMLInternalDocument', 'XMLAbstractDocument', 'oldClass' <externalptr> 
output1[[1]] 


#Doesn't work 
myFunction<- function(x){ 
cl<- makeCluster(getOption("cl.cores",detectCores())) 
ok<- parSapply(cl=cl,X=x,FUN=htmlParse) 
stopCluster(cl) 
return(ok) 
} 

output2<- myFunction(urls) 
str(output2[[1]]) 
> Classes 'HTMLInternalDocument', 'HTMLInternalDocument', 'XMLInternalDocument', 'XMLAbstractDocument', 'oldClass' <externalptr> 
output2[[1]] 
#empty 

Cảm ơn.

Answer 1

Bạn có thể sử dụng getURIAsynchronous từ gói Rcurl cho phép người gọi chỉ định nhiều URI để tải xuống cùng một lúc.

library(RCurl) 
library(XML) 
get.asynch <- function(urls){ 
    txt <- getURIAsynchronous(urls) 
    ## this part can be easily parallelized 
    ## I am juste using lapply here as first attempt 
    res <- lapply(txt,function(x){ 
    doc <- htmlParse(x,asText=TRUE) 
    xpathSApply(doc,"/html/body/h2[2]",xmlValue) 
    }) 
} 

get.synch <- function(urls){ 
    lapply(urls,function(x){ 
    doc <- htmlParse(x) 
    res2 <- xpathSApply(doc,"/html/body/h2[2]",xmlValue) 
    res2 
    })} 

Dưới đây một số điểm chuẩn cho 100 url bạn chia thời gian phân tích bởi một yếu tố của 2.

library(microbenchmark) 
uris = c("http://www.omegahat.org/RCurl/index.html") 
urls <- replicate(100,uris) 
microbenchmark(get.asynch(urls),get.synch(urls),times=1) 

Unit: seconds 
      expr  min  lq median  uq  max neval 
get.asynch(urls) 22.53783 22.53783 22.53783 22.53783 22.53783  1 
    get.synch(urls) 39.50615 39.50615 39.50615 39.50615 39.50615  1