Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

observeEvent Shiny function used in a module does not work

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)
like image 784
MaxPlank Avatar asked Jul 18 '17 14:07

MaxPlank


1 Answers

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)

enter image description here

like image 88
shosaco Avatar answered Nov 12 '22 12:11

shosaco