How to Add edit delete of table in shiny app

微笑、不失礼 提交于 2019-12-10 00:47:51

问题


I want to CRUD(Create, read,update and delete) in a table in shiny app. it update and delete perfectly but when I want to add new record it does not show the input from slider when the textinput is filled. Sometimes it only shows the default of sliderInput which is 2 when the value of name is NULL.

ui <- fluidPage(
  #use shiny js to disable the ID field
  shinyjs::useShinyjs(),
  #DT::dataTableOutput("responses"),
  shinyjs::disabled(textInput("id", "Id", "0")),

  textInput("name", "Name", ""),
  checkboxInput("used_shiny", "I've built a Shiny app in R before", FALSE),
  sliderInput("r_num_years", "Number of years using R", 0, 25, 2, ticks = FALSE),

  actionButton("submit", "Submit",icon = icon("plus-circle"),class = "btn-primary"),
  # Delete button 
  actionButton(inputId = "delete", label = "Delete", icon = icon("minus-circle"),class = "btn-primary"),
  #NEW button
  actionButton("new", "Reset",icon = icon("refresh"),class = "btn-primary"),

  box(
    title = "KPIs", status = "primary", solidHeader = TRUE,
    collapsible = TRUE,
    DT::dataTableOutput("responses"), tags$hr()
    )
  )

Methods of Load Data and save data

UpdateInputs <- function(data, session) {
   updateTextInput(session, "id", value = unname(rownames(data)))
   updateTextInput(session, "name", value = unname(data["name"]))
   updateCheckboxInput(session, "used_shiny", value = as.logical(data["used_shiny"]))
   updateSliderInput(session, "r_num_years", value = as.integer(data["r_num_years"]))
 }
 CastData <- function(data) {
   datar <- data.frame(name = data["name"], 
                       used_shiny = as.logical(data["used_shiny"]), 
                       r_num_years = as.integer(data["r_num_years"]),
                       stringsAsFactors = FALSE)

   rownames(datar) <- data["id"]
   return (datar)
 }

 CreateDefaultRecord <- function() {
   mydefault <- CastData(list(id = "0", name = "", used_shiny = FALSE, r_num_years = 2))
   return (mydefault)
 }


 GetNextId <- function() {
   if (exists("responses") && nrow(responses) > 0) {
     max(as.integer(rownames(responses))) + 1
   } else {
     return (1)
   }
 }

 CreateData <- function(data) {

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

 ReadData <- function() {
   if (exists("responses")) {
     responses
   }
 }

 UpdateData <- function(data) {
   data <- CastData(data)
   responses[row.names(responses) == row.names(data), ] <<- data
 }
 DeleteData <- function(data) {
   responses <<- responses[row.names(responses) != unname(data["id"]), ]
 }

 GetTableMetadata <- function() {
   fields <- c(id = "Id", 
               name = "Name", 
               used_shiny = "Used Shiny", 
               r_num_years = "R Years")

   result <- list(fields = fields)
   return (result)
 }

Server.r is as following:

server <- function(input, output, session) {
  # input fields are treated as a group
  formData <- reactive({
    sapply(names(GetTableMetadata()$fields), function(x) input[[x]])
  })

  # Click "Submit" button -> save data
  observeEvent(input$submit, {
    if (input$id != "0") {
      UpdateData(formData())
    } else {
      CreateData(formData())
      UpdateInputs(CreateDefaultRecord(), session)
    }
  }, priority = 1)

  # Press "New" button -> display empty record
  observeEvent(input$new, {
    UpdateInputs(CreateDefaultRecord(), session)
  })

  # Press "Delete" button -> delete from data
  observeEvent(input$delete, {
    DeleteData(formData())
    UpdateInputs(CreateDefaultRecord(), session)
  }, priority = 1)

  # Select row in table -> show details in inputs
  observeEvent(input$responses_rows_selected, {
    if (length(input$responses_rows_selected) > 0) {
      data <- ReadData()[input$responses_rows_selected, ]
      UpdateInputs(data, session)
    }

  })

  # display table
  output$responses <- DT::renderDataTable(server = FALSE, selection = "single",
                                          colnames = unname(GetTableMetadata()$fields)[-1], {
    #update after submit is clicked
    input$submit
    #update after delete is clicked
    input$delete
    ReadData()
  })
}
shinyApp(ui,server)

The Error message that I got is :

Warning in [<-.factor(*tmp*, ri, value = 22L) : invalid factor level, NA generated

来源:https://stackoverflow.com/questions/33820575/how-to-add-edit-delete-of-table-in-shiny-app

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!