How to modify elements on a multi-level nested R list?

user_16241587 0
Viewed 189

What I need to do is replacing all values of type vectors on the 4th level of the nested list a by the corresponding ones on the transcodification tibble and keeping the same structure for the rest of the list :

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

Is it possible to do using purrr functions ?

nested-lists nested-loops r
3 Answers

You can start with purrr's modify function

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"

But this will introduce additional list layers in b2, respectively.

If "type" is always on the first tree, than you can try without any further transformations

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

Or on each numeric vector

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

For the replacement we will use stringr's str_replace_all while the replacement is done using a named vector like this:

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

Another approach is to use rrapply() in the rrapply-package (an extension of base rapply()).

The list elements with name "type" that need to be replaced are specified in the condition argument and the replacement function is specified in the f argument:

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"

NB: if the name "type" also occurs on other list levels, the condition can be made more precise by evaluating only the "type" elements at the fourth level of the list:

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

@Joris C. solution is a cleaner rrapply approach but here is another take that I think gets you what you want. I was thinking would an unlist/relist type option work here:

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

Then replace type values in the dataframe as discussed 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
user_40837430
Related