после этого сообщения: ( ShinyR: вставьте пользовательские данные в базу данных для дальнейшего использования ), я нашел решение своей проблемы, вдохновленное этим блестящим приложением (https://deanattali.com/2015/06/14/mimicking-google-form-shiny/).
Мне удалось получить основной результат, который я хотел (база данных, объединяющая мои наблюдения и результаты пользователя приложения). Тем не менее, теперь у меня есть два новых вопроса:
Во-первых, как это возможно, если смотреть намой код (полная версия в конце поста). Вот строки серверной части кода, используемые для извлечения входных данных. Создаются две переменные
- Udata только с входными данными изПользователь, который должен быть сохранен как один файл (% s_% s.csv).
- Mdata, который является комбинацией входных данных (Udata) и базы данных (DB_Nonames), также должен быть сохранен какодин файл (% s_% s_Merged.csv).
Здесь возникает проблема: сохраняется только один файл (% s_% s.csv), НО он состоит не только из входных данных изпользователь (Udata), но также и полныйэлектронная база данных (DB_Nonames).Сообщение об ошибке состоит в том, что "аргумент" Mdata "отсутствует, без значения по умолчанию" , как будто его не существует, однако кажется, что каким-то образом Udata был объединен с базой данных, хотя он по-прежнему называется Udata (хотяэто не значит, что).
formData <- reactive({
Udata <- sapply(fieldsAll, function(x) input[[x]]) #fieldsAll is an array with all the fields completed by the user
Udata <- c(Udata, PSS = (input$SSS/input$SBL)) #Test to see if I can add a new field using inputs
Udata <- t(Udata) #transposition to get a line
Mdata <- rbind(DB_NoNames,Udata) #Merge of my database and the inputs from the user
})
saveData <- function(Udata,Mdata) {
fileName <- sprintf("%s_%s.csv", #First a .csv file with only the inputs from the user
humanTime(),
digest::digest(Udata)) #To get a unique fileName for each user using time of submit and values of the inputs
fileName2 <- sprintf("%s_%s_Merged.csv", #Second a .csv file with the database + the inputs
humanTime(),
digest::digest(Udata))
write.csv(x = Udata, file = file.path(responsesDir, fileName),
row.names = c(indnames))
write.csv(x = Mdata, file = file.path(responsesDir, fileName2),
row.names = c(indnames))
}
Во-вторых, после понимания этого колдовства, как это можно исправить?
Большое спасибо всем, если я не уверен, пожалуйста, дайте мне знатьи я попробую другое объяснение.
Вот полный код (большая его часть взята из https://deanattali.com/2015/06/14/mimicking-google-form-shiny/, как подробные объяснения)
#############################################
DB <- read.csv2("~/filepath/DB.csv", row.names = 1, sep=",", dec=".")
DB_NoNames <- DB
rownames(DB_NoNames) <- NULL
indnames <- c(rownames(DB),"USER")
fieldsMandatory <- c("SBL", "SSS")
labelMandatory <- function(label) {
tagList(label, span("*", class = "mandatory_star")
)}
appCSS <- ".mandatory_star { color: red; }
#error { color: red; }"
fieldsAll <- c("AGE", "SBL", "SSS")
responsesDir <- file.path("~/filepath/responses")
responsesDBDir <- file.path("~/filepath/ResponsesAndDb")
epochTime <- function() {
as.integer(Sys.time())
}
humanTime <- function() format(Sys.time(), "%Y%m%d-%H%M%OS")
loadData <- function() {
files <- list.files(file.path(responsesDir), full.names = TRUE)
data <- lapply(files, read.csv, stringsAsFactors = FALSE)
data <- dplyr::rbind_all(data)
data
}
adminUsers <- c("admin")
#############################################
shinyApp(
#############################################
ui = fluidPage(
shinyjs::useShinyjs(),
shinyjs::inlineCSS(appCSS),
titlePanel("Users'data"),
uiOutput("adminPanelContainer"),
div(
id = "form",
numericInput("AGE", "Age de la ferme", value = 1, min=0),
numericInput("SBL", labelMandatory("Surface brute en légumes (ha)"), value = 1, min=0),
numericInput("SSS", labelMandatory("Surface sous serre (ha)"), value = 0.3, min=0),
actionButton("submit", "Valider", 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("Merci, vos données ont été enregistrées avec succès. Vous pouvez maintenant utiliser l'outil ou enregistrer de nouvelles données"),
actionLink("submit_another", "Enregistrer de nouvelles données")
)
)
),
#############################################
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({
Udata <- sapply(fieldsAll, function(x) input[[x]])
Udata <- c(Udata, PSS = (input$SSS/input$SBL))
Udata <- t(Udata)
Mdata <- rbind(DB_NoNames,Udata)
})
saveData <- function(Udata,Mdata) {
fileName <- sprintf("%s_%s.csv",
humanTime(),
digest::digest(Udata))
fileName2 <- sprintf("%s_%s_Merged.csv",
humanTime(),
digest::digest(Udata))
write.csv(x = Udata, file = file.path(responsesDir, fileName),
row.names = c(indnames))
# write.csv(x = Mdata, file = file.path(responsesDir, fileName2),
# row.names = c(indnames))
}
# action to take when submit button is pressed
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$responsesTable <- DT::renderDataTable(
loadData(),
rownames = FALSE,
options = list(searching = FALSE, lengthChange = FALSE)
)
output$downloadBtn <- downloadHandler(
filename = function() {
sprintf("mimic-google-form_%s.csv", humanTime())
},
content = function(file) {
write.csv(loadData(), file, row.names = FALSE)
}
)
output$adminPanelContainer <- renderUI({
if (!isAdmin()) return()
wellPanel(
h2("Previous responses (only visible to admins)"),
downloadButton("downloadBtn", "Download responses"), br(), br(),
DT::dataTableOutput("responsesTable")
)
})
isAdmin <- reactive({
is.null(session$user) || session$user %in% adminUsers
})
})