Path along linked values taking the lowest value each time - r

Question

I have a data.table with two columns "From" and "To" as follows:
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))
The data.table will always be sorted as shown in the example above, with "From" and "To" values increasing from smallest to largest.
I need to find a 'path' starting from the first 'From' (which will always be '1'), through to the last 'To' value, subject to always choosing the lowest 'To' value.
In the above example, I would have 1 --> 3, then 3 --> 4, then 4 --> 5, then finally 5 --> 6.
I then want to return in a vector 1, 3, 4, 5, and 6, representing the linked values.
The only way that I can think of doing it is using a while or for loop and looping through each group of 'From' values and iteratively choosing the smallest. That seems inefficient though and will probably be very slow on my actual data set which is over 100,000 rows long.
Are there any data.table-like solutions?
I also thought that maybe igraph would have a method for this, but I must admit that I currently have pretty much zero knowledge of this function.
Any help would be greatly appreciated.
Thanks,
Phil
EDIT:
Thanks for all the responses so far.
My example/explanation wasn't a great one sorry, as I didn't explain that the 'From' / 'To' pairs don't need to go all the way through to the end value of the 'To' column.
Using the example from the comments below:
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))
The output would simply be a vector of c(1, 3), as it will start at 1, choose the lowest value which is 3, and then because there are no 'From' values of '3', it wouldn't continue any further.
Another example:
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))
The intended output here is a vector c(1,2,5); following the path 1 --> 2, then 2 --> 5, at which point it stops as there is no '5' value in the "From" column.
Hopefully, that makes sense, and apologies for the lack of clarity in the original question.
Thanks,
Phil

Answer 1

You can try the code below
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()
or simpler with subcomponent (as #clp did)
dt %>%
group_by(From) %>%
slice_min(To) %>%
graph_from_data_frame() %>%
subcomponent(v = "1", mode = "out") %>%
names() %>%
as.integer()
which gives
For the first new updated data
[1] 1 3
For the second updaed data
[1] 1 2 5

Answer 2

Assuming an ordered From and To list this may work.
It first groups by From, compresses by To, then excludes non-matching From-To values using shift.
If jumps are missing (e.g. To 3 but From 3 missing) it prints 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

Answer 3

Using from Igraph and subcomponents().
After ThomasisCoding's comment, I realized that graph_from_data_frame creates a graph by name.
This is a waste of memory (and time) if the graph is large (1E6).
Note also that graph_from_edgelist(as.matrix(...)) is much faster.
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")))
First attempt.
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")))

Answer 4

I can't seem to get the other answers to work with certain tables. E.g.,
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
This igraph solution seems to work based on a little more extensive testing:
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

Answer 5

A sequential solution is feasable.
Copying one million dataframe lines took 8 seconds on my system.
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)
Output.
[1] 500000.5
[1] 1000000
Updated after last edit of Phil.
The first step is to simplify the input (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
Set path to first start node and
subsequently append end nodes.
## 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)
Output:
[1] 1 3 4 5 6 , df as in first example.
[1] 1 2 5 , df as in another example.