从selectInput选项插入警告消息

Question

朋友，如果在selecInput中选择了一个选项，您能帮我插入一条警告消息吗？就我而言，如果选择了“排除服务器场”选项，则会出现如下消息：更改上面选择的过滤器选项。可执行代码如下：

library(shinyBS)
library(shiny)

popoverTempate <- 
  '<div class="popover popover-lg" role="tooltip"><div class="arrow"></div><h3 class="popover-title"></h3><div class="popover-content"></div></div>'

DES_filter1<-paste(".........", sep = "<br>")


ui <- fluidPage(

  tags$head(
    tags$style(HTML(".popover.popover-lg {width: 500px; max-width: 500px;}"))
  ),
  titlePanel("Old Faithful Geyser Data"),

  sidebarLayout(
    sidebarPanel(

      radioButtons(
        "filter1", 
        h3("Select properties"), 
        choiceValues = c(1, 2),
        choiceNames = list(
          tagList(
            tags$span("All properties"),
            tags$span(icon("info-circle"), id = "icon1", style = "color: blue;")
          ), 
          tagList(
            tags$span("Exclude properties"),
            tags$span(icon("info-circle"), id = "icon2", style = "color: blue;")
          )
        ),
        selected = 1
      ),

      bsPopover("icon1", "TITLE1", DES_filter1, placement = "right", 
                options = list(template = popoverTempate)), 
      bsPopover("icon2", "TITLE2", "CONTENT2", placement = "right"), 

      selectInput("filter2", h3("Select farms"),
                   choices = list("All farms" = 1, 
                                  "Exclude farms" = 2),
                   selected = 1),
    ),

    mainPanel(

    )
  )
)

server <- function(input, output) {

}

shinyApp(ui = ui, server = server)

Answer 1

如果您愿意使用其他软件包，则可以使用带有'sendSweetAlert'的ShinyWidgets解决方案：

library(shinyWidgets)
library(shiny)


ui <- fluidPage(


  titlePanel("Old Faithful Geyser Data"),

  sidebarLayout(
    sidebarPanel(

      radioButtons(
        "filter1", 
        h3("Select properties"), 
        choiceValues = c(1, 2),
        choiceNames = list(
          tagList(
            tags$span("All properties"),
            tags$span(icon("info-circle"), id = "icon1", style = "color: blue;")
          ), 
          tagList(
            tags$span("Exclude properties"),
            tags$span(icon("info-circle"), id = "icon2", style = "color: blue;")
          )
        ),
        selected = 1
      ),


      selectInput("filter2", h3("Select farms"),
                  choices = list("All farms" = 1, 
                                 "Exclude farms" = 2),
                  selected = 1),
    ),

    mainPanel(

    )
  )
)

server <- function(input, output, session) {
  observe({
    if(input$filter2 == 2){
      sendSweetAlert(
        session = session,
        title = "Error...",
        text = "Change filter options selected above",
        type = "warning"
      )
    }
  })
}

shinyApp(ui = ui, server = server)