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

У меня есть data.table с двумя столбцами «От» и «Кому» следующим образом:

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 всегда будет сортироваться, как показано в примере выше, при этом значения «От» и «До» увеличиваются от меньшего к большему.

Мне нужно найти «путь», начиная с первого «От» (который всегда будет «1») до последнего значения «Кому», всегда выбирая наименьшее значение «Кому». В приведенном выше примере у меня было бы 1 --> 3, затем 3 --> 4, затем 4 --> 5, затем, наконец, 5 --> 6.

Затем я хочу вернуть вектор 1, 3, 4, 5 и 6, представляющий связанные значения.

Единственный способ, который я могу придумать, - это использовать цикл while или for и перебирать каждую группу значений «От» и итеративно выбирать наименьшее. Это кажется неэффективным и, вероятно, будет очень медленным для моего фактического набора данных, длина которого превышает 100 000 строк.

Есть ли какие-нибудь data.table-подобные решения? Я также думал, что, возможно, у igraph есть метод для этого, но я должен признать, что в настоящее время у меня практически нет знаний об этой функции.

Любая помощь будет принята с благодарностью.

Спасибо, Фил

Обновлено:

Спасибо за все ответы. Мой пример/объяснение не был удачным, извините, так как я не объяснил, что парам «От» / «Кому» не нужно проходить весь путь до конечного значения столбца «Кому».

Используя пример из комментариев ниже:

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, после чего он останавливается, так как в столбце "От" нет значения "5".

Надеюсь, это имеет смысл, и приносим извинения за отсутствие ясности в исходном вопросе.

Спасибо, Фил

Не как data.table, но если я правильно понял, вы можете заказать To в порядке возрастания, затем получить его уникальные значения (или наоборот), а затем добавить From[1] в начало: with(df, c(From[1], unique(To[order(To)])))

Ricardo Semião e Castro 21.11.2022 22:55

@ThomasIsCoding опубликовал еще один пример набора данных: 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)) Можете ли вы сказать нам, каков желаемый результат? Также рассмотрите любые другие пограничные случаи из вашего реального сценария.

arg0naut91 21.11.2022 23:54

Спасибо @ arg0naut91, хорошее предложение. Пожалуйста, смотрите мои правки выше с этим примером и еще одним.

Phil 25.11.2022 22:40
Как настроить Tailwind CSS с React.js и Next.js?
Как настроить Tailwind CSS с React.js и Next.js?
Tailwind CSS - единственный фреймворк, который, как я убедился, масштабируется в больших командах. Он легко настраивается, адаптируется к любому...
LeetCode запись решения 2536. Увеличение подматриц на единицу
LeetCode запись решения 2536. Увеличение подматриц на единицу
Увеличение подматриц на единицу - LeetCode
Переключение светлых/темных тем
Переключение светлых/темных тем
В Microsoft Training - Guided Project - Build a simple website with web pages, CSS files and JavaScript files, мы объясняем, как CSS можно...
Отношения &quot;многие ко многим&quot; в Laravel с методами присоединения и отсоединения
Отношения &quot;многие ко многим&quot; в Laravel с методами присоединения и отсоединения
Отношения "многие ко многим" в Laravel могут быть немного сложными, но с помощью Eloquent ORM и его моделей мы можем сделать это с легкостью. В этой...
В PHP
В PHP
В большой кодовой базе с множеством различных компонентов классы, функции и константы могут иметь одинаковые имена. Это может привести к путанице и...
Карта дорог Беладжар PHP Laravel
Карта дорог Беладжар PHP Laravel
Laravel - это PHP-фреймворк, разработанный для облегчения разработки веб-приложений. Laravel предоставляет различные функции, упрощающие разработку...
3
3
193
5
Перейти к ответу Данный вопрос помечен как решенный

Ответы 5

Ответ принят как подходящий

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

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

Спасибо @ThomasIsCoding. Это очень хорошо работает для приведенного выше примера. К сожалению, я не полностью объяснил различные крайние случаи, которые могут возникнуть и которые не будут работать для приведенного выше кода. Не могли бы вы взглянуть на исправленные примеры, которые я добавил?

Phil 26.11.2022 10:27

@ Фил, я думаю, вы можете сделать это, используя subcomponent (предпочтительнее) или ego, если вы придерживаетесь igraph. Пожалуйста, смотрите обновление.

ThomasIsCoding 28.11.2022 17:04

Предполагая упорядоченный список 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

Хороший data.table ответ! +1!

ThomasIsCoding 22.11.2022 08:48

Спасибо @Andre Wildberg. Это хорошо работает для примера, который я опубликовал, но, к сожалению, я не очень хорошо объяснил полные критерии. Не могли бы вы взглянуть на мой отредактированный вопрос/примеры?

Phil 26.11.2022 10:29

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

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")))

Хорошее решение с subcomponent, оно играет волшебно, что я почти забыл о нем! +1! Кстати, вы должны использовать "1" вместо 1, когда вы индексируете вершину по имени, если вы его не знаете vid.

ThomasIsCoding 27.11.2022 20:52

Хорошая точка зрения. Мое намерение состояло в том, чтобы создать граф без имен вершин. Для экономии памяти, когда фрейм данных очень большой (1E6). Вот почему я использовал 1 вместо «1».

clp 27.11.2022 22:20

Я также пробовал dfs() и bfs(). Эти функции работают медленнее.

clp 27.11.2022 22:21

Другие вопросы по теме