Cfrgtkky

I have a similar dataset but with many more r and v variables.

set.seed(1000)

tb <- tibble(grp = c(rep("A",4),rep("B",4)),

             v1 = rnorm(8),

             v2 = rnorm(8),

             v3 = rnorm(8),

             r1 = rnorm(8),

             r2 = rnorm(8))

For each v variable, I would like to create a lm() with r variables.

This is what I have so far:

lm_fun <- function(x,y) coef(lm(x ~ y))[2]

tb %>% 

  nest(-grp) %>%

  mutate(lm_list = map(data, ~ .x %>% 

                              summarise_at(colnames(tb)[c(2:4)], funs(r1=lm_fun), .$r1)),

         lm_list2= map(data, ~ .x %>% 

                         summarise_at(colnames(tb)[c(2:4)], funs(r2=lm_fun), .$r2)),) %>%

  select(grp,lm_list,lm_list2) %>%

  unnest()

which gives me the intended output:

# A tibble: 2 x 7

  grp    v1_r1   v2_r1  v3_r1  v1_r2  v2_r2  v3_r2

  <chr>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>

1 A     -0.188 -0.0972  0.858  0.130 0.136   1.21 

2 B      0.208  0.935  -1.33  -0.339 0.0580 -0.840

However, how can I specify the r variables in a vector (in a similar way of specifying the v variables as colnames(tb)[...]. I don't want to copy-pasta the code for every r variable I have in my full data. Also, would it be possible to solve this with another method?

Note that it is not important that the function is performing lm(), could be any function that involves two variables.

An option would be to loop through the 'r' columns inside map. This simplifies the code as we are using the same data but different 'r' columns

library(tidyverse)

tb %>% 

  nest(-grp) %>%

  mutate(lm_list = map(data,  function(x)

           map(paste0('r', 1:2), function(y) 

             x %>% 

                summarise_at(vars(names(.)[1:3]), funs(lm_fun), .[[y]]) %>% 

                rename_all(~ paste(., y, sep="_")) ) %>% 

            bind_cols)) %>% 

   select(-data) %>% 

   unnest

# A tibble: 2 x 7

#  grp    v1_r1   v2_r1  v3_r1  v1_r2  v2_r2  v3_r2

#   <chr>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>

#1 A     -0.188 -0.0972  0.858  0.130 0.136   1.21 

#2 B      0.208  0.935  -1.33  -0.339 0.0580 -0.840

Another option would be to gather the levels of r before mutate/map:

tb %>% 

  gather(r, value, starts_with('r')) %>% 

  nest(-r, -grp) %>% 

  mutate(lm_list = map(

    data, ~ .x %>% 

      summarise_at(colnames(tb)[c(2:4)], funs(lm_fun), .$value)

                         )) %>% 

  unnest(lm_list, .drop = T)



  grp   r         v1      v2     v3

  <chr> <chr>  <dbl>   <dbl>  <dbl>

1 A     r1    -0.188 -0.0972  0.858

2 B     r1     0.208  0.935  -1.33 

3 A     r2     0.130  0.136   1.21 

4 B     r2    -0.339  0.0580 -0.840