How to bind two lists with same structure?

Question

Introduction

I have two nested lists with the same structure that I'd like to combine (in the c() sense).

There might already exist a concept for what I mean by same structure in graph theory, or in computer science, for this relationship but I am not aware.

So here is my attempt to clarify what I mean by same structure:

• Elements of a list at some level are either all named or none is named;
• When we have named elements there are never duplicated names at that level;
• Parent-child node relationships are the same for the two lists, when the nodes are named elements themselves.

So I am wondering if there is already a solution for this problem which I feel might be rather general and common...(?) Any solution involving:

• Using base rapply;
• Tidyverse solution with some combination of purrr functions;
• Functions from the rlist package

would be great!

Example

foo and bar are two example lists with same structure.

wonderful is the desired list that results from combining foo and bar (done manually).

I hope it is clear enough!

# Input lists: foo and bar
foo <- list(a = list(a1 = 1:3, a2 = rep('a', 3)), b = list(b1 = list(b11 = c(4,5,6), b12 = rep('b', 3)), b2 = list(b21 = list(b31 = c(0, 1, 2)))), c = list(list(c21 = 1:3), list(c21 = 4:6), list(c21 = 7:9)))
bar <- list(a = list(a1 = 1:3, a2 = rep('z', 3)), b = list(b1 = list(b11 = c(-1,2,5), b12 = rep('b', 3)), b2 = list(b21 = list(b31 = -c(1,2,3)))), c = list(list(c21 = 3:1), list(c21 = 5:3)))

# wonderful: desired list (result from combining foo and bar)
wonderful <- list(
  a = list(
    a1 = c(foo$a$a1, bar$a$a1), 
    a2 = c(foo$a$a2, bar$a$a2)
    ),
  b = list(
    b1 = list(
      b11 = c(foo$b$b1$b11, bar$b$b1$b11),
      b12 = c(foo$b$b1$b12, bar$b$b1$b12)
      ),
    b2 = list(
      b21 = list(
        b31 = c(foo$b$b2$b21$b31, bar$b$b2$b21$b31)
        )
      )
    ),
  c = c(foo$c, bar$c)
)

str(foo)
#> List of 3
#>  $ a:List of 2
#>   ..$ a1: int [1:3] 1 2 3
#>   ..$ a2: chr [1:3] "a" "a" "a"
#>  $ b:List of 2
#>   ..$ b1:List of 2
#>   .. ..$ b11: num [1:3] 4 5 6
#>   .. ..$ b12: chr [1:3] "b" "b" "b"
#>   ..$ b2:List of 1
#>   .. ..$ b21:List of 1
#>   .. .. ..$ b31: num [1:3] 0 1 2
#>  $ c:List of 3
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 1 2 3
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 4 5 6
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 7 8 9

str(bar)
#> List of 3
#>  $ a:List of 2
#>   ..$ a1: int [1:3] 1 2 3
#>   ..$ a2: chr [1:3] "z" "z" "z"
#>  $ b:List of 2
#>   ..$ b1:List of 2
#>   .. ..$ b11: num [1:3] -1 2 5
#>   .. ..$ b12: chr [1:3] "b" "b" "b"
#>   ..$ b2:List of 1
#>   .. ..$ b21:List of 1
#>   .. .. ..$ b31: num [1:3] -1 -2 -3
#>  $ c:List of 2
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 3 2 1
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 5 4 3

str(wonderful)
#> List of 3
#>  $ a:List of 2
#>   ..$ a1: int [1:6] 1 2 3 1 2 3
#>   ..$ a2: chr [1:6] "a" "a" "a" "z" ...
#>  $ b:List of 2
#>   ..$ b1:List of 2
#>   .. ..$ b11: num [1:6] 4 5 6 -1 2 5
#>   .. ..$ b12: chr [1:6] "b" "b" "b" "b" ...
#>   ..$ b2:List of 1
#>   .. ..$ b21:List of 1
#>   .. .. ..$ b31: num [1:6] 0 1 2 -1 -2 -3
#>  $ c:List of 5
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 1 2 3
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 4 5 6
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 7 8 9
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 3 2 1
#>   ..$ :List of 1
#>   .. ..$ c21: int [1:3] 5 4 3

Answer 1

After thinking a bit more about this problem in general... and after some inspiration from dplyr's joins, here's three joins for lists for my own future reference:

• lst_left_join
• lst_right_join
• lst_inner_join

library(purrr)

#
# Inspired by dplyr's joins: https://r4ds.had.co.nz/relational-data.html#inner-join
# Here's some (more or less equivalent) list joins
# 
lst_left_join <- function(lst_x, lst_y) {
  if(is.atomic(lst_x) || is.null(names(lst_x))){
    c(lst_x, lst_y)
  } else {
    imap(lst_x, ~lst_left_join(lst_x[[.y]], lst_y[[.y]]))
  }
}

plst_left_join <- function(.l) reduce(.l, lst_left_join)

lst_right_join <- function(lst_x, lst_y) {
  if(is.atomic(lst_y) || is.null(names(lst_y))){
    c(lst_x, lst_y)
  } else {
    imap(lst_y, ~lst_right_join(lst_x[[.y]], lst_y[[.y]]))
  }
}

plst_right_join <- function(.l) reduce(.l, lst_right_join)

lst_inner_join <- function(lst_x, lst_y) {
  if(is.atomic(lst_y) || is.null(names(lst_y))){
    c(lst_x, lst_y)
  } else {
    common_names <- intersect(names(lst_x), names(lst_y))
    names(common_names) <- common_names # so that map preserves names
    map(common_names, ~lst_inner_join(lst_x[[.x]], lst_y[[.x]]))
  }
}
plst_inner_join <- function(.l) reduce(.l, lst_inner_join)

# Input lists: foo and bar.
foo <- list(x1 = 1:2, x3 = 30+5:6)
bar <- list(x1 = 10+1:2, x2 = 10+3:4)

# Output lists: r1, r2 and r3.
r1 <- lst_left_join(foo, bar)
r2 <- lst_right_join(foo, bar)
r3 <- lst_inner_join(foo, bar)

str(r1)
#> List of 2
#>  $ x1: num [1:4] 1 2 11 12
#>  $ x3: num [1:2] 35 36
str(r2)
#> List of 2
#>  $ x1: num [1:4] 1 2 11 12
#>  $ x2: num [1:2] 13 14
str(r3)
#> List of 1
#>  $ x1: num [1:4] 1 2 11 12

Answer 2

Here's a go at it:

library(purrr)

rec_map <- function(fizz, buzz) {
  if(is.atomic(fizz) | is.null(names(fizz))){
    c(fizz, buzz)
  } else {
    imap(fizz,
         ~rec_map(fizz[[.y]], buzz[[.y]]))
  }
}

temp <- rec_map(foo, bar)

all.equal(temp, wonderful)
#> [1] TRUE

I'm by no means a computer scientist, so take the solution with a grain of salt. I am not certain about the behavior desired when there are no names for one level, but then one level down there are names (e.g., foo$c). So I just combined the results (c()) if we encountered a level without names.

edit to take a number of lists:

prec_map <- function(...){
  dots <- list(...)
  first_el = dots[[1]]
  if(is.atomic(first_el) | is.null(names(first_el))){
    do.call(c, dots)
  } else {
    imap(first_el,
         function(el, nme){
           one_level_down <- map(dots, nme)
           do.call(prec_map, one_level_down)
         })
  }
}

temp <- prec_map(foo, bar)

all.equal(temp, wonderful)
[1] TRUE

I haven't tested it out thoroughly, but light testing looks like it gets the job done.

Answer 3

list_merge does something close to the requirements:

library(purrr)

res <- list_merge(foo, !!! bar)

all.equal(wonderful, list_merge(foo, !!! bar))
# [1] "Component “c”: Length mismatch: comparison on first 3 components"       
# [2] "Component “c”: Component 1: Component 1: Numeric: lengths (3, 6) differ"
# [3] "Component “c”: Component 2: Component 1: Numeric: lengths (3, 6) differ"

The only difference seems to be for elements that are unnamed lists (e.g. foo$c and bar$c), the elements of which are concatenated by position (foo$c[[1]] with bar$c[[1]], foo$c[[2]] with bar$c[[2]], and foo$c[[3]] left alone since there is no bar$c[[3]]... rather than c(foo$c, bar$c)).

---

And a parallel version could be:

plist_merge <- function(.l) {
  reduce(.l, ~ list_merge(.x, !!! .y))
}

all.equal(
  plist_merge(list(foo, bar)),
  list_merge(foo, !!! bar)
)
# [1] TRUE