使用R爬取大学课程目录时的学科归属路径优化问题

我用R开发了大学课程目录爬虫，代码功能正常，但课程与学科、子学科的归属关联有问题。比如VAK ID为SZHB 0806的课程，当前ModulePath会收集该课程之前所有h4标题，生成包含17个元素的路径列表，但我只需要**顶级学科（Language Center of the Universities in the State of Bremen）和直接所属学科（Polish）**的路径。直接截取首尾元素的方法可靠性不足，因为未来页面结构可能变化，需要更可靠的方案。

原实现代码 #

# loading needed libraries -----------------------------------------------------
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, rvest, xml2)
html_code <- read_html("https://www.uni-bremen.de/studium/starten-studieren/veranstaltungsverzeichnis?tx_hbulvp_pi1%5Bmodule%5D=93fdb6be384979f7300d263ba0c094be&tx_hbulvp_pi1%5Bsem%5D=39")
# Eine rekursive Funktion, um Informationen unter jedem h-Tags zu sammeln
extract_module_info <- function(node, module_path = c()) {
  # Basisfall: Wenn der Knoten leer ist, beenden Sie die Rekursion
  if (length(node) == 0) return(tibble())
  current_tag <- node %>% html_name()
  current_text <- node %>% html_text(trim = TRUE)
  # Aktualisieren des Pfades mit dem aktuellen Modul/Submodul
  new_path <- c(module_path, current_text)
  # Suchen nach dem nächsten div, das die Details enthält
  details_node <- node %>% html_node(xpath = "./following-sibling::div[1]")
  # Sammeln von Detailinformationen, wenn vorhanden
  if (!is.null(details_node) && length(html_nodes(details_node, 'tr')) > 0) {
    details <- html_nodes(details_node, 'tr') %>%
      map_df(~{
        tibble(
          ModulePath = list(new_path),
          CourseDesc = html_nodes(.x, '.expander') %>%
            html_text(trim = TRUE) %>%
            ifelse(length(.) == 0, NA_character_, .),
          CourseElse = html_nodes(.x, 'td:nth-child(2)') %>%
            html_text(trim = TRUE) %>%
            ifelse(length(.) == 0, NA_character_, .),
          CourseVAK = html_nodes(.x, 'td:nth-child(1)') %>%
            html_text(trim = TRUE) %>%
            ifelse(length(.) == 0, NA_character_, .),
          CourseTitle = html_nodes(.x, 'strong') %>%
            html_text(trim = TRUE) %>%
            ifelse(length(.) == 0, NA_character_, .),
          CourseTeacher = html_nodes(.x, 'td ~ td + td') %>%
            html_text(trim = TRUE) %>%
            ifelse(length(.) == 0, NA_character_, .)
        )
      })
  } else {
    details <- tibble(ModulePath = list(new_path))
  }
  # Rekursiver Abstieg zum nächsten h-Tag, falls vorhanden
  next_node <- node %>% html_node(xpath = "./following-sibling::*[self::h2 or self::h3 or self::h4][1]")
  child_details <- extract_module_info(next_node, new_path)
  # Kombinieren der aktuellen Details mit den rekursiv gesammelten Details
  bind_rows(details, child_details)
}
# Anwendung der Funktion auf das gesamte Dokument, startend mit dem ersten h2-Tag
results <- html_nodes(html_code, 'h2') %>% map_df(~extract_module_info(.x))
# Ausgabe der Ergebnisse
print(results)

核心思路 #

放弃递归累加路径的方式，改为从每个课程节点向上追溯直接所属的父标题和顶级学科标题，这样不受页面中间层级变化的影响，可靠性更高。具体逻辑：

1. 提取页面中所有层级标题（h2/h3/h4），记录节点位置用于匹配
2. 对每个课程行，找到它之前最近的标题节点（直接所属学科）
3. 从该直接标题向上找到最近的h2节点（顶级学科）
4. 将这两个标题组成ModulePath

修改后的代码 #

# loading needed libraries -----------------------------------------------------
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, rvest, xml2)

html_code <- read_html("https://www.uni-bremen.de/studium/starten-studieren/veranstaltungsverzeichnis?tx_hbulvp_pi1%5Bmodule%5D=93fdb6be384979f7300d263ba0c094be&tx_hbulvp_pi1%5Bsem%5D=39")

# 提取所有层级标题，记录节点、文本和层级
all_headers <- html_nodes(html_code, "h2, h3, h4") %>%
  tibble(
    node = .,
    text = html_text(., trim = TRUE),
    level = as.integer(str_remove(html_name(.), "h"))
  )

# 提取所有有效课程行（过滤表头行）
course_rows <- html_nodes(html_code, "tr") %>%
  keep(~length(html_nodes(., "strong")) > 0)

# 处理每个课程行，匹配对应标题
results <- course_rows %>%
  map_df(~{
    current_node <- .x
    # 找到当前课程行之前最近的直接父标题
    direct_header <- all_headers %>%
      filter(node < current_node) %>%
      slice_tail(n = 1)
    
    # 从直接父标题向上找最近的h2顶级学科标题
    top_header <- all_headers %>%
      filter(level == 2, node < direct_header$node) %>%
      slice_tail(n = 1)
    
    # 组装ModulePath，自动过滤空值
    module_path <- c(top_header$text, direct_header$text) %>%
      discard(is.na)
    
    # 提取课程信息
    tibble(
      ModulePath = list(module_path),
      CourseDesc = html_nodes(current_node, '.expander') %>%
        html_text(trim = TRUE) %>%
        ifelse(length(.) == 0, NA_character_, .),
      CourseElse = html_nodes(current_node, 'td:nth-child(2)') %>%
        html_text(trim = TRUE) %>%
        ifelse(length(.) == 0, NA_character_, .),
      CourseVAK = html_nodes(current_node, 'td:nth-child(1)') %>%
        html_text(trim = TRUE) %>%
        ifelse(length(.) == 0, NA_character_, .),
      CourseTitle = html_nodes(current_node, 'strong') %>%
        html_text(trim = TRUE) %>%
        ifelse(length(.) == 0, NA_character_, .),
      CourseTeacher = html_nodes(current_node, 'td ~ td + td') %>%
        html_text(trim = TRUE) %>%
        ifelse(length(.) == 0, NA_character_, .)
    )
  })

# 查看结果
print(results)

代码说明 #

• 利用xml2的节点比较功能（node < current_node），准确判断节点在页面中的先后顺序，避免递归累加的冗余问题
• 直接从课程节点向上追溯关联标题，即使页面新增或减少中间层级（如h3分类），依然能稳定提取目标路径
• 自动过滤空值，兼容极端异常情况

内容的提问来源于stack exchange，提问作者Cheroff_Faces