R/boostedBoxplot.R

# --------------------------------------------------------------------------------
# title: boostedBoxplot
# description: Boosted Boxplot : add useful features to R boxplot function
# author: Alassane Samba (alassane.samba@orange.com)
# Copyright (c) 2017 Orange
# ---------------------------------------------------------------------------------
## Boosted Boxplot : add useful features to R boxplot function
#' @title Boosted Boxplot
#'
#' @description  Add useful features to R classical boxplot
#'
#' @param y a numeric vector.
#' @param x a factor vector.
#' @param main the title of the graphic.
#' @param labx,laby \code{character}, labels of the axis.
#' @param plot.mean a boolean to indicate whether the mean value of \code{y} must be plotted for each \code{x} category.
#' @param text.freq a boolean to indicate whether the \code{x} categories frequencies must be drawn on boxes.
#' @param las 1 or 2 to indicate whether the x-axis labels must be respectively horizontal or vertical.
#' @param ylim a vector of 2 numeric values to indicate the range of y-axis. Example : \code{c(0,1)}.
#' @param limitVisibleModalities an integer to indicate the number of categories to retain for the \code{x} variable.
#' If the number of categories is higher than \code{limitVisibleModalities}, only categories presenting the highest
#' and the lowest \code{y} median values are plotted.
#' @param decreasing a boolean indicating whether categories order on x-axis according to their corresponding median \code{y} value.
#' @param dynamic a boolean. If \code{TRUE}, an AmChart is return and the parameters \code{plot.mean} and \code{test.freq} are ignored.
#' @return If \code{dynamicity} is \code{TRUE} it returns an object of class AmChart, else it returns a classical boxplot result list.
#' @import stats
#' @import graphics
#' @import rAmCharts
#' @export
boostedBoxplot<-function(y,x=NULL, main="", labx=NULL,laby=NULL, plot.mean=T, text.freq=T, las=1, ylim=NULL, limitVisibleModalities=30, decreasing=NULL, dynamic=F){


  xlab=""
  if(is.null(labx)&!is.null(x))labx=deparse(substitute(x))
  if(is.null(laby))laby=deparse(substitute(y))
  if(main==""){
    main=labx
  }else{
    xlab=labx
  }
  if(is.null(x)){
    x=rep(laby,length(y))
    xlab=laby
    laby=""
  }
  x=droplevels(as.factor(x))
  p=length(levels(as.factor(x)))
  if(!is.null(decreasing)){
    x=factor(x,levels = names(sort(tapply(y,x,median), decreasing = decreasing)), ordered = F)
  }else{
    decreasing=T
  }
  #limitVisibleModalities
  if(limitVisibleModalities<p-1){
    x=factor(x,levels = names(sort(tapply(y,x,median), decreasing = decreasing)), ordered = F)
    lx=levels(as.factor(x))
    leftl=lx[1:floor(limitVisibleModalities/2)]
    rightl=lx[(p-floor(limitVisibleModalities/2)+1):p]
    n_other=length(lx[!lx%in%c(leftl,rightl)])
    x=as.character(x)
    x[!x%in%c(leftl,rightl)]<-paste(c("other(",n_other,")"),collapse="")
    x=as.factor(x)
    x=factor(x,levels = names(sort(tapply(y,x,median), decreasing = decreasing)), ordered = F)
  }
  #
  #dynamicity
  if(dynamic){
    dataf=data.frame(Y=y,X=x)
    rAmCharts::amBoxplot(Y~X,data=dataf,labelRotation = (las==2)*90, ylab = laby, main = main)
  }else{
    if(is.null(ylim)){
      rb<-boxplot(y~x, main=main, xlab=xlab, ylab=laby, las=las)
      grid()
      #rb<-boxplot(y~x, main=main, xlab=xlab, ylab=laby, las=las, add=T)
    }else{
      rb<-boxplot(y~x, main=main, xlab=xlab, ylab=laby, las=las, ylim=ylim)
      grid()
      #rb<-boxplot(y~x, main=main, xlab=xlab, ylab=laby, las=las, add=T)
    }
    if(plot.mean){
      mn.t <- tapply(y, x, mean, na.rm=T)
      sd.t <- tapply(y, x, sd, na.rm=T)
      xi <- 0.3-(length(levels(droplevels(as.factor(x))))==1)*0.15 + 1:length(rb$n)
      points(xi, mn.t, col = "red", pch = 18, cex=1)
      arrows(xi, mn.t - sd.t, xi, mn.t + sd.t,code = 3, col = "red", angle = 75, length = .1, lwd = 1)
    }
    if(text.freq)text(x=1:length(rb$names), y=(rb$stats[3,]+rb$stats[4,])/2,label=rb$n)
  }
}
############
sambaala/boostedBoxplot documentation built on May 29, 2019, 1:01 p.m.