我们可以创建条件字符串，使用parse_exprs并进行拼接（!!!）。
dplyr case_when具有动态案例数时
Posted
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了dplyr case_when具有动态案例数时相关的知识，希望对你有一定的参考价值。
想要使用dplyr和case_when将一系列指标列折叠为一个列。挑战是我希望能够折叠未指定/动态的列数。
考虑以下数据集，gear已划分为一系列指标列。
library(dplyr)
data(mtcars)
mtcars = mtcars %>%
mutate(g2 = ifelse(gear == 2, 1, 0),
g3 = ifelse(gear == 3, 1, 0),
g4 = ifelse(gear == 4, 1, 0)) %>%
select(g2, g3, g4)
我正在尝试编写一个与之相反的函数。
当我知道有多少种情况时，可以执行以下操作：
combine_indices = function(db, cols, vals)
db %>% mutate(new_col = case_when(!!sym(cols[1]) == 1 ~ vals[1],
!!sym(cols[2]) == 1 ~ vals[2],
!!sym(cols[3]) == 1 ~ vals[3]))
cols = c("g2", "g3", "g4")
vals = c(2,3,4)
combine_indices(mtcars, cols, vals)
但是，我希望combine_indices函数可以处理任意数量的索引列（现在它仅适用于三个索引列。）>
根据文档（?case_when），“如果您的模式存储在列表中，则可以使用!!!进行拼接”。但是我无法正常工作：
patterns = list(sym(cols[1] == 1 ~ vals[1], sym(cols[2] == 1 ~ vals[2], sym(cols[3] == 1 ~ vals[3]) mtcars %>% mutate(new_col = case_when(!!!patterns))仅产生一个充满NA的新列。
如果!!!patterns有效，则直接获取列表cols和vals并生成patterns会很简单。但是，我无法正确地获得保证。希望更熟悉quosure的人知道如何。
注意-SO的一些类似问题已通过连接或其他功能解决。 但是，由于使用dbplyr时它如何转换为sql，因此我只能使用case_when] >>
想要在将一系列指标列折叠为单个列时使用dplyr和case_when。挑战在于我希望能够折叠未指定/动态数量的列。 ...
library(dplyr) library(rlang) combine_indices = function(db, cols, vals) db %>% mutate(new_col = case_when(!!!parse_exprs(paste(cols, '== 1 ~', vals)))) cols = c("g2", "g3", "g4") vals = c(2,3,4) combine_indices(mtcars, cols, vals)返回：
# g2 g3 g4 new_col #1 0 0 1 4 #2 0 0 1 4 #3 0 0 1 4 #4 0 1 0 3 #5 0 1 0 3 #6 0 1 0 3 #....其中
paste动态生成case_when的条件。
paste(cols, '== 1 ~', vals)
#[1] "g2 == 1 ~ 2" "g3 == 1 ~ 3" "g4 == 1 ~ 4"
此解决方案应为gear列中的任何值创建一个列：
data <- mtcars %>%
mutate(mygear = gear) %>%
pivot_wider(values_from = gear, names_from = gear, names_prefix = "g") %>%
mutate_at(vars(starts_with('g')), function(x) x/.$mygear) %>%
mutate_if(is.numeric , replace_na, replace = 0) %>%
rename(gear = mygear)
我确实需要创建一个临时列mygear，因为pivot_wider不保留枢轴列。
> data
# A tibble: 32 x 14
mpg cyl disp hp drat wt qsec vs am carb gear g4 g3 g5
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 21 6 160 110 3.9 2.62 16.5 0 1 4 4 1 0 0
2 21 6 160 110 3.9 2.88 17.0 0 1 4 4 1 0 0
3 22.8 4 108 93 3.85 2.32 18.6 1 1 1 4 1 0 0
4 21.4 6 258 110 3.08 3.22 19.4 1 0 1 3 0 1 0
5 18.7 8 360 175 3.15 3.44 17.0 0 0 2 3 0 1 0
6 18.1 6 225 105 2.76 3.46 20.2 1 0 1 3 0 1 0
7 14.3 8 360 245 3.21 3.57 15.8 0 0 4 3 0 1 0
8 24.4 4 147. 62 3.69 3.19 20 1 0 2 4 1 0 0
9 22.8 4 141. 95 3.92 3.15 22.9 1 0 2 4 1 0 0
10 19.2 6 168. 123 3.92 3.44 18.3 1 0 4 4 1 0 0
# … with 22 more rows
您需要通过expr()使列表中未赋值的表达式中的对象成为case_when的值。老实说，我并没有完全理解它，但这是可行的。
patterns <- list(expr(!!sym(cols[1]) == 1 ~ vals[1]),
expr(!!sym(cols[2]) == 1 ~ vals[2]),
expr(!!sym(cols[3]) == 1 ~ vals[3]))
或更简单地说
patterns <- exprs(!!sym(cols[1]) == 1 ~ vals[1],
!!sym(cols[2]) == 1 ~ vals[2],
!!sym(cols[3]) == 1 ~ vals[3])
mtcars %>% mutate(new_col = case_when(!!!patterns))
为了完整起见，仅针对此特定用例可以使用矩阵乘法获得结果：
library(dplyr)
combine_indices = function(db, cols, vals)
db %>% mutate(new_col = as.matrix(db[, cols]) %*% vals)
cols = c("g2", "g3", "g4")
vals = c(2, 3, 4)
combine_indices(mtcars, cols, vals)
g2 g3 g4 new_col 1 0 0 1 4 2 0 0 1 4 3 0 0 1 4 4 0 1 0 3 5 0 1 0 3 6 0 1 0 3 7 0 1 0 3 8 0 0 1 4 9 0 0 1 4 10 0 0 1 4 11 0 0 1 4 12 0 1 0 3 13 0 1 0 3 14 0 1 0 3 15 0 1 0 3 16 0 1 0 3 17 0 1 0 3 18 0 0 1 4 19 0 0 1 4 20 0 0 1 4 21 0 1 0 3 22 0 1 0 3 23 0 1 0 3 24 0 1 0 3 25 0 1 0 3 26 0 0 1 4 27 0 0 0 0 28 0 0 0 0 29 0 0 0 0 30 0 0 0 0 31 0 0 0 0 32 0 0 1 4说明
对于第1行，我们得到
0 * 2 + 0 * 3 + 1 * 4 = 4
也许我看错了，但是我认为使用join可以更有效地完成它：
cols <- tibble(g2 = c(1, 0, 0), g3 = c(0, 1, 0), g4 = c(0, 0, 1), val = c(2, 3, 4))
cols
# # A tibble: 3 x 4
# g2 g3 g4 val
# <dbl> <dbl> <dbl> <dbl>
# 1 1 0 0 2
# 2 0 1 0 3
# 3 0 0 1 4
# using your mtcars
left_join(mtcars, cols, by = c("g2", "g3", "g4"))
# g2 g3 g4 val
# 1 0 0 1 4
# 2 0 0 1 4
# 3 0 0 1 4
# 4 0 1 0 3
# 5 0 1 0 3
# 6 0 1 0 3
# 7 0 1 0 3
# 8 0 0 1 4
# 9 0 0 1 4
# 10 0 0 1 4
# 11 0 0 1 4
# 12 0 1 0 3
# 13 0 1 0 3
# 14 0 1 0 3
# 15 0 1 0 3
# 16 0 1 0 3
# 17 0 1 0 3
# 18 0 0 1 4
# 19 0 0 1 4
# 20 0 0 1 4
# 21 0 1 0 3
# 22 0 1 0 3
# 23 0 1 0 3
# 24 0 1 0 3
# 25 0 1 0 3
# 26 0 0 1 4
# 27 0 0 0 NA
# 28 0 0 0 NA
# 29 0 0 0 NA
# 30 0 0 0 NA
# 31 0 0 0 NA
# 32 0 0 1 4
答案
我们可以创建条件字符串，使用parse_exprs并进行拼接（!!!）。
另一答案
此解决方案应为gear列中的任何值创建一个列：
data <- mtcars %>%
mutate(mygear = gear) %>%
pivot_wider(values_from = gear, names_from = gear, names_prefix = "g") %>%
mutate_at(vars(starts_with('g')), function(x) x/.$mygear) %>%
mutate_if(is.numeric , replace_na, replace = 0) %>%
rename(gear = mygear)
另一答案
您需要通过expr()使列表中未赋值的表达式中的对象成为case_when的值。老实说，我并没有完全理解它，但这是可行的。
patterns <- list(expr(!!sym(cols[1]) == 1 ~ vals[1]),
expr(!!sym(cols[2]) == 1 ~ vals[2]),
expr(!!sym(cols[3]) == 1 ~ vals[3]))
另一答案
为了完整起见，仅针对此特定用例可以使用矩阵乘法获得结果：
另一答案
也许我看错了，但是我认为使用join可以更有效地完成它：
cols <- tibble(g2 = c(1, 0, 0), g3 = c(0, 1, 0), g4 = c(0, 0, 1), val = c(2, 3, 4))
cols
# # A tibble: 3 x 4
# g2 g3 g4 val
# <dbl> <dbl> <dbl> <dbl>
# 1 1 0 0 2
# 2 0 1 0 3
# 3 0 0 1 4
# using your mtcars
left_join(mtcars, cols, by = c("g2", "g3", "g4"))
# g2 g3 g4 val
# 1 0 0 1 4
# 2 0 0 1 4
# 3 0 0 1 4
# 4 0 1 0 3
# 5 0 1 0 3
# 6 0 1 0 3
# 7 0 1 0 3
# 8 0 0 1 4
# 9 0 0 1 4
# 10 0 0 1 4
# 11 0 0 1 4
# 12 0 1 0 3
# 13 0 1 0 3
# 14 0 1 0 3
# 15 0 1 0 3
# 16 0 1 0 3
# 17 0 1 0 3
# 18 0 0 1 4
# 19 0 0 1 4
# 20 0 0 1 4
# 21 0 1 0 3
# 22 0 1 0 3
# 23 0 1 0 3
# 24 0 1 0 3
# 25 0 1 0 3
# 26 0 0 1 4
# 27 0 0 0 NA
# 28 0 0 0 NA
# 29 0 0 0 NA
# 30 0 0 0 NA
# 31 0 0 0 NA
# 32 0 0 1 4
以上是关于dplyr case_when具有动态案例数时的主要内容，如果未能解决你的问题，请参考以下文章
R语言dplyr包使用case_when函数和mutate函数生成新的数据列实战：基于单列生成新的数据列基于多列生成新的数据列