Как получить позицию элементов в списке?

Учитывая переменную списка, я хотел бы иметь фрейм данных позиций каждого элемента. Для простого не вложенного списка это выглядит довольно просто.

Например, здесь список векторов символов.

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

Как получить фрейм данных позиций для вложенного списка?

Ответы

Ответ 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"

Теперь, чтобы вернуть a 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

Улучшенная версия g, внесенная @AnandaMahto (спасибо!), будет использовать 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)

pic

Другие формы представления данных:

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/

Ответ 2

Вот альтернатива. Это будет не так быстро, как подход @docendodiscimus, но он все еще довольно прост.

Основная идея - использовать melt из "reshape2" / "data.table". melt имеет method для list, который создает вывод следующим образом:

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

"data.table" версия g из ответа @docendodiscimus немного более прямая:

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

Ответ 3

Похоже на docendo's, но пытается работать как можно больше внутри рекурсии, чем после этого фиксировать результат:

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