dplyr和tidyr - 如何使用动态条件生成case_when？

Question

dplyr和tidyr - 如何使用动态条件生成case_when？

9

有没有一种方法可以动态/以编程方式生成具有不同列名称和/或不同条件数量的 dplyr 中的 case_when 条件？我有一个交互式脚本，正在尝试将其转换为函数。在 case_when 语句中有很多重复的代码，我想知道是否可以在不需要再次从头编写所有内容的情况下自动化处理。

这是一个虚拟数据集:

test_df = tibble(low_A=c(5, 15, NA),
                 low_TOT=c(NA, 10, NA),
                 low_B=c(20, 25, 30),
                 high_A=c(NA, NA, 10),
                 high_TOT=c(NA, 40, NA),
                 high_B=c(60, 20, NA))

expected_df = tibble(low_A=c(5, 15, NA),
                     low_TOT=c(NA, 10, NA),
                     low_B=c(20, 25, 30),
                     ans_low=c(5, 10, 30),
                     high_A=c(NA, NA, 10),
                     high_TOT=c(NA, 40, NA),
                     high_B=c(60, 20, NA),
                     ans_high=c(60, 40, 10))

> expected_df
# A tibble: 3 x 8
  low_A low_TOT low_B ans_low high_A high_TOT high_B ans_high
  <dbl>   <dbl> <dbl>   <dbl>  <dbl>    <dbl>  <dbl>    <dbl>
1     5      NA    20       5     NA       NA     60       60
2    15      10    25      10     NA       40     20       40
3    NA      NA    30      30     10       NA     NA       10

我需要的逻辑是，如果._TOT列有值，则使用该列。如果没有，则尝试使用._A列，如果还没有，则使用 ._B列。请注意，我故意没有将._TOT列作为组的第一列。在这种情况下，我可以使用coalesce()函数，但是我希望有一个通用解决方案，不考虑列的顺序。

当然，这一切都可以通过几个case_when语句轻松实现。我的问题是：

我正在尝试创建一个通用函数，因此不希望进行交互/整洁评估。
我有很多类似的列。所有这些列都以_TOT，_A，_B结尾，但具有不同的前缀（例如：low_TOT, low_A, low_B, high_TOT, high_A, high_B,......），而我不想一遍又一遍地重写case_when函数。

目前我的代码看起来像这样(其中我为每个前缀编写了一个case_when)：

def my_function = function(df) { 
    df %>% mutate(
          # If a total low doesn't exist, use A (if exists) or B (if exists)
          "ans_low" := case_when(
            !is.na(.data[["low_TOT"]]) ~ .data[["low_TOT"]],
            !is.na(.data[["low_A"]]) ~ .data[["low_A"]],
            !is.na(.data[["low_B"]]) ~ .data[["low_B"]],
          ),

          # If a total high doesn't exist, use A (if exists) or B (if exists)
          "ans_high" := case_when(
            !is.na(.data[["high_TOT"]]) ~ .data[["high_TOT"]],
            !is.na(.data[["high_A"]]) ~ .data[["high_R"]],
            !is.na(.data[["high_B"]]) ~ .data[["high_B"]],
              
         # Plus a whole bunch of similar case_when functions...
}

我希望得到的是一种动态生成不同条件case_when函数的方法，这样每次就不需要编写新的case_when函数了。利用以下特点：

所有三个条件都具有相同的一般形式和变量名称结构，但具有不同的前缀（例如high_，low_等）。
它们具有相同的公式格式为!is.na(.data[[. ]])〜.data[[.]]，其中点（.）是列的动态生成名称。

我想要的是像下面这样的东西:

def my_function = function(df) { 
    df %>% mutate(
          "ans_low" := some_func(prefix="Low"),
          "ans_high" := some_func(prefix="High")
}

我试图创建自己的case_when生成器以替换标准的case_when，如下所示，但是出现了错误。我猜测这是因为.data在tidyverse函数之外无法正常工作?

some_func = function(prefix) {
  case_when(
    !is.na(.data[[ sprintf("%s_TOT", prefix) ]]) ~ .data[[ sprintf("%s_TOT", prefix) ]],
    !is.na(.data[[ sprintf("%s_A", prefix) ]]) ~ .data[[ sprintf("%s_A", prefix) ]],
    !is.na(.data[[ sprintf("%s_B", prefix) ]]) ~ .data[[ sprintf("%s_B", prefix) ]]
  )
}

我还想知道的是如何制作一个更加通用的case_when生成器。到目前为止，仅列出列名称（前缀）发生了变化。如果我想要：

改变后缀的数量和名称（例如，high_W, high_X, high_Y, high_Z, low_W, low_X, low_Y, low_Z, .......），并将后缀字符向量作为some_func的参数之一。
修改公式的形式。现在，所有条件的公式形式都是!is.na(.data[[ . ]]) ~ .data[[ . ]]，但如果我想将其作为some_func的一个参数，该怎么做呢？例如，!is.na(.data[[ . ]]) ~ sprintf("%s is missing", .)

如果只能让它与不同的前缀配合使用，我会很高兴，但如果我能理解如何使用任意（但常见）后缀和任意公式实现更通用的功能，那就太棒了，这样我就可以使用some_func(prefix, suffixes, formula)。

- anonymous1a

请提供一个小的可重现的示例。 - akrun

如果您提供一个简单的可重现示例，其中包含样本输入和期望输出，那么我们更容易帮助您测试和验证可能的解决方案。如果您只是想获取第一个非NA值，那么像coalesce()这样的函数可能更合适。 - MrFlick

现在看一下。我添加了一个简单的数据集作为示例，并重新编写了问题以使其更清晰和更短。它仍然有点长，因为实际上，我正在询问关于逐渐增加泛化程度的三个问题，我想知道是否可能开始解决这些问题。 - anonymous1a

coalesce()可能是一个潜在的答案，但我更感兴趣的是动态生成条件（is.na只是这里的一个特定示例，而coalesce也需要特定的列顺序）。我真的很想了解如何更好地使用dplyr进行编程，并实现更高层次的抽象/通用性。 - anonymous1a

我也尝试过在列进行重新排序后使用coalese()，但它仍然存在同样的主要问题：现在我必须编写一堆coalesce语句。我想利用列组的共同前缀，这样我就不必编写10个不同的case_when或coalese语句了。 - anonymous1a

为什么不通过前缀拆分列，使用 gsub("_(TOT|[A-Z]+)$", "", ...) 在 colnames() 上的结果来确定它们如何拆分？这考虑了无限多个列后缀：*_TOT、*_A、*_B、*_C、……、*_Z、*_AA、*_AB等等。然后对于这些拆分（"low_"和"high_"），按后缀排序它们的colnames()，由str_extract("_(TOT|[A-Z]+)$")给出；显然，您必须将"_TOT"重新排序为第一项。然后mutate(paste0("ans_", prefix) = coalesce(everything()))，并将所有结果cbind()或bind_cols()在一起。 - Greg

6个回答

6

冒着无法回答问题的风险，我认为最简单的方法是重新整理并使用coalesce()。你的数据结构需要两个轴心（我认为），但这不需要仔细考虑哪些前缀存在。

library(tidyverse)

test_df <- tibble(
  low_A = c(5, 15, NA),
  low_TOT = c(NA, 10, NA),
  low_B = c(20, 25, 30),
  high_A = c(NA, NA, 10),
  high_TOT = c(NA, 40, NA),
  high_B = c(60, 20, NA)
)

test_df %>%
  rowid_to_column() %>%
  pivot_longer(cols = -rowid, names_to = c("prefix", "suffix"), names_sep = "_") %>%
  pivot_wider(names_from = suffix, values_from = value) %>%
  mutate(ans = coalesce(TOT, A, B)) %>%
  pivot_longer(cols = c(-rowid, -prefix), names_to = "suffix") %>%
  pivot_wider(names_from = c(prefix, suffix), names_sep = "_", values_from = value)
#> # A tibble: 3 x 9
#>   rowid low_A low_TOT low_B low_ans high_A high_TOT high_B high_ans
#>   <int> <dbl>   <dbl> <dbl>   <dbl>  <dbl>    <dbl>  <dbl>    <dbl>
#> 1     1     5      NA    20       5     NA       NA     60       60
#> 2     2    15      10    25      10     NA       40     20       40
#> 3     3    NA      NA    30      30     10       NA     NA       10

注意，case_when没有整洁评估，因此仅仅不使用mutate就可以大大简化您的some_func。您已经在mutate内部使用了!!sym来获得答案，下面是演示一个更简单方法的版本。我更喜欢在不必要的情况下不使用tidyeval，因为我想使用mutate链，在这里它并不是真正需要的。

some_func <- function(df, prefix) {
  ans <- str_c(prefix, "_ans")
  TOT <- df[[str_c(prefix, "_TOT")]]
  A <- df[[str_c(prefix, "_A")]]
  B <- df[[str_c(prefix, "_B")]]
  
  df[[ans]] <- case_when(
    !is.na(TOT) ~ TOT,
    !is.na(A) ~ A,
    !is.na(B) ~ B
  )
  df
}

reduce(c("low", "high"), some_func, .init = test_df)
#> # A tibble: 3 x 8
#>   low_A low_TOT low_B high_A high_TOT high_B low_ans high_ans
#>   <dbl>   <dbl> <dbl>  <dbl>    <dbl>  <dbl>   <dbl>    <dbl>
#> 1     5      NA    20     NA       NA     60       5       60
#> 2    15      10    25     NA       40     20      10       40
#> 3    NA      NA    30     10       NA     NA      30       10

- Calum You

我的直觉也是只需“重新塑造并使用coalesce()”。但我很好奇：我们如何将其推广到任意数量的字母后缀 _A、_B、……、_Z、_AA、_AB 等等？对于可能包含 _ 的前缀，比如 another_prefix_A，该怎么办？也许可以通过将列名旋转成一个 name 列，然后将每个 name 分割成 (1) 与正则表达式 _(TOT|[A-Z]+)$ 匹配的子字符串，以及 (2) 出现在其前面的所有内容的子字符串。 - Greg

1

为了处理任意后缀，我可能想要对后缀列表进行排序并拼接到 coalesce 中。对于复杂的前缀，pivot_longer 支持 names_pattern，因此您可以使用正则表达式选择所需的组（例如，(^.*)_([^_]+$) 将（我认为）使后缀成为字符串末尾之前的最后一个 _，并且前缀是该下划线之前的所有内容）。 - Calum You

我真的很喜欢你的基本R解决方案（比多个数据透视表更好）。不幸的是，你的解决方案并没有真正解决动态生成case_when条件的问题，所以我不得不选择TimeTeaFan的答案作为被接受的答案。但如果我再次这样做，我肯定会使用你的基本R解决方案，因为它更容易理解。 - anonymous1a

6

更新的解决方案 我认为这个只基于R语言基础的解决方案可能会对你有所帮助。

fn <- function(data) {
  
  do.call(cbind, lapply(unique(gsub("([[:alpha:]]+)_.*", "\\1", names(test_df))), function(x) {
    tmp <- test_df[paste0(x, c("_TOT", "_A", "_B"))]
    tmp[[paste(x, "ans", sep = "_")]] <- Reduce(function(a, b) {
      i <- which(is.na(a))
      a[i] <- b[i]
      a
    }, tmp)
    tmp
  }))
}

fn(test_df)

fn(test_df)

   high_TOT high_A high_B high_ans low_TOT low_A low_B low_ans
1       NA     NA     60       60      NA     5    20       5
2       40     NA     20       40      10    15    25      10
3       NA     10     NA       10      NA    NA    30      30

- Anoushiravan R

3

感谢大家的回答！Calum You的回答特别让我意识到一直坚持使用Tidyverse并不一定是最好的选择，有时候基础R会有更好、更简单、更优雅的解决方案。

通过大量搜索和RStduio社区中noahm的这篇卓越的帖子，我也能够自己想出一个解决方案，它实现了我所需要的功能：

library(tidyverse)
library(rlang)
library(glue)

make_expr = function(prefix, suffix) {
  rlang::parse_expr(glue::glue('!is.na(.data[[\"{prefix}_{suffix}\"]]) ~ .data[[\"{prefix}_{suffix}\"]]'))
}

make_conds = function(prefixes, suffixes){
  map2(prefixes, suffixes, make_expr)
}

ans_df = test_df %>%  
    mutate(
        "ans_low" := case_when(
            !!! make_conds( prefixes=c("low"), suffixes=c("TOT", "A", "B") ) 
        ),
        "ans_high" := case_when(
            !!! make_conds( prefixes=c("high"), suffixes=c("TOT", "A", "B") ) 
        )
    )

# The ans is the same as the expected solution
> all_equal(ans_df, expected_df)
[1] TRUE

我还确认过这在函数内也能正常工作（这对我来说是另一个重要的考虑因素）。

这种解决方案的一个好处是后缀没有硬编码，至少实现了我所期望的第一级泛化。

我想一些字符串替换操作可能也可以允许公式结构的泛化。最终，通用公式将需要某种字符串模板解决方案，因为使用这种结构，您只需保持该结构粘合即可。

- anonymous1a

2

这不会生成任何case_when，但是您可以按以下方式创建两个新列。当然，这也可以是一个带有test_df、ans_order和and_groups作为参数的函数。

ans_order <- c('TOT', 'A', 'B')
ans_groups <- c('low', 'high')

test_df[paste0('ans_', ans_groups)] <- 
  apply(outer(ans_groups, ans_order, paste, sep = '_'), 1, 
        function(x) do.call(dplyr::coalesce, test_df[x]))

test_df
#>   low_A low_TOT low_B high_A high_TOT high_B ans_low ans_high
#> 1     5      NA    20     NA       NA     60       5       60
#> 2    15      10    25     NA       40     20      10       40
#> 3    NA      NA    30     10       NA     NA      30       10

如果您不想使用任何包，另一个选择是：

test_df[paste0('ans_', ans_groups)] <- 
  apply(outer(ans_groups, ans_order, paste, sep = '_'), 1, 
        function(x) Reduce(function(x, y) ifelse(is.na(x), y, x), test_df[x]))

- IceCreamToucan

1

尽管答案已被接受，但我认为这可以在dplyr中完成（甚至适用于任意列集），而无需先编写自定义函数。

test_df %>%
  mutate(across(ends_with('_TOT'), ~ coalesce(., 
                                              get(gsub('_TOT', '_A', cur_column())), 
                                              get(gsub('_TOT', '_B', cur_column()))
                                              ),
                .names = "ans_{gsub('_TOT', '', .col)}"))

# A tibble: 3 x 8
  low_A low_TOT low_B high_A high_TOT high_B ans_low ans_high
  <dbl>   <dbl> <dbl>  <dbl>    <dbl>  <dbl>   <dbl>    <dbl>
1     5      NA    20     NA       NA     60       5       60
2    15      10    25     NA       40     20      10       40
3    NA      NA    30     10       NA     NA      30       10

一个完整的基础 R 方法。

Reduce(function(.x, .y) {
  xx <- .x[paste0(.y, c('_TOT', '_A', '_B'))]
  .x[[paste0('ans_',.y)]] <- apply(xx, 1, \(.z) head(na.omit(.z), 1))
  .x
}, unique(gsub('([_]*)_.*', '\\1', names(test_df))),
init = test_df)

# A tibble: 3 x 8
  low_A low_TOT low_B high_A high_TOT high_B ans_low ans_high
  <dbl>   <dbl> <dbl>  <dbl>    <dbl>  <dbl>   <dbl>    <dbl>
1     5      NA    20     NA       NA     60       5       60
2    15      10    25     NA       40     20      10       40
3    NA      NA    30     10       NA     NA      30       10

- AnilGoyal

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- TimTeaFan · Accepted Answer

这里是一个自定义的 case_when 函数，你可以使用 purrr::reduce 和一个字符串向量作为变量名的部分（在本例中为 c("low", "high")）来调用它：

library(dplyr)
library(purrr)

my_case_when <- function(df, x) {
  
  mutate(df,
         "ans_{x}" := case_when(
           !is.na(!! sym(paste0(x, "_TOT"))) ~ !! sym(paste0(x, "_TOT")),
           !is.na(!! sym(paste0(x, "_A"))) ~ !! sym(paste0(x, "_A")),
           !is.na(!! sym(paste0(x, "_B"))) ~ !! sym(paste0(x, "_B"))
           )
  )
}

test_df %>% 
  reduce(c("low", "high"), my_case_when, .init = .)

#> # A tibble: 3 x 8
#>   low_A low_TOT low_B high_A high_TOT high_B ans_low ans_high
#>   <dbl>   <dbl> <dbl>  <dbl>    <dbl>  <dbl>   <dbl>    <dbl>
#> 1     5      NA    20     NA       NA     60       5       60
#> 2    15      10    25     NA       40     20      10       40
#> 3    NA      NA    30     10       NA     NA      30       10

^{本文档由reprex软件包（v0.3.0）于2021-07-22创建。}

我在Github上有一个名为{dplyover}的软件包，专门用于这种情况。对于您的例子，其中有两个以上变量，我会使用特殊的语法将字符串作为变量名进行评估，并与dplyover::over一起使用。我们还可以使用dplyover::cut_names("_TOT")来提取变量名称中"_TOT"之前或之后的字符串部分（在此示例中，这是"low"和"high"）。

我们可以使用case_when：

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

test_df %>% 
  mutate(over(cut_names("_TOT"),
              list(ans = ~ case_when(
                  !is.na(.("{.x}_TOT")) ~ .("{.x}_TOT"),
                  !is.na(.("{.x}_A")) ~ .("{.x}_A"),
                  !is.na(.("{.x}_B")) ~ .("{.x}_B")
                  )),
              .names = "{fn}_{x}")
         )

#> # A tibble: 3 x 8
#>   low_A low_TOT low_B high_A high_TOT high_B ans_low ans_high
#>   <dbl>   <dbl> <dbl>  <dbl>    <dbl>  <dbl>   <dbl>    <dbl>
#> 1     5      NA    20     NA       NA     60       5       60
#> 2    15      10    25     NA       40     20      10       40
#> 3    NA      NA    30     10       NA     NA      30       10

或者更简单的合并函数：

test_df %>% 
  mutate(over(cut_names("_TOT"),
              list(ans = ~ coalesce(.("{.x}_TOT"),
                                    .("{.x}_A"),
                                    .("{.x}_B"))),
              .names = "{fn}_{x}")
  )

#> # A tibble: 3 x 8
#>   low_A low_TOT low_B high_A high_TOT high_B ans_low ans_high
#>   <dbl>   <dbl> <dbl>  <dbl>    <dbl>  <dbl>   <dbl>    <dbl>
#> 1     5      NA    20     NA       NA     60       5       60
#> 2    15      10    25     NA       40     20      10       40
#> 3    NA      NA    30     10       NA     NA      30       10

^{本文档由 reprex package (v0.3.0) 于2021-07-22创建。}