Question

在这篇文章之后：（ShinyR : Insert user inputs in a database for further use），我发现了一个解决问题的方法，这一启发性很强的应用（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
})
  })

ShinyR：导出输入时出现意外结果

0 个答案: