带有索引列表的 R tibble：如何快速使用它们？
Posted
技术标签:
【中文标题】带有索引列表的 R tibble：如何快速使用它们？【英文标题】：R tibble with list of indexes: how to quickly use them? 【发布时间】：2021-12-24 21:09:35 【问题描述】：我正在寻找一种快速方法来根据另一个表中的索引列表获取表中列的总和。
这是一个可重现的简单示例：首先创建一个边缘表
fake_edges <- st_sf(data.frame(id=c('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i'),
weight=c(102.1,98.3,201.0,152.3,176.4,108.6,151.4,186.3,191.2),
soc=c(-0.1,0.7,1.1,0.2,0.5,-0.2,0.4,0.3,0.8),
geometry=st_sfc(st_linestring(rbind(c(1,1), c(1,2))),
st_linestring(rbind(c(1,2), c(2,2))),
st_linestring(rbind(c(2,2), c(2,3))),
st_linestring(rbind(c(1,1), c(2,1))),
st_linestring(rbind(c(2,1), c(2,2))),
st_linestring(rbind(c(2,2), c(3,2))),
st_linestring(rbind(c(1,1), c(1,0))),
st_linestring(rbind(c(1,0), c(0,0))),
st_linestring(rbind(c(0,0), c(0,1)))
)))
tm_shape(fake_edges, ext = 1.3) +
tm_lines(lwd = 2) +
tm_shape(st_cast(fake_edges, "POINT")) +
tm_dots(size = 0.3) +
tm_graticules(lines = FALSE)
然后从表中创建一个网络，并找到从第一个节点到所有节点的成本最低的路径。
fake_net <- as_sfnetwork(fake_edges)
fake_paths <- st_network_paths(fake_net,
from=V(fake_net)[1],
to=V(fake_net),
weights='weight', type='shortest')
现在，我要改进的是查找 fake_paths 表的每一行的过程
id
路径所有边的soc 的总和
我所做的是以下（这里有 9 行很快，但在大型网络上需要很长时间）：
# Transforming to data.tables makes things a bit faster
fake_p <- as.data.table(fake_paths)
fake_e <- as.data.table(fake_edges)
# ID of the last edge on the path
fake_p$id <- apply(fake_p, 1, function(df) unlist(fake_e[df$edge_paths %>% last(), 'id'], use.names=F))
# Sum of soc
fake_p$result <- to_vec(for (edge in 1:nrow(fake_p)) fake_e[unlist(fake_p[edge, 'edge_paths']), soc] %>% sum())
最终，我想要的是 soc 的总和，我称之为 result 与原始 fake_edges 一起支持
fake_e = left_join(fake_e,
fake_p %>% select(id, result) %>% drop_na(id) %>% mutate(id=as.character(id), result=as.numeric(result)),
by='id')
fake_edges$result <- fake_e$result
fake_edges
Simple feature collection with 9 features and 4 fields
Geometry type: LINESTRING
Dimension: XY
Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 3
CRS: NA
| id | weight | soc | geometry | result |
|---|---|---|---|---|
| a | 102.1 | -0.1 | LINESTRING (1 1, 1 2) | -0.1 |
| b | 98.3 | 0.7 | LINESTRING (1 2, 2 2) | 0.6 |
| c | 201.0 | 1.1 | LINESTRING (2 2, 2 3) | 1.7 |
| d | 152.3 | 0.2 | LINESTRING (1 1, 2 1) | 0.2 |
| e | 176.4 | 0.5 | LINESTRING (2 1, 2 2) | NA |
| f | 108.6 | -0.2 | LINESTRING (2 2, 3 2) | 0.4 |
| g | 151.4 | 0.4 | LINESTRING (1 1, 1 0) | 0.4 |
| h | 186.3 | 0.3 | LINESTRING (1 0, 0 0) | 0.7 |
| i | 191.2 | 0.8 | LINESTRING (0 0, 0 1) | 1.5 |
【问题讨论】：
您能否提供一些使用dput 的node_paths 和edge_paths 的玩具示例？ collapse 包或 data.table 在涉及此类用例时通常优于 dplyr 和 base R，但在这里完全重写可能是矫枉过正。该循环似乎做了一些多余的操作，例如unlist(use.names = F) 或直接使用map_dbl 或summarise 会更好。
你是对的@Donald-seinen，使用 data.table 确实可以大大加快速度。还是有点慢，但感谢您的提示！
嗨！我很抱歉，但问题不是那么清楚。您可以使用玩具数据或内置数据（例如 roxel 数据）创建 reproducible example 吗？
嗨@agila，我要准备这个。有趣的是，当我收到您的评论时，我正在阅读something you wrote！
@agila，我希望通过我刚刚对问题所做的编辑更容易理解
【参考方案1】：
我不确定您要完成什么，但以下过程应该与您在第一篇文章中描述的过程相对应。
加载包
suppressPackageStartupMessages(
library(sf)
library(igraph)
library(tidygraph)
library(sfnetworks)
library(tibble)
)
定义假数据
fake_edges <- st_sf(
data.frame(
id = c('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i'),
weight = c(102.1, 98.3, 201.0, 152.3, 176.4, 108.6, 151.4, 186.3, 191.2),
soc = c(-0.1, 0.7, 1.1, 0.2, 0.5, -0.2, 0.4, 0.3, 0.8),
geometry = st_sfc(
st_linestring(rbind(c(1,1), c(1,2))),
st_linestring(rbind(c(1,2), c(2,2))),
st_linestring(rbind(c(2,2), c(2,3))),
st_linestring(rbind(c(1,1), c(2,1))),
st_linestring(rbind(c(2,1), c(2,2))),
st_linestring(rbind(c(2,2), c(3,2))),
st_linestring(rbind(c(1,1), c(1,0))),
st_linestring(rbind(c(1,0), c(0,0))),
st_linestring(rbind(c(0,0), c(0,1)))
)
)
)
从表中创建一个网络，并找到从第一个节点开始的最短路径 到所有其他节点
fake_net <- as_sfnetwork(fake_edges)
fake_paths <- st_network_paths(
x = fake_net,
from = V(fake_net)[1],
to = V(fake_net),
weights = 'weight',
type = 'shortest'
)
提取路径中最后一条边的id
idx_numeric <- unlist(lapply(fake_paths[["edge_paths"]], tail, n = 1L))
id <- fake_edges[["id"]][idx_numeric]
对于每条路径，计算路径所有边的 soc 和
result <- tapply(
X = fake_edges[["soc"]][unlist(fake_paths[["edge_paths"]])],
INDEX = rep(seq_len(nrow(fake_paths)), times = lengths(fake_paths[["edge_paths"]])),
FUN = sum
)
使用列 id 和 result 创建一个 tibble 对象
my_tbl <- tibble(
id = id,
result = result
)
运行左连接
left_join(fake_edges, my_tbl)
#> Joining, by = "id"
#> Simple feature collection with 9 features and 4 fields
#> Geometry type: LINESTRING
#> Dimension: XY
#> Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 3
#> CRS: NA
#> id weight soc result geometry
#> 1 a 102.1 -0.1 -0.1 LINESTRING (1 1, 1 2)
#> 2 b 98.3 0.7 0.6 LINESTRING (1 2, 2 2)
#> 3 c 201.0 1.1 1.7 LINESTRING (2 2, 2 3)
#> 4 d 152.3 0.2 0.2 LINESTRING (1 1, 2 1)
#> 5 e 176.4 0.5 NA LINESTRING (2 1, 2 2)
#> 6 f 108.6 -0.2 0.4 LINESTRING (2 2, 3 2)
#> 7 g 151.4 0.4 0.4 LINESTRING (1 1, 1 0)
#> 8 h 186.3 0.3 0.7 LINESTRING (1 0, 0 0)
#> 9 i 191.2 0.8 1.5 LINESTRING (0 0, 0 1)
我真的不明白算法背后的想法（所以我不确定如何模拟更大的网络），但我认为相同的“算法”在更大的网络上效果很好，你能测试一下吗？
【讨论】：
非常感谢，帽子太棒了，时间大幅缩短（在 90K 行表上从近 2 分钟缩短到约 20 秒）！这个想法是我现在想用它来为地图上result 列的不同阈值生成边缘周围的凸包。
很高兴它很有用！我只是想建议在更多（稍微大一点的）网络上比较这两个过程，以确保它们总是给出相同的结果。【参考方案2】：
按照 Donald Seinen 的提示，我使用 data.table 来加快速度。
library(data.table)
paths_dt = data.table(paths)
edges_dt = data.table(edges)
# Getting the sum of soc for all edges
paths_dt$result <- to_vec(for (edge in 1:nrow(paths_dt))
# Getting the id of the last edge
edges_dt[unlist(paths_dt[edge, 'edge_paths']), soc] %>% sum())
paths_dt$id <- apply(paths_dt, 1, function(df) unlist(edges_dt[df$edge_paths %>% last(), 'id'], use.names=F))
# Applying the result to the corresponding edge
edges_dt <- left_join(edges_dt, paths_dt %>% unlist() %>% select(id, result), on=id)
但是，尽管这比我以前做的更快，但它仍然需要很长时间（大约 10 分钟，而且我只处理了我应该使用的数据量的一小部分）。
如果有人可以提出另一个提示，我仍在寻找更好的方法。
【讨论】：
以上是关于带有索引列表的 R tibble：如何快速使用它们？的主要内容，如果未能解决你的问题，请参考以下文章