时间戳

首页 > 解决方案 > 如何在带有模块的 navbarPage 中获取选定的 Tab-ID

r - 如何在带有模块的 navbarPage 中获取选定的 Tab-ID

问题描述

我想创建一个navbarPage，其中每个tabPanel或tagList每个tabPanel都是在另一个模块中创建的。

在“正常”闪亮的应用程序中，我将能够知道当前使用input$navbarPage_ID. （分配的 id 变量在哪里navbarPage_IDnavbarPage）

使用模块我无法获得正确的 ID，因为它不会改变。
如何在服务器模块中获取所选选项卡的正确 ID？

示例 1，其中tabPanels在模块中创建： 

library(shiny)
## Module 1 ####################
mod1_ui <- function(id, label, navid) {
  ns <- NS(id)
  tabPanel(label, value = navid,
           h2("mod1")
  )
}
mod1_server <- function(input, output, session, navid) {
  observe({
    message("mod1_server ", navid)
  })
}
## Module 2 ####################
mod2_ui <- function(id, label, navid) {
  ns <- NS(id)
  tabPanel(label, value = navid,
           h2("mod2")
  )
}
mod2_server <- function(input, output, session, navid) {
  observe({
    message("mod2_server ", navid)
  })
}

## Shiny App #####################
ui <- navbarPage(collapsible  = T, id = "navbarid",
                 title = "Title",
                 mod1_ui("mod1", "Module 1 Tab", navid = 1),
                 mod2_ui("mod2", 'Module 2 Tab', navid = 2)
)

server <- function(input, output, session) {
  callModule(mod1_server, "mod1", input$navbarid)
  callModule(mod2_server, "mod2", input$navbarid)
}

shinyApp(ui, server)

示例 2，其中tabPanels在 UI 中创建并且仅tagList在模块中创建： 

library(shiny)
## Module 1 ####################
mod1_ui <- function(id, label, navid) {
  ns <- NS(id)
  tagList(h2("mod1"))
}
mod1_server <- function(input, output, session, navid) {
  observe({ 
    message("mod1_server ", navid)
    # message("mod1_server ", input$navbarid)
  })
}
## Module 2 ####################
mod2_ui <- function(id, label, navid) {
  ns <- NS(id)
  tagList(h2("mod2"))
}
mod2_server <- function(input, output, session, navid) {
  observe({
    message("mod2_server ", navid)
    # message("mod2_server ", input$navbarid)
  })
}

## Shiny App #####################
ui <- navbarPage(collapsible  = T, id = "navbarid",
                 title = "Title",
                 
                 tabPanel("Module 1 Tab", value = 1,
                          mod1_ui("mod1")
                 ),
                 tabPanel("Module 2 Tab", value = 2,
                          mod2_ui("mod2")
                 )
)

server <- function(input, output, session) {
  callModule(mod1_server, "mod1", input$navbarid)
  callModule(mod2_server, "mod2", input$navbarid)
}

shinyApp(ui, server)

标签： rshinyshinymodules

解决方案

您在服务器中调用mod1_server了两次；p

我将在父会话中使用这个技巧：

library(shiny)
## Module 1 ####################
mod1_ui <- function(id, label, navid) {
  ns <- NS(id)
  tabPanel(label, value = navid,
           h2("mod1")
  )
}
mod1_server <- function(input, output, session, parent_session) {
  observe({
    message("mod1_server ", parent_session$input$navbarid)
  })
}
## Module 2 ####################
mod2_ui <- function(id, label, navid) {
  ns <- NS(id)
  tabPanel(label, value = navid,
           h2("mod2")
  )
}
mod2_server <- function(input, output, session, parent_session) {
  observe({
    message("mod2_server ", parent_session$input$navbarid)
  })
}

## Shiny App #####################
ui <- navbarPage(collapsible  = T, id = "navbarid",
                 title = "Title",
                 mod1_ui("mod1", "Module 1 Tab", navid = 1),
                 mod2_ui("mod2", 'Module 2 Tab', navid = 2)
)

server <- function(input, output, session) {
  callModule(mod1_server, "mod1", parent_session = session)
  callModule(mod2_server, "mod2", parent_session = session)
}

shinyApp(ui, server)

推荐阅读