r - 通过使用 tibble 中不同行的值来改变值

Question

我想计算一个节点到根 dtr 的距离。我只有一个向量，其中包含每个节点 rel 的父节点 ID(在此示例中 id == 7 是根):

library(tidyverse)

tmp <- tibble(
  id = 1:12,
  rel = c(2,7,4,2,4,5,7,7,10,8,7,7)
)

最后我要找的是这个结果:

tmp$dtr

[1] 2 1 3 2 3 4 0 1 3 2 1 1

到目前为止，我能够编写以下算法，直到我在尝试引用代码中的不同行时遇到困难。

算法应该像这样工作(伪代码):

1. 如果不是 root，增加 dtr:if(!equals(tid,trel)): dtr = dtr+1
2. 将 tid 更改为 trel:tid = trel
3. 将 trel 更改为 rel 值，其中 id == trel
4. 如果有 !equals(tid,trel) GOTO 1., else END

首先我添加了 2 个辅助列来存储临时信息:

tmp <- tmp %>%
  mutate(
    tid = id,
    trel = rel,
    dtr = 0
  )

算法的前两步是这样的:

tmp <- tmp %>%
  mutate(
    dtr = if_else(
      !equals(tid,trel),
      dtr + 1,
      dtr
    ),
    tid = trel
  ) 

第三步我不确定....我试图用下面的代码实现它，但这不起作用:

tmp <- tmp %>% 
  mutate(trel = rel[id == .$tid])

结果(当然)是错误的:

tmp$rel

[1] 7 7 7 7 7 7 7 7 7 7 7 7

但为什么不是这个呢？ (第一次运行3.应该是正确的解决方案):

[1] 2 7 2 7 2 4 7 7 10 8 7 7

第四步是检查我在 trel 中是否有多个唯一值:

while(length(unique(tmp$trel)) > 1){
  ...
}

因此完整的算法应该看起来像这样:

get_dtr <- function(tib){
  tmp <- tib %>%
    mutate(
      tid = id,
      trel = rel,
      dtr = 0
    )
  
  while(length(unique(tmp$trel)) > 1){
    tmp <- tmp %>%
      mutate(
        dtr = if_else(
          !equals(tid,trel),
          dtr + 1,
          dtr
        ),
        tid = trel
      ) 
    
    ### Step 3
  }
  tmp
}

知道如何解决这个问题或更简单的解决方案吗？提前致谢!

Answer 1

如果你想自己写一个函数，可以使用下面的代码:

library(tidyverse)

tmp <- tibble(
  id = 1:12,
  rel = c(2,7,4,2,4,5,7,7,10,8,7,7)
)


calc_dtr <- function(id, tmp){
  # find root
  root <- tmp$id[tmp$id == tmp$rel]

  # is this the root node? 
  if(id == root){return(0)}

  # initialize counter
  dtr <- 1
  trel <- tmp$rel[tmp$id == id]

  while(trel != root){
    dtr <- dtr + 1
    trel <- tmp$rel[tmp$id == trel]
  }

  return(dtr)
}

tmp %>% 
  mutate(
    dtr = map_dbl(id, calc_dtr, tmp)
  )

这会产生以下输出:

# A tibble: 12 x 3
      id   rel   dtr
   <int> <dbl> <dbl>
 1     1     2     2
 2     2     7     1
 3     3     4     3
 4     4     2     2
 5     5     4     3
 6     6     5     4
 7     7     7     0
 8     8     7     1
 9     9    10     3
10    10     8     2
11    11     7     1
12    12     7     1