<p><strong>更新的答案</strong></p>
<p>我现在有一种方法,只要你知道后代的顺序,也就是我们需要对<code>child_level</code>向量排序的顺序,它就可以工作。如果你不知道,我们应该能够计算订单,但现在我假设它是已知的</p>
<p>该方法基于:</p>
<ol>
<li>首先还要计算<code>parent_level</code></li>
<li>通过<code>parent_level</code>和<code>child_level</code>嵌套数据帧</li>
<li>一种自定义函数,可与<code>purrr::accumulate2</code>或<code>purrr::reduce2</code>一起使用,该函数使用<code>left_join</code>连接行中的所有data.frames,如果再次连接现有列,则将相应的列合并为一个列</li>
</ol>
<p>在应用此自定义<code>join_merge</code>函数之前:</p>
<ol start=“4”>
<li>嵌套的data.frames需要按照后代的顺序进行排序(<code>child_level</code>)</li>
<li>列名<code>parent</code>和<code>child</code>被替换为<code>parent_level</code>和<code>child_level</code>的值</li>
<li>最后<code>parent_level</code>和<code>child_level</code>组合成一个名为<code>arg_ls</code>的向量,该向量作为<code>.y</code>参数传递给<code>accumulate2</code>(或者<code>reduce2</code>)</li>
</ol>
<p>我希望这对你的真实数据有效</p>
<pre class="lang-r prettyprint-override"><code>library(tidyverse)
dat <- tribble(
~ parent, ~child, ~child_level,
"d" ,"sf" ,"x",
"d" ,"st" ,"x",
"d" ,"s0" ,"x",
"sf" ,"gr4" ,"l",
"sf" ,"gr3" ,"l",
"st" ,"grd" ,"l",
"st" ,"gr9" ,"l",
"s0" ,"n7" ,"l",
"s0" ,"b12" ,"l",
"grd" ,"nyvc" ,"b",
"gr3" ,"trub2","b",
"b12" ,"ngb2" ,"b",
"b12" ,"ggb8" ,"b",
"nyvc" ,"xtr2d","i",
"trub2" ,"xtuD" ,"i",
"gr4" ,"stab3","i",
"gr9" ,"ubc8" ,"i",
"n7" ,"ubc2" ,"i",
"ggb8" ,"drik2","i"
)
# in a first step we calculate the `parent_level`
dat <- dat %>%
left_join(., select(., -parent), by = c("parent" = "child")) %>%
rename("child_level" = "child_level.x",
"parent_level" = "child_level.y") %>%
mutate(parent_level = replace_na(parent_level, "o"))
# we need this function to work with accumulate2 or reduce2
join_merge <- function(df1, df2, .rename) {
res <- left_join(df1, df2, by = .rename[1])
# in case an existing column is joined again, we need to merge it together
if(length(colnames(select(res, starts_with(all_of(.rename[2]))))) > 1) {
res <- mutate(res, across(matches(paste0(.rename[2], ".x")),
~ if_else(is.na(.x), eval(sym(paste0(.rename[2], ".y"))), .x))) %>%
select(-all_of(paste0(.rename[2], ".y"))) %>%
rename(!! .rename[2] := paste0(.rename[2], ".x"))
}
res
}
# accumulate is used to show how the final result is buildt
dat %>%
nest_by(child_level, parent_level) %>%
arrange(child_level == "i", desc(child_level)) %>%
mutate(arg_ls = list(c(parent_level, child_level))) %>%
mutate(data = list(rename_with(data,
~ paste0(child_level),
"child") %>%
rename_with(~ paste0(parent_level),
"parent"))) %>%
ungroup %>%
mutate(dat_acc = accumulate2(data,
arg_ls[-1],
join_merge)) %>%
pull(dat_acc)
#> [[1]]
#> # A tibble: 3 x 2
#> o x
#> <chr> <chr>
#> 1 d sf
#> 2 d st
#> 3 d s0
#>
#> [[2]]
#> # A tibble: 6 x 3
#> o x l
#> <chr> <chr> <chr>
#> 1 d sf gr4
#> 2 d sf gr3
#> 3 d st grd
#> 4 d st gr9
#> 5 d s0 n7
#> 6 d s0 b12
#>
#> [[3]]
#> # A tibble: 7 x 4
#> o x l b
#> <chr> <chr> <chr> <chr>
#> 1 d sf gr4 <NA>
#> 2 d sf gr3 trub2
#> 3 d st grd nyvc
#> 4 d st gr9 <NA>
#> 5 d s0 n7 <NA>
#> 6 d s0 b12 ngb2
#> 7 d s0 b12 ggb8
#>
#> [[4]]
#> # A tibble: 7 x 5
#> o x l b i
#> <chr> <chr> <chr> <chr> <chr>
#> 1 d sf gr4 <NA> <NA>
#> 2 d sf gr3 trub2 xtuD
#> 3 d st grd nyvc xtr2d
#> 4 d st gr9 <NA> <NA>
#> 5 d s0 n7 <NA> <NA>
#> 6 d s0 b12 ngb2 <NA>
#> 7 d s0 b12 ggb8 drik2
#>
#> [[5]]
#> # A tibble: 7 x 5
#> o x l b i
#> <chr> <chr> <chr> <chr> <chr>
#> 1 d sf gr4 <NA> stab3
#> 2 d sf gr3 trub2 xtuD
#> 3 d st grd nyvc xtr2d
#> 4 d st gr9 <NA> ubc8
#> 5 d s0 n7 <NA> ubc2
#> 6 d s0 b12 ngb2 <NA>
#> 7 d s0 b12 ggb8 drik2
</code></pre>
<p><sup>由<a href="https://reprex.tidyverse.org" rel="nofollow noreferrer">reprex package</a>(v0.3.0)于2020-12-22创建</p>