r - Altering code behind crosstalk's filter_slider() function

Question

I am trying to modify the appearance of a crosstalk filter slider by changing its colour and font. There is no built-in option to do this within the filter_slider() function, so I looked up the code behind the function to see if it specifies the colour and font of the output. I found nothing that indicates that it does, so I was wondering if it is possible to add some lines to the function that enable changing the colour of the slider and its font. I have very limited knowledge of writing functions, so I do not know how to modify a complicated function like this one. I am attaching the code behind the filter_slider() function below.

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

question from:https://stackoverflow.com/questions/65830386/altering-code-behind-crosstalks-filter-slider-function

Answer 1

To change the font and colour of the slider, you don't need to modify the function. Instead, you can add some additional CSS to customise the appearance.

If you run the following Rmarkdown file, you can see the slider now has blue text and is in cursive font, with a red bar.

---
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"))
```