Преобразование несимметричного векторного списка в матрицу

Question

Как можно преобразовать объект списка (с разной длиной) в матричный объект в эффективном способом! Следуя примеру уточнения оной цели:

представьте у вас есть список объектов структуры:

l <- list(c(1,2), c(5,7,3,11)) 
print(l) 

# [[1]] 
# [1] 1 2 

# [[2]] 
# [1] 5 7 3 11 

Цель состоит в том, чтобы получить матрицу или data.frame в виде:

 [,1] [,2] [,3] [,4] 
[1,] 1 2 NA NA 
[2,] 5 7 3 11 

Очень легко решить проблему с помощью петли. Есть ли у вас какие-либо идеи, как можно легко сделать такое преобразование? Заранее спасибо!

Answer 1

Вы также можете попробовать

t(sapply(l, `length<-`, max(sapply(l, length)))) 
#  [,1] [,2] [,3] [,4] 
#[1,] 1 2 NA NA 
#[2,] 5 7 3 11 

Answer 2

Вот один из способов сделать это:

n <- max(sapply(l, length)) 
t(sapply(l, function(x) if(length(x) < n) c(x, rep(NA, n - length(x))) else x)) 

    [,1] [,2] [,3] [,4] 
[1,] 1 2 NA NA 
[2,] 5 7 3 11 

Сначала мы выяснить максимальную длину вектора каждого элемента списка и хранить его в n (который является 4 в данном случае).

Затем мы sapply по списку и проверить, если длина элемента списка равна n и если да, то вернуть его, если он короче, чем n, возвращает элемент списка + повторяется NA так часто, как разница в длину. Это возвращает матрицу. Мы используем t() на этой матрице, чтобы транспонировать его и получить желаемый результат.

Answer 3

Если вы открыты для использования пакета, вы могли бы также рассмотреть вопрос о stri_list2matrix из "STRINGI" пакет:

library(stringi) 
l <- list(c(1,2), c(5,7,3,11)) 
stri_list2matrix(l, byrow = TRUE) 
#  [,1] [,2] [,3] [,4] 
# [1,] "1" "2" NA NA 
# [2,] "5" "7" "3" "11" 

---

Что касается вашего вопроса об этом эффективно, ответ @ akrun уже довольно эффективен, но можно сделать более эффективным, используя vapply вместо sapply. «Стройный» подход также довольно эффективен (и имеет преимущество не прибегать к загадочному коду, например, length<-).

funDD <- function() { 
    n <- max(sapply(l, length)) 
    t(sapply(l, function(x) if(length(x) < n) c(x, rep(NA, n - length(x))) else x)) 
} 

funAK <- function() t(sapply(l, `length<-`, max(sapply(l, length)))) 

funAM <- function() { 
    x <- max(vapply(l, length, 1L)) 
    t(vapply(l, `length<-`, numeric(x), x)) 
} 

funStringi <- function() stri_list2matrix(l, byrow = TRUE) 

## Make a big list to test on 
set.seed(1) 
l <- lapply(sample(3:10, 1000000, TRUE), function(x) sample(10, x, TRUE)) 

system.time(out1 <- funDD()) 
# user system elapsed 
# 5.81 0.33 7.02 

library(microbenchmark) 
microbenchmark(funAK(), funAM(), funStringi(), times = 10) 
# Unit: seconds 
#   expr  min  lq  mean median  uq  max neval 
#  funAK() 2.350877 2.499963 2.974141 3.123008 3.200545 3.418648 10 
#  funAM() 1.154151 1.238235 1.337607 1.287610 1.494964 1.508884 10 
# funStringi() 2.080901 2.168248 2.352030 2.344763 2.462959 2.716910 10