是否可以使用 dplyr 和 furrr up 来加速此功能？

Question

我有一个数据框，其中行对应于文档，列捕获这些文档中的单个单词。

library(tidyverse)
library(furrr)
#> Loading required package: future

doc_by_word_df <- structure(list(
 doc_id = c("doc1.txt", "doc2.txt", "doc3.txt"),
 kwpe_1 = c("apple", "fish", "apple"),
 kwpe_2 = c("bananna", "grain", "insects"),
 kwpe_3 = c("carrot", "insects", "grain")),
 class = c("tbl_df", "tbl", "data.frame"),
 row.names = c(NA,-3L))

doc_by_word_df
#> # A tibble: 3 × 4
#>   doc_id   kwpe_1 kwpe_2  kwpe_3 
#>   <chr>    <chr>  <chr>   <chr>  
#> 1 doc1.txt apple  bananna carrot 
#> 2 doc2.txt fish   grain   insects
#> 3 doc3.txt apple  insects grain

我想识别所有包含这些文档中任何可能的词对组合的文档。

为此，我创建了数据集中所有单词的向量，并提取了所有独特的单词对组合。

all_words <- c("apple", "fish", "apple", "bananna", "grain", "insects", "carrot", "insects", "grain")

unique_keyword_pair <- combn(unique(all_words), 2)

unique_keyword_pair
#>      [,1]    [,2]      [,3]    [,4]      [,5]     [,6]      [,7]    [,8]     
#> [1,] "apple" "apple"   "apple" "apple"   "apple"  "fish"    "fish"  "fish"   
#> [2,] "fish"  "bananna" "grain" "insects" "carrot" "bananna" "grain" "insects"
#>      [,9]     [,10]     [,11]     [,12]     [,13]     [,14]    [,15]    
#> [1,] "fish"   "bananna" "bananna" "bananna" "grain"   "grain"  "insects"
#> [2,] "carrot" "grain"   "insects" "carrot"  "insects" "carrot" "carrot"

我创建了一个函数，它使用唯一的词对过滤掉所有包含这些词对的文档，并将该函数映射到数据框上。

它以我希望的方式工作，但需要很长时间才能运行。我已经使用 furrr 包来尝试加快速度，但我仍然需要很长的运行时间。最初我是用 for 循环做的；我的印象是使用 map 函数会缩短时间——但我认为这没有太大区别。

我对这类事情的了解还不够，无法理清我可以做些什么来减少运行此功能所需的时间。我怀疑这与通过过滤功能运行的大量词对组合有关，但除此之外我不确定。

如有任何建议，我们将不胜感激。

docs_word_pairs <- function(x) {
 doc_by_word_df %>% 
  filter(if_any(-doc_id, ~ . %in% unique_keyword_pair[,x][1]) & 
          if_any(-doc_id, ~ . %in% unique_keyword_pair[,x][2])) %>% 
  mutate(keyword_pair = paste(c(unique_keyword_pair[,x][1],
                                unique_keyword_pair[,x][2]), 
                              collapse = "-"),
         keyword_1 = unique_keyword_pair[,x][1],
         keyword_2 = unique_keyword_pair[,x][2]) %>% 
  relocate(keyword_pair:keyword_2, .before = doc_id) %>% 
  group_by(keyword_pair) %>%
  summarize(n = n())
}

num_unique_keyword_pair <- length(unique_keyword_pair)/2

seq_num_unique_keyword_pair <- rep(c(1:num_unique_keyword_pair))

future::plan(multisession)

seq_num_unique_keyword_pair %>% 
 future_map_dfr(docs_word_pairs)
#> # A tibble: 8 × 2
#>   keyword_pair       n
#>   <chr>          <int>
#> 1 apple-bananna      1 # one document contains this key word pair
#> 2 apple-grain        1
#> 3 apple-insects      1
#> 4 apple-carrot       1
#> 5 fish-grain         1
#> 6 fish-insects       1
#> 7 bananna-carrot     1
#> 8 grain-insects      2 # two documents contain this key word pair

^{由 reprex package (v2.0.1)}

于 2022-04-18 创建

Answer 1

这可以快速完成，如下所示：

as.dist(crossprod(table(cbind(doc_by_word_df[,1],unlist(doc_by_word_df[-1])))))

        apple bananna carrot fish grain
bananna     1                          
carrot      1       1                  
fish        0       0      0           
grain       1       0      0    1      
insects     1       0      0    1     2

甚至

doc_by_word_df %>%
  pivot_longer(-doc_id) %>%
  select(-name) %>%
  table() %>%
  crossprod() %>%
  as.dist()

        apple bananna carrot fish grain
bananna     1                          
carrot      1       1                  
fish        0       0      0           
grain       1       0      0    1      
insects     1       0      0    1     2

如果你想将其作为数据框，请执行以下操作：

df2 <- crossprod(table(cbind(doc_by_word_df[,1],unlist(doc_by_word_df[-1]))))
subset(data.frame(as.table(as.matrix(as.dist(df2)))), Freq > 0)
      Var1    Var2 Freq
2  bananna   apple    1
3   carrot   apple    1
5    grain   apple    1
6  insects   apple    1
7    apple bananna    1
9   carrot bananna    1
13   apple  carrot    1
14 bananna  carrot    1
23   grain    fish    1
24 insects    fish    1
25   apple   grain    1
28    fish   grain    1
30 insects   grain    2
31   apple insects    1
34    fish insects    1
35   grain insects    2

是否可以使用 dplyr 和 furrr up 来加速此功能？

Is it possible to speed this function using dplyr and furrr up?

r

dplyr

purrr

furrr