0

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)
aiorr
  • 547
  • 4
  • 11
  • The notion of a global exception handler that catches some deeply-nested `stop()` is problematic to begin with, as it can be mis-used, abused, etc, though it exists as [`globalCallingHandlers`](https://stat.ethz.ch/R-manual/R-devel/library/base/html/conditions.html); be careful with it. Having said that, this means that you want to define in the global environment something that will know how to reach inside the reactive nature of a running shiny app and display a modal popup or message to the user ... I suggest it is _far simpler_ to catch errors on known-problematic calls like that one. – r2evans Aug 30 '23 at 20:13

1 Answers1

1

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

r2evans
  • 141,215
  • 6
  • 77
  • 149