Using eventReactive to display filtered row of data

Question

I'm creating a simple shiny app that produces Trival Pursuit questions that pair with the board game version.

I have code that collects questions, and starts an app that randomly selects 6 categories. When you click 'start game' it opens a new tab with actionButtons for each category. The idea is when you click an actionButton it randomly samples 1 row from the dataframe that matches that category, and displays the row.

I've written a block wrapped in eventReactive that should respond to the 1st category button, however when I click it it doesn't display the row of data. No errors are produced, so not sure why nothing displays when you click the 1st category actionButton

library(shiny)
library(DT)
library(dplyr)

csv_questions <- structure(list(question = c("Q 4105", "Q 5360", "Q 3948", "Q 32347", 
"Q 98", "Q 32668", "Q 596", "Q 43370", "Q 35001", "Q 33899", 
"Q 35529", "Q 11902", "Q 35598", "Q 42518", "Q 20935", "Q 44847", 
"Q 39341", "Q 1419", "Q 25431", "Q 33351", "Q 45095", "Q 21851", 
"Q 4798", "Q 10213", "Q 8069", "Q 31661", "Q 8536", "Q 33027", 
"Q 6584", "Q 25062", "Q 21855", "Q 18518", "Q 30481", "Q 28354", 
"Q 31308", "Q 48175", "Q 6835", "Q 42680", "Q 14729", "Q 34827", 
"Q 28698", "Q 43018", "Q 31076", "Q 14388", "Q 32963", "Q 1770", 
"Q 5172", "Q 13483", "Q 26718", "Q 49467"), category = c("celebrities", 
"for-kids", "celebrities", "rated", "animals", "rated", "animals", 
"television", "science-technology", "science-technology", "science-technology", 
"hobbies", "science-technology", "television", "music", "world", 
"television", "brain-teasers", "newest", "religion-faith", "world", 
"music", "entertainment", "history", "general", "rated", "general", 
"rated", "general", "music", "music", "movies", "people", "people", 
"rated", "world", "general", "television", "literature", "science-technology", 
"people", "television", "rated", "literature", "rated", "celebrities", 
"for-kids", "humanities", "newest", "world"), answer = c("answer", 
"answer", "answer", "answer", "answer", "answer", "answer", "answer", 
"answer", "answer", "answer", "answer", "answer", "answer", "answer", 
"answer", "answer", "answer", "answer", "answer", "answer", "answer", 
"answer", "answer", "answer", "answer", "answer", "answer", "answer", 
"answer", "answer", "answer", "answer", "answer", "answer", "answer", 
"answer", "answer", "answer", "answer", "answer", "answer", "answer", 
"answer", "answer", "answer", "answer", "answer", "answer", "answer"
)), row.names = c(NA, -50L), class = "data.frame")

create_random_choices <- function(){
  qs <- get_questions()
  cats <- unique(qs$category)
  choices <- sample(cats, 6, replace = FALSE)
  return(choices)
}

# Define UI
ui <- navbarPage(title = "Trivial Pursuit", id = "navpage",
                 tabPanel("Setup",
                          sidebarLayout(
                            sidebarPanel(
                              checkboxGroupInput(
                                "selectedCategories",
                                "Select Categories",
                                choices = unique(csv_questions$category),
                                selected = create_random_choices()
                              )
                            ),
                            
                            mainPanel(
                              actionButton("startGame", "Start Game")
                            )
                          )
                 ),
                 tabPanel("Game",
                          mainPanel(
                            fluidRow(
                              column(4,
                                     uiOutput("cat1")),
                              column(4,
                                     uiOutput("cat2"), offset = 4)
                            ),
                            fluidRow(
                              DTOutput("cat1Data")
                            )
                          ))
)

# Define server logic
server <- function(input, output, session) {
  
  filter_questions <- reactive({
    csv_questions %>%
      dplyr::filter(category %in% input$selectedCategories)
  })

  
  observeEvent(input$startGame, {
    updateTabsetPanel(session, "navpage", "Game")
  })
  
  
  # Game Server Logic
  randomized_categories <- reactive({
    sample(input$selectedCategories)
  })
  output$cat1 <- renderUI({
    actionButton("cat1Button",
                 label = randomized_categories()[1],
                 style = "background-color: blue;")
  })
  output$cat2 <- renderUI({
    actionButton("cat2Button",
                 label = randomized_categories()[2],
                 style = "background-color: green;")
  })
  
  
  eventReactive("cat1", {
    output$cat1Data <- renderDT({filter_questions() %>%
        filter(category == randomized_categories()[1]) %>%
        dplyr::sample_n(1) %>%
        as.data.frame()})
  })
  
}

# Run the application
shinyApp(ui = ui, server = server)

Answer 1

Change eventReactive to observeEvent and use actionButton IDs. Then it should work. See below:

# Define UI
ui <- navbarPage(title = "Trivial Pursuit", id = "navpage",
                 tabPanel("Setup",
                          sidebarLayout(
                            sidebarPanel(
                              checkboxGroupInput(
                                "selectedCategories",
                                "Select Categories",
                                choices = unique(csv_questions$category),
                                selected = create_random_choices()
                              )
                            ),
                            
                            mainPanel(
                              actionButton("startGame", "Start Game")
                            )
                          )
                 ),
                 tabPanel("Game",
                          mainPanel(
                            fluidRow(
                              column(4,
                                     uiOutput("cat1")),
                              column(4,
                                     uiOutput("cat2"), offset = 4)
                            ),
                            fluidRow(
                              DTOutput("tb1"),
                              DTOutput("cat1Data"),
                              DTOutput("cat2Data")
                            )
                          ))
)

# Define server logic
server <- function(input, output, session) {
  
  filter_questions <- reactive({
    csv_questions %>%
      dplyr::filter(category %in% input$selectedCategories)
  })
  
  
  observeEvent(input$startGame, {
    updateTabsetPanel(session, "navpage", "Game")
  })
  
  
  # Game Server Logic
  randomized_categories <- reactive({
    sample(input$selectedCategories)
  })
  
  output$tb1 <- renderDT({
    filter_questions() %>%
      filter(category == randomized_categories()[1]) %>%
      #dplyr::sample_n(1) %>%
      as.data.frame()
    })
  
  output$cat1 <- renderUI({
    actionButton("cat1Button",
                 label = randomized_categories()[1],
                 style = "background-color: cyan;")
  })
  output$cat2 <- renderUI({
    actionButton("cat2Button",
                 label = randomized_categories()[2],
                 style = "background-color: yellow;")
  })
  
  
  observeEvent(input$cat1Button, {
    output$cat1Data <- renderDT({filter_questions() %>%
        dplyr::filter(category == randomized_categories()[1]) %>%
        dplyr::sample_n(1) %>%
        as.data.frame()})
  })
  
  observeEvent(input$cat2Button, {
    output$cat2Data <- renderDT({filter_questions() %>%
        dplyr::filter(category == randomized_categories()[2]) %>%
        dplyr::sample_n(1) %>%
        as.data.frame()})
  })
}

# Run the application
shinyApp(ui = ui, server = server)