通过使用来自tibble中不同行的值来变量值

时间:2018-01-02 15:28:56

标签: r dplyr mutate tidygraph

我想计算节点到根dtr的距离。我只有一个向量,它包含每个节点rel的父节点id(在本例中id == 7是root):

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

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

算法应该像这样工作(Pseudocode):

  1. 如果不是root,请增加dtrif(!equals(tid,trel)): dtr = dtr+1
  2. tid更改为treltid = trel
  3. trel更改为rel
  4. 所在的id == trel
  5. 如果有任何!equals(tid,trel) GOTO 1.,则结束
  6. 首先,我添加了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 $相对

         

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

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

      

    [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
    }
    

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

2 个答案:

答案 0 :(得分:1)

这基本上已在SELECT Path, Name, Description FROM ReportServer.dbo.Catalog 包中实现。如果您打算使用tidyverse处理类似图形的数据,那么您应该首先查看。你可以做到

tidygraph

答案 1 :(得分:1)

如果您想自己编写函数,可以使用以下代码:

new_names={'USA':['USA', 'U.S.A.', 'US', 'United States'],
'Egypt': ['Egypt', 'ARE', 'Egypt, the Arab Republic of',  'ARE, eg']}

这会产生以下输出:

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)
  )