ggplot2Example: Test Package for ggplot2

#@notes
# This function requires 
# ggplot2, scales, grid, gridExtra

#@usage:
format_si <- function(...) {
  # Format a vector of numeric values according
  # to the International System of Units.
  # Returns:
  #   A function to format a vector of strings using
  #   SI prefix notation
  function(x) {
    limits <- c(1e-24, 1e-21, 1e-18, 1e-15, 1e-12,
                1e-9,  1e-6,  1e-3,  1e0,   1e3,
                1e6,   1e9,   1e12,  1e15,  1e18,
                1e21,  1e24)
    prefix <- c("y",   "z",   "a",   "f",   "p",
                "n",   "µ",   "m",   " ",   "K",
                "M",   "G",   "T",   "P",   "E",
                "Z",   "Y")
    
    # Vector with array indices according to position in intervals
    i <- findInterval(abs(x), limits)
    # Set prefix to " " for very small values < 1e-24
    i <- ifelse(i==0, which(limits == 1e0), i)
    paste(format(round(x/limits[i], 1),trim=TRUE, scientific=FALSE, ...),prefix[i])
  }
}

#@usage:
updateParam <- function(new, default){
  default[names(new)] <- new
  return(default)
}

plotTS <- function(x, y, grp, xlab, ylab, xlim, ylim, main, xLabFmt, useSci=FALSE, 
                   geom.param=list(), 
                   x.axis.param=list(),
                   theme.legend = list()
                   ){
  DT <- data.table(x=x,y=y)
  if(!missing('grp')) DT[,grp:=grp]
  #lines with many options
  p <- ggplot(DT)
  p <- p + do.call(geom_line, geom.param)
  p <- p + aes(x = x, y = y, color=grp)
  # remove this ***UGLY*** grey theme
  p <- p + theme_bw()
  # legend
  theme.legend.default <- list(legend.position = c(0.1,0.98), 
                               legend.direction = 'horizontal', 
                               legend.background = element_rect(fill='transparent'), 
                               legend.key = element_blank(),
                               legend.title = element_blank())
  theme.legend <- updateParam(theme.legend,theme.legend.default)
  p <- p + do.call(theme, theme.legend)
  # vertical label on x-axis
  x.axis.param.default <- list(angle = 90, vjust = 0.5, hjust=1)
  x.axis.param <- updateParam(x.axis.param, x.axis.param.default)
  p <- p + theme(axis.text.x = do.call(element_text, x.axis.param))
  # change x-axis format
  if(inherits(x,'Date')){
    p <- p + scale_x_date(labels = date_format(if(missing('xLabFmt')) '%Y%m%d' else xLabFmt),
                          limits = if(missing('xlim')) NULL else xlim)
  }else if(inherits(x,'POSIXct')){
    p <- p + scale_x_datetime(labels = date_format(if(missing('xLabFmt')) '%Y%m%d %H:%M:%OS' else xLabFmt),
                          limits = if(missing('xlim')) NULL else xlim)
  }
  # xlab
  if(!missing('xlab')) p <- p + ggplot2:::xlab(xlab)
  # ylab
  if(!missing('ylab')) p <- p + ggplot2:::ylab(ylab)
  if(!missing('ylim')) p <- p + ggplot2:::ylim(ylim)
  # title
  if(!missing('main')) p <- p + ggtitle(main)
  # have si units
  p <- p + scale_y_continuous(labels= if(useSci) format_si() else waiver())
  # change colorscheme
  p <- p +scale_color_brewer(palette="Set1")
  return(p)  
}

#@usage:
#@notes: outlier.shape=NA for no outliers
plotBP <- function(x, y, grp, xlab, ylab, xlim, ylim, main, xLabFmt, useSci=FALSE, 
                   geom.param = list(),
                   x.axis.param=list(angle = 90, vjust = 0.5, hjust=1), 
                   theme.legend = list()
                   ){
  DT <- data.table(x=x,y=y)
  if(!missing('grp')) DT[,grp:=grp]
  p <- ggplot(DT)
  # update geom
  geom.param.default <- list(outlier.shape=NA)
  geom.param <- updateParam(geom.param, geom.param.default)
  p <- p + do.call(geom_boxplot, geom.param)
  # aesthetics
  p <- p + aes(x = x, y = y, group=interaction(x,grp),fill = grp)
  # remove this ***UGLY*** grey theme
  p <- p + theme_bw() 
  # legend
  theme.legend.default <- list(legend.position = c(0.1,0.98), 
                               legend.direction = 'horizontal', 
                               legend.background = element_rect(fill='transparent'), 
                               legend.key = element_blank(),
                               legend.title = element_blank())
  theme.legend <- updateParam(theme.legend,theme.legend.default)
  p <- p + do.call(theme, theme.legend)
  # vertical label on x-axis
  p <- p + theme(axis.text.x = do.call(element_text, x.axis.param))
  # change x-axis format
  if(inherits(x,'Date')){
    p <- p + scale_x_date(labels = date_format(if(missing('xLabFmt')) '%Y%m%d' else xLabFmt),
                          limits = if(missing('xlim')) NULL else xlim)
  }else if(inherits(x,'POSIXct')){
    p <- p + scale_x_datetime(labels = date_format(if(missing('xLabFmt')) '%Y%m%d %H:%M:%OS' else xLabFmt),
                          limits = if(missing('xlim')) NULL else xlim)
  }
  # xlab
  if(!missing('xlab')) p <- p + ggplot2:::xlab(xlab)
  # ylab
  if(!missing('ylab')) p <- p + ggplot2:::ylab(ylab)
  if(!missing('ylim')) p <- p + ggplot2:::ylim(ylim)
  # title
  if(!missing('main')) p <- p + ggtitle(main)
  # have si units
  p <- p + scale_y_continuous(labels= if(useSci) format_si() else waiver())
  # change colorscheme
  p <- p + scale_fill_brewer(palette="Set1")
  return(p)  
}

#@usage: plot bar chart
plotBC <- function(x, y, grp, xlab, ylab, xlim, ylim, main, xLabFmt, useSci=FALSE,
                   geom.param=list(),
                   x.axis.param=list(), 
                   theme.legend = list()
                  ){
  DT <- data.table(x=x,y=y)
  if(!missing('grp')) DT[,grp:=grp]
  p <- ggplot(DT)
  # update geom
  geom.param.default <- list(position='dodge',stat='identity')
  geom.param <- updateParam(geom.param, geom.param.default)
  p <- p + do.call(geom_bar, geom.param)
  # aesthetics
  p <- p + aes(x = x, y = y, group=interaction(x,grp),fill = grp)
  # remove this ***UGLY*** grey theme
  p <- p + theme_bw() 
  # legend
  theme.legend.default <- list(legend.position = c(0.1,0.98), 
                               legend.direction = 'horizontal', 
                               legend.background = element_rect(fill='transparent'), 
                               legend.key = element_blank(),
                               legend.title = element_blank())
  theme.legend <- updateParam(theme.legend,theme.legend.default)
  p <- p + do.call(theme, theme.legend)
  # vertical label on x-axis
  x.axis.param.default <- list(angle = 90, vjust = 0.5, hjust=1)
  x.axis.param <- updateParam(x.axis.param, x.axis.param.default)
  p <- p + theme(axis.text.x = do.call(element_text, x.axis.param))
  # change x-axis format
  if(inherits(x,'Date')){
    p <- p + scale_x_date(labels = date_format(if(missing('xLabFmt')) '%Y%m%d' else xLabFmt),
                          limits = if(missing('xlim')) NULL else xlim)
  }else if(inherits(x,'POSIXct')){
    p <- p + scale_x_datetime(labels = date_format(if(missing('xLabFmt')) '%Y%m%d %H:%M:%OS' else xLabFmt),
                          limits = if(missing('xlim')) NULL else xlim)
  }
  # xlab
  if(!missing('xlab')) p <- p + ggplot2:::xlab(xlab)
  # ylab
  if(!missing('ylab')) p <- p + ggplot2:::ylab(ylab)
  if(!missing('ylim')) p <- p + ggplot2:::ylim(ylim)
  # title
  if(!missing('main')) p <- p + ggtitle(main)
  # have si units
  p <- p + scale_y_continuous(labels= if(useSci) format_si() else waiver())
  # change colorscheme
  p <- p + scale_fill_brewer(palette="Set1")
  return(p)  
  
}

testFunction <- function(){
	plot(1:9)
	library(data.table)
}