observeEvent Shiny Funktion in einem Modul verwendet nicht

Question

funktioniert

Ich entwickle eine app, in dem ich Module verwenden unterschiedliche Registerkarte ui Inhalte angezeigt werden soll. Es scheint jedoch, dass das Modul nicht mit der Hauptanwendung (oder der übergeordneten App) kommuniziert. Es zeigt das richtige ui aber ist nicht in der Lage, die observeEvent Funktion auszuführen, wenn ein actionButton geklickt wird, sollte es die aktuelle Registerkarte aktualisieren und die zweite anzeigen.

In meinem Code habe ich eine Namespace-Funktion erstellt und die ID actionButton in ns() verpackt, aber es funktioniert immer noch nicht. Weiß jemand, was los ist?

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) 

Answer 1

Die observeEvent funktioniert, aber da Module nur die Variablen, um sie als Eingangsparameter gegeben sehen und wissen, es kennt nicht die tabsetPanel angegeben und somit nicht aktualisieren kann. Dieses Problem kann mit einem reaktiven Wert gelöst werden, der als Parameter übergeben wird und innerhalb des Moduls geändert wird. Sobald es sich verändert hat, ist es weiß, in die Hauptanwendung und die tabsetPanel aktualisieren können:

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)