更改串扰 filter_slider() 函数背后的代码

如何解决更改串扰 filter_slider() 函数背后的代码

我正在尝试通过更改颜色和字体来修改串扰滤波器滑块的外观。在 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`,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,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())))
}

解决方法

改变滑块的字体和颜色，不需要修改函数。相反，您可以添加一些额外的 CSS 来自定义外观。

如果您运行以下 Rmarkdown 文件，您可以看到滑块现在具有蓝色文本，并且是草书字体，带有红色条。

CMakeLists.txt