observeEvent with menuItem (in a module)

shiny
,
1

Hi everyone! Thank you in advance for taking the time to help me with this (it's greatly appreciated :smiley:)

I have an application I built using modules with shinydashboard. The input data is a list (two versions of the palmerpenguins data), and I want the selectInput() to update when the user clicks on the second menuItem().

EDIT: The packages and data:

# packages ----------------------------------------------------------------
library(shiny)
library(tidyverse)
library(shinydashboard)
library(reactable)
library(palmerpenguins)
library(janitor)


# raw_penguins -----
# clean this up a little for printing
raw_penguins <- penguins_raw %>%
  janitor::clean_names() %>%
  # rename this to 'ratio of stable isotopes' (_rsi)
  rename(
    delta_15_rsi = delta_15_n_o_oo,
    delta_13_rsi = delta_13_c_o_oo
  ) %>%
  mutate(
    sex = str_to_lower(sex),
    sex = factor(sex),
    species = factor(species),
    island = factor(island)
  )

# split data by species and island ----
penguins_raw_list <- split(x = raw_penguins, ~island)
penguins_list <- split(x = penguins, ~species)

# all_penguins_list -----
all_penguins_list <- list(
  "penguins_raw" = penguins_raw_list,
  "penguins" = penguins_list
)

Here is the UI module:

# penguin_module_UI -----
penguin_module_UI <- function(id) {
  tagList(
    shiny::selectInput(
      inputId = NS(namespace = id, id = "dataset"),
      label = "Dataset", choices = c("Adelie", "Chinstrap", "Gentoo"),
      selected = "Adelie"
    ),
      br(), br(),
    reactable::reactableOutput(NS(id, "penguin_table")),
      br(), br(),
    shiny::verbatimTextOutput(outputId = NS(namespace = id, id = "values"))
  )
}

And there is the server module:

# penguin_module_server ---------
penguin_module_server <- function(id, dataset) {

      moduleServer(id, function(input, output, session) {

        # sidebarMenu id ----
        observeEvent(eventExpr = input$sbmenu, handlerExpr = {

            updateSelectInput(inputId = input$dataset,
                choices = c("Torgersen", "Dream", "Biscoe"),
                selected = "Biscoe"
                )
        })

        table_data <- reactive({

          if (dataset == "penguins") {
            list_of_penguins <- all_penguins_list$penguins
            table_data <- as_tibble(
              list_of_penguins[[input$dataset]]
            )

          } else {

            list_of_penguins_raw <- all_penguins_list$penguins_raw
            table_data <- as_tibble(
              list_of_penguins_raw[[input$dataset]]
            )
          }

          return(table_data)
        })

    # penguin_table -----
    output$penguin_table <- reactable::renderReactable({
      req(input$dataset)
      reactable::reactable(
        data = table_data(),
        # reactable settings ------
        defaultPageSize = 10,
        resizable = TRUE,
        highlight = TRUE,
        height = 350,
        wrap = FALSE,
        bordered = TRUE,
        searchable = TRUE,
        filterable = TRUE
      )
    })

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

  })

}

I'm using the observeEvent() here, and the dataset argument is passed to the penguin_module_server() in the demo below:

# penguin_module_demo ----------
penguin_module_demo <- function() {
  # UI -----------------
  ui <- dashboardPage(
    dashboardHeader(title = "Penguin Modules"),
    dashboardSidebar(
        # sidebarMenu id ----
      sidebarMenu(id = "sbmenu",
        menuItem("Penguin (species)",
          tabName = "penguins",
          icon = icon("table")
        ),
        menuItem("Penguins Raw (island)",
          tabName = "penguins_raw",
          icon = icon("table")
        )
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          tabName = "penguins",
          fluidRow(
            box(
              title = "Penguins (species)",
              width = 12,
              penguin_module_UI("penguins_table")
            )
          )
        ),
        tabItem(
          tabName = "penguins_raw",
          fluidRow(
            box(
              title = "Penguins Raw (island)",
              width = 12,
              penguin_module_UI("penguins_raw_table")
            )
          )
        )
      )
    )
  )

  # server ---------
  server <- function(input, output) {
    # Penguins -----
    penguin_module_server("penguins_table", dataset = "penguins")
    # Penguins Raw ------
    penguin_module_server("penguins_raw_table", dataset = "penguins_raw")
  }

  # run -----
  shinyApp(ui = ui, server = server)
}

penguin_module_demo()

I think I know what the issue is (from the reactiveValuesToList() output I'm rendering):

  • the module's namespace only contains the inputId for the dataset, which I define in penguin_module_UI()
  • when the observeEvent() goes looking for the input$sbmenu, it doesn't see it because it's created outside the module.

If I'm right, is there a way to include the sidebarMenu(id) inside the UI (maybe inside the tagList())?

Thank you again so much in advance for helping me tackle this one (still learning modules :thinking:)

EDIT: I deployed the app with the error here

2

I attempted to run your code as a precursor to trying to assist you.
I overcame the first hurdle by intuiting the library dependencies you have. I believe these are:

library(shiny)
library(shinydashboard)
library(reactable)

and possibly

library(palmerpenguins)

I get an error :

Warning: Error in <reactive:table_data>: object 'all_penguins_list' not found
  [No stack trace available]

I checked the code and there does seem to be this named object that lacks a definition. perhaps you initialise it in another script and omitted it from this example by accident. could you review ?

3

Hi @nirgrahamuk ! Thank you for looking into this (and I apologize for the incomplete documentation :man_facepalming: --it was very late in the day when I wrote this reprex).

I've added the necessary code for packages and data.

Cheers,

../Martin

4

yeah, im still struggling to get your reprex to a point where it can demonstrate what your ask for support is...
Are you using a non standard split function ? the syntax you provided fails and does not generate an object
I adjusted to

penguins_raw_list <- split(x = raw_penguins, raw_penguins$island)
penguins_list <- split(x = penguins , raw_penguins$species)

to have something.

however, even before any clicks and considering updating selectInputs, there is still a data not found error viewable on the first tab.. Is this a part of your issue or a distraction ?

5

@nirgrahamuk Thank you for coming back to this! I am using base::split() and splitting on island and species. I've put the reprex in this RStudio.Cloud project so you can see everything I'm doing.

I get the Error: data must have at least one column on the 2nd tab (not the first).

6

I believe I fixed it for you
a) the module server can't access objects that aren't passed into it, so I passed in the sidebar input event you wanted
b) I think you had confusion on what it was you would update in the module ui

# packages ----------------------------------------------------------------
library(shiny)
library(tidyverse)
library(shinydashboard)
library(reactable)
library(palmerpenguins)
library(janitor)


# raw_penguins -----
# clean this up a little for printing
raw_penguins <- penguins_raw %>%
  janitor::clean_names() %>%
  # rename this to 'ratio of stable isotopes' (_rsi)
  rename(
    delta_15_rsi = delta_15_n_o_oo,
    delta_13_rsi = delta_13_c_o_oo
  ) %>%
  mutate(
    sex = str_to_lower(sex),
    sex = factor(sex),
    species = factor(species),
    island = factor(island)
  )

# split data by species and island ----
penguins_raw_list <- base::split(x = raw_penguins, ~island)
penguins_list <- base::split(x = penguins, ~species)

# all_penguins_list -----
all_penguins_list <- list(
  "penguins_raw" = penguins_raw_list,
  "penguins" = penguins_list
)

# penguin_module_UI -----
penguin_module_UI <- function(id) {
  tagList(
    shiny::selectInput(
      inputId = NS(namespace = id, id = "dataset"),
      label = "Dataset", choices = c("Adelie", "Chinstrap", "Gentoo"),
      selected = "Adelie"
    ),
    br(), br(),
    reactable::reactableOutput(NS(id, "penguin_table")),
    br(), br(),
    shiny::verbatimTextOutput(outputId = NS(namespace = id, id = "values"))
  )
}

# penguin_module_server ---------
penguin_module_server <- function(id, dataset,other_input = NULL) {
  
  moduleServer(id, function(input, output, session) {
    
    # sidebarMenu id ----
    if(isTruthy(other_input)){
      stopifnot(is.reactive(other_input))
    observeEvent(eventExpr =other_input(), handlerExpr = {
      updateSelectInput(inputId = "dataset",
                        choices = c("Torgersen", "Dream", "Biscoe"),
                        selected = "Biscoe"
      )
    })
    }
    table_data <- reactive({
      
      if (dataset == "penguins") {
        list_of_penguins <- all_penguins_list$penguins
        table_data <- as_tibble(
          list_of_penguins[[input$dataset]]
        )
        
      } else {
        
        list_of_penguins_raw <- all_penguins_list$penguins_raw
        table_data <- as_tibble(
          list_of_penguins_raw[[input$dataset]]
        )
      }
      
      return(table_data)
    })
    
    # penguin_table -----
    output$penguin_table <- reactable::renderReactable({
      req(input$dataset)
      reactable::reactable(
        data = table_data(),
        # reactable settings ------
        defaultPageSize = 10,
        resizable = TRUE,
        highlight = TRUE,
        height = 350,
        wrap = FALSE,
        bordered = TRUE,
        searchable = TRUE,
        filterable = TRUE
      )
    })
    
    # reactive values ----
    output$values <- shiny::renderPrint({
      req(input$dataset)
      all_values <- reactiveValuesToList(x = input,
                                         all.names = TRUE)
      values <- str_detect(names(all_values), "reactable", negate = TRUE)
      print(all_values[values])
    })
    
  })
  
}

# penguin_module_demo ----------
penguin_module_demo <- function() {
  # UI -----------------
  ui <- dashboardPage(
    dashboardHeader(title = "Penguin Modules"),
    dashboardSidebar(
      # sidebarMenu id ----
      sidebarMenu(id = "sbmenu",
                  menuItem("Penguin (species)",
                           tabName = "penguins",
                           icon = icon("table")
                  ),
                  menuItem("Penguins Raw (island)",
                           tabName = "penguins_raw",
                           icon = icon("table")
                  )
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          tabName = "penguins",
          fluidRow(
            box(
              title = "Penguins (species)",
              width = 12,
              penguin_module_UI("penguins_table")
            )
          )
        ),
        tabItem(
          tabName = "penguins_raw",
          fluidRow(
            box(
              title = "Penguins Raw (island)",
              width = 12,
              penguin_module_UI("penguins_raw_table")
            )
          )
        )
      )
    )
  )
  
  # server ---------
  server <- function(input, output) {
    # Penguins -----
    penguin_module_server("penguins_table", dataset = "penguins")
    # Penguins Raw ------
    penguin_module_server("penguins_raw_table", dataset = "penguins_raw",
                          other_input = reactive(input$sbmenu))
  }
  
  # run -----
  shinyApp(ui = ui, server = server)
}

penguin_module_demo()

p.s. the earlier confusion on this thread surrounding split was caused by the use of a new feature added in R4.1 where split can take a formula where in the past it could not.

7

Thank you so much for this solution! This question actually made me go back and re-write the post on communicating between modules (check it out if you'd like here).

And it took me a minute to figure out the new changes to split() function, too :slight_smile:

8

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.