Dynamic select expression in function [duplicate]

问题:

This question already has answers here:

Reshaping multiple sets of measurement columns (wide format) into single columns (long format) (7 answers)

Closed 2 years ago.

I am trying to write a function that will convert this data frame

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

In to this data frame

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

But I would like the function to be able to work with any number of columns. So it would also work if I had S1, S2, S3, S4 or if there was an additional category ie DS1, DS2. Ideally the function would take as arguments the patterns that determine which columns are stacked on top of each other, the number of sets of each column, the names of the output columns and the names of any variables that should also be kept.

This is my attempt at this function:

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()
}

I can get the sel_fun part to work for a fixed number of patterns like this

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)

But the dynamic version that I have tried does not work and gives this error:

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

回答1:

Here is a function to get the expected output. Loop through the 'patterns' and the corresponding new column names ('cnames') using map2, gather into 'long' format, rename the 'val' column to the 'cnames' passed into the function, bind the columns (bind_cols) and select the columns of interest

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

---

Also, multiple patterns reshaping can be done with data.table::melt

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

回答2:

This solves your problem, although it does not fix your function:

The idea is to use gather and spread on the columns which starts with the specific pattern. Therefore I create a regex which matches the column names and then first gather all of them, extract the group and the rename the groups with the cnames. Finally spread takes separates the new columns.

library(dplyr)
library(purrr)
library(tidyr)
library(stringr)

patterns <- c("S", "PR")
cnames <- c("Species", "PR")
names(cnames) <- patterns 
complete_pattern <- str_c("^", str_c(patterns, collapse = "|^"))

df %>% 
  mutate(rownumber = 1:n()) %>%
  gather(new_variable, value, matches(complete_pattern)) %>% 
  mutate(group = str_extract(new_variable, complete_pattern), 
         group = str_replace_all(group, cnames),
         group_number = str_extract(new_variable, "\\d+")) %>% 
  select(-new_variable) %>% 
  spread(group, value)

#    obj rownumber group_number PR Species
# 1    1         1            1  3       a
# 2    1         1            2  7       c
# 3    1         2            1  7       b
# 4    1         2            2  3       d
# 5    2         3            1  3       a
# 6    2         3            2  7       c
# 7    2         4            1  7       b
# 8    2         4            2  3       d
# 9    3         5            1  3       a
# 10   3         5            2  7       c
# 11   3         6            1  7       b
# 12   3         6            2  3       d
# 13   3         7            1  3       a
# 14   3         7            2  7       c
# 15   4         8            1  7       b
# 16   4         8            2  3       d
# 17   4         9            1  3       a
# 18   4         9            2  7       c
# 19   4        10            1  7       b
# 20   4        10            2  3       d