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

Uploaded
author peter-waltman
date Thu, 28 Feb 2013 01:45:39 -0500
parents
children
line wrap: on
line source

#!/usr/bin/env Rscript
argspec <- c("

        Usage: 
                gen.matrix.heatmap.R -d <data.file> 
        Optional:
                            -o <output_file>
                \n\n")
args <- commandArgs(TRUE)
if ( length( args ) == 1 && args =="--help") { 
  write(argspec, stderr())
  q();
}


lib.load.quiet <- function( package ) {
   package <- as.character(substitute(package))
   suppressPackageStartupMessages( do.call( "library", list( package=package ) ) )
}
lib.load.quiet(getopt)
lib.load.quiet( gplots )
lib.load.quiet( amap )
lib.load.quiet( ctc )
if ( any( c( 'flashClust', 'fastcluster' ) %in% installed.packages() ) ) {
  if ( 'flashClust' %in% installed.packages() ) {
    lib.load.quiet( flashClust )
  } else {
    if ( 'fastcluster' %in% installed.packages() ) {
      lib.load.quiet( fastcluster )
    }
  }
}


spec <- matrix( c( "dataset",             "d", 1, "character",
                   "reverse.rows",        "r", 2, "character",
                   "image.format",        "i", 2, "character",
                   "output.fname",        "o", 2, "character",
                   "output.report.html",  "h", 2, "character",
                   "output.report.dir",   "p", 2, "character",
                   "output.treeview",     "t", 2, "character"
                   ),
                nc=4,
                byrow=TRUE
               )


opt <- getopt( spec=spec )
if ( is.null( opt$image.format ) ){
  opt$image.format <- "png"
} else {
  if ( ! opt$image.format %in% c( "pdf", "png" ) ) stop( 'invalid image format specified\n' )
}
if ( is.null( opt$output.report.dir ) ) { opt$output.report.dir <- "report" }
if ( is.null( opt$output.report.html ) ) {
  if ( opt$image.format == "pdf" ) opt$output.report.html <- "report/heatmap.pdf"
  if ( opt$image.format == "png" ) opt$output.report.html <- "report/index.html"
}
if ( is.null( opt$output.treeview ) ) {
  opt$output.treeview <- FALSE
} else {
  if ( ! opt$output.treeview %in% c( "no", "yes" ) ) {
    stop( "invalid input to output.treeview param", opt$output.treeview, "\n" )
  }
  ##  set to TRUE/FALSE
  opt$output.treeview <- ( opt$output.treeview == "yes" )
}
if ( is.null( opt$reverse.rows ) ) {
  opt$reverse.rows <- TRUE
}  else {
  if ( ! opt$reverse.rows %in% c( "no", "yes" ) ) {
    stop( "invalid input to reverse.rows param", opt$reverse.rows, "\n" )
  }

  ##  set to TRUE/FALSE
  opt$reverse.rows <- ( opt$reverse.rows == "yes" )
}

if ( ( opt$image.format == "png" ) || opt$output.treeview ) {
  if ( !file.exists( opt$output.report.dir ) ){
    dir.create(opt$output.report.dir, recursive=T)
  }
}


data <- as.matrix( read.delim(opt$dataset, row.names=1, check.names=F ) )  ## should load the cl, treecl.res (or partcl.res) and data
hr <- hclust( Dist( data, "euclidean" ) )
row.ddr <- as.dendrogram( hr )
if ( opt$reverse.rows ) row.ddr <- rev( row.ddr )
hc <- hclust( Dist( t( data ), "euclidean" ) )
col.ddr <- as.dendrogram( hc )
hmcols<-colorRampPalette(c("blue","white","red"))(256)

param.list <- list( x=data,
                    Rowv=row.ddr,
                    Colv=col.ddr,
                    dendrogram="both",
                    trace="none",
                    col=hmcols,
                    symbreaks=TRUE,
                    scale="none",
                    labRow="",
                    labCol="",
                    na.color='grey' ) #,
                    ##key=FALSE )


if ( opt$image.format == 'png' ) {
  
  png.fname <- file.path( opt$output.report.dir, "cluster.heatmap.png")
  plot.dev <- png( png.fname,
                   width=8.5,
                   height=11,
                   units='in',
                   res=72 )
} else {
  pdf.fname <- opt$output.report.html
  pdf( opt$output.report.html,
       paper="letter" )
}

heatmap.retval <- do.call( "heatmap.2", param.list )
dev.off()

if ( opt$image.format == 'png' ) {
  pngs = list.files(path=opt$output.report.dir, patt="png")
  html.out <- paste( "<html>",
                     paste( paste( paste( "<div><img src=\'", pngs, sep="" ), "\'/></div>", sep="" ), collapse=""),
                     "</html>" )
  cat( html.out, file=opt$output.report.html )
}


if ( opt$output.treeview ) {
  treeview.fname.stem <- file.path( opt$output.report.dir, "cluster.heatmap")
  
  fnames <- character()
  fname <- paste( treeview.fname.stem, ".gtr", sep="" )
  r2gtr( hr, file=fname )
  fnames <- c( fnames, fname )

  fname <- paste( treeview.fname.stem, ".atr", sep="" )
  r2atr( hc, file=fname )
  fnames <- c( fnames, fname )

  fname <- paste( treeview.fname.stem, ".cdt", sep="" )
  r2cdt( hr, hc, data, file=fname )
  fnames <- c( fnames, fname )

  ## jtv file now
  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>'
  fname <- paste( treeview.fname.stem, ".jtv", sep="" )
  cat( jtv.str, file=fname )
  fnames <- c( fnames, fname )

  cmd <- paste( "tar -zcf", opt$output.fname, paste( "--directory=", opt$output.report.dir, sep="" ), paste( basename( fnames ), collapse=" " ) )
  system( cmd )
}