子列表的子列表提取和按给定范围分组到新列表

时间:2016-04-04 19:40:17

标签: r

对于具有所需输出的下面的函数,我有以下列表和索引范围参考。我的目标是根据A和E指示的索引列表选择范围选择和分组主列表子列表。尝试过两种方式,但似乎无法完成此操作。

RECX5  <- list ( list ( c( 1 , 2 , 3 , 4 , 5 ) , c( 6 , 7 , 8 , 9 , 10 ) , c( 11 , 12 , 13 , 14, 15 )) , list (c( -11 , -12 , -13 , -14 , -15 ) , c( 16 , 17 , 18 , 19 , 20 ) , c( 21 , 22 , 23 , 24, 25 ))) 

# SUB-SELECT LISTS 
A <- c(1,2)

# SELECT RANGE FOR LISTS
E <- data.frame ( c(1,2) , c(1,5))

for ( i in seq(nrow(E)) )
fun <-  function ( x ) RECX5 [[ x ]] [ E[ ,1 ] [[ i ]] : E[ ,2 ] [[ i ]] ] 
D   <-  lapply (  seq(length ( A )) , fun )
# D
[[1]]
[[1]][[1]]
[1]  6  7  8  9 10

[[1]][[2]]
[1] 11 12 13 14 15

[[1]][[3]]
NULL

[[1]][[4]]
NULL


[[2]]
[[2]][[1]]
[1] 16 17 18 19 20

[[2]][[2]]
[1] 21 22 23 24 25

[[2]][[3]]
NULL

[[2]][[4]]
NULL


DESIRED RESULT : 
[[1]]
[[1]][[1]]
1  2  3  4  5 
[[1]][[2]]
-11 -12 -13 -14 -15   

[[2]]
[[2]][[1]][[1]]
6  7  8  9 10 
[[2][[1]][[2]]
16 17 18  19  20 
[[2]][[2]][[1]]
11 12 13 14 15 
[[2]][[2]][[2]]
21 22 23 24 25 

2 个答案:

答案 0 :(得分:-1)

这产生了预期的结构,但显然不是通用的:

> list(list(RECX5[[1]][[1]],RECX5[[2]][[1]]),
+      list(list(RECX5[[1]][[2]],RECX5[[2]][[2]]),
+           list(RECX5[[1]][[3]],RECX5[[2]][[3]])))
[[1]]
[[1]][[1]]
[1] 1 2 3 4 5

[[1]][[2]]
[1] -11 -12 -13 -14 -15


[[2]]
[[2]][[1]]
[[2]][[1]][[1]]
[1]  6  7  8  9 10

[[2]][[1]][[2]]
[1] 16 17 18 19 20


[[2]][[2]]
[[2]][[2]][[1]]
[1] 11 12 13 14 15

[[2]][[2]][[2]]
[1] 21 22 23 24 25

你更想要什么?一般来说[抱歉],您可以通过选择索引级别然后lapply某些范围的索引function(x) [that expression]来概括上述内容,其中您希望功能化的索引级别上的多个调用将替换为{ {1}}。

修改/更新

根据我的几条评论,我不明白您认为自己如何一般性地指定解决方案的输入,但我已经在这里阐明了一种方法,应该指出解决方案的要求是什么。理想情况下,如果您确实有一些我认为没有硬编码的假设,您可以简化此策略。

注意,是的,此解决方案仍然在处理任意深度的结果列表时不是通用的。这是可行的,但更糟糕的是。

首先:让我们走一下列表,将其结构构建为一个表格。这将使在最终函数调用中遍历列表变得更容易:

x

现在手动构建您将传递给该函数的所需结果结构。这是我不了解你试图做的事情的地方。不知何故,结果函数需要 all 这个信息:输入中的每个元素都将精确地放在输出的列表结构中?我在这个例子中做了这个特别具体的事情,但是如果你有简化的假设,你就可以跳过一些细节:

library(data.table)
build.structure <- function(src) {
    rbindlist(lapply(1:length(src),
              function(x) data.table(input.position.depth.0=rep(x,length(src[[x]])),
                                     input.position.depth.1=1:length(src[[x]]))))
}

struct <- build.structure(RECX5)
> struct
   input.position.depth.0 input.position.depth.1
1:                      1                      1
2:                      1                      2
3:                      1                      3
4:                      2                      1
5:                      2                      2
6:                      2                      3

注意读取 down 列中的此文本是元素的结果列表位置;当您显示您阅读的表格时:

struct[,result.position.depth.0:=c( 1, 2, 2,  1, 2, 2)]
struct[,result.position.depth.1:=c( 1, 1, 2,  2, 1, 2)]
struct[,result.position.depth.2:=c(NA, 1, 1, NA, 2, 2)]

我在下面编写的函数假设新列表是通过深度索引按元素的字典顺序构建的,因此对此表进行相应的排序:

> struct
   input.position.depth.0 input.position.depth.1 result.position.depth.0 result.position.depth.1
1:                      1                      1                       1                       1
2:                      2                      1                       1                       2
3:                      1                      2                       2                       1
4:                      2                      2                       2                       1
5:                      1                      3                       2                       2
6:                      2                      3                       2                       2
   result.position.depth.2
1:                      NA
2:                      NA
3:                       1
4:                       2
5:                       1
6:                       2

(注意,这里有一般性细分。如果你需要这个更深入2级,setkey(struct,result.position.depth.0, result.position.depth.1, result.position.depth.2) 数据并添加一个额外的深度列来引用该列的深度&#39; s值,并相应地修改以下深度,而不是硬编码预期的深度。)

现在是一个便利函数,用于从我们刚刚构建的表中的行指定的输入列表中提取数据:

melt

现在很长一段时间。

首先制作一个全球对象。 (这只是意味着我们不必担心引用。这可以避免,但我不打扰。)

extract <- function(src,struct,a.row) {
    src[[struct[a.row,input.position.depth.0]]][[struct[a.row,input.position.depth.1]]]
}

然后让我们使用修改此对象的函数[参见注释内联]

result <<- list()

好的,现在我们可以运行它(忽略它打印的内容,或添加get.lists.from.structure <- function(src, struct) { lapply(1:nrow(struct), function(the.row) { #Extract the value that we'll insert next val <- extract(src,struct,the.row) #If there's not already a slot at the top level for this value, #make an empty list there so we'll have a place to put it. #Without this you'll get subscript out of bounds errors if(length(result) < struct[the.row,result.position.depth.0]) { result[[struct[the.row,result.position.depth.0]]] <<- list() } #Now if the resulting object is getting stuck one level down, #take the first branch; just put it there. if(struct[the.row,is.na(result.position.depth.2)]) { result[[struct[the.row,result.position.depth.0 ]]][[struct[the.row,result.position.depth.1]]] <<- val } else { #otherwise, take this branch, but WAIT! Repeat the same check; #if there's not already a slot at this depth, put #an empty list in if(length(result[[struct[the.row,result.position.depth.0]]]) < struct[the.row,result.position.depth.1]) { result[[struct[the.row,result.position.depth.0 ]]][[struct[the.row,result.position.depth.1]]] <<- list() } #then put the value in at its intended position. result[[struct[the.row,result.position.depth.0 ]]][[struct[the.row,result.position.depth.1 ]]][[struct[the.row,result.position.depth.2]]] <<- val } }) }

invisible

并检查它是否对get.lists.from.structure(RECX5,struct)

有正确的副作用
result

答案 1 :(得分:-1)

Use : lapply ( list name , '[' ,  list number )


RECX5  <- list ( list ( c( 1 , 2 , 3 , 4 , 5 ) , c( 6 , 7 , 8 , 9 , 10 ) , c( 11 , 12 , 13 , 14, 15 )) , list (c( -11 , -12 , -13 , -14 , -15 ) , c( 16 , 17 , 18 , 19 , 20 ) , c( 21 , 22 , 23 , 24, 25 ))) 
# SUBSELECT LISTS. 
A       <-  c ( 1 , 2 )
# SELECT LISTS. 
B        <-  data.frame ( c ( 1 , 2 ) , c( 1 , 5 ))

# Possible solution, however I does the null results of running the sequence over the function so it adds two null list to at the end of the last lists.

fun     <-  function ( x ) ( B[,x] [2] - B[,x] [1] ) 
E1      <-  lapply ( seq ( nrow ( B )) , fun )
fun     <-  function ( x ) ( E[,2] [[x]] - E[,1] [[x]] )+1 
E1      <-  lapply ( seq ( nrow ( E )) , fun )
fun     <-  function ( x )  seq ( E1[[ x ]] )
E2      <-  lapply ( seq ( length ( E1 )) , fun )
E3      <-  relist ( seq ( unlist ( E2 )) , E2 )
fun    <- function ( y ) lapply ( RECX5 , '[' ,  unlist ( E3[ y ] ))
E4     <- lapply (seq(length(E3)) , fun )