根据 textInput Box 的值从数据表中删除一条记录

Question

如何使用操作按钮删除记录？ 如果我对要删除的内容进行硬编码，则删除操作按钮会正确执行命令，但如果我想通过指向“delete2”文本输入框来动态删除，它会变灰。 例如，如果我想删除测试表中值为 100 的记录，我想在“delete2”框中键入 100 值，当单击操作按钮时，它将执行命令并删除记录。

目前，当我在删除语句中键入 100 值时，该按钮起作用，但直到我下次打开应用程序时它才会刷新表。 总而言之，假设我想从 100 的“value1”中删除一条记录，如何动态删除它并刷新数据表？ 希望是明确的。 以下是我尝试过的：

library(shiny)
library(RSQLite)

ui = fluidPage(
    shinyUI(fluidPage(
      titlePanel("Enter Data into SQLite"),
      sidebarLayout(
        sidebarPanel(
    textInput("value1", label = "Value 1"),
    textInput("value2", label = "Value 2"),
    
    dateInput("SampleDate", label = "Today",value = ""),  
    actionButton("action", label = "Write to DB"),
    actionButton("delete", label = "Delete Records"),
    textInput("delete2", label = "delete these records"),#type record number to be deleted
    
        ),
    mainPanel(
      dataTableOutput("table")
  )
      )
    )))
  
  server = function(input, output,session){
    session$onSessionEnded(function() {
      stopApp()
    }) 
    
    data <- eventReactive(input$action, {
      con <- dbConnect(SQLite(), dbname="sample.sqlite",extended_types=TRUE) 
     dbWriteTable(con, "testing", data.frame(value1 = input$value1, value2 = input$value2, 
                          SampleDate = input$SampleDate, stringsAsFactors = FALSE), append = TRUE)
      
      data <- dbReadTable(con, "testing")
      dbDisconnect(con)
      #Clear form fields to enter more data
      updateTextInput(session, "value1", "value 1", value="")
      updateTextInput(session, "value2", "value 2", value="")
      updateDateInput(session = session, inputId = "SampleDate", value = NA)  
      return(data)
    })
    
  output$table <- renderDataTable(data())

   #Everything above works as expected but the code below to delete the record is not working   
  
   observeEvent(input$delete, {
    con <- dbConnect(SQLite(), dbname="sample.sqlite",extended_types=TRUE) 
    dbExecute(con,"DELETE from testing WHERE value1 = input$delete2") 
    dbDisconnect(con)
  })
  output$table <- renderDataTable(data()) #datatable is not refreshing
  
    
  } 
  shinyApp(ui = ui, server = server)

Answer 1

实现所需结果的一种选择是将eventReactive的“阅读”部分移动到reactive式中，这对input$action和input$delete都具有反应性，即如果单击任一按钮，它就会更新。 这样做之后，您可以将eventReactive替换为现在只执行写入部分的observeEvent 。

另外我做了两个调整。 首先，我通过添加代码来创建示例数据库，使您的示例可重现。 其次，为一项操作连接和断开与数据库的连接不是最佳实践。 相反，我使用pool包，它在应用程序启动时连接到数据库一次，并在完成时断开连接。 第三，我使用今天的日期作为DateInput的默认值，因为使用""会引发警告。

library(shiny)
library(RSQLite)
library(DBI)

pool <- pool::dbPool(RSQLite::SQLite(), dbname = "sample.sqlite", extended_types = TRUE)

# Create sql lite df
sample_df <- data.frame(
  value1 = numeric(),
  value2 = numeric(),
  SampleDate = as.Date(x = integer(0), origin = "1970-01-01")
)

# Create responses table in sql database
dbWriteTable(pool, "sample_df", sample_df, overwrite = FALSE, append = TRUE)

ui <- fluidPage(
  shinyUI(fluidPage(
    titlePanel("Enter Data into SQLite"),
    sidebarLayout(
      sidebarPanel(
        textInput("value1", label = "Value 1"),
        textInput("value2", label = "Value 2"),
        dateInput("SampleDate", label = "Today", value = Sys.Date()),
        actionButton("action", label = "Write to DB"),
        actionButton("delete", label = "Delete Records"),
        textInput("delete2", label = "delete these records"), # type record number to be deleted
      ),
      mainPanel(
        dataTableOutput("table")
      )
    )
  ))
)

server <- function(input, output, session) {
  session$onSessionEnded(function() {
    stopApp()
  })

  data <- reactive({
    input$action
    input$delete

    dbReadTable(pool, "testing")
  })

  observeEvent(input$action, {
    dbWriteTable(pool, "testing", data.frame(
      value1 = input$value1, value2 = input$value2,
      SampleDate = as.Date(input$SampleDate), stringsAsFactors = FALSE
    ), append = TRUE)

    updateTextInput(session, "value1", "value 1", value = "")
    updateTextInput(session, "value2", "value 2", value = "")
    updateDateInput(session = session, inputId = "SampleDate", value = Sys.Date())
  })

  observeEvent(input$delete, {
    dbExecute(pool, paste("DELETE from testing WHERE value1 = ", input$delete2))
    
    updateTextInput(session, "delete2", value = "")
  })

  output$table <- renderDataTable(data())
}

shinyApp(ui = ui, server = server)