library(shiny)
fieldsAll <- c("name", "favourite_pkg", "used_shiny", "r_num_years", "os_type")
fieldsMandatory <- c("name", "favourite_pkg")
labelMandatory <- function(label) {
tagList(
label,
span("*", class = "mandatory_star")
)
}
epochTime <- function() {
return(as.integer(Sys.time()))
}
humanTime <- function() {
format(Sys.time(), "%Y%m%d-%H%M%OS")
}
saveData <- function(data) {
fileName <- sprintf("%s_%s.csv",
humanTime(),
digest::digest(data))
write.csv(x = data, file = file.path(responsesDir, fileName),
row.names = FALSE, quote = TRUE)
}
loadData <- function() {
files <- list.files(file.path(responsesDir), full.names = TRUE)
data <- lapply(files, read.csv, stringsAsFactors = FALSE)
#data <- dplyr::rbind_all(data)
data <- do.call(rbind, data)
data
}
responsesDir <- file.path("responses")
appCSS <-
".mandatory_star { color: red; }
.shiny-input-container { margin-top: 25px; }
#submit_msg { margin-left: 15px; }
#error { color: red; }
body { background: #fcfcfc; }
#header { background: #fff; border-bottom: 1px solid #ddd; margin: -20px -15px 0; padding: 15px 15px 10px; }
"
adminUsers <- c("admin", "prof")
share <- list(
)
shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
shinyjs::inlineCSS(appCSS),
title = "My Form with Shiny code",
tags$head(
),
div(id = "header",
h1("My Form with Shiny code"),
strong(
a("Sai Mahesh")
)
),
fluidRow(
column(6,
div(
id = "form",
textInput("name", labelMandatory("Name"), ""),
textInput("favourite_pkg", labelMandatory("Favourite R package")),
checkboxInput("used_shiny", "I've built a Shiny app in R before", FALSE),
sliderInput("r_num_years", "Number of years using R", 0, 25, 2, ticks = FALSE),
selectInput("os_type", "Operating system used most frequently",
c("", "Windows", "Mac", "Linux")),
actionButton("submit", "Submit", class = "btn-primary"),
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")
)
)
),
column(6,
uiOutput("adminPanelContainer")
)
)
),
server = function(input, output, session) {
observe({
mandatoryFilled <-
vapply(fieldsMandatory,
function(x) {
!is.null(input[[x]]) && input[[x]] != ""
},
logical(1))
mandatoryFilled <- all(mandatoryFilled)
shinyjs::toggleState(id = "submit", condition = mandatoryFilled)
})
formData <- reactive({
data <- sapply(fieldsAll, function(x) input[[x]])
data <- c(data, timestamp = epochTime())
data <- t(data)
data
})
observeEvent(input$submit, {
shinyjs::disable("submit")
shinyjs::show("submit_msg")
shinyjs::hide("error")
tryCatch({
saveData(formData())
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")
})
output$adminPanelContainer <- renderUI({
if (!isAdmin()) return()
div(
id = "adminPanel",
h2("Previous responses "),
downloadButton("downloadBtn", "Download responses"), br(), br(),
DT::dataTableOutput("responsesTable")
)
})
isAdmin <- reactive({
is.null(session$user) || session$user %in% adminUsers
})
output$responsesTable <- DT::renderDataTable(
loadData(),
rownames = FALSE,
options = list(searching = FALSE, lengthChange = FALSE)
)
output$downloadBtn <- downloadHandler(
filename = function() {
sprintf("mimic-google-form_%s.csv", humanTime())
#sprintf("get_me_responses.csv", humanTime())
},
content = function(file) {
write.csv(loadData(), file, row.names = FALSE)
}
)
}
)
我创建了一个表单,其中提交按钮显示错误。我无法提交表格。我创建了五个必填字段,在填写所有这些字段后,提交按钮被启用,当按下提交按钮时,它需要显示表单已提交。