Question

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

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

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

接受UserInput并在Mainpanel中显示的代码：

#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)

Answer 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()根据登录条件有条件地显示表。

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

1 个答案: