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

时间:2015-03-23 11:03:23

标签: r shiny rmysql

我正在尝试在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)
  })
})

1 个答案:

答案 0 :(得分:0)

我通过更新API的数据遇到了类似的问题。

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

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

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