Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

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 ?

like image 455
Fabien Pomponio Avatar asked Sep 12 '25 17:09

Fabien Pomponio


2 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" 
like image 83
Roman Avatar answered Sep 14 '25 07:09

Roman


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"
)
like image 36
Joris C. Avatar answered Sep 14 '25 06:09

Joris C.