# 利用dplyr中cross()中的函数来处理成对的列 [英] Utilizing functions within across() in dplyr to work with paired-columns

### 问题描述

``````set.seed(3)
library(dplyr)
x <- tibble(Measure = c("Height","Weight","Width","Length"),
``````

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.

``````fun <- function(x,y){x-y}
dat %>%
...)
``````

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

``````# A tibble: 4 x 10
<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()?

### 推荐答案

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"))
``````

-输出

``````# A tibble: 4 x 10
#  <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, .)
``````

-输出

``````# A tibble: 4 x 10
#  <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 `Vectorize`d. 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')),
#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
``````