将 dplyr::across 与两组变量一起使用

Posted 2023-02-13

【中文标题】将 dplyr::across 与两组变量一起使用

【英文标题】：Using dplyr::across with two sets of variables将 dplyr::across 与两组变量一起使用

【发布时间】：2021-05-16 09:11:05

【相关技术】：@tags@

【问题描述】：

我有两组变量，例如变量a 和变量a_avail。我正在尝试根据a_avail 的值更改a 的值，我想知道这是否可以使用across 和glue 来完成。

这是我尝试过的。没有产生错误，但胶水似乎没有拾取.x_avail 的值，因为所有返回值都是 NA：

library(tidyverse)

df <- tibble(a = c(0, 1, 0, 0, 0),
       a_avail = c(1, 1, 1, 0, 0),
       b = c(1, 1, 1, 0, 0),
       b_avail = c(1, 0, 0, 1, 0))

df2 <- df %>% 
  mutate(across(.cols = c(a, b),
                .fns = ~case_when(
                  glue::glue(".x_avail") == 1 ~ .x,
                  glue::glue(".x_avail") == 0 ~ as.numeric(NA)
                ),
                .names = ".col_new"))

df2
#> # A tibble: 5 x 6
#>       a a_avail     b b_avail a_new b_new
#>   <dbl>   <dbl> <dbl>   <dbl> <dbl> <dbl>
#> 1     0       1     1       1    NA    NA
#> 2     1       1     1       0    NA    NA
#> 3     0       1     1       0    NA    NA
#> 4     0       0     0       1    NA    NA
#> 5     0       0     0       0    NA    NA

^{由reprex package (v0.3.0) 于 2021-02-12 创建}

【参考方案1】：

Ronak Shah 在他的 answer 和相关的 question 中提出了一种绝妙的方法，我将在下面复制。

其实两件事

在mutate(across.. 内部使用列/变量名而不是值cur_column() 应与. 或.x 相对应。 get() 也可以与 glue 一起使用，以便 R 将其识别为变量。

这样做

df %>% 
  mutate(across(.cols = c(a, b),
                .fns = ~case_when(
                  get(glue::glue("cur_column()_avail")) == 1 ~ .x,
                  get(glue::glue("cur_column()_avail")) == 0 ~ NA_real_
                ),
                .names = ".col_new"))

# A tibble: 5 x 6
      a a_avail     b b_avail a_new b_new
  <dbl>   <dbl> <dbl>   <dbl> <dbl> <dbl>
1     0       1     1       1     0     1
2     1       1     1       0     1    NA
3     0       1     1       0     0    NA
4     0       0     0       1    NA     0
5     0       0     0       0    NA    NA

【参考方案2】：

我认为通过purrr 包可以轻松实现您想要的输出。在某种程度上，我们不使用across，而是使用map2函数，因为我们同时处理2个变量，并且为了我们的目的，我们希望逐行迭代它们：

library(dplyr)
library(purrr)

df <- tibble(a = c(0, 1, 0, 0, 0),
             a_avail = c(1, 1, 1, 0, 0),
             b = c(1, 1, 1, 0, 0),
             b_avail = c(1, 0, 0, 1, 0))


df %>%
  mutate(a_new = map2_dbl(a, a_avail, ~ ifelse(.y == 1, .x, NA)),
         b_new = map2_dbl(b, b_avail, ~ ifelse(.y == 1, .x, NA)))


# A tibble: 5 x 6
      a a_avail     b b_avail a_new b_new
  <dbl>   <dbl> <dbl>   <dbl> <dbl> <dbl>
1     0       1     1       1     0     1
2     1       1     1       0     1    NA
3     0       1     1       0     0    NA
4     0       0     0       1    NA     0
5     0       0     0       0    NA    NA

在这种情况下，最好仔细考虑哪个函数最能满足您的目的，并且最符合您给出的参数集，您想用它们做什么。由于我们正在处理逐行操作，因此我更愿意使用 purrr 包函数。

【参考方案3】：

您遇到的主要问题是引用列本身，而不仅仅是将字符串（或glue 对象）与数字进行比较。您可能可以将一个 tidyeval 函数放在一起，但（可能）更简单的方法是将数据重塑为长格式，以便为原始值提供一列和可用性列，在新列中添加比较，然后重新调整.这也将进行缩放，因此您不必指定要执行此操作的所有列，或手动将原件与可用的准确匹配。

第一个技巧是使用某种方式标记原始列，以便您可以拆分，例如"a" 来自 "avail"。为此，将另一个字符串附加到只有单个字符的名称上。 （您可以使用不同的方法来选择列。）使用 ID 标记行 - 您可以稍后删除此列。第二个技巧是在数据透视函数中使用特殊的 ".value" 术语。

我建议逐步完成重塑步骤，看看它们是如何工作的，并根据需要进行调整。

library(dplyr)
library(tidyr)
df %>%
  rename_with(~paste(., "orig", sep = "_"), matches("^[a-z]$")) %>%
  tibble::rowid_to_column() %>%
  pivot_longer(-rowid, names_to = c("col", ".value"), names_sep = "_") %>%
  mutate(new = if_else(avail == 1, orig, NA_real_)) %>%
  pivot_wider(id_cols = rowid, names_from = col, values_from = orig:new, 
              names_glue = "col_.value")
#> # A tibble: 5 x 7
#>   rowid a_orig b_orig a_avail b_avail a_new b_new
#>   <int>  <dbl>  <dbl>   <dbl>   <dbl> <dbl> <dbl>
#> 1     1      0      1       1       1     0     1
#> 2     2      1      1       1       0     1    NA
#> 3     3      0      1       1       0     0    NA
#> 4     4      0      0       0       1    NA     0
#> 5     5      0      0       0       0    NA    NA

【参考方案4】：

不是一个 tidyverse 解决方案，但这应该可以工作

library(tidyverse)

df <- tibble(a = c(0, 1, 0, 0, 0),
             a_avail = c(1, 1, 1, 0, 0),
             b = c(1, 1, 1, 0, 0),
             b_avail = c(1, 0, 0, 1, 0))


v1 <- list('a','b')
v2 <- list('a_avail','b_avail')


v3 <- as.data.frame(mapply(function(x,y)ifelse(df[[y]] == 0, NA,df[[x]]) , v1,v2, 
                           SIMPLIFY = TRUE))

names(v3) <- paste0(v1,"_new")

df3 <- cbind(df, v3)