如何使用依赖于闪亮中另一个输入的输入来获取数据子集？

Question

我尝试在我的数据分析中添加过滤器。过滤器 (inputF2) 是用户选择的类别 (xInput) 中的一个项目。

然后我想过滤掉数据以进行汇总分析并绘制平均值。但是，一旦我编写了 if 语句，程序就无法运行。

library(datasets)
library(shiny)
library(dplyr)
library(ggplot2)
library(DT)
library(crosstalk)

data("iris")

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Analyze Iris table"),

  # Sidebar with a dropdown menu selection input for key measurecomponent
  sidebarLayout(
    sidebarPanel(
      selectInput("yInput", "Measuring element: ", 
                  colnames(iris), selected = colnames(iris)[2]), 
      selectInput('xInput', 'Grouper: ', 
                  colnames(iris), selected = colnames(iris)[5])
    ),

    # Show a plot of the generated distribution
    mainPanel(
      uiOutput('filter'),
      plotOutput("barPlot"),
      DTOutput('table1')
      )))
server <- function(input, output) {

  output$filter = renderUI({

    selectInput('inputF2', 'Filter Item: ', 
                c('Null', unique(iris %>% select(input$xInput))))
  })

  if(input$inputF2 != 'Null') {
    iris_sub = reactive({

      iris %>% filter_at(input$xInput == input$inputF2)

    })
  } else{ iris_sub = iris}

  by_xInput <- reactive({

    iris_sub %>% 
      group_by_at(input$xInput) %>% 
      summarize(n = n(), mean_y = mean(!! rlang::sym(input$yInput)))

  })

  output$barPlot <- renderPlot({

    # as the input is a string, use `aes_string`
    ggplot(data = by_xInput(), aes_string(x = input$xInput, y = "mean_y")) + 
      geom_bar(stat = 'identity')

  })

  output$table1 = renderDT(
    datatable(by_xInput())
    )
}

shinyApp(ui = ui, server = server)

这是我收到的错误消息：

.getReactiveEnvironment()$currentContext() 中的错误： 如果没有活动的反应上下文，则不允许操作。 （你试图做一些只能在反应式表达式或观察者内部完成的事情。）

Answer 1

您收到active reactive content 错误的原因是因为这个块

if(input$inputF2 != 'Null') {
    iris_sub = reactive({

      iris %>% filter_at(input$xInput == input$inputF2)

    })
  } else{ iris_sub = iris}

在这里，您正在评估 input$inputF2，但这可能会随着用户选择而改变，因此测试需要在 reactive() 内。

另一个好的做法是将inputF2 之类的变量包装在req 中，以确保它们在被评估之前具有值。这是因为您在服务器端呈现过滤器的小部件，并且最初它不会有值。

还要注意，过滤条件filter(input$xInput == input$inputF2) 会失败，因为filter 期望在该表达式的左侧有一个unquoted 变量名（但input$xInput 是一个character）。您可以使用as.name() 将input$xInput 转换为name，然后在filter 中使用bang-bang 对其进行评估：filter(!!as.name(input$xInput) == input$inputF2)

这个变化后，过滤块变成：

iris_sub <- reactive({
    x_in <- as.name(input$xInput)
    if (req(input$inputF2) != 'Null') {
      iris_sub <- iris %>% filter(!!x_in == input$inputF2)
    } else{
      iris_sub <- iris
    }
    return(iris_sub)
  })

最后，您的应用似乎允许用户选择与measuring element 相同的变量和 作为grouper。不确定这是一个好主意，因为它可能会抛出错误，因为您无法修改分组变量。控制这种情况的一种方法是在reactive 中使用validate，它会进行汇总并为用户生成有意义的错误消息：

validate(
      need(expr = input$xInput != input$yInput,
           message = "Can't summarise by group when 'grouper' is the same as 'measuring element'"))

这是经过这些修改的整个应用程序。

library(datasets)
library(shiny)
library(dplyr)
library(ggplot2)
library(DT)
library(crosstalk)

data("iris")

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Analyze Iris table"),

  # Sidebar with a dropdown menu selection input for key measurecomponent
  sidebarLayout(
    sidebarPanel(
      selectInput("yInput", "Measuring element: ", 
                  colnames(iris), selected = colnames(iris)[2]), 
      selectInput('xInput', 'Grouper: ', 
                  colnames(iris), selected = colnames(iris)[5])
    ),

    # Show a plot of the generated distribution
    mainPanel(
      uiOutput('filter'),
      plotOutput("barPlot"),
      DTOutput('table1')
    )))

server <- function(input, output) {

  output$filter = renderUI({
    selectInput('inputF2',
                'Filter Item: ',
                c('Null', iris %>% select(input$xInput) %>% unique()))
  })

  iris_sub <- reactive({
    x_in <- as.name(input$xInput)
    if (req(input$inputF2) != 'Null') {
      iris_sub <- iris %>% filter(!!x_in == input$inputF2)
    } else{
      iris_sub <- iris
    }
    return(iris_sub)
  })

  by_xInput <- reactive({
    validate(
      need(expr = input$xInput != input$yInput,
           message = "Can't summarise by group when 'grouper' is the same as 'measuring element'"))

    iris_sub() %>%
      group_by_at(input$xInput) %>%
      add_tally() %>%
      summarize_at(.vars = vars(input$yInput),
                   .funs = list("mean_y" = mean))

  })

  output$barPlot <- renderPlot({

    # as the input is a string, use `aes_string`
    ggplot(data = by_xInput(), aes_string(x = input$xInput, y = "mean_y")) + 
      geom_bar(stat = 'identity')

  })

  output$table1 = renderDT(
    datatable(by_xInput())
  )
}

shinyApp(ui = ui, server = server)