Добавьте разные статические цвета для ползунка в блестящей приборной панели - PullRequest
Новая
       9

Добавьте разные статические цвета для ползунка в блестящей приборной панели

0 голосов
/ 16 мая 2018

Я новичок в блеске.Я хотел бы дать статический цвет для ползунка независимо от диапазона, выбранного в блестящей приборной панели.Я хочу иметь другой цвет для слайдера следующим образом, например: от 0 до 40 - красный, от 40 до 60 - синий, от 60 до 100 - зеленый.Пожалуйста, помогите мне решить эту проблему.Мой код, 

library(shiny)
library(shinydashboard)

ui <- dashboardPage(skin = "black",
                    dashboardHeader(title = "test"),

                  dashboardSidebar(
                    sidebarMenu(
                      menuItem("Complete", tabName = "comp"))),

                    dashboardBody(
                      tabItems(
                        tabItem(tabName = "comp",
                          fluidRow(
                              sliderInput("range_var", "", value = c(90,100), min = 0, max = 100, width = '200%'))))))

server <- function(input, output, session) { 
  observe({
    updateSliderInput(session, "range_var", label = "", value = c(90, 100), min = 0, max = 100)
  })
}
shinyApp(ui, server)

Спасибо, Баладжи

Ответы [ 2 ]

0 голосов
/ 16 мая 2018

О, тогда я неправильно понял ваш вопрос. Вы можете добиться этого также с помощью css-команд и правильных селекторов: 

library(shiny)
library(shinydashboard)
library(shinyjs)

ui <- dashboardPage(skin = "black",
                    dashboardHeader(title = "test"),
                    dashboardSidebar(
                      sidebarMenu(
                        menuItem("Complete", tabName = "comp"))),
                    dashboardBody(
                      inlineCSS(".irs-line-left { background-color: red; width: 40%;}
                                 .irs-line-mid { background-color: blue; width: 20%; left: 40%;}
                                 .irs-line-right { background-color: green; width: 40%; left: 60%;}
                                "
                                ),

                      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) { 
}

shinyApp(ui, server)
0 голосов
/ 16 мая 2018

Вы уже проверили этот пакет - глянцевая обратная связь ?

Вы можете увидеть несколько примеров здесь .

Чтобы использовать несколько отзывов, вам следуетнапишите все условия в одном наблюдаемом событии - хотя мне не удалось заставить работать несколько отзывов.

Вот пример кода с этой страницы для множественных отзывов: 

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)

Другой вариант - использовать пакет smoothjs , где вы можете запустить java-скрипти отправьте css-код в браузер.Вы должны поместить useShinyjs () в панель инструментов тела.Класс "irs-bar" используется для всех ползунков в блестящем, поэтому, если вы хотите, чтобы поведение было только на определенном слайдере, вам придется адаптировать селектор css (.irs-bar).(См. Следующий пример).Вот небольшой пример того, как вы могли бы достичь желаемого поведения: 

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)

В следующем примере показано, как стилизовать только один конкретный sliderInput.SliderInputs помещается в 2 деления с идентификаторами.В функции runjs селектор css адаптирован для стиля только первого 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")'))
    }
  })
}

Чтобы полностью настроить sliderInput на нужный вам цвет, вы также должны изменить css для border-bottom и border-вверху ползунка, примерно так: 

    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"})'))
}
...