How to get a subset of data using an input that's dependent on another input in shiny?

Question

I tried to add a filter to my data analysis. The filter (inputF2) is an item in a category (xInput) chosen by the user.

then I want filter out the data to do summarize analysis and plot out the mean. However, once I wrote the if statement, the program won't run.

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)

This is the error message I got:

Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

Answer 1

The reason you were getting the active reactive content error was because of this chunk

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

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

    })
  } else{ iris_sub = iris}

Here you are evaluating input$inputF2 but that can change with user selection, so the test needs to be inside a reactive().

Another good practice is to wrap variables like inputF2 in req, to ensure they will have a value before being evaluated. This is because you are rendering the widget for filter on the server side, and initially it will not have a value.

Note also, that the filtering condition filter(input$xInput == input$inputF2) would fail, because filter expects an unquoted variable name in the left hand side of that expression (but input$xInput is a character). You can convert input$xInput to a name with as.name() and then use bang-bang inside filter to evaluate it: filter(!!as.name(input$xInput) == input$inputF2)

After this changes, the filtering chunk becomes:

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)
  })

Finally, it seems like your app allowed the user to choose the same variable as measuring element and as the grouper. Not sure this is a good idea, as it might throw errors because you can't modify a grouping variable. One way to control this is to use validate inside the reactive that does the summarising and produce a meaningful error message for the user:

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

Here is the whole app with these modifications.

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)