如何获取列表中元素的位置？答案

【问题标题】：How to get the position of elements in a list?如何获取列表中元素的位置？
【发布时间】：2016-02-17 12:35:58
【问题描述】：

给定一个列表变量，我想要一个包含每个元素位置的数据框。对于一个简单的非嵌套列表来说，这似乎很简单。

例如，这是一个字符向量列表。

l <- replicate(
  10,
  sample(letters, rpois(1, 2), replace = TRUE),
  simplify = FALSE
)

l 看起来像这样：

[[1]]
[1] "m"

[[2]]
[1] "o" "r"

[[3]]
[1] "g" "m"
# etc.

要获取位置的数据框，我可以使用：

d <- data.frame(
  value = unlist(l),
  i = rep(seq_len(length(l)), lengths(l)),
  j = rapply(l, seq_along, how = "unlist"),
  stringsAsFactors = FALSE
)
head(d)
##   value i j
## 1     m 1 1
## 2     o 2 1
## 3     r 2 2
## 4     g 3 1
## 5     m 3 2
## 6     w 4 1

给定一个更复杂的嵌套列表，例如：

l2 <- list(
  "a",
  list("b", list("c", c("d", "a", "e"))),
  character(),
  c("e", "b"),
  list("e"),
  list(list(list("f")))
)

这不容易概括。

我期望这个例子的输出是：

data.frame(
  value = c("a", "b", "c", "d", "a", "e", "e", "b", "e", "f"), 
  i1 = c(1, 2, 2, 2, 2, 2, 4, 4, 5, 6), 
  i2 = c(1, 1, 2, 2, 2, 2, 1, 2, 1, 1), 
  i3 = c(NA, 1, 1, 2, 2, 2, NA, NA, 1, 1), 
  i4 = c(NA, NA, 1, 1, 2, 3, NA, NA, NA, 1), 
  i5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 1)
)

如何获取嵌套列表的位置数据框？

【问题讨论】：

您是否期望一个具有 6 列（值 + 5 级嵌套）的 data.frame 作为l2 的结果？
这似乎本质上是melt(l2) + rapply(l2, seq_along) 的组合。问题是如何轻松地将这两者结合起来:-)
@AnandaMahto，这非常简单——如果你作为答案发帖，我会支持你
@docendodiscimus，发布了答案。它（显然）没有你的方法那么快。

标签： r list

【解决方案1】：

这是一种产生与您展示的稍有不同的输出的方法，但它在以后会很有用。

f <- function(l) {
  names(l) <- seq_along(l)
  lapply(l, function(x) {
    x <- setNames(x, seq_along(x))
    if(is.list(x)) f(x) else x
  })
}

函数f 简单地（递归地）遍历给定列表的所有级别并将其元素命名为1,2,...,n，其中n 是（子）列表的长度。然后，我们可以利用 unlist 有一个 use.names 参数，默认为 TRUE 并且在用于命名列表时有效（这就是为什么我们必须使用 f 来命名列表的原因） )。

对于嵌套列表l2，它返回：

unlist(f(l2))
#      1.1     2.1.1   2.2.1.1   2.2.2.1   2.2.2.2   2.2.2.3       4.1       4.2     5.1.1 6.1.1.1.1 
#      "a"       "b"       "c"       "d"       "a"       "e"       "e"       "b"       "e"       "f"

现在，为了按照问题中的要求返回 data.frame，我会这样做：

g <- function(l) {
  vec <- unlist(f(l))
  n <- max(lengths(strsplit(names(vec), ".", fixed=TRUE)))
  require(tidyr)
  data.frame(
    value = unname(vec),
    i = names(vec)
  ) %>% 
    separate(i, paste0("i", 1:n), sep = "\\.", fill = "right", convert = TRUE)
}

并像这样应用它：

g(l2)
#   value i1 i2 i3 i4 i5
#1      a  1  1 NA NA NA
#2      b  2  1  1 NA NA
#3      c  2  2  1  1 NA
#4      d  2  2  2  1 NA
#5      a  2  2  2  2 NA
#6      e  2  2  2  3 NA
#7      e  4  1 NA NA NA
#8      b  4  2 NA NA NA
#9      e  5  1  1 NA NA
#10     f  6  1  1  1  1

@AnandaMahto 贡献的g 的改进版本（谢谢！）将使用data.table：

g <- function(inlist) {
    require(data.table)
    temp <- unlist(f(inlist))
    setDT(tstrsplit(names(temp), ".", fixed = TRUE))[, value := unname(temp)][]
}

编辑（感谢@TylerRinkler - 谢谢！）

这样做的好处是可以轻松转换为 data.tree 对象，然后可以将其转换为许多其他数据类型。对g 稍加修改：

g <- function(l) {
  vec <- unlist(f(l))
  n <- max(lengths(strsplit(names(vec), ".", fixed=TRUE)))
  require(tidyr)
  data.frame(
    i = names(vec),
    value = unname(vec)
  ) %>% 
    separate(i, paste0("i", 1:n), sep = "\\.", fill = "right", convert = TRUE)
}

library(data.tree)

x <- data.frame(top=".", g(l2))
x$pathString <- apply(x, 1, function(x) paste(trimws(na.omit(x)), collapse="/"))
mytree <- data.tree::as.Node(x)

mytree
#                   levelName
#1  .                        
#2   ¦--1                    
#3   ¦   °--1                
#4   ¦       °--a            
#5   ¦--2                    
#6   ¦   ¦--1                
#7   ¦   ¦   °--1            
#8   ¦   ¦       °--b        
#9   ¦   °--2                
#10  ¦       ¦--1            
#11  ¦       ¦   °--1        
#12  ¦       ¦       °--c    
#13  ¦       °--2            
#14  ¦           ¦--1        
#15  ¦           ¦   °--d    
#16  ¦           ¦--2        
#17  ¦           ¦   °--a    
#18  ¦           °--3        
#19  ¦               °--e    
#20  ¦--4                    
#21  ¦   ¦--1                
#22  ¦   ¦   °--e            
#23  ¦   °--2                
#24  ¦       °--b            
#25  ¦--5                    
#26  ¦   °--1                
#27  ¦       °--1            
#28  ¦           °--e        
#29  °--6                    
#30      °--1                
#31          °--1            
#32              °--1        
#33                  °--1    
#34                      °--f

并制作一个漂亮的情节：

plot(mytree)

其他形式的数据展示：

as.list(mytree)
ToDataFrameTypeCol(mytree)

更多关于转换 data.tree 类型：

https://cran.r-project.org/web/packages/data.tree/vignettes/data.tree.html#tree-conversion http://www.r-bloggers.com/how-to-convert-an-r-data-tree-to-json/

【讨论】：

好东西。我在指定预期输出时很草率，但设置 i = names(vec) 然后调用 tidyr::separate 得到了我想要的。
@docendo discimus 我做了一个补充（顺便说一句很好的答案）如果它不符合您的意图，请随时回滚。 +1
@TylerRinker，感谢您的编辑，这真的很酷！我也可以添加该图表

【解决方案2】：

这里有一个替代方案。它不会像@docendodiscimus 的方法那么快，但它仍然非常简单。

基本思想是使用“reshape2”/“data.table”中的melt。 melt 有一个用于 lists 的 method，它创建如下输出：

melt(l2)
#    value L3 L2 L4 L1
# 1      a NA NA NA  1
# 2      b NA  1 NA  2
# 3      c  1  2 NA  2
# 4      d  2  2 NA  2
# 5      a  2  2 NA  2
# 6      e  2  2 NA  2
# 7      e NA NA NA  4
# 8      b NA NA NA  4
# 9      e NA  1 NA  5
# 10     f  1  1  1  6

除了列排序和您感兴趣的最后一个值之外，它似乎包含您所需要的所有信息。要获取您感兴趣的最后一个值，您可以使用rapply(l2, seq_along)。

把这两个要求放在一起，你会得到这样的结果：

myFun <- function(inlist) {
  require(reshape2)                           ## Load required package
  x1 <- melt(inlist)                          ## Melt the data
  x1[[paste0("L", ncol(x1))]] <- NA_integer_  ## Add a column to hold the position info
  x1 <- x1[c(1, order(names(x1)[-1]) + 1)]    ## Reorder the columns
  vals <- rapply(inlist, seq_along)           ## These are the positional values
  positions <- max.col(is.na(x1), "first")    ## This is where the positions should go
  x1[cbind(1:nrow(x1), positions)] <- vals    ## Matrix indexing for replacement
  x1                                          ## Return the output
}

myFun(l2)
#    value L1 L2 L3 L4 L5
# 1      a  1  1 NA NA NA
# 2      b  2  1  1 NA NA
# 3      c  2  2  1  1 NA
# 4      d  2  2  2  1 NA
# 5      a  2  2  2  2 NA
# 6      e  2  2  2  3 NA
# 7      e  4  1 NA NA NA
# 8      b  4  2 NA NA NA
# 9      e  5  1  1 NA NA
# 10     f  6  1  1  1  1

@docendodiscimus 的回答中g 的“data.table”版本更直接一些：

g <- function(inlist) {
  require(data.table)
  temp <- unlist(f(inlist))
  setDT(tstrsplit(names(temp), ".", fixed = TRUE))[, value := unname(temp)][]
}

【讨论】：

不错的解决方案。 Acutally 我有点惊讶你说我的回答会更快。但无论如何，这是一个非常好的方法
@docendodiscimus，它本质上是unlist 和带有一些有趣递归的字符串拆分，对吧？ :-)
我喜欢你的 g 的 data.table 版本，特别是因为它避免了两次拆分。介意我在答案中添加关于此的参考吗？
@docendodiscimus，没问题 :-)

【解决方案3】：

类似于 docendo，但尝试在递归内部尽可能多地操作而不是在之后修复结果：

ff = function(x)
{
    if(!is.list(x)) if(length(x)) return(seq_along(x)) else return(NA)
    lapply(seq_along(x), 
           function(i) cbind(i, do.call(rBind, as.list(ff(x[[i]])))))
}

ans = do.call(rBind, ff(l2))
data.frame(value = unlist(l2), 
           ans[rowSums(is.na(ans[, -1L])) != (ncol(ans) - 1L), ])
#   value X1 X2 X3 X4 X5
#1      a  1  1 NA NA NA
#2      b  2  1  1 NA NA
#3      c  2  2  1  1 NA
#4      d  2  2  2  1 NA
#5      a  2  2  2  2 NA
#6      e  2  2  2  3 NA
#7      e  4  1 NA NA NA
#8      b  4  2 NA NA NA
#9      e  5  1  1 NA NA
#10     f  6  1  1  1  1

rBind 是rbind 的包装器，以避免“不匹配的列”错误：

rBind = function(...) 
{
    args = lapply(list(...), function(x) if(is.matrix(x)) x else matrix(x))
    nc = max(sapply(args, ncol))
    do.call(rbind, 
            lapply(args, function(x) 
                           do.call(cbind, c(list(x), rep_len(list(NA), nc - ncol(x))))))
}

【讨论】：

【解决方案4】：

这也可以通过rrapply-package（基础rapply的扩展版本）中的rrapply来完成，使用how = "melt"返回一个类似于reshape2::melt的熔化的data.frame：

library(rrapply)

## use rapply or rrapply to convert terminal nodes to lists
l2_list <- rapply(l2, f = as.list, how = "replace")

## use rrapply with how = "melt" to return melted data.frame
l2_melt <- rrapply(l2_list, how = "melt")
#>     L1  L2   L3   L4   L5 value
#> 1  ..1 ..1 <NA> <NA> <NA>     a
#> 2  ..2 ..1  ..1 <NA> <NA>     b
#> 3  ..2 ..2  ..1  ..1 <NA>     c
#> 4  ..2 ..2  ..2  ..1 <NA>     d
#> 5  ..2 ..2  ..2  ..2 <NA>     a
#> 6  ..2 ..2  ..2  ..3 <NA>     e
#> 7  ..4 ..1 <NA> <NA> <NA>     e
#> 8  ..4 ..2 <NA> <NA> <NA>     b
#> 9  ..5 ..1  ..1 <NA> <NA>     e
#> 10 ..6 ..1  ..1  ..1  ..1     f

注意：如有必要，我们可以在之后将级别列转换为数字列。

rrapply(l2_melt, condition = function(x, .xname) grepl("^L", .xname), f = function(x) as.numeric(sub("\\.+", "", x)))
#>    L1 L2 L3 L4 L5 value
#> 1   1  1 NA NA NA     a
#> 2   2  1  1 NA NA     b
#> 3   2  2  1  1 NA     c
#> 4   2  2  2  1 NA     d
#> 5   2  2  2  2 NA     a
#> 6   2  2  2  3 NA     e
#> 7   4  1 NA NA NA     e
#> 8   4  2 NA NA NA     b
#> 9   5  1  1 NA NA     e
#> 10  6  1  1  1  1     f

计算时间

使用rrapply 而不是reshape2::melt 可以显着提高（非常）大型嵌套列表的速度，如下面的基准时间所示：

## create deeply nested list
deep_list <- rrapply(list(1, 1), classes = c("list", "numeric"), condition = function(x, .xpos) length(.xpos) < 18, f = function(x) list(1, 1), how = "recurse")

system.time(reshape2::melt(deep_list))
#>    user  system elapsed 
#> 119.747   0.024 119.784
system.time(rrapply(deep_list, how = "melt"))
#>    user  system elapsed 
#>   0.240   0.008   0.249

## create large shallow nested list
large_list <- lapply(replicate(500, 1, simplify = F), function(x) replicate(500, 1, simplify = F))

system.time(reshape2::melt(large_list))
#>    user  system elapsed 
#>  40.558   0.008  40.569
system.time(rrapply(large_list, how = "melt"))
#>    user  system elapsed 
#>   0.073   0.000   0.073

【讨论】：