Question

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

（我点击了所有“类似的问题”并进行了搜索，并且我不知道这样做的基本功能，modifyList是相似但不完全是我想要的。我还快速查看了包{{} 3}}，但没有任何东西让我觉得相似。rlist类似但只适用于矢量）

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

更新 - 可以rbind或cbind矩形对象（矩阵，数据框）的新版本（this question/answer）

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
}

水平连接列表

1 个答案: