ShinyR: неожиданный результат при экспорте входных данных - PullRequest
0 голосов
/ 17 марта 2019

после этого сообщения: ( 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
})
  })
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...