R Shiny: удалить строки из данных постоянного хранения данных - PullRequest
Новая
       23

R Shiny: удалить строки из данных постоянного хранения данных

0 голосов
/ 07 сентября 2018

У вас есть предложения по удалению строк из постоянного хранилища данных в приложениях Shiny?

Я использую структуру, похожую на этом сайте: https://shiny.rstudio.com/articles/persistent-data-storage.html#basic.

У меня есть способ добавить кнопку удаления в каждой строке.

Однако я не нашел способа заставить объект, который загружает данные (loadData ()), подвергаться изменениям при рисовании строк.

Спасибо за любую помощь.

Вот код: 

library(shiny)
library(DT)
library(data.table)

# memory
rm(list = ls())

# save a response
saveData <- function(data){

  data <- as.data.frame(t(data))

  if(exists("responses")){
    responses <<- rbind(responses, data)
  } else{
    responses <<- data
  }
}

# load all previous responses
loadData <- function(){
  if(exists("responses")){
    responses
  }
}

# define the fields we want to save from the form
fields <- c("class")

use <- c("Varzea Forest", "Igapo Forest", "Woodlands", "Palm Swamps", 
         "Shrubs", "Herbaceous", "Urban", "Sand Bank", "Bare Rocks", 
         "White Water", "Black Water", "Clear Water")

# shiny app with 1 fields that the user can submit data for
shinyApp(

  ui = fluidPage(

    DT::dataTableOutput("data", width = 300), 
    tags$script("$(document).on('click', '#data button', function () {
                Shiny.onInputChange('lastClickId',this.id);
                Shiny.onInputChange('lastClick', Math.random()) });"),

    selectInput("class", "Class", choices = use),
    actionButton("submit", "Submit")
  ),


  server = function(input, output, session) {

    # field to filled
    data.i <- reactive({
      data <- sapply(fields, function(x) input[[x]])
      data
    })

    # when the submit button is clicked, save the form data
    observeEvent(input$submit, {
      req(input$submit)
      saveData(data.i())
    })

    # Show the previous responses
    vals <- reactiveValues()
    vals$Data <- data.table(class = "White Water")

    output$data <- renderDataTable({
      input$submit

      DT <- rbind(vals$Data, loadData())
      DT[["Actions"]] <- paste0('<div class="btn-group" role="group" aria-label="Basic example">
                                   <button type="button" class="btn btn-secondary delete" id=delete_', 1:nrow(vals$Data), '>Delete</button>
                                   </div>')
      datatable(DT, rownames = FALSE, class = "cell-border stripe", escape = FALSE, 
                options = list(searching = FALSE, pageLength = 8))
    })

    observeEvent(input$lastClick, {
      if(input$lastClickId %like% "delete"){
        row_to_del <- as.numeric(gsub("delete_", "", input$lastClickId))
        vals$Data <- vals$Data[-row_to_del]
      }
    }
    )   
  }
)
...