Utilizing functions within across() in dplyr to work with paired-columns

问题

set.seed(3)
library(dplyr)
x <- tibble(Measure = c("Height","Weight","Width","Length"),
        AD1_1= rpois(4,10),
        AD1_2= rpois(4,9),
        AD2_1= rpois(4,10),
        AD2_2= rpois(4,9),
        AD3_1= rpois(4,10),
        AD3_2= rpois(4,9))

Suppose I have data that looks like this. I wish to run a function for each AD, paired with underscored number, i.e., AD1fun, AD2fun,AD3fun.

Instead of writing,

fun <- function(x,y){x-y}
dat %>%
mutate(AD1fun = fun(AD1_1,AD1_2),
       AD2fun = fun(AD2_1,AD2_2),
...)

Finding the differences of paired-columns using dplyr shows that

x_minus <- x %>%
  mutate(fun(across(ends_with("_1"), .names = "{col}_minus"), across(ends_with("_2")))) %>%
  rename_with(~ sub("_\\d+", "", .), ends_with("_minus"))

can be used to produce

# A tibble: 4 x 10
  Measure AD1_1 AD1_2 AD2_1 AD2_2 AD3_1 AD3_2 AD1_minus AD2_minus AD3_minus
  <chr>   <int> <int> <int> <int> <int> <int>     <int>     <int>     <int>
1 Height      6    10    10     3    12     8        -4         7         4
2 Weight      8     9    13     6    14     7        -1         7         7
3 Width      10     9    11     5    12     8         1         6         4
4 Length      8     9     8     7     8    13        -1         1        -5

However, if we were to make non-operational function,

fun <- function(x,y){
  case <- case_when(
    x == y ~ "Agree",
    x == 0 & y != 0 ~ "Disagreement",
    x != 0 & y == 0 ~ "Disagreement",
    x-y <= 1 & x-y >= -1 ~ "Agree",
    TRUE ~ "Disagree"
  )
  return(case)
}

x_case <- x %>%
  mutate(fun(across(ends_with("_1"), .names = "{col}_case"), across(ends_with("_2")))) %>%
  rename_with(~ sub("_\\d+", "", .), ends_with("_case"))

it will produce an error, since to quote,

This procedure essentially means that you compare two datasets: one with variables ending with _1 and one with _2. It is, thus, the same as dat %>% select(ends_with("_1")) - dat %>% select(ends_with("_2")). And as these are lists, you cannot compare them that way

If so, what can be done to include a function using across()?

回答1:

We could loop across the columns with names that ends_with "_1", then use cur_column() to extract the column name, replace the suffix part with _2, get the value and use that as argument to the fun for the current column and the corresponding pair from _2

library(dplyr)
library(stringr)
x %>% 
   mutate(across(ends_with("_1"), ~
     fun(., get(str_replace(cur_column(), "_1$", "_2"))), .names = "{.col}_case"))

-output

# A tibble: 4 x 10
#  Measure AD1_1 AD1_2 AD2_1 AD2_2 AD3_1 AD3_2 AD1_1_case AD2_1_case AD3_1_case
#  <chr>   <int> <int> <int> <int> <int> <int> <chr>      <chr>      <chr>     
#1 Height      6    10    10     3    12     8 Disagree   Disagree   Disagree  
#2 Weight      8     9    13     6    14     7 Agree      Disagree   Disagree  
#3 Width      10     9    11     5    12     8 Agree      Disagree   Disagree  
#4 Length      8     9     8     7     8    13 Agree      Agree      Disagree

Or another option is split.default/map. Here, we split the datasets into list of data.frame each having the same prefix as column name, then apply the fun on each list element with map/reduce and bind the output back to the original dataset with bind_cols

library(purrr)
x %>% 
  select(-Measure) %>% 
  split.default(str_remove(names(.), "_\\d+$")) %>%
  map_dfr(reduce, fun) %>% 
  rename_all(~ str_c(., "_case")) %>%
  bind_cols(x, .)

-output

# A tibble: 4 x 10
#  Measure AD1_1 AD1_2 AD2_1 AD2_2 AD3_1 AD3_2 AD1_case AD2_case AD3_case
#  <chr>   <int> <int> <int> <int> <int> <int> <chr>    <chr>    <chr>   
#1 Height      6    10    10     3    12     8 Disagree Disagree Disagree
#2 Weight      8     9    13     6    14     7 Agree    Disagree Disagree
#3 Width      10     9    11     5    12     8 Agree    Disagree Disagree
#4 Length      8     9     8     7     8    13 Agree    Agree    Disagree

Regarding the OP's approach, the fun is not Vectorized. If we do that, it can be applied to multiple pairwise columns

x %>%
  mutate(Vectorize(fun)(across(ends_with("_1"), 
         .names = "{col}_minus"), across(ends_with("_2"))))%>%
   do.call(data.frame, .) %>% 
   rename_at(vars(contains('minus')),
         ~ str_extract(., 'AD\\d+_\\d+_minus'))
#  Measure AD1_1 AD1_2 AD2_1 AD2_2 AD3_1 AD3_2 AD1_1_minus AD2_1_minus AD3_1_minus
#1  Height     6    10    10     3    12     8    Disagree    Disagree    Disagree
#2  Weight     8     9    13     6    14     7       Agree    Disagree    Disagree
#3   Width    10     9    11     5    12     8       Agree    Disagree    Disagree
#4  Length     8     9     8     7     8    13       Agree       Agree    Disagree

来源：https://stackoverflow.com/questions/65852611/utilizing-functions-within-across-in-dplyr-to-work-with-paired-columns

标签

function

dplyr

across