动态菜单，conditionalPanel

Question

背景

我想开发一个应用程序，它有一个登录屏幕，显示根据用户的权限不同的菜单。

用户权限是分层的，这意味着Read + Write用户应该拥有与Read用户相同的权利以及一些其他权利。

我现在正在努力如何创建这个动态菜单。我读this document on dynamic UIs，我希望我完全可以通过使用conditionalPanel来实现我的目标。

在下面的代码中，您会看到有很多重复。最糟糕的是，即使它们在不同的（互斥）面板（a1和a2）中，但我们也必须为tabs分配唯一的名称，但其意图完全相同。

事情试过到目前为止

我试图移动（分别tabItems）的conditionalPanel到sidebarMenu，但后来我得到一个错误，因为conditionalPanel返回类型不匹配预期的类型。

预期结果

最后，我想有很少的代码重复。也就是说，我想定义的界面为Do A和Do B正好为一次，但重复使用Do A两个用户。

我有哪些选择？我是否必须回退到动态渲染（renderUI/renderMenu），或者有什么方法可以实现预期的行为（仅限于conditionalPanel）？

工作代码复制

library(shiny) 
library(shinydashboard) 

ui <- dashboardPage(
    dashboardHeader(), 
    dashboardSidebar(
     selectInput("userrights", label = "User Rights:", 
        choices = c("Read + Write", "Read")), 
     conditionalPanel("input.userrights == 'Read'", 
         sidebarMenu(
          menuItem("Do A", tabName = "a1") 
         ) 
    ), 
     conditionalPanel("input.userrights == 'Read + Write'", 
         sidebarMenu(
          ## unnecessary duplication + I need yet another tab 'a2' 
          menuItem("Do A", tabName = "a2"), 
          menuItem("Do B", tabName = "b2") 
         ) 
    ) 
    ), 
    dashboardBody(
     conditionalPanel("input.userrights == 'Read'", 
         tabItems(
          tabItem("a1", h1("A was done")) 
         ) 
    ), 
     conditionalPanel("input.userrights == 'Read + Write'", 
         tabItems(
          tabItem("a2", h1("A was done")), 
          tabItem("b2", h1("B was done")) 
         ) 
    ) 
    ) 
) 

server <- function(input, output) {} 

runApp(shinyApp(ui, server)) 

段：没有工作，但至少W/O复制

sidebarMenu(
    menuItem("Do A", tabName = "a") 
    conditionalPanel("input.userrights == 'Read + Write'", 
     menuItem("Do B", tabName = "b") 
    ) 
) 

Answer 1

您可以在服务器中呈现的菜单根据用户输入或其他条件，并将其输出到UI。下面的工作示例：

library(shiny) 
library(shinydashboard) 

ui <- dashboardPage(
    dashboardHeader(), 
    dashboardSidebar(
    selectInput("userrights", label = "User Rights:", 
       choices = c("Read + Write", "Read")), 
    sidebarMenuOutput("menu") 
), 
    dashboardBody(
    tabItems(
     tabItem("a", h1("A was done")), 
     tabItem("b", h1("B was done")) 
    ) 
) 
) 

server <- function(input, output) { 


    output$menu <- renderMenu({ 

    my_list = list(menuItem("a", tabName="a")) 

    if(input$userrights=="Read + Write") 
     my_list[[2]] = menuItem("b", tabName="b") 

    sidebarMenu(my_list) 

    }) 

} 

runApp(shinyApp(ui, server)) 

希望这有助于！