创建 (dplyr::mutate) 和 select (dplyr::select) 通过用户定义函数粘贴两个现有列的新变量

Question

使用用户定义的函数，我必须加入数据框中选定数量的列的置信区间的下限和上限（命名为 CIlow 和 CIhigh）。数据框有 CIlow 和 CIhigh 用于多个组（命名为 a、b 和 c）和数字行（在本例中只有两个）。看看下面数据框的样子。

dataframe<-data.frame(CIlow_a=c(1.1,1.2),CIlow_b=c(2.1,2.2),CIlow_c=c(3.1,3.2),
CIhigh_a=c(1.3,1.4),CIhigh_b=c(2.3,2.4),CIhigh_c=c(3.3,3.4))

我想在现有组（a、b 和 c)。

因此，预期输出应如下所示：

output<-data.frame(CI_a=c("(1.1,1.3)","(1.2,1.4)"),
                  CI_b=c("(2.1,2.3)","(2.2,2.4)"))

为了构建我自己的用户定义函数，我尝试了以下代码：

f<-function(df,gr){

enquo_gr<-enquo(gr)

r<-df%>%
   dplyr::mutate(UQ(paste("CI",quo_name(gr),sep="_")):=
                   sprintf("(%s,%s)",
                           paste("CIlow",UQ(enquo_gr),sep="_"),
                           paste("CIhigh",UQ(enquo_gr),sep="_")))%>%
   dplyr::select(paste("CI",UQ(enquo_gr),sep="_"))

return(r)
}

但是当以这种方式使用上述功能时

library(dplyr)
group<-c("a","b")
dataframe<-data.frame(CIlow_a=c(1.1,1.2),CIlow_b=c(2.1,2.2),CIlow_c=c(3.1,3.2),CIhigh_a=c(1.3,1.4),CIhigh_b=c(2.3,2.4),CIhigh_c=c(3.3,3.4))

f(df=dataframe,gr=group)

我收到以下错误消息：

Error: expr must quote a symbol, scalar, or call

我该如何解决这个问题？

PS1：本题与a previous one类似。但是，这个问题更进一步，因为它需要选择要合并的列。

PS2：我很感激按照这个问题的方法提出代码建议。

Answer 1

如果我们传递带引号的字符串，则使用 sym（对于多个元素 - syms 其中 return a list）

f <- function(df, gr){
   sl <-  rlang::syms(paste("CIlow", gr, sep="_"))
   sh <-  rlang::syms(paste("CIhigh", gr, sep="_"))
   nmN <- paste("CI", gr, sep= "_")


   df %>%
       dplyr::mutate(!!(nmN[1]) := sprintf("(%s,%s)",
                               !!(sl[[1]]), !!(sh[[1]])),
                     !!(nmN[2]) := sprintf("(%s,%s)",
                               !!(sl[[2]]), !!(sh[[2]]))) %>%
       dplyr::select(paste("CI", gr, sep="_"))



 }

group <- c("a","b")
f(dataframe, group)
#      CI_a      CI_b
#1 (1.1,1.3) (2.1,2.3)
#2 (1.2,1.4) (2.2,2.4)

Answer 2

我自己找到了解决问题的方法。下面的代码有效：

output<-data.frame(CI_a=c("(1.1,1.3)","(1.2,1.4)"), CI_b=c("(2.1,2.3)","(2.2,2.4)"))

dataframe<-data.frame(CIlow_a=c(1.1,1.2),CIlow_b=c(2.1,2.2),CIlow_c=c(3.1,3.2),
                      CIhigh_a=c(1.3,1.4),CIhigh_b=c(2.3,2.4),CIhigh_c=c(3.3,3.4))

f <- function(df, gr){

   sl <<-  rlang::syms(paste("CIlow", gr, sep="_"))
   sh <<-  rlang::syms(paste("CIhigh", gr, sep="_"))
   nmN <<- paste("CI", gr, sep= "_")
   r<-df

for(i in 1:length(gr)){
        r<-dplyr::mutate(r,UQ(nmN[i]) := sprintf("(%s;%s)", UQ(sl[[i]]),UQ(sh[[i]])))
}
   r<- dplyr::select(r,nmN)
return(r)

 }

group <- c("a","b")

x<-f(df=dataframe, gr=group)

该代码适用于 group 中未定义数量的元素。因此，它适用于 c("a","b")、c("a") 或 c("a","b","c").

我知道不推荐使用循环。任何更好的解决方案表示赞赏。

Answer 3

我可能会根据问题做出不同的回答，但在检查了您的回答后，我准备了以下代码。它使用此处 lapply 的技巧。我不确定这里使用 dplyr/tidyr 是否是最好的选择，也许简单的 for 会更简单。

output <- data.frame(CI_a=c("(1.1,1.3)","(1.2,1.4)"),
                     CI_b=c("(2.1,2.3)","(2.2,2.4)"),
                     stringsAsFactors = F)

dataframe <- data.frame(CIlow_a=c(1.1,1.2),CIlow_b=c(2.1,2.2),CIlow_c=c(3.1,3.2),
                        CIhigh_a=c(1.3,1.4),CIhigh_b=c(2.3,2.4),CIhigh_c=c(3.3,3.4))


tricky <- function(input_data, group_ids){

  # convert columns to character

  input_data <- input_data %>%
    mutate_each(funs(as.character(.)))

  # unite selected groups

  output <- group_ids %>%
    lapply(function(group_id) {unite_(input_data, 
                                      paste0("CI_", group_id), 
                                      paste0(c("CIlow_", "CIhigh_"), group_id), 
                                      sep = ',') %>% select_(paste0("CI_", group_id))}) %>%
    bind_cols() %>%
    mutate_each(funs(paste0("(", ., ")")))

  return(output)

}

identical(tricky(dataframe, list("a", "b")), output)

创建 (dplyr::mutate) 和 select (dplyr::select) 通过用户定义函数粘贴两个现有列的新变量

Create (dplyr::mutate) and select (dplyr::select) new variables that paste two existing columns by means of a user-defined function

r

function

paste

dplyr