Несколько пользователей обновят data.frame, используя несколько входов в блестящем приложении.Я хотел бы иметь возможность сохранять каждую новую отправку (или удалять действия) в каталоге www моего блестящего приложения, чтобы data.frame всегда обновлялся каждый раз, когда пользователь начинает новый сеанс.
Каков наилучший способ сделать это?Код приложения указан ниже
library(shiny)
library(tidyverse)
library(shinyWidgets)
# Define the fields we want to save from the form
fields <- c("q1", "q2", "q3", "q4", "q5", "q6")
# Save a response
# This is one of the two functions we will change for every storage type
saveData <- function(data) {
data <- as.data.frame(t(data))
if (exists("responses")) {
responses <<- rbind(responses, data)
} else {
responses <<- data
}
}
# Load all previous responses
# This is one of the two functions we will change for every storage type
loadData <- function() {
if (exists("responses")) {
responses
}
}
# Shiny app with 3 fields that the user can submit data for
shinyApp(
ui = fluidPage(
tags$br(),
dropdown(
htmlOutput("q1"),
htmlOutput("q2"),
htmlOutput("q3"),
htmlOutput("q4"),
htmlOutput("q5"),
htmlOutput("q6"),
actionButton("submit", "Submit"),
actionButton("edit", "Edit"),
style = "unite",
icon = icon("plus"),
status = "danger",
#width = "300px",
size = "m",
label = "Add new Record",
tooltip = TRUE,
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutRightBig
)
),
tags$hr(),
downloadButton("downloadData", "Download"),
actionButton("deleteRow", "Delete Row"),
tags$hr(),
column(width = 12, DT::dataTableOutput("responses", width = '100%'))
),
server = function(input, output, session) {
output$q1 <- renderUI({
textInput("Q1", "...", "")
})
output$q2 <- renderUI({
textInput("Q2", "...", "")
})
output$q3 <- renderUI({
dateInput("Q3", "...")
})
output$q4 <- renderUI({
textAreaInput("Q4", "...")
})
output$q5 <- renderUI({
textAreaInput("Q5", "...")
})
output$q6 <- renderUI({
dateInput("Q6", "...")
})
# Whenever a field is filled, aggregate all form data
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(formData())
})
# Show the previous responses
# (update with current response when Submit is clicked)
output$responses <- DT::renderDataTable({
input$submit
loadData()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste("questionnaire", ".csv", sep = "")
},
content = function(file) {
write.csv(loadData(), file, row.names = FALSE)
}
)
}
)