如何使 Shiny 的 input$var 可用于 dplyr::summarise()

Posted 2023-03-24

【中文标题】如何使 Shiny 的 input$var 可用于 dplyr::summarise()

【英文标题】：How to make Shiny's input$var consumable for dplyr::summarise()

【发布时间】：2021-09-30 22:26:25

【问题描述】：

我有以下Rmarkdown Shiny：

---
title: "My Title"
runtime: shiny
output: 
  flexdashboard::flex_dashboard:
    vertical_layout: scroll
    theme:  bootstrap
    orientation: rows
---

```r setup, include=FALSE
library(flexdashboard)
```

Rows data-height=700
-----------------------------------------------------------------------

### Mate-pair Mapping Distribution

```r mate_pair_distribution, echo=FALSE
library(ggplot2)
library(tidyverse)
sidebarPanel(
  selectInput("col_id", label = "Features",
              choices = c("carat", "depth","price"), selected = "price"),
  selectInput("op_id", label = "Quality:",
              choices = c("All", "Ideal","Premium","Good","Very Good"), selected = "Good"),

  sliderInput("n_breaks", label = "Number of bins:",
               min = 20, max = 50, value = 30, step = 1)
)


#renderText(input$op_id)

mainPanel(
  renderPlot(
    # Prepare for the data
    dat  <- diamonds %>% filter(cut == input$op_id)
    if(input$op_id == "All") 
      dat <- diamonds
    

    # Plotting 
    ggplot(dat, aes(dat %>% select(.,contains(input$col_id)))) +
    ggtitle(input$op_id, subtitle = input$col_id) +
    geom_histogram(bins = input$n_breaks) +
    scale_x_continuous() +
    xlab(input$col_id) +
    theme_light()

  , height=400, width=400),
  br(),
  br(),
  renderPrint(
    dat  <- diamonds %>% filter(cut == input$op_id)
    if(input$op_id == "All") 
      dat <- diamonds
    

   dat %>% 
      select(.,contains(input$col_id)) %>%
      summarise(mean = mean(input$col_id), sd=sd(input$col_id), n=n())
  )
)

```

产生这个输出

如您所见，renderText() 在mean 和sd 值中显示NA。 是这条线造成的

 dat %>% 
          select(.,contains(input$col_id)) %>%
          summarise(mean = mean(input$col_id), sd=sd(input$col_id), n=n())

那么我怎样才能使input$col_id 成为summarise() 的消耗品？ 正确的做法是什么？

---

Non-Shiny 上下文结果是：

> diamonds %>% filter(cut=="Good") %>% select(price)  %>% summarise(mean = mean(price), sd=sd(price), n=n())
# A tibble: 1 × 3
      mean      sd     n
     <dbl>   <dbl> <int>
1 3928.864 3681.59  4906

【问题讨论】：

您是否尝试过使用summarise_ 函数而不是summarise 来让它接受文本字符串输入？

@NickCriswell：试过了，也遇到了同样的问题。

试试dat %>% select(one_of(input$col_id)) %>% summarise_(mean = lazyeval::interp(~mean(x), x = as.name(input$col_id)))

【参考方案1】：

使用dplyr (v0.5.0.9002) 的开发版本，您可以使用rlang::sym() 将字符串转换为符号，然后使用取消引用运算符（!! 或@987654327 @) 来引用 dplyr 动词中的变量。

library(dplyr)

var1 <- "Good" # replace with input$op_id
var2 <- rlang::sym("price") # replace with input$col_id

diamonds %>%
  filter(cut == var1) %>%
  select_at(vars(!!var2)) %>%
  summarise_at(vars(!!var2), funs(mean, sd, n()))

这给出了：

## A tibble: 1 × 3
#      mean      sd     n
#     <dbl>   <dbl> <int>
#1 3928.864 3681.59  4906

---

如果您有多个变量，请将rlang::syms() 与取消引用拼接运算符（!!! 或UQS）一起使用。例如：

var1 <- "Good" 
var2 <- rlang::syms(c("price", "depth")) 

diamonds %>%
  filter(cut == var1) %>%
  select_at(vars(UQS(var2))) %>%
  summarise_at(vars(UQS(var2)), funs(mean, sd, n()))

这给出了：

## A tibble: 1 × 6
#  price_mean depth_mean price_sd depth_sd price_n depth_n
#       <dbl>      <dbl>    <dbl>    <dbl>   <int>   <int>
#1   3928.864   62.36588  3681.59 2.169374    4906    4906

---

有关更多信息，请查看Programming with dplyr 小插图的quasiquotation section

【讨论】：

谢谢vars(!!var2) 是什么意思，我在哪里可以找到相关的文档/解释？

看看Programming with dplyr 小插图：

最后，为什么var2 <- rlang::sym("price") 而不仅仅是var2 <- "price"

只需将字符串转换为符号。或者，您可以使用as.name()。来自文档：“名称”（也称为“符号”）是一种通过名称（而不是绑定到该名称的对象的值，如果有的话）引用 R 对象的方法。我>