將刪除和編輯按鈕添加到在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)
        }
      )

    })
  }
)