如何使用shinyjs在shiny应用中根据登录用户隐藏tab项

核心错误点 #

• 条件判断逻辑错误：原代码中!is.null(creds_reactive()$user) %in% c("shiny")的判断逻辑不成立，%in%左侧是判断用户是否为空的布尔值，无法和字符串"shiny"完成匹配
• 菜单元素定位错误：shinydashboard的menuItem默认不会将tabName作为HTML元素id，直接调用shinyjs::hide("widgets")找不到对应DOM元素，无法触发隐藏效果

修正步骤 #

1. 给需要控制显隐的menuItem添加唯一的id属性，方便shinyjs定位元素
2. 修正身份判断逻辑，匹配到指定用户后调用对应方法控制菜单显隐

完整可运行代码 #

library(shinymanager)
library(shinyjs)
library(shiny)
library(shinydashboard)

credentials <- data.frame(
  user = c("shiny", "shiny2"), # mandatory
  password = c("111", "111"), # mandatory
  start = c("2015-04-15"), # optinal (all others)
  expire = c(NA, "2032-12-31"),
  admin = c(FALSE, TRUE),
  comment = "Simple and secure authentification mechanism 
  for single ‘Shiny’ applications.",
  stringsAsFactors = FALSE,
  moreInfo = c("someData1", "someData2"),
  level = c(2, 0)
)

if (interactive()) {
  header <- dashboardHeader()
  
  sidebar <- dashboardSidebar(
    shinyjs::useShinyjs(),
    sidebarUserPanel("User Name",
                     subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
                     # Image file should be in www/ subdir
                     image = "userimage.png"
    ),
    sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
    sidebarMenu(
      # Setting id makes input$tabs give the tabName of currently-selected tab
      id = "tabs",
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      # 给Widgets菜单添加唯一id
      menuItem("Widgets", icon = icon("th"), tabName = "widgets", id = "menu_widgets", badgeLabel = "new",
               badgeColor = "green"),
      menuItem("Charts", icon = icon("bar-chart-o"),
               menuSubItem("Sub-item 1", tabName = "subitem1"),
               menuSubItem("Sub-item 2", tabName = "subitem2")
      )
    )
  )
  
  body <- dashboardBody(
    tabItems(
      tabItem("dashboard",
              div(p("Dashboard tab content"))
      ),
      tabItem("widgets",
              "Widgets tab content"
      ),
      tabItem("subitem1",
              "Sub-item 1 tab content"
      ),
      tabItem("subitem2",
              "Sub-item 2 tab content"
      )
    )
  )
  
  shinyApp(
    ui = secure_app(dashboardPage(header, sidebar, body)),
    server = function(input, output, session) { 
      
      res_auth <- secure_server(
        check_credentials = check_credentials(credentials)
      )
      # Create reactive values including all credentials
      creds_reactive <- reactive({
        reactiveValuesToList(res_auth)
      })
      
      # 修正后的显隐控制逻辑
      observe({
        req(creds_reactive())
        if(creds_reactive()$user == "shiny"){
          shinyjs::hide("menu_widgets")
        } else {
          shinyjs::show("menu_widgets")
        }
      })
      
    }
  )
}

如果需要控制子菜单的显隐，只需给对应menuSubItem添加唯一id，用相同逻辑调用hide/show方法即可。

内容的提问来源于stack exchange，提问作者Jorge Hernández