2016-01-23 4 views
0

Рассмотрите список смешанных классов, например, что возвращается с 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" 
+0

Для 'mtcars' например, по крайней мере, вы могли бы просто используйте 'tmp <- lapply (1: length (bp1), function (x) cbind (bp1 [[x]], bp2 [[x]])); имена (tmp) <- names (bp1) '. Однако это не супер-робаст. Сглаживание с помощью 'c (list, recursive = TRUE)' и восстановление будет работать для более сложных структур, но будет намного больше работать. [Этот вопрос] (https://xkcd.com/1205/), действительно. – alistaire

ответ

3

Эта функция, похоже, выполняет свою работу, но проста, поэтому ее можно, вероятно, легко сломать.

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 

Update - новая версия (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 
} 
+0

Не уверен, что это стоит усилий/времени, но, я думаю, более гибким подходом было бы сохранить ядро ​​'cList' простым и использовать функцию -eg-' horiz_concat = (...) UseMethod ("horiz_concat") '+ методы, которые выполняют определенную проверку для каждого класса объектов, которые будут« конкатенированы по горизонтали ». Тогда 'cList' нужно будет беспокоиться только о конкатенации как таковой и позволить соответствующей функции выполнять определенную работу. Вы могли бы также включить 'cList' accept' ... 'аргументы и, возможно, добавить проверку, что, если нет имен, существует элементная конкатенация? –

Смежные вопросы