diff cluster.tools/normalize.matrix.R @ 2:b442996b66ae draft

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cluster.tools/normalize.matrix.R	Wed Feb 27 20:17:04 2013 -0500
@@ -0,0 +1,88 @@
+#!/usr/bin/env Rscript
+##  Script by Peter Waltman
+## 
+## License under Creative Commons Attribution 3.0 Unported (CC BY 3.0)
+##
+argspec <- c("TBD
+
+
+        Usage: 
+                normalize.matrix.R -d <data.file> 
+        Optional:
+                -o <output.name>
+                TBD 
+                \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)
+
+
+spec <- matrix( c( "data.fname",         "d", 1, "character",
+                   "center.rows",        "r", 2, "character",
+                   "var.adj.rows",       "R", 2, "character",
+                   "center.cols",        "c", 2, "character",
+                   "var.adj.cols",       "C", 2, "character",
+                   "output.fname",       "o", 2, "character"
+                   ),
+                nc=4,
+                byrow=TRUE
+               )
+
+opt <- getopt( spec=spec )
+
+#set some reasonable defaults for the options that are needed,
+#but were not specified.
+if ( is.null( opt$output.fname ) ) {
+  out.fname <- ""
+  if ( ! is.null( opt$center.rows ) ) out.fname <- paste( "row", opt$center.rows, "centered", out.fname, sep="." )
+  if ( ! is.null( opt$center.cols ) ) out.fname <- paste( "col", opt$center.cols, "centered", out.fname, sep="." )
+  if ( ! is.null( opt$var.adj.rows ) ) out.fname <- paste( "row", opt$var.adj.rows, "var.adjed", out.fname, sep="." )
+  if ( ! is.null( opt$var.adj.cols ) ) out.fname <- paste( "col", opt$var.adj.cols, "var.adjed", out.fname, sep="." )
+  
+  opt$output.fname <- paste( out.fname, "centered.matrix", sep="." )
+}
+if ( is.null( opt$center.rows ) ) { opt$center.rows <- 'none' }
+if ( is.null( opt$center.cols ) ) { opt$center.cols <- 'none' }
+if ( is.null( opt$var.adj.rows ) ) { opt$var.adj.rows <- 'none' }
+if ( is.null( opt$var.adj.cols ) ) { opt$var.adj.cols <- 'none' }
+
+data <- as.matrix( read.delim( opt$data.fname, header=T, row.names=1 , check.names=FALSE ) )
+
+my.center <- rep( 0, nrow( data ) )
+my.var.adj <- rep( 1, nrow( data ) )
+if ( opt$center.rows != "none" ) {
+  my.center.fn <- get( opt$center.rows )
+  ##data <- sweep( data, 1, apply( data, 1, my.center.fn, na.rm=T ) )
+  my.center <- apply( data, 1, my.center.fn, na.rm=T )
+}
+if ( opt$var.adj.rows != "none" ) {
+  my.var.adj.fn <- get( opt$var.adj.rows )
+  my.var.adj <- apply( data, 1, my.var.adj.fn, na.rm=T )
+}
+data <- t( scale( t( data ), center=my.center, scale=my.var.adj ) )
+
+my.center <- rep( 0, nrow( data ) )
+my.var.adj <- rep( 1, nrow( data ) )
+if ( opt$center.cols != "none" ) {
+  my.center.fn <- get( opt$center.cols )
+  ##data <- sweep( data, 2, apply( data, 2, my.center.fn, na.rm=T ) )
+  my.center <- apply( data, 2, my.center.fn, na.rm=T )
+}
+my.var.adj <- rep( 1, ncol( data ) )
+if ( opt$var.adj.cols != "none" ) {
+  my.var.adj.fn <- get( opt$var.adj.cols )
+  my.var.adj <- apply( data, 2, my.var.adj.fn, na.rm=T )
+}
+data <- scale( data, center=my.center, scale=my.var.adj )
+
+write.table( data, opt$output.fname, sep="\t", quote=FALSE, col.names=NA )
+