R语言 沿着链接值的路径,每次取最小值

mgdq6dx1  于 2022-12-06  发布在  其他
关注(0)|答案(5)|浏览(124)

我有一个data.table,其中有两列“From”和“To”,如下所示:

data.table(From = c(1,1,1,1,2,2,2,2,3,3,3,4,4,5),
           To = c(3,4,5,6,3,4,5,6,4,5,6,5,6,6))

data.table将始终按上例所示排序,其中“From”和“To”值从最小到最大递增。
我需要找到一个从第一个“From”(始终为“1”)开始到最后一个“To”值的“路径”,但始终选择最小的“To”值。在上面的例子中,我将有1 --〉3,然后3 --〉4,然后4 --〉5,最后5 --〉6。
然后我想返回一个向量1,3,4,5和6,代表链接的值。
我能想到的唯一方法是使用while或for循环,循环遍历每组“From”值,并迭代选择最小值。这似乎效率很低,而且在我的实际数据集上可能会非常慢,因为它超过100,000行。
有没有类似于数据表的解决方案?我也认为igraph可能会有一个方法,但我必须承认,我目前对这个函数几乎一无所知。
如有任何帮助,我们将不胜感激。
谢谢你,菲尔
编辑:
感谢到目前为止所有的回答。我的例子/解释不是很好,抱歉,因为我没有解释'From' / 'To'对不需要一直到'To'列的结束值。
使用以下注解中的示例:

dt <- data.table(From = c(1, 1, 1, 1, 2, 2, 2, 2, 4, 4, 5), 
                   To = c(3, 4, 5, 6, 3, 4, 5, 6, 5, 6, 6))

输出将简单地是c(1,3)的向量,因为它将从1开始,选择最小值3,然后因为没有“从”值"3“,它将不再继续。
再举一个例子:

dt <- data.table(From = c(1,1,1,2,2,3,3,4,4),
                   To = c(2,3,4,5,6,4,7,8,9))

这里的预期输出是向量c(1,2,5);遵循路径1 --〉2,然后2 --〉5,在该点停止,因为在“From”列中没有“5”值。
希望这是有意义的,并为最初的问题缺乏明确性表示歉意。
谢谢你,菲尔

aemubtdh

aemubtdh1#

您可以尝试以下代码

dt %>%
  group_by(From) %>%
  slice_min(To) %>%
  graph_from_data_frame() %>%
  ego(
    order = sum((m <- membership(components(.))) == m[names(m) == "1"]),
    nodes = "1",
    mode = "out"
  ) %>%
  pluck(1) %>%
    names() %>%
    as.numeric()

或者使用subcomponent更简单(如@clp)

dt %>%
  group_by(From) %>%
  slice_min(To) %>%
  graph_from_data_frame() %>%
  subcomponent(v = "1", mode = "out") %>%
  names() %>%
  as.integer()

其给出了

  • 对于第一个新的更新数据
[1] 1 3
  • 对于第二次更新的数据
[1] 1 2 5
u3r8eeie

u3r8eeie2#

假设有一个有序的 FromTo 列表,这可能有效。
它首先按 From 分组,按 To 压缩,然后使用shift排除不匹配的 From-To 值。
如果缺少跳转(例如,To 3但 From 3缺失),则打印NULL

dt[, .(frst = first(To)), From][
  , if(all((frst %in% From)[1:(.N - 1)])){
      c(1, unique(frst[From == shift(frst, type = "lag", fill = T)]))}]
[1] 1 3 4 5 6
jq6vz3qz

jq6vz3qz3#

Igraphsubcomponents()使用。
在ThomasisCoding的评论之后,我意识到graph_from_data_frame是通过名称创建图的。如果图很大(1E6),这是对内存(和时间)的浪费。还要注意graph_from_edgelist(as.matrix(...))要快得多。

dt2 <- setNames(aggregate(dt$To, list(dt$From), "min"), c("From", "To") )
g <- graph_from_edgelist(as.matrix(dt2), directed=TRUE) 
as.numeric(as_ids(subcomponent(g, 1, mode="out")))

第一次尝试

dt2 <- setNames(aggregate(dt$To, list(dt$From), "min"), c("From", "To") )
g <- graph_from_data_frame(dt2, directed=TRUE) 
as.numeric(as_ids(subcomponent(g, 1, mode="out")))
gtlvzcf8

gtlvzcf84#

我似乎无法得到其他答案来处理某些表。例如,

library(data.table)
library(igraph)
library(purrr)

dt <- data.table(
  From = c(1, 1, 1, 1, 2, 2, 4, 5),
  To = c(3, 4, 5, 6, 4, 6, 6, 6)
)

fPath1 <- function(dt) {
  setorder(dt, From, To)[, wt := fifelse(rleid(To)==1,1,Inf), From] %>%
    graph_from_data_frame() %>%
    set_edge_attr(name = "weight", value = dt[, wt]) %>%
    shortest_paths(min(dt[, From]), max(dt[, To])) %>%
    pluck(1) %>%
    unlist(use.names = FALSE)
}

fPath2 <- function(dt) {
  dt[, .SD[which.min(To)], From] %>%
    graph_from_data_frame() %>%
    shortest_paths(min(dt[, From]), max(dt[, To])) %>%
    pluck(1) %>%
    unlist(use.names = FALSE)
}

fPath3 <- function(dt) {
  dt[, .(frst = first(To)), From][
    , if(all((frst %in% From)[1:(.N - 1)])){
      c(1, unique(frst[From == shift(frst, type = "lag", fill = T)]))}]
}

fPath1(dt)
#> [1] 1 6
fPath2(dt)
#> Warning in shortest_paths(., min(dt[, From]), max(dt[, To])): At core/paths/
#> unweighted.c:368 : Couldn't reach some vertices.
#> integer(0)
fPath3(dt)
#> NULL

这个igraph解决方案似乎是基于更广泛的测试而工作的:

fPath4 <- function(dt) {
  g <- graph_from_data_frame(dt)
  E(g)$weight <- (dt$To - dt$From)^2
  as.integer(V(g)[shortest_paths(g, V(g)[1], V(g)[name == dt$To[nrow(dt)]])$vpath[[1]]]$name)
}

fPath4(dt)
#> [1] 1 4 6
ycl3bljg

ycl3bljg5#

一个连续的解决方案是可行的。复制一百万行 Dataframe 在我的系统上花了8秒。

n <- 1E6
df1 <- data.frame(from=sample(n), to=sample(n))
path <- c()
system.time(
for (i in seq(nrow(df1)) ){
  path[length(path) + 1] <- df1[i, "to"]   # avoid copying.
}
)
mean(path)
length(path)

输出。

[1] 500000.5
[1] 1000000

更新后,菲尔的最后一次编辑。第一步是简化输入(df)。

## Select min(To) by From.
if (nrow(df) > 0) { df2 <- setNames(aggregate(df$To, list(df$From), "min"), c("From", "To") )
} else              df2 <- df

将路径设置为第一个开始节点,然后追加结束节点

## Let tt is maximal outgoing node upto now.
path <- df2[1,1]
tt <- df2[1,1]
for (i in seq_len(nrow(df2))){
  if      (df2[i, 1] < tt) next
  else if (df2[i,1] == tt) { tt <- df2[i, 2]
                             path[length(path) + 1] <- df2[i, 2]
                           }
  else                     break
}
head(path)

输出量:

[1] 1 3 4 5 6 , df as in first example.
[1] 1 2 5     , df as in another example.

相关问题