使用 "SelectizeInput" 在 R Shiny Dashboard Sidebar 上生成警告消息

Generate warning message on R Shiny Dashboard Sidebar using "SelectizeInput"

如果用户输入无法识别的内容,我想在闪亮的仪表板侧边栏中添加一条警告消息。我发现了一些非常有用的信息: 但这并不是我所需要的,并且想听听您的想法。下面是我的代码

library(shiny)
ui <- dashboardPage(

  dashboardHeader(),
  dashboardSidebar(
    selectizeInput('email', 'Email', c("NYC@gmail.com", "LA@gmail.com","SF@gmail.com"), multiple = FALSE,
                   options = list(
                     placeholder = 'Email addresss',
                     onInitialize = I('function() { this.setValue(""); }')
                   )),
    uiOutput('email_text')
  ),
  dashboardBody()
)

server <- function(input, output) {
  output$email_text <-
    renderUI({
      if(input$email == ""){
        return(p("Please add your gmail e-mail address."))
      }

      #Update: Below checks for "gmail" - I would something to search list and return.
      if(!grepl("gmail", input$email)){
        return(p("Your email is not a gmail e-mail address!"))
      }

    })
}

shinyApp(ui = ui, server = server)

当前侧边栏 selection 可以很好地识别电子邮件格式,只要我从下拉列表中 select

然而,我还想补充的是,如果我输入了不期望的内容(不在给定的列表中),系统可以捕获并警告我(例如 "Your email is not an expected email address!")。目前,如果我只是输入一些不在列表中的东西,系统不会做任何事情:

我觉得和我上面提到的post相比,我的版本在"selectizeInput"功能上有问题。它旨在从列表中获取元素,而不是用户输入的所有内容。有没有办法解决它?我尝试使用 validate() 但没有成功。

非常感谢您的帮助!

默认情况下 selecticizeInput 不允许用户输入新值。您必须使用 options = list(create = TRUE) 启用它。选择此选项后,您可以使用 %in% 检查新创建的电子邮件是否在预定义的电子邮件列表中,并在侧边栏中报告自定义错误消息。

这是更新后的代码:

library(shiny)
library(shinydashboard)

list_of_emails <- c("NYC@gmail.com", "LA@gmail.com", "SF@gmail.com")

ui <- dashboardPage(dashboardHeader(),
                    dashboardSidebar(
                      selectizeInput(
                        'email',
                        'Email',
                        c("NYC@gmail.com", "LA@gmail.com", "SF@gmail.com"),
                        multiple = FALSE,
                        options = list(
                          create=TRUE,
                          placeholder = 'Email addresss',
                          onInitialize = I('function() { this.setValue(""); }')
                        )
                      ),
                      uiOutput('email_text')
                    ),
                    dashboardBody())

server <- function(input, output) {
  output$email_text <-
    renderUI({
      # print the input email to the console to help with debugging
      message(input$email)
      if (input$email == "") {
        return(p("Please add your gmail e-mail address."))
      }

      #Update: Below checks for "gmail" - I would something to search list and return.
      if (!input$email %in% list_of_emails) {
        return(p("Your email is not in the list of emails!"))
      }

    })
}

runApp(list(ui = ui, server = server))