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 ?
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"
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"
)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With