闪亮的 R 日期输入弹出消息

Question

我有一个应用程序的服务器文件，它从用户输入的股票代码中从雅虎财经获取股票信息。此处相关的服务器代码是

dataInput <- reactive({
  getSymbols(input$symb, src = "yahoo", 
    from = input$dates[1],
    to = input$dates[2],
    auto.assign = FALSE)
})

并且 ui.r 代码是

  textInput("symb", "Symbol", "^FTSE"),

  dateRangeInput("dates", 
    "Date range",
    start = "2015-01-01", 
    end = as.character(Sys.Date())),

  submitButton("Analysis"),width=6)

这给出了以下内容

但是，如果用户输入的代码不正确或不是股票，我会收到以下错误

Error in download.file(paste(yahoo.URL, "s=", Symbols.name, "&a=", from.m,  : 
  cannot open URL 'http://ichart.finance.yahoo.com/table.csv?s=sdf&a=11&b=16&c=2014&d=1&e=25&f=2015&g=d&q=q&y=0&z=sdf&x=.csv'

这很好，因为它无法打开 url，因为他们输入的代码不存在股票。但是，我希望出现一条弹出消息，说明他们插入的股票代码不存在。我已经尝试过一些方法来做到这一点，包括 bsAlert() 方法，但我似乎做不到。任何帮助都会很棒

Answer 1

您可以在获取符号时使用 try/catch，如果出现错误则显示 bsAlert：

app.R

library(quantmod)
library(shinyBS)

server<-function(input, output,session) {
  #get the symbol data
  symbolData<-reactive({
    #try/catch in case there is an error
    data<-tryCatch({
      #if there is a bsAlert, close it
      closeAlert(session, "alert")
      #try to get the symbols
      getSymbols(input$symb, src = "yahoo", 
               from = input$dates[1],
               to = input$dates[2],
               auto.assign = FALSE)},
               #if there is an error
               error=function(cond) {
                 #create the bsAlert
                 createAlert(session, inputId = "alert_anchor",
                             alertId="alert",
                             message = "Please enter a valid symbol",
                             type = "warning",
                             append="false",
                             dismiss = FALSE
                 )
                 #return an empty string
                 return("")
               })
    data
    })

  #as an example, output the table
  output$table<-renderDataTable({symbolData()})
}

ui<-fluidPage(
  fluidRow(
    column(3, wellPanel(
      textInput("symb", "Symbol", "^FTSE"),
      bsAlert(inputId = "alert_anchor"),
      dateRangeInput("dates", 
                     "Date range",
                     start = "2015-01-01", 
                     end = as.character(Sys.Date())),
      submitButton("Submit")
    )),
  column(6, dataTableOutput("table"))

  ))
shinyApp(ui = ui, server = server)

闪亮的 R 日期输入弹出消息

Shiny R Date Input Pop Up message

r

shiny