Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
760 views
in Technique[技术] by (71.8m points)

r - 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)
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...