从 Shiny 的 sideBarMenu 和 radioButton 中选择时不显示图表

Question

我不确定为什么没有显示图表。我想要的只是用户必须 select sidebarMenu 中的 menuSubItem 和 select radioButton 中的选项，当这些被 selected 时，必须显示 dashboardBody 中的相应选项卡。当我尝试执行这段代码时，没有任何效果，也没有抛出任何错误。请帮忙。还建议是否可以进行任何替代编码来完成此操作。谢谢，

ui <-  dashboardPage(#skin="purple-light",
dashboardHeader(title="Testing"),
dashboardSidebar(width=200, 
               sidebarMenu(id= "sbar",verbatimTextOutput("text1"),verbatimTextOutput("text2"),
                           menuItem("Menu1", tabName = "MenuTab1",startExpanded = TRUE,
                                    menuSubItem("Sub Menu1", tabName = "sub1"),
                                    menuSubItem("Sub Menu2", tabName = "sub2")),
                           menuItem("Menu2", tabName= "MenuTab2",startExpanded = TRUE,
                                    menuSubItem("Sub Menu3", tabName = "sub3"),
                                    menuSubItem("Sub Menu4", tabName = "sub4")))),

  dashboardBody(radioButtons("rb1",label=NULL, choices = c("choice1","choice2"), selected=NULL),
      tabItems(
              tabItem("sub1",title= "Tab1",fluidRow(plotOutput("plot1"),plotOutput("plot3"))),
              tabItem("sub2",title= "Tab2",fluidRow(plotOutput("plot1"),plotOutput("plot2"))),
              tabItem("sub3",title= "Tab3",fluidRow(plotOutput("plot1"),plotOutput("plot3")))))) 

server <- function(input,output){
 set.seed(1234)
 observe(input$sbar)
 p1 <- reactive({
      req(input$rb1)
      req(input$sbar)

      if (      input$sbar == "sub1" && input$rb1 =="choice1" ){
        return(qplot(rnorm(500),fill=I("blue"),binwidth=0.2))
      }else if (input$sbar == "sub1" && input$rb1 =="choice2") {
        return(qplot(rnorm(500),fill=I("red"),binwidth=0.2))
      }else if (input$sbar == "sub2" && input$rb1 =="choice1") {
        return(qplot(rnorm(500),fill=I("black"),binwidth=0.2))
      }else if (input$sbar == "sub2" && input$rb1 =="choice2") {
        return(qplot(rnorm(500),fill=I("red"),binwidth=0.2))
      }else if (input$sbar == "sub3" && input$rb1 =="choice1") {
        return(qplot(rnorm(500),fill=I("black"),binwidth=0.2))
      }else if (input$sbar == "sub3" && input$rb1 =="choice2") {
        return(qplot(rnorm(500),fill=I("blue"),binwidth=0.2))
      }else if (input$sbar == "sub4" && input$rb1 =="choice1") {
        return(qplot(rnorm(500),fill=I("yellow"),binwidth=0.2))
      }else if (input$sbar == "sub4" && input$rb1 =="choice2") {
        return(qplot(rnorm(500),fill=I("orange"),binwidth=0.2))
      }else {return(qplot(rnorm(500),fill=I("green"),binwidth=0.2))}
    })
 p2 <- qplot(rnorm(500),fill=I("red"),binwidth=0.2)
 p3 <- qplot(rnorm(500),fill=I("yellow"),binwidth=0.2)

observe(input$sbar)
output$text1      <- renderText(print(input$rb1))
output$text2      <- renderText(print(input$sbar))
output$plot1 <- renderPlot({p1})
output$plot2 <- renderPlot({p2()})
output$plot3 <- renderPlot({p3})

shinyApp(ui, 服务器)

Answer 1

如果您希望看到 4 个不同的选项卡及其自己的图，请定义四个反应图。然后在每个选项卡中你有两个选择。请看下面的代码。

 ui <-  dashboardPage(#skin="purple-light",
    dashboardHeader(title="Testing"),
    dashboardSidebar(width=200, 
                     sidebarMenu(id= "sbar",verbatimTextOutput("text1"),verbatimTextOutput("text2"),
                                 menuItem("Menu1", tabName = "MenuTab1",startExpanded = TRUE,
                                          menuSubItem("Sub Menu1", tabName = "sub1"),
                                          menuSubItem("Sub Menu2", tabName = "sub2")),
                                 menuItem("Menu2", tabName= "MenuTab2",startExpanded = TRUE,
                                          menuSubItem("Sub Menu3", tabName = "sub3"),
                                          menuSubItem("Sub Menu4", tabName = "sub4")))),
    
    dashboardBody(radioButtons("rb1",label=NULL, choices = c("choice1","choice2"), selected=NULL),
                  tabItems(
                    tabItem("sub1",title= "Tab1",fluidRow(plotOutput("plot1"))),
                    tabItem("sub2",title= "Tab2",fluidRow(plotOutput("plot2"))),
                    tabItem("sub3",title= "Tab3",fluidRow(plotOutput("plot3"))),
                    tabItem("sub4",title= "Tab3",fluidRow(plotOutput("plot4")))
                    ))) 
  
  server <- function(input,output){
    set.seed(1234)
    observe(input$sbar)
    p1 <- reactive({
      req(input$rb1)
      req(input$sbar)
      
      if (      input$sbar == "sub1" && input$rb1 =="choice1" ){
        return(qplot(rnorm(500),fill=I("blue"),binwidth=0.2))
      }else if (input$sbar == "sub1" && input$rb1 =="choice2") {
        return(qplot(rnorm(500),fill=I("red"),binwidth=0.2))
      }
    })
    p2 <- reactive({
      req(input$rb1)
      req(input$sbar)
      
      if (input$sbar == "sub2" && input$rb1 =="choice1") {
        return(qplot(rnorm(500),fill=I("green"),binwidth=0.2))
      }else if (input$sbar == "sub2" && input$rb1 =="choice2") {
        return(qplot(rnorm(500),fill=I("brown"),binwidth=0.2))
      }
    })
    p3 <- reactive({
      req(input$rb1)
      req(input$sbar)
      
      if (      input$sbar == "sub3" && input$rb1 =="choice1" ){
        return(qplot(rnorm(500),fill=I("yellow"),binwidth=0.2))
      }else if (input$sbar == "sub3" && input$rb1 =="choice2") {
        return(qplot(rnorm(500),fill=I("orange"),binwidth=0.2))
      }
    })
    p4 <- reactive({
      req(input$rb1)
      req(input$sbar)
      
      if (input$sbar == "sub4" && input$rb1 =="choice1") {
        return(qplot(rnorm(500),fill=I("purple"),binwidth=0.2))
      }else if (input$sbar == "sub4" && input$rb1 =="choice2") {
        return(qplot(rnorm(500),fill=I("black"),binwidth=0.2))
      }
    })
    
    
    observe(input$sbar)
    output$text1      <- renderText(print(input$rb1))
    output$text2      <- renderText(print(input$sbar))
    output$plot1 <- renderPlot({p1()})
    output$plot2 <- renderPlot({p2()})
    output$plot3 <- renderPlot({p3()})
    output$plot4 <- renderPlot({p4()})
  }
  
  shinyApp(ui = ui, server = server)

从 Shiny 的 sideBarMenu 和 radioButton 中选择时不显示图表

Charts not being displayed while selecting from sideBarMenu and radioButton in Shiny

shiny

shinydashboard

shiny-server

shinyapps

shiny-reactivity