通过两个数据帧和一个矩阵进行匹配和索引

Matching and indexing through two dataframes and one matrix

  1. 我有一个数据框 events,其中包含唯一点的 xy 坐标。
  2. 我有一个包含网络节点 xy 坐标的数据框 all_nodesevents中的所有点也在all_nodes中,但不一定只有一次,而且在不同的位置,即events中的一个点的索引(row id)不对应all_nodes.
  3. 我有一个维度 nrow(all_nodes) 乘以 nrow(all_nodes) 的矩阵 ma,其中计算了所有节点之间的成对交互项。 marows 和 cols 对应于 all_nodes.
  4. 的索引 (row_ids)

我的总体目标 是识别 all_nodesevents 的行 ID。有了这个,我的目标是根据检测到的行 ID 从我的矩阵 ma 中提取成对交互的子矩阵。最后我想改变 submtarix 的顺序,使 ids 和对应的点对应于 events。非常感谢任何形式的帮助 (code/reference/hint)!

玩具数据(下面可以找到真实数据)

# coords of unique events 
events <- data.frame(x = c(1,2,3,4),
                     y = c(4,3,2,1))
# all_nodes 
all_nodes <- data.frame(x = c(2,1,120,3,150,4,1),
                     y = c(3,4,120,2,150,1,4))
# matrix corresponding to the index of all_nodes
ma <- matrix(data = rnorm(n = 49, mean = 3, sd = 1), 
             nrow = nrow(all_nodes), ncol = nrow(all_nodes))
ma[6, ] <- ma[2, ]

我的努力 这不是很有帮助,因为我 运行 遇到了几个问题。

# coords of unique events 
events # see toy data

# ------------------------------------------------
# from object g of class  "sfnetwork" "tbl_graph" "igraph" 
# all rounded coords of nodes; from g ma is used 
# in several steps 
# cols and rows in ma correspond to node ids of g/all_nodes

# all_nodes <- g %>% tidygraph::activate("nodes") %>%
# as.data.frame(geometry)
# all_nodes <- as.data.frame(matrix(unlist(all_nodes$geometry), ncol = 2, byrow = TRUE))
# names(all_nodes) <- c('x', 'y')
# all_nodes <- round(all_nodes, 2)
# --------------------------------------------------

# matching based on x-coord only 
ix <- which(all_nodes$x %in% events$x)
# Problem A
length(ix) == nrow(events) # different length
# Problem B
# and the event with coords x=1, y=4 occurs twice in ix 

sub <- ma[ix, ix]
# If problems A+B were eleminated, sub would correspond to 
# all events, but I different indexing makes it unusable  #(several permutations possible)

我还玩过 st_equals {sf},在上一步中使用 events <- sf::st_as_sf(events[, c('x', 'y')], coords = c('x', 'y')) 直接比较几何图形。

真实数据

# removed 

也许我们应该像下面那样完成 match 任务

idx <- match(do.call(paste, events), do.call(paste, all_nodes))
ma[idx,idx]

idx <- match(asplit(events, 1), asplit(all_nodes, 1))
ma[idx, idx]

基准

TIC1 <- function() {
    match(do.call(paste, events), do.call(paste, all_nodes))
}

TIC2 <- function() {
    match(asplit(events, 1), asplit(all_nodes, 1))
}


GKi <- function() {
    match(interaction(events),interaction(all_nodes))
}

library(bench)
bm <- mark(
    TIC1(),
    TIC2(),
    GKi()
)
autoplot(bm)

给予

> bm
# A tibble: 3 x 13
  expression     min  median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
  <bch:expr> <bch:t> <bch:t>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
1 TIC1()     175.9us 197.5us     4573.        0B     24.5  2052    11      449ms
2 TIC2()      30.2us  32.1us    28884.        0B     14.4  9995     5      346ms
3 GKi()      311.2us 349.1us     2741.    1.53KB     27.1  1212    12      442ms
# ... with 4 more variables: result <list>, memory <list>, time <list>,
#   gc <list>

interaction 可用于 match 多列。

idx <- match(interaction(events), interaction(all_nodes))
ma[idx,idx]