我如何隐藏带有 shinyjs 的选项卡？

Question

您好，感谢您阅读我的文章我正在使用具有密码层的应用程序，我想知道如何根据进入应用程序的人隐藏选项卡项。到目前为止，这是我所拥有的，但我还没有设法让它发挥作用：

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")),
      menuItem("Widgets", icon = icon("th"), tabName = "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 (!is.null(creds_reactive()$user) %in% c("shiny") ) shinyjs::hide("widgets")
      })
      
      }
  )
}

有人知道如何纠正这个问题吗？当某个用户进入应用程序时，我无法让选项卡项目隐藏:(

Answer 1

我会使用 renderMenu 而不是隐藏 menuItem - 否则不允许访问内容的用户只需在浏览器中将 UI 元素的样式更改为（我假设你的 tabItems 的内容也是在服务器端生成的）。

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")),
      menuItemOutput("widgetsOutput"),
      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)
      })
      
      output$widgetsOutput <- renderMenu({
        if(creds_reactive()$user == "shiny"){
          menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new", badgeColor = "green") 
        }
      })
      
    }
  )
}

我如何隐藏带有 shinyjs 的选项卡？

How I can hide a tab with shinyjs?

r

shiny

shinydashboard

shinyjs