R语言 在函数中提取列属性

6yjfywim  于 2023-09-27  发布在  其他
关注(0)|答案(2)|浏览(127)

假设我有下面的tibble:

df1 <- structure(list(var1 = structure(c("Didn't do a thing", "Almost did a thing", 
"Once did a thing", "Have never done a thing", "Always do a thing"
), description = "This is the question i asked respondents (and the title of the plot)"), 
    wtd_pct = c(4L, 15L, 62L, 11L, 8L)), row.names = c(NA, -5L
), class = c("tbl_df", "tbl", "data.frame"))

我想做一个plot函数,它接受tibble的名称(df1)和其中一列的名称作为输入(在本例中,只有var1,但在我的实际tibble中,我有更多的列)。
在plot函数中,我想取出与var1连接的属性,并将其作为plot title。例如,在一个函数之外,它看起来像这样:

df1 %>% 
  ggplot(aes(y = var1, x = wtd_pct)) +
  geom_col(aes(fill = var1)) +
  geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), size = 3.5, vjust = -.5, hjust = -.3, color = 'black') +
  theme_minimal() + theme(legend.position = "none") +
  labs(y = "", 
       x = "Weighted percent", 
       title = paste0("\"", str_wrap(attr(df1$var1, "description"), 100), "\""))

注意上面的title行。然而,当我把它放在一个函数中并试图调用它时,我会得到各种各样的错误。例如

plot_function <- function(.x, .y){
.x %>% 
  ggplot(aes(y = {{.y}}, x = wtd_pct)) +
  geom_col(aes(fill = {{.y}})) +
  geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), size = 3.5, vjust = -.5, hjust = -.3, color = 'black') +
  theme_minimal() + theme(legend.position = "none") +
  labs(y = "", 
       x = "Weighted percent", 
       title = paste0("\"", str_wrap(attr({{.x$.y}}, "description"), 100), "\""))
}

plot_function(df1, var1)

这将返回图,但没有标题+错误Warning message: Unknown or uninitialised column: .y .。我已经尝试过各种其他方法( Package 在!!ensym().data[[]]中,首先将属性提取到一个单独的字符串中,等等),但我从未得到我想要的。
看起来问题的关键是你不能把df导入attr(),但是它也不喜欢.x$.y的语法。有人能给我指个路吗?

4si2a6ki

4si2a6ki1#

使用pull{{.x$.y}}替换为pull(.x, {{.y}}),如下面标记为##的行所示。还请注意,在发布到SO时,应提供所有library语句。

library(dplyr)
library(ggplot2)
library(stringr)

plot_function <- function(.x, .y) {
  .x %>% 
    ggplot(aes(y = {{.y}}, x = wtd_pct)) +
      geom_col(aes(fill = {{.y}})) +
      geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), size = 3.5, 
        vjust = -.5, hjust = -.3, color = 'black') +
      theme_minimal() + theme(legend.position = "none") +
      labs(y = "", 
        x = "Weighted percent", 
        title = paste0(
          "\"", 
          str_wrap(attr(pull(.x, {{.y}}), "description"), 100), ##
          "\"")
      ) 
}

plot_function(df1, var1)

或者我们可能想将title=部分重写为管道,并移动到sprintf,以使其更容易阅读。

plot_function <- function(.x, .y) {
  .x %>% 
    ggplot(aes(y = {{.y}}, x = wtd_pct)) +
      geom_col(aes(fill = {{.y}})) +
      geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), size = 3.5, 
        vjust = -.5, hjust = -.3, color = 'black') +
      theme_minimal() + theme(legend.position = "none") +
      labs(y = "", 
        x = "Weighted percent", 
        title = pull(.x, {{.y}}) %>%          ##
                  attr("description") %>%     ##
                  str_wrap(100) %>%           ##
                  sprintf('"%s"', .)          ##

      ) 
}

plot_function(df1, var1)

jecbmhm3

jecbmhm32#

$运算符使用非标准求值而不进行替换,因此.x$.y将被解释为“df1内部名为.y的列”,这当然是不存在的。
通常的解决方法是使用[[而不是$,但这里有点棘手,因为您希望传递一个不带引号的列名。
一种选择是使用.x[[deparse(substitute(.y))]](不使用curly-curly操作符)

plot_function <- function(.x, .y){
  .x %>% 
    ggplot(aes(y = {{.y}}, x = wtd_pct)) +
    geom_col(aes(fill = {{.y}})) +
    geom_text(aes(label = paste0(round(wtd_pct, 0), "%")), 
              size = 3.5, vjust = -.5, hjust = -.3, color = 'black') +
    theme_minimal() + theme(legend.position = "none") +
    labs(y = "", 
         x = "Weighted percent", 
         title = paste0("\"", str_wrap(attr(.x[[deparse(substitute(.y))]],
                                            "description"), 100), "\""))
}

plot_function(df1, var1)

一个纯粹的tidyverse等价物可能是使用类似于

rlang::eval_tidy(enquo(.y), data = .x)

代替.x[[deparse(substitute(.y))]]

相关问题