如果我们想使用相同的函数,那么通过循环一个字符串来使用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,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 <- 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,.groups = 'drop')
cat_names <- paste0(nm1,cat_names[1]) %>%
dplyr::select(1,order(as.integer(names(.)[-1])) + 1)
}
)
}
-测试
foo(data,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)
本文链接:https://www.f2er.com/520.html