Find root nodes in a hierarchical data.frame-CodePudding

I have a data.frame providing me with hierarchical information for it's rows (DF_in):

   id parent_id
1   1        NA
2   2        NA
3   3         1
4   4         2
5   5         3
6   6         4
7   7         1
8   8         2
9   9         3
10 10         4

I'd like to find the root_id for each row (DF_out):

   id parent_id root_id
1   1        NA      NA
2   2        NA      NA
3   3         1       1
4   4         2       2
5   5         3       1
6   6         4       2
7   7         1       1
8   8         2       2
9   9         3       1
10 10         4       2

Usually I prefer working with data.table's but this seems to need a recursive solution and I don't know how to solve this efficiently.

DF_in <- data.frame(id = 1:10, parent_id = c(NA, NA, 1:4, 1:4))
# library(data.table)
# setDT(DF_in)

DF_out <- data.frame(id = 1:10, parent_id = c(NA, NA, 1:4, 1:4), root_id = c(NA, NA, rep(1:2, 4)))

CodePudding user response：

Something quick:

find_root <- function(id, table) {
  par <- table[match(id, table$id), 'parent_id']
  if (is.na(par)) id else find_root(id = par, table)
}

DF_in$root_id <- vapply(DF_in$id, \(x) find_root(x, DF_in), integer(1L))


> DF_in
   id parent_id root_id
1   1        NA       1
2   2        NA       2
3   3         1       1
4   4         2       2
5   5         3       1
6   6         4       2
7   7         1       1
8   8         2       2
9   9         3       1
10 10         4       2

CodePudding user response：

Here is another solution using dplyr. Of course you can turn it into a function if there is the need to run this piece of code multiple times.

library(dplyr)
#> 
#> Attache Paket: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

id <- c(1:10)

parent_id <- c(NA, NA, 1, 2, 3, 4, 1, 2, 3, 4)

df <- tibble(id = id, parent_id = parent_id)

df %>%
  mutate(
    root_id = pull(
      left_join(
        x = df,
        y = df,
        by = c("parent_id" = "id")),
      "parent_id.y"),
    root_id = ifelse(
      test = is.na(root_id) & !is.na(parent_id),
      yes = parent_id,
      no = root_id
    )
  )
#> # A tibble: 10 x 3
#>       id parent_id root_id
#>    <int>     <dbl>   <dbl>
#>  1     1        NA      NA
#>  2     2        NA      NA
#>  3     3         1       1
#>  4     4         2       2
#>  5     5         3       1
#>  6     6         4       2
#>  7     7         1       1
#>  8     8         2       2
#>  9     9         3       1
#> 10    10         4       2

^{Created on 2021-10-12 by the reprex package (v2.0.1)}