R Shiny renderMenu意外行为

Question

休息两年多后我要回到R，这并不容易。

由于使用了闪亮的仪表板软件包，我已经创建了一个界面，在侧边栏中包括两个不同的菜单：一个简短的菜单和一个扩展的菜单。当您单击“国家/地区”选项卡时，应该显示扩展菜单，但是打开的很快，然后又返回到短菜单，我不明白为什么。菜单是从服务器端呈现的。非常感谢您的帮助。

这是ui代码：

 library(dplyr)
 library(shiny)
 library(shinydashboard)

 ui <- dashboardPage(
   dashboardHeader(
       title = "2019 CENSUS",
       titleWidth = 500), # f. de dashboardHeader

     dashboardSidebar(#Sidebar contents
       sidebarMenu(id = "Menu1",
                   sidebarMenuOutput("Menu"))

     ), # closes dashboardSidebar

     #### BODY CONTENTS #####

     dashboardBody(

       # Title
       tags$head(tags$style(HTML('
                                 .main-header .logo {
                                 font-family: "Georgia", Times, "Times New Roman", serif;
                                 font-weight: bold;
                                 font-size: 16px;
                                 }
                                 '))), # closes tags$head(tags$style(HTML('

       tabItems(
         # Geo levels tab contents
         tabItem(tabName = "levels",
                 fluidRow(                
                   box(width = 12, background = "light-blue",title = "Welcome", "Please choose a geo level from the three available then click on the 'Home datas' tab") # closes box
                 ) # closes fluidRow
         ), # closes tabItem

         # Country level tab contents
         tabItem(tabName = "country",
                 fluidRow(
                   box(title = "Country level : please, click on the 'Home datas' tab to view datas", width = 12, background = "olive") # closes box
                ) # closes fluidRow
         ), # closes tabItem

         # Counties tab contents
         tabItem(tabName = "counties",
                 fluidRow(
                   box(title = "Counties level", width = 3, solidHeader = TRUE, status = "primary",
                       checkboxGroupInput("dynamic_provinces", label = "", c("North","South","Islands"))) # closes box
                 ), # closes fluidRow

                 fluidRow(
                   box(title = "North county", width = 9, background = "light-blue"),  # closes box

                   br()

                 ), # closes fluidRow

                 fluidRow(
                  box(title = "South county", width = 9, background = "orange"), # closes box

                   br()

                 ), # closes fluidRow

                 fluidRow(
                   box(title = "Islands county", width = 9, background = "olive"),  # closes box

                 ) # closes fluidRow

              ) # closes tabItem

            ) # closes tabItems

          ) # closes dashboardBody    

        ) # closes dashboardPage

和服务器代码：

 shinyServer(function(input, output, session) {

   # Initialize reactive values
   rv10 <- reactiveValues(selection = numeric())

   rv10$selection <- 0 # extended/short menu reactive value : extended menu if = 1/ short menu if = 0

   #### FOCUS ON THE WELCOME TAB ####

   updateTabItems(session, "Menu1", "welcome")

   ############## SETTING MENU DEPENDING ON THE VALUE OF rv10$selection ################

   output$Menu <- renderMenu({
     if (rv10$selection == 1) { # extended/short menu reactive value : extended menu if = 1/ short menu if = 0
       sidebarMenu(# Short menu
         menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE),
         menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
         menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
         menuItem(strong("Home datas"), tabName = "home_datas", icon = icon("home"),
                  menuSubItem("Home data 1", tabName = "home_1", icon = icon("home")),
                  menuSubItem("Home data 2", tabName = "home_2", icon = icon("home"))),
         menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))

       ) # closes sidebarMenu
     } # closes if

     else {

       sidebarMenu(# Extended menu
         menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE),
         menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
         menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
         menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))

       ) # closes sidebarMenu

     } # closes else

   }) # closes output$Menu <- renderMenu({

   #### OBSERVEEVENT #####

   observeEvent(input$Menu1, {

     # If click on the "Geo levels" tab -> short menu

     if (input$Menu1 == "levels"){

       rv10$selection <- 0 # rv10$selection = 0 -> displaying the short menu
       print(paste("rv10$selection value =", rv10$selection)) # displaying the value of rv10$selection
     }

     # If click on the "Country" tab -> extended menu

     if(input$Menu1 == "country"){

       rv10$selection <- 1 # rv10$selection = 1 -> displaying the extended menu
       print(paste("rv10$selection value =", rv10$selection))
     }

     # If click on the "counties" tab -> short menu

     if(input$Menu1 == "counties"){

       rv10$selection <- 0 # rv10$selection = 0 -> displaying the short menu
       print(paste("rv10$selection value =", rv10$selection))
     }

     #### CLOSING THE APP ####

     if (input$Menu1 == "quit"){

       print("Quit")
       stopApp()}

   }) # closes ObserveEvent(input$Menu1

 }) # closes shinyServer(function(input, output, session) {

非常感谢您的帮助。

Answer 1

请小心使用右括号。 menuSubItem()放置在menuItem()内部。

不正确：

 sidebarMenu(# Short menu
         menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE),
         menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
         menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
         menuItem(strong("Home datas"), tabName = "home_datas", icon = icon("home"),
                  menuSubItem("Home data 1", tabName = "home_1", icon = icon("home")),
                  menuSubItem("Home data 2", tabName = "home_2", icon = icon("home"))),
         menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))

       ) # closes sidebarMenu

正确的版本：

sidebarMenu(# Short menu
        menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE,
        menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
        menuSubItem("Counties", tabName = "counties", icon = icon("parking"))),
        menuItem(strong("Home datas"), tabName = "home_datas", icon = icon("home"),
                 menuSubItem("Home data 1", tabName = "home_1", icon = icon("home")),
                 menuSubItem("Home data 2", tabName = "home_2", icon = icon("home"))),
        menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))

我所要做的就是去掉第一个menuItem()末尾的右方括号，然后将其放在第二个menuSubItem()末尾。

完整服务器代码：

server <- function(input, output, session) {

  # Initialize reactive values
  rv10 <- reactiveValues(selection = numeric())

  rv10$selection <- 0 # extended/short menu reactive value : extended menu if = 1/ short menu if = 0

  #### FOCUS ON THE WELCOME TAB ####

  updateTabItems(session, "Menu1", "welcome")

  ############## SETTING MENU DEPENDING ON THE VALUE OF rv10$selection ################

  output$Menu <- renderMenu({
    if (rv10$selection == 1) { # extended/short menu reactive value : extended menu if = 1/ short menu if = 0
      sidebarMenu(# Short menu
        menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE,
        menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
        menuSubItem("Counties", tabName = "counties", icon = icon("parking"))),
        menuItem(strong("Home datas"), tabName = "home_datas", icon = icon("home"),
                 menuSubItem("Home data 1", tabName = "home_1", icon = icon("home")),
                 menuSubItem("Home data 2", tabName = "home_2", icon = icon("home"))),
        menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))

      ) # closes sidebarMenu
    } # closes if

    else {

      sidebarMenu(# Extended menu
        menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE),
        menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
        menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
        menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))

      ) # closes sidebarMenu

    } # closes else

  }) # closes output$Menu <- renderMenu({

  #### OBSERVEEVENT #####

  observeEvent(input$Menu1, {

    # If click on the "Geo levels" tab -> short menu

    if (input$Menu1 == "levels"){

      rv10$selection <- 0 # rv10$selection = 0 -> displaying the short menu
      print(paste("rv10$selection value =", rv10$selection)) # displaying the value of rv10$selection
    }

    # If click on the "Country" tab -> extended menu

    if(input$Menu1 == "country"){

      rv10$selection <- 1 # rv10$selection = 1 -> displaying the extended menu
      print(paste("rv10$selection value =", rv10$selection))
    }

    # If click on the "counties" tab -> short menu

    if(input$Menu1 == "counties"){

      rv10$selection <- 0 # rv10$selection = 0 -> displaying the short menu
      print(paste("rv10$selection value =", rv10$selection))
    }

    #### CLOSING THE APP ####

    if (input$Menu1 == "quit"){

      print("Quit")
      stopApp()}

  }) # closes ObserveEvent(input$Menu1

} # closes shinyServer(function(input, output, session) {
然后运行：

shinyApp(ui, server)