r - 生成引用现有变量的动态变量

Question

我正在尝试生成具有重要性星星的相关矩阵。采用以下数据框:

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

我想编写一个函数，如果stub_pvalue小于0.01，则粘贴与“***”连接的任何列(例如本例中的 stub )，否则简单地粘贴 stub 。像这样的东西:

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"进行评估。有人可以帮忙吗？

Answer 1

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

我们还可以为每列使用不同的阈值和标记:

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