annotate cluster.tools/fix.and.merge.TCGA.sample.IDs.R @ 0:0decf3fd54bc draft

Uploaded
author peter-waltman
date Thu, 28 Feb 2013 01:45:39 -0500
parents
children dddfeedb85af
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
1 #!/usr/bin/env Rscript
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
2 argspec <- c("fix.and.merge.TCGA.samples.IDs.R takes a clustering from ConsensusClusterPlus and clinical survival data
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
3 and generates a KM-plot, along with the log-rank p-values
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
4
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
5 Usage:
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
6 fix.and.merge.TCGA.samples.IDs.R -d <data.file>
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
7
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
8 \n\n")
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
9 args <- commandArgs(TRUE)
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
10 if ( length( args ) == 1 && args =="--help") {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
11 write(argspec, stderr())
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
12 q();
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
13 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
14
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
15 lib.load.quiet <- function( package ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
16 package <- as.character(substitute(package))
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
17 suppressPackageStartupMessages( do.call( "library", list( package=package ) ) )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
18 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
19 lib.load.quiet(getopt)
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
20
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
21 spec <- matrix( c( "data.fname", "d", 1, "character",
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
22 "num.components", "n", 2, "integer",
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
23 "remove.normals", "r", 0, "logical",
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
24 "output.fname", "o", 2, "character"
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
25 ),
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
26 nc=4,
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
27 byrow=TRUE
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
28 )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
29
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
30 opt <- getopt( spec=spec )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
31
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
32 data <- as.matrix( read.delim( opt$data.fname, row.names=1, check.names=FALSE ) )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
33 if ( is.null( opt$num.components ) ) { opt$num.components <- 3 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
34 if ( is.null( opt$remove.normals ) ) { opt$remove.normals <- FALSE }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
35 if ( is.null( opt$output.fname ) ) { opt$output.fname <- paste( "sample.IDs.updated", basename( opt$data.fname ), sep="." ) }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
36
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
37 if ( opt$num.components < 3 ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
38 err.msg <- "Minimum number of barcode components that can be used is 3\n"
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
39 cat( err.msg, file=opt$output.fname )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
40 stop( err.msg )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
41 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
42
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
43 remove.periods.from.ids <- function( ids ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
44 return( gsub( "\\.", "-", ids ) )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
45 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
46
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
47
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
48 reformat.ids <- function( ids,
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
49 num.components=3 ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
50 return( sapply( strsplit( ids, "-" ), function(x) paste( x[1:num.components], collapse="-" ) ) )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
51 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
52
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
53
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
54 merge.cols <- function( mat,
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
55 samp.ids ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
56
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
57 if ( ! any( duplicated( samp.ids ) ) ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
58 colnames( mat ) <- samp.ids
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
59 return( mat )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
60 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
61
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
62 dupes <- unique( samp.ids[ duplicated( samp.ids ) ] )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
63 uniqs <- samp.ids[ ! samp.ids %in% dupes ]
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
64
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
65 uniq.mat <- mat[ , ( samp.ids %in% uniqs ), drop=FALSE ]
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
66 colnames( uniq.mat ) <- uniqs
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
67
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
68 for ( dup in dupes ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
69 dup.mat <- apply( mat[, ( samp.ids %in% dup ), drop=FALSE],
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
70 1,
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
71 mean,
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
72 na.rm=TRUE )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
73
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
74 uniq.mat <- cbind( uniq.mat, dup.mat )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
75 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
76 colnames( uniq.mat ) <- c( uniqs, dupes )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
77 return( uniq.mat )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
78 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
79
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
80
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
81 cnames <- colnames( data )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
82 rnames <- rownames( data )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
83
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
84 transpose.back <- FALSE
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
85
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
86 if ( all( grepl( "^TCGA", rnames ) ) ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
87 data <- t( data )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
88 transpose.back <- TRUE
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
89 } else {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
90 if ( ! all( grepl( "^TCGA", cnames ) ) ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
91 err.msg <- "can't find any TCGA samples listed in this matrix. If columns are samples, all columns must be a TCGA sample ID. Same if rows are samples.\n"
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
92 cat( err.msg, file=opt$output.fname )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
93 stop( err.msg )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
94 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
95 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
96
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
97 cnames <- remove.periods.from.ids( colnames( data ) )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
98 nelts <- as.numeric( names( table( as.factor( sapply( strsplit( cnames, "-" ), function(x) length(x ) ) ) ) ) )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
99 if ( length( nelts ) > 1 ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
100 err.msg <- "Error: Inconsistent TCGA sample barcodes used. Have found ID with different numbers of components in the barcodes used\n"
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
101 cat( err.msg, file=opt$output.fname )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
102 stop( err.msg )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
103 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
104
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
105 if ( opt$remove.normals ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
106 if ( nelts > 3 ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
107 normals <- grepl( "^TCGA-..-....-1", cnames )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
108 data <- data[ , (! normals ), drop=FALSE ]
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
109 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
110 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
111
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
112 if ( opt$num.components < nelts ) {
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
113 cnames <- reformat.ids( ids=cnames, num.components=opt$num.components )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
114 data <- merge.cols( data, cnames )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
115 }
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
116
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
117 if ( transpose.back ) data <- t( data )
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
118
0decf3fd54bc Uploaded
peter-waltman
parents:
diff changeset
119 write.table( data, opt$output.fname, sep="\t", quote=FALSE, col.names=NA )