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

Question

我需要做的是用transcodification tibble 上的相应值替换嵌套列表a 第4 级上的type 向量的所有值，并为列表的其余部分保持相同的结构：

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 函数？

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" 

Answer 2

另一种方法是在rrapply-package 中使用rrapply()（基础rapply() 的扩展）。

condition参数中指定了需要替换的名称为"type"的列表元素，f参数中指定了替换函数：

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

Answer 3

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

然后按照here 的讨论替换数据框中的类型值：

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