R shiny async error later: exception occured while executing callback

Viewed 52

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)
```
0 Answers
Related