observe(), observeEvent(), and updateSelectizeInput()

[mjfrigaard]

columnSelectApp (reprex)

Hi everyone! Thank you in advance for any help you can provide for this error I am getting. I've built the following shiny application using modules (colselUI, colselServer, and columnSelectApp).

# packages ------------------------------------------
library(shiny)
library(tidyverse)
library(reactable)
library(fivethirtyeight)


# ds538 ----------------------------------------------
ds538 <- list(
  "airline_safety" = fivethirtyeight::airline_safety,
  "antiquities_act" = fivethirtyeight::antiquities_act,
  "august_senate_polls" = fivethirtyeight::august_senate_polls,
  "cabinet_turnover" = fivethirtyeight::cabinet_turnover
)

# title538 ----------------------------------------------
title538 <- data.frame(
  dataset = c(
    "airline_safety",
    "antiquities_act", 
    "august_senate_polls", 
    "cabinet_turnover"
  ),
  title = c(
    "Should Travelers Avoid Flying Airlines That Have Had Crashes in the Past?",
    "Trump Might Be The First President To Scrap A National Monument",
    "How Much Trouble Is Ted Cruz Really In?",
    "Two Years In, Turnover In Trump’s Cabinet Is Still Historically High"
  )
)


# colselUI -------------------------------------
colselUI <- function(id, filter = NULL) {
  tagList(
    sidebarLayout(
      sidebarPanel(
        # dataset
        selectInput(
          inputId = NS(namespace = id, id = "dataset"),
          label = strong("Dataset (", code('input$dataset'), ")"),
          choices = names(ds538)
        ),
        # columns
        selectizeInput(
          inputId = NS(namespace = id, id = "cols"),
          label = strong("Column (", code('input$cols'), ")"),
          choices = names(ds538[[1]]),
          selected = NULL,
          multiple = TRUE
        )
      ),
      mainPanel(
        htmlOutput(outputId = 
                NS(namespace = id, id = "label")),
        # data_display
        reactableOutput(
          outputId =
            NS(namespace = id, id = "data_display")
        ),
        # some space
        br(), br(),
        # values
        tags$strong("module ", tags$code("reactiveValues:")),
        verbatimTextOutput(
          outputId =
            NS(namespace = id, id = "values")
        )
      )
    )
  )
}


# colselServer ---------------------------------
colselServer <- function(id) {
  moduleServer(id = id, module = function(input, output, session) {

    # data ----------------------------------
    data <- reactive({
      validate(
        need(input$dataset, "please select a dataset"),
        need(input$cols, "please select a column")
      )
      col_data <- select(.data = ds538[[input$dataset]], any_of(input$cols))
      return(col_data)
    })


    # label ----------------------------------
    output$label <- renderUI({
        data_label <- dplyr::filter(.data = title538, 
                        dataset %in% input$dataset) %>% 
                      select(.data = ., title) %>% 
                      purrr::as_vector(.x = .) %>% 
                      base::unname(obj = .)
        return(h3(data_label))
    })

    # column drop-down options  ----------------
    observeEvent(eventExpr = input$dataset, {
      dataset538 <- input$dataset
      if (is.null(dataset538)) {
        dataset538 <- character(0)
      } else {
      ds538_names <- names(ds538[[dataset538]])
      updateSelectizeInput(
        session = session, inputId = "cols",
        choices = ds538_names, selected = ds538_names
      )
      }
    })

    # observeEvent (reactable table) -------------------------
    observeEvent(eventExpr = input$dataset, handlerExpr = {
    # data display -------------------------
    output$data_display <- reactable::renderReactable({
      req(input$dataset)
      req(input$cols)
      reactable::reactable(
        data = data(),
        # reactable settings ------
        defaultPageSize = 10,
        resizable = TRUE,
        highlight = TRUE,
        wrap = FALSE,
        bordered = TRUE,
        searchable = TRUE,
        filterable = TRUE
      )
      })
    })

    # reactive values -------------------------
    output$values <- shiny::renderPrint({
      all_values <- reactiveValuesToList(
        x = input,
        all.names = TRUE
      )
      values <- all_values[str_detect(names(all_values), "reactable", TRUE)]
      print(values)
    })
  })
}


# columnSelectApp ------------------------------
columnSelectApp <- function() {
  ui <- fluidPage(
    h3("columnSelectApp"),
    colselUI(id = "columns"),
  )

  server <- function(input, output, session) {
    colselServer(id = "columns")
  }

  shinyApp(ui, server)
}

columnSelectApp()

However, when I run the application, I get the following error:

Warning: Error in reactable::reactable: `data` must have at least one column
  99: stop
  98: reactable::reactable
  97: ::
htmlwidgets
shinyRenderWidget [shinymods/reprex/columnSelectApp/app.R#129]
  96: func
  83: renderFunc
  82: output$columns-data_display
   1: runApp

The app works (deployed here in showcase mode), but I can't seem to get rid of the error. I've included an observeEvent({}) for the selectizeInput()/updateSelectizeInput({})), and req(input$dataset) and req(input$cols), but I am still seeing the error.

Thank you again for any help you can provide!

Cheers,

../Martin

[agus]

Hi!

First, nice reprex!
I think I found the issue: it's the reactivity graph. In the code you shared when you change input$dataset this triggers data, input$cols and data_display updating at the "same time", which generates some "spurious" invalidation and triggering of the reactable.

Give it a try with this version of your module server:

# colselServer ---------------------------------
colselServer <- function(id) {
  moduleServer(id = id, module = function(input, output, session) {
    
    # data ----------------------------------
    data <- eventReactive(input$cols ,{
      validate(
        need(input$dataset, "please select a dataset"),
        need(input$cols, "please select a column")
      )
      col_data <- select(.data = ds538[[input$dataset]], any_of(input$cols))
      return(col_data)
    })
    
    
    # label ----------------------------------
    output$label <- renderUI({
      data_label <- dplyr::filter(.data = title538, 
                                  dataset %in% input$dataset) %>% 
        select(.data = ., title) %>% 
        purrr::as_vector(.x = .) %>% 
        base::unname(obj = .)
      return(h3(data_label))
    })
    
    # column drop-down options  ----------------
    observeEvent(eventExpr = input$dataset, {
      dataset538 <- input$dataset
      if (is.null(dataset538)) {
        dataset538 <- character(0)
      } else {
        ds538_names <- names(ds538[[dataset538]])
        updateSelectizeInput(
          session = session, inputId = "cols",
          choices = ds538_names, selected = ds538_names
        )
      }
    })
    
    # observeEvent (reactable table) -------------------------
    observeEvent(eventExpr = data(), handlerExpr = {
      # data display -------------------------
      output$data_display <- reactable::renderReactable({
        reactable::reactable(
          data = data(),
          # reactable settings ------
          defaultPageSize = 10,
          resizable = TRUE,
          highlight = TRUE,
          wrap = FALSE,
          bordered = TRUE,
          searchable = TRUE,
          filterable = TRUE
        )
      })
    })
    
    # reactive values -------------------------
    output$values <- shiny::renderPrint({
      all_values <- reactiveValuesToList(
        x = input,
        all.names = TRUE
      )
      values <- all_values[str_detect(names(all_values), "reactable", TRUE)]
      print(values)
    })
  })
}

HTH!

---

This post was published by an Appsilon team member. Our company can help you get the most out of RShiny and Posit/RStudio products.

Check our open positions here.

Appsilon: Building impactful RShiny Dashboards and providing R coding services.

[mjfrigaard]

Thank you--I'll definitely remember eventReactive() now!

Here is the updated/deployed app (in case you wanted to see it in action )

Cheers,

../Martin