如何高效地将列表中所有的嵌套列表保存为data.frame格式？ - R

Question

我有以下列表，我想创建一个数据框来保存每个可能的“路径”，当数组的数值> 0时。

这是列表：

> ABBCCD2
$A1
$A1$B1
      D1    D2
C1 0.233 0.078
C2 0.039 0.039

$A1$B2
      D1    D2
C1 0.083 0.028
C2 0.056 0.056

$A1$B3
      D1    D2
C1 0.083 0.028
C2 0.056 0.056


$A2
$A2$B1
      D1    D2
C1 0.100 0.033
C2 0.017 0.017

$A2$B2
   D1 D2
C1  0  0
C2  0  0

$A2$B3
   D1 D2
C1  0  0
C2  0  0

这是我想要的结果：

> res
   FUN INTC INTB INME  prob
1   A1   B1   C1   D1 0.233
2   A1   B1   C1   D2 0.078
3   A1   B1   C2   D1 0.039
4   A1   B1   C2   D2 0.039
5   A1   B2   C1   D1 0.083
6   A1   B2   C1   D2 0.028
7   A1   B2   C2   D1 0.056
8   A1   B2   C2   D2 0.056
9   A1   B3   C1   D1 0.083
10  A1   B3   C1   D2 0.028
11  A1   B3   C2   D1 0.056
12  A1   B3   C2   D2 0.056
13  A2   B1   C1   D1 0.100
14  A2   B1   C1   D2 0.033
15  A2   B1   C2   D1 0.017
16  A2   B1   C2   D2 0.017

我已经用for循环解决了它，但效率不高，因为我遇到的实际问题有1500万条可能的路径，可能需要几天才能解决。

这是我编写的代码：

m <- 0

# creamos dataframe vacio
res <- data.frame(FUN=character(),INTC=character(),INTB=character(),INME=character(),prob=numeric())


for(i in 1:length(ABBCCD2)) { # A
  
 
  for (j in 1:length(ABBCCD2[[1]])) {  # B
    
    
    for(k in 1:nrow(ABBCCD2[[1]][[1]])) {  # C
      
      
      for(f in 1:ncol(ABBCCD2[[1]][[1]])) {  # D
       
        
        # solo guardamos las prob > 0
        if(ABBCCD2[[i]][[j]][k,f] > 0) {
        
        
            # contador de caminos con probabilidad no-cero
            m <- m + 1
            
            
            # creamos la fila del data frame correspondiente y vamos rellenando
            res[m,] <- data.frame(FUN=names(ABBCCD2[i]), INTC=names(ABBCCD2[[i]][j]), INTB=rownames(ABBCCD2[[i]][[j]])[k], 
                                 
                                 INME = colnames(ABBCCD2[[i]][[j]])[f] , prob = ABBCCD2[[i]][[j]][k,f] )
        }else{
          
        }

      }
    }
  }
}

有没有更加高效的解决方法？

感谢大家

- Jose Quesada

Answer 1

这里有一个选项

library(rrapply)
library(purrr)
library(dplyr)
library(tidyr)
map_depth(ABBCCD2, 2, ~ as.data.frame.table(.x)) %>% 
  map_dfr(~ bind_rows(.x, .id = 'INTC'), .id = 'FUN') %>% 
  rename_at(3:5, ~c("INTB", "INME", "prob"))  %>% 
  filter(prob != 0) 

-输出

#    FUN INTC INTB INME       prob
#1   A1   B1   C1   D1 -1.0978872
#2   A1   B1   C2   D1 -0.8782714
#3   A1   B1   C1   D2  0.1646925
#4   A1   B1   C2   D2  1.2239280
#5   A1   B2   C1   D1  0.2088934
#6   A1   B2   C2   D1  0.2191693
#7   A1   B2   C1   D2 -1.6247005
#8   A1   B2   C2   D2 -0.4496129
#9   A2   B1   C1   D1  0.3426282
#10  A2   B1   C2   D1 -1.0963979
#11  A2   B1   C1   D2  1.8424623
#12  A2   B1   C2   D2 -0.2248845
#13  A2   B2   C1   D1 -0.9655256
#14  A2   B2   C2   D1  0.6998366
#15  A2   B2   C1   D2 -1.2647063
#16  A2   B2   C2   D2  0.4514344

数据

ABBCCD2 <- list(A1 = list(B1 = structure(c(-1.0978871935389, -0.878271447742256, 
0.164692499183084, 1.22392804082201), .Dim = c(2L, 2L), .Dimnames = list(
    c("C1", "C2"), c("D1", "D2"))), B2 = structure(c(0.208893448902667, 
0.21916929248291, -1.62470051990683, -0.449612869059051), .Dim = c(2L, 
2L), .Dimnames = list(c("C1", "C2"), c("D1", "D2")))), A2 = list(
    B1 = structure(c(0.34262819072166, -1.09639792471103, 1.8424623311698, 
    -0.224884516346163), .Dim = c(2L, 2L), .Dimnames = list(c("C1", 
    "C2"), c("D1", "D2"))), B2 = structure(c(-0.965525564286861, 
    0.699836580462635, -1.26470634026811, 0.451434438203962), .Dim = c(2L, 
    2L), .Dimnames = list(c("C1", "C2"), c("D1", "D2"))), B3 = structure(c(0, 
    0, 0, 0), .Dim = c(2L, 2L), .Dimnames = list(c("C1", "C2"
    ), c("D1", "D2")))))

- akrun

---

非常感谢您，akrun， 您的解决方案非常高效 :) 我想我应该开始学习tydiverse编程。 - Jose Quesada

多么高端的解决方案！喜欢它！ - ThomasIsCoding

Answer 2

如果我理解正确，挑战在于：

• 将矩阵转换为数据框(data.frame)
• 跳过零矩阵(zero matrices)
• 将所有嵌套列表(nested lists)的部分绑定为一个大数据集
• 将其重塑(reshape)为长格式(long format)
• 保留列表元素和矩阵维度的名称

(执行不一定按照上述顺序)

另一个挑战是问题以打印的形式展示了嵌套列表，但没有以dput()等可重现的形式呈现。请参见“Data”部分，以将打印输出转换为列表结构。

---

为了完整起见，这里介绍另外两种方法。

• 嵌套lapply()和rbindlist()
• rrapply::rrapply()和reshape2::melt()

嵌套lapply()和rbindlist()

library(data.table)
library(magrittr)
res <- lapply(
  ABBCCD2, 
  function(x) lapply(x, as.data.table, keep.rownames = "INTB") %>% rbindlist(idcol = "INTC")
) %>% 
  rbindlist(idcol = "FUN") %>% 
  melt(measure.vars = patterns("^D"), variable.name = "INME", value.name = "prob") %>% 
  .[prob != 0] %>%
  setorderv(names(.))
res

    FUN INTC INTB INME  prob
 1:  A1   B1   C1   D1 0.233
 2:  A1   B1   C1   D2 0.078
 3:  A1   B1   C2   D1 0.039
 4:  A1   B1   C2   D2 0.039
 5:  A1   B2   C1   D1 0.083
 6:  A1   B2   C1   D2 0.028
 7:  A1   B2   C2   D1 0.056
 8:  A1   B2   C2   D2 0.056
 9:  A1   B3   C1   D1 0.083
10:  A1   B3   C1   D2 0.028
11:  A1   B3   C2   D1 0.056
12:  A1   B3   C2   D2 0.056
13:  A2   B1   C1   D1 0.100
14:  A2   B1   C1   D2 0.033
15:  A2   B1   C2   D1 0.017
16:  A2   B1   C2   D2 0.017

magrittr管道用于提高代码可读性。

这种方法将单个2 x 2矩阵转换为每个具有3列和2行的data.table。然后，通过两步rbindlist()将它们组合成一个大的data.table。最后，将两个值列重塑为长格式，并删除零prob值。

setorderv()仅用于允许与OP的预期结果进行直接比较。

注意：所有数据都被转换为长格式后才删除零prob值。如果其中一个矩阵只是因为偶然原因包含零元素，则可能会导致意外的结果。

rrapply()和矩阵melt()

这是一种不同的方法，它首先将矩阵转换为长格式data.table（在排除具有全部零元素的矩阵之后），然后通过两个rbindlist()步骤将它们组合成一个大数据集：

library(data.table)
library(magrittr)
library(rrapply)
res2 <- rrapply(ABBCCD2, 
                condition = function(x) sum(abs(x)) > 0, 
                f = function(x) reshape2::melt(x, value.name = "prob"), 
                classes = "matrix", how = "prune") %>% 
  lapply(rbindlist, idcol = "INTC") %>% 
  rbindlist(idcol = "FUN") %>% 
  setnames(c("Var1", "Var2"), c("INTB", "INME"))%>%
  setorderv(names(.))
res2

结果与上述相同。

数据

以下是将打印输出转换为嵌套列表结构的方法：

txt <- "$A1
$A1$B1
D1    D2
C1 0.233 0.078
C2 0.039 0.039

$A1$B2
D1    D2
C1 0.083 0.028
C2 0.056 0.056

$A1$B3
D1    D2
C1 0.083 0.028
C2 0.056 0.056


$A2
$A2$B1
D1    D2
C1 0.100 0.033
C2 0.017 0.017

$A2$B2
D1 D2
C1  0  0
C2  0  0

$A2$B3
D1 D2
C1  0  0
C2  0  0"

txt 包含从问题中复制和粘贴的打印输出内容。

library(data.table)
library(magrittr)
library(rrapply)

ABBCCD2 <- fread(text = txt, sep = NULL, header = FALSE, blank.lines.skip = TRUE) %>% 
  .[, tstrsplit(V1, "\\$")] %>% 
  .[, c("V2", "V3") := zoo::na.locf(.SD, na.rm = FALSE), .SDcols = c("V2", "V3")] %>% 
  .[V1 != ""] %>% 
  split(by = c("V2", "V3"), flatten = FALSE, keep.by = FALSE) %>% 
  rrapply(
    f = . %>% 
      .[, paste0(V1, collapse = "\n") %>% 
          {paste("rn", .)} %>% 
          fread() %>% 
          as.matrix(rownames = "rn")]
    , classes = "data.frame", how = "replace")


ABBCCD2

$A1
$A1$B1
      D1    D2
C1 0.233 0.078
C2 0.039 0.039

$A1$B2
      D1    D2
C1 0.083 0.028
C2 0.056 0.056

$A1$B3
      D1    D2
C1 0.083 0.028
C2 0.056 0.056


$A2
$A2$B1
      D1    D2
C1 0.100 0.033
C2 0.017 0.017

$A2$B2
   D1 D2
C1  0  0
C2  0  0

$A2$B3
   D1 D2
C1  0  0
C2  0  0

- Uwe

Answer 3

这是一个使用基本R选项的示例，使用stack函数。

rev(
  transform(
    stack(df <- as.data.frame(
      rapply(ABBCCD2,
        t,
        how = "replace"
      )
    )),
    ind = paste0(ind, ".", row.names(df))
  )
)

这提供了

           ind     values
1  A1.B1.C1.D1 -1.0978872
2  A1.B1.C1.D2  0.1646925
3  A1.B1.C2.D1 -0.8782714
4  A1.B1.C2.D2  1.2239280
5  A1.B2.C1.D1  0.2088934
6  A1.B2.C1.D2 -1.6247005
7  A1.B2.C2.D1  0.2191693
8  A1.B2.C2.D2 -0.4496129
9  A2.B1.C1.D1  0.3426282
10 A2.B1.C1.D2  1.8424623
11 A2.B1.C2.D1 -1.0963979
12 A2.B1.C2.D2 -0.2248845
13 A2.B2.C1.D1 -0.9655256
14 A2.B2.C1.D2 -1.2647063
15 A2.B2.C2.D1  0.6998366
16 A2.B2.C2.D2  0.4514344
17 A2.B3.C1.D1  0.0000000
18 A2.B3.C1.D2  0.0000000
19 A2.B3.C2.D1  0.0000000
20 A2.B3.C2.D2  0.0000000

- ThomasIsCoding