ggplot2 boxplot to ggplotly

   Package "plotly" provide powerful web interactive tools in chart. ggplot2 is very intuitively for creating charts. Use ggplotly to transform ggplot2 object into plotly object is very convenient. But sometimes it's will make you surprised

For example

```{r}
library(ggplot2)
library(plotly)

df <- diamonds
p <- ggplot(df, aes_string(x = 'carat', y = 'cut')) +
  geom_boxplot()
print(p)

```

But the chart will not as you desire if you use ggplotly

 
```{r}
library(ggplot2)
library(plotly)
df <- diamonds
p <- ggplot(df, aes_string(x = 'carat', y = 'cut')) +
  geom_boxplot()
print(ggplotly(p))
```

 

plotly default set boxplot as verticle, so we use coord_flip to plot horizontal boxplot

```{r}
p <- ggplot(df, aes_string(y = 'carat', x = 'cut')) +
  geom_boxplot()+
  coord_flip()
print(ggplotly(p))

```

for grouped boxplot

```{r}
p <- ggplot(df, aes_string(y = 'carat', x = 'cut', color = 'clarity')) +
  geom_boxplot() +
  coord_flip()
print(p)
```

 

use ggplotly get stacked boxplot

```{r}
p <- ggplot(df, aes_string(y = 'carat', x = 'cut', color = 'clarity')) +
  geom_boxplot() +
  coord_flip()
print(ggplotly(p))
```

fine tune ploty layout:

```{r}
p <- ggplot(df, aes_string(y = 'carat', x = 'cut', color = 'clarity')) +
  geom_boxplot() +
  coord_flip()
print(ggplotly(p) %>% layout(boxmode='group'))
```

Color Ramping using linear approximation

R colorRAmpPalette method with linear approximation: Input C1=(r1,g1,b1), C2=(r2,g2,b2), C3=(r3,g3,b3) and k as number of colors to generate Idea: A walk from C1 to C3 passing through C2 with equal steps. Implement The result color list denote by RC Step1 : the first half colors list distance for one step from C1 to C2 denoted by D1: (C2-C1)/((k-1)/2) RC = C1 + 1:int(k/2) * D1 Step 2: if k is odd, add C2 into this list RC = RC + C2 Step 3: the other half color list distance for one step from C2 to C3 denoted by D2: (C3-C2)/((k-1)/2) RC = RC + (C2 + 1:int(k/2) * D2) Step 4: All the element in RC must between 0 and 255

updateusr method for better barplot with lines/points

When using barplot with add y2 axis for lines or points by par(new=TRUE)  as show in the example code usually get shifted.

The updateusr method from Greg Snow's TeachingDemos package is a great solution for this problem. The idea behind updateusr is define new plot region according to the ratio of one unit in each axis.

The code:

	updateusr <- function(x1, y1=NULL, x2, y2=NULL) {
	xy1 <- xy.coords(x1,y1)
	xy2 <- if( missing(x2) && missing(y2) ) {
	xy.coords(y1)
	} else {
	xy.coords(x2,y2)
	}
	cur.usr <- par('usr')
	xslope <- diff(xy2$x)/diff(xy1$x)
	yslope <- diff(xy2$y)/diff(xy1$y)
	new.usr.x <- xslope * ( cur.usr[1:2] - xy1$x ) + xy2$x
	new.usr.y <- yslope * ( cur.usr[3:4] - xy1$y ) + xy2$y
	invisible(par(usr=c(new.usr.x, new.usr.y)))
	}

view raw updateusr hosted with ❤ by GitHub

Example code:(add space 8/20)

	yy <- c(4,6,13,24,15,13,14,8,2,1)
	n <- length(yy)
	bar <- data.frame(Group=LETTERS[1:n], value=yy*1000, yield=yy+rnorm(n,50,10))
	ylim <- c(0,max(bar$value))
	space <- 0.3
	xlim <- c(0, floor((1+space)*n)+1)
	plot(0, xaxs = "i", xlim = xlim, ylim = ylim, main = "Barplot with Line use par(new=TRUE)", xlab = "", ylab = "", type = "n", axes = FALSE)
	r <- barplot(bar$value, axes=F, axisnames = FALSE, space = space, add = T)
	axis(1, at = r, labels = LETTERS[1:n])
	axis(2, at = seq(0,ylim[2], 1000), las = 2)
	#use par new
	par(new = TRUE)
	plot(x = r, y = bar$yield, axes = FALSE, xlim = xlim, ylim = c(0,110) ,xlab = "", ylab = "",type = "o")
	abline(v=r, lty = 2, col = "red")
	axis(4, at = seq(0, 110, 10))
	box()
	plot(0, xaxs = "i", xlim = xlim, ylim = ylim, main = "Barplot with Line use updateusr", xlab = "", ylab = "", type = "n", axes = FALSE)
	r <- barplot(bar$value, axes=F, axisnames = FALSE, space = space, add = T)
	axis(1, at = r, labels = LETTERS[1:n])
	axis(2, at = seq(0,ylim[2], 1000), las = 2)
	#By using updateusr
	updateusr(r[1:2], ylim/100, r[1:2], 0:1)
	lines(x = r, y = bar$yield, type = "o")
	abline(v=r, lty = 2, col = "red")
	axis(4, at = seq(0, 110, 10))
	box()

view raw gistfile1.txt hosted with ❤ by GitHub

Result:

Error: Package 'XXX' was build before 3.x.x: please re-install it

For install new package which previous install use different R version cause the error:
"Error: Package 'XXX' was build before 3.x.x: please re-install it"


solution:
update.packages(checkBuilt = TRUE, ask = FALSE)

for user privilege issue:
use SUDO R, then update.packages(checkBuilt = TRUE, ask = FALSE)

Reference:
https://stackoverflow.com/questions/16987948/causes-of-error-package-was-built-before-3-0-0-please-re-install-it

wafer map pattern recognization by fingerprint matching/DNA sequence matching method?

寫下來才不會又忘了 wafer map --> whole fingerprint/total DNA sequence pattern --> partial fingerprint/partial DNA sequence Q1: how to define pattern character as fingerprint's character(minutia/ridge points...) encoding wafer map pattern as DNA sequence Q2: which algorithm to apply? Reference: BFAST Fingerprint Recognition Algorithms for Partial and Full Fingerprints

Boxplot in R

boxplot.stats for calculating.
the argument coef for multuplier of the IQR. 0 for extream data points in data

returning statistics are lower whisker, P25, median,P75, upper whisker

 

Wave Chart

The bar plot always start at line 0, therefore use xlim for located the barplot at different x-axis position.
The code:

	waveChart <- function(x, group, xAt, lineStat = "mean", barScale = 0.5, plotType = "B", title = "", xlab = "", ylab = "", ...){
	dots <- list(...)
	allhg <- hist(x$value, plot = F)
	breaks <- allhg$breaks
	width <- breaks[2] - breaks[1]
	nBreaks <- length(breaks)
	ylim <- range((breaks - breaks[1])/width)
	xaxisLabel <- xAt
	nxaxis <- length(xAt)
	xAtNum <- 1:nxaxis
	xlim <- c(-1,1)*0.5 + range(xAtNum)
	xlim1 <- c(0, nxaxis+1)
	groupNum <- 1
	if(!is.null(group)){
	ngroup <- unique(group)
	groupNum <- length(ngroup)
	#colSet <- setColors(groupNum)
	colSet <- rainbow(groupNum)
	colsData <- data.frame(group = as.character(ngroup), cols = colSet, stringsAsFactors = FALSE)
	} else {
	#colSet <- setColors(nxaxis)
	colSet <- rainbow(nxaxis)
	colsData <- data.frame(group = as.character(1:nxaxis), cols = colSet, stringsAsFactors = FALSE)
	}
	if(length(ngroup)>1){
	defpar <- par(no.readonly = TRUE)
	layout(matrix(c(1,2), ncol=2, nrow=1), width=c(3,1))
	par(mar=c(5.1, 4.1, 4.1, 0))
	}
	# tmpStatValue <- by(tmpAxisData$value, group, FUN = function(x, stats){statsValue(as.numeric(x), stats)}, stats = lineStat)
	plot(0, xaxs = "i", xlim = xlim1, ylim = ylim, main = title, xlab = xlab, ylab = ylab, type = "n", axes = FALSE)
	for(i in 1:nxaxis){
	tmpAxisDataAll <- x[x$xAt == xAt[i], ]
	if(is.null(group)){
	tmpAxisData <- tmpAxisDataAll$value
	useCol <- as.character(subset(colsData, group == i)$cols)
	tmp <- hist(tmpAxisData, breaks = breaks, plot=FALSE)
	if(plotType == "L"){
	tmpcur <- density(tmpAxisData, from = breaks[1], to = breaks[nBreaks])
	ycount <- (tmpcur$y/max(tmpcur$y))*barScale
	lines(i + ycount, (tmpcur$x - tmp$breaks[1])/width, col = useCol)
	} else {
	xmin <- -xAtNum[i] +xlim[1]
	xmax <- xlim1[2] - xAtNum[i]
	print(paste("i=",i, ":", xmin, ":",xmax))
	par(new = TRUE)
	barCount <- (tmp$counts/max(tmp$counts))*barScale
	barplot(barCount, xlim = c(xmin, xmax), space=0, horiz=TRUE, border = useCol, axes = FALSE, col = "transparent")
	if(plotType == "B"){
	tmpcur <- density(tmpAxisData, from = breaks[1], to = breaks[nBreaks])
	ycount <- (tmpcur$y/max(tmpcur$y))*barScale
	lines(ycount, (tmpcur$x - breaks[1])/width, col = useCol)
	}
	}
	} else {
	for(n.group in 1:groupNum){
	useCol <- as.character(subset(colsData, group == ngroup[n.group])$cols)
	tmpData <- (subset(tmpAxisDataAll, group == ngroup[n.group]))$value
	tmpH <- hist(tmpData, breaks = breaks, plot =FALSE)
	if(plotType == "L"){
	tmpData <- na.omit(tmpData)
	tmpcur <- density(tmpData, from = breaks[1], to = breaks[nBreaks])
	ycount <- (tmpcur$y/max(tmpcur$y))*barScale
	lines(i + ycount, (tmpcur$x - breaks[1])/width, col = useCol)
	} else {
	xmin <- -xAtNum[i] + xlim[1]
	xmax <- xlim1[2] - xAtNum[i]
	barCount <- (tmpH$counts/max(tmpH$counts))*barScale
	par(new = TRUE)
	barplot(barCount, space=0, xlim = c(xmin, xmax), axes = FALSE, horiz=TRUE, col = "transparent", border = useCol)
	if(plotType == "B"){
	tmpData <- na.omit(tmpData)
	tmpcur <- density(tmpData, from = breaks[1], to = breaks[nBreaks])
	ycount <- (tmpcur$y/max(tmpcur$y))*barScale
	lines(ycount, (tmpcur$x - breaks[1])/width, col = useCol)
	}
	}
	}
	}
	}
	if(plotType == "L"){
	abline(v = xAtNum)
	axis(1, at = xAtNum, labels = xAt)
	} else {
	abline(v = 1-xAtNum)
	axis(1, at = rev(1-xAtNum), labels = xAt)
	}
	axis(2, at = (breaks - breaks[1])/width, labels = breaks, las = 2)
	box()
	if(!is.null(group)){
	par(xpd = T, mar=c(5.1, 0.5, 4.1, 6.1))
	plot.new()
	plot.window(c(0,1), c(0,1))
	textNo <- max(nchar(colsData$group))
	if(textNo > 20){
	cex <- 0.6
	} else if(textNo > 15){
	cex <- 0.8
	} else {
	cex <- 1
	}
	tmplegend <- colsData$group
	cols <- as.character(colsData$cols)
	legend("topleft", legend = tmplegend, col=cols, pch = 16, text.col=cols, inset=0.05, cex = cex)
	par(defpar)
	}
	}
	#test data
	x <- data.frame(value = c(rnorm(250), rnorm(250, -1, 2), rgamma(250,4), rgamma(250, 1, 3)), group = rep(c(rep("G1", 100), rep("G2", 80), rep("G3", 70)), 4), xAt = rep(c("A", "B", "C", "D"), each = 250))
	group <- NULL
	xAt <- unique(x$xAt)
	waveChart(x, group,xAt, barScale = 0.8, title = "Histogram and Density Chart", xlab = "Main Group", ylab = "Value")
	waveChart(x, x$group,xAt, barScale = 0.8, title = "Histogram and Density Chart", xlab = "Main Group", ylab = "Value")

view raw waveChart hosted with ❤ by GitHub

TO DO: add lines for input statistics

Reference : Quantile regression Chart by Philippe Grosjean, http://addictedtor.free.fr/graphiques/RGraphGallery.php?graph=109