Search code examples
rshinytry-catch

using tryCatch/showNotification for RShiny while using functions with internal stop() command


Suppose I have a Rshiny app that takes numericInput via mynum, keeps the entry in a list after pressing go button, undergoes function CheckOdd, form a table resultTable for that number, while keeping the result on a separate table resultHistory.

The function CheckOdd has internal stop() command that returns error message, but if ran inside Shiny environment, it will crash the app.

I want to prevent crashing and display that specific error message instead. While there are many similar questions, I could not find one for Rshiny that

  • defines function at global level, rather than defined in server
  • has stop() command inside that function

How can I write tryCatch/showNotification that it will effectively catch the error without crashing the app, without the separate use of verbatimText?

library(shiny)
library(DT)

CheckOdd <- function(num){
  if(is.na(num)){stop("num is NA")}
  if((num %% 2) == 0){stop("num is even")}
  result <- c(num, num+1, num+3, num+5)
  return(result)
}

ui <- fluidPage(
  column(6,
         numericInput("mynum","Enter Number", value = 4),
         actionButton("go_button", "Assess"),
         hr(),
         tableOutput("resultTable")
  ),
  column(6,
         DT::dataTableOutput("resultHistory")
  )
)

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

  myentry <- eventReactive(input$go_button, {
    list(
      mynum = input$mynum
    )
  })

  myvector <- reactive({
    CheckOdd(myentry()$mynum)
  })


  output$resultTable <- renderTable({
    tbl1 <- data.frame(
      "zero" = myvector()[1],
      "one" = myvector()[2],
      "three" = myvector()[3],
      "five" = myvector()[4]
    )
    tbl1
  })

  history <- reactiveVal(
    data.frame(
      "num" = integer(),
      "plus_one" = integer(),
      "plus_three" = integer(),
      "plus_five" = integer()
    )
  )

  observeEvent(input$go_button, {
    t <- rbind(history(),
               data.frame(
                 "zero" = myvector()[1],
                 "one" = myvector()[2],
                 "three" = myvector()[3],
                 "five" = myvector()[4]
               )
    )
    history(t)
  })

  output$resultHistory <- DT::renderDataTable(DT::datatable({
    history()
  }))
}

shinyApp(ui, server)

Solution

  • I suggest staying specific with individual calls of tryCatch.

    I've done a few things here:

    • added req(.) in a couple of places, it helps enforce reactive dependency requirements so that when something upstream breaks, its "error-state" is back-channeled to dependencies in a smart way;
    • this back-channel error-state is created here using validate(need(cond, text)); normally the cond would be inherits(res, "error"), but unfortunately the conditionMessage(res) is always called, and this fails when res is not an error ... so we take a little care to only call validate(need(...)) when we know it'll be a problem
    server <- function(input, output, session) {
    
      myentry <- eventReactive(input$go_button, {
        list(
          mynum = input$mynum
        )
      })
    
      myvector <- reactive({
        mye <- req(myentry())
        res <- tryCatch(
          CheckOdd(mye$mynum),
          error = function(e) e)
        if (inherits(res, "error")) {
          validate(
            need(FALSE, paste("ERROR:", conditionMessage(res)))
          )
        }
        res
      })
    
    
      output$resultTable <- renderTable({
        vec <- req(myvector())
        tbl1 <- data.frame(
          "zero" = vec[1],
          "one" = vec[2],
          "three" = vec[3],
          "five" = vec[4]
        )
        tbl1
      })
    
      history <- reactiveVal(
        data.frame(
          "num" = integer(),
          "plus_one" = integer(),
          "plus_three" = integer(),
          "plus_five" = integer()
        )
      )
    
      observeEvent(input$go_button, {
        vec <- req(myvector())
        t <- rbind(history(),
                   data.frame(
                     "zero" = vec[1],
                     "one" = vec[2],
                     "three" = vec[3],
                     "five" = vec[4]
                   )
        )
        history(t)
      })
    
      output$resultHistory <- DT::renderDataTable(DT::datatable({
        history()
      }))
    }
    

    When this works, the resultTable shows the one row just fine; when there's an error, it presents ERROR: error message ....

    shiny with validation error message