I am trying to built an async app using shiny and ran into a problem. Sometimes when starting the app, an error message appears in the console: "later: exception occured while executing callback: Evaluation error: object of type 'closure' is not subsettable.". The app runs as expected even when the message appears. My best guess is that it is some sort of race problem since it only appears about 50% of the times I start the app. Thank you very much for your help and insights! Also, if you detect any other problems with my shiny implementation, feel free to let me know!
```
library(shiny)
library(promises)
library(future)
library(tidyverse)
library(glue)
plan(multisession) # plan(multicore) -> forking (not Windows/RStudio)
scopes_ui <- c('a', 'b', 'c')
ui <- function(){
tagList(
# numeric input for the first promise
numericInput(inputId = 'num1',
label = 'Choose your first number: ',
value = 0,
min = 0,
max = 10),
# numeric input for the second promise which relies on the first promise
numericInput(inputId = 'num2',
label = 'Choose your second number: ',
value = 3,
min = 0,
max = 10),
# input to test additional filter options
selectInput('ui_scope',
label = 'Choose scope: ',
scopes_ui,
selected = 'a'),
# this will receive the output of the future
h2('1. Table'),
tableOutput('res1'),
h2('2. Table'),
tableOutput('res2'),
# this plot will be drawn before the future is resolved
plotOutput('plot_inst'),
)
}
server <- function(input, output, session) {
# empty list sufficient (no need to actually initiate with NULLs)
rv <- reactiveValues(
last_id1 = NULL,
res1 = NULL,
res1_id = NULL,
value1 = NULL,
scope = NULL,
last_id2 = NULL,
value2 = NULL,
res2 = NULL
)
# ~~~~~~~~~~~~~~~~~~~~ #
# First promise #
# ~~~~~~~~~~~~~~~~~~~~ #
observe({
# initiate reactive variables BEFORE the promise
rv$last_id1 <- glue('ID_{input$num1}')
last_id1 <- rv$last_id1
rv$value1 <- input$num1
value1 <- rv$value1
rv$scope <- input$ui_scope
scope <- rv$scope
# promise
future_promise({
# make computation expensive
if(value1 %% 2 == 0) {
Sys.sleep(10)
}
data <- data.frame(treat = c('a', 'b', 'c'), outcome = c(value1, 1.9, 3.2))
data <- data %>% filter(treat == scope)
# return id and data from the future
list(
id = last_id1,
res = data
)
}) %...>%
(function(result){
# change value1 of `rv$res1` only if the current id is the same as the last_id
if (result$id == rv$last_id1){
rv$res1_id <- result$id
rv$res1 <- result$res
}
})
# this must return something (including "empty") to execute asynchronously
return()
}) %>%
bindEvent(input$num1, input$ui_scope)
# ~~~~~~~~~~~~~~~~~~~~ #
# Second promise #
# ~~~~~~~~~~~~~~~~~~~~ #
observe({
# initiate reactive variables BEFORE the promise
rv$last_id2 <- glue('ID_{input$num1}_{input$num2}')
last_id2 <- rv$last_id2
rv$value2 <- input$num2
value2 <- rv$value2
# ensure that rv$res1 is available
data <- req(rv$res1)
# promise
future_promise({
# make computation expensive
Sys.sleep(5)
data[1,2] <- value2
# return id and data from the future
list(
id = last_id2,
res = data
)
}) %...>%
(function(result){
# change value of `rv$res2` only if the current id is the same as last_id2
if (result$id == rv$last_id2){
rv$res2 <- result$res
}
})
# this must return something (including "empty") to execute asynchronously
return()
}) %>%
bindEvent(rv$res1, input$num2)
# output$res1 will be printed whenever rv$res1
# is available, i.e. returned from the future,
# and corresponds to the last input sent.
output$res1 <- renderTable({
req(rv$res1)
})
output$res2 <- renderTable({
req(rv$res2)
})
# output$plot_inst will be drawn immediately
my_plt <- reactive({
data <- data.frame(treat = c('a', 'b', 'c'), outcome = c(1, 2, 3)) %>%
filter(treat == input$ui_scope)
ggplot(data, aes(treat, outcome)) +
geom_col() +
theme(text = element_text(size = 20))
})
output$plot_inst <- renderPlot({
req(my_plt())
})
}
shinyApp(ui, server)
```