生成引用现有变量的动态变量答案

【问题标题】：Generating dynamic variables referencing existing variables生成引用现有变量的动态变量
【发布时间】：2019-12-28 04:49:03
【问题描述】：

我正在尝试生成一个带有显着性星的相关矩阵。取以下数据框：

df <- tibble(stub = c(1,2,3,4),
             stub_pvalue = c(.00, .04, .07,.2))

如果 stub_pvalue 小于 .01，我想编写一个粘贴与“***”连接的任何列（例如本例中的存根）的函数，否则只是粘贴存根。比如：

assign_stars <- function(var) {

    if (paste0(var,"_pvalue") < .01) {
      paste0(var, "***")
    } else {
      paste0(var)
    }

}

df %>% 
  mutate(col_with_stars = map_chr(col, assign_stars))

但是，我不知道如何让 if 的第一个逻辑条件对 var + "_pvalue" 进行评估。有人可以帮忙吗？

【问题讨论】：

标签： r dplyr tidyverse purrr tidyeval

【解决方案1】：

这个问题你可能想多了，ifelse 是矢量化函数，你可以用它来进行动态变化。

df <- tibble(stub1 = c(1,2,3,4),
             stub1_pvalue = c(.00, .04, .07,.2),
             stub2 = c(1,2,3,4),
             stub2_pvalue = c(.00,.00,.02,.2))


for(x in paste0("stub",seq(1:2))){
 df[[paste0(x,"_with_star")]] <- ifelse(df[[paste0(x,"_pvalue")]]< .01, paste0(df[[x]],"***"),df[[x]])
}

df

# A tibble: 4 x 6
  stub1 stub1_pvalue stub2 stub2_pvalue stub1_with_star stub2_with_star
  <dbl>        <dbl> <dbl>        <dbl> <chr>           <chr>          
1     1         0        1         0    1***            1***           
2     2         0.04     2         0    2               2***           
3     3         0.07     3         0.02 3               3              
4     4         0.2      4         0.2  4               4

【讨论】：

【解决方案2】：

您可以在 base R 中编写一个函数，然后使用 dplyr，如下所示：

assign_stars = function(var){
  pval = paste0(substitute(var),"_pvalue")
  tst = tryCatch(get(pval, parent.frame()), error = function(e) FALSE)
  if(length(unlist(tst))==1&&tst==FALSE) return(NULL)
  paste0(var, ifelse(tst<0.01,"***",""))
}

那么你可以把它当作：

对于一个变量：

   df%>%mutate(stub_marker = assign_stars(stub))
# A tibble: 4 x 5
   stub stub_pvalue   sho sho_pvalue stub_marker
  <dbl>       <dbl> <dbl>      <dbl> <chr>      
1     1        0        8      0.005 1***       
2     2        0.04     7      0.03  2          
3     3        0.07     6      0     3          
4     4        0.2      5      0.24  4

对于所有变量：

df%>%mutate_all(funs(marker=assign_stars))
# A tibble: 4 x 6
   stub stub_pvalue   sho sho_pvalue stub_marker sho_marker
  <dbl>       <dbl> <dbl>      <dbl> <chr>       <chr>     
1     1        0        8      0.005 1***        8***      
2     2        0.04     7      0.03  2           7         
3     3        0.07     6      0     3           6***      
4     4        0.2      5      0.24  4           5

【讨论】：

【解决方案3】：

assign_stars <- function(df, var, threshold, marker) {

  require(dplyr)
  require(rlang)

  var <- sym(var)
  val <- sym(paste(var, "pvalue" , sep="_"))
  out <- sym(paste(var, "marker" , sep="_"))

  mutate(df, !!out := if_else(!!val < threshold, 
                              paste0(!!var, marker),
                              as.character(!!var)
                              )
         ) 
}

如果我们只想对一列执行此操作，则可以使用以下方法：

df %>% 
  assign_stars(., "stub", 0.01, "***")

# # A tibble: 4 x 5
#    stub stub_pvalue  stub_marker
#    <dbl>      <dbl>  <chr>      
# 1     1        0     1***       
# 2     2        0.04  2          
# 3     3        0.07  3          
# 4     4        0.2   4

但是如果我们要向这个函数传递多列，我们需要使用purrr：

#sample data with multiple sets of columns:
df <- tibble(stub = c(1,2,3,4),
             stub_pvalue = c(.00, .04, .07,.2),
             sho = c(8,7,6,5),
             sho_pvalue = c(.005, .03, .00,.24))

library(purrr)  

pmap_dfc(list(c("stub", "sho")), ~ assign_stars(df, ..1, 0.01, "***")) %>% 
  select(!! names(df), ends_with("marker"))

#> # A tibble: 4 x 6
#>    stub stub_pvalue   sho sho_pvalue stub_marker sho_marker
#>   <dbl>       <dbl> <dbl>      <dbl> <chr>       <chr>     
#> 1     1        0        8      0.005 1***        8***      
#> 2     2        0.04     7      0.03  2           7         
#> 3     3        0.07     6      0     3           6***      
#> 4     4        0.2      5      0.24  4           5

我们还可以为每一列使用不同的threshold 和marker：

library(purrr)  

pmap_dfc(list(c("stub", "sho"), c(0.01, 0.04), c("*", "**")), 
         ~ assign_stars(df, ..1, ..2, ..3)) %>% 
   select(!! names(df), ends_with("marker"))

#> # A tibble: 4 x 6
#>    stub stub_pvalue   sho sho_pvalue stub_marker sho_marker
#>   <dbl>       <dbl> <dbl>      <dbl> <chr>       <chr>     
#> 1     1        0        8      0.005 1*          8**       
#> 2     2        0.04     7      0.03  2           7**       
#> 3     3        0.07     6      0     3           6**       
#> 4     4        0.2      5      0.24  4           5

【讨论】：

【解决方案4】：

这是一个非 tidyverse 解决方案，但应该可以在不指定任何列的情况下工作。我正在使用来自another answer 的M-- 的数据。

threshold = 0.05
nms = names(df)[grepl("pvalue", names(df))]
cbind(df, data.frame(lapply(nms, function(nm){
    prefix = strsplit(nm, "_")[[1]][1]
    setNames(data.frame(ifelse(df[[nm]] < threshold,
                               paste0(df[[prefix]], "***"),
                               df[[prefix]]),
                        stringsAsFactors = FALSE),
             paste0(prefix, "_marker"))
})))
#  stub stub_pvalue sho sho_pvalue stub_marker sho_marker
#1    1        0.00   8      0.005        1***       8***
#2    2        0.04   7      0.030        2***       7***
#3    3        0.07   6      0.000           3       6***
#4    4        0.20   5      0.240           4          5

【讨论】：