Mercurial > repos > peter-waltman > ucsc_cluster_tools2

comparison cluster.tools/gen.matrix.heatmap.R @ 0:0decf3fd54bc draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author peter-waltman
date Thu, 28 Feb 2013 01:45:39 -0500
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:0decf3fd54bc
1 #!/usr/bin/env Rscript
2 argspec <- c("
3
4 Usage:
5 gen.matrix.heatmap.R -d <data.file>
6 Optional:
7 -o <output_file>
8 \n\n")
9 args <- commandArgs(TRUE)
10 if ( length( args ) == 1 && args =="--help") {
11 write(argspec, stderr())
12 q();
13 }
14
15
16 lib.load.quiet <- function( package ) {
17 package <- as.character(substitute(package))
18 suppressPackageStartupMessages( do.call( "library", list( package=package ) ) )
19 }
20 lib.load.quiet(getopt)
21 lib.load.quiet( gplots )
22 lib.load.quiet( amap )
23 lib.load.quiet( ctc )
24 if ( any( c( 'flashClust', 'fastcluster' ) %in% installed.packages() ) ) {
25 if ( 'flashClust' %in% installed.packages() ) {
26 lib.load.quiet( flashClust )
27 } else {
28 if ( 'fastcluster' %in% installed.packages() ) {
29 lib.load.quiet( fastcluster )
30 }
31 }
32 }
33
34
35 spec <- matrix( c( "dataset", "d", 1, "character",
36 "reverse.rows", "r", 2, "character",
37 "image.format", "i", 2, "character",
38 "output.fname", "o", 2, "character",
39 "output.report.html", "h", 2, "character",
40 "output.report.dir", "p", 2, "character",
41 "output.treeview", "t", 2, "character"
42 ),
43 nc=4,
44 byrow=TRUE
45 )
46
47
48 opt <- getopt( spec=spec )
49 if ( is.null( opt$image.format ) ){
50 opt$image.format <- "png"
51 } else {
52 if ( ! opt$image.format %in% c( "pdf", "png" ) ) stop( 'invalid image format specified\n' )
53 }
54 if ( is.null( opt$output.report.dir ) ) { opt$output.report.dir <- "report" }
55 if ( is.null( opt$output.report.html ) ) {
56 if ( opt$image.format == "pdf" ) opt$output.report.html <- "report/heatmap.pdf"
57 if ( opt$image.format == "png" ) opt$output.report.html <- "report/index.html"
58 }
59 if ( is.null( opt$output.treeview ) ) {
60 opt$output.treeview <- FALSE
61 } else {
62 if ( ! opt$output.treeview %in% c( "no", "yes" ) ) {
63 stop( "invalid input to output.treeview param", opt$output.treeview, "\n" )
64 }
65 ## set to TRUE/FALSE
66 opt$output.treeview <- ( opt$output.treeview == "yes" )
67 }
68 if ( is.null( opt$reverse.rows ) ) {
69 opt$reverse.rows <- TRUE
70 } else {
71 if ( ! opt$reverse.rows %in% c( "no", "yes" ) ) {
72 stop( "invalid input to reverse.rows param", opt$reverse.rows, "\n" )
73 }
74
75 ## set to TRUE/FALSE
76 opt$reverse.rows <- ( opt$reverse.rows == "yes" )
77 }
78
79 if ( ( opt$image.format == "png" ) || opt$output.treeview ) {
80 if ( !file.exists( opt$output.report.dir ) ){
81 dir.create(opt$output.report.dir, recursive=T)
82 }
83 }
84
85
86 data <- as.matrix( read.delim(opt$dataset, row.names=1, check.names=F ) ) ## should load the cl, treecl.res (or partcl.res) and data
87 hr <- hclust( Dist( data, "euclidean" ) )
88 row.ddr <- as.dendrogram( hr )
89 if ( opt$reverse.rows ) row.ddr <- rev( row.ddr )
90 hc <- hclust( Dist( t( data ), "euclidean" ) )
91 col.ddr <- as.dendrogram( hc )
92 hmcols<-colorRampPalette(c("blue","white","red"))(256)
93
94 param.list <- list( x=data,
95 Rowv=row.ddr,
96 Colv=col.ddr,
97 dendrogram="both",
98 trace="none",
99 col=hmcols,
100 symbreaks=TRUE,
101 scale="none",
102 labRow="",
103 labCol="",
104 na.color='grey' ) #,
105 ##key=FALSE )
106
107
108 if ( opt$image.format == 'png' ) {
109
110 png.fname <- file.path( opt$output.report.dir, "cluster.heatmap.png")
111 plot.dev <- png( png.fname,
112 width=8.5,
113 height=11,
114 units='in',
115 res=72 )
116 } else {
117 pdf.fname <- opt$output.report.html
118 pdf( opt$output.report.html,
119 paper="letter" )
120 }
121
122 heatmap.retval <- do.call( "heatmap.2", param.list )
123 dev.off()
124
125 if ( opt$image.format == 'png' ) {
126 pngs = list.files(path=opt$output.report.dir, patt="png")
127 html.out <- paste( "<html>",
128 paste( paste( paste( "<div><img src=\'", pngs, sep="" ), "\'/></div>", sep="" ), collapse=""),
129 "</html>" )
130 cat( html.out, file=opt$output.report.html )
131 }
132
133
134 if ( opt$output.treeview ) {
135 treeview.fname.stem <- file.path( opt$output.report.dir, "cluster.heatmap")
136
137 fnames <- character()
138 fname <- paste( treeview.fname.stem, ".gtr", sep="" )
139 r2gtr( hr, file=fname )
140 fnames <- c( fnames, fname )
141
142 fname <- paste( treeview.fname.stem, ".atr", sep="" )
143 r2atr( hc, file=fname )
144 fnames <- c( fnames, fname )
145
146 fname <- paste( treeview.fname.stem, ".cdt", sep="" )
147 r2cdt( hr, hc, data, file=fname )
148 fnames <- c( fnames, fname )
149
150 ## jtv file now
151 jtv.str <- '<DocumentConfig><UrlExtractor/><ArrayUrlExtractor/><Views><View type="Dendrogram" dock="1"><ColorExtractor contrast="2.0"><ColorSet zero="#FFFFFF" down="#0000FF"/></ColorExtractor><ArrayDrawer/><GlobalXMap current="Fill"><FixedMap type="Fixed"/><FillMap type="Fill"/><NullMap type="Null"/></GlobalXMap><GlobalYMap current="Fill"><FixedMap type="Fixed"/><FillMap type="Fill"/><NullMap type="Null"/></GlobalYMap><ZoomXMap><FixedMap type="Fixed"/><FillMap type="Fill"/><NullMap type="Null"/></ZoomXMap><ZoomYMap><FixedMap type="Fixed"/><FillMap type="Fill"/><NullMap type="Null"/></ZoomYMap><TextView><TextView face="Monospaced" size="14"><GeneSummary/></TextView><TextView face="Monospaced" size="14"><GeneSummary/></TextView><TextView face="Monospaced" size="14"><GeneSummary/></TextView><TextView face="Monospaced" size="14"><GeneSummary/></TextView></TextView><ArrayNameView face="Monospaced" size="14"><ArraySummary included="0"/></ArrayNameView><AtrSummary/><GtrSummary/></View></Views></DocumentConfig>'
152 fname <- paste( treeview.fname.stem, ".jtv", sep="" )
153 cat( jtv.str, file=fname )
154 fnames <- c( fnames, fname )
155
156 cmd <- paste( "tar -zcf", opt$output.fname, paste( "--directory=", opt$output.report.dir, sep="" ), paste( basename( fnames ), collapse=" " ) )
157 system( cmd )
158 }
159
160