ggplot2Example: Test Package for ggplot2

setwd('/home/statquant/CodeProjects/R/ggplot2/')
library(ggplot2)
library(data.table)
library(fasttime)
library(plotly)
library(scales)
set.seed(seed = 1)

testIBM <- function(){
  ibm <- fread('IBM_adjusted.txt')
  setnames(ibm,c('date','time','open','high','low','close','volume'))
  ibm[,datetime:=as.POSIXct(paste(date,time),format='%m/%d/%Y %H:%M')]
  ibm <- ibm[,.(datetime,open,high,low,close)]
  # subset this data looks like 1M points takes >1min to plot
  plotData <- ibm[1:5e4,.(datetime,px1=100*open,px2=100*(open+3*runif(.N)))]
  # you can construct by layers
  p <- ggplot(data=plotData, aes(x=datetime, y=px1))
  # to be able to plot multiple lines at once
  plotData <- data.table:::melt(plotData, id='datetime')
  p <- ggplot(data=plotData, aes(x=datetime, y=value, colour=variable))
  p <- p + geom_line()
  p
  # lines
  p <- p + do.call(geom_line, list(col='red', size=.1))
  #lines with many options
  p <- p + geom_line(size=.5, lty=2, col='red')
  # remove the ugly grey theme
  p <- p + theme_bw()
  # vertical label on x-axis
  p <- p + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
  # change x-axis format
  p <- p + scale_x_datetime(labels = date_format("%Y%m%d"))
  # xlab/ylab/title
  p <- p + xlab('myXLab') + ggtitle('myTitle')
  # have si units
  p <- p + scale_y_continuous(labels=format_si())
  # plot it
  p
  # make plotly
  ggplotly(p)
}

testPlotTS <- function(){
  library(data.table)
  library(ggplot2)
  DT <- data.table(date=seq.Date(as.Date('2011-01-01'),as.Date('2012-02-01'),1)[1:100],
                   x=cumsum(rnorm(100)))
  plotTS(DT)
  
  DT <- data.table(date=seq.Date(as.Date('2011-01-01'),as.Date('2012-02-01'),1)[1:100],
                   x=cumsum(rnorm(100)),
                   z=cumsum(rnorm(100)),
                   y=cumsum(rnorm(100)))
  DT <- data.table::melt(DT,id='date')
  DT[,plotTS(date,value,variable,theme.legend = list(legend.position=c(.2,.98 )))]
}

testBoxPlot <- function(){
	library(ggplot2)
	library(data.table)

	# create fake dataset with additional attributes - sex, sample, and temperature
	DT <- data.table(
	  values = c(runif(100, min = -2), runif(100), runif(100, max = 2), runif(100)),
	  sex = rep(c('M', 'F'), each = 100),
	  sample = rep(c('sample_a', 'sample_b'), each = 200),
	  temperature = sample(c('15C', '25C', '30C', '42C'), 400, replace = TRUE)
	)
	
	# compare different sample populations across various temperatures
	p <- ggplot(DT, aes(x = sample, y = values, fill = sex))
	p <- p + geom_boxplot()
	p <- p + facet_wrap(~ temperature)
	p
	
	DT <- data.table(
	  y = runif(400, max = 2),
	  grp = sample(c('M', 'F'),size = 400, replace = T),
	  x = rep(as.Date(1:10,origin='2011-01-01'), each = 40)
	)
	
	p <- ggplot(DT)
	p <- p + geom_boxplot()
	p <- p + aes(x = date, y = value, group=interaction(date,grp))
	p <- p + aes(fill = grp)
	p
}

testBarChart <- function(){
  library(data.table)
  library(scales)
	DT <- data.table( y = runif(400, max = 2), 
	                  grp = sample(c('M', 'F'),size = 400, replace = T), 
	                  x = rep(as.Date(1:10,origin='2011-01-01'), each = 40)
	)
	DT <- DT[,.(y=uniqueN(y)),.(x,grp)]
	
	#manual
	p <- ggplot(DT) + geom_bar(position='dodge',stat='identity') + 
	p <- p + aes(x,y,group=interaction(x,grp),fill=grp)
	#or
	DT[,plotBC(x,y,grp)]
}

testPlotArrangement <- function(){
  library(data.table)
  library(gridExtra)

	BP <- data.table( y = runif(400, max = 2), 
	                  grp = sample(c('M', 'F'),size = 400, replace = T), 
	                  x = rep(as.Date(1:10,origin='2011-01-01'), each = 40)
	)
	TS <- BP[,.(y=sum(y[1L])),.(x,grp)][,y:=cumsum(y),.(grp)]
	BC <- BP[,.(y=uniqueN(y)),.(x,grp)]
	
	#one by one
	bp <- BP[,plotBP(x,y,grp)]
	bc <- BC[,plotBC(x,y,grp)]
	ts <- TS[,plotTS(x,y,grp,x.axis.param=list(size=6))]
	#as a layout
	# with arrangement in matrix
	# with heights
	grid.arrange(ts, bp, bc , ncol=2,  layout_matrix = matrix(c(1,2,1,3),nrow=2), heights=c(2,1))
}

testSameXGraphs <- function(){
  library(data.table)
	DT <- data.table( y = runif(400, max = 2), 
	                  grp = sample(c('M', 'F'),size = 400, replace = T), 
	                  x = rep(as.Date(1:10,origin='2011-01-01'), each = 40)
	)
	TS <- DT[,.(y=sum(y[1L])),.(x,grp)][,y:=cumsum(y),.(grp)]
	#make a "hole" so it is not too easy
	BC <- DT[,.(y=uniqueN(y)),.(x,grp)][x!='2011-01-05']
	#join so the table is the same
	plotData <- merge(TS,BC,by=c('x','grp'),all=T,suffixes=c('_ts','_bc'))
  
  # 1. bad way => do not handle differnt geoms
	plotData2 <- rbindlist(list(copy(TS)[,var:=1],copy(BC)[,var:=2])) 
	p <- ggplot(plotData2) + aes(x = x, y = y, color=grp)
	p <- p + geom_line()
	p <- p + facet_grid(var ~ ., scales = "free_y")
	p
	
	# 2. grid.arrange
	#
	library(ggplot2)
	ts <- ggplot(plotData) + aes(x=x,y=y_ts,color=grp) + geom_line() 
	ts <- ts + theme(axis.ticks.x = element_blank(), axis.text.x = element_blank(), axis.title.x = element_blank())
	#
	bc <- ggplot(plotData) + aes(x=x,y=y_bc,group=interaction(x,grp),fill=grp) 
	bc <- bc + geom_bar(position='dodge',stat='identity')
  # plot stand alone	
	ts
	bc
	# with grid.arrange
	require(gridExtra)
	grid.arrange(ts, bc , ncol=1,  layout_matrix = matrix(c(1,2),nrow=2), heights=c(2,1))
	#=> plots are misaligned
	
	
	# 3. with gtable
	require(ggplot2)
	require(gtable)
	#Extract Grobs
	g1 <- ggplotGrob(ts + xlim(range(plotData[, x]) + c(-.5, .5))) 
	g2 <- ggplotGrob(bc + xlim(range(plotData[, x]) + c(-.5, .5))) 
	#Bind the tables
	g <- gtable:::rbind_gtable(g1, g2, 'first')
	#Remove a row between the plots
	g <- gtable_add_rows(g, unit(-1,"line"), pos=nrow(g1))
	#Make the second graph smaller
	panels <- g$layout$t[grep("panel", g$layout$name)]
	g$heights[panels] <- lapply(c(2,1), unit, "null")
	#draw
	grid.newpage()
	grid.draw(g)
	
	# 4. with grid.arrange *** GAGNANT ***
	require(ggplot2)
	require(gridExtra)
	g1 <- ggplotGrob(ts + xlim(range(plotData[, x]) + c(-.5, .5)) +
	                      theme(plot.margin=unit(c(0,0,0,0),'lines'))) 
	g2 <- ggplotGrob(bc + xlim(range(plotData[, x]) + c(-.5, .5)) +
	                      theme(plot.margin=unit(c(-.5,0,0,0),'lines'))) 
	maxWidth = grid::unit.pmax(g1$widths[2:5], g2$widths[2:5])
	g1$widths[2:5] <- as.list(maxWidth); 
	g2$widths[2:5] <- as.list(maxWidth); 
	grid.arrange(g1, g2, ncol=1, layout_matrix = matrix(c(1,2),nrow=2), heights=c(2,1))	
	
	# 5. stealing from cowplot *** GAGNANT ***
	ts <- ts + xlim(range(plotData[, x]) + c(-.5, .5)) +
	                      theme(plot.margin=unit(c(0,0,0,0),'lines'))
	bc <- bc + xlim(range(plotData[, x]) + c(-.5, .5)) +
	                      theme(plot.margin=unit(c(-.5,0,0,0),'lines'))
	grobs <- lapply(list(ts,bc), FUN=ggplot2::ggplotGrob)
	max_widths <- do.call(grid::unit.pmax, lapply(grobs,  function(x) { x$widths }))
	num_plots <- length(grobs)
	for (i in 1:num_plots) {
	      grobs[[i]]$widths <- max_widths
	}
	grid.arrange(grobs=grobs , ncol=1, layout_matrix = matrix(c(1,2),nrow=2), heights=c(2,1))	
	
	#@note This would work too
	p <- arrangeGrob(grobs=grobs , ncol=1, layout_matrix = matrix(c(1,2),nrow=2), heights=c(2,1))	
	p
	pdf('test.pdf',width=14,height = 10)
	grid.arrange(p, bp, bp , ncol=2,  layout_matrix = matrix(c(1,2,1,3),nrow=2))
	grid.arrange(p, bp, bp , ncol=2,  layout_matrix = matrix(c(1,2,1,3),nrow=2))
	graphics.off()
	
	#6. That might have worked with cowplot
	library(cowplot)
	theme_set(theme_bw()) 
	plot_grid(g1,g2,nrow=2,align = 'vh')
	
}

grid_arrange_shared_legend <- function(...) {
  plots <- list(...)
  for(myPlot in plots){
    if(inherits(myPlot,'ggplot')){
      g <- ggplotGrob(myPlot + theme(legend.position="bottom"))$grobs
      legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
      lheight <- sum(legend$height)
      break
    }
  }
  removeLegend <- function(myPlot){
    return(
      if(inherits(myPlot,'ggplot')) myPlot + theme(legend.position="none") else myPlot
    )
  }
  browser()
  grid.arrange( do.call(arrangeGrob, lapply(plots, removeLegend)), 
                legend, 
                ncol=2,  layout_matrix = matrix(c(1,2,1,3),nrow=2)
                )
}

commonLegend <- function(){
  #data 
  require(data.table)
	DT <- data.table( y = runif(400, max = 2), 
	                  grp = sample(c('M', 'F'),size = 400, replace = T), 
	                  x = rep(as.Date(1:10,origin='2011-01-01'), each = 40)
	)
	TS <- DT[,.(y=sum(y[1L])),.(x,grp)][,y:=cumsum(y),.(grp)]
	#make a "hole" so it is not too easy
	BC <- DT[,.(y=uniqueN(y)),.(x,grp)][x!='2011-01-05']
	#join so the table is the same
	plotData <- merge(TS,BC,by=c('x','grp'),all=T,suffixes=c('_ts','_bc'))
  
	#first plot made of 2
	require(ggplot2)
	require(scales)
	
	# first composed plot
	ts <- TS[,plotTS(x,y,grp,main='Superplot',
	                 theme.legend=list(legend.position='none'),
	                 xlim =range(x + c(-.5, .5)))]
	ts <- ts + theme(plot.margin=unit(c(0,0,0,0),'lines'))
	ts <- ts + theme(axis.ticks.x = element_blank(), axis.text.x = element_blank(), axis.title.x = element_blank())
	bc <- BC[,plotBC(x,y,grp,xlim =range(x + c(-.5, .5)),
	                 theme.legend=list(legend.position='none'),
	                 xlab='dates')]
	bc <- bc + theme(plot.margin=unit(c(-.5,0,0,0),'lines'))
	grobs <- lapply(list(ts,bc), FUN=ggplot2::ggplotGrob)
	max_widths <- do.call(grid::unit.pmax, lapply(grobs,  function(x) { x$widths }))
	num_plots <- length(grobs)
	for (i in 1:num_plots) {
	      grobs[[i]]$widths <- max_widths
	}
	p <- arrangeGrob(grobs=grobs , ncol=1, layout_matrix = matrix(c(1,2),nrow=2), heights=c(1,1))	
	
	bp <- DT[,plotBP(x,y,grp,main='Boxplot',
	                 theme.legend=list(legend.position='top'),
	                 xlab='dates')]
	grid.arrange(p, bp, bp , ncol=2,  layout_matrix = matrix(c(1,2,1,3),nrow=2))
	grid_arrange_shared_legend(p,bp,bp)
	grid.arrange(grid_arrange_shared_legend(p, bp, bp) , ncol=2,  layout_matrix = matrix(c(1,2,1,3),nrow=2))
}