如何为slidebar(sliderInput)着色?

时间:2016-04-28 05:49:28

标签: r colors shiny

我试图为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)

3 个答案:

答案 0 :(得分:33)

以下是如何修改滑块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)

enter image description here

答案 1 :(得分: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 }'
                    ))
               )

答案 2 :(得分:0)

动态生成滑块并reused时,上述解决方案将不起作用,因为它依赖于对容器类(“ .js-irs-0”)的计数。重新初始化滑块时,计数将增加。在下面的示例中比较滑块1与2和3。

如果CSS允许使用父选择器,则可以使用输入的ID来选择所需的元素(ID不变)。由于这是not posssible,因此需要其他解决方案。幸运的是,标签具有for=id属性,可用于选择以下同级项-包含条形图的span元素。为了突出理解,我还突出显示了滑块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)