Max*_*ank 3 module r shiny shiny-server
我正在开发一个应用程序,其中我使用模块来显示不同选项卡的ui内容.但是,似乎该模块不与主(或父)应用程序通信.它显示正确的ui但是observeEvent
在actionButton
单击时无法执行该功能,它应该更新当前选项卡并显示第二个选项卡.
在我的代码中,我创建了一个命名空间函数并将其包含actionButton
在内ns()
,但它仍然无效.有谁知道什么是错的?
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)
Run Code Online (Sandbox Code Playgroud)
observeEvent工作,但由于模块只能看到并知道作为输入参数赋予它们的变量,因此它不知道指定的tabsetPanel,因此无法更新它.可以使用反应值来解决此问题,该值作为参数传递并在模块内部更改.一旦它被更改,主应用程序就会知道它并且可以更新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)
Run Code Online (Sandbox Code Playgroud)