水平连接列表

Question

考虑一个混合类列表，例如从 boxplot 返回的内容。我想连接每个列表元素，水平堆叠每对元素。

（我单击了所有“类似问题”并进行了搜索，但不知道执行此操作的基本功能，modifyList 相似但不完全是我想要的。我还快速浏览了包rlist，但没有什么让我觉得相似。this question/answer 也相似，但仅适用于矢量）

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"

这个想法是将上面的两个列表组合成一个简单地完成以下操作的列表：

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

Answer 1

这个函数看起来可以完成工作，但很简单，所以它很可能很容易被破坏。

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

也适用于嵌套列表或不具有相同顺序的相同元素的列表，需要注意的是列表必须命名，否则函数不知道要连接哪些元素。

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

---

更新——新版本（approximately here）可以rbind或cbind矩形对象（矩阵、数据框）

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
}