Блог

Я пытаюсь изменить внешний вид ползунка фильтра перекрестных помех, изменив его цвет и шрифт. Для этого в функции нет встроенной опции filter_slider() , поэтому я просмотрел код функции, чтобы узнать, указывает ли он цвет и шрифт вывода. Я не нашел ничего, что указывало бы на то, что это так, поэтому мне было интересно, можно ли добавить в функцию несколько строк, которые позволяют изменять цвет слайдера и его шрифта. У меня очень ограниченные знания о написании функций, поэтому я не знаю, как изменить сложную функцию, подобную этой. Я прилагаю код, лежащий в filter_slider() основе функции ниже.

 function (id, label, sharedData, column, step = NULL, round = FALSE, 
    ticks = TRUE, animate = FALSE, width = NULL, sep = ",", 
    pre = NULL, post = NULL, timeFormat = NULL, timezone = NULL, 
    dragRange = TRUE, min = NULL, max = NULL) 
{
    if (is.character(column)) {
        column <- lazyeval::f_new(as.symbol(column))
    }
    df <- sharedData$data(withKey = TRUE)
    col <- lazyeval::f_eval(column, df)
    values <- na.omit(col)
    if (is.null(min)) 
        min <- min(values)
    if (is.null(max)) 
        max <- max(values)
    value <- range(values)
    ord <- order(col)
    options <- list(values = col[ord], keys = df$key_[ord], group = sharedData$groupName())
    findStepSize <- function(min, max, step) {
        if (!is.null(step)) 
            return(step)
        range <- max - min
        if (range < 2 || hasDecimals(min) || hasDecimals(max)) {
            step <- pretty(c(min, max), n = 100)
            step[2] - step[1]
        }
        else {
            1
        }
    }
    if (inherits(min, "Date")) {
        if (!inherits(max, "Date") || !inherits(value, 
            "Date")) 
            stop("`min`, `max`, and `value must all be Date or non-Date objects")
        dataType <- "date"
        if (is.null(timeFormat)) 
            timeFormat <- "%F"
    }
    else if (inherits(min, "POSIXt")) {
        if (!inherits(max, "POSIXt") || !inherits(value, 
            "POSIXt")) 
            stop("`min`, `max`, and `value must all be POSIXt or non-POSIXt objects")
        dataType <- "datetime"
        if (is.null(timeFormat)) 
            timeFormat <- "%F %T"
    }
    else {
        dataType <- "number"
    }
    if (isTRUE(round)) 
        round <- 0
    else if (!is.numeric(round)) 
        round <- NULL
    step <- findStepSize(min, max, step)
    step <- signif(step, 14)
    if (dataType %in% c("date", "datetime")) {
        to_ms <- function(x) 1000 * as.numeric(as.POSIXct(x))
        step <- to_ms(max) - to_ms(max - step)
        min <- to_ms(min)
        max <- to_ms(max)
        value <- to_ms(value)
    }
    range <- max - min
    if (ticks) {
        n_steps <- range/step
        scale_factor <- ceiling(n_steps/10)
        n_ticks <- n_steps/scale_factor
    }
    else {
        n_ticks <- NULL
    }
    sliderProps <- dropNulls(list(`data-type` = if (length(value) > 
        1) "double", `data-min` = formatNoSci(min), 
        `data-max` = formatNoSci(max), `data-from` = formatNoSci(value[1]), 
        `data-to` = if (length(value) > 1) formatNoSci(value[2]), 
        `data-step` = formatNoSci(step), `data-grid` = ticks, 
        `data-grid-num` = n_ticks, `data-grid-snap` = FALSE, 
        `data-prettify-separator` = sep, `data-prefix` = pre, 
        `data-postfix` = post, `data-keyboard` = TRUE, 
        `data-keyboard-step` = step/(max - min) * 100, 
        `data-drag-interval` = dragRange, `data-round` = round, 
        `data-data-type` = dataType, `data-time-format` = timeFormat, 
        `data-timezone` = timezone))
    sliderProps <- lapply(sliderProps, function(x) {
        if (identical(x, TRUE)) 
            "true"
        else if (identical(x, FALSE)) 
            "false"
        else x
    })
    sliderTag <- div(class = "form-group crosstalk-input", 
        class = "crosstalk-input-slider js-range-slider", 
        id = id, style = if (!is.null(width)) 
            paste0("width: ", validateCssUnit(width), ";"), 
        if (!is.null(label)) 
            controlLabel(id, label), do.call(tags$input, sliderProps), 
        tags$script(type = "application/json", `data-for` = id, 
            jsonlite::toJSON(options, dataframe = "columns", 
                pretty = TRUE)))
    if (identical(animate, TRUE)) 
        animate <- shiny::animationOptions()
    if (!is.null(animate) amp;amp; !identical(animate, FALSE)) {
        if (is.null(animate$playButton)) 
            animate$playButton <- shiny::icon("play", lib = "glyphicon")
        if (is.null(animate$pauseButton)) 
            animate$pauseButton <- shiny::icon("pause", 
                lib = "glyphicon")
        sliderTag <- tagAppendChild(sliderTag, tags$div(class = "slider-animate-container", 
            tags$a(href = "#", class = "slider-animate-button", 
                `data-target-id` = id, `data-interval` = animate$interval, 
                `data-loop` = animate$loop, span(class = "play", 
                  animate$playButton), span(class = "pause", 
                  animate$pauseButton))))
    }
    htmltools::browsable(attachDependencies(sliderTag, c(ionrangesliderLibs(), 
        crosstalkLibs())))
}
 

Чтобы изменить шрифт и цвет ползунка, вам не нужно изменять функцию. Вместо этого вы можете добавить некоторые дополнительные CSS для настройки внешнего вида.

Если вы запустите следующий файл Rmarkdown, вы увидите, что ползунок теперь имеет синий текст и написан курсивным шрифтом с красной полосой.

 ---
title: "Crosstalk Slider CSS"
output: html_document
---

<style>
.crosstalk-input-slider, .irs-grid-text{
  color: blue;
  font-family: cursive;
}
.irs-bar {
  background-color:red; 
}
</style>

## Crosstalk Slider CSS

```{r}
library(crosstalk)
shared_mtcars <- SharedData$new(mtcars)
filter_checkbox("cyl", "Cylinders", shared_mtcars, ~cyl, inline = TRUE)
filter_slider("hp", "Horsepower", shared_mtcars, ~hp, width = "100%")
filter_select("auto", "Automatic", shared_mtcars, ~ifelse(am == 0, "Yes", "No"))
```