Как цветной слайдер (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)
