Antonio
Antonio

Reputation: 1111

Insert warning message from selectInput option

Friends, could you help me to insert a warning message if an option is selected in selecInput. In my case, I would like it to be the case if the option "Exclude farms" is selected, a message like: Change filter options selected above. The executable code is below:

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)

Upvotes: 0

Views: 195

Answers (1)

bs93
bs93

Reputation: 1316

If you are open to using another package here is a shinyWidgets solution with a 'sendSweetAlert':

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 = "Warning!",
        text = "Change filter options selected above",
        type = "warning"
      )
    }
  })
}

shinyApp(ui = ui, server = server)

All is needed is to observe the selectInput value and when the input is on "Exclude farms" which has a value of 2 a warning message is sent.

enter image description here

Upvotes: 1

Related Questions