将来自多个用户的输入保存到www应用程序文件夹中,以便当新会话开始时会始终更新吗?

时间:2019-03-01 23:59:21

标签: r shiny shiny-server shiny-reactivity

多个用户将使用闪亮的应用程序中的多个输入来更新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)
      }
    )


  }
)

0 个答案:

没有答案