R - dplyr/purrr - 从现有列对的函数创建新列答案

【问题标题】：R - dplyr/purrr - Create new columns from function of pairs of existing columnsR - dplyr/purrr - 从现有列对的函数创建新列
【发布时间】：2020-05-13 15:28:52
【问题描述】：

我曾多次遇到 dplyr::mutate 的绊脚石，因为我不知道如何基于函数（例如求和或其他任何东西）创建新列，该函数将基于创建新列在所有成对的两组输入列上。部分演示如下：

#Input data
set.seed(100)
in_dat <- tibble(x1 = sample(x = c(1:10, NA_real_), size = 1000, replace = TRUE),
                 x2 = sample(x = c(1:10, NA_real_), size = 1000, replace = TRUE),
                 x3 = sample(x = c(1:10, NA_real_), size = 1000, replace = TRUE),
                 x4 = sample(x = c(1:10, NA_real_), size = 1000, replace = TRUE),
                 y1 = sample(x = c(1, 0, NA_real_), size = 1000, replace = TRUE),
                 y2 = sample(x = c(1, 0, NA_real_), size = 1000, replace = TRUE),
                 y3 = sample(x = c(1, 0, NA_real_), size = 1000, replace = TRUE),
                 y4 = sample(x = c(1, 0, NA_real_), size = 1000, replace = TRUE),
                 y5 = sample(x = c(1, 0, NA_real_), size = 1000, replace = TRUE),
                 y6 = sample(x = c(1, 0, NA_real_), size = 1000, replace = TRUE))

#Output data with 1 column pair; all pairs between x and y should be computed
out_dat_1col <- in_dat %>% 
  mutate(miss_x1y1 = if_else(is.na(x1) & is.na(y1), TRUE, FALSE))

这会检查是否有一对 x 和 y 列都有缺失值，并在新列中标记为 TRUE。不过，这只是一对，我想要一种方法来对 x 和 y 列之间的所有对执行此操作，而不是在它们自己的 mutate 行中手动编码每一对。我认为 purrr 应该能够做到这一点，但我还没有弄清楚 map 变体的正确语法，或者也可能减少。我目前从map2_dfc（使用bind_cols 将新列附加到现有列）和reduce2 都收到错误，.x（x 变量）和.y（y 变量）不是长度一致，我不知道如何规避这一点。任何想法都非常感谢。

#Produces error
out_dat <- in_dat %>% 
  bind_cols(map2_dfc(
    .x = in_dat %>% select(starts_with('x')),
    .y = in_dat %>% select(starts_with('y')),
    .f = ~if_else(is.na(.x) & is.na(.y), TRUE, FALSE)
  ))

Error: Mapped vectors must have consistent lengths:
* `.x` has length 4
* `.y` has length 6

【问题讨论】：

标签： r dplyr data-manipulation purrr

【解决方案1】：

这是使用 lapply、sapply 和 mapply 创建数据框的简短基本 R 方法：

all_cols <- lapply(in_dat, function(y) sapply(in_dat, function(x) is.na(y) & is.na(x)))
all_cols <- mapply(function(x, y) {colnames(x) <- paste(y, colnames(x), sep = "_"); x}, 
                   all_cols, names(all_cols), SIMPLIFY = FALSE)
df <- as_tibble(cbind(in_dat, do.call(cbind, all_cols)))
df
#> # A tibble: 1,000 x 110
#>       x1    x2    x3    x4    y1    y2    y3    y4    y5    y6 x1_x1 x1_x2 x1_x3 x1_x4
#>    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <lgl> <lgl> <lgl> <lgl>
#>  1     3     7     2     5     1     1     0     1     0    NA FALSE FALSE FALSE FALSE 
#>  2     7     5    10     3    NA     0    NA    NA     0    NA FALSE FALSE FALSE FALSE
#>  3     3     3     3     7     1     1    NA     1     1     1 FALSE FALSE FALSE FALSE
#>  4     7     3     1     8     1    NA     1     0    NA     1 FALSE FALSE FALSE FALSE 
#>  5     5     2    10     7     0    NA    NA     0    NA     1 FALSE FALSE FALSE FALSE 
#>  6     7     8    10     8    NA     1     1     1     1     1 FALSE FALSE FALSE FALSE 
#>  7    10     8     3     5     0     1    NA     1     1     1 FALSE FALSE FALSE FALSE 
#>  8     1    10     5    10     1    NA    NA     0     1     1 FALSE FALSE FALSE FALSE
#>  9     7     2     5     9    NA     0     0    NA     1     1 FALSE FALSE FALSE FALSE
#> 10     8     9     1     4     1    NA    NA     1    NA     0 FALSE FALSE FALSE FALSE
#> # ... with 990 more rows, and 96 more variables

唯一的问题是您还检查了每一行，因此要删除它们，您可以执行以下操作：

df <- df[sapply(strsplit(names(df), "_"), function(x) {!any(duplicated(x))})]

【讨论】：