observeEvent Shiny function used in a module does

问题:

I'm developing an app in which I use modules to display different tab's ui content. However it seems like the module does not communicate with the main (or parent) app. It displays the proper ui but is not able to execute the observeEvent function when an actionButton is clicked, it should update the current tab and display the second one.

In my code I have created a namespace function and wrapped the actionButton's id in ns(), however it still does not work. Does anyone knows what's wrong?

library(shiny)

moduleUI <- function(id){

  ns <- NS(id)
      sidebarPanel(

        actionButton(ns("action1"), label = "click")
      )
}

module <- function(input, output, session){


  observeEvent(input$action1, {
    updateTabItems(session, "tabsPanel", "two")
  })
}

ui <- fluidPage(

            navlistPanel(id = "tabsPanel",

                         tabPanel("one",moduleUI("first")),
                         tabPanel("two",moduleUI("second"))
))
server <- function(input, output, session){
  callModule(module,"first")
  callModule(module,"second")

}

shinyApp(ui = ui, server = server)

回答1:

The observeEvent works, but since modules only see and know the variables given to them as input parameters, it does not know the tabsetPanel specified and thus cannot update it. This problem can be solved using a reactive Value, which is passed as parameter and which is changed inside the module. Once it's changed, it is known to the main app and can update the tabsetPanel:

library(shiny)
library(shinydashboard)

moduleUI <- function(id){

  ns <- NS(id)
  sidebarPanel(
    actionButton(ns("action1"), label = "click")
  )
}

module <- function(input, output, session, tabsPanel, openTab){

  observeEvent(input$action1, {
    if(tabsPanel() == "one"){  # input$tabsPanel == "one"
      openTab("two")
    }else{                     # input$tabsPanel == "two"
      openTab("one")
    }
  })

  return(openTab)
}

ui <- fluidPage(
  h2("Currently open Tab:"),
  verbatimTextOutput("opentab"),
  navlistPanel(id = "tabsPanel",
               tabPanel("one", moduleUI("first")),
               tabPanel("two", moduleUI("second"))
  ))


server <- function(input, output, session){
  openTab <- reactiveVal()
  observe({ openTab(input$tabsPanel) }) # always write the currently open tab into openTab()

  # print the currently open tab
  output$opentab <- renderPrint({
    openTab()
  })

  openTab <- callModule(module,"first", reactive({ input$tabsPanel }), openTab)
  openTab <- callModule(module,"second", reactive({ input$tabsPanel }), openTab)

  observeEvent(openTab(), {
    updateTabItems(session, "tabsPanel", openTab())
  })
}

shinyApp(ui = ui, server = server)