无法通过 actionButton() 在 Shiny + RMySQL 中更新 SQL 数据

Cannot Update SQL data in Shiny + RMySQL by actionButton()

我正在尝试在 Shiny 中构建一个表单,让我的同事在 MySQL 中维护数据。

我的 RMySQL 可以用,我可以用 dbSendQuery(MySQLCon, Query), 但是如果我想使用 actionButton()UPDATE TableName SET Colname = 'Value' WHERE ID = 'ID' 信息到数据库, 不能用,也没有提示。

如果我直接执行 UpdateMySQL(DataTableName, "DayBir", "1989/06/04", "A001"),mysql 将更新,但它会有一个 warning : "Closing open result sets"

请您帮我确认是否有任何反应式表达是非法的?

代码ui.R:

# define UI
shinyUI(bootstrapPage(
  # I add some js and css here for login mechanism by https://gist.github.com/withr/9001831
  # so if I want to use observe()
  # I should put observe() in the observe() which for login
  # and it will report error

  title = "Shiny Demo",

  # mainPanel
  uiOutput("MainUI")
))

server.R中的代码:

# Load Data loading R
library(RMySQL)

MySQLCon = dbConnect(MySQL(),
                 host = "localhost",
                 db = "DB",
                 user = "Usr",
                 password = "PW")
DataTableName = "Data"

DataInput = dbReadTable(MySQLCon, DataTableName)

# turn off connection
Allcons = dbListConnections(MySQL())
for (MySQLCon in Allcons) {
  dbDisconnect(MySQLCon)
}

UpdateMySQL = function(DataTableName, ColName, UpdateValue, UpdateIDSubj) {
  library(RMySQL)
  MySQLCon = dbConnect(MySQL(),
                   host = "localhost",
                   db = "DB",
                   user = "Usr",
                   password = "PW")
  Query = paste('UPDATE', DataTableName, ' ', # name of table in db
                  'SET', ColName, '="', UpdateValue, '" ', 
                  'WHERE IDSubj ="', UpdateIDSubj, '";', sep = "")
  dbSendQuery(MySQLCon, Query)

  # turn off connection
  Allcons = dbListConnections(MySQL())
  for (MySQLCon in Allcons) {
    dbDisconnect(MySQLCon)
  }
}

shinyServer(function(input, output) {
  # Authenticate
  observe({
    if (USER$Logged == TRUE) {
      # KeyIn UI
      source("./KeyIn/KeyIn.R",  local = TRUE, encodin = "utf-8")

      # main
      output$MainUI = renderUI({
        mainPanel(
          tabsetPanel(id = 'TabSet',
            tabPanel(title = "Key In Data",
              numericInput("KeyInChoice", "Choice Row You Want", value = 1,
                min = 1, max = dim(DataInput)[1], step = 1),
              uiOutput("KeyIn")),,
            tabPanel(title = "Raw Data",
              dataTableOutput("TableInput"))
          )
        )
      })

      output$TableInput = renderDataTable({
          DataInput
        }, option = list(orderClasses = TRUE))

    } # else show nothing
  })
})

代码在KeyIn.R

output$ApplyKeyIn = renderUI({
  fluidPage(
    fluidRow(
      column(width = 3,
        # Subj ID
        textInput("IDSubj", "Subj ID",
                value = reactive({
                       if (is.null(input$KeyInChoice)) {
                       return("NULL")
                        } else {
                      return(isolate({ DataInput$IDSubj[input$KeyInChoice] })) }
                     })())
      ),
      column(width = 3,
        # Birthday
        dateInput("DayBir", "Birthday",
                    value = reactive({
                               if (is.null(input$KeyInChoice)) {
                       return("NULL")
                        } else {
                      return(isolate({ DataInput$DayBir[input$KeyInChoice] })) }
                         })(),
                    max = DateNow, format = "yyyy/mm/dd", language = "zh-TW")
      )
    ),
    fluidRow(
      column(width = 12,
        # Send
        actionButton("KeyInSend", "Send")
      )
    )
  )
})

# listening to edit data
KeyInUpdate = reactive({
  if (input$KeyInSend == 0) {
    return()
  }

  input$KeyInSend

  isolate({
    IDSubj = input$IDSubj
    DayBir = input$DayBir
    UpdateMySQL(DataTableName, "DayBir", DayBir, IDSubj)
  })
})

我在更新 API 的数据时遇到了类似的问题。

我的解决方法是使用 reactiveValues() 和 eventReactive() 函数。

x <- reactiveValues()
y <- eventReactive(x) {<code>}

我的结果是,每次在代码中的任何地方更新 x 时,y 也会随着新的 x 传递给它而改变。