How to make renderUI change when the SQL database changes?

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)

How to make renderUI change when the SQL database changes? As the code is above, only update if I restart the app and I would like it to update whenever there is a change. The code problem is found inside the "##### ------ the problem is here" demarcation that I made for easier reading

I believe that this question answered would open up a lot of possibilities for R+Shiny.

thothal · Accepted Answer · 2020-08-04T07:11:48.913

The problem with your code (besides being not reproducible - please check How to make a great R reproducible example) is that you reactives are not firing because the input they see does not change:

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

This reactive will fire once (when id changes) but never again (as id does not change). As a consequence:

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

will not fire, because a remains constant.

It is not quiet clear what you want to achieve. Do you want that the renderUI fires whenever there is a new id? In this case you have to make id reactive on a user input or whatever.

If you want renderUI to fire whenever the databases changes, you can use reactivePoll, which is meant to be used in such cases.

You would define a relatively cheap check function to find out whether a change was made to the database (e.g. SELECT COUNT(*) FROM TABLE). The check function is called periodically (as given by intervalMillis) and whenever this value changes the valueFunc is called, where you do your real database query (which is assumed to be heavier on resources).

Alternatively, you could use also something like this:

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

But this would query the database every n milliseconds and this may be an overkill if your query is rather heavy.

How to make renderUI change when the SQL database changes?

1 Answers1