R数据抓取/抓取动态/多个URL

1 回答

• 1

  我不会在下面进行错误处理，因为这超出了这个问题的范围 .

  让我们从通常的嫌疑人开始：

  library(rvest)
  library(httr)
  library(tidyverse)
  

  我们将定义一个函数，它将按页码为我们提供搜索结果页面 . 由于您提供了URL，因此我对搜索参数进行了硬编码 .

  在这个函数中，我们：

  • 获取页面HTML

  • 获取我们要抓取的文档的链接

  • 获取文档metdata

  • 制作数据框

  • 为数据框添加属性以获取页码，以及是否有更多页面要抓取

  这非常简单：

  get_page <- function(page_num=1) {
  
    GET(
      url = "https://www.bger.ch/ext/eurospider/live/de/php/aza/http/index.php",
      query = list(
        type="simple_query",
        lang="de",
        top_subcollection_aza="all",
        query_words="",
        from_date="",
        to_date="",
        x="12",
        y="12",
        page=page_num
      )
    ) -> res
  
    warn_for_status(res) # shld be "stop" and you should do error handling
  
    pg <- content(res)
  
    links <- html_nodes(pg, "div.ranklist_content ol li")
  
    data_frame(
      link = html_attr(html_nodes(links, "a"), "href"),
      title = html_text(html_nodes(links, "a"), trim=TRUE),
      court = html_text(html_nodes(links, xpath=".//a/../../div/div[contains(@class, 'court')]"), trim=TRUE), # these are "dangerous" if they aren't there but you can wrap error handling around this
      subject = html_text(html_nodes(links, xpath=".//a/../../div/div[contains(@class, 'subject')]"), trim=TRUE),
      object = html_text(html_nodes(links, xpath=".//a/../../div/div[contains(@class, 'object')]"), trim=TRUE)
    ) -> xdf
  
    # this looks for the text at the bottom paginator. if there's no link then we're done
  
    attr(xdf, "page") <- page_num
    attr(xdf, "has_next") <- html_node(pg, xpath="boolean(.//a[contains(., 'Vorwärts')])")
  
    xdf
  
  }
  

  做一个辅助函数，因为我无法忍受输入 attr(...) 并且它在使用中读得更好：

  has_next <- function(x) { attr(x, "has_next") }
  

  现在，进行一个抓取循环 . 我只停在6点b / c . 您应该删除该逻辑以刮取所有内容 . 考虑这样做，因为互联网连接是不稳定的事情：

  pg_num <- 0
  all_links <- list()
  
  repeat {
    cat(".") # poor dude's progress ber
    pg_num <- pg_num + 1
    pg_df <- get_page(pg_num)
    if (!has_next(pg_df)) break
    all_links <- append(all_links, list(pg_df))
    if (pg_num == 6) break # this is here for me since I don't need ~11,000 documents
    Sys.sleep(2) # robots.txt crawl delay
  }
  cat("\n")
  

  将数据框列表转换为一个大的框架 . 注意：您应该在此之前进行有效性测试，因为网络抓取充满了危险 . 您还应该将此数据框保存到RDS文件，这样您就不必再次执行此操作 .

  lots_of_links <- bind_rows(all_links)
  
  glimpse(lots_of_links)
  ## Observations: 60
  ## Variables: 5
  ## $ link    <chr> "https://www.bger.ch/ext/eurospider/live/de/php/aza/http/index.php?lang=de&type=highlight_simple_query&...
  ## $ title   <chr> "18.12.2017 6B 790/2017", "14.12.2017 6G 2/2017", "13.12.2017 5A 975/2017", "13.12.2017 5D 257/2017", "...
  ## $ court   <chr> "Strafrechtliche Abteilung", "Cour de droit pénal", "II. zivilrechtliche Abteilung", "II. zivilrechtlic...
  ## $ subject <chr> "Straf- und Massnahmenvollzug", "Procédure pénale", "Familienrecht", "Schuldbetreibungs- und Konkursrec...
  ## $ object  <chr> "Bedingte Entlassung aus der Verwahrung, Beschleunigungsgebot", "Demande d'interprétation et de rectifi...
  

  有了所有链接，我们将获得文件 .

  定义辅助函数 . 注意我们不会存储内部内容 <div> HTML文本，以便您以后解析它 .

  get_documents <- function(urls) {
    map_chr(urls, ~{
      cat(".") # poor dude's progress ber
      Sys.sleep(2) # robots.txt crawl delay 
      read_html(.x) %>% 
        xml_node("div.content") %>% 
        as.character() # we do this b/c we aren't parsing it yet but xml2 objects don't serialize at all
    })
  }
  

  这是如何使用它 . 再次，删除 head() 但也考虑分批进行 .

  head(lots_of_links) %>% # I'm not waiting for 60 documents
    mutate(content = get_documents(link)) -> links_and_docs
  cat("\n")
  
  glimpse(links_and_docs)
  ## Observations: 6
  ## Variables: 6
  ## $ link    <chr> "https://www.bger.ch/ext/eurospider/live/de/php/aza/http/index.php?lang=de&type=highlight_simple_query&...
  ## $ title   <chr> "18.12.2017 6B 790/2017", "14.12.2017 6G 2/2017", "13.12.2017 5A 975/2017", "13.12.2017 5D 257/2017", "...
  ## $ court   <chr> "Strafrechtliche Abteilung", "Cour de droit pénal", "II. zivilrechtliche Abteilung", "II. zivilrechtlic...
  ## $ subject <chr> "Straf- und Massnahmenvollzug", "Procédure pénale", "Familienrecht", "Schuldbetreibungs- und Konkursrec...
  ## $ object  <chr> "Bedingte Entlassung aus der Verwahrung, Beschleunigungsgebot", "Demande d'interprétation et de rectifi...
  ## $ content <chr> "<div class=\"content\">\n      \n<div class=\"para\"> </div>\n<div class=\"para\">Bundesgericht </div>...
  

  您仍需要在各个地方进行错误和有效性检查，如果存在服务器错误或解析问题，可能需要重新抓取页面 . 但这是如何构建这种特定于站点的爬虫 .

  回复于 2024-04-23T21:43:58+08:00