将删除和编辑按钮添加到在Shiny中创建DT：dataTable的表单中

Question

我使用应用程序服务器部分中的不同输入以闪亮的形式创建了一个表单。 我现在正尝试在表单中添加两个按钮，但是还没有找到正确的方法。 我需要一个按钮，该按钮允许用户编辑表上的选定条目，另一个按钮允许用户从表中删除选定的条目，当然，一旦完成，就需要更新数据表。

这是一个可重现的示例。 我将主要通过一些修改来访问此示例https://deanattali.com/2015/06/14/mimicking-google-form-shiny/

我的应用程式码：

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)
      }
    )


  }
)

我为“编辑”和“删除”添加了动作链接按钮，但在编程方面需要一些帮助。

谢谢，

Answer 1

欢迎堆栈溢出。 进行一些反应式编程会很有帮助。 此处定义了全局df来保存原始数据帧。

当按下submit或delete时， submit修改此数据框。

同样，当按下按钮时，下载处理程序也会更新。

library(shiny)
library(tidyverse)
library(shinyWidgets)

# Define the fields we want to save from the form
fields <- c("q1", "q2", "q3", "q4", "q5", "q6")


# Shiny app with 3 fields that the user can submit data for
shinyApp(
  ui = fluidPage(

    tags$br(),
    dropdown(

      textInput("Q1", "...", ""),
      textInput("Q2", "...", ""),
      textInput("Q3", "...", ""),
      textInput("Q4", "...", ""),
      textInput("Q5", "...", ""),
      textInput("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) {

    #initialiez a dataframe
    df = data.frame(Q1 = character(0),
                    Q2 = character(0),
                    Q3 = character(0),
                    Q4 = character(0),
                    Q5 = character(0),
                    Q6 = character(0))


    #Modify the dataframe when submit is clicked
    observeEvent(input$submit,{
      data = data.frame(Q1 = input$Q1,
                        Q2 = input$Q2,
                        Q3 = input$Q3,
                        Q4 = input$Q4,
                        Q5 = input$Q5,
                        Q6 = input$Q6)

      df <<-  rbind(df,data)
    })

    #Delete a row when clicked
    observeEvent(input$deleteRow,{

      df <<- df%>%
        filter(row_number() < nrow(.))
    })

    # Show the previous responses
    # (update with current response when Submit is clicked)
    output$responses <- DT::renderDataTable({
      #simply to induce reactivity
      input$submit
      input$deleteRow

      return(df)
    }) 

    #Update the download handler then submit is clicked
    observe({
      input$submit
      input$deleteRow
      # Downloadable csv of selected dataset ----
      output$downloadData <- downloadHandler(
        filename = function() {
          paste("questionnaire", ".csv", sep = "")
        },
        content = function(file) {
          write.csv(df, file, row.names = FALSE)
        }
      )

    })
  }
)