如何触发点击菜单项的动作?

问题描述

我想在点击 menuItem 时触发一些操作。我在这里使用 observe:当我单击“驱动程序”项时,我希望在控制台中返回一些文本。不幸的是,当我运行应用程序时出现错误Error in if: argument is of length 0。我的 menuItem 存在,id 也可以,所以不知道为什么会出现这个错误。 这是可重现的代码observe 在我的代码底部):

library(shiny)
library(bs4Dash)
library(leaflet)


bodyTag <- dashboardBody(
  tags$head(
    tags$style(
      "#map {
          height: calc(100vh - 57px) !important;
        }"
    )
  ),tabItems(
    tabItem(
      tabName = "live",Box(
        title = "LIVE",id = "panel",height = 450,collapsible = TRUE
      )
    ),tabItem(
      tabName = "drivers",Box(
        title = "Drivers",tabItem(
      tabName = "customers",Box(
        title = "Customers",collapsible = TRUE
      )
    )    
  ),leafletoutput("map")
)



ui <- dashboardPage(
  dark = TRUE,header = dashboardHeader(
    title = h5("DEMO app")
  ),sidebar = dashboardSidebar(
    fixed = TRUE,collapsed = TRUE,expandOnHover = FALSE,status = "purple",customArea = fluidRow(
      actionButton(
        inputId = "myAppButton",label = NULL,icon = icon("users"),width = NULL,status = "primary",style = "margin: auto",dashboardBadge(1,color = "danger")
      )
    ),sidebarMenu(
      id = "sidebarID",menuItem("Live",tabName = "live",icon = icon("circle")),menuItem("Drivers",tabName = "drivers",icon = icon("user-friends")),menuItem("Customers",tabName = "customers",icon = icon("building"))
    )
  ),body = bodyTag
)



server <- function(input,output) {
  observeEvent(input$sidebarID,{
    updateBox("panel",action = "toggle")
  })
  

  output$map <- renderLeaflet({
    leaflet() %>%
      setView(lng = -73.98928,lat = 40.75042,zoom = 6) %>%
      addProviderTiles("CartoDB.Positron")
  })
  
   
  # the problem is here
  observe({
    
    if(input$tabs == "drivers") {
      print("Drivers")
      #print(input$tabs)
    } else {
      print("other tabs")
    }
  })

}

shinyApp(ui = ui,server = server)

我很确定 input$tabs 是我应该如何到达给定的 menuItem,但也许我错了。

解决方法

你错了。此问题的许多其他已发布解决方案使用 tabs 作为侧边栏菜单的 ID,但您没有:

    sidebarMenu(
      id = "sidebarID",menuItem("Live",tabName = "live",icon = icon("circle")),menuItem("Drivers",tabName = "drivers",icon = icon("user-friends")),menuItem("Customers",tabName = "customers",icon = icon("building"))
    )

所以你需要

  observe({
    if(input$sidebarID == "drivers") {
      print("Drivers")
      #print(input$tabs)
    } else {
      print("other tabs")
    }
  })

这是一个简单的错字。