r - 带下一个按钮的闪亮调查并保存数据
问题描述
我有一系列闪亮的调查，我想将它们合并在一起并用每个部分的下一个按钮和最后的提交按钮分开。我正在努力使用下一个按钮，我还可以确保在调查结束时将每个参与者信息的信息保存到 csv 文件中。我已经粘贴了我为两个现有的单独调查所拥有的代码示例。理想情况下，我想将单独代码中的问题保留为单独的页面。非常感谢您的帮助！
一项示例调查：
#srt delayed
library(shiny)
library(ggplot2)
library(tidyverse)
library(dplyr)
library(shinydashboard)
outputDir <- "responses"
# Define the fields we want to save from the form
fields <- c("Participant_ID",
"srt_delay_recall_bl",
"srt_delay_recognition_bl")
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.csv",
as.integer(Sys.time()),
digest::digest(data))
# Write the file to the local system
write.csv(
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) read.csv(x))
# Concatenate all data together into one data.frame
data <- do.call(rbind, data)
}
data
}
# Define questions
#participant id
Participant_ID <- textInput("Participant_ID", "Please enter participant ID number")
srt_delay_recall_bl <- selectInput(
"srt_delay_recall_bl", "SRT delayed recall",
c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12"))
srt_delay_recognition_bl <- selectInput(
"srt_delay_recognition_bl", "SRT delayed recognition",
c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12"))
actionButton("button1", "Next")
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, "Participant_ID", value = "")
for (nm in names(session$input)) {
if (startsWith(nm, "srt"))
session$sendInputMessage(nm, list(value = character()))
}
}
# 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("SRT Delayed Recall"),
p("Please fill in all values"),
fluidRow(
column(width=6, Participant_ID,
),
column(width=6, srt_delay_recall_bl,
srt_delay_recognition_bl)),
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)
想在下面的代码中与第二次调查合并：
#digit symbol
library(shiny)
library(ggplot2)
library(tidyverse)
library(dplyr)
library(shinydashboard)
outputDir <- "responses"
# Define the fields we want to save from the form
fields <- c("Participant_ID",
"SDMFIN_bl",
"SDMTR_bl",
"SDMER_bl",
"SDMCR_bl")
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.csv",
as.integer(Sys.time()),
digest::digest(data))
# Write the file to the local system
write.csv(
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) read.csv(x))
# Concatenate all data together into one data.frame
data <- do.call(rbind, data)
}
data
}
# Define questions
#participant id
Participant_ID <- textInput("Participant_ID", "Please enter participant ID number")
SDMFIN_bl <- selectInput(
"SDMFIN_bl", "Time to finish Digit Symbol in seconds",
c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18",
"19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34",
"35", "36", "37", "38", "39", "40", "41","42", "43", "44", "45", "46", "47", "48",
"49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63",
"64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82",
"83", "84", "85", "86", "87", "88", "89", "90"))
SDMTR_bl <- selectInput(
"SDMTR_bl", "Total Responses",
c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18",
"19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34",
"35", "36", "37", "38", "39", "40", "41","42", "43", "44", "45", "46", "47", "48",
"49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63",
"64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82",
"83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106", "107", "108",
"109", "110", "111", "112", "113", "114", "115"))
SDMER_bl <- selectInput(
"SDMER_bl", "Total Errors",
c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18",
"19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34",
"35", "36", "37", "38", "39", "40", "41","42", "43", "44", "45", "46", "47", "48",
"49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63",
"64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82",
"83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106", "107", "108",
"109", "110", "111", "112", "113", "114", "115"))
SDMCR_bl <- selectInput(
"SDMCR_bl", "Number of Correct Responses",
c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18",
"19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34",
"35", "36", "37", "38", "39", "40", "41","42", "43", "44", "45", "46", "47", "48",
"49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63",
"64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82",
"83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106", "107", "108",
"109", "110", "111", "112", "113", "114", "115"))
actionButton("button1", "Next")
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, "Participant_ID", value = "")
for (nm in names(session$input)) {
if (startsWith(nm, "SDM"))
session$sendInputMessage(nm, list(value = character()))
}
}
# 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 Symbol"),
p("Please fill in all values"),
fluidRow(
column(width=8, Participant_ID),
column(width=6, SDMFIN_bl,
SDMTR_bl)),
fluidRow(
column(width=6,
SDMER_bl,
SDMCR_bl)),
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)
解决方案
推荐阅读
- javascript - 无法写入 Firebase，没有错误
- php - 带有 ssl、代理配置和 php7.1 的 ngnix 上的 502 Bad Gateway
- android - Android Studio 在构建过程中找不到可绘制对象
- java - Java-8：在文件的 1 行中多次匹配 1 个模式（通过过滤器）
- ios - 设置图像属性时，UIImageView 图像不会明显更新
- python - 使用 rrule 将日期分配给相关月份
- c++ - Opengl：如何正确映射缓冲区？
- javascript - 异步递归在用于轮询 fn 的 Js 代码中是否安全
- java - 如何获取节点的字符串值？
- java - 方法遍历字符串文件并找到匹配的输入答案后退出while循环