Добавьте кнопки «Удалить» и «Редактировать» в форму, которая создает DT: dataTable в Shiny

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


  }
)

Я добавил кнопки actionlink для редактирования и удаления, но мне нужна помощь с программной сторонывещи на сервере.

Спасибо,

Answer 1

Добро пожаловать в переполнение стека.Было бы полезно пройти через некоторое реактивное программирование.Здесь глобальный df определен для хранения исходного фрейма данных.

Этот фрейм данных изменяется при нажатии submit или delete.

Аналогично, обработчик загрузки обновляется, когда кнопкинажаты.

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

    })
  }
)