1

我正在尝试在多个子菜单项中使用 R Shiny 中的 plotOutput。但是，我相信 plotOutput 不可能在具有相同 ID 的多个地方使用。如果有可能，请帮助我。附上快照以供参考。

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")
  ))),
dashboardBody(
tabItems(tabItem("subitem1", 3),
         tabItem("subitem2", plotOutput("brand_selector")))
 ))
server <- shinyServer(function(input, output) {
output$brand_selector <-  renderPlot({
plot(iris$Sepal.Length)
}) 
})
shinyApp(ui = ui, server = server)

快照

更新

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","A2","A1","A3","A1"))),
column(2,offset = 0, style='padding:1px;', 

selectInput(ns("select2"),"select2",c("B3","B4","B5","B3","B6","B2","B3")))
)
}
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) {
  observeEvent(input$Select1,{
  updateSelectInput(session,'Select2',
                  choices= input$select2[input$Select1 == "A1"] )
   }) 
   callModule(submenu, "submenu")
   }
   shinyApp(ui, server)

请帮助我根据前一个 selectInput 的输入更新第二个 selectInput。

4

1 回答 1

2

这是用于多次绘图的模块化代码：与 selectInput 非常相似。

library(shiny)
library(shinydashboard)

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


  # return a list of tags
  tagList(
   plotOutput(ns('plt'))
  )


}



plotop <- function(input,output,session){
  ns <- session$ns

  output$plt <- renderPlot({
    plot(iris$Sepal.Length)
  })
}


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")
      ))),
  dashboardBody(
    tabItems(tabItem("subitem1", plotopUI('plt1')),
             tabItem("subitem2", plotopUI('plt2')))))

server <- function(input, output, session) {
  callModule(plotop, "plt1")
  callModule(plotop, "plt2")
}
shinyApp(ui, server)
于 2018-01-22T12:10:40.607 回答