Gee*_*eet 5 r dplyr purrr tidyeval rlang
这是数据:
library(tidyverse)
data <- tibble::tribble(
~var1, ~var2, ~var3, ~var4, ~var5,
"a", "d", "g", "hello", 1L,
"a", "d", "h", "hello", 2L,
"b", "e", "h", "k", 4L,
"b", "e", "h", "k", 7L,
"c", "f", "i", "hello", 3L,
"c", "f", "i", "hello", 4L
)
Run Code Online (Sandbox Code Playgroud)
和矢量,我想用:
filter_var <- c("hello")
groupby_vars1 <- c("var1", "var2", "var3")
groupby_vars2 <- c("var1", "var2")
joinby_vars1 <- c("var1", "var2")
joinby_vars2 <- c("var1", "var2", "var3")
Run Code Online (Sandbox Code Playgroud)
第2和第5,第3和第4个向量相同,但请假设它们不同并将它们保留为不同的向量.
现在我想创建一个通用函数,我可以在其中获取数据和这些向量来获得结果.
my_fun <- function(data, filter_var, groupby_vars1,groupby_vars2, joinby_vars1, joinby_vars2) {
data2 <- data %>% filter(var4 == filter_var)
data3 <- data2 %>%
group_by(groupby_vars1) %>%
summarise(var6 = sum(var5))
data4 <- data3 %>%
ungroup() %>%
group_by(groupby_vars2) %>%
summarise(avg = mean(var6,na.rm = T))
data5 <- data3 %>% left_join(data4, by = joinby_vars1)
data6 <- data %>% left_join(data5, by = joinby_vars2)
}
Run Code Online (Sandbox Code Playgroud)
问题是向函数提供多个变量的多个向量,以用作正文中的dplyr参数.我试着查看http://dplyr.tidyverse.org/articles/programming.html,但无法解决上述问题.
group_by不能把groupby_vars...字符串作为输入.您需要使用rlang::syms()将字符串向量转换为变量,然后使用!!!它们取消引用它们以便可以在内部进行求值group_by
library(tidyverse)
library(rlang)
data <- tibble::tribble(
~var1, ~var2, ~var3, ~var4, ~var5,
"a", "d", "g", "hello", 1L,
"a", "d", "h", "hello", 2L,
"b", "e", "h", "k", 4L,
"b", "e", "h", "k", 7L,
"c", "f", "i", "hello", 3L,
"c", "f", "i", "hello", 4L
)
filter_var <- c("hello")
groupby_vars1 <- c("var1", "var2", "var3")
groupby_vars2 <- c("var1", "var2")
joinby_vars1 <- c("var1", "var2")
joinby_vars2 <- c("var1", "var2", "var3")
my_fun <- function(data, filter_var,
groupby_vars1, groupby_vars2,
joinby_vars1, joinby_vars2) {
groupby_vars1 <- syms(groupby_vars1)
groupby_vars2 <- syms(groupby_vars2)
data2 <- data %>%
filter(var4 == filter_var)
data3 <- data2 %>%
group_by(!!! groupby_vars1) %>%
summarise(var6 = sum(var5))
data4 <- data3 %>%
ungroup() %>%
group_by(!!! groupby_vars2) %>%
summarise(avg = mean(var6, na.rm = TRUE))
data5 <- data3 %>%
left_join(data4, by = joinby_vars1)
data6 <- data %>%
left_join(data5, by = joinby_vars2)
return(data6)
}
my_fun(data, filter_var,
groupby_vars1, groupby_vars2,
joinby_vars1, joinby_vars2)
#> # A tibble: 6 x 7
#> var1 var2 var3 var4 var5 var6 avg
#> <chr> <chr> <chr> <chr> <int> <int> <dbl>
#> 1 a d g hello 1 1 1.5
#> 2 a d h hello 2 2 1.5
#> 3 b e h k 4 NA NA
#> 4 b e h k 7 NA NA
#> 5 c f i hello 3 7 7
#> 6 c f i hello 4 7 7
Run Code Online (Sandbox Code Playgroud)
另一种方法:使用parse_exprs外部解析字符串向量,然后在函数内取消引用它们.另请参见本
my_fun2 <- function(data, filter_var,
groupby_vars1, groupby_vars2,
joinby_vars1, joinby_vars2) {
data2 <- data %>%
filter(var4 == filter_var)
data3 <- data2 %>%
group_by(!!! groupby_vars1) %>%
summarise(var6 = sum(var5))
data4 <- data3 %>%
ungroup() %>%
group_by(!!! groupby_vars2) %>%
summarise(avg = mean(var6, na.rm = TRUE))
data5 <- data3 %>%
left_join(data4, by = joinby_vars1)
data6 <- data %>%
left_join(data5, by = joinby_vars2)
return(data6)
}
my_fun2(data, filter_var,
parse_exprs(groupby_vars1), parse_exprs(groupby_vars2),
joinby_vars1, joinby_vars2)
identical(my_fun(data, filter_var,
groupby_vars1, groupby_vars2,
joinby_vars1, joinby_vars2),
my_fun2(data, filter_var,
parse_exprs(groupby_vars1), parse_exprs(groupby_vars2),
joinby_vars1, joinby_vars2))
[1] TRUE
Run Code Online (Sandbox Code Playgroud)
由reprex包(v0.2.0)创建于2018-04-24.