0

我正在尝试通过更改其颜色和字体来修改串扰过滤器滑块的外观。函数内没有执行此操作的内置选项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) && !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())))
}
4

1 回答 1

2

要更改滑块的字体和颜色，无需修改功能。相反，您可以添加一些额外的 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"))
```
于 2021-01-23T13:52:15.267 回答