通过使用小标题中另一行中的值来对值进行突变 [英] Mutate value by using a value from a different row in a tibble

问题描述

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

I want to calculate the distance a node to the root dtr. All I have is a vector, that contains the parent node id for each node rel (in this example id == 7 is root):

library(tidyverse)

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

最后，我正在寻找以下结果:

In the end I'm looking for this result:

tmp $ dtr

tmp$dtr

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

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

到目前为止，我能够编写以下算法，直到在尝试引用代码中的另一行时陷入困境为止.

So far I was able to write the following algorithm until I got stuck when trying to reference a different row in my code.

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

The algorithm should work like this (Pseudocode):

1. 如果不是root用户，请递增dtr:if(!equals(tid,trel)): dtr = dtr+1
2. 将tid更改为trel:tid = trel
3. 将trel更改为rel值，其中id == trel
4. 如果有!equals(tid,trel)转到1.，否则END

1. If not root, increment dtr: if(!equals(tid,trel)): dtr = dtr+1
2. Change tid to trel: tid = trel
3. Change trel to to the rel value where id == trel
4. If any !equals(tid,trel) GOTO 1., else END

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

First I added 2 helper columns to store temporary information:

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

算法的前两个步骤是这样的:

The first two steps in the algorithm work like this:

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

我不确定的第三步....我尝试使用以下代码来实现它，但这不起作用:

The 3rd step I'm not sure about.... I tried to achieve it with the following code, but that does not work:

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

结果(当然)是错误的:

The result is (of course) wrong:

tmp $ rel

tmp$rel

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

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

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

But why not this? (Should be the right solution when running 3. the first time):

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

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

第4步是通过检查trel中是否有多个唯一值来完成的:

The 4th step is done by checking if I have more than one unique value in trel:

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

因此完整的算法应如下所示:

Thus the full algorithm should somewhat look like this:

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
}

有什么想法如何解决这个或更简单的解决方案?预先感谢！

Any idea how to solve this or a simpler solution? Thanks in advance!

推荐答案

这基本上已经在tidygraph包中实现.如果要使用tidyverse处理类似图形的数据，则应首先查看那里.你可以做

This is basically already implemented in the tidygraph package. If you are going to be working with graph-like data with the tidyverse you should look there first. you can do

library(tidygraph)
as_tbl_graph(tmp, directed=FALSE) %>% 
  activate(nodes) %>% 
  mutate(depth=bfs_dist(root=7)) %>% 
  as_tibble()
#     name depth
#    <chr> <int>
#  1     1     2
#  2     2     1
#  3     3     3
#  4     4     2
#  5     5     3
#  6     6     4
#  7     7     0
#  8     8     1
#  9     9     3
# 10    10     2
# 11    11     1
# 12    12     1

这篇关于通过使用小标题中另一行中的值来对值进行突变的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！