R 中的 Apply 与 For 循环 [英] Apply vs For loop in R

问题描述

我编写了以下代码来每天从门户网站中删除招标信息.

I wrote the following code to scrap tendering information from a portal on daily basis.

packages <- c('rvest', 'stringi', 'tidyverse','lubridate','dplyr')
purrr::walk(packages, library, character.only = TRUE, warn.conflicts = FALSE)
start_time <- proc.time()

主页面报废并获得总记录数.

Main Page to scrap and get total no of records.

data <- read_html('https://eprocure.gov.in/mmp/latestactivetenders')
total_tenders_raw <- html_nodes(data,xpath = '//*[(@id = "table")]')
All_tenders <- data.frame(html_table(total_tenders_raw, header = TRUE))
links <- html_nodes(data, xpath='//*[(@id = "table")] | //td | //a')
links_fair <- html_attr(links,'href')
links_fair <- links_fair[grep("tendersfullview",links_fair)]
All_tenders <- cbind(All_tenders,links_fair)

读取要获取的记录总数

Count_of_Recs_raw <- html_nodes(data, xpath = '//*[(@id = "edit-l-active-teners")]//div')
Count_of_Recs <- as.numeric(gsub("Total Tenders : ","",html_text(Count_of_Recs_raw[1])))

用于清理和处理日期和因子等数据字段的函数.

Functions for cleaning and processing data fields like dates and Factors.

process_dates <- function(data){
    cols2date <- c('Bid.Submission.Closing.Date','epublished_date','document_download_start_date','bid_submission_start_date','bid_opening_date','document_download_end_date','bid_submission_end_date')
    date_processed_data <- data
    date_processed_data[cols2date] <- lapply(data[cols2date] , dmy_hm)
    return(date_processed_data)
}

clean_process_data <- function(data){
    cols2factor <- c('State.Name','product_category','pre_qualification','organisation_name','organisation_type','tender_type')
    clean_processed_data <- data
    clean_processed_data[cols2factor] <- lapply(data[cols2factor] , factor)
   #clean_processed_data <- process_dates(clean_processed_data)
    return(clean_processed_data)

}

下面的代码正是我的问题所在......

表格整理从这里开始.第一页已经报废得到数据框的结构.

The code below is where precisely my question lies...

Table Scrapping starts here. Page one has already been scrapped to get the structure of the data frame.

for (page_no in 2:round(Count_of_Recs/10)){
    closeAllConnections()
    on.exit(closeAllConnections())
    url_bit1 <- 'https://eprocure.gov.in/mmp/latestactivetenders/page='
    url <- paste(url_bit1, page_no, sep="")
    cat(page_no,"\t",proc.time() - start_time,"\n")
    data <- read_html(url)
    total_tenders_raw <- html_nodes(data,xpath = '//*[(@id = "table")]')
    Page_tenders <- data.frame(html_table(total_tenders_raw, header = TRUE))
    links <- html_nodes(data, xpath='//*[(@id = "table")] | //td | //a')
    links_fair <- html_attr(links,'href')
    links_fair <- links_fair[grep("tendersfullview",links_fair)]
    Page_tenders <- cbind(Page_tenders,links_fair)
    All_tenders <- rbind(All_tenders,Page_tenders)
 }

这个 for 循环通常需要几个小时才能完成.我正在寻找使用 apply 系列以节省时间的良好效果.该程序进一步负责获取和处理所有记录，然后再次获取每个单独的记录每次都废弃一个全新的页面(此处未列出代码)......

This for loop usually ends up taking hours to complete. I am looking for using the apply family to good effect so as to save on time. This program has further responsibility of fetching and processing all records and then for each individual record again scrapping a entirely new page every time (code not listed here)....

我尝试了以下代码，但它没有给我想要的:

I have tried the following code but it doesn't give me what i want:

url_bit1 <- 'https://eprocure.gov.in/mmp/latestactivetenders/page='
read_page <- function(datain){
   closeAllConnections()
   on.exit(closeAllConnections())
   url <- paste(url_bit1, datain$S.No., sep="")
   cat(S.No.,"\t",proc.time() - start_time,"\n")
   data <- read_html(url)
   total_tenders_raw <- html_nodes(data,xpath = '//*[(@id = "table")]')
   Page_tenders <- data.frame(html_table(total_tenders_raw, header = TRUE))
   links <- html_nodes(data, xpath='//*[(@id = "table")] | //td | //a')
   links_fair <- html_attr(links,'href')
   links_fair <- links_fair[grep("tendersfullview",links_fair)]
   Page_tenders <- cbind(Page_tenders,links_fair)
   All_tenders <- rbind(All_tenders,Page_tenders)
}

All_tenders <- sapply(All_tenders, FUN=read_page(All_tenders$S.No.))

欢迎提供任何建议、指导、建议、意见或帮助.我只使用 R 3-4 个月.我也知道 Python 在这件事上比 R 强，但我更倾向于 R 来解决这个问题.

Any advise, guidance, suggestions, inputs or help is welcome. I have been using R for 3-4 months only. I am also aware of Python's strengths in this matter over R but am inclined towards R for the solution to this problem.

推荐答案

您的 sapply 函数不正确.我对您的代码进行了一些编辑，并在样本大小 N = 50 上对其进行了测试.我们可能会使用 system.time() 来找出完成任务所需的时间.

Your sapply function is incorrect. I made some edit on your code and tested it on sample size N = 50. We might use system.time() to find out how much time it takes to finish the task.

for"方法:

system.time(
  for (page_no in 1:50){
    closeAllConnections()
    on.exit(closeAllConnections())
    url_bit1 <- 'https://eprocure.gov.in/mmp/latestactivetenders/page='
    url <- paste(url_bit1, page_no, sep="")
    cat(page_no,"\t",proc.time() - start_time,"\n")
    data <- read_html(url)
    total_tenders_raw <- html_nodes(data,xpath = '//*[(@id = "table")]')
    Page_tenders <- data.frame(html_table(total_tenders_raw, header = TRUE))
    links <- html_nodes(data, xpath='//*[(@id = "table")] | //td | //a')
    links_fair <- html_attr(links,'href')
    links_fair <- links_fair[grep("tendersfullview",links_fair)]
    Page_tenders <- cbind(Page_tenders,links_fair)
    All_tenders <- rbind(All_tenders,Page_tenders)
  }
)

#user  system elapsed 
# 50.15   81.26  132.73

lapply"方法:

All_tenders = NULL
url_bit1 <- 'https://eprocure.gov.in/mmp/latestactivetenders/page='
read_page <- function(datain){
  closeAllConnections()
  on.exit(closeAllConnections())
  url <- paste(url_bit1, datain, sep="")
  cat(datain,"\t",proc.time() - start_time,"\n")
  data <- read_html(url)
  total_tenders_raw <- html_nodes(data,xpath = '//*[(@id = "table")]')
  Page_tenders <- data.frame(html_table(total_tenders_raw, header = TRUE))
  links <- html_nodes(data, xpath='//*[(@id = "table")] | //td | //a')
  links_fair <- html_attr(links,'href')
  links_fair <- links_fair[grep("tendersfullview",links_fair)]
  Page_tenders <- cbind(Page_tenders,links_fair)
  All_tenders <- rbind(All_tenders,Page_tenders)
}

system.time(
  All_tenders <- lapply(1:50, function(x) read_page(x))
)
# user  system elapsed 
# 49.84   78.97  131.16

如果我们想把我们的结果放在一个数据框中，那么将 All_tenders 列表转换为一个数据框，如下所示:

If we want to put our results in a dataframe, then transform All_tenders list to a dataframe as follows:

All_tenders = do.call(rbind, lapply(All_tenders, data.frame, stringsAsFactors=FALSE)

事实证明 lapply 稍微快一点.

Turns out lapply is slightly faster.

这篇关于R 中的 Apply 与 For 循环的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！