Purrr 向数据框中添加新列，这些列是映射函数调用的输出答案

【问题标题】：Purrr add new columns to a data frame that are an output from a map function callPurrr 向数据框中添加新列，这些列是映射函数调用的输出
【发布时间】：2023-10-13 08:40:01
【问题描述】：

我正在处理一个数据框（称为 full_df），其中包含我想用来抓取两个其他链接的链接。这是数据框的示例：

structure(list(CIK = c("1082339", "1276755", "1280511"), COMPANY_NAME = c("COLDSTREAM CAPITAL MANAGEMENT INC", 
"CHELSEA COUNSEL CO", "QUANTUM CAPITAL MANAGEMENT"), FORM_TYPE = c("13F-HR", 
"13F-HR", "13F-HR"), FILE_DATE = c("2020-05-27", "2020-06-12", 
"2020-05-26"), FORM_LINK = c("edgar/data/1082339/0001082339-20-000002.txt", 
"edgar/data/1276755/0001420506-20-000683.txt", "edgar/data/1280511/0001280511-20-000003.txt"
), QTR_YEAR = c("Q22020", "Q22020", "Q22020"), FULL_LINK = c("https://www.sec.gov/Archives/edgar/data/1082339/0001082339-20-000002-index.htm", 
"https://www.sec.gov/Archives/edgar/data/1276755/0001420506-20-000683-index.htm", 
"https://www.sec.gov/Archives/edgar/data/1280511/0001280511-20-000003-index.htm"
)), row.names = c(NA, 3L), class = "data.frame")

我想遍历 FULL_LINK 列并获得另外两个链接，然后我想将它们作为两个新列添加到我的原始数据框中 - xml_link 和 html_link。

我可以使用我这样编写的函数获取链接（此处使用单个链接作为示例）：

library(polite)
library(rvest)
library(glue)
library(tidyverse)

test_link <- "https://www.sec.gov/Archives/edgar/data/1082339/0001082339-20-000002-index.htm"

ua = 'Kartik P (for personal use)'


session <- bow("https://www.sec.gov/",
               user_agent = ua)

xml_scraper <- function(urll) {
  print(glue("Scraping: {urll}"))
  
  temp_link <- session %>%
    nod(urll) %>%
    scrape(verbose = FALSE) %>%
    html_nodes("a") %>%
    html_attr('href') 
  
  xml_link <- temp_link %>% 
    nth(12)
  html_link <- temp_link %>% 
    nth(11)
  return(data.frame(xml_link, html_link))
}

太棒了！这按预期工作并返回一个包含我想要的两列的数据框

xml_scraper(test_link)
Scraping: https://www.sec.gov/Archives/edgar/data/1082339/0001082339-20-000002-index.htm
                                                           xml_link
1 /Archives/edgar/data/1082339/000108233920000002/CCMI13F2020Q1.xml
                                                                         html_link
1 /Archives/edgar/data/1082339/000108233920000002/xslForm13F_X01/CCMI13F2020Q1.xml

但是，我想做的是遍历 full_df 中 FULL_LINK 列的每个元素，并将两个新链接添加为原始数据框中新创建的 xml_link 和 html_link 列的元素。感觉这应该可以通过 purr::map_dfr 和 bind_cols 调用或同时改变两个名称变量来实现，但我无法弄清楚语法。

如果有任何关于如何让它与 dplyr 和 purrr 一起工作的建议，我们将不胜感激。

提前致谢。

【问题讨论】：

标签： r dplyr purrr rvest

【解决方案1】：

也许：

df_new <- bind_cols(map_dfr(df$FULL_LINK, xml_scraper), df)

结果：


#> # A tibble: 3 × 9
#>   xml_link  html_link  CIK   COMPANY_NAME FORM_TYPE FILE_DATE FORM_LINK QTR_YEAR
#>   <chr>     <chr>      <chr> <chr>        <chr>     <chr>     <chr>     <chr>   
#> 1 /Archive… /Archives… 1082… COLDSTREAM … 13F-HR    2020-05-… edgar/da… Q22020  
#> 2 /Archive… /Archives… 1276… CHELSEA COU… 13F-HR    2020-06-… edgar/da… Q22020  
#> 3 /Archive… /Archives… 1280… QUANTUM CAP… 13F-HR    2020-05-… edgar/da… Q22020  
#> # … with 1 more variable: FULL_LINK <chr>

^{由reprex package (v2.0.1) 于 2022-01-01 创建}

【讨论】：

完美！这有效，我修改如下，以无缝处理多个文件 read_csv(file_name) %>% bind_cols(., map_dfr(.$FULL_LINK, xml_scraper)) %>% write.csv(new_file_path/file_name))

【解决方案2】：

您可以使用 xml_scraper 函数对数据集进行变异。您需要“按行”进行变异，因为您的函数未矢量化。


data_full<-data %>% 
  rowwise() %>%
  mutate(xml_link=xml_scraper(FULL_LINK) %>% pluck("xml_link"),
         html_link=xml_scraper(FULL_LINK) %>% pluck("html_link"))

#If you want just the results of the scrape, you can use map
the_xml<-data %>%
  split(1:nrow(.)) %>%
  map(~pluck(.x$"FULL_LINK")) %>%
  map(xml_scraper) %>%
  bind_rows()

【讨论】：

这很好，但是“the_xml”只包含两列xml_link和html_link，这很有用但不完整。我想要的是将这两列绑定到上面代码中的“数据”数据框。我想我可以强制 col_bind 两个数据帧（上面代码中的 data 和 the_xml ），但是有没有一种方法可以在一次调用中完成？
啊，我知道你现在想要什么了。查看修改。

【解决方案3】：

您可以编辑您的函数以输出 FULL_LINK 并使用它将 2 个新列加入到您的原始数据中

xml_scraper <- function(urll) {
  print(glue("Scraping: {urll}"))
  
  temp_link <- session %>%
    nod(urll) %>%
    scrape(verbose = FALSE) %>%
    html_nodes("a") %>%
    html_attr('href') 
  
  xml_link <- temp_link %>% 
    nth(12)
  html_link <- temp_link %>% 
    nth(11)

return(data.frame(FULL_LINK = urll, xml_link, html_link))

}

然后

data2 <- map_dfr(data$FULL_LINK, .f = xml_scrapper) %>%
  left_join(data, ., by = "FULL_LINK")

【讨论】：