如何修改多层嵌套的R列表中的元素？

Question

我需要做的是将嵌套列表“a”第四层级别中所有 type 向量的值替换为相应的 transcodification 表中的值，并保持其余部分的相同结构：

a = list(
    a1 = list(
      b1 = list(
        c1 = list(
          type = c(1,3),
          attribute1 = runif(3,0,1),
          attribute2 = list(d = rpois(1,1))
        ),
        c2 = list(
          type = c(2,3,6),
          attribute1 = runif(3,0,1),
          attribute2 = list(d = rpois(1,1))
        )
      ),
      b2 = list("foo")
    ),
    a2 = list(
      b1 = list(
        c3 = list(
          type = c(5),
          attribute1 = runif(3,0,1),
          attribute2 = list(d = rpois(1,1))
        ),
        c4 = list(
          type = c(2,3,6),
          attribute1 = runif(3,0,1),
          attribute2 = list(d = rpois(1,1))
        )
      ),
      b2 = list("foo")
    ),
    a3 = list(
      b1 = list(
        c5 = list(
          type = c(6),
          attribute1 = runif(3,0,1),
          attribute2 = list(d = rpois(1,1))
        ),
        c6 = list(
          type = c(1,2,3,5),
          attribute1 = runif(3,0,1),
          attribute2 = list(d = rpois(1,1))
        )
      ),
      b2 = list("foo")
    )
  )
  
transcodification = tibble(origin = c(1,2,3,4,5,6),
                           replacement = c("Peter","Jake","Matthew","Suzan","Christina","Margot"))

使用purrr函数，这是否有可能实现？

- Fabien Pomponio

Answer 1

您可以使用purrr的modify函数开始

modify_depth(a, 3, ~map(., ~str_replace_all(., transcodification %>% pull(2) %>% set_names(1:length(.)))))
$a1
$a1$b1
$a1$b1$c1
$a1$b1$c1$type
[1] "Peter"   "Matthew"

$a1$b1$c1$attribute1
character(0)

$a1$b1$c1$attribute2
character(0)


$a1$b1$c2
$a1$b1$c2$type
[1] "Jake"    "Matthew" "Margot" 

$a1$b1$c2$attribute1
character(0)

$a1$b1$c2$attribute2
character(0)



$a1$b2
$a1$b2[[1]]
$a1$b2[[1]][[1]]
[1] "foo"

但这将在b2中引入额外的列表层级。

如果"type"总是在第一棵树上，那么您可以尝试不进行任何进一步的转换。

modify_depth(a, 3, ~modify_at(.,1, ~str_replace_all(., transcodification %>% pull(2) %>% set_names(1:length(.)))))

或者在每个数字向量上

modify_depth(a, 3, ~modify_if(., is.numeric, ~str_replace_all(., transcodification %>% pull(2) %>% set_names(1:length(.)))))

为了替换，我们将使用 stringr 的 str_replace_all 函数，同时使用命名向量进行替换，代码如下：

transcodification %>% pull(2) %>% set_names(1:length(.))
      1           2           3           4           5           6 
"Peter"      "Jake"   "Matthew"     "Suzan" "Christina"    "Margot" 

- Roman

---

谢谢Roman，这真的很有帮助！然而，我没有意识到我的问题还有一个棘手的情况：每个b2都不是列表，而是向量（你可以通过修改b2 = list()为b2 = runif(1,1,2)来得到这个结果。任何你提供的解决方案都无法处理这个新列表。我得到了一个错误： Error: Can't coerce element 1 from a character to a double.需要帮助吗？ - Fabien Pomponio

这个 modify_depth(a, 3, ~modify_at(., 1, ~str_replace_all(., transcodification %>% pull(2) %>% set_names(1:length(.))))) 对我有效。 - Roman

Answer 2

@Joris C.的解决方案是更简洁的rrapply方法，但我认为这里还有另一种方法可以实现你想要的效果。我在想是否可以使用unlist/relist类型的选项：

library(rrapply)
library(tidyverse)
#restructure transcodification 
transcodification_named <- transcodification$origin %>% setNames(transcodification$replacement)
#unlist list into dataframe (instead of using base::unlist)
a_unlist <- rrapply(a, how = "melt")

请按照这里所讨论的方法，替换数据框中的类型数值：

a_unlist <- a_unlist %>% 
  mutate(value = map2(value, L4, ~ if(.y %in% 'type') 
    unname(coalesce(setNames(names(transcodification_named), 
                             transcodification_named)[.x], as.character(.x))) else .x))
#then reconvert to a list (instead of base::relist which needs list skeleton object)
a_relist <- rrapply(a_unlist, how = "unmelt")
a_relist

- user63230

Answer 3

另一种方法是使用rrapply()，它是基于rapply()的扩展包rrapply中的函数。

需要替换的名称为"type"的列表元素在condition参数中指定，替换函数在f参数中指定。请保留HTML标签。

library(rrapply)

ans <- rrapply(
        object = a, 
        condition = function(x, .xname) .xname == "type",
        f = function(x) transcodification$replacement[x],  
        how = "replace"
)

str(ans)

#> List of 3
#>  $ a1:List of 2
#>   ..$ b1:List of 2
#>   .. ..$ c1:List of 3
#>   .. .. ..$ type      : chr [1:2] "Peter" "Matthew"
#>   .. .. ..$ attribute1: num [1:3] 0.37 0.685 0.783
#>   .. .. ..$ attribute2:List of 1
#>   .. .. .. ..$ d: int 2
#>   .. ..$ c2:List of 3
#>   .. .. ..$ type      : chr [1:3] "Jake" "Matthew" "Margot"
#>   .. .. ..$ attribute1: num [1:3] 0.251 0.613 0.301
#>   .. .. ..$ attribute2:List of 1
#>   .. .. .. ..$ d: int 1
#>   ..$ b2:List of 1
#>   .. ..$ : chr "foo"
#>  $ a2:List of 2
#>   ..$ b1:List of 2
#>   .. ..$ c3:List of 3
#>   .. .. ..$ type      : chr "Christina"
#>   .. .. ..$ attribute1: num [1:3] 0.548 0.233 0.623
#>   .. .. ..$ attribute2:List of 1
#>   .. .. .. ..$ d: int 2
#>   .. ..$ c4:List of 3
#>   .. .. ..$ type      : chr [1:3] "Jake" "Matthew" "Margot"
#>   .. .. ..$ attribute1: num [1:3] 0.618 0.828 0.685
#>   .. .. ..$ attribute2:List of 1
#>   .. .. .. ..$ d: int 0
#>   ..$ b2:List of 1
#>   .. ..$ : chr "foo"
#>  $ a3:List of 2
#>   ..$ b1:List of 2
#>   .. ..$ c5:List of 3
#>   .. .. ..$ type      : chr "Margot"
#>   .. .. ..$ attribute1: num [1:3] 0.424 0.156 0.79
#>   .. .. ..$ attribute2:List of 1
#>   .. .. .. ..$ d: int 0
#>   .. ..$ c6:List of 3
#>   .. .. ..$ type      : chr [1:4] "Peter" "Jake" "Matthew" "Christina"
#>   .. .. ..$ attribute1: num [1:3] 0.941 0.16 0.649
#>   .. .. ..$ attribute2:List of 1
#>   .. .. .. ..$ d: int 1
#>   ..$ b2:List of 1
#>   .. ..$ : chr "foo"

---

注意：如果名称 "type" 也出现在其他列表级别上，则可以通过仅评估列表的第四级别处的 "type" 元素来使 condition 更加精确：

ans <- rrapply(
        object = a, 
        condition = function(x, .xname, .xpos) .xname == "type" && length(.xpos) == 4L,
        f = function(x) transcodification$replacement[x],  
        how = "replace"
)

- Joris C.