Mapping a function on two nested objects

user_8430337 0
Viewed 276

I am trying to map a function dplyr::mutate on two sets of nested tibbles contained in a data set. My goal is to add new columns to each tibble nested in db$data.y by using the corresponding coefficients in the nested tibbles db$data.x.

Below, I provided a reproducible example. Each row of db refers to a different scale that we are validating. The nested tibbles in db$data.x contain the variance components that will be used to perform further calculations. The nested tibbles in db$data.y contain the same set of two columns wherein the combination of the number of occasions (from 1 to 10) and raters (from 1 to 2) is different for every row.

library(dplyr)
library(purrr)

coefficients <- data.frame(Scale = rep(1:5, each = 5), 
                           Component = rep(c("R", "S", "T", "RxS", "SxT"), 5), 
                           Value = rep(c(2, 4, 7, 3, 5, 5, 6, 7, 3, 5, 2, 6, 3, 6, 4, 7, 3, 7, 12, 8, 7, 11, 14, 9, 2))) %>% 
                           group_by(Scale) %>% nest()

sim.data <- data.frame(Scale = rep(1:5, each = 20), 
                       Occasion = rep(1:10, 2), 
                       Rater = rep(1:2, each = 10)) %>% 
                       group_by(Scale) %>% nest()

db <- left_join(coefficients, sim.data, by = "Scale")

#> db
# A tibble: 5 x 3
#  Scale data.x           data.y           
#  <int> <list>           <list>           
#1     1 <tibble [5 x 2]> <tibble [20 x 2]>
#2     2 <tibble [5 x 2]> <tibble [20 x 2]>
#3     3 <tibble [5 x 2]> <tibble [20 x 2]>
#4     4 <tibble [5 x 2]> <tibble [20 x 2]>
#5     5 <tibble [5 x 2]> <tibble [20 x 2]>

#> db$data.x[[1]]
# A tibble: 5 x 2
#  Component Value
#  <fct>     <dbl>
#1 R             2
#2 S             4
#3 T             7
#4 RxS           3
#5 SxT           5

#> db$data.y[[1]]
# A tibble: 20 x 2
#   Occasion Rater
#      <int> <int>
# 1        1     1
# 2        2     1
# 3        3     1
# 4        4     1
# 5        5     1
# 6        6     1
# 7        7     1
# 8        8     1
# 9        9     1
#10       10     1
#11        1     2
#...

The final goal is to calculate the column db$data.y$Abs for each scale for which we need to use the variance components contained in db$data.x. I could do this for each scale separately, but it seems extremely time-consuming. Is there anyone who can help with this?

db$data.y[[1]] %>% 
     mutate(Abs = db$data.x[[1]][[1,2]] / db$data.y[[1]]$Occasion + 
                  db$data.x[[1]][[2,2]] / db$data.y[[1]]$Rater + 
                  db$data.x[[1]][[3,2]] / (db$data.y[[1]]$Occasion * db$data.y[[1]]$Rater))

# A tibble: 20 x 3
#   Occasion Rater Abs
#      <int> <int> <dbl>
# 1        1     1 13   
# 2        2     1  8.5 
# 3        3     1  7   
# 4        4     1  6.25
# 5        5     1  5.8 
# 6        6     1  5.5 
# 7        7     1  5.29
# 8        8     1  5.12
# 9        9     1  5   
#10       10     1  4.9

I have tried with purrr::map2 but, if I am not mistaken, it works on two columns of the same nested object, whereas in this case, I am dealing with two different nested objects. I would be happy to consider other solutions as well.

purrr dplyr r
1 Answers

I think you're right that you can use map2(), but you'll need to use it within a mutate() so you can use the two nested columns as the first two arguments of that function.

You then can use your current mutate() code as the function within map2() to modify data.y. You'll see I replace the current data.y with the modified object with the same name in the outer mutate().

Something like that would look like:

db %>%
    mutate(data.y = map2(data.x, 
                         data.y, 
                         ~mutate(.y, Abs = .x[[1, 2]]/.y$Occasion +
                                     .x[[2, 2]]/.y$Rater +
                                     .x[[3, 2]]/(.y$Occasion*.y$Rater))))

The first data frame looks like

db %>%
    mutate(data.y = map2(data.x, 
                         data.y, 
                         ~mutate(.y, Abs = .x[[1, 2]]/.y$Occasion +
                                     .x[[2, 2]]/.y$Rater +
                                     .x[[3, 2]]/(.y$Occasion*.y$Rater)))) %>%
    pull(data.y) %>%
    pluck(1)

# A tibble: 20 x 3
   Occasion Rater   Abs
      <int> <int> <dbl>
 1        1     1 13   
 2        2     1  8.5 
 3        3     1  7   
 4        4     1  6.25
 5        5     1  5.8 
 6        6     1  5.5 
 7        7     1  5.29
 8        8     1  5.12
 9        9     1  5   
10       10     1  4.9 
...
user_24615520
Related