r - 遍历基于 tidyverse/rlang 的函数的输入值
问题描述
我的函数foo
适用于其参数的一个输入值。cat_mod
但我想知道如何让它接受多个输入以在我的函数cat_mod
中使用rlang::ensym(cat_mod)
?
foo <- function(data, study_id, cat_mod){
study_id <- rlang::ensym(study_id)
cat_mod <- rlang::ensym(cat_mod)
studies_cats <-
data %>%
dplyr::group_by(!!study_id, !!cat_mod) %>%
dplyr::summarise(effects = n())
cat_names <- paste0(rlang::as_string(cat_mod), c(".x", ".y"))
studies_cats <-
studies_cats %>%
dplyr::inner_join(studies_cats, by = rlang::as_string(study_id)) %>%
dplyr::group_by(!!!rlang::syms(cat_names)) %>%
dplyr::summarise(
studies = n(),
effects = sum(effects.x)) %>%
dplyr::mutate(n = paste0(studies, " (", effects, ")") )
studies_cats %>%
dplyr::select(-studies, -effects) %>%
tidyr::pivot_wider(names_from = cat_names[2], values_from = n) %>%
dplyr::rename(`Moderator Category` = cat_names[1])
}
#===
## Example of use when using a single input for `cat_mod`:
data <- read.csv("https://raw.githubusercontent.com/rnorouzian/m2/main/q.csv")
foo(data, study.name, time_wk)
foo(data, study.name, treats)
解决方案
如果我们想使用相同的函数,那么map
通过遍历一个字符串来使用
library(purrr)
map(c('time_wk', 'treats'), ~foo(data, study.name, !!.x))
-输出
[[1]]
# A tibble: 12 x 13
# Groups: Moderator Category [12]
`Moderator Category` `0` `2` `4` `6` `7` `8` `9` `12` `24` `40` `1` `3`
<int> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 0 22 (86) 5 (16) 8 (27) 3 (10) 1 (4) 2 (7) 2 (10) 1 (6) 1 (4) 2 (16) <NA> <NA>
2 1 <NA> 1 (12) 6 (35) <NA> <NA> <NA> <NA> <NA> <NA> <NA> 19 (95) 2 (6)
3 2 5 (16) 11 (60) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (12) <NA>
4 3 <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> <NA> <NA> <NA> 2 (6) 4 (11)
5 4 8 (27) <NA> 15 (71) <NA> <NA> <NA> <NA> 1 (6) <NA> <NA> 6 (35) 1 (4)
6 6 3 (10) <NA> <NA> 3 (10) <NA> <NA> <NA> <NA> 1 (4) 1 (4) <NA> <NA>
7 7 1 (4) <NA> <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> <NA> <NA> <NA>
8 8 2 (7) <NA> <NA> <NA> <NA> 3 (13) <NA> <NA> <NA> <NA> <NA> <NA>
9 9 2 (10) <NA> <NA> <NA> <NA> <NA> 2 (10) <NA> <NA> <NA> <NA> <NA>
10 12 1 (6) <NA> 1 (6) <NA> <NA> <NA> <NA> 2 (10) <NA> <NA> <NA> <NA>
11 24 1 (4) <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> 1 (4) 1 (4) <NA> <NA>
12 40 2 (16) <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> 1 (4) 2 (16) <NA> <NA>
[[2]]
# A tibble: 12 x 13
# Groups: Moderator Category [12]
`Moderator Category` `1` `2` `3` `4` `5` `7` `8` `9` `12` `14` `35` `NA`
<int> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 1 13 (121) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
2 2 <NA> 14 (114) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
3 3 <NA> <NA> 10 (50) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
4 4 <NA> <NA> <NA> 2 (9) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
5 5 <NA> <NA> <NA> <NA> 3 (31) <NA> <NA> <NA> <NA> <NA> <NA> <NA>
6 7 <NA> <NA> <NA> <NA> <NA> 2 (20) <NA> <NA> <NA> <NA> <NA> <NA>
7 8 <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA> <NA> <NA> <NA> <NA>
8 9 <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA> <NA> <NA> <NA>
9 12 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (24) <NA> <NA> <NA>
10 14 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (4) <NA> <NA>
11 35 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA>
12 NA <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 2 (11)
该函数可以更改为添加 3 个点 ( ...
) 用于传递多个参数
foo <- function(data, study_id, ...){
study_id <- rlang::ensym(study_id)
cat_mod <- rlang::ensyms(...)
purrr::map(cat_mod, ~ {
studies_cats <-
data %>%
dplyr::group_by(!!study_id, !!.x) %>%
dplyr::summarise(effects = n(), .groups = 'drop')
nm1 <- rlang::as_string(.x)
cat_names <- paste0(nm1, c(".x", ".y"))
studies_cats <-
studies_cats %>%
dplyr::inner_join(studies_cats, by = rlang::as_string(study_id)) %>%
dplyr::group_by(!!!rlang::syms(cat_names)) %>%
dplyr::summarise(
studies = n(),
effects = sum(effects.x), .groups = 'drop') %>%
dplyr::mutate(n = paste0(studies, " (", effects, ")") )
studies_cats %>%
dplyr::select(-studies, -effects) %>%
tidyr::pivot_wider(names_from = cat_names[2], values_from = n) %>%
dplyr::rename_with(~nm1, cat_names[1])
}
)
}
-测试
foo(data, study.name,time_wk, treats )
[[1]]
# A tibble: 12 x 13
time_wk `0` `2` `4` `6` `7` `8` `9` `12` `24` `40` `1` `3`
<int> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 0 22 (86) 5 (16) 8 (27) 3 (10) 1 (4) 2 (7) 2 (10) 1 (6) 1 (4) 2 (16) <NA> <NA>
2 1 <NA> 1 (12) 6 (35) <NA> <NA> <NA> <NA> <NA> <NA> <NA> 19 (95) 2 (6)
3 2 5 (16) 11 (60) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (12) <NA>
4 3 <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> <NA> <NA> <NA> 2 (6) 4 (11)
5 4 8 (27) <NA> 15 (71) <NA> <NA> <NA> <NA> 1 (6) <NA> <NA> 6 (35) 1 (4)
6 6 3 (10) <NA> <NA> 3 (10) <NA> <NA> <NA> <NA> 1 (4) 1 (4) <NA> <NA>
7 7 1 (4) <NA> <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> <NA> <NA> <NA>
8 8 2 (7) <NA> <NA> <NA> <NA> 3 (13) <NA> <NA> <NA> <NA> <NA> <NA>
9 9 2 (10) <NA> <NA> <NA> <NA> <NA> 2 (10) <NA> <NA> <NA> <NA> <NA>
10 12 1 (6) <NA> 1 (6) <NA> <NA> <NA> <NA> 2 (10) <NA> <NA> <NA> <NA>
11 24 1 (4) <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> 1 (4) 1 (4) <NA> <NA>
12 40 2 (16) <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> 1 (4) 2 (16) <NA> <NA>
[[2]]
# A tibble: 12 x 13
treats `1` `2` `3` `4` `5` `7` `8` `9` `12` `14` `35` `NA`
<int> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 1 13 (121) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
2 2 <NA> 14 (114) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
3 3 <NA> <NA> 10 (50) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
4 4 <NA> <NA> <NA> 2 (9) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
5 5 <NA> <NA> <NA> <NA> 3 (31) <NA> <NA> <NA> <NA> <NA> <NA> <NA>
6 7 <NA> <NA> <NA> <NA> <NA> 2 (20) <NA> <NA> <NA> <NA> <NA> <NA>
7 8 <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA> <NA> <NA> <NA> <NA>
8 9 <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA> <NA> <NA> <NA>
9 12 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (24) <NA> <NA> <NA>
10 14 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (4) <NA> <NA>
11 35 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA>
12 NA <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 2 (11)
如果我们想命名列表元素
foo <- function(data, study_id, ...){
study_id <- rlang::ensym(study_id)
cat_mod <- rlang::ensyms(...)
cat_mod_names <- purrr::map_chr(cat_mod, ~rlang::as_string(.x))
purrr::imap(setNames(cat_mod, cat_mod_names), ~ {
nm1 <- .y
studies_cats <-
data %>%
dplyr::group_by(!!study_id, !!.x) %>%
dplyr::summarise(effects = n(), .groups = 'drop')
cat_names <- paste0(nm1, c(".x", ".y"))
studies_cats <-
studies_cats %>%
dplyr::inner_join(studies_cats, by = rlang::as_string(study_id)) %>%
dplyr::group_by(!!!rlang::syms(cat_names)) %>%
dplyr::summarise(
studies = n(),
effects = sum(effects.x), .groups = 'drop') %>%
dplyr::mutate(n = paste0(studies, " (", effects, ")") )
studies_cats %>%
dplyr::select(-studies, -effects) %>%
tidyr::pivot_wider(names_from = cat_names[2], values_from = n) %>%
dplyr::rename_with(~nm1, cat_names[1]) %>%
dplyr::select(1, gtools::mixedorder(names(.)[-1]) + 1)
}
)
}
-测试
foo(data, study.name,time_wk, treats )
$time_wk
# A tibble: 12 x 13
time_wk `0` `1` `2` `3` `4` `6` `7` `8` `9` `12` `24` `40`
<int> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 0 22 (86) <NA> 5 (16) <NA> 8 (27) 3 (10) 1 (4) 2 (7) 2 (10) 1 (6) 1 (4) 2 (16)
2 1 <NA> 19 (95) 1 (12) 2 (6) 6 (35) <NA> <NA> <NA> <NA> <NA> <NA> <NA>
3 2 5 (16) 1 (12) 11 (60) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
4 3 <NA> 2 (6) <NA> 4 (11) 1 (4) <NA> <NA> <NA> <NA> <NA> <NA> <NA>
5 4 8 (27) 6 (35) <NA> 1 (4) 15 (71) <NA> <NA> <NA> <NA> 1 (6) <NA> <NA>
6 6 3 (10) <NA> <NA> <NA> <NA> 3 (10) <NA> <NA> <NA> <NA> 1 (4) 1 (4)
7 7 1 (4) <NA> <NA> <NA> <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> <NA>
8 8 2 (7) <NA> <NA> <NA> <NA> <NA> <NA> 3 (13) <NA> <NA> <NA> <NA>
9 9 2 (10) <NA> <NA> <NA> <NA> <NA> <NA> <NA> 2 (10) <NA> <NA> <NA>
10 12 1 (6) <NA> <NA> <NA> 1 (6) <NA> <NA> <NA> <NA> 2 (10) <NA> <NA>
11 24 1 (4) <NA> <NA> <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> 1 (4) 1 (4)
12 40 2 (16) <NA> <NA> <NA> <NA> 1 (4) <NA> <NA> <NA> <NA> 1 (4) 2 (16)
$treats
# A tibble: 12 x 13
treats `1` `2` `3` `4` `5` `7` `8` `9` `12` `14` `35` `NA`
<int> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 1 13 (121) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
2 2 <NA> 14 (114) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
3 3 <NA> <NA> 10 (50) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
4 4 <NA> <NA> <NA> 2 (9) <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
5 5 <NA> <NA> <NA> <NA> 3 (31) <NA> <NA> <NA> <NA> <NA> <NA> <NA>
6 7 <NA> <NA> <NA> <NA> <NA> 2 (20) <NA> <NA> <NA> <NA> <NA> <NA>
7 8 <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA> <NA> <NA> <NA> <NA>
8 9 <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA> <NA> <NA> <NA>
9 12 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (24) <NA> <NA> <NA>
10 14 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (4) <NA> <NA>
11 35 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 1 (2) <NA>
12 NA <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> 2 (11)
推荐阅读
- mongodb - 在MongoDB中按索引获取数组项
- dotnetnuke - 如何在带有文本字段而不是实体字段的 2sxc 可视化查询中使用关系过滤器?
- if-statement - 我可以对 put 和 delete 请求使用带有 fetch 的条件吗?
- javascript - 使用 Vanilla JS 添加内联 CSS 属性和后备值
- angular - 如何使用角度选择器将一个组件添加到另一个组件中?
- python - 如何在 Python 中解码 Avro 消息?
- python - 我需要采取的步骤才能让其他人看到我的烧瓶网页
- javascript - 为什么我的状态更新会覆盖现有数据值?
- angular - 未找到 t 的组件工厂。你把它添加到@NgModule.entryComponents 了吗?
- docker - 如何从 Docker 容器内部到外部(本地网络)的 Nginx 反向代理(proxy_pass)