在R中将可变长度列表转换为数据帧的更快方法

在R中将可变长度列表转换为数据帧的更快方法,r,R,我有一个可变长度的列表,如下所示 chr [1:249] "1" "29.12" "2" "20.78" "3" "12.09" ... chr [1:200] "1" "20.45" "3" "10.56" "4" "12.34" ... chr [1:213] "2" "12.20" "3" "19.93" "5" "23.05" ... X1 X2 X3 X4 X5 1 29.12 20.78 12.09 NA NA 2 20.45 NA 1

我有一个可变长度的列表,如下所示

chr [1:249] "1" "29.12" "2" "20.78" "3" "12.09" ...
chr [1:200] "1" "20.45" "3" "10.56" "4" "12.34" ...
chr [1:213] "2" "12.20" "3" "19.93" "5" "23.05" ...
   X1    X2    X3    X4    X5
1  29.12 20.78 12.09 NA    NA
2  20.45 NA    10.56 12.34 NA
3  NA    12.20 19.93 NA    23.05
奇数位置(“1”、“3”、“4”等)中的值表示具有特定含义的变量,而偶数位置中的值表示由其前面的数字表示的变量值。例如,在列表的第二个元素中,变量“3”的值为“10.56”

我试图将其转换为一个数据框,将“10.56”这样的值放入数据框的正确列,即“3”列。这是我正在使用的代码

e <- unlist(d[[k]])  ## d is my list. k is the index for a for loop
pos_index <- seq(1, length(e), 2) ## gives positions for the variables
val_index <- seq(2, length(e), 2) ## gives positions for corresponding values
df_index <- as.numeric(e[pos_index])

## Populate a pre-defined data frame at calculated positions
CNNIBN_DF[k, df_index] <- as.numeric(e[val_index])
这是可行的,但需要很长时间<代码>系统时间对于1000个实体

user   system  elapsed 
57.64  0.06    58.14
列表本身有33k个实体,每个实体有200多个元素。我已经尝试了同样的操作,只对循环使用了
,但这两种方法都需要大约相同的时间

有没有更快的方法?我使用的是一台win32机器,内存为4GB,运行Intel Core i3 M350 CPU,速度为2.27 GHz

提前谢谢

试试看

lst1 <- lapply(lst, function(x) { x<- as.numeric(x)
                    indx <- c(TRUE, FALSE)
                   v1 <- tabulate(x[indx])
                   is.na(v1) <- v1==0
                   v1[!is.na(v1)] <- x[!indx]
                   v1 })

setNames(do.call(rbind.data.frame,lapply(lst1, `length<-`,
                         max(lengths(lst1)))), paste0('X', 1:5))
#     X1    X2    X3    X4    X5
#1 29.12 20.78 12.09    NA    NA
#2 20.45    NA 10.56 12.34    NA
#3    NA 12.20 19.93    NA 23.05
可以通过
as.matrix
将其转换为
matrix

library(tidyr)
library(dplyr)
d1 <- unnest(lst, group) 
d2 <- bind_cols(slice(d1, seq(1, n(), by=2)), slice(d1, seq(2, n(), by=2))[2])
colnames(d2)[3] <- 'val'
spread(d2, x, val) %>%
                  select(-group)
#     1     2     3     4     5
#1 29.12 20.78 12.09  <NA>  <NA>
#2 20.45  <NA> 10.56 12.34  <NA>
#3  <NA> 12.20 19.93  <NA> 23.05
基准 对于1000个实体的列表

set.seed(42)
lst <- lapply(1:1000, function(i) {v1 <- sample(50:200)[1L]
                     v2 <- sample(1:200, v1, replace=FALSE)
                     as.character(c(rbind(v2, rnorm(v1))))})

system.time({
  m1 <- do.call(rbind,Map(function(x,y) cbind(x,matrix(as.numeric(y), 
     nrow=length(y)/2, byrow=TRUE)), seq_along(lst), lst))
  m2 <- matrix(NA, ncol=max(m1[,2]), nrow=length(lst))
  m2[m1[,-3]] <- m1[,3]
 })
#  user  system elapsed 
# 0.064   0.004   0.067 


system.time({
  m1 <- do.call(rbind,Map(function(x,y) cbind(x,matrix(as.numeric(y),
          nrow=length(y)/2, byrow=TRUE)), seq_along(lst), lst))
  d1 <- setNames(as.data.frame(m1), c('Row', 'Col', 'Value'))
   with(d1, sparseMatrix(Row, Col, x=Value))
   })
#  user  system elapsed 
# 0.068   0.003   0.070 


system.time({d1 <- unnest(lst, group)
          d2 <-  bind_cols(slice(d1, seq(1, n(), by=2)),
                  slice(d1, seq(2, n(), by=2))[2])
          colnames(d2)[3] <- 'val'
          res <- spread(d2, x, val) %>%
                       select(-group)}) 
 #    user  system elapsed 
 #  0.259   0.002   0.261 
@alexis_-laz方法速度更快

 system.time({
  ulst = unlist(lst)
  cols = seq(1, length(ulst), 2)
 inds = cbind(row = rep(seq_along(lst), lengths(lst) %/% 2), 
            col = as.integer(ulst[cols]))
 vals = as.numeric(ulst[-cols])
 ans = matrix(, max(inds[, "row"]), max(inds[, "col"]))
  ans[inds] = vals
 })
#  user  system elapsed 
#  2.421   0.041   2.460 
数据
lst试试看

可以通过
as.matrix
将其转换为
matrix

library(tidyr)
library(dplyr)
d1 <- unnest(lst, group) 
d2 <- bind_cols(slice(d1, seq(1, n(), by=2)), slice(d1, seq(2, n(), by=2))[2])
colnames(d2)[3] <- 'val'
spread(d2, x, val) %>%
                  select(-group)
#     1     2     3     4     5
#1 29.12 20.78 12.09  <NA>  <NA>
#2 20.45  <NA> 10.56 12.34  <NA>
#3  <NA> 12.20 19.93  <NA> 23.05
基准 对于1000个实体的列表

set.seed(42)
lst <- lapply(1:1000, function(i) {v1 <- sample(50:200)[1L]
                     v2 <- sample(1:200, v1, replace=FALSE)
                     as.character(c(rbind(v2, rnorm(v1))))})

system.time({
  m1 <- do.call(rbind,Map(function(x,y) cbind(x,matrix(as.numeric(y), 
     nrow=length(y)/2, byrow=TRUE)), seq_along(lst), lst))
  m2 <- matrix(NA, ncol=max(m1[,2]), nrow=length(lst))
  m2[m1[,-3]] <- m1[,3]
 })
#  user  system elapsed 
# 0.064   0.004   0.067 


system.time({
  m1 <- do.call(rbind,Map(function(x,y) cbind(x,matrix(as.numeric(y),
          nrow=length(y)/2, byrow=TRUE)), seq_along(lst), lst))
  d1 <- setNames(as.data.frame(m1), c('Row', 'Col', 'Value'))
   with(d1, sparseMatrix(Row, Col, x=Value))
   })
#  user  system elapsed 
# 0.068   0.003   0.070 


system.time({d1 <- unnest(lst, group)
          d2 <-  bind_cols(slice(d1, seq(1, n(), by=2)),
                  slice(d1, seq(2, n(), by=2))[2])
          colnames(d2)[3] <- 'val'
          res <- spread(d2, x, val) %>%
                       select(-group)}) 
 #    user  system elapsed 
 #  0.259   0.002   0.261 
@alexis_-laz方法速度更快

 system.time({
  ulst = unlist(lst)
  cols = seq(1, length(ulst), 2)
 inds = cbind(row = rep(seq_along(lst), lengths(lst) %/% 2), 
            col = as.integer(ulst[cols]))
 vals = as.numeric(ulst[-cols])
 ans = matrix(, max(inds[, "row"]), max(inds[, "col"]))
  ans[inds] = vals
 })
#  user  system elapsed 
#  2.421   0.041   2.460 
数据
lstAkrun已经发布了许多可能的替代方案中的一些;我将只添加一个更明确的方法,该方法看起来尽可能少(使用akrun的“lst”):


从您的目标来看,似乎不需要“data.frame”,但“matrix”很容易转换为一个。此外,为了避免这种奇怪的格式,您是否可以对数据的构建/获取进行操作,这也是值得研究的;我将只添加一个更明确的方法,该方法看起来尽可能少(使用akrun的“lst”):


从您的目标来看,似乎不需要“data.frame”,但“matrix”很容易转换为一个。另外,为了避免这种奇怪的格式,您是否可以操作数据的构建/获取,这可能值得研究。

我没有看到您的帖子,因为页面没有更新。我更新了一个矩阵方法,但我想它和你的方法不同。我想测试一下这个方法。你能把它变得更一般一些吗,例如
长度(lst[[1]])
@akrun:我错误地认为“lst”中的所有元素都是相同的
长度。我相应地修改了答案。谢谢,你的方法更快。我想这一定是因为我使用了
Map
而不是
取消了整个列表list@akrun:可能,
地图
是你的瓶颈;一、 最初,我的想法和你的一样,但我尽量避免任何可以“矢量化”完成的事情。我没有看到你的帖子,因为页面没有更新。我更新了一个矩阵方法,但我想它和你的方法不同。我想测试一下这个方法。你能把它变得更一般一些吗,例如
长度(lst[[1]])
@akrun:我错误地认为“lst”中的所有元素都是相同的
长度。我相应地修改了答案。谢谢,你的方法更快。我想这一定是因为我使用了
Map
而不是
取消了整个列表list@akrun:可能,
地图
是你的瓶颈;一、 起初,我的想法与你的想法相同,但我尽量避免任何可以通过矢量方式实现的事情。谢谢Akrun!给出的选项真的很有帮助。谢谢Akrun!给出的选项真的很有用。
set.seed(42)
lst <- lapply(1:33000, function(i) {v1 <- sample(50:200)[1L]
                 v2 <- sample(1:200, v1, replace=FALSE)
                   as.character(c(rbind(v2, rnorm(v1))))})
 system.time({
  m1 <- do.call(rbind,Map(function(x,y) cbind(x,matrix(as.numeric(y), 
     nrow=length(y)/2, byrow=TRUE)), seq_along(lst), lst))
  m2 <- matrix(NA, ncol=max(m1[,2]), nrow=length(lst))
  m2[m1[,-3]] <- m1[,3]
 })
 #  user  system elapsed 
 # 6.160   0.102   6.260 
 system.time({
  ulst = unlist(lst)
  cols = seq(1, length(ulst), 2)
 inds = cbind(row = rep(seq_along(lst), lengths(lst) %/% 2), 
            col = as.integer(ulst[cols]))
 vals = as.numeric(ulst[-cols])
 ans = matrix(, max(inds[, "row"]), max(inds[, "col"]))
  ans[inds] = vals
 })
#  user  system elapsed 
#  2.421   0.041   2.460 
lst <- list(c('1', '29.12', '2', '20.78', '3', '12.09'), c('1', '20.45',
'3', '10.56', '4', '12.34'), c('2', '12.20', '3', '19.93', '5', '23.05'))
ulst = unlist(lst)
cols = seq(1, length(ulst), 2)
inds = cbind(row = rep(seq_along(lst), lengths(lst) %/% 2), 
             col = as.integer(ulst[cols]))
vals = as.numeric(ulst[-cols])
ans = matrix(, max(inds[, "row"]), max(inds[, "col"]))
ans[inds] = vals
#      [,1]  [,2]  [,3]  [,4]  [,5]
#[1,] 29.12 20.78 12.09    NA    NA
#[2,] 20.45    NA 10.56 12.34    NA
#[3,]    NA 12.20 19.93    NA 23.05