如何为滑块（sliderInput）着色？
Posted
技术标签:
【中文标题】如何为滑块（sliderInput）着色？【英文标题】：How to color sliderbar (sliderInput)? 【发布时间】：2016-08-22 17:19:19 【问题描述】：我尝试为 R 中的几个 silderInput 条制作不同的颜色。它需要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)
【讨论】：
如何接受？我点击了向上箭头。这是否意味着我接受了它？再次感谢您的帮助！ @czqiu 见这里：How does accepting an answer work? 使用这个，很高兴它工作。但是，当您的应用程序中有 50 个滑块可供样式时，这是一种乐趣..... 我喜欢这个解决方案，但是您的代码似乎并没有改变蓝色边框的颜色。有可能吗？【参考方案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】：当滑块是动态生成的并且reused 时，上述解决方案将不起作用，因为它依赖于容器类（“.js-irs-0”）的计数。重新初始化滑块时，计数会增加。比较下例中的滑块 1 与 2 和 3。
如果 CSS 允许父选择器，则可以使用输入的 id 来选择所需的元素（id 不会改变）。由于这是not posssible，因此需要另一个解决方案。幸运的是，该标签有一个for=id-attribute，可用于选择以下同级 - 包含条的跨度元素等。我还突出显示了滑块 2 的标签以便更好地理解。另请参阅overview of CSS-selectors。
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)
【讨论】：
以上是关于如何为滑块（sliderInput）着色？的主要内容，如果未能解决你的问题，请参考以下文章