闪亮 - 自定义警告/错误消息？

Question

当所需数据为空时，如何打印自定义警告/错误消息？

例如，在我的 server.R 中，下面有这段代码，

output$plot = renderPlot({

      # Sites.
      site1 = input$site1

      # Prepare SQL query.
      query <- "SELECT * FROM datatable
                  WHERE sites.id = 'SITE1'
                  "

      # Match the pattern and replace it.
      query <- sub("SITE1", as.character(site1), query)

      # Store the result in data.
      data = dbGetQuery(DB, query)

      if (is.na(data) || data == '') {

        # print error/ warning message
        "sorry, no data is found."

      } else {

       # plot the data
       dens <- density(data$particles, na.rm = TRUE)

       plot(dens, main = paste("Histogram of ", "particles"), 
         xlab = "particles")

      }

当没有找到数据时，我在下面收到这个不友好的红色错误消息。

error: need at least 2 points to select a bandwidth automatically

理想情况下，

sorry, no data is found.

有什么想法吗？

Answer 1

在某些情况下，您可能需要使用validate、see accepted answer there。

对于其他情况，我根据@zx8754 的回答制作了一个函数，但使用了ggplot2。到这里就可以打包了。

你会打电话到哪里：

stop("sorry, no data is found.")

打电话

return(plot_exception("sorry, no data is found."))

功能：

#' plot message for exception
#' 
#' Useful to display messages in \code{shiny} reports
#'
#' Typically call \code{return(plot_exception(...))} where you would have called \code{stop(...)}
#' @param ... text to display, concatenated with sep
#' @param sep separator used for concatenation
#' @param type function to use to print in console
#' @param color text color, by default red for message and warning else black
#' @param console if TRUE print in console, if FALSE just plot
#' @param size text size
#' @examples
#' plot_exception("no data for current filter selection")
#' plot_exception("NO","WAY","!!!",color="blue",size=12,console=FALSE)
#' @export
plot_exception <-function(
  ...,
  sep=" ",
  type=c("message","warning","cat","print"),
  color="auto",
  console=TRUE,
  size = 6){      
  type=match.arg(type)
  txt = paste(...,collapse=sep)
  if(console){
    if(type == "message") message(txt)
    if(type == "warning") warning(txt)
    if(type == "cat") cat(txt)
    if(type == "print") print(txt)
  }
  if(color =="auto") color <- if(type == "cat") "black" else "red"
  if(txt == "warning") txt <- paste("warning:",txt)
  print(ggplot2::ggplot() +
          ggplot2::geom_text(ggplot2::aes(x=0,y=0,label=txt),color=color,size=size) + 
          ggplot2::theme_void())
  invisible(NULL)
}

Answer 2

由于我们需要将绘图返回到renderPlot()，我们需要在plot() 函数中显示错误/警告。

我们正在绘制一个带有"white" 颜色的空白散点图，然后在中间添加带有text() 函数的错误消息 - 该图的x=1、y=1，请参见下面的工作示例：

#dummy dataframe
data <- data.frame(sites.id=rep(letters[1:3],10),particles=runif(30))

#subset - change "SiteX" to "a" to test ifelse
data <- data[data$sites.id=="SiteX", ]

if(nrow(data) == 0) {
  # print error/ warning message
  plot(1,1,col="white")
  text(1,1,"no data")
} else {
  # plot the data
  dens <- density(data$particles, na.rm = TRUE)
  plot(dens, main = paste("Histogram of", sites.id, "particles"), 
       xlab = "particles")
}