如何使用 Shinyauthr 库在闪亮中创建登录而不在 R 中显示主面板？

Posted 2023-03-24

【中文标题】如何使用 Shinyauthr 库在闪亮中创建登录而不在 R 中显示主面板？

【英文标题】：How to create login in shiny using Shinyauthr libarary without displaying main panel in R?

【发布时间】：2019-11-21 18:01:02

【问题描述】：

目前，我的闪亮应用程序处于状态，因此我能够在侧边栏面板中输入信息，并能够在mainpanel 中显示输出。接下来，我想使用shinyauthr 库创建一个登录屏幕，这样用户 1 应该只能看到侧栏面板信息，而输出表应该只在用户 2 登录时显示。为此，我正在尝试遵循shinyauthr 主页上提到的代码。我的问题是，每当我尝试使用 ## 标签隐藏主面板时。将显示以下错误。

注意：我是 Shiny 的新手，请提供外部链接或代码的解释

"Error in sidebarLayout(sidebarPanel(div(id = "form", textInput("name",  : 
  argument "mainPanel" is missing, with no default"

接受 UserInput 并显示在主面板中的代码：

#Storing data on Local Machine
library(shiny)
library(ggplot2)

outputDir <- "responses"

# Define the fields we want to save from the form
fields <- c("name", "address","used_shiny", "r_num_years","select")

#Which fields are mandatory
fieldsMandatory<-c("name","address")


labelMandatory <- function(label) 
  tagList(
    label,
    span("*", class = "mandatory_star")
  )


appCSS <-
  ".mandatory_star  color: red; 
#error  color: red; "


saveData <- function(input) 
  # put variables in a data frame
  data <- data.frame(matrix(nrow=1,ncol=0))
  for (x in fields) 
    var <- input[[x]]
    if (length(var) > 1 ) 
      # handles lists from checkboxGroup and multiple Select
      data[[x]] <- list(var)
     else 
      # all other data types
      data[[x]] <- var
    
  
  data$submit_time <- date()

  # Create a unique file name
  fileName <- sprintf(
    "%s_%s.rds", 
    as.integer(Sys.time()), 
    digest::digest(data)
  )

  # Write the file to the local system
  saveRDS(
    object = data,
    file = file.path(outputDir, fileName)
  )


loadData <- function() 
  # read all the files into a list
  files <- list.files(outputDir, full.names = TRUE)

  if (length(files) == 0) 
    # create empty data frame with correct columns
    field_list <- c(fields, "submit_time")
    data <- data.frame(matrix(ncol = length(field_list), nrow = 0))
    names(data) <- field_list
   else 
    data <- lapply(files, function(x) readRDS(x)) 

    # Concatenate all data together into one data.frame
    data <- do.call(rbind, data)
  

  data


deleteData <- function() 
  # Read all the files into a list
  files <- list.files(outputDir, full.names = TRUE)

  lapply(files, file.remove)


resetForm <- function(session) 
  # reset values
  updateTextInput(session, "name", value = "")
  updateTextInput(session, "address", value = "")
  updateCheckboxInput(session, "used_shiny", value = FALSE)
  updateSliderInput(session, "r_num_years", value = 0)
  updateSelectInput(session,"select",selected = 'NULL')




ui <- fluidPage(
  shinyjs::useShinyjs(),
  shinyjs::inlineCSS(appCSS),

  # App title ----
  titlePanel("Data Collection & Feedback"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(
      div(id='form',
          textInput("name", labelMandatory("Name"), ""),
          textInput("address",labelMandatory('address'),""),
          checkboxInput("used_shiny", "I've built a Shiny app before", FALSE),
          sliderInput("r_num_years", "Number of years using R",
                      0, 10, 0, ticks = FALSE),
          selectInput("select","select",choices = c('a','e','i')),
          actionButton("submit", "Submit",class='btn-primary'),
          actionButton("clear", "Clear Form"),
          downloadButton("downloadData", "Download"),
          actionButton("delete", "Delete All Data"),


          shinyjs::hidden(
            span(id = "submit_msg", "Submitting..."),
            div(id = "error",
                div(br(), tags$b("Error: "), span(id = "error_msg"))
            )
          )

      ),  
      shinyjs::hidden(
        div(
          id = "thankyou_msg",
          h3("Thanks, your response was submitted successfully!"),
          actionLink("submit_another", "Submit another response")
        )
      )  
    ),

    # Main panel for displaying outputs ----
    mainPanel(
      dataTableOutput("responses")
    )
  )
)
server = function(input, output, session) 
  # Enable the Submit button when all mandatory fields are filled out
  observe(
    mandatoryFilled <-
      vapply(fieldsMandatory,
             function(x) 
               !is.null(input[[x]]) && input[[x]] != ""
             ,
             logical(1))
    mandatoryFilled <- all(mandatoryFilled)

    shinyjs::toggleState(id = "submit", condition = mandatoryFilled)
  )



  # When the Submit button is clicked, save the form data
  observeEvent(input$submit, 
    #saveData(input)
    #resetForm(session)
    shinyjs::disable("submit")
    shinyjs::show("submit_msg")
    shinyjs::hide("error")

    tryCatch(
      saveData(input)
      shinyjs::reset("form")
      shinyjs::hide("form")
      shinyjs::show("thankyou_msg")
    ,
    error = function(err) 
      shinyjs::html("error_msg", err$message)
      shinyjs::show(id = "error", anim = TRUE, animType = "fade")
    ,
    finally = 
      shinyjs::enable("submit")
      shinyjs::hide("submit_msg")
    )
  )

  observeEvent(input$submit_another, 
    shinyjs::show("form")
    shinyjs::hide("thankyou_msg")
  )   
  observeEvent(input$clear, 
    resetForm(session)
  )

  # When the Delete button is clicked, delete all of the saved data files
  observeEvent(input$delete, 
    deleteData()
  )

  # Show the previous responses in a reactive table ----
  output$responses <- renderDataTable(
    # update with current response when Submit or Delete are clicked
    input$submit 
    input$delete

    loadData()
  )


  # Downloadable csv of selected dataset ----
  output$downloadData <- downloadHandler(
    filename= "data.csv",

    content = function(file) 
      write.csv(loadData(), file, row.names = FALSE, quote= TRUE)
    
  )


shinyApp(ui, server)

【参考方案1】：

如果登录用户是 user2，则使用 req() 条件仅在 mainPanel 中呈现响应表。

# Show the previous responses in a reactive table ----
  output$responses <- renderDataTable(
    # only render table if user2 is logged in
    req(credentials()$info$user == "user2")

    # update with current response when Submit or Delete are clicked
    input$submit 
    input$delete

    loadData()
  )

查看package readme 获取完整的应用示例，该示例使用req() 根据登录条件有条件地显示表格。