函数中的动态选择表达式[重复]

我正在尝试编写一个函数来转换此数据框

library(dplyr)
library(rlang)
library(purrr)

df <- data.frame(obj=c(1,1,2,2,3,3,3,4,4,4),
                 S1=rep(c("a","b"),length.out=10),PR1=rep(c(3,7),length.out=10),
                 S2=rep(c("c","d"),length.out=10),PR2=rep(c(7,3),length.out=10))

   obj S1 PR1 S2 PR2
1    1  a   3  c   7
2    1  b   7  d   3
3    2  a   3  c   7
4    2  b   7  d   3
5    3  a   3  c   7
6    3  b   7  d   3
7    3  a   3  c   7
8    4  b   7  d   3
9    4  a   3  c   7
10   4  b   7  d   3

进入这个数据框

df %>% {bind_rows(select(., obj, S = S1, PR = PR1),
              select(., obj, S = S2, PR = PR2))}
   obj S PR
1    1 a  3
2    1 b  7
3    2 a  3
4    2 b  7
5    3 a  3
6    3 b  7
7    3 a  3
8    4 b  7
9    4 a  3
10   4 b  7
11   1 c  7
12   1 d  3
13   2 c  7
14   2 d  3
15   3 c  7
16   3 d  3
17   3 c  7
18   4 d  3
19   4 c  7
20   4 d  3

但我希望该函数能够处理任意数量的列。因此，如果我有 S1、S2、S3、S4 或者有附加类别（即 DS1、DS2），它也可以工作。理想情况下，该函数将采用确定哪些列彼此堆叠的模式作为参数、每列的组数、输出列的名称以及还应保留的任何变量的名称。

这是我对此功能的尝试：

stack_col <- function(df, patterns, nums, cnames, keep){
  keep <- enquo(keep)
  build_exp <- function(x){
   paste0("!!sym(cnames[[", x, "]]) := paste0(patterns[[", x, "]],num)") %>% 
      parse_expr()
  }
  exps <- map(1:length(patterns), ~expr(!!build_exp(.)))

  sel_fun <- function(num){
    df %>% select(!!keep, 
                  !!!exps)
  }
  map(nums, sel_fun) %>% bind_rows()
}

我可以得到sel_fun部分适用于固定数量的模式，如下所示

patterns <- c("S", "PR")
cnames <- c("Species", "PR")
keep <- quo(obj)
sel_fun <- function(num){
df %>% select(!!keep,
!!sym(cnames[[1]]) := paste0(patterns[[1]], num),
!!sym(cnames[[2]]) := paste0(patterns[[2]], num))
}
sel_fun(1)

但我尝试过的动态版本不起作用并给出以下错误：

Error: `:=` can only be used within a quasiquoted argument

这是一个获得预期输出的函数。使用循环遍历“patterns”和相应的新列名称（“cnames”）map2, gather转换为“长”格式，rename将“val”列传递到函数中的“cnames”，绑定列（bind_cols) and select感兴趣的列

stack_col <- function(dat, pat, cname, keep) {

    purrr::map2(pat, cname, ~ 
                    dat %>%
                       dplyr::select(keep, matches(.x)) %>%
                       tidyr::gather(key, val, matches(.x)) %>%
                       dplyr::select(-key) %>%
                       dplyr::rename(!! .y := val)) %>%
       dplyr::bind_cols(.) %>%
       dplyr::select(keep, cname) 



}

stack_col(df, patterns, cnames, 1)
#    obj Species PR
#1    1       a  3
#2    1       b  7
#3    2       a  3
#4    2       b  7
#5    3       a  3
#6    3       b  7
#7    3       a  3
#8    4       b  7
#9    4       a  3
#10   4       b  7
#11   1       c  7
#12   1       d  3
#13   2       c  7
#14   2       d  3
#15   3       c  7
#16   3       d  3
#17   3       c  7
#18   4       d  3
#19   4       c  7
#20   4       d  3

此外，可以通过以下方式完成多个图案重塑data.table::melt

library(data.table)
melt(setDT(df), measure = patterns("^S\\d+", "^PR\\d+"), 
          value.name = c("Species", "PR"))[, variable := NULL][]