Mercurial > repos > peter-waltman > ucsc_cluster_tools2
comparison cluster.tools/normalize.matrix.R @ 0:0decf3fd54bc draft
Uploaded
author | peter-waltman |
---|---|
date | Thu, 28 Feb 2013 01:45:39 -0500 |
parents | |
children | dddfeedb85af |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:0decf3fd54bc |
---|---|
1 #!/usr/bin/env Rscript | |
2 ## Script by Peter Waltman | |
3 ## | |
4 ## License under Creative Commons Attribution 3.0 Unported (CC BY 3.0) | |
5 ## | |
6 argspec <- c("TBD | |
7 | |
8 | |
9 Usage: | |
10 normalize.matrix.R -d <data.file> | |
11 Optional: | |
12 -o <output.name> | |
13 TBD | |
14 \n\n") | |
15 | |
16 args <- commandArgs(TRUE) | |
17 if ( length( args ) == 1 && args =="--help") { | |
18 write(argspec, stderr()) | |
19 q(); | |
20 } | |
21 | |
22 lib.load.quiet <- function( package ) { | |
23 package <- as.character(substitute(package)) | |
24 suppressPackageStartupMessages( do.call( "library", list( package=package ) ) ) | |
25 } | |
26 lib.load.quiet(getopt) | |
27 | |
28 | |
29 spec <- matrix( c( "data.fname", "d", 1, "character", | |
30 "center.rows", "r", 2, "character", | |
31 "var.adj.rows", "R", 2, "character", | |
32 "center.cols", "c", 2, "character", | |
33 "var.adj.cols", "C", 2, "character", | |
34 "output.fname", "o", 2, "character" | |
35 ), | |
36 nc=4, | |
37 byrow=TRUE | |
38 ) | |
39 | |
40 opt <- getopt( spec=spec ) | |
41 | |
42 #set some reasonable defaults for the options that are needed, | |
43 #but were not specified. | |
44 if ( is.null( opt$output.fname ) ) { | |
45 out.fname <- "" | |
46 if ( ! is.null( opt$center.rows ) ) out.fname <- paste( "row", opt$center.rows, "centered", out.fname, sep="." ) | |
47 if ( ! is.null( opt$center.cols ) ) out.fname <- paste( "col", opt$center.cols, "centered", out.fname, sep="." ) | |
48 if ( ! is.null( opt$var.adj.rows ) ) out.fname <- paste( "row", opt$var.adj.rows, "var.adjed", out.fname, sep="." ) | |
49 if ( ! is.null( opt$var.adj.cols ) ) out.fname <- paste( "col", opt$var.adj.cols, "var.adjed", out.fname, sep="." ) | |
50 | |
51 opt$output.fname <- paste( out.fname, "centered.matrix", sep="." ) | |
52 } | |
53 if ( is.null( opt$center.rows ) ) { opt$center.rows <- 'none' } | |
54 if ( is.null( opt$center.cols ) ) { opt$center.cols <- 'none' } | |
55 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' } | |
57 | |
58 data <- as.matrix( read.delim( opt$data.fname, header=T, row.names=1 , check.names=FALSE ) ) | |
59 | |
60 my.center <- rep( 0, nrow( data ) ) | |
61 my.var.adj <- rep( 1, nrow( data ) ) | |
62 if ( opt$center.rows != "none" ) { | |
63 my.center.fn <- get( opt$center.rows ) | |
64 ##data <- sweep( data, 1, apply( data, 1, my.center.fn, na.rm=T ) ) | |
65 my.center <- apply( data, 1, my.center.fn, na.rm=T ) | |
66 } | |
67 if ( opt$var.adj.rows != "none" ) { | |
68 my.var.adj.fn <- get( opt$var.adj.rows ) | |
69 my.var.adj <- apply( data, 1, my.var.adj.fn, na.rm=T ) | |
70 } | |
71 data <- t( scale( t( data ), center=my.center, scale=my.var.adj ) ) | |
72 | |
73 my.center <- rep( 0, nrow( data ) ) | |
74 my.var.adj <- rep( 1, nrow( data ) ) | |
75 if ( opt$center.cols != "none" ) { | |
76 my.center.fn <- get( opt$center.cols ) | |
77 ##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 ) | |
79 } | |
80 my.var.adj <- rep( 1, ncol( data ) ) | |
81 if ( opt$var.adj.cols != "none" ) { | |
82 my.var.adj.fn <- get( opt$var.adj.cols ) | |
83 my.var.adj <- apply( data, 2, my.var.adj.fn, na.rm=T ) | |
84 } | |
85 data <- scale( data, center=my.center, scale=my.var.adj ) | |
86 | |
87 write.table( data, opt$output.fname, sep="\t", quote=FALSE, col.names=NA ) | |
88 |