繁体   English   中英

R - 有效地将列表列表的所有元素保存为 data.frame

[英]R - save as data.frame all elements of a list of lists efficiently

我有以下列表,当 arrays 的数值大于 0 时,我想创建一个包含所有可能“路径”的 data.frame。

这是列表:

> 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{
          
        }

      }
    }
  }
}

有什么想法可以更有效地解决它吗?

谢谢你们

这是一个选项

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")))))

如果我理解正确,挑战是

  • 将矩阵转换为 data.frames,
  • 跳过零矩阵,
  • 将嵌套列表中的所有部分绑定到一个大数据集中,
  • 重塑成长格式,
  • 保留列表元素和矩阵维度的名称。

(不一定按此顺序执行)

另一个挑战是该问题以打印形式显示嵌套列表,但不是以可复制形式显示,例如dput() 请参阅将打印输出转换为列表结构的数据部分。


为了完整起见,这里有另外两种方法。

  • 嵌套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.tables。 然后通过rbindlist()分两步将它们组合起来,形成一个大的 data.table。 最后,将两个值列重新整形为长格式并删除零prob值。

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

警告:在所有数据都转换为长格式后,将删除零prob值。 如果其中一个矩阵偶然包含零元素,这可能会导致意外结果。

rrapply() 和矩阵melt()

这是一种不同的方法,它首先将矩阵重塑为长格式 data.tables(在排除所有零元素的矩阵之后),然后通过两个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

这是使用stack的基本 R 选项

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM