我们如何在 R shiny 中为应用程序提供自定义错误消息？

Question

我创建了一个 shiny 应用程序，该应用程序在 textarea 字段中从用户那里获取 select 查询，然后在用户单击 Go 时运行它。 数据如下表所示。 现在，如果用户输入了一些错误的查询，或者查询中有任何错误，那么用户应该会收到一条错误消息“请更正查询。”。 现在，如果用户在 textarea 框中输入任何错误内容，我会收到此错误消息“发生错误。请检查您的日志或联系应用程序作者进行澄清”。 即使从我的代码中删除了 sanatize 错误行，我也得到了这个。 任何帮助将非常感激

server <- function(input, output, session) {
  resultTable <-  data.frame()
  observeEvent(input$tableName, {
    nQuery = paste("SELECT * FROM ",db, ".dbo.[",input$tableName,"]" ,sep = "" )
    updateTextAreaInput(session, "query", value = nQuery)
  })
  observeEvent(input$runQuery, {
    resultTable <<- sqlQuery (channel = conn, query = input$query)
    output$table <- renderDataTable(resultTable)
    }
  )
}

Answer 1

如果您安装 GitHub 版本的shinyWidgets ，您将拥有 function execute_safely以在弹出窗口中显示错误：

# Install dev version
devtools::install_github("dreamRs/shinyWidgets")

# then something like that:

library(shinyWidgets)

server <- function(input, output, session) {
  resultTable <-  data.frame()
  observeEvent(input$tableName, {
    nQuery = paste("SELECT * FROM ",db, ".dbo.[",input$tableName,"]" ,sep = "" )
    updateTextAreaInput(session, "query", value = nQuery)
  })

  result <- eventReactive(input$runQuery, {
    execute_safely(sqlQuery (channel = conn, query = input$query))
  })

  output$table <- renderDataTable(result())
}

可重现的例子：

library(RSQLite)
library(shiny)
# dev: devtools::install_github("dreamRs/shinyWidgets")
library(shinyWidgets)



# Fake database
con <- dbConnect(RSQLite::SQLite(), ":memory:")
dbWriteTable(con, "mtcars", mtcars) # write a table

ui <- fluidPage(
  textAreaInput(inputId = "query", label = "Query:", value = "SELECT * FROM mtcars"),
  actionButton(inputId = "runQuery", label = "Run query"),
  tableOutput("table")
)

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

  result <- eventReactive(input$runQuery, {
    execute_safely(dbGetQuery(conn = con, statement = input$query))
  })

  output$table <- renderTable(result())

}

shinyApp(ui, server)

如果你写了一个错误的查询，你会得到一个错误弹出窗口：