r - SQL数据库发生变化时，如何让renderUI发生变化？

Question

library(shiny)
library(shinyWidgets)
library(miniUI)
library(shinymanager)
library(RMariaDB)
library(DBI)

inactivity <- "function idleTimer() {
var t = setTimeout(logout, 120000);
window.onmousemove = resetTimer; // catches mouse movements
window.onmousedown = resetTimer; // catches mouse movements
window.onclick = resetTimer;     // catches mouse clicks
window.onscroll = resetTimer;    // catches scrolling
window.onkeypress = resetTimer;  //catches keyboard actions

function logout() {
window.close();  //close the window
}

function resetTimer() {
clearTimeout(t);
t = setTimeout(logout, 120000);  // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"

# data.frame with credentials info
credentials <- data.frame(
  user = c("1", "fanny", "victor", "benoit"),
  password = c("1", "azerty", "12345", "azerty"),
   stringsAsFactors = FALSE
)
ui <- secure_app(head_auth = tags$script(inactivity), miniPage( 
  gadgetTitleBar("Welcome!"),
  miniTabstripPanel(
    miniTabPanel("Test", icon = icon("truck"),
                 
                   h2(" "),
                 uiOutput("wq_print"),
                 actionButton("finish", "Finish!", class = "btn btn-primary")#btn btn-primary btn-lg btn-success
                 
    )
    
) ) )

server <- function(input, output,session) {
  
  result_auth <- secure_server(check_credentials = check_credentials(credentials))
  
  output$res_auth <- renderPrint({
    reactiveValuesToList(result_auth)
  })
  id=1
localuserpassword="MYPASSWORD"

con=dbConnect(RMariaDB::MariaDB(), user='USER_NAME', password=localuserpassword, dbname='DBNAME', host='localhost')
query <-  function(...) dbGetQuery(con, ...) 

  wq = data.frame()
  values <- reactiveValues()
  values$df <- data.frame()

   ##### the problem is here -------------------------------------------################

  
   a <- reactive({ paste("SELECT COL1  FROM TABLE where id = ", id, sep="") })
  
   observe({
      wq <- reactive({  query( a() ) })
      
      output$wq_print <- renderUI( { h1(wq()$COL1,align = "center") } )
      
       })
  
   ##### the problem is above-------------------------------------------################
    
  id=1
  localuserpassword <- "MYPASSWORD"
  storiesDb <- dbConnect(RMariaDB::MariaDB(), user='USER_NAME', password=localuserpassword, dbname='DBNAME', host='localhost')
  querysel=paste("select COL1 from TABLE where id ='",id,"'",sep = ''  )
  rs = dbSendQuery(storiesDb,querysel)
  dbClearResult(rs)
  dbDisconnect(storiesDb)
     
  observeEvent(input$finish,{
    confirmSweetAlert(
      session = session,
      inputId = "Confirm",
      type = "question",
      title = "Do you want to confirm?",
      danger_mode = F,
      closeOnClickOutside = T,
      showCloseButton =T
    )
    observeEvent(input$Confirm, {
      if(isTRUE(input$Confirm)){
        Free="Free"
        localuserpassword="MYPASSWORD"
        storiesDb <- dbConnect(RMariaDB::MariaDB(), user='USER_NAME', password=localuserpassword, dbname='DBNAME', host='localhost')
        query = paste("update TABLE set COL1= '",Free,"' where id ='",id,"' ",sep = '')
        rs = dbSendQuery(storiesDb,query)
        }
      
    } )
    
  })
  }
# Run the app ----
shinyApp(ui = ui, server = server)

如何让renderUI随着SQL数据库的变化而变化？正如上面的代码，只有在我重新启动应用程序时才更新，我希望它在有更改时更新。代码问题在我为了方便阅读而划定的“##### ------ 问题在这里”分界内

我相信这个问题的回答将为 R+Shiny 带来很多可能性。

Answer 1

你的代码的问题(除了不可重现 - 请检查 How to make a great R reproducible example )是你的reactives 没有触发，因为他们看到的输入没有改变:

a <- reactive({ paste("SELECT COL1  FROM TABLE where id = ", id, sep="") })

这个 react 将触发一次(当 id 改变时)但永远不会再触发(因为 id 不会改变)。结果:

wq <- reactive({  query( a() ) })

不会触发，因为 a 保持不变。

目前还不清楚您想要实现什么。您是否希望在有新的 id 时触发 renderUI？在这种情况下，您必须使 id 对用户输入或其他内容具有反应性。

如果您希望renderUI 在数据库 更改时触发，您可以使用reactivePoll。 ，这意味着在这种情况下使用。

您可以定义一个相对便宜的 check 函数来查明是否对数据库进行了更改(例如 SELECT COUNT(*) FROM TABLE)。定期调用检查函数(由 intervalMillis 给出)，每当此值更改时调用 valueFunc，您可以在其中进行真正的数据库查询(假定较重关于资源)。

或者，你也可以使用这样的东西:

get_data <- reactive({
 invalidateLater(1000) # tell r to invalidate this input every 1000 millisecs
 # your query
 dbGetQuery(con, "SELECT * FROM TABLE WHERE id = 1")
}) 

但是这会每 n 毫秒查询一次数据库，如果您的查询相当繁重，这可能有点矫枉过正。