从selectInput选项插入警告消息

朋友,如果在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)
评论
  • 三叔公
    三叔公 回复

    如果您愿意使用其他软件包,则可以使用带有“ 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)
    

    enter image description here