How to Make Shiny Reactivity Work with SQL Database

How to make Shiny reactivity work with SQL database?

1. sqlOutput is a function so change it to sqlOutput()

2. Try this, note this will export is as .csv hope its ok

output$download <- downloadHandler(filename = function() {paste(Sys.time(), ' Fltered_data.csv', sep='')}, content = function(file) {write.csv(sqlOutput()[input$table_rows_all, ], file, row.names = FALSE)})

Acessing SQL database using shiny with reactive query

Store your final object in a list you define as:

wq<- reactiveValues()
....
isolate()

I'm working on something similar with updating a model statement with reactively generated interaction terms. I had to use reactiveValues() and isolate() to get it to work. Joe Cheng has an example Gist.

Here's a link. Maybe it will help you.
https://gist.github.com/jcheng5/eaedfed5095d37217fca

Best,
NF

Storing reactive data in shiny from SQL

I think changing

values$df <- reactive({ rbind(values$df, wq() )   }) 

in your new server.R to

observe({
  values$df <- rbind(isolate(values$df), wq())
})

might fix your problem.

EDIT: Here's a working example using a local connection:

library(markdown)
library(RMySQL)
library(DBI)
library(sqldf)

con <- dbConnect(RSQLite::SQLite(), ":memory:")
dbWriteTable(con, "mtcars", mtcars)
query <-  function(...) dbGetQuery(con, ...) 

wq = data.frame()

ui <- shinyUI(fluidPage(
  titlePanel("Generic grapher"),
  sidebarLayout(
    sidebarPanel(

      numericInput("wafer", label = h3("Select number of cylinders:"),
                   value = NULL),

      actionButton("do", "An action button")
    ),

    mainPanel(
      verbatimTextOutput("value"),
      verbatimTextOutput("que"),
      verbatimTextOutput("wq_print"),
      dataTableOutput(outputId="pos")
    )
  )
)
)

server <- shinyServer(function(input, output){

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

  d <- eventReactive(input$do, { input$wafer })

  output$value <- renderPrint({ d() }) 

  a <- reactive({ paste("SELECT * FROM mtcars WHERE cyl = ", d(), sep="") })

  output$que <- renderPrint({ a() }) 

  observe({
    if (!is.null(d())) {
      wq <- reactive({  query( a() ) })

      output$wq_print <- renderPrint({ print(str(wq())) })

      values$df <- rbind(isolate(values$df), wq())
    }
  })

  output$pos <- renderDataTable({ values$df })  

})

shinyApp(ui, server)

The relevant changes to your original code are the !is.null(d()) condition for handling the initial NULL value of d(), and using values$df <- rbind(isolate(values$df), wq()) inside an observer. Hope this helps with fixing your code!

How to run parallel SQL within a reactive in Shiny

You can use futures combined with promises to run the two queries in parallel, see scaling shiny with async.

Under SQL Server I used a WAIT FOR DELAY to simulate two long queries:

library(DBI)
library(shiny)
library(future)
library(promises)
plan(multisession,workers = 2)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Async Test"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            selectInput("choice",
                        "Choice",
                        choice = list('choice 1','choice 2'))
        ),

        # Show a plot of the generated distribution
        mainPanel(
           textOutput("data1"),
           textOutput("data2")
  
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output,session) {

    cat(nbrOfWorkers(),' workers launched \n')
    
    # first query depending on Choice
    data1 <-reactive({
        input$choice
        start <- Sys.time()
        future({
        conn <- dbConnect(***)
        dbGetQuery(conn,("WAITFOR DELAY '00:00:05'"))
        dbDisconnect(conn)
        paste("Result from Task 1 : done in ", round(difftime(Sys.time(),start)), 's')
        }) %...>% print() })
    
    # second query depending on Choice
    data2 <-reactive({
        input$choice
        start <- Sys.time()
        future({
        conn <- Connect(***)  
        dbGetQuery(conn,("WAITFOR DELAY '00:00:10'"))
        dbDisconnect(conn)
        paste("Result from Task 2 : done in ", round(difftime(Sys.time(),start)), 's')
        }) %...>% print() })

    output$data1 <- renderText({ data1()})
    output$data2 <- renderText({ data2()})

}

# Run the application 
shinyApp(ui = ui, server = server)

You can verify that the result of a 5s query and a 10s query is displayed in 10s and not in 15s :

How to insert reactive input values from a shiny app into a MySQL database?

Finally, I could make the query run with this code:

writingMarks <- function(input){ 
    con <- dbConnect(MySQL(), dbname="db", username="myname", password="mypassword", 
           host="myhost.com", port=xxxx)   
    result <- sprintf<-("insert into scenario1 (toss, dec, timestamp) values (%s,%s,%s)",
                input$toss, input$decision, "now()")
    dbSendQuery(con, result)
}

I could not make the paste query run. With sprintf there is less confusion with the commas.

And, yes I indeed had to add an isolate(). I inserted it into an observe(). So it looks like this:

observe({
    if (input$condition==1){
      isolate({
        writingMarks(input)
      })
    }
    return()
  })

how to save a sql database in a real time dataframe? shiny

I think you're probably better off using invalidateLater instead of reactivePoll. The latter is intended to use a

relatively cheap "check" function with a more expensive value retrieval function

In your case, you intend to run your query every 2 seconds, regardless. There is no "check" needed.

Additionally, reactive* functions in shiny tend to be lazy (if nothing depends on it, it will never fire), whereas observe* functions are more greedy (and fire regardless of dependencies).

How about this?

dat <- reactiveValue(NULL)
observe({
  invalidateLater(2000)
  QUERY1 = "SELECT * FROM table"
  ret <- dbGetQuery(storiesDb, QUERY1)
  dat(ret)
})
output$tbl <- renderDataTable({
  dat()
})

You might want to consider only downloading recent data, depending on the schema of that table. For instance, if there is a timestamp (e.g., Created which indicates when the data was inserted into the table), then perhaps you can use something like

dat <- reactiveValue(NULL)
observeEvent(invalidateLater(2000), {
  olddat <- dat()
  latest <- max(c(as.POSIXct("1900-01-01"), olddat$Created), na.rm = TRUE)
  QUERY1 = "SELECT * FROM table t where t.Created > ?"
  newdat <- dbGetQuery(storiesDb, QUERY1, params = list(latest))
  if (NROW(newdat) > 0) {
    newdat <- rbind(olddat, newdat)
    dat(newdat)
  }
})
output$tbl <- renderDataTable({
  dat()
})

Depending on your schema, you may also have a Modified field in the table, where Created indicates when it was first added and Modified indicates when it was last changed. In this case, you'll likely need to check both fields for recency. (Perhaps I'm getting ahead of myself now.)

---

However, you can use reactivePoll to do a "fast" check function and a "slower" value function, perhaps something like:

df <- reactivePoll(2000, session,
  checkFunc = function() {
    dbGetQuery(storiesDb, "select count(*) as n from table")
  },
  valueFunc = function() {
    dbGetQuery(storiesDb, "select * from table")
  }  
})
output$tbl <- renderDataTable({
  df()
})

This idea (of using valueFunc for counting rows) can also be adapted to take advantage of Created and Modified ... in fact, if you have one or both of those fields, most tables will be index/optimized so that querying for the max(Created) is pretty fast. Granted, getting the row-count of a table is often optimized into a near-immediate query, so you might benefit from some internal benchmarking and/or a discussion with your DBA.

R Shiny: Formatting reactive data.frame from sql query

EDIT:

Simply replace this expression:

output$table <- DT::renderDataTable(sqlOutput(), server=TRUE, 
  rownames=TRUE, filter="top", options=list(pageLength=10))

With:

output$table <- DT::renderDataTable({
  intermed <- sqlOutput()
  intermed$HOEHE_TOLP <- as.factor(intermed$HOEHE_TOLP)
  datatable(intermed) %>% formatStyle("RUND2_MITT", color = 'red', 
    backgroundColor = 'lightyellow', fontWeight = 'bold')
}, server=TRUE, rownames=TRUE, filter="top", options=list(pageLength=10))

Here is a self contained example:

library(DT)
library(shiny)

ui <- fluidPage(
  actionButton("inst", "Instigate Reactive"),
  dataTableOutput("test")
)

server <- function(input, output){
  data <- eventReactive(input$inst, {
    iris
  })

  output$test <- renderDataTable({
    set <- data()
    set$Sepal.Length <- as.factor(set$Sepal.Length)
    datatable(set) %>% formatStyle("Petal.Length", color = 'red', 
                                   backgroundColor = 'lightyellow',
                                   fontWeight = 'bold')
  })
}

shinyApp(ui, server)

---

Related Topics