如何最好地使用 purrr 为每个两列比较创建一个新列?

How best to create a new column for each two-column comparison using purrr?

假设我有以下数据框:

ABC1_old <- c(1, 5, 3, 4, 3, NA, NA, NA, NA, NA)
ABC2_old <- c(4, 2, 1, 1, 5, NA, NA, NA, NA, NA)
ABC1_adj <- c(NA, NA, NA, NA, NA, 5, 5, 1, 2, 4)
ABC2_adj <- c(NA, NA, NA, NA, NA, 3, 2, 1, 4, 2)

df <- data.frame(ABC1_old, ABC2_old, ABC1_adj, ABC2_adj)

我想创建一个列,将每对 ABCn_old 与其对应的 ABCn_adj 进行比较。 (因此 ABC1_old 将与 ABCn_adj 等进行比较。)结果列将称为 ABCn_new。求值就是如果ABCn_oldNA,就用ABCn_adj中对应的值填空,否则就用ABCn_old的值。新列将如下所示:

df$ABC1_new <- c(1, 5, 3, 4, 3, 5, 5, 1, 2, 4)
df$ABC2_new <- c(4, 2, 1, 1, 5, 3, 2, 1, 4, 2)

我知道一个简单的 mutate 可以在这里工作,但如果可能的话,我想通过 purrr 使用某种 tidyverse 循环,因为实际上数据集要大得多。有什么关于实现此目标的最佳方法的想法吗?

map_dfc(split.default(df, str_remove(names(df), "_.*")), ~coalesce(!!!.x))
# A tibble: 10 x 2
    ABC1  ABC2
   <dbl> <dbl>
 1     1     4
 2     5     2
 3     3     1
 4     4     1
 5     3     5
 6     5     3
 7     5     2
 8     1     1
 9     2     4
10     4     2

放在一起:

df %>%
   split.default(str_replace(names(.), "_.*", "_new")) %>%
   map_dfc(~coalesce(!!!.x))%>%
   cbind(df, .)
   ABC1_old ABC2_old ABC1_adj ABC2_adj ABC1_new ABC2_new
1         1        4       NA       NA        1        4
2         5        2       NA       NA        5        2
3         3        1       NA       NA        3        1
4         4        1       NA       NA        4        1
5         3        5       NA       NA        3        5
6        NA       NA        5        3        5        3
7        NA       NA        5        2        5        2
8        NA       NA        1        1        1        1
9        NA       NA        2        4        2        4
10       NA       NA        4        2        4        2

使用tidyverse

library(dplyr)
library(tidyr)
library(stringr)
df %>% 
   mutate(rn = row_number()) %>%
  pivot_longer(cols = -rn, names_to = c(".value", 'grp'), 
      names_sep = '_', values_drop_na = TRUE) %>% 
  select(-grp, -rn) %>% 
  rename_all(~ str_c(., '_new')) %>% bind_cols(df, .)
#   ABC1_old ABC2_old ABC1_adj ABC2_adj ABC1_new ABC2_new
#1         1        4       NA       NA        1        4
#2         5        2       NA       NA        5        2
#3         3        1       NA       NA        3        1
#4         4        1       NA       NA        4        1
#5         3        5       NA       NA        3        5
#6        NA       NA        5        3        5        3
#7        NA       NA        5        2        5        2
#8        NA       NA        1        1        1        1
#9        NA       NA        2        4        2        4
#10       NA       NA        4        2        4        2

或使用dplyr

df %>%
   mutate(across(ends_with('old'),
    ~ coalesce(., get(str_replace(cur_column(), 
     'old', 'adj'))), .names = '{.col}_new')) 

我在 github 上有一个包可以解决这个问题和类似的问题。在这种情况下,我们可以使用 dplyover::across2 将一个(或多个)函数应用于两组列,这可以使用 tidyselect 选择。在 .names 参数中,我们可以指定 "{pre}" 来引用两组列的公共前缀。

library(dplyr)
library(dplyover) # https://github.com/TimTeaFan/dplyover

df %>% 
  mutate(across2(ends_with("_old"),
                 ends_with("_adj"),
                 ~ coalesce(.x, .y),
                 .names = "{pre}_new"))

#>    ABC1_old ABC2_old ABC1_adj ABC2_adj ABC1_new ABC2_new
#> 1         1        4       NA       NA        1        4
#> 2         5        2       NA       NA        5        2
#> 3         3        1       NA       NA        3        1
#> 4         4        1       NA       NA        4        1
#> 5         3        5       NA       NA        3        5
#> 6        NA       NA        5        3        5        3
#> 7        NA       NA        5        2        5        2
#> 8        NA       NA        1        1        1        1
#> 9        NA       NA        2        4        2        4
#> 10       NA       NA        4        2        4        2

reprex package (v0.3.0)

于 2021 年 5 月 16 日创建