How to perform Non-metric multidimensional scaling (NMDS) analysis
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # modifed from http://sickel.net/blogg/?p=688 | |
| # This R script create group bar graph with error bars and split y axis | |
| # Library | |
| library(gplots) | |
| library(extrafont) | |
| #font_import() # only one time required when first time use the library extrafont | |
| #y | |
| fonts() | |
| loadfonts() | |
| library(RColorBrewer) | |
| #define function | |
| cnvrt.coords <-function(x,y=NULL){ | |
| xy <- xy.coords(x,y, recycle=TRUE) | |
| cusr <- par('usr') | |
| cplt <- par('plt') | |
| plt <- list() | |
| plt$x <- (xy$x-cusr[1])/(cusr[2]-cusr[1]) | |
| plt$y <- (xy$y-cusr[3])/(cusr[4]-cusr[3]) | |
| fig <- list() | |
| fig$x <- plt$x*(cplt[2]-cplt[1])+cplt[1] | |
| fig$y <- plt$y*(cplt[4]-cplt[3])+cplt[3] | |
| return( list(fig=fig) ) | |
| } | |
| subplot <- function(fun, x, y=NULL){ | |
| old.par <- par(no.readonly=TRUE) | |
| on.exit(par(old.par)) | |
| xy <- xy.coords(x,y) | |
| xy <- cnvrt.coords(xy)$fig | |
| par(plt=c(xy$x,xy$y), new=TRUE) | |
| fun | |
| tmp.par <- par(no.readonly=TRUE) | |
| return(invisible(tmp.par)) | |
| } | |
| # define the color for bar | |
| #gg_color_hue <- function(n) { | |
| # hues = seq(15, 375, length = n + 1) | |
| # hcl(h = hues, l = 65, c = 100)[1:n] | |
| #} | |
| #n = 4 # number of color | |
| #cols = gg_color_hue(n) | |
| cols <- brewer.pal(4,"Set3") | |
| # dataset: | |
| data=data.frame(Gene1=c(1,229.05,232.27,233.17),Gene2=c(1,8.9,11.07,10.77),Gene3=c(1,13.954,11.7,51.9),Gene4=c(1,3.4,3.75,6.23),Gene5=c(1,1.74,3.78,0.95)) | |
| # Set the place to break the axis | |
| lower=c(0,60) | |
| upper=c(180,260) | |
| y_outer=21 | |
| lowspan=c(0,11) | |
| topspan=c(lowspan[2]+1,21) | |
| # axis and legend labeling | |
| ylabel="Relative expression" | |
| xlabel="Genes" | |
| legendtext=c('Gene1','Gene2','Gene3','Gene4') | |
| jpeg("heatmap1.jpg", units="in", family="Times New Roman", width=5, height=4, res=300, pointsize = 7) #pointsize is font size| increase image size to see the key | |
| plot(c(0,1),c(0,y_outer),type='n',axes=FALSE,ylab=ylabel,xlab=xlabel,lwd=7,cex.lab=1.3,font.lab = 2, xaxs = 'i',yaxs="i") | |
| subplot({ | |
| y <- as.matrix(data) | |
| bp <- barplot(y,col=cols,beside=T,ylim=lower,xpd=FALSE,las=1,cex.names=1.3) | |
| arrows(bp, y * .95, bp, y * 1.05, xpd = NA, angle = 90, code = 3, | |
| length = .03,width = .01, col = ifelse(y > max(lower), 0, 1)) | |
| },x=c(0,1),y=lowspan) | |
| subplot({ | |
| bp <- barplot(y, col=cols,beside=T, ylim=upper, cex.names=1.3, las=1, xpd=FALSE, | |
| names.arg=vector(mode="character",length=length(data))) | |
| arrows(bp, y * .95, bp, y * 1.05, xpd = NA, angle = 90, code = 3, | |
| length = .03, width = .01,col = ifelse(y > max(lower), 1, 0)) | |
| axis(2,at=seq(0,60,20)) | |
| }, x=c(0,1), y=topspan) | |
| legend("topright",legendtext,fill=cols,bty = "n",horiz = F) # Legend position | |
| abline(h = 0, col = "black") | |
| dev.off() |
Post a Comment