Question

给定的R闪亮脚本在侧栏中创建一个包含主菜单项和子菜单项的下拉菜单。当您单击第一个子项1时，您将在dashboardBody中获得两个selectInput。我想要一个功能，我只需要声明这些输入一次，并在其他子项中多次使用它，就像反应函数一样。我想这样做是为了使脚本快速有效。我对反应功能的了解较少，请帮助和谢谢。

library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(), 
dashboardSidebar(
sidebarMenu(

  id = "tabs",
  menuItem("Charts", icon = icon("bar-chart-o"),
           menuSubItem("Sub-item 1", tabName = "subitem1"),
           menuSubItem("Sub-item 2", tabName = "subitem2"),
           menuSubItem("Sub-item 3", tabName = "subitem3"),
           menuSubItem("Sub-item 4", tabName = "subitem4")
        ))),
  dashboardBody(
  tabItems(
  tabItem("subitem1", column(2,offset = 0, style='padding:1px;', 
  selectInput("select1","select1",c("A1","A2","A3"), selected = "A1")),
          column(2,offset = 0, style='padding:1px;', 
  selectInput("select2","select2",c("A3","A4","A5"), selected = "A3"))),
  tabItem("subitem2", "Widgets tab content"),
  tabItem("subitem3", "Sub-item 1 tab content"),
  tabItem("subitem4", "Sub-item 2 tab content"))))
  server <- function(input, output, session) {
  }
  shinyApp(ui, server)

Answer 1

您的代码可以使用闪亮的modules进行重写。要显示两个下拉列表的UI模块可以写为一个（Ui函数），然后可以在所需的位置引用。

修改后的代码：

library(shiny)
library(shinydashboard)

submenuUI <- function(id) {
  ns <- NS(id)


  # return a list of tags
  tagList(
     column(2,offset = 0, style='padding:1px;', 
                               selectInput(ns("select1"),"select1",c("A1","A2","A3"), selected = "A1")),
            column(2,offset = 0, style='padding:1px;', 
                   selectInput(ns("select2"),"select2",c("A3","A4","A5"), selected = "A3"))
  )


}


submenu <- function(input,output,session){}


ui <- dashboardPage(
  dashboardHeader(), 
  dashboardSidebar(
    sidebarMenu(

      id = "tabs",
      menuItem("Charts", icon = icon("bar-chart-o"),
               menuSubItem("Sub-item 1", tabName = "subitem1"),
               menuSubItem("Sub-item 2", tabName = "subitem2"),
               menuSubItem("Sub-item 3", tabName = "subitem3"),
               menuSubItem("Sub-item 4", tabName = "subitem4")
      ))),
  dashboardBody(
    tabItems(tabItem("subitem1", submenuUI('submenu1')),
      tabItem("subitem2", submenuUI('submenu2')),
      tabItem("subitem3", submenuUI('submenu3')),
      tabItem("subitem4", "Sub-item 2 tab content"))))
server <- function(input, output, session) {
  callModule(submenu, "submenu")
}
shinyApp(ui, server)

在多个subMenuItems下的R shiny中使用类似的UI脚本

1 个答案: