How to run parallel SQL within a reactive in Shiny - r

Question

Background: I have a Shiny app that generates one dataframe by merging the results of several SQL queries from different databases into one dataframe.
Each SQL query is held within a function and all of the functions run once a button is pressed.
The problem: Two of the queries take a while to run but because Shiny is the way it is, they run in serial whereas I suppose it would be a lot faster to get them to run in parallel.
Attempts: I tried firstly to get each query to run asynchronously but apparently that is really for scaling an application between users rather than within session asynchronous so I've ditched that approach and tried to use parallel processing with doParallel.
I started by using the parallel processing within each function but of course that is pointless because the parallel processing doesn't chop up a SQL query and run each separately, so then I thought I should add all the functions to a list and run them with a parallel processing.
library(shiny)
library(doParallel)
library(dplyr)
PendingApptdf<-reactiveValues(data = data.frame()) #dataframe for the pending data
myResdf<-reactiveValues(data = data.frame()) #Results dataframe
LatestResultsdf<-reactiveValues(data = data.frame()) #Final dataframe
ui.R
ui <- fluidPage(
titlePanel("Parallel SQL attempt"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
actionBttn("LatestResults_btn",label = "Latest results",size="sm"),
DT::dataTableOutput("LatestResultsTable")
)
)
)
server.R
server <- function(input, output) {
#SQL number one:
PatientPendingAppt<-function(HospNums){
ch_PAD_PendingAppt<-odbcDriverConnect("DRIVER={*******};*******;Database=******")
sql_PAD_PendingAppt<-paste0("SELECT * from database",HospNums)
resultsetPAD_PendingAppt <- sqlQuery(ch_PAD_PendingAppt, sql_PAD_PendingAppt)
resultsetPAD_PendingAppt<-unique(resultsetPAD_PendingAppt)
odbcClose(ch_PAD_PendingAppt)
return(resultsetPAD_PendingAppt)
}
#SQL number two:
myRes<-function(HospNums){
ch_PAD_myRes<-odbcDriverConnect("DRIVER={*******};*******;Database=******")
sql_PAD_myRes<-paste0("SELECT * from database2",HospNums)
resultsetmyRes <- sqlQuery(ch_PAD_myRes, sql_PAD_myRes)
resultsetPAD_myRes<-unique(resultsetPAD_myRes)
odbcClose(ch_PAD_myRes)
return(resultsetPAD_myRes)
}
PendingAppt<-reactive({
myNumber<- '123456'
Pending<-PatientPendingAppt(myNumber)
PendingApptdf$data<-Pending
})
myResOP<-reactive({
myNumber<- '123456'
myResOP1<-myRes(myNumber)
myResdf$data<-myResOP1
})
####Latest results datatable####
output$LatestResultsTable = DT::renderDT({
outputPar <- foreach(i = 1:2, .packages="RODBC")%dopar%{
PendingAppt()
mergedEnoting<-mergedEnoting()
#merge the results here with rbind
}
LatestResultsdf<-outputPar
datatable(LatestResultsdf$data,
options = list(
dom = 't'),
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
But this doesn't seem to work either and it tells me that it can't find the function PendingAppt.
Why is this? Is it because it is a reactive being run inside of the parallel processing. If so then how to rectify?
How can I run the two SQL functions so that they run concurrently rather than in serial?

Answer 1

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 :