R: Возвращает значение из l oop при ручной остановке

Question

Я пытаюсь создать базу данных с помощью rvest. Поскольку у меня много данных для загрузки, я попытался написать несколько функций, которые позволили бы мне прервать процесс очистки и перезапустить его там, где я его оставил. Однако, хотя функции работают более или менее, всякий раз, когда я вручную прерываю их, я теряю вывод. Кто-нибудь знает решение, которое позволило бы мне остановить функцию без потери кадра данных, который создает l oop? Буду рад любому совету!

Некоторые URL, с которых я пытаюсь очистить данные:

to_do <- c("https://jobs.51job.com/shenzhen-nsq/116924235.html?s=01&t=0",
          "https://jobs.51job.com/shenzhen-nsq/116923692.html?s=01&t=0",
          "https://jobs.51job.com/shenzhen-nsq/116923628.html?s=01&t=0",
          "https://jobs.51job.com/shenzhen-nsq/116923578.html?s=01&t=0",
          "https://jobs.51job.com/shenzhen-nsq/116920896.html?s=01&t=0")

Функции, которые я создал для загрузки:

# In order to initiate the dowload
dl_data_start <- function(to_do){
  output <- tibble()
  i = 1
  while (to_do[i] %in% to_do) {
      page <- read_html(to_do[i])
      position <- page %>%
        html_nodes(.,'h1') %>%
        html_text(.)
      resume <- page %>%
        html_nodes(.,'.ltype') %>%
        html_text(.)
      job_offer <- page %>%
        html_nodes(.,'.job_msg') %>%
        html_text(.)
      eps <- page %>%
        html_nodes(.,'.com_msg') %>%
        html_text(.)
      eps_status <- page %>%
        html_nodes(.,'.at:nth-child(1)') %>%
        html_text(.)
      eps_description <- page %>%
        html_nodes(.,'.tmsg') %>%
        html_text(.)
      employees <- page %>%
        html_nodes(.,'.at:nth-child(2)') %>%
        html_text(.)
      category <- page %>%
        html_nodes(.,'.at:nth-child(3)') %>%
        html_text(.)
      salary <- page %>%
        html_nodes(.,'.cn strong') %>%
        html_text(.)
      url <- to_do[i]
      id <- i
      current <- tibble(position,resume,job_offer,eps,eps_description,eps_status,
                        employees,category,salary,url,id)
      output <- bind_rows(output,current)
      print(output[i,])
      i = i + 1
  }
  return(output)
}

# function in order to continue the download where I left it
dl_data_continue <- function(to_do,df,done){
  i = (match(tail(done,n=1),to_do) + 1)
  while (to_do[i] %in% to_do) {
    page <- read_html(to_do[i])
    position <- page %>%
      html_nodes(.,'h1') %>%
      html_text(.)
    resume <- page %>%
      html_nodes(.,'.ltype') %>%
      html_text(.)
    job_offer <- page %>%
      html_nodes(.,'.job_msg') %>%
      html_text(.)
    eps <- page %>%
      html_nodes(.,'.com_msg') %>%
      html_text(.)
    eps_status <- page %>%
      html_nodes(.,'.at:nth-child(1)') %>%
      html_text(.)
    eps_description <- page %>%
      html_nodes(.,'.tmsg') %>%
      html_text(.)
    employees <- page %>%
      html_nodes(.,'.at:nth-child(2)') %>%
      html_text(.)
    category <- page %>%
      html_nodes(.,'.at:nth-child(3)') %>%
      html_text(.)
    salary <- page %>%
      html_nodes(.,'.cn strong') %>%
      html_text(.)
    url <- to_do[i]
    id <- i
    current <- tibble(position,resume,job_offer,eps,eps_description,eps_status,
                      employees,category,salary,url,id)
    df <- bind_rows(df,current)
    print(df[i,])
    i = i + 1
  }
  return(df)
}

Проблема, с которой я столкнулся, заключается в том, что всякий раз, когда я прерываю l oop или когда происходит ошибка, я теряю все данные. Кто-нибудь может решить эту проблему? Я попробовал несколько вещей, таких как безопасно или tryCatch, но я не могу понять, что здесь не так. Большое спасибо.

Редактировать: Я также сделал несколько попыток с tryCatch. Используя приведенную ниже функцию, код больше не прерывается при возникновении проблемы (например, ошибка HTTP 404). Однако, когда есть ошибка, l oop останется застрявшей в проблемной итерации c, поэтому я должен использовать ее неправильно.

dl_data_continue_2 <- function(to_do,df,done){
  i = (match(tail(done,n=1),to_do) + 1)
  while (to_do[i] %in% to_do) {
    tryCatch(
      {expr =
        page <- read_html(to_do[i])
      position <- page %>%
        html_nodes(.,'h1') %>%
        html_text(.)
      resume <- page %>%
        html_nodes(.,'.ltype') %>%
        html_text(.)
      job_offer <- page %>%
        html_nodes(.,'.job_msg') %>%
        html_text(.)
      eps <- page %>%
        html_nodes(.,'.com_msg') %>%
        html_text(.)
      eps_status <- page %>%
        html_nodes(.,'.at:nth-child(1)') %>%
        html_text(.)
      eps_description <- page %>%
        html_nodes(.,'.tmsg') %>%
        html_text(.)
      employees <- page %>%
        html_nodes(.,'.at:nth-child(2)') %>%
        html_text(.)
      category <- page %>%
        html_nodes(.,'.at:nth-child(3)') %>%
        html_text(.)
      salary <- page %>%
        html_nodes(.,'.cn strong') %>%
        html_text(.)
      url <- to_do[i]
      id <- i
      current <- tibble(position,resume,job_offer,eps,eps_description,eps_status,
                        employees,category,salary,url,id)
      df <- bind_rows(df,current)
      print(df[i,])
      i = i + 1},
      error = function(e){
        message("* Caught an error on itertion ")
        print(e)
        i = i + 1
      }
    )
  }
  out
}

Используя безопасно, я в основном пытался

library(purrr)
dl_safely <- safely(dl_data_continue)

Answer 1

Я часто сталкиваюсь с этой проблемой в веб-скрепинге. Ключ заключается в том, чтобы хранить промежуточные результаты в среде, где они доступны, если ваша функция выдает ошибку. Очевидное место - глобальная среда, но это зависит от того, как вы используете свою функцию. Если это часть пакета, вы не хотите писать в глобальную рабочую область. В этом случае вы можете использовать среду «хранения» как часть пакета.

Возможно, самый лучший способ сделать это - удалить промежуточный объект после завершения l oop, поэтому он будет только когда-либо быть видимым / доступным, если l oop выдает ошибку.

Вот функция, которая демонстрирует принцип:

write_data_frames <- function(n)
{
  if(!exists("temporary", .GlobalEnv))
  {
    assign("temporary", list(), envir = globalenv())
    i <- 1
  }
  else
  {
    i <- length(.GlobalEnv$temporary) + 1
  }

  while(i <= n)
  {
    # This is the block where you do your web scraping and store the result
    .GlobalEnv$temporary[[i]] <- data.frame(var1 = rnorm(1), var2 = runif(1))

    # We'll create an error when i == 4
    if(i == 4) stop("Something broke!")
    i <- i + 1
  }
  result <- do.call(rbind, temporary)
  rm("temporary", envir = globalenv())
  return(result)
}

Теперь, это должно вернуть хороший фрейм данных, если я спрашиваю это для 3 строк:

write_data_frames(3)
#>         var1      var2
#> 1 -1.6428100 0.1976913
#> 2  0.7136643 0.9684348
#> 3 -0.4845004 0.0294557

И это ничего не оставило в нашей глобальной рабочей области:

ls()
#> [1] "write_data_frames"

Но предположим, что я прошу десять строк: здесь, это выдаст ошибку на четвертом l oop:

write_data_frames(10)
#> Error in write_data_frames(10) : Something broke!

Однако на этот раз мне доступен объект temporary:

ls()
#> [1] "temporary"         "write_data_frames"

temporary
#> [[1]]
#>       var1      var2
#> 1 -1.46648 0.1748874
#> 
#> [[2]]
#>          var1      var2
#> 1 -0.03855686 0.5772731
#> 
#> [[3]]
#>        var1      var2
#> 1 0.8228591 0.4115181
#> 
#> [[4]]
#>        var1      var2
#> 1 0.9183934 0.2732575

Еще лучше, моя функция предназначена просто для продолжайте с того места, на котором остановились, поэтому, если я снова сделаю

write_data_frames(10)
#>           var1      var2
#> 1  -1.46647987 0.1748874
#> 2  -0.03855686 0.5772731
#> 3   0.82285907 0.4115181
#> 4   0.91839339 0.2732575
#> 5   0.54850658 0.9946303
#> 6  -1.39917426 0.9948544
#> 7   0.39525152 0.9234611
#> 8  -1.05899076 0.6226182
#> 9  -2.03137464 0.1218762
#> 10  0.24880216 0.6631982

, функция снова запустится из положения 5 без каких-либо изменений. И теперь, когда мы проверяем наше глобальное рабочее пространство, ничего не остается:

ls()
#> [1] "write_data_frames"