Mercurial > repos > peter-waltman > ucsc_cluster_tools2
comparison cluster.tools/normalize.matrix.R @ 1:dddfeedb85af draft
Uploaded
| author | peter-waltman |
|---|---|
| date | Fri, 01 Mar 2013 10:16:53 -0500 |
| parents | 0decf3fd54bc |
| children |
comparison
equal
deleted
inserted
replaced
| 0:0decf3fd54bc | 1:dddfeedb85af |
|---|---|
| 15 | 15 |
| 16 args <- commandArgs(TRUE) | 16 args <- commandArgs(TRUE) |
| 17 if ( length( args ) == 1 && args =="--help") { | 17 if ( length( args ) == 1 && args =="--help") { |
| 18 write(argspec, stderr()) | 18 write(argspec, stderr()) |
| 19 q(); | 19 q(); |
| 20 } | |
| 21 | |
| 22 ## some helper fn's | |
| 23 write.2.tab <- function( mat, | |
| 24 fname ) { | |
| 25 mat <- rbind( colnames( mat ), mat ) | |
| 26 mat <- cbind( c( "ID", rownames( mat )[-1] ), | |
| 27 mat ) | |
| 28 write.table( mat, fname, sep="\t", row.names=FALSE, col.names=FALSE, quote=FALSE ) | |
| 20 } | 29 } |
| 21 | 30 |
| 22 lib.load.quiet <- function( package ) { | 31 lib.load.quiet <- function( package ) { |
| 23 package <- as.character(substitute(package)) | 32 package <- as.character(substitute(package)) |
| 24 suppressPackageStartupMessages( do.call( "library", list( package=package ) ) ) | 33 suppressPackageStartupMessages( do.call( "library", list( package=package ) ) ) |
| 54 if ( is.null( opt$center.cols ) ) { opt$center.cols <- 'none' } | 63 if ( is.null( opt$center.cols ) ) { opt$center.cols <- 'none' } |
| 55 if ( is.null( opt$var.adj.rows ) ) { opt$var.adj.rows <- 'none' } | 64 if ( is.null( opt$var.adj.rows ) ) { opt$var.adj.rows <- 'none' } |
| 56 if ( is.null( opt$var.adj.cols ) ) { opt$var.adj.cols <- 'none' } | 65 if ( is.null( opt$var.adj.cols ) ) { opt$var.adj.cols <- 'none' } |
| 57 | 66 |
| 58 data <- as.matrix( read.delim( opt$data.fname, header=T, row.names=1 , check.names=FALSE ) ) | 67 data <- as.matrix( read.delim( opt$data.fname, header=T, row.names=1 , check.names=FALSE ) ) |
| 59 | |
| 60 my.center <- rep( 0, nrow( data ) ) | 68 my.center <- rep( 0, nrow( data ) ) |
| 61 my.var.adj <- rep( 1, nrow( data ) ) | 69 my.var.adj <- rep( 1, nrow( data ) ) |
| 62 if ( opt$center.rows != "none" ) { | 70 if ( opt$center.rows != "none" ) { |
| 63 my.center.fn <- get( opt$center.rows ) | 71 my.center.fn <- get( opt$center.rows ) |
| 64 ##data <- sweep( data, 1, apply( data, 1, my.center.fn, na.rm=T ) ) | 72 ##data <- sweep( data, 1, apply( data, 1, my.center.fn, na.rm=T ) ) |
| 68 my.var.adj.fn <- get( opt$var.adj.rows ) | 76 my.var.adj.fn <- get( opt$var.adj.rows ) |
| 69 my.var.adj <- apply( data, 1, my.var.adj.fn, na.rm=T ) | 77 my.var.adj <- apply( data, 1, my.var.adj.fn, na.rm=T ) |
| 70 } | 78 } |
| 71 data <- t( scale( t( data ), center=my.center, scale=my.var.adj ) ) | 79 data <- t( scale( t( data ), center=my.center, scale=my.var.adj ) ) |
| 72 | 80 |
| 73 my.center <- rep( 0, nrow( data ) ) | 81 my.center <- rep( 0, ncol( data ) ) |
| 74 my.var.adj <- rep( 1, nrow( data ) ) | 82 my.var.adj <- rep( 1, ncol( data ) ) |
| 75 if ( opt$center.cols != "none" ) { | 83 if ( opt$center.cols != "none" ) { |
| 76 my.center.fn <- get( opt$center.cols ) | 84 my.center.fn <- get( opt$center.cols ) |
| 77 ##data <- sweep( data, 2, apply( data, 2, my.center.fn, na.rm=T ) ) | 85 ##data <- sweep( data, 2, apply( data, 2, my.center.fn, na.rm=T ) ) |
| 78 my.center <- apply( data, 2, my.center.fn, na.rm=T ) | 86 my.center <- apply( data, 2, my.center.fn, na.rm=T ) |
| 79 } | 87 } |
| 82 my.var.adj.fn <- get( opt$var.adj.cols ) | 90 my.var.adj.fn <- get( opt$var.adj.cols ) |
| 83 my.var.adj <- apply( data, 2, my.var.adj.fn, na.rm=T ) | 91 my.var.adj <- apply( data, 2, my.var.adj.fn, na.rm=T ) |
| 84 } | 92 } |
| 85 data <- scale( data, center=my.center, scale=my.var.adj ) | 93 data <- scale( data, center=my.center, scale=my.var.adj ) |
| 86 | 94 |
| 87 write.table( data, opt$output.fname, sep="\t", quote=FALSE, col.names=NA ) | 95 write.2.tab( data, opt$output.fname ) |
| 88 | 96 |