rawr
rawr

Reputation: 20811

Concatenate lists horizontally

Consider a list of mixed classes like what returns from boxplot. I want to concatenate each list element, sort of stack each pair of elements horizontally.

(I clicked all of the "similar questions" and searched and am not aware of a base function to do this, modifyList being similar but not exactly what I want. I also looked quickly through the package rlist, but nothing struck me as similar. Also this question/answer is similar but only works for vectors)

f <- function(x) boxplot(mpg ~ vs, data = x, plot = FALSE)

(bp1 <- f(mtcars[mtcars$vs == 0, ]))
# $stats
#       [,1]
# [1,] 10.40
# [2,] 14.70
# [3,] 15.65
# [4,] 19.20
# [5,] 21.00
# 
# $n
# [1] 18
# 
# $conf
#          [,1]
# [1,] 13.97416
# [2,] 17.32584
# 
# $out
# [1] 26
# 
# $group
# [1] 1
# 
# $names
# [1] "0"


(bp2 <- f(mtcars[mtcars$vs == 1, ]))
# $stats
#      [,1]
# [1,] 17.8
# [2,] 21.4
# [3,] 22.8
# [4,] 30.4
# [5,] 33.9
# 
# $n
# [1] 14
# 
# $conf
#          [,1]
# [1,] 18.99955
# [2,] 26.60045
# 
# $out
# numeric(0)
# 
# $group
# numeric(0)
# 
# $names
# [1] "1"

The idea is to combine the two lists above into what one would get having simply done the following:

(bp  <- f(mtcars))
# $stats
#       [,1] [,2]
# [1,] 10.40 17.8
# [2,] 14.70 21.4
# [3,] 15.65 22.8
# [4,] 19.20 30.4
# [5,] 21.00 33.9
# 
# $n
# [1] 18 14
# 
# $conf
#          [,1]     [,2]
# [1,] 13.97416 18.99955
# [2,] 17.32584 26.60045
# 
# $out
# [1] 26
# 
# $group
# [1] 1
# 
# $names
# [1] "0" "1"

Upvotes: 0

Views: 842

Answers (1)

rawr
rawr

Reputation: 20811

This function seems to get the job done but is simple, so it can probably be broken easily.

cList <- function (x, y) {
  islist  <- function(x) inherits(x, 'list')
  get_fun <- function(x, y)
    switch(class(if (is.null(x)) y else x),
           matrix = cbind,
           data.frame = function(x, y)
             do.call('cbind.data.frame', Filter(Negate(is.null), list(x, y))),
           factor = function(...) unlist(list(...)), c)

  stopifnot(islist(x), islist(y))
  nn <- names(rapply(c(x, y), names, how = 'list'))
  if (is.null(nn) || any(!nzchar(nn)))
    stop('All non-NULL list elements should have unique names', domain = NA)

  nn <- unique(c(names(x), names(y)))
  z <- setNames(vector('list', length(nn)), nn)

  for (ii in nn)
    z[[ii]] <- if (islist(x[[ii]]) && islist(y[[ii]]))
      Recall(x[[ii]], y[[ii]]) else
        (get_fun(x[[ii]], y[[ii]]))(x[[ii]], y[[ii]])
  z
}

f <- function(x) boxplot(mpg ~ vs, data = x, plot = FALSE)
bp1 <- f(mtcars[mtcars$vs == 0, ])
bp2 <- f(mtcars[mtcars$vs == 1, ])
bp  <- f(mtcars)
identical(cList(bp1, bp2), bp)
# [1] TRUE

Also works on nested lists or lists not having the same elements in the same order, the caveat being the lists must be named, otherwise the function doesn't know which elements to concatenate.

l0 <- list(x = 1:5, y = matrix(1:4, 2), z = head(cars), l = list(1:5))
l1 <- list(x = factor(1:5), y = matrix(1:4, 2), z = head(cars), l = list(zz = 1:5))
l2 <- list(z = head(cbind(cars, cars)), x = factor('a'), l = list(zz = 6:10))

cList(l0, l2) ## should throw error
cList(l1, l2)

# $x
# [1] 1 2 3 4 5 a
# Levels: 1 2 3 4 5 a
# 
# $y
#      [,1] [,2]
# [1,]    1    3
# [2,]    2    4
# 
# $z
#   speed dist speed dist speed dist
# 1     4    2     4    2     4    2
# 2     4   10     4   10     4   10
# 3     7    4     7    4     7    4
# 4     7   22     7   22     7   22
# 5     8   16     8   16     8   16
# 6     9   10     9   10     9   10
# 
# $l
# $l$zz
# [1]  1  2  3  4  5  6  7  8  9 10

Update -- new version (approximately here) which can rbind or cbind rectangular objects (matrices, data frames)

cList <- function(x, y, how = c('cbind', 'rbind')) {
  if (missing(y))
    return(x)

  how <- match.arg(how)

  islist  <- function(x) inherits(x, 'list')
  get_fun <- function(x, y)
    switch(class(if (is.null(x)) y else x),
           matrix = match.fun(how),
           data.frame = function(x, y)
             do.call(sprintf('%s.data.frame', how),
                     Filter(Negate(is.null), list(x, y))),
           factor = function(...) unlist(list(...)), c)

  stopifnot(islist(x), islist(y))
  nn <- names(rapply(c(x, y), names, how = 'list'))

  if (is.null(nn) || any(!nzchar(nn)))
    stop('All non-NULL list elements should have unique names', domain = NA)

  nn <- unique(c(names(x), names(y)))
  z <- setNames(vector('list', length(nn)), nn)

  for (ii in nn)
    z[[ii]] <- if (islist(x[[ii]]) && islist(y[[ii]]))
      Recall(x[[ii]], y[[ii]]) else
        (get_fun(x[[ii]], y[[ii]]))(x[[ii]], y[[ii]])
  z
}

Upvotes: 3

Related Questions