使用函数使用查找列表剪切链接文档（文档树）的分支

Question

我刚刚学会了如何添加分支到链接文档（文档树）.

现在我正在尝试做相反的事情，即使用函数根据查找列表切割文档树的分支。

可重现的例子：

library(tidyverse)

# list of document trees

df1 <- tibble(id_from=c(NA_character_,"111","222","333","444","444","aaa","bbb","x","x"),
              id_to=c("111","222","333","444","aaa","bbb","x","ccc","x1","x1"),
              level=c(0,1,2,3,4,4,5,5,6,6))

df2 <- tibble(id_from=c(NA_character_,"thank"),
              id_to=c("thank","you"),
              level=c(0,1))

tree_list <- list(df1,df2)
tree_list
#> [[1]]
#> # A tibble: 10 × 3
#>    id_from id_to level
#>    <chr>   <chr> <dbl>
#>  1 <NA>    111       0
#>  2 111     222       1
#>  3 222     333       2
#>  4 333     444       3
#>  5 444     aaa       4
#>  6 444     bbb       4
#>  7 aaa     x         5
#>  8 bbb     ccc       5
#>  9 x       x1        6
#> 10 x       x1        6
#> 
#> [[2]]
#> # A tibble: 2 × 3
#>   id_from id_to level
#>   <chr>   <chr> <dbl>
#> 1 <NA>    thank     0
#> 2 thank   you       1


# lookup list 
cut1 <- tibble(id_from=c("444"),
              id_to=c("aaa"))

cut2 <- tibble(id_from=c("thank"),
              id_to=c("you"))

cut3 <- tibble(id_from=c("bbb"),
               to_id=c("ccc"))

cut4 <- tibble(id_from=c("x"),
               id_to=c("x1"))

cut_lookup <- list(cut1,cut2,cut3,cut4)
cut_lookup
#> [[1]]
#> # A tibble: 1 × 2
#>   id_from id_to
#>   <chr>   <chr>
#> 1 444     aaa  
#> 
#> [[2]]
#> # A tibble: 1 × 2
#>   id_from id_to
#>   <chr>   <chr>
#> 1 thank   you  
#> 
#> [[3]]
#> # A tibble: 1 × 2
#>   id_from to_id
#>   <chr>   <chr>
#> 1 bbb     ccc  
#> 
#> [[4]]
#> # A tibble: 1 × 2
#>   id_from id_to
#>   <chr>   <chr>
#> 1 x       x1



# desired output
df1r <- tibble(id_from=c(NA_character_,"111","222","333","444"),
                     id_to=c("111","222","333","444","bbb"),
                     level=c(0,1,2,3,4))

df2r <- tibble(id_from=c(NA_character_),
              id_to=c("thank"),
              level=c(0))

desired.output <- list(df1r,df2r)

desired.output
#> [[1]]
#> # A tibble: 5 × 3
#>   id_from id_to level
#>   <chr>   <chr> <dbl>
#> 1 <NA>    111       0
#> 2 111     222       1
#> 3 222     333       2
#> 4 333     444       3
#> 5 444     bbb       4
#> 
#> [[2]]
#> # A tibble: 1 × 3
#>   id_from id_to level
#>   <chr>   <chr> <dbl>
#> 1 <NA>    thank     0

^{创建于 2023-04-02 与 reprex v2.0.2}

我尝试了以下方法，但出现错误：

# function to cut branches from a single tree
cut_tree <- function(tree, cuts) {
  nodes_to_cut_table <- setNames(rep(TRUE, length(cuts$id_from)), cuts$id_from)
  nodes_to_cut <- unique(cuts$id_from)
  tree %>%
    filter(!id_from %in% nodes_to_cut) %>%
    filter(!id_to %in% nodes_to_cut) %>%
    filter(!id_from %in% nodes_to_cut_table) %>%
    filter(!id_to %in% nodes_to_cut_table)
}

# function to apply cuts to a list of trees
cut_trees <- function(tree_list, cut_lookup) {
  pmap(list(tree_list, cut_lookup), cut_tree)
}

# apply cuts to the example input
cut_trees <- cut_trees(tree_list, cut_lookup)
#> Error in `pmap()`:
#> ! Can't recycle `.l[[1]]` (size 2) to match `.l[[2]]` (size 4).
#> Backtrace:
#>     ▆
#>  1. ├─global cut_trees(tree_list, cut_lookup)
#>  2. │ └─purrr::pmap(list(tree_list, cut_lookup), cut_tree)
#>  3. │   └─purrr:::pmap_("list", .l, .f, ..., .progress = .progress)
#>  4. │     └─vctrs::vec_size_common(!!!.l, .arg = ".l", .call = .purrr_error_call)
#>  5. └─vctrs::stop_incompatible_size(...)
#>  6.   └─vctrs:::stop_incompatible(...)
#>  7.     └─vctrs:::stop_vctrs(...)
#>  8.       └─rlang::abort(message, class = c(class, "vctrs_error"), ..., call = call)
cut_trees
#> function(tree_list, cut_lookup) {
#>   pmap(list(tree_list, cut_lookup), cut_tree)
#> }

^{创建于 2023-04-02 与 reprex v2.0.2}