Путь вдоль связанных значений, каждый раз принимая наименьшее значение

Вы можете попробовать код ниже

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

Предполагая упорядоченный список From и To, это может сработать.

Сначала он группирует по From, сжимает по To, затем исключает несовпадающие значения From-To с помощью shift.

Если переходы отсутствуют (например, до 3, но отсутствует от 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

Кажется, я не могу заставить другие ответы работать с определенными таблицами. Например.,

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

Возможно последовательное решение. Копирование одного миллиона строк данных заняло 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.

Использование от Igraph и subcomponents().

После комментария 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")))