hc_add_series_boxplot.R

rm(list = ls())
suppressPackageStartupMessages(library(highcharter))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(purrr))

## Warning: package 'purrr' was built under R version 3.2.3

options(highcharter.theme = hc_theme_smpl())

hc <- highchart()
... <- NULL

hc_add_series_boxplot <- function(hc, x, by = NULL, outliers = TRUE, ...) {
  
  if (is.null(by)) {
    by <- "value"
  } else {
    stopifnot(length(x) == length(by))
  }
  
  df <- data_frame(value = x, by = by) %>% 
    group_by(by) %>% 
    do(data = boxplot.stats(.$value))
  
  bxps <- map(df$data, "stats")
  
  hc <- hc %>%
    hc_xAxis(categories = df$by) %>% 
    hc_add_series(data = bxps, type = "boxplot", ...)
  
  if (outliers) {
    outs <- map2_df(seq(nrow(df)), df$data, function(x, y){
      if (length(y$out) > 0)
        d <- data_frame(x = x - 1, y = y$out)
      else
        d <- data_frame()
      d
    })
    
    if (nrow(outs) > 0) {
      hc <- hc %>%
        hc_add_series_df(
          data = outs, name = "outliers", type = "scatter",linkedTo = ":previous",
          marker = list(...),
          tooltip = list(
            headerFormat = "<span>{point.key}</span><br/>",
            # pointFormat = "Observation: {point.y}"
            pointFormat = "<span style='color:{point.color}'></span> Outlier: <b>{point.y}</b><br/>"
            ),
          ...
          )
    }
      
    
  }
  
  hc
  
}

# I think its better use a more autoexplained name
hc_add_series_whisker <- hc_add_series_boxplot

highchart() %>% 
  hc_add_series_boxplot(x = iris$Sepal.Length, by = iris$Species,
                        name = "length", color = "red",
                        fillColor = "transparent", lineColor = "red",  lineWidth = 1)

# support omitted `by` option
hc_add_series_boxplot(hc = highchart(), x = iris$Sepal.Length) 

library(diamonds, package = "ggplot2")
head(diamonds)

## Source: local data frame [6 x 10]
## 
##   carat       cut  color clarity depth table price     x     y     z
##   (dbl)    (fctr) (fctr)  (fctr) (dbl) (dbl) (int) (dbl) (dbl) (dbl)
## 1  0.23     Ideal      E     SI2  61.5    55   326  3.95  3.98  2.43
## 2  0.21   Premium      E     SI1  59.8    61   326  3.89  3.84  2.31
## 3  0.23      Good      E     VS1  56.9    65   327  4.05  4.07  2.31
## 4  0.29   Premium      I     VS2  62.4    58   334  4.20  4.23  2.63
## 5  0.31      Good      J     SI2  63.3    58   335  4.34  4.35  2.75
## 6  0.24 Very Good      J    VVS2  62.8    57   336  3.94  3.96  2.48

highchart() %>% 
  hc_add_series_boxplot(diamonds$x, diamonds$color, name = "X", color = "#2980b9") 

highchart() %>% 
  hc_add_series_boxplot(diamonds$x, diamonds$color, name = "X", color = "red") %>% 
  hc_plotOptions(scatter = list(marker = list(fillColor = "transparent", lineWidth = 1, lineColor = "red")))

# here y remove outliers because the use the SAME x coordinates
highchart() %>% 
  hc_add_series_boxplot(diamonds$x, diamonds$color, outliers = FALSE, name = "x") %>%
  hc_add_series_boxplot(diamonds$y, diamonds$color, outliers = FALSE, name = "y")

highchart() %>% 
  hc_add_series_boxplot(x = diamonds$x, by = diamonds$color, name = "x") %>%
  hc_add_series_boxplot(diamonds$y, diamonds$color, name = "y") %>% 
  hc_add_series_boxplot(diamonds$z, diamonds$color, name = "z")