Good morning! This is a fun one (I hope).
I have a complex application that has numerous nested R6 objects. I have been using a method of creating a reactive aware R6 object at the center of the app to better control reactivity. My initial tests have been looking great!
Next, I'm I am to integrate promises/futures into the application to improve the user experience while waiting on the data to download and process. I'm struggling to find a pattern that allows the R parent session to actually be available while the future is processing the data. I built a repex that (I think?) is checking if the main R session is available/free while the future is processing the data. The steps are as follows.
Step 1 - Click the 'Get Data' button - To start the future and promises, then trigger the reactives in the R6 Object
Step 2 - Click the 'Is Session Free' button to see when the session isn't busy.
The message 'Free @ ... ' should appear before 'dataX is rendered @ ...'. This is telling me that shiny is still waiting on the future to finish before the user can move on.
Could someone please help me find a pattern that fits my objectives?
library(shiny)
library(tidyverse)
library(R6)
library(promises)
library(future)
reactiveTrigger <- function() {
counter <- reactiveVal( 0)
list(
depend = function() {
counter()
invisible()
},
trigger = function() {
counter( isolate(counter()) + 1 )
}
)
}
rxR6 <- R6::R6Class(classname = 'rxR6',
public = list(
initialize = function(reactive = FALSE) {
private$data1 = 0
private$rxTrigger1 = reactiveTrigger()
private$rxTrigger2 = reactiveTrigger()
},
downloadData = function() {
private$data1 <- future({
Sys.sleep(5)
mtcars
})
private$data2 <- private$data1 %...>% filter(cyl == '6')
private$rxTrigger1$trigger()
private$rxTrigger2$trigger()
},
getData1 = function(){
private$rxTrigger1$depend()
return(private$data1)
},
getData2 = function(){
private$rxTrigger2$depend()
return(private$data2)
},
show_notification = function(msg) {
showNotification(ui = msg)
}
),
private = list(
data1 = NULL,
data2 = NULL,
rxTrigger1 = NULL,
rxTrigger2 = NULL
)
)
ui <- fluidPage(
actionButton("get.data", "Get Data"),
actionButton("is.session.free", "Is Session Free?"),
fluidPage(
tableOutput("data1"),
tableOutput("data2")
)
)
server <- function(input, output, session) {
x <- rxR6$new()
observeEvent(input$is.session.free, {
message('Free @ ', Sys.time())
}, ignoreInit = F, ignoreNULL = T)
observeEvent(input$get.data, {
message('download @ ', Sys.time())
x$downloadData()
}, ignoreInit = F, ignoreNULL = T)
output$data1 <- renderTable({
message('data1 rendered @ ', Sys.time())
req(is.promising(x$getData1()))
x$getData1() %...>% select(cyl, mpg)
})
output$data2 <- renderTable({
message('data2 rendered @ ', Sys.time())
req(is.promising(x$getData2()))
x$getData2() %...>% select(cyl, mpg)
})
}
shinyApp(ui, server)