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

Posted 2023-03-24

【中文标题】从 Shiny 中的 sideBarMenu 和 radioButton 选择时不显示图表

【英文标题】：Charts not being displayed while selecting from sideBarMenu and radioButton in Shiny

【发布时间】：2020-11-20 20:55:30

【问题描述】：

我不确定为什么没有显示图表。 All I want is the user must select a menuSubItem from the sidebarMenu and select a choice in the radioButton, when these are selected, respective tabs in the dashboardBody must be displayed.当我尝试执行此代码时，没有任何效果，也没有引发错误。请帮忙。还建议是否可以进行任何替代编码来完成这项工作。 谢谢，

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（用户界面，服务器）

【参考方案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)  

【讨论】：

我确实按照您的建议进行了更改，但尚未绘制图表，也看不到 verbatimTextOutput(text1) 或 text2。

事实是我需要使用 menuSubItem 和 radioButton 值在dashboardBody中显示标题为tab1或tab2或tab3或tab4的tabItem。这些实时选项卡中的每一个都有带有多个图表的流体行。所以如果我使用上面的建议，这只会满足dashboarBody中的tab1选择。我如何使用 if 条件来显示所需的选项卡，而不仅仅是一个选项卡（即 tab1）。请帮忙。