主页 / coding / 问题 / 78973946
Accepted
Alireza Sadeghi
Asked: 2024-09-11 21:03:40 +0800 CST

如何使用 rvest 将分层网络数据抓取为表格格式？

  • 772

我通常熟悉。我知道和rvest之间的区别。但我无法解决这个问题：html_elements()html_element()

假设我们有类似此网页上的数据。数据采用分层格式，每个标题都有不同数量的子标题。

当我尝试抓取时，我得到了 177 个标题。但是，副标题实际上有 270 个。我想将数据提取成整齐的格式。但由于向量大小不同，我无法轻松地将它们组合成 tibble。

这是我的代码以及一些关于结果的评论：

page <- read_html("https://postdocs.stanford.edu/about/department-postdoc-admins")

person_departments <- page %>% 
    html_elements(".item-list") %>% 
    html_element("h3") %>% 
    html_text2()
# The above code returns 

person_names <- page %>% 
  html_elements(".item-list li") %>% 
  html_element("h4") %>% 
  html_text2()
# This one returns 270 names (some departments have more than 1 admin)

# Using the above codes, I can't get a nice table with two columns, one for the name and one for the person's department.

2 个回答

  1. 主要的技巧是获取"item-list"元素的子元素。然后就是处理成表的问题。每个部门都是一个奇数编号的列表元素，人员位于偶数编号的元素中。必须注意空缺的部门职位。

    library(rvest)

link <- "https://postdocs.stanford.edu/about/department-postdoc-admins"
page <- read_html(link)

person_table <- page %>% 
  html_elements(".item-list") %>% 
  html_children() |>
  html_text2() |>
  strsplit("\nPhone:|\n|Email:") |>
  lapply(trimws)

i_odd <- c(TRUE, FALSE)
# get how many persons in each dept
r <- lengths(person_table[!i_odd]) %/% 3L
# if "Vacant", adjust to 1 person (named "Vacant", see below)
r[r == 0L] <- 1L
Department <- person_table[i_odd] |> unlist() |> rep(r)
Person <- lapply(person_table[!i_odd], \(x) {
  # these are the vacant persons
  if( length(x) == 1L) {
    matrix(c(x, "", ""), nrow = 1L)
  } else {
    matrix(x, ncol = 3L, byrow = TRUE)
  }
  }) |> do.call(rbind, args = _)

result <- cbind(Department, Person) |>
  as.data.frame() |>
  setNames(c("Department", "Name", "Phone", "Email"))

str(result)
#> 'data.frame':    270 obs. of  4 variables:
#>  $ Department: chr  "Advanced Residency Training at Stanford" "Aeronautics and Astronautics" "African & African-Amer Studies" "Anesthes, Periop & Pain Med" ...
#>  $ Name      : chr  "Sofia Gonzales" "Jenny Scholes" "Ashante Johnson" "Natalie Darling-Cabrera" ...
#>  $ Phone     : chr  "(650) 724-9139" "(510) 468-5967" "(650) 721-3969" "(650) 497-0648" ...
#>  $ Email     : chr  "[email protected]" "[email protected]" "[email protected]" "[email protected]" ...
head(result)
#>                                Department                    Name
#> 1 Advanced Residency Training at Stanford          Sofia Gonzales
#> 2            Aeronautics and Astronautics           Jenny Scholes
#> 3          African & African-Amer Studies         Ashante Johnson
#> 4             Anesthes, Periop & Pain Med Natalie Darling-Cabrera
#> 5             Anesthes, Periop & Pain Med          Ashley Johnson
#> 6             Anesthes, Periop & Pain Med        Jessica Martinez
#>            Phone                 Email
#> 1 (650) 724-9139   [email protected]
#> 2 (510) 468-5967 [email protected]
#> 3 (650) 721-3969 [email protected]
#> 4 (650) 497-0648 [email protected]
#> 5 (650) 721-7212 [email protected]
#> 6 (650) 497-8189 [email protected]

    创建于 2024-09-11，使用reprex v2.1.0

    • 2
  2. Best Answer

    这里的方法略有不同，从元素开始.item-list > ul > li，然后您可以直接提取姓名、电话和电子邮件。如果当前元素中没有这些元素li，您可以方便地在结果框架中获取一个NA值（例如，对于空缺职位和仅列出电子邮件的情况）。

    切换h4到，xpath因为它允许搜索祖先，这样您就可以获得元素列表中的h4每个匹配。li

    library(dplyr)
library(rvest)
library(purrr)

page <- read_html("https://postdocs.stanford.edu/about/department-postdoc-admins")

page |> 
  html_elements(".item-list > ul > li") |> 
  map(\(li) 
      list(
        h3    = html_element(li, xpath = "./ancestor::div[@class='item-list']/h3"),
        h4    = html_element(li, "h4"),
        phone = html_element(li, ".views-field-field-s-person-phone-display"),
        email = html_element(li, ".views-field-field-s-person-email")
      ) |> map(html_text, trim = TRUE)
  ) |> 
  bind_rows() |> 
  # do not display full contact details in a SO post
  mutate(across(everything(), \(x) stringr::str_trunc(x, 20)))
#> # A tibble: 270 × 4
#>    h3                   h4                   phone                email         
#>    <chr>                <chr>                <chr>                <chr>         
#>  1 Advanced Residenc... Sofia Gonzales       Phone:     (650) ... Email:     so…
#>  2 Aeronautics and A... Jenny Scholes        Phone:     (510) ... Email:     js…
#>  3 African & African... Ashante Johnson      Phone:     (650) ... Email:     as…
#>  4 Anesthes, Periop ... Natalie Darling-C... Phone:     (650) ... Email:     nd…
#>  5 Anesthes, Periop ... Ashley Johnson       Phone:     (650) ... Email:     as…
#>  6 Anesthes, Periop ... Jessica Martinez     Phone:     (650) ... Email:     ji…
#>  7 Anthropology         Julianne Spitler     Phone:     (650) ... Email:     js…
#>  8 Archaeology          Bilge Kucukdogan     Phone:     (650) ... Email:     bi…
#>  9 Bill Lane Center ... Vacant               <NA>                 <NA>          
#> 10 Biochemistry         Dan Carino           Phone:     (650) ... Email:     dp…
#> # ℹ 260 more rows

    在某种程度上，这是一个风格偏好的问题（当然，性能也是如此），但我们也可以使用相同的构建块而无需map()/lapply()迭代。html_element()在以下上下文中使用单数可能听起来不太直观，但文档中有这一点：

    html_element()返回与输入长度相同的节点集

    必须说我个人直到今天才忽略了这一点。

    无论如何，我们可以通过以下方式获得与前面的例子相同的结果：

    li <- html_elements(page, ".item-list > ul > li")
tibble(
  h3 = html_element(li, xpath = "./ancestor::div[@class='item-list']/h3") |> html_text(trim = TRUE),
  h4 = html_element(li, "h4") |> html_text(trim = TRUE),
  phone = html_element(li, ".views-field-field-s-person-phone-display") |> html_text(trim = TRUE),
  email = html_element(li, ".views-field-field-s-person-email") |> html_text(trim = TRUE)
)

    Becnhmark（注意秒与毫秒）：

    library(dplyr)
library(rvest)
library(purrr)

page <- read_html("https://postdocs.stanford.edu/about/department-postdoc-admins")
bm <- bench::mark(
  map_li = page |> 
    html_elements(".item-list > ul > li") |> 
    map(\(li) 
        list(
          h3    = html_element(li, xpath = "./ancestor::div[@class='item-list']/h3"),
          h4    = html_element(li, "h4"),
          phone = html_element(li, ".views-field-field-s-person-phone-display"),
          email = html_element(li, ".views-field-field-s-person-email")
        ) |> map(html_text, trim = TRUE)
    ) |> 
    bind_rows(),
  vec_li = {
    li <- html_elements(page, ".item-list > ul > li")
    tibble(
      h3 = html_element(li, xpath = "./ancestor::div[@class='item-list']/h3") |> html_text(trim = TRUE),
      h4 = html_element(li, "h4") |> html_text(trim = TRUE),
      phone = html_element(li, ".views-field-field-s-person-phone-display") |> html_text(trim = TRUE),
      email = html_element(li, ".views-field-field-s-person-email") |> html_text(trim = TRUE)
    )
  }, iterations = 10
)
bm  
#> # A tibble: 2 × 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 map_li        1.16s    1.19s     0.842    16.5MB     8.50
#> 2 vec_li      33.63ms  34.95ms    27.5     227.2KB     5.50
ggplot2::autoplot(bm)

    • 2

相关问题