Have you checked out this package - shinyFeedback ?
You can see some examples here.
To use multiple feedbacks, you should write all the conditions in one observeEvent - although I didnt manage to make multiple feedbacks working.
Here is the code example from that page for multiple feedbacks:
library(shiny)
library(shinyFeedback)
ui <- fluidPage(
useShinyFeedback(), # include shinyFeedback
numericInput(
"multiFeedbacks",
"1 is scary 2 is dangerous",
value = 1
)
)
server <- function(input, output) {
observeEvent(input$multiFeedbacks, {
feedbackWarning(
inputId = "multiFeedbacks",
condition = input$multiFeedbacks >= 1,
text = "Warning 1 is a lonely number"
)
feedbackDanger(
inputId = "multiFeedbacks",
condition = input$multiFeedbacks >= 2,
text = "2+ is danger"
)
})
}
shinyApp(ui, server)
Another option would be to use the shinyjs package, where you can run java-script and send css-code to the browser. You have to put useShinyjs() in the dashboardBody. The class "irs-bar" is used for all sliders in shiny, so if you want the behaviour only on a certain slider you would have to adapt the css selector (.irs-bar). (See next example).
Here is a little example oh how you could achieve the desired behaviour:
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(skin = "black",
dashboardHeader(title = "test"),
dashboardSidebar(
sidebarMenu(
menuItem("Complete", tabName = "comp"))),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(tabName = "comp",
fluidRow(
sliderInput("range_var", "", value = c(90,100), min = 0, max = 100, width = '200%'))))))
server <- function(input, output, session) {
observeEvent(input$range_var, {
if (input$range_var[1] <= 40) {
runjs(paste0('$(".irs-bar").css("background-color"," red")'))
}
if (input$range_var[1] > 40 & input$range_var[1] < 60) {
runjs(paste0('$(".irs-bar").css("background-color"," blue")'))
}
if (input$range_var[1] > 60 & input$range_var[1] < 100) {
runjs(paste0('$(".irs-bar").css("background-color"," green")'))
}
})
}
shinyApp(ui, server)
The following example shows how to style only one specific sliderInput. The sliderInputs are put in 2 divs with ids. In the runjs function the css selector is adapted to only style the first sliderInput.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(skin = "black",
dashboardHeader(title = "test"),
dashboardSidebar(
sidebarMenu(
menuItem("Complete", tabName = "comp"))),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(tabName = "comp",
fluidRow(
div(id="range_var_css",
sliderInput("range_var", "", value = c(90,100), min = 0, max = 100, width = '200%')
),
div(id="range_var_css1",
sliderInput("range_var1", "", value = c(90,100), min = 0, max = 100, width = '200%')
)
))))
)
server <- function(input, output, session) {
observeEvent(input$range_var, {
if (input$range_var[1] <= 40) {
runjs(paste0('$("#range_var_css .irs-bar").css("background-color"," red")'))
}
if (input$range_var[1] > 40 & input$range_var[1] < 60) {
runjs(paste0('$("#range_var_css .irs-bar").css("background-color"," blue")'))
}
if (input$range_var[1] > 60 & input$range_var[1] < 100) {
runjs(paste0('$("#range_var_css .irs-bar").css("background-color"," green")'))
}
})
}
To fully style the sliderInput to your desired color, you also have to change the css of the border-bottom and border-top of the slider, to something like that:
if (input$range_var[1] <= 40) {
runjs(paste0('$("#range_var_css .irs-bar").css({
"background-color": "red",
"border-top": "1px solid red",
"border-bottom": "1px solid red"})'))
}