Несколько tabItems в одном блестящем модуле

Question

Привет, я относительно новичок в программировании на R и сиянии. В настоящее время я разрабатываю блестящее приложение для приборной панели. Я застрял в моменте с проблемой, как иметь несколько tabItems в одном модуле. В реальном приложении мне нужно передать гораздо больше информации между модулями, а подменю не похожи. Так есть ли способ заставить эту работу работать? Большое спасибо за Вашу помощь!

library(shiny)
library(shinydashboard)
library(shinydasboardPlus)

#submodules
submodule_ui <- function(id,tabName){
  ns <- NS(id)
  
  tabItem(
    tabName = tabName,
    boxPlus(
      title = "some title",
      textOutput(ns("some_output"))
    )
  )
  
}

submodule_server <- function(id,see){
  moduleServer(
    id,
    function(input, output, session){
      output$some_output <- renderText({
        see
      })
    }
  )
}


#module
module_ui <- function(id,tabName1,tabName2){
  ns <- NS(id)
  
  submodule_ui(ns("sub1"),
               tabName = tabName1)
  submodule_ui(ns("sub2"),
               tabName = tabName2)
  
}

module_server <- function(id){
  moduleServer(
    id,
    function(input, output, session){
      submodule_server("sub1","hello")
      submodule_server("sub2","world !")
    }
  )
}


#app

ui <- dashboardPagePlus(
  header = dashboardHeaderPlus(
    title = "dummy app"
  ),
  sidebar = dashboardSidebar(
    sidebarMenu(
      menuItem(
        text = "home",
        tabName = "home"
      ),
      menuItem(
        text = "submodule1",
        tabName = "subtab1"
      ),
      menuItem(
        text = "submodule2",
        tabName = "subtab2"
      ),
      menuItem(
        text = "some other tabItems",
        tabName = "some_other_tabItems"
      )
    )
  ),
  body = dashboardBody(
    tabItems(
      tabItem(
        tabName = "home",
        box(
          title = "home of the app",
          width = "auto"
        )
      ),
      module_ui(
        id = "module",
        tabName1 = "subtab1",
        tabName2 = "subtab2"
      ),
      tabItem(
        tabName = "some_other_tabItems",
        box(
          title = "some other content"
        )
      )
    )
  )
)

server <- function(input, output){
  module_server("module")
}

shinyApp(ui,server)

´´´

Answer 1

Похоже, возникли некоторые проблемы с получением оболочки элемента вкладки вокруг подмодулей - она ​​производила только второй подмодуль. Модули действуют как функции, поскольку имеют тенденцию производить окончательный вызов. Вы можете завернуть вещи в listили taglistвернуть больше предметов. В это время...

Переместив tabItemsоболочку в модуль, он смог правильно создать список и создать обе вкладки.

Примечание: я преобразовал функции так, чтобы shinydashboardпонять, откуда они xxxPlusвзялись.

library(shiny)
library(shinydashboard)
#submodules
submodule_ui <- function(id,tabName){
  ns <- NS(id)
  
  tabItem(
    tabName = tabName,
    box(
      title = "some title",
      textOutput(ns("some_output"))
    )
  )
  
}

submodule_server <- function(id,see){
  moduleServer(
    id,
    function(input, output, session){
      output$some_output <- renderText({
        see
      })
    }
  )
}


#module
module_ui <- function(id,tabName1,tabName2){
  ns <- NS(id)
  ### tabsItems now produced in module, submodules separated by comma
  tabItems(
    submodule_ui(ns("sub1"),
                 tabName = tabName1),
    submodule_ui(ns("sub2"),
                 tabName = tabName2)
  )
  
  
}

module_server <- function(id){
  moduleServer(
    id,
    function(input, output, session){
      submodule_server("sub1","hello")
      submodule_server("sub2","world !")
    }
  )
}


#app

ui <- dashboardPage(
  header = dashboardHeader(
    title = "dummy app"
  ),
  sidebar = dashboardSidebar(
    sidebarMenu(
      menuItem(
        text = "submodule1",
        tabName = "subtab1"
      ),
      menuItem(
        text = "submodule2",
        tabName = "subtab2"
      )
    )
  ),
  body = dashboardBody(
  
      module_ui(
        id = "module",
        tabName1 = "subtab1",
        tabName2 = "subtab2"
      
    )
  )
)

server <- function(input, output){
  module_server("module")
}

shinyApp(ui,server)