在使用带有内部 stop() 命令的函数时，使用 RShiny 的 tryCatch/showNotification

Question

假设我有一个 Rshiny 应用程序，它通过

mynum

获取数字输入，按下 go 按钮后将条目保留在列表中，执行功能

CheckOdd

，为该数字形成一个表

resultTable

，同时将结果保存在单独的表中

resultHistory

。

函数

CheckOdd

有内部

stop()

命令返回错误消息，但如果在Shiny环境中运行，它会使应用程序崩溃。

我想防止崩溃并显示特定的错误消息。虽然有很多类似问题，但我找不到适合Rshiny的

• 在全局级别定义函数，而不是在服务器中定义
• 该函数内有 stop() 命令

如何编写 tryCatch/showNotification 来有效捕获错误而不会使应用程序崩溃，而无需单独使用

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+2, num+4, num+6)
  return(result)
}

ui <- fluidPage(
  column(6,
         numericInput("mynum","Enter Zero", 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)

Answer 1

我建议对

tryCatch

的个别电话保持具体。

我在这里做了一些事情：

• 在几个地方添加了

  req(.)

  ，它有助于强制执行反应性依赖要求，以便当上游出现故障时，其“错误状态”会以智能方式反向引导到依赖项；
• 此反向通道错误状态是使用

  validate(need(cond, text))

  创建的；通常，

  cond

  将是

  inherits(res, "error")

  ，但不幸的是，

  conditionMessage(res)

  总是被调用，当res不是错误时，这会失败......所以我们要小心一点，只在以下情况下调用

  validate(need(...))

  ：我们知道这会是一个问题

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()
  }))
}

当此方法有效时，

resultTable

可以很好地显示一行；当出现错误时，会显示

ERROR: error message ...

。