根据用户限制 SelectInput

Question

我目前正在尝试构建一个应用程序来可视化工人随时间的表现。我正在尝试创建一个受密码保护的仪表板，其中标记为经理的用户可以查看所有其他用户统计信息，而非经理用户只能查看他们自己的统计信息。但是我无法让它工作。这是我到目前为止所拥有的。用户列表是与其用户名匹配的员工（2 个变量），凭据列表是用户名和密码（2 个变量）。问题出在观察功能 imo 上。如果用户不是经理，我希望他们的 selectinput 按钮锁定在他们自己的名字上。 IE。 session$user==users$user

任何指导将不胜感激。

data<-read.csv("Data/data.csv")
data$Create.Date<-as.Date(data$Create.Date)
credentials<-unique(read.csv("Data/credentials.csv"))

ui<-secure_app(head_auth=tags$script(inactivity),
             dashboardPage(

dashboardHeader(title = "Services Dashboard"),

dashboardSidebar(
  selectInput("name","Select a User", users[,1]),
  dateRangeInput("date", "Select a Date Range",format="mm-dd-yy"),
  actionButton("go", "Go")
),

dashboardBody(
  plotlyOutput("plot"),
  tableOutput("table"),
)
)
)

server<-function(input, output, session){

res_auth<-secure_server(check_credentials = check_credentials(credentials))

user<-reactive({
  session$user
}
)

manager<-reactive({
  if(user()=="manager"){
    return(TRUE)
  }else{
    return(FALSE)
  }
})

observe({
  if(manager()==FALSE){
    updateSelectInput(session, "names", "Select A User", 
choices=users$user[users$username==user()])
  }
 })

    
 masterdata<-eventReactive(input$go, {
  data %>%
    filter(
      as.Date(Create.Date) >= as.Date(input$date[1]),
      as.Date(Create.Date) <= as.Date(input$date[2]),
      Staff.Created == input$name)
  })

 aggdata<-eventReactive(input$go, {
  data %>%
    filter(
      as.Date(Create.Date) >= as.Date(input$date[1]),
      as.Date(Create.Date) <= as.Date(input$date[2]),
      Staff.Created == input$name)%>%
    summarise(`Services Provided in Period Selected`=sum(count))
    
 })

 output$plot<-renderPlotly({
  ggplot(masterdata(), 
         aes(x=Create.Date, y=count, label=count),
         xmin=input$date[1], xmax=input$date[2], ymin=0, fill = input$date)+
    xlab("Date")+
    ylab("Services Provided")+
    geom_line(group=1, colour="#000099")+
    theme(axis.text.x = element_text(angle=45, vjust=0.5, size=8))+
    scale_x_date(breaks = "days", date_labels = "%m.%d")+
    geom_point()
    })

  output$table<-renderTable({
  aggdata()
 })

}

shinyApp(ui = ui, server = server)

这是我的错误代码：警告：如果：参数长度为零时出错

Answer 1

我删除了所有东西，除了一些基本的东西来模拟你想要的东西。我改变的是这样的：

我一直使用选择输入的 id（在此示例中为“名称”）。否则，您将尝试访问不存在的 input 元素。当您尝试读取它时，这只会返回 null。

在初始化期间可能会发生另一个可能的原因。我不确定事情发生的顺序。但是，如果在第一次评估代码时未设置 session$user，您的代码将假定为非管理器场景，并且一旦所有信息可用，它将不会再次更新。因此：

• 当反应式表达式检查管理员权限时，也检查null。这可能在初始化期间发生。
• 我添加了一个else 分支以在经理登录时恢复选择输入中的所有名称。

library(shiny)

users <- data.frame(
  username = LETTERS[1:10],
  user = letters[1:10]
)

ui <- fluidPage(
  # Needed for mocking the user id
  checkboxInput("MockScenario", "Mock a manager scenario"),

  # Original code
  selectInput("names", "Select a User", users$username),
  dateRangeInput("date", "Select a Date Range", format="mm-dd-yy"),
  actionButton("go", "Go")
)

server <- function(input, output, session) {

  user <- reactive({
    # session$user # is not used in this sample but the mock
    ## Mocked user
    if (input$MockScenario == TRUE)
      "manager"
    else
      sample(users$user, 1)
  })
  
  manager <- reactive({
    if (isTruthy(user()) && user() == "manager") {
      return(TRUE)
    } else {
      return(FALSE)
    }
  })
  
  observe({
    if(manager() == FALSE) {
      updateSelectInput(session, "names", "Select A User", 
                        choices = users$username[users$user == user()])
    } else {
      updateSelectInput(session, "names", "Select A User", 
                        choices = users$username)
    }
  })
}

shinyApp(ui, server)