向列表中的向量转换为列表中的列表

Question

我有一个以这种方式结构化的列表：

x <- list(id = c("a", "b"),
          value = c(1,2),
          othervalue = c(3,4)
    )

我需要将列表转换为这样的结构：

y <- list(a = list(value = 1, othervalue = 3),
          b = list(value = 2, othervalue = 4)
    )

你会怎么做呢？

---

编辑：

我偶然发现了这个问题的更高级版本：

输出中有一种嵌套列表。

x <-  list(id = c("a", "b", "a"), key = c("foo", "foo", "bar"), value = c(1, 2, 3))

到

y <- list(a = list(foo = 1, bar = 2), b  = list(foo = 3))

根据当前的答案，结果是：

$a
$a$key
[1] "foo"

$a$value
[1] 1


$b
$b$key
[1] "foo"

$b$value
[1] 2


$a
$a$key
[1] "bar"

$a$value
[1] 3

- Felix M

---

感谢大家的回答，我遇到了这个问题的一个高级版本。有任何解决办法吗？ - Felix M

Answer 1

你可以使用 do.call 在 Map 中使用 list。

z <- setNames(do.call(Map, c(list, x[-1])), x[[1]])

identical(z, y)
#[1] TRUE

相同，但使用管道：

z <- c(list, x[-1]) |>
       do.call(what=Map) |>
       setNames(x[[1]])

---

基准

x <- list(id = c("a", "b"), value = c(1,2), othervalue = c(3,4) )

bench::mark(purr = purrr::transpose(x[-1], .names = x[[1]]), #@Maël
            lapplySplit = lapply(split(as.data.frame(x)[-1], x$id), c), #@Allan Cameron
            Map = setNames(do.call(Map, c(list, x[-1])), x[[1]]) ) #@GKi

# expression       min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc
#  <bch:expr>  <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>
#1 purr          2.51ms   2.64ms      372.    3.69MB     34.2   152    14
#2 lapplySplit 461.77µs 490.48µs     2018.  102.21KB     52.0   892    23
#3 Map          14.13µs   15.9µs    61557.    3.06KB     80.1  9987    13

在这种情况下，与lapplySplit第二个相比，Map快约30倍，并且分配的内存要少得多。
而且使用@s_baldur的数据集：

x <- list(id = c(letters, LETTERS), value = 1:52, othervalue = (1:52 + 100))
bench::mark(check=FALSE,
purr = purrr::transpose(x[-1], .names = x[[1]]), #@Maël
lapplySplit = lapply(split(as.data.frame(x)[-1], x$id), c), #@Allan Cameron
Map = setNames(do.call(Map, c(list, x[-1])), x[[1]]) ) #@GKi
#  expression       min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc
#  <bch:expr>  <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>
#1 purr           2.5ms   2.59ms      385.    3.69MB     33.9   159    14
#2 lapplySplit   2.43ms   2.51ms      391.  137.21KB     68.3   149    26
#3 Map          50.98µs  61.06µs    15717.    3.51KB     72.5  6506    30

---

对于更新的问题，也许可以使用：

lapply(split(setNames(x$value, x$key), x$id), as.list)

但是否需要一个列表呢？如果不需要的话，可以使用"maybe"：

split(setNames(x$value, x$key), x$id)

- GKi

---

transpose在处理大数据时实际上更快。请参考@s_baldur的解决方案。 - Maël

@Maël 实际上，在我的机器上，小数据的处理速度也要快得多。使用 purrr 0.3.4。 - s_baldur

@Maël 我已经使用另一个数据集添加了一个基准测试，但是排名在我的电脑上不同。也许 s_baldur 使用了另一个 R 版本？我使用的是 4.3.0 版本。或者可能是因为使用了不同的库或硬件。你能确认一下 s_baldur 的排名与我的是否相同，还是完全不同？ - GKi

Answer 2

你可以做

lapply(split(as.data.frame(x)[-1], x$id), c)
#> $a
#> $a$value
#> [1] 1
#> 
#> $a$othervalue
#> [1] 3
#> 
#> 
#> $b
#> $b$value
#> [1] 2
#> 
#> $b$othervalue
#> [1] 4

与 y 相同的是什么？

identical(lapply(split(as.data.frame(x)[-1], x$id), c), y)
#> [1] TRUE

- Allan Cameron

---

这个可能不会尊重x$id中的原始顺序。 - s_baldur

这个可能不会按照x$id中的原始顺序进行排序。 - undefined

Answer 3

既然你在标签中提到了purrr，你可以使用purrr::transpose函数：

purrr::transpose(x[-1], .names = x[[1]])

# $a
# $a$value
# [1] 1
# 
# $a$othervalue
# [1] 3
# 
# 
# $b
# $b$value
# [1] 2
# 
# $b$othervalue
# [1] 4

你的第二个问题看起来像是递归分割。为了实现这个功能，一个方便的选项是使用collapse::rsplit。

collapse::rsplit(data.frame(x), ~ id + key)

# $a
# $a$bar
# [1] 3
# 
# $a$foo
# [1] 1
# 
# 
# $b
# $b$foo
# [1] 2

- Maël

Answer 4

简单明了：

foo <- function(x) {
  n <- length(x$id)
  y <- vector(mode = "list", length = n) |> setNames(x$id)
  for (i in seq_len(n)) y[[i]] <- list(value = x$value[i], othervalue = x$othervalue[i])
  y
}

基准测试（使用稍大的数据）：

x <- list(id = c(letters, LETTERS),
          value = 1:52,
          othervalue = (1:52 + 100)
    )
bench::mark(purr = purrr::transpose(x[-1], .names = x[[1]]),
            Map = setNames(do.call(Map, c(list, x[-1])), x[[1]]),
            loop = foo(x)) 

#   expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time                 
#   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>            
# 1 purr            5µs    5.8µs   137969.     1.2KB     27.6  9998     2     72.5ms
# 2 Map          32.3µs   34.7µs    27567.      464B     13.8  9995     5    362.6ms
# 3 loop         16.5µs   17.5µs    52962.      464B     15.9  9997     3    188.8ms 

- s_baldur

Answer 5

更新

关于问题的更新，您可以尝试split + lapply

lapply(split(list2DF(x[-1]), x[[1]]), \(v) with(v, split(value, key)))

或者我们可以使用aggregate + Map。

with(
    aggregate(x[-1], x[1], as.list),
    setNames(Map(setNames, value, key), id)
)

这提供了

$a
$a$bar
[1] 3

$a$foo
[1] 1


$b
$b$foo
[1] 2

---

关于之前的问题

你可以试试

list2DF(x[-1]) %>%
    split(1:nrow(.)) %>%
    setNames(x[[1]]) %>%
    lapply(c)

这提供了

$a
$a$value
[1] 1

$a$othervalue
[1] 3


$b
$b$value
[1] 2

$b$othervalue
[1] 4

- ThomasIsCoding