我想在多个子菜单项中使用R闪亮的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。
答案 0 :(得分: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)