Как цветной слайдер (sliderInput)?

Я попытался сделать другой цвет для нескольких silderInput бар в R блестящий. Он требует css и т.д. Я посмотрел онлайн и могу найти только, как сделать один silderInput. Как я могу создать несколько разных цветов для разных баров?

Вот мой тестовый код. Он отобразит все строки в том же стиле:

 ui <- fluidPage(
   tags$style(type = "text/css", "
              .irs-bar {width: 100%; height: 25px; background: black; border-top: 1px solid black; border-bottom: 1px solid black;}
              .irs-bar-edge {background: black; border: 1px solid black; height: 25px; border-radius: 0px; width: 20px;}
              .irs-line {border: 1px solid black; height: 25px; border-radius: 0px;}
              .irs-grid-text {font-family: 'arial'; color: white; bottom: 17px; z-index: 1;}
              .irs-grid-pol {display: none;}
              .irs-max {font-family: 'arial'; color: black;}
              .irs-min {font-family: 'arial'; color: black;}
              .irs-single {color:black; background:#6666ff;}
              .irs-slider {width: 30px; height: 30px; top: 22px;}

             .irs-bar1 {width: 50%; height: 25px; background: red; border-top: 1px solid black; border-bottom: 1px solid black;}
              .irs-bar-edge1 {background: black; border: 1px solid red; height: 25px; border-radius: 0px; width: 20px;}
              .irs-line1 {border: 1px solid red; height: 25px; border-radius: 0px;}
              .irs-grid-text1 {font-family: 'arial'; color: white; bottom: 17px; z-index: 1;}
              .irs-grid-pol1 {display: none;}
              .irs-max1 {font-family: 'arial'; color: red;}
              .irs-min1 {font-family: 'arial'; color: red;}
              .irs-single1 {color:black; background:#6666ff;}
              .irs-slider1 {width: 30px; height: 30px; top: 22px;}

             "),

  uiOutput("testSlider")
  )

server <- function(input, output, session){
  output$testSlider <- renderUI({
    fluidRow(
      column(width=3, 
             box(
               title = "Preferences", width = NULL, status = "primary",
               sliderInput(inputId="test", label=NULL, min=1, max=10, value=5, step = 1, width='100%'),
               sliderInput(inputId="test2", label=NULL, min=1, max=10, value=5, step = 1, width='50%')
             )     
      ))
  })
}

shinyApp(ui = ui, server=server)

ОТВЕТЫ

Ответ 1

Ниже приведен пример кода, как вы можете изменить style ползунков. Вы можете добавить к нему свою собственную логику.

rm(list = ls())
library(shiny)
ui <- fluidPage(
  # All your styles will go here
  tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: purple}")),
  tags$style(HTML(".js-irs-1 .irs-single, .js-irs-1 .irs-bar-edge, .js-irs-1 .irs-bar {background: red}")),
  tags$style(HTML(".js-irs-2 .irs-single, .js-irs-2 .irs-bar-edge, .js-irs-2 .irs-bar {background: green}")),

  sliderInput("slider1", "Slider 1",min = 0.1, max = 1, value = 0.4, step = 0.05),
  sliderInput("slider2", "Slider 2",min = 0.1, max = 1, value = 0.4, step = 0.05),                               
  sliderInput("slider3", "Slider 3",min = 100, max = 20000, value = 5000, step= 200)

)
server <- function(input, output, session){}
shinyApp(ui = ui, server=server)

введите описание изображения здесь

Ответ 2

Предыдущий ответ, к сожалению, только изменил цвет бара для меня, а не теги числа выше. Это сделало трюк для остальных. (Замените шестнадцатеричные цветовые коды на любой цвет, который вам нравится).

/* changes the colour of the bars */ 
tags$head(tags$style(HTML('.js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {
                                                  background: #000069;
                                                  border-top: 1px solid #000039 ;
                                                  border-bottom: 1px solid #000039 ;}

                            /* changes the colour of the number tags */
                           .irs-from, .irs-to, .irs-single { background: #000069 }'
                    ))
               )

Ответ 3

Вышеупомянутые решения не будут работать, если ползунки генерируются динамически и повторно используются, поскольку они полагаются на подсчет класса контейнера (".js-irs-0"). При повторной инициализации ползунка количество будет увеличиваться. Сравните слайдеры 1 и 2 и 3 в приведенном ниже примере.

Если CSS позволит родительским селекторам, можно использовать идентификатор ввода для выбора необходимых элементов (идентификатор не изменяется). Поскольку это невозможно, требуется другое решение. К счастью, ярлык имеет значение for=id -attribute, которое может использоваться для выбора следующих сиблингов - элементов span, содержащих полоски и т.д. Я также выделил ярлык слайдера 2 для лучшего понимания. См. Также обзор CSS-селекторов.

library(shiny)
library(shinyjs)

'%||%' <- function(a, b) {
  if (!is.null(a)) a else b
}

NUM_PAGES <- 3

ui<- fluidPage(
  useShinyjs(), 
  tags$head(tags$style(HTML('.js-irs-1 .irs-single, .js-irs-1 .irs-bar-edge, .js-irs-1 .irs-bar {
                                                  background: purple;
                            }
                            '
  ))
  ),
  tags$head(tags$style(HTML(' [for=sl2]+span>.irs>.irs-single, [for=sl2]+span>.irs-bar-edge, [for=sl2]+span>.irs-bar {
                                                  background: green;} 

                            [for=sl2]{color:red;}
                            [for=sl3]+span>.irs>.irs-single, [for=sl3]+span>.irs-bar-edge, [for=sl3]+span>.irs-bar {
                                                  background: grey;} 

                            '
  ))
  ),
  uiOutput("ui"),
  br(),
  actionButton("prevBtn", "< Previous"),
  actionButton("nextBtn", "Next >")
  )

server<- function(input, output, session) {
  rv <- reactiveValues(page = 1)

  uilist <- reactive(list(
    sliderInput("sl1","Dies ist slider 1", 1,101,input$sl1%||%11),
    sliderInput("sl2","Dies ist slider 2", 2,102,input$sl2%||%22),
    sliderInput("sl3","Dies ist slider 3", 3,103,input$sl3%||%33)
  ))

  observeEvent(rv$page,{
    toggleState(id = "nextBtn", condition = rv$page < NUM_PAGES+1)

    if(rv$page <= NUM_PAGES){
      #Einzelne Slider
      toggleState(id = "prevBtn", condition = rv$page > 1)
      output$ui<- renderUI(uilist()[[rv$page]])  
    }else{
      #Am Ende Gesamtliste
      output$ui<- renderUI(uilist())
    }


  })

  navPage <- function(direction) {
    rv$page <- rv$page + direction
  }

  observeEvent(input$prevBtn, navPage(-1))
  observeEvent(input$nextBtn, navPage(1))
}

shinyApp(ui, server)