r - 重置闪亮的多个复选框
问题描述
我正在创建一个闪亮的问卷,我希望在我点击提交后重置问卷的选项。我在重置函数中使用了相应的命令。我遇到了需要相同命令的项目的问题:updateSelectInput 和 updateCheckboxInput。当我点击重置时,它只更新具有 updateSelectInput 和 updateCheckboxInput 命令的第一个项目,而当我点击提交时,后续项目不会重置。我试图解决这个问题,但似乎无法在文档中找到解决方案。如果有人有任何解决方案,我将粘贴我的代码,将不胜感激。
library(shiny)
library(ggplot2)
outputDir <- "responses"
# Define the fields we want to save from the form
fields <- c("ID",
"date_evaluation",
"DSFMAX",
"DSF1AP",
"DSF1AT",
"DSF2AP",
"DSF2AT",
"DSF3AP",
"DSF3AT",
"DSF4AP",
"DSF4AT",
"DSF5AP",
"DSF5AT",
"DSF6AP",
"DSF6AT",
"DSF7AP",
"DSF7AT",
"DSF8AP",
"DSF8AT",
"DSF9AP",
"DSF9AT",
"DSF10AP",
"DSF10AT",
"DSF1BP",
"DSF1BT",
"DSF2BP",
"DSF2BT",
"DSF3BP",
"DSF3BT",
"DSF4BP",
"DSF4BT",
"DSF5BP",
"DSF5BT",
"DSF6BP",
"DSF6BT",
"DSF7BP",
"DSF7BT",
"DSF8BP",
"DSF8BT",
"DSF9BP",
"DSF9BT",
"DSF10BP",
"DSF10BT")
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
}
# Define questions
#participant id
ID <- textInput("ID", "Please enter participant ID number")
#date evaluation took place
date_evaluation <- dateInput(
"date_evaluation",
"Enter the date evaluation was completed",
min = "2021-01-01", max = "2028-12-31", startview="year"
# right answer is 1983-02-26
)
#max
DSFMAX <- selectInput(
"DSFMAX",
"Max Digit span forward",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"9",
"10",
"11"
)
)
#1A
DSF1AP <- checkboxGroupInput(
"DSF1AP",
"1A. 1-7 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF1AT <- selectInput(
"DSF1AT",
"1A. 1-7 Number Correct",
c( "0",
"1",
"2"
)
)
#2A
DSF2AP <- checkboxGroupInput(
"DSF2AP",
"2A. 5-8-2 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF2AT <- selectInput(
"DSF2AT",
"2A. 5-8-2 Number Correct",
c( "0",
"1",
"2",
"3"
)
)
#3a
DSF3AP <- checkboxGroupInput(
"DSF3AP",
"3A. 6-4-3-9 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF3AT <- selectInput(
"DSF3AT",
"3A. 6-4-3-9 Number Correct",
c( "0",
"1",
"2",
"3",
"4"
)
)
#4a
DSF4AP <- checkboxGroupInput(
"DSF4AP",
"4A. 4-2-7-3-1 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF4AT <- selectInput(
"DSF4AT",
"4A. 4-2-7-3-1 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5"
)
)
#5a
DSF5AP <- checkboxGroupInput(
"DSF5AP",
"5A. 6-1-9-4-7-3 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF5AT <- selectInput(
"DSF5AT",
"5A. 6-1-9-4-7-3 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6"
)
)
#6a
DSF6AP <- checkboxGroupInput(
"DSF6AP",
"6A. 5-9-1-7-4-2-8 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF6AT <- selectInput(
"DSF6AT",
"6A. 5-9-1-7-4-2-8 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7"
)
)
#7a
DSF7AP <- checkboxGroupInput(
"DSF7AP",
"7A. 5-8-1-9-2-6-4-7 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF7AT <- selectInput(
"DSF7AT",
"7A. 5-8-1-9-2-6-4-7 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8"
)
)
#8a
DSF8AP <- checkboxGroupInput(
"DSF8AP",
"8A. 2-7-5-8-6-2-5-8-4 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF8AT <- selectInput(
"DSF8AT",
"8A. 2-7-5-8-6-2-5-8-4 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"9"
)
)
#9a
DSF9AP <- checkboxGroupInput(
"DSF9AP",
"9A. 3-6-5-1-9-4-7-2-8-5 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF9AT <- selectInput(
"DSF9AT",
"9A. 3-6-5-1-9-4-7-2-8-5 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"9",
"10"
)
)
#10a
DSF10AP <- checkboxGroupInput(
"DSF10AP",
"10A. 5-2-8-6-9-1-7-4-8-3-9 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF10AT <- selectInput(
"DSF10AT",
"10A. 5-2-8-6-9-1-7-4-8-3-9 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"9",
"10",
"11"
)
)
#1b
DSF1BP <- checkboxGroupInput(
"DSF1BP",
"1B. 6-3 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF1BT <- selectInput(
"DSF1BT",
"1B. 6-3 Number Correct",
c( "0",
"1",
"2"
)
)
#2b
DSF2BP <- checkboxGroupInput(
"DSF2BP",
"2B. 6-9-4 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF2BT <- selectInput(
"DSF2BT",
"2B. 6-9-4 Number Correct",
c( "0",
"1",
"2",
"3"
)
)
#3b
DSF3BP <- checkboxGroupInput(
"DSF3BP",
"3B. 7-2-8-6 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF3BT <- selectInput(
"DSF3BT",
"3B. 7-2-8-6 Number Correct",
c( "0",
"1",
"2",
"3",
"4"
)
)
#4b
DSF4BP <- checkboxGroupInput(
"DSF4BP",
"4B. 7-5-8-3-6 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF4BT <- selectInput(
"DSF4BT",
"4B. 7-5-8-3-6 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5"
)
)
#5b
DSF5BP <- checkboxGroupInput(
"DSF5BP",
"5B. 3-9-2-4-8-7 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF5BT <- selectInput(
"DSF5BT",
"5B. 3-9-2-4-8-7 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6"
)
)
#6b
DSF6BP <- checkboxGroupInput(
"DSF6BP",
"6B. 4-1-7-9-3-8-6 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF6BT <- selectInput(
"DSF6BT",
"6B. 4-1-7-9-3-8-6 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7"
)
)
#7b
DSF7BP <- checkboxGroupInput(
"DSF7BP",
"7B. 3-8-2-9-5-1-7-4 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF7BT <- selectInput(
"DSF7BT",
"7B. 3-8-2-9-5-1-7-Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8"
)
)
#8b
DSF8BP <- checkboxGroupInput(
"DSF8BP",
"8B. 7-1-3-9-4-2-5-6-8 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF8BT <- selectInput(
"DSF8BT",
"8B. 7-1-3-9-4-2-5-6-8 4 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"9"
)
)
#9b
DSF9BP <- checkboxGroupInput(
"DSF9BP",
"9B. 9-5-2-4-6-8-1-3-7-4 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF9BT <- selectInput(
"DSF9BT",
"9B. 9-5-2-4-6-8-1-3-7-4 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"9",
"10"
)
)
#10b
DSF10BP <- checkboxGroupInput(
"DSF10BP",
"10B. 2-5-1-9-6-4-8-3-7-1-6 Pass or Fail?",
c("Pass" = "1",
"Fail" = "0"
)
)
DSF10BT <- selectInput(
"DSF10BT",
"10B. 2-5-1-9-6-4-8-3-7-1-6 Number Correct",
c( "0",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"9",
"10",
"11"
)
)
action_demo <- actionButton("clear", "Clear Form")
download_demo <- downloadButton("download", "Download")
file_demo <- fileInput("file_demo", "Upload a PDF", accept = "pdf")
help_demo <- helpText("You can write help text in your form this way")
resetForm <- function(session) {
updateTextInput(session, "ID", value = "")
updateDateInput(session, "date_evaluation", value = NA)
updateSelectInput(session, "DSFMAX", selected=character(0))
updateCheckboxInput(session, "DSF1AP", value = FALSE)
updateSelectInput(session, "DSF1AT", selected=character(0))
updateCheckboxInput(session, "DSF2AP", value = FALSE)
updateSelectInput(session, "DSF2AT", selected=character(0))
updateCheckboxInput(session, "DSF3AP", value = FALSE)
updateSelectInput(session, "DSF3AT", selected=character(0))
updateCheckboxInput(session, "DSF4AP", value = FALSE)
updateSelectInput(session, "DSF4AT", selected=character(0))
updateCheckboxInput(session, "DSF5AP", value = FALSE)
updateSelectInput(session, "DSF5AT", selected=character(0))
updateCheckboxInput(session, "DSF6AP", value = FALSE)
updateSelectInput(session, "DSF6AT", selected=character(0))
updateCheckboxInput(session, "DSF7AP", value = FALSE)
updateSelectInput(session, "DSF7AT", selected=character(0))
updateCheckboxInput(session, "DSF8AP", value = FALSE)
updateSelectInput(session, "DSF8AT", selected=character(0))
updateCheckboxInput(session, "DSF9AP", value = FALSE)
updateSelectInput(session, "DSF9AT", selected=character(0))
updateCheckboxInput(session, "DSF10AP", value = FALSE)
updateSelectInput(session, "DSF10AT", selected=character(0))
updateCheckboxInput(session, "DSF1BP", value = FALSE)
updateSelectInput(session, "DSF1BT", selected=character(0))
updateCheckboxInput(session, "DSF2BP", value = FALSE)
updateSelectInput(session, "DSF2BT", selected=character(0))
updateCheckboxInput(session, "DSF3BP", value = FALSE)
updateSelectInput(session, "DSF3BT", selected=character(0))
updateCheckboxInput(session, "DSF4BP", value = FALSE)
updateSelectInput(session, "DSF4BT", selected=character(0))
updateCheckboxInput(session, "DSF5BP", value = FALSE)
updateSelectInput(session, "DSF5BT", selected=character(0))
updateCheckboxInput(session, "DSF6BP", value = FALSE)
updateSelectInput(session, "DSF6BT", selected=character(0))
updateCheckboxInput(session, "DSF7BP", value = FALSE)
updateSelectInput(session, "DSF7BT", selected=character(0))
updateCheckboxInput(session, "DSF8BP", value = FALSE)
updateSelectInput(session, "DSF8BT", selected=character(0))
updateCheckboxInput(session, "DSF9BP", value = FALSE)
updateSelectInput(session, "DSF9BT", selected=character(0))
updateCheckboxInput(session, "DSF10BP", value = FALSE)
updateSelectInput(session, "DSF10BT", selected=character(0))
}
# Set up questionnaire interface ----
ui <- fluidPage(
title = "OHS Neuropsych Data Entry",
# CSS ----
# stop the default input containers being 300px, which is ugly
tags$head(
tags$style(HTML("
.shiny-input-container:not(.shiny-input-container-inline) {
width: 100%;
max-width: 100%;
}
"))
),
# App title ----
h3("Digit Span Forward"),
p("Please fill in all values"),
fluidRow(
column(width=8, ID, date_evaluation),
column(width=6, DSFMAX)
),
fluidRow(
column(width=6,
DSF1AP,
DSF1AT ),
column(width=6,
DSF1BP,
DSF1BT
)),
fluidRow(
column(width=6,
DSF2AP,
DSF2AT ),
column(width=6,
DSF2BP,
DSF2BT
)),
fluidRow(
column(width=6,
DSF3AP,
DSF3AT ),
column(width=6,
DSF3BP,
DSF3BT
)),
fluidRow(
column(width=6,
DSF4AP,
DSF4AT ),
column(width=6,
DSF4BP,
DSF4BT
)),
fluidRow(
column(width=6,
DSF5AP,
DSF5AT ),
column(width=6,
DSF5BP,
DSF5BT
)),
fluidRow(
column(width=6,
DSF6AP,
DSF6AT ),
column(width=6,
DSF6BP,
DSF6BT
)),
fluidRow(
column(width=6,
DSF7AP,
DSF7AT ),
column(width=6,
DSF7BP,
DSF7BT
)),
fluidRow(
column(width=6,
DSF8AP,
DSF8AT ),
column(width=6,
DSF8BP,
DSF8BT
)),
fluidRow(
column(width=6,
DSF9AP,
DSF9AT ),
column(width=6,
DSF9BP,
DSF9BT
)),
fluidRow(
column(width=6,
DSF10AP,
DSF10AT ),
column(width=6,
DSF10BP,
DSF10BT
)),
actionButton("submit", "Submit"),
action_demo
)
# Reactive functions ----
server = function(input, output, session) {
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(input)
resetForm(session)
# thank the user
n_responses <- length(list.files(outputDir))
response <- paste0("Thank you for completing the survey! You are respondant ",
n_responses, ".")
showNotification(response, duration = 0, type = "message")
})
# clear the fields
observeEvent(input$clear, {
resetForm(session)
})
}
shinyApp(ui, server)
解决方案
您可以简化resetForm()
功能代码。updateWidget
Shiny 中的所有函数都只是sendInputMessage()
. 该示例展示了如何遍历所有小部件,检查每个小部件的 id 是否与某个字符串模式匹配,如果匹配,则通过向其发送值来删除设置值character(0)
。
resetForm <- function(session) {
updateTextInput(session, "ID", value = "")
updateDateInput(session, "date_evaluation", value = NA)
for (nm in names(session$input)) {
if (startsWith(nm, "DSF"))
session$sendInputMessage(nm, list(value = character()))
}
}
现在只剩下不接受日期输入的问题NA
(另见这篇文章)。在 öeast 我得到警告Couldn't coerce the
值 argument to a date string with format yyyy-mm-dd
。据我所知,您必须选择一个有效的日期并且dateInput
不知道未选择的状态。
推荐阅读
- aws-api-gateway - 使用 cognito 用户池用户而非 IAM 用户的凭证使用 IAM 授权测试 api 网关
- memory - 内核崩溃跟踪是随机的,并不总是相同的
- .net - 在 Windows Docker 桌面上找不到任何已安装的 .NET Core SDK
- android - JobService 在 Android 上使用 Switch 小部件触发通知
- css - 未应用 CSS 中的媒体查询
- c++ - 如何在 C++ 中创建递归嵌套哈希图?
- javascript - JSON - 从父对象中删除过滤的项目
- node.js - 如果条件 PostgreSQL,则在多个表上插入
- avro - 如何在 avro 名称中添加特殊字符
- java - 我的 java 图形项目中缺少库