|
0
|
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
|
