Search code examples
rhighchartscolorsboxplotr-highcharter

Customize colors for boxplot with highcharter


I have boxplots on highcharter and I would like to customize both the

  • Fill color
  • Border color

Here is my code

df = data.frame(cbind(categ = rep(c('a','b','c','d')),value = rnorm(1000)))

hcboxplot(var = df$categ, x = as.numeric(df$value)) %>% 
  hc_chart(type = "column")  %>% 
  hc_colors(c("#203d7d","#a0a0ed","#203d7e","#a0a0ad")) 

The hc_colors works only if I put var2 instead of var but then the box plot are shrunken...


Solution

  • I made a couple functions to do some stuff with highcharts and boxplots. It will let you color each boxplot and fill it accordingly, and then inject new graphical parameters according to the Highcharts API, should you desire.

    Check it out:

    ## Boxplots Data and names, note the data index (0,1,2) is the first number in the datum
    series<- list(
      list(
        name="a",
        data=list(c(0,1,2,3,4,5))
      ),
      list(
        name="b",
        data=list(c(1,2,3,4,5,6))
    
      ),
      list(
        name="c",
        data=list(c(2,3,4,5,6,7))
    
      )
    )
    
    # Graphical attribute to be set: fillColor.
    # Make the colors for the box fill and then also the box lines (make them match so it looks pretty)
    cols<- viridisLite::viridis(n= length(series2), alpha = 0.5) # Keeping alpha in here! (for box fill)
    cols2<- substr(cols, 0,7) # no alpha, pure hex truth, for box lines 
    
    gen_key_vector<-function(variable, num_times){
      return(rep(variable, num_times))
    } 
    
    kv<- gen_key_vector(variable = "fillColor", length(series)) 
    
    # Make a function to put stuff in the 'series' list, requires seq_along to be used since x is the list/vector index tracker
    
    add_variable_to_series_list<- function(x, series_list, key_vector, value_vector){
      base::stopifnot(length(key_vector) == length(value_vector))
      base::stopifnot(length(series_list) == length(key_vector))
      series_list[[x]][length(series_list[[x]])+1]<- value_vector[x]
      names(series_list[[x]])[length(series_list[[x]])]<- key_vector[x]
      return(series_list[[x]])
    }
    ## Put the extra stuff in the 'series' list
    series2<- lapply(seq_along(series), function(x){ add_variable_to_series_list(x = x, series_list = series, key_vector = kv, value_vector = cols) })
    
    
    hc<- highcharter::highchart() %>%
      highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
      highcharter::hc_title(text="This is a title") %>%
      highcharter::hc_legend(enabled=FALSE) %>%
      highcharter::hc_xAxis(type="category", categories=c("a", "b", "c"), title=list(text="Some x-axis title")) %>%
      highcharter::hc_add_series_list(series2) %>%
      hc_plotOptions(series = list(
        marker = list(
          symbol = "circle"
        ),
        grouping=FALSE
      )) %>%
      highcharter::hc_colors(cols2) %>%
      highcharter::hc_exporting(enabled=TRUE)
    hc
    

    This probably could be adjusted to work with a simple dataframe, but I think it will get you what you want for right now without having to do too much extra work. Also, maybe look into list_parse or list_parse2' fromhighcharter...it could probably help with building out theseries` object..I still need to look into that.

    Edit:

    I have expanded the example to make it work with a regular DF. As per some follow up questions, the colors are set using the viridis palette inside the make_highchart_boxplot_with_colored_factors function. If you want to allow your own palette and colors, you could expose those arguments and just include them as parameters inside the function call. The expanded example borrows how to add outliers from the highcharter library (albeit in a hacky way) and then builds everything else up from scratch. Hopefully this helps clarify my previous answer. Please note, I could probably also clean up the if condition to make it a little more brief, but I kept it verbose for illustrative purposes.

    Double Edit: You can now specify a vector of colors for each level of the factor variable

    library(highcharter)
    library(magrittr)
    library(viridisLite)
    
    df = data.frame(cbind(categ = rep(c('a','b','c','d')),value = rnorm(1000)))
    df$value<- base::as.numeric(df$value)
    
    
    add_variable_to_series_list<- function(x, series_list, key_vector, value_vector){
      base::stopifnot(length(key_vector) == length(value_vector))
      base::stopifnot(length(series_list) == length(key_vector))
      series_list[[x]][length(series_list[[x]])+1]<- value_vector[x]
      names(series_list[[x]])[length(series_list[[x]])]<- key_vector[x]
      return(series_list[[x]])
    }
    
    
    # From highcharter github pages:
    hc_add_series_bwpout = function(hc, value, by, ...) {
      z = lapply(levels(by), function(x) {
        bpstats = boxplot.stats(value[by == x])$stats
        outliers = c()
        for (y in na.exclude(value[by == x])) {
          if ((y < bpstats[1]) | (y > bpstats[5]))
            outliers = c(outliers, list(which(levels(by)==x)-1, y))
        }
        outliers
      })
      hc %>%
        hc_add_series(data = z, type="scatter", ...)
    }
    
    
    gen_key_vector<-function(variable, num_times){
      return(rep(variable, num_times))
    } 
    gen_boxplot_series_from_df<- function(value, by,...){
      value<- base::as.numeric(value)
      by<- base::as.factor(by)
      box_names<- levels(by)
      z=lapply(box_names, function(x) {
        boxplot.stats(value[by==x])$stats
      })
      tmp<- lapply(seq_along(z), function(x){
        var_name_list<- list(box_names[x])
        #tmp0<- list(names(df)[x])
        names(var_name_list)<- "name"
        index<- x-1
        tmp<- list(c(index,  z[[x]]))
        tmp<- list(tmp)
        names(tmp)<- "data"
        tmp_out<- c(var_name_list, tmp)
        #tmp<- list(tmp)
        return(tmp_out)
    
      })
      return(tmp)
    }
    # Usage: 
    #series<- gen_boxplot_series_from_df(value = df$total_value, by=df$asset_class)
    
    
    ## Boxplot function:
    make_highchart_boxplot_with_colored_factors<- function(value, by, chart_title="Boxplots",
                                                           chart_x_axis_label="Values", show_outliers=FALSE,
                                                           boxcolors=NULL, box_line_colors=NULL){
      by<- as.factor(by)
      box_names_to_use<- levels(by)
      series<- gen_boxplot_series_from_df(value = value, by=by)
      if(is.null(boxcolors)){
        cols<- viridisLite::viridis(n= length(series), alpha = 0.5) # Keeping alpha in here! (COLORS FOR BOXES ARE SET HERE)
      } else {
        cols<- boxcolors
      }
      if(is.null(box_line_colors)){
        if(base::nchar(cols[[1]])==9){
          cols2<- substr(cols, 0,7) # no alpha, pure hex truth, for box lines 
        } else {
          cols2<- cols
        }
    
      } else {
        cols2<- box_line_colors
      }
    
      # Injecting value 'fillColor' into series list
      kv<- gen_key_vector(variable = "fillColor", length(series)) 
      series2<- lapply(seq_along(series), function(x){ add_variable_to_series_list(x = x, series_list = series, key_vector = kv, value_vector = cols) })
    
      if(show_outliers == TRUE){
        hc<- highcharter::highchart() %>%
          highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
          highcharter::hc_title(text=chart_title) %>%
          highcharter::hc_legend(enabled=FALSE) %>%
          highcharter::hc_xAxis(type="category", categories=box_names_to_use, title=list(text=chart_x_axis_label)) %>%
          highcharter::hc_add_series_list(series2) %>%
          hc_add_series_bwpout(value = value, by=by, name="Outliers") %>%
          hc_plotOptions(series = list(
            marker = list(
              symbol = "circle"
            ),
            grouping=FALSE
          )) %>%
          highcharter::hc_colors(cols2) %>%
          highcharter::hc_exporting(enabled=TRUE)
    
      } else{
        hc<- highcharter::highchart() %>%
          highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
          highcharter::hc_title(text=chart_title) %>%
          highcharter::hc_legend(enabled=FALSE) %>%
          highcharter::hc_xAxis(type="category", categories=box_names_to_use, title=list(text=chart_x_axis_label)) %>%
          highcharter::hc_add_series_list(series2) %>%
          hc_plotOptions(series = list(
            marker = list(
              symbol = "circle"
            ),
            grouping=FALSE
          )) %>%
          highcharter::hc_colors(cols2) %>%
          highcharter::hc_exporting(enabled=TRUE)
      }
      hc
    }
    # Usage:
    tst_box<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title", chart_x_axis_label = "Some X Axis", show_outliers = TRUE)
    tst_box
    
    # Custom Colors:
    custom_colors_with_alpha_in_hex<- paste0(gplots::col2hex(sample(x=colors(), size = length(unique(df$categ)), replace = FALSE)), "80")
    tst_box2<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title",
                                                          chart_x_axis_label = "Some X Axis",
                                                          show_outliers = TRUE, boxcolors = custom_colors_with_alpha_in_hex)
    tst_box2
    
    tst_box3<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title",
                                                                     chart_x_axis_label = "Some X Axis",
                                                                     show_outliers = TRUE, boxcolors = custom_colors_with_alpha_in_hex, box_line_colors = "black")
    tst_box3
    

    I hope this helps, please let me know if you have any more questions. I'm happy to try to help as best I can. -nate