如何在点击 menuItem 时触发动作？

Question

我想在点击 menuItem 时触发一些动作。我在这里使用 observe：当我单击 'Drivers' 项时，我希望在控制台中返回一些文本。不幸的是，当我运行应用程序出现错误时：if: 参数长度为 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",
        id = "panel",
        height = 450,
        collapsible = TRUE
      )
    ),
    tabItem(
      tabName = "customers",
      box(
        title = "Customers",
        id = "panel",
        height = 450,
        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 的方式，但也许我错了。

Answer 1

你错了。许多其他针对此问题的已发布解决方案使用 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")
    }
  })

这是一个简单的错字。

如何在点击 menuItem 时触发动作？

How to trigger action on clicking in menuItem?

r

reactive-programming

shiny

shinydashboard