通过使用 tibble 中不同行的值来改变值
Mutate value by using a value from a different row in a tibble
我想计算一个节点到根的距离dtr
。我只有一个向量,其中包含每个节点的父节点 ID rel
(在本例中 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
到目前为止,我能够编写以下算法,直到我在尝试引用代码中的不同行时遇到困难。
算法应该像这样工作(伪代码):
- 如果不是root,递增
dtr
:if(!equals(tid,trel)): dtr = dtr+1
- 将
tid
更改为trel
:tid = trel
- 将
trel
更改为 rel
值,其中 id == trel
- 如果有
!equals(tid,trel)
GOTO 1.,否则 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
)
第 3 步我不确定....我尝试使用以下代码实现它,但这不起作用:
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
第 4 步通过检查我在 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
}
知道如何解决这个问题或更简单的解决方案吗?提前致谢!
这基本上已经在tidygraph
包中实现了。如果你打算使用 tidyverse 处理类似图形的数据,你应该先看看那里。你可以做到
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
如果你想自己写一个函数,可以使用下面的代码:
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
我想计算一个节点到根的距离dtr
。我只有一个向量,其中包含每个节点的父节点 ID rel
(在本例中 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
到目前为止,我能够编写以下算法,直到我在尝试引用代码中的不同行时遇到困难。
算法应该像这样工作(伪代码):
- 如果不是root,递增
dtr
:if(!equals(tid,trel)): dtr = dtr+1
- 将
tid
更改为trel
:tid = trel
- 将
trel
更改为rel
值,其中id == trel
- 如果有
!equals(tid,trel)
GOTO 1.,否则 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
)
第 3 步我不确定....我尝试使用以下代码实现它,但这不起作用:
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
第 4 步通过检查我在 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
}
知道如何解决这个问题或更简单的解决方案吗?提前致谢!
这基本上已经在tidygraph
包中实现了。如果你打算使用 tidyverse 处理类似图形的数据,你应该先看看那里。你可以做到
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
如果你想自己写一个函数,可以使用下面的代码:
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