Mercurial > repos > peter-waltman > ucsc_cluster_tools2
diff cluster.tools/normalize.matrix.R @ 0:0decf3fd54bc draft
Uploaded
author | peter-waltman |
---|---|
date | Thu, 28 Feb 2013 01:45:39 -0500 |
parents | |
children | dddfeedb85af |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cluster.tools/normalize.matrix.R Thu Feb 28 01:45:39 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 ) +