Add Delete and Edit Buttons to a form that creates a DT:dataTable in Shiny

Question

I created a form in shiny using different inputs in the server part of the app. I am now trying to add two buttons to the form but haven't found the right way to do it. I need one button that allows the user to edit a selected entry on the table, and another button that allows the user to remove the selected entry from the table, and of course once this is done the datatable needs to be updated.

Here is a reproducible example. I am going of this example mostly with a few modifications https://deanattali.com/2015/06/14/mimicking-google-form-shiny/

My app code:

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


  }
)

I added the actionlink buttons for Edit and Delete but need some help with programmatically side of things in the server.

Thank you,

Answer 1

Welcome to stack overflow. It would be helpful to go over some reactive programming. Here a global df is defined to hold the original dataframe.

This dataframe is modified when submit or delete are pressed.

Similarly the download handler is updated when the buttons are pressed.

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

    })
  }
)