annotate QDNAseq.R @ 11:4fe3844a5fb0 draft

Uploaded
author stef
date Thu, 06 Nov 2014 03:57:21 -0500
parents 4efd258b33d9
children 6936ad89f369
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
6
d4d58887f008 Uploaded
stef
parents:
diff changeset
1 #!/usr/bin/Rscript
d4d58887f008 Uploaded
stef
parents:
diff changeset
2
d4d58887f008 Uploaded
stef
parents:
diff changeset
3 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
4 ## prints all arguments as msg
d4d58887f008 Uploaded
stef
parents:
diff changeset
5 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
6 catMsg <- function( msg=c() ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
7 cat( MAIN_NAME, paste( msg, collapse="" ), "\n", sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
8 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
9 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
10 ## return the location of this script
d4d58887f008 Uploaded
stef
parents:
diff changeset
11 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
12 getScriptPath <- function(){
d4d58887f008 Uploaded
stef
parents:
diff changeset
13 cmd.args <- commandArgs()
d4d58887f008 Uploaded
stef
parents:
diff changeset
14 m <- regexpr("(?<=^--file=).+", cmd.args, perl=TRUE)
d4d58887f008 Uploaded
stef
parents:
diff changeset
15 script.dir <- dirname(regmatches(cmd.args, m))
d4d58887f008 Uploaded
stef
parents:
diff changeset
16 if( length(script.dir) == 0 ) stop("[ERR] Can't determine script dir: please call the script with Rscript\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
17 if( length(script.dir) > 1 ) stop("[ERR] Can't determine script dir: more than one '--file' argument detected\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
18 return(script.dir)
d4d58887f008 Uploaded
stef
parents:
diff changeset
19 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
20 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
21 ## Some html creation functions
d4d58887f008 Uploaded
stef
parents:
diff changeset
22 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
23 htmlTableRow <- function( string_array=c() ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
24 td_cells <- ''
d4d58887f008 Uploaded
stef
parents:
diff changeset
25 for ( i in string_array ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
26 td_cells <- paste( td_cells, '<td>', i, '</td>', sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
27 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
28 return( paste( "<tr>", td_cells, "</tr>") )
d4d58887f008 Uploaded
stef
parents:
diff changeset
29 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
30 htmlLink <- function( path, desc="LINK" ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
31 return( paste( '<a href="', path, '">', desc, "</a>", sep='') )
d4d58887f008 Uploaded
stef
parents:
diff changeset
32 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
33 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
34 ## constructs a list with input bam file info
d4d58887f008 Uploaded
stef
parents:
diff changeset
35 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
36 makeBamFileList <- function( paths, names ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
37 tmp <- list()
d4d58887f008 Uploaded
stef
parents:
diff changeset
38 l1 <- length(paths)
d4d58887f008 Uploaded
stef
parents:
diff changeset
39 l2 <- length(names)
d4d58887f008 Uploaded
stef
parents:
diff changeset
40 if ( l1 != l2 ) stop( "Unequal amount of bam-paths (", l1, ") and -names (", l2, ") in makeBamFileList!!!\n" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
41 if ( l1 == 0 ){ return(tmp) } # empty list in debug mode
d4d58887f008 Uploaded
stef
parents:
diff changeset
42
d4d58887f008 Uploaded
stef
parents:
diff changeset
43 for ( i in 1:length(paths) ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
44 path <- paths[i]
d4d58887f008 Uploaded
stef
parents:
diff changeset
45 name <- names[i]
d4d58887f008 Uploaded
stef
parents:
diff changeset
46 file <- basename(path)
d4d58887f008 Uploaded
stef
parents:
diff changeset
47
d4d58887f008 Uploaded
stef
parents:
diff changeset
48 tmp[[ file ]] <- name
d4d58887f008 Uploaded
stef
parents:
diff changeset
49 tmp[[ 'all_paths' ]] <- c( tmp[[ 'all_paths' ]], path )
d4d58887f008 Uploaded
stef
parents:
diff changeset
50 tmp[[ 'all_files' ]] <- c( tmp[[ 'all_files' ]], file )
d4d58887f008 Uploaded
stef
parents:
diff changeset
51 tmp[[ 'all_names' ]] <- c( tmp[[ 'all_names' ]], name )
d4d58887f008 Uploaded
stef
parents:
diff changeset
52 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
53 return( tmp )
d4d58887f008 Uploaded
stef
parents:
diff changeset
54 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
55
d4d58887f008 Uploaded
stef
parents:
diff changeset
56 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
57 ## copied code for extracting the regions by segment call status
d4d58887f008 Uploaded
stef
parents:
diff changeset
58 ## --------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
59 fuseRegions <- function( obj, minRatio=0 ) {
d4d58887f008 Uploaded
stef
parents:
diff changeset
60 if ( ncol(obj) > 1 ) stop('Please specify which sample...')
d4d58887f008 Uploaded
stef
parents:
diff changeset
61
d4d58887f008 Uploaded
stef
parents:
diff changeset
62 data <- data.frame( obj@featureData@data[,1:3], copynumber(obj), segmented(obj), check.names=FALSE, stringsAsFactors=FALSE)
d4d58887f008 Uploaded
stef
parents:
diff changeset
63 colnames( data ) <- c( "chr", "start", "end", "log2", "segmentval" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
64
d4d58887f008 Uploaded
stef
parents:
diff changeset
65 fused.data <- data.frame()
d4d58887f008 Uploaded
stef
parents:
diff changeset
66 curr.bin <- 1
d4d58887f008 Uploaded
stef
parents:
diff changeset
67 for ( chr in unique( data$chr ) ) {
d4d58887f008 Uploaded
stef
parents:
diff changeset
68 chr.data <- data[ data$chr == chr, ]
d4d58887f008 Uploaded
stef
parents:
diff changeset
69 prev.bin <- curr.bin
d4d58887f008 Uploaded
stef
parents:
diff changeset
70 prev.log2 <- chr.data[ 1, 'log2' ]
d4d58887f008 Uploaded
stef
parents:
diff changeset
71 prev.segm <- chr.data[ 1, 'segmentval' ]
d4d58887f008 Uploaded
stef
parents:
diff changeset
72 start <- chr.data[ 1, 'start' ]
d4d58887f008 Uploaded
stef
parents:
diff changeset
73
d4d58887f008 Uploaded
stef
parents:
diff changeset
74 if ( nrow(chr.data) > 1) {
d4d58887f008 Uploaded
stef
parents:
diff changeset
75 for ( i in 2:nrow(chr.data) ) {
d4d58887f008 Uploaded
stef
parents:
diff changeset
76 curr.bin <- curr.bin + 1
d4d58887f008 Uploaded
stef
parents:
diff changeset
77 curr.segm <- chr.data[ i, 'segmentval']
d4d58887f008 Uploaded
stef
parents:
diff changeset
78
d4d58887f008 Uploaded
stef
parents:
diff changeset
79 if ( curr.segm != prev.segm ) {
d4d58887f008 Uploaded
stef
parents:
diff changeset
80 fused.data <- rbind( fused.data, data.frame( chr=chr, start=start, end=chr.data[ i-1, 'end'], segmentval=round(prev.segm, digits=DECIMALS) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
81 prev.segm <- curr.segm
d4d58887f008 Uploaded
stef
parents:
diff changeset
82 prev.bin <- curr.bin
d4d58887f008 Uploaded
stef
parents:
diff changeset
83 start <- chr.data[ i, 'start']
d4d58887f008 Uploaded
stef
parents:
diff changeset
84 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
85 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
86 fused.data <- rbind( fused.data, data.frame( chr=chr, start=start, end=chr.data[ i-1, 'end'], segmentval=round(prev.segm, digits=DECIMALS) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
87 }else{
d4d58887f008 Uploaded
stef
parents:
diff changeset
88 fused.data <- rbind( fused.data, data.frame( chr=chr, start=start, end=chr.data[ i-1, 'end'], segmentval=round(prev.segm, digits=DECIMALS) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
89 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
90 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
91 ## remove regions with low amplitude
d4d58887f008 Uploaded
stef
parents:
diff changeset
92 fused.data <- fused.data[ abs(fused.data$segmentval) >= minRatio, ]
d4d58887f008 Uploaded
stef
parents:
diff changeset
93 fused.data
d4d58887f008 Uploaded
stef
parents:
diff changeset
94 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
95
d4d58887f008 Uploaded
stef
parents:
diff changeset
96 ## DESC: takes the output of fuse.regions and outputs a txt file per sample
d4d58887f008 Uploaded
stef
parents:
diff changeset
97 outputRegionsFromList <- function ( regionsList, outputBasename, outputDir="./", binSize, storeList ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
98 if ( missing(regionsList) ) stop( 'Please provide regionsList...' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
99 if ( missing(outputBasename) ) stop( 'Please provide outputBasename...' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
100 if ( !is.list(regionsList) ) stop( 'Input not a list...?' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
101 if ( length(regionsList) < 1 ) stop( 'List seems empty...?' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
102 if ( file.exists( outputDir ) ) catMsg( c(" Using dir ", outputDir, " for output") )
d4d58887f008 Uploaded
stef
parents:
diff changeset
103 else dir.create( outputDir )
d4d58887f008 Uploaded
stef
parents:
diff changeset
104
d4d58887f008 Uploaded
stef
parents:
diff changeset
105 ## have to set R output options otherwise scientific method is used at some point
d4d58887f008 Uploaded
stef
parents:
diff changeset
106 options( "scipen"=100 )
d4d58887f008 Uploaded
stef
parents:
diff changeset
107
d4d58887f008 Uploaded
stef
parents:
diff changeset
108 sampleCount <- length( regionsList )
d4d58887f008 Uploaded
stef
parents:
diff changeset
109 sampleNames <- names( regionsList )
d4d58887f008 Uploaded
stef
parents:
diff changeset
110 bedgraphColumns <- c( 'chr', 'start', 'end', 'segmentval' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
111
d4d58887f008 Uploaded
stef
parents:
diff changeset
112 catMsg( c( " There are ", sampleCount, " samples found in input list") )
d4d58887f008 Uploaded
stef
parents:
diff changeset
113
d4d58887f008 Uploaded
stef
parents:
diff changeset
114 for ( sample in sampleNames ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
115 catMsg( c(" Working on sample ", sample ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
116 regionCount <- nrow( regionsList[[sample]] )
d4d58887f008 Uploaded
stef
parents:
diff changeset
117
d4d58887f008 Uploaded
stef
parents:
diff changeset
118 outSampleBase <- paste( outputBasename, '_', sample, '_', binSize, 'kbp', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
119 outBedgraphFile <- paste( outSampleBase, '.bedGraph', sep="" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
120 outBedgraphPath <- paste( outputDir, '/', outBedgraphFile, sep="" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
121
d4d58887f008 Uploaded
stef
parents:
diff changeset
122 ## ---------- BEDGRAPH ----------
d4d58887f008 Uploaded
stef
parents:
diff changeset
123 txt <- paste( "track type=bedGraph color=0,100,0 altColor=255,0,0 name=", sample," description=segmented_regions_from_QDNAseq_",binSize,"kbp\n", sep="")
d4d58887f008 Uploaded
stef
parents:
diff changeset
124 sink( outBedgraphPath )
d4d58887f008 Uploaded
stef
parents:
diff changeset
125 cat( txt )
d4d58887f008 Uploaded
stef
parents:
diff changeset
126 sink()
d4d58887f008 Uploaded
stef
parents:
diff changeset
127 write.table( regionsList[[sample]][,bedgraphColumns], outBedgraphPath, quote=F, sep="\t", row.names=F, append=T, col.names=F)
d4d58887f008 Uploaded
stef
parents:
diff changeset
128 #outFiles[[sample]] <- c( outBedgraphFile )
d4d58887f008 Uploaded
stef
parents:
diff changeset
129 storeList[[ paste( binSize, sample, 'bedgraph', sep="_")]] <- outBedgraphFile
d4d58887f008 Uploaded
stef
parents:
diff changeset
130 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
131 return(storeList)
d4d58887f008 Uploaded
stef
parents:
diff changeset
132 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
133
d4d58887f008 Uploaded
stef
parents:
diff changeset
134
d4d58887f008 Uploaded
stef
parents:
diff changeset
135 ## ==================================================
d4d58887f008 Uploaded
stef
parents:
diff changeset
136 ## Start of analysis
d4d58887f008 Uploaded
stef
parents:
diff changeset
137 ## ==================================================
9
4efd258b33d9 Uploaded
stef
parents: 8
diff changeset
138 cmdLineArgs <- commandArgs(TRUE)
4efd258b33d9 Uploaded
stef
parents: 8
diff changeset
139 config <- cmdLineArgs[1]
4efd258b33d9 Uploaded
stef
parents: 8
diff changeset
140 installDir <- cmdLineArgs[2]
4efd258b33d9 Uploaded
stef
parents: 8
diff changeset
141
6
d4d58887f008 Uploaded
stef
parents:
diff changeset
142 MAIN_NAME <- '[INFO] '
d4d58887f008 Uploaded
stef
parents:
diff changeset
143 TOOL_PATH <- getScriptPath()
9
4efd258b33d9 Uploaded
stef
parents: 8
diff changeset
144 CSS_FILE <- paste( installDir, '/static/css/QDNAseq.css', sep="" )
6
d4d58887f008 Uploaded
stef
parents:
diff changeset
145 DECIMALS <- 3
d4d58887f008 Uploaded
stef
parents:
diff changeset
146 WEB_LINK <- 'http://www.bioconductor.org/packages/release/bioc/html/QDNAseq.html'
d4d58887f008 Uploaded
stef
parents:
diff changeset
147 PURE_CSS <- 'http://yui.yahooapis.com/pure/0.5.0/pure-min.css'
d4d58887f008 Uploaded
stef
parents:
diff changeset
148
d4d58887f008 Uploaded
stef
parents:
diff changeset
149 catMsg( "Starting QDNAseq wrapper" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
150 catMsg( "Loading R libraries" )
7
1181e22c2b5a Uploaded
stef
parents: 6
diff changeset
151 catMsg( R.version.string )
1181e22c2b5a Uploaded
stef
parents: 6
diff changeset
152
6
d4d58887f008 Uploaded
stef
parents:
diff changeset
153 suppressWarnings( suppressMessages( library( QDNAseq, quietly = TRUE ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
154 suppressWarnings( suppressMessages( library( CGHcall, quietly = TRUE ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
155
d4d58887f008 Uploaded
stef
parents:
diff changeset
156 ## sourcing the config file will load all input params
d4d58887f008 Uploaded
stef
parents:
diff changeset
157 ## many variables are imported via sourced "config"
d4d58887f008 Uploaded
stef
parents:
diff changeset
158 source( config )
d4d58887f008 Uploaded
stef
parents:
diff changeset
159
d4d58887f008 Uploaded
stef
parents:
diff changeset
160 ## desparate tries to make png text scale well, damn you R...!
d4d58887f008 Uploaded
stef
parents:
diff changeset
161 PLOT_RES <- min( PLOT_WIDTH, PLOT_HEIGHT ) / 6.3
d4d58887f008 Uploaded
stef
parents:
diff changeset
162 PAR_SET <- list( pch=22 )
d4d58887f008 Uploaded
stef
parents:
diff changeset
163
d4d58887f008 Uploaded
stef
parents:
diff changeset
164 systemUser <- system("whoami",T)
d4d58887f008 Uploaded
stef
parents:
diff changeset
165 qdnaseqVersion <- packageDescription( "QDNAseq" )$Version
d4d58887f008 Uploaded
stef
parents:
diff changeset
166 rVersion <- R.version.string
d4d58887f008 Uploaded
stef
parents:
diff changeset
167 startTime <- Sys.time()
d4d58887f008 Uploaded
stef
parents:
diff changeset
168 analysisStart <- as.character( startTime )
d4d58887f008 Uploaded
stef
parents:
diff changeset
169 catMsg( c("QDNAseq version: ", qdnaseqVersion) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
170 catMsg( c( rVersion ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
171
d4d58887f008 Uploaded
stef
parents:
diff changeset
172 ## get the comma separated list of chromosomes to exclude
d4d58887f008 Uploaded
stef
parents:
diff changeset
173 excludeChrs <- unlist( strsplit( excludeChrsString, ",") )
d4d58887f008 Uploaded
stef
parents:
diff changeset
174 binSizes <- as.numeric( unlist( strsplit( binSizesString, ",") ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
175
d4d58887f008 Uploaded
stef
parents:
diff changeset
176
d4d58887f008 Uploaded
stef
parents:
diff changeset
177 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
178 ## DEBUG
d4d58887f008 Uploaded
stef
parents:
diff changeset
179 if ( debug ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
180 catMsg( c("Analysis run by user: ", systemUser ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
181 catMsg( c("DEBUG SessionInfo: " ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
182 print( sessionInfo() )
d4d58887f008 Uploaded
stef
parents:
diff changeset
183 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
184 ## /DEBUG
d4d58887f008 Uploaded
stef
parents:
diff changeset
185 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
186
d4d58887f008 Uploaded
stef
parents:
diff changeset
187 ## prepare output dir
d4d58887f008 Uploaded
stef
parents:
diff changeset
188 if ( !file.exists( outputPath) ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
189 dir.create( outputPath )
d4d58887f008 Uploaded
stef
parents:
diff changeset
190 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
191
d4d58887f008 Uploaded
stef
parents:
diff changeset
192 ## copy source config file to output dir to include it in output zip
d4d58887f008 Uploaded
stef
parents:
diff changeset
193 if ( inGalaxy ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
194 file.copy( config, paste(outputPath, 'galaxyConfigFile.R', sep='/') )
d4d58887f008 Uploaded
stef
parents:
diff changeset
195 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
196
d4d58887f008 Uploaded
stef
parents:
diff changeset
197 ## setup bam filelist for easy retrieval later
d4d58887f008 Uploaded
stef
parents:
diff changeset
198 fileList <- makeBamFileList( bamsPaths, bamsNames )
d4d58887f008 Uploaded
stef
parents:
diff changeset
199 bamCount <- length( fileList[[ 'all_paths' ]] )
d4d58887f008 Uploaded
stef
parents:
diff changeset
200
d4d58887f008 Uploaded
stef
parents:
diff changeset
201 gzipOutputName <- paste( 'QDNAseqResults_', outputName, '.zip', sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
202 gzipOutputPath <- paste( outputPath, '/', gzipOutputName, sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
203 htmlOutputName <- 'index.html'
d4d58887f008 Uploaded
stef
parents:
diff changeset
204 htmlOutputPath <- paste( outputPath, '/', htmlOutputName, sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
205
d4d58887f008 Uploaded
stef
parents:
diff changeset
206 plotted_images <- list() # to keep track of images for later linking
d4d58887f008 Uploaded
stef
parents:
diff changeset
207 regions <- list() # will contain the segments
d4d58887f008 Uploaded
stef
parents:
diff changeset
208 outputFiles <- list()
d4d58887f008 Uploaded
stef
parents:
diff changeset
209
d4d58887f008 Uploaded
stef
parents:
diff changeset
210 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
211 ## in case of debug just use inbuilt LGG data for speedup
d4d58887f008 Uploaded
stef
parents:
diff changeset
212 if ( debug ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
213 binSizes <- c(15)
d4d58887f008 Uploaded
stef
parents:
diff changeset
214 bamsPaths <- c( "BUILD_IN_DATA")
d4d58887f008 Uploaded
stef
parents:
diff changeset
215 bamsNames <- c( "LGG150")
d4d58887f008 Uploaded
stef
parents:
diff changeset
216 fileList <- makeBamFileList( bamsPaths, bamsNames )
d4d58887f008 Uploaded
stef
parents:
diff changeset
217 bamCount <- length( fileList[[ 'all_paths' ]] )
d4d58887f008 Uploaded
stef
parents:
diff changeset
218 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
219
d4d58887f008 Uploaded
stef
parents:
diff changeset
220 for ( binSize in binSizes ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
221
d4d58887f008 Uploaded
stef
parents:
diff changeset
222 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
223 ## construct output file-names and -paths
d4d58887f008 Uploaded
stef
parents:
diff changeset
224 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
225 robjReadCoName <- paste( binSize, 'kbp_QDNAseqReadCounts.rds', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
226 robjCopyNrName <- paste( binSize, 'kbp_QDNAseqCopyNumbers.rds', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
227 igvCopyNrName <- paste( binSize, 'kbp_QDNAseqCopyNumbers.igv', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
228 robjSegmntName <- paste( binSize, 'kbp_QDNAseqCopyNumbersSegmented.rds', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
229 regiOutputName <- paste( binSize, 'kbp_QDNAseqRegions.rds', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
230 noiseImgName <- paste( binSize, 'kbp_QDNAseqNoiseplot.png', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
231
d4d58887f008 Uploaded
stef
parents:
diff changeset
232 robjReadCoPath <- paste( outputPath, '/', robjReadCoName, sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
233 robjCopyNrPath <- paste( outputPath, '/', robjCopyNrName, sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
234 robjSegmntPath <- paste( outputPath, '/', robjSegmntName, sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
235 robjRegionPath <- paste( outputPath, '/', regiOutputName, sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
236 igvCopyNrPath <- paste( outputPath, '/', igvCopyNrName, sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
237 noiseImgPath <- paste( outputPath, '/', noiseImgName, sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
238
d4d58887f008 Uploaded
stef
parents:
diff changeset
239 binAnnFile <- paste( TOOL_PATH, '/static/binannotation/', binSize, 'kbp_binAnnotations.rds', sep="" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
240 if ( file.exists(binAnnFile) ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
241 binAnnotations <- readRDS( binAnnFile )
d4d58887f008 Uploaded
stef
parents:
diff changeset
242 catMsg( c("Using local binAnnotations file" ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
243 }else{
d4d58887f008 Uploaded
stef
parents:
diff changeset
244 binAnnotations <- getBinAnnotations( binSize=binSize, type=experimentType )
d4d58887f008 Uploaded
stef
parents:
diff changeset
245 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
246
d4d58887f008 Uploaded
stef
parents:
diff changeset
247 ## in case of debug just use inbuilt LGG data for speedup
d4d58887f008 Uploaded
stef
parents:
diff changeset
248 if ( debug ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
249 data(LGG150)
d4d58887f008 Uploaded
stef
parents:
diff changeset
250 readCounts <- LGG150
d4d58887f008 Uploaded
stef
parents:
diff changeset
251 }else{
d4d58887f008 Uploaded
stef
parents:
diff changeset
252 ## provide bamnames because in galaxy everyting is called "dataset_###"
d4d58887f008 Uploaded
stef
parents:
diff changeset
253 readCounts <- binReadCounts( binAnnotations, bamfiles=fileList[[ 'all_paths' ]], bamnames=fileList[[ 'all_names' ]] )
d4d58887f008 Uploaded
stef
parents:
diff changeset
254 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
255
d4d58887f008 Uploaded
stef
parents:
diff changeset
256 readCountsFiltered <- applyFilters( readCounts, residual=TRUE, blacklist=filterBlacklistedBins, mappability=mappabilityCutoff, chromosomes=excludeChrs )
d4d58887f008 Uploaded
stef
parents:
diff changeset
257 readCountsFiltered <- estimateCorrection( readCountsFiltered )
d4d58887f008 Uploaded
stef
parents:
diff changeset
258 copyNumbers <- correctBins( readCountsFiltered )
d4d58887f008 Uploaded
stef
parents:
diff changeset
259 copyNumbersNormalized <- normalizeBins( copyNumbers )
d4d58887f008 Uploaded
stef
parents:
diff changeset
260 copyNumbersSmooth <- smoothOutlierBins( copyNumbersNormalized )
d4d58887f008 Uploaded
stef
parents:
diff changeset
261 sampleNames <- readCountsFiltered@phenoData@data$name
d4d58887f008 Uploaded
stef
parents:
diff changeset
262
d4d58887f008 Uploaded
stef
parents:
diff changeset
263 ## save objects to output dir
d4d58887f008 Uploaded
stef
parents:
diff changeset
264 saveRDS( readCountsFiltered, robjReadCoPath );
d4d58887f008 Uploaded
stef
parents:
diff changeset
265 saveRDS( copyNumbersSmooth, robjCopyNrPath );
d4d58887f008 Uploaded
stef
parents:
diff changeset
266 exportBins( copyNumbersSmooth, file=igvCopyNrPath, format="igv" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
267
d4d58887f008 Uploaded
stef
parents:
diff changeset
268 ## also save objects for galaxy history output if requested
d4d58887f008 Uploaded
stef
parents:
diff changeset
269 if ( doOutputCopynumbersIgv ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
270 #@ a bit hacky galaxy way to allow an unknown number of output files based on param selection
d4d58887f008 Uploaded
stef
parents:
diff changeset
271 #@ see: https://wiki.galaxyproject.org/Admin/Tools/Multiple%20Output%20Files
d4d58887f008 Uploaded
stef
parents:
diff changeset
272 historyName <- paste(binSize, 'kbp-IGV', sep="")
d4d58887f008 Uploaded
stef
parents:
diff changeset
273 igvFile <- paste( newFilePath, "/primary_", outputId, "_", historyName, "_visible_txt", sep="" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
274 exportBins( copyNumbersSmooth, file=igvFile, format="igv" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
275 catMsg( c("Exported igv file to history for ", binSize, "kbp bin") )
d4d58887f008 Uploaded
stef
parents:
diff changeset
276 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
277
d4d58887f008 Uploaded
stef
parents:
diff changeset
278 ## proceed with calling if requested
d4d58887f008 Uploaded
stef
parents:
diff changeset
279 if ( doSegment ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
280 copyNumbersSegmented <- segmentBins( copyNumbersSmooth, undo.splits=undoSplits, undo.SD=undoSD )
d4d58887f008 Uploaded
stef
parents:
diff changeset
281 copyNumbersSegmented <- normalizeSegmentedBins( copyNumbersSegmented )
d4d58887f008 Uploaded
stef
parents:
diff changeset
282 cgh <- makeCgh( copyNumbersSegmented )
d4d58887f008 Uploaded
stef
parents:
diff changeset
283 saveRDS( copyNumbersSegmented, robjSegmntPath );
d4d58887f008 Uploaded
stef
parents:
diff changeset
284 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
285
d4d58887f008 Uploaded
stef
parents:
diff changeset
286 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
287 ## create output files
d4d58887f008 Uploaded
stef
parents:
diff changeset
288 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
289 png( noiseImgPath, width=PLOT_HEIGHT, height=PLOT_HEIGHT, res=PLOT_RES );
d4d58887f008 Uploaded
stef
parents:
diff changeset
290 par( PAR_SET )
d4d58887f008 Uploaded
stef
parents:
diff changeset
291 noisePlot( readCountsFiltered, main=paste( "Noise Plot ", binSize, "kbp", sep=''), col="darkgreen" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
292 dev.off()
d4d58887f008 Uploaded
stef
parents:
diff changeset
293
d4d58887f008 Uploaded
stef
parents:
diff changeset
294 binSize <- as.character( binSize ) # to avoid R using it as array index... (*#$^@ you R!)
d4d58887f008 Uploaded
stef
parents:
diff changeset
295 binSizeString <- paste( binSize, 'kbp', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
296
d4d58887f008 Uploaded
stef
parents:
diff changeset
297 for (i in 1:length(sampleNames) ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
298
d4d58887f008 Uploaded
stef
parents:
diff changeset
299 sample <- sampleNames[i]
d4d58887f008 Uploaded
stef
parents:
diff changeset
300 usedReads <- readCountsFiltered@phenoData@data$used.reads[i]
d4d58887f008 Uploaded
stef
parents:
diff changeset
301 catMsg( c("Creating plots for sample: ", sample, " (", binSizeString, ")" ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
302
d4d58887f008 Uploaded
stef
parents:
diff changeset
303 type <- 'CopyNumbers'
d4d58887f008 Uploaded
stef
parents:
diff changeset
304 img_file <- paste( sample, '_', binSize, 'kbp_QDNAseq', type, '.png', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
305 img_file_path <- paste( outputPath, '/', img_file, sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
306
d4d58887f008 Uploaded
stef
parents:
diff changeset
307 ## COPYNUMBER PLOT
d4d58887f008 Uploaded
stef
parents:
diff changeset
308 png( img_file_path, width=PLOT_WIDTH, height=PLOT_HEIGHT, res=PLOT_RES );
d4d58887f008 Uploaded
stef
parents:
diff changeset
309 par( PAR_SET )
d4d58887f008 Uploaded
stef
parents:
diff changeset
310 plot( copyNumbersSmooth[ ,sample ], main=paste(sample, ": CopyNumbers", sep="") )
d4d58887f008 Uploaded
stef
parents:
diff changeset
311 mtext( paste( binSizeString, " bins", sep=""), 3 )
d4d58887f008 Uploaded
stef
parents:
diff changeset
312 abline( h=c(-2,-1,1,2,3,4), lty=1, lwd=0.5, col="grey" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
313 dev.off()
d4d58887f008 Uploaded
stef
parents:
diff changeset
314
d4d58887f008 Uploaded
stef
parents:
diff changeset
315 plotted_images[[ paste(binSize, sample, type, sep="_" ) ]] <- img_file
d4d58887f008 Uploaded
stef
parents:
diff changeset
316
d4d58887f008 Uploaded
stef
parents:
diff changeset
317 if ( doSegment ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
318 type <- 'Segmented'
d4d58887f008 Uploaded
stef
parents:
diff changeset
319 img_file <- paste( sample, '_', binSize, 'kbp_QDNAseq', type, '.png', sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
320 img_file_path <- paste( outputPath, '/', img_file, sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
321
d4d58887f008 Uploaded
stef
parents:
diff changeset
322 ## COPYNUMBER PLOT
d4d58887f008 Uploaded
stef
parents:
diff changeset
323 png( img_file_path, width=PLOT_WIDTH, height=PLOT_HEIGHT, res=PLOT_RES );
d4d58887f008 Uploaded
stef
parents:
diff changeset
324 par( PAR_SET )
d4d58887f008 Uploaded
stef
parents:
diff changeset
325 plot( copyNumbersSegmented[ ,sample ], main=paste(sample, ": CopyNumbers and Segments", sep="") )
d4d58887f008 Uploaded
stef
parents:
diff changeset
326 mtext( paste( "(", binSizeString, " bins)", sep=""), 3 )
d4d58887f008 Uploaded
stef
parents:
diff changeset
327 abline( h=c(-2,-1,1,2,3,4), lty=1, lwd=0.5, col="grey" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
328 dev.off()
d4d58887f008 Uploaded
stef
parents:
diff changeset
329
d4d58887f008 Uploaded
stef
parents:
diff changeset
330 plotted_images[[ paste(binSize, sample, type, sep="_" ) ]] <- img_file
d4d58887f008 Uploaded
stef
parents:
diff changeset
331
d4d58887f008 Uploaded
stef
parents:
diff changeset
332 catMsg( c(" Fusing regions of sample: ", sample) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
333 regions[[ sample ]] <- fuseRegions( cgh[, sample] )
d4d58887f008 Uploaded
stef
parents:
diff changeset
334
d4d58887f008 Uploaded
stef
parents:
diff changeset
335 region_count <- nrow( data.frame( regions[[ sample ]] ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
336 catMsg( c( ' sample "', sample, '" has ', region_count, " regions" ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
337 plotted_images[[ paste(binSize, sample, 'region_count', sep="_" ) ]] <- region_count
d4d58887f008 Uploaded
stef
parents:
diff changeset
338 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
339
d4d58887f008 Uploaded
stef
parents:
diff changeset
340 ## add USED read counts
d4d58887f008 Uploaded
stef
parents:
diff changeset
341 plotted_images[[ paste(binSize, sample, 'usedReads', sep="_" ) ]] <- usedReads
d4d58887f008 Uploaded
stef
parents:
diff changeset
342 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
343
d4d58887f008 Uploaded
stef
parents:
diff changeset
344 if ( doSegment ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
345 saveRDS( regions, robjRegionPath )
d4d58887f008 Uploaded
stef
parents:
diff changeset
346 plotted_images <- outputRegionsFromList( regions, outputBasename=outputName, outputDir=outputPath, binSize=binSize, storeList=plotted_images )
d4d58887f008 Uploaded
stef
parents:
diff changeset
347 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
348 }# end bin
d4d58887f008 Uploaded
stef
parents:
diff changeset
349
d4d58887f008 Uploaded
stef
parents:
diff changeset
350
d4d58887f008 Uploaded
stef
parents:
diff changeset
351 ## ----- debug -----
d4d58887f008 Uploaded
stef
parents:
diff changeset
352 #catMsg( "done" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
353 #q(status=0)
d4d58887f008 Uploaded
stef
parents:
diff changeset
354 ## ---- /debug -----
d4d58887f008 Uploaded
stef
parents:
diff changeset
355
d4d58887f008 Uploaded
stef
parents:
diff changeset
356
d4d58887f008 Uploaded
stef
parents:
diff changeset
357 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
358 ## prepare output
d4d58887f008 Uploaded
stef
parents:
diff changeset
359 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
360 catMsg( "...zipping output")
d4d58887f008 Uploaded
stef
parents:
diff changeset
361 zip_cmd <- paste( "zip -j", gzipOutputPath, paste(outputPath,'/*',sep='') ) ## -j is for removing dirs from the tree
d4d58887f008 Uploaded
stef
parents:
diff changeset
362 system( zip_cmd )
d4d58887f008 Uploaded
stef
parents:
diff changeset
363
d4d58887f008 Uploaded
stef
parents:
diff changeset
364 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
365 ## get filesizes for report
d4d58887f008 Uploaded
stef
parents:
diff changeset
366 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
367 zippedSize <- paste( round( file.info( gzipOutputPath )[["size"]] / 1e+6, digits=2 ), 'MB' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
368 endTime <- Sys.time()
d4d58887f008 Uploaded
stef
parents:
diff changeset
369 timeDiff <- format( round( endTime - startTime, 3 ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
370 analysisEnd <- as.character( endTime )
d4d58887f008 Uploaded
stef
parents:
diff changeset
371
d4d58887f008 Uploaded
stef
parents:
diff changeset
372 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
373 ## creating html output to be linked to from the middle galaxy pane
d4d58887f008 Uploaded
stef
parents:
diff changeset
374 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
375 sink( file = htmlOutputPath, type = "output" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
376 cat( "<html>\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
377 cat( "<head>\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
378
d4d58887f008 Uploaded
stef
parents:
diff changeset
379 cat( "\t", '<title>QDNAseq Report | ', outputName,'</title>', "\n", sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
380 cat( "\t", '<link rel="stylesheet" href="', PURE_CSS, '">', "\n", sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
381 cat( "\t<style>\n", sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
382 ## include CSS into html file, makes it more portable
d4d58887f008 Uploaded
stef
parents:
diff changeset
383 cat( "\t\t", readLines( CSS_FILE ), sep="\n\t\t" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
384 #cat( "\t\th1 {color:red;}", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
385 cat( "\n\t</style>\n" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
386
d4d58887f008 Uploaded
stef
parents:
diff changeset
387 cat( "\n</head>\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
388 cat( "\n<body>\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
389
d4d58887f008 Uploaded
stef
parents:
diff changeset
390 cat( "<h1>QDNAseq Report</h1>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
391
d4d58887f008 Uploaded
stef
parents:
diff changeset
392 cat( '<h3 class="qdnaseq">About this analysis</h3>', "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
393 cat( '<p>This page provides access to all results. To have a local copy of this report just download the <a href="', gzipOutputName, '" class="button">zipfile</a> with all output (', zippedSize, ')</p>', "\n", sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
394
d4d58887f008 Uploaded
stef
parents:
diff changeset
395 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
396 ## table with general info
d4d58887f008 Uploaded
stef
parents:
diff changeset
397 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
398 cat( '<h3 class="qdnaseq">Settings</h3><p>', "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
399 cat( '<table class="pure-table pure-table-striped"><tbody>' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
400 cat( htmlTableRow( c( "AnalysisName", outputName ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
401 cat( htmlTableRow( c( "AnalysisStart", analysisStart ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
402 cat( htmlTableRow( c( "AnalysisEnd", analysisEnd ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
403 cat( htmlTableRow( c( "AnalysisTime", timeDiff ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
404 cat( htmlTableRow( c( "BinSizes (kbp)", paste(binSizes,collapse=", ") ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
405 cat( htmlTableRow( c( "R info", rVersion ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
406 cat( htmlTableRow( c( "QDNAseq info", qdnaseqVersion ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
407
d4d58887f008 Uploaded
stef
parents:
diff changeset
408 sampleStrings <- c()
d4d58887f008 Uploaded
stef
parents:
diff changeset
409 for ( galaxyName in fileList[[ 'all_files' ]] ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
410 sampleName <- fileList[[ galaxyName ]]
d4d58887f008 Uploaded
stef
parents:
diff changeset
411 sampleStrings <- c( sampleStrings, paste( galaxyName, ' (', sampleName, ')', sep='' ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
412 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
413 cat( htmlTableRow( c( "InputBams", paste( sampleStrings, collapse=", ") ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
414
d4d58887f008 Uploaded
stef
parents:
diff changeset
415 cat( "</tbody></table></p>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
416
d4d58887f008 Uploaded
stef
parents:
diff changeset
417 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
418 ## list with links to all output files
d4d58887f008 Uploaded
stef
parents:
diff changeset
419 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
420 cat( '<h3 class="qdnaseq">Output files</h3><p>', "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
421 cat( '<p>This table contains output files that can be used for local downstream analysis with the bioconductor QDNAseq package. For each bin-size / data-level there is a R data structure file with data of all samples. See ', htmlLink( WEB_LINK, 'the bioconductor QDNAseq documentation' ), ' for more information on how to work with these files</p>', "\n", sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
422 cat( '<table class="pure-table pure-table-striped">', "\n" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
423 cat( '<thead><th>Type</th>', as.vector( mapply( paste, "<th>", binSizes, "kbp</th>", sep="" ) ),'</thead>', "\n" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
424 cat( "<tbody>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
425 files <- list()
d4d58887f008 Uploaded
stef
parents:
diff changeset
426 fileTypes <- c( 'ReadCounts.rds', 'CopyNumbers.rds' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
427 if ( doSegment ){ fileTypes <- c( fileTypes, 'CopyNumbersSegmented.rds') }
d4d58887f008 Uploaded
stef
parents:
diff changeset
428
d4d58887f008 Uploaded
stef
parents:
diff changeset
429 for ( fileType in fileTypes ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
430 fileNames <- mapply( paste, binSizes, paste( 'kbp_QDNAseq', fileType, sep=''), sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
431 fileLinks <- mapply( htmlLink, fileNames, paste( binSizes, "kbp", sep="" ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
432 cat( htmlTableRow( c( fileType, fileLinks ) ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
433 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
434 cat( "\n</tbody></table></p>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
435
d4d58887f008 Uploaded
stef
parents:
diff changeset
436 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
437 ## table with links to files
d4d58887f008 Uploaded
stef
parents:
diff changeset
438 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
439 ratio <- PLOT_WIDTH / PLOT_HEIGHT
d4d58887f008 Uploaded
stef
parents:
diff changeset
440 width <- 960; height <- width / ratio ## bigger img
d4d58887f008 Uploaded
stef
parents:
diff changeset
441 width_t <- 100; height_t <- 40 ## thumb img
d4d58887f008 Uploaded
stef
parents:
diff changeset
442
d4d58887f008 Uploaded
stef
parents:
diff changeset
443 cat( '<h3 class="qdnaseq">Results: overview</h3><p>', "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
444 cat( '<p>This table contains the visual results of the copy number aberration analysis. You can click on an image to jump to the larger version. If segmentation was performed as well the number of segments is shown and a file with genomic regions can be downloaded (just remember to inspect the results carefully as this is a more exprimental step).</p>', "\n", sep='')
d4d58887f008 Uploaded
stef
parents:
diff changeset
445 plots_html <- ''
d4d58887f008 Uploaded
stef
parents:
diff changeset
446
d4d58887f008 Uploaded
stef
parents:
diff changeset
447 colspan <- 1
d4d58887f008 Uploaded
stef
parents:
diff changeset
448 binHeader <- "<th>Image</th>"
d4d58887f008 Uploaded
stef
parents:
diff changeset
449 if ( doSegment ){ # extra column with segment info
d4d58887f008 Uploaded
stef
parents:
diff changeset
450 colspan <- 2
d4d58887f008 Uploaded
stef
parents:
diff changeset
451 binHeader <- "<th>Image</th><th>Segments</th>"
d4d58887f008 Uploaded
stef
parents:
diff changeset
452 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
453 cat( '<table class="pure-table pure-table-striped">', "\n" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
454 cat( '<thead><tr><th></th><th></th>', as.vector( mapply( paste, "<th colspan=\"", colspan,"\">", binSizes, "kbp</th>", sep="" ) ), '</tr></thead>' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
455 cat( '<thead><tr><th>Sample / File</th><th>Reads</th>', rep( binHeader, length(binSizes) ), '</tr></thead>' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
456 cat( '<tbody>' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
457
d4d58887f008 Uploaded
stef
parents:
diff changeset
458 for ( bam_file in bamsNames ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
459
d4d58887f008 Uploaded
stef
parents:
diff changeset
460 usedReads <- plotted_images[[ paste(binSize, bam_file, 'usedReads', sep="_" ) ]]
d4d58887f008 Uploaded
stef
parents:
diff changeset
461 usedReads <- format( as.integer(usedReads), digits=4, decimal.mark=".", big.mark="," )
d4d58887f008 Uploaded
stef
parents:
diff changeset
462 htmlRow <- paste( '<tr><td>', bam_file, '</td><td>', usedReads, '</td>', sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
463
d4d58887f008 Uploaded
stef
parents:
diff changeset
464 for ( binSize in binSizes ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
465
d4d58887f008 Uploaded
stef
parents:
diff changeset
466 ## add thumbnails to table with links to anchors on html page
d4d58887f008 Uploaded
stef
parents:
diff changeset
467 copy_img <- plotted_images[[ paste(binSize, bam_file, 'CopyNumbers', sep="_" ) ]]
d4d58887f008 Uploaded
stef
parents:
diff changeset
468 html_copy_thumb <- htmlLink( path=paste('#', copy_img, sep=''), paste('<img src="',copy_img,'" alt="', bam_file, '" width="', width_t, '" height="', height_t, '">', sep='') )
d4d58887f008 Uploaded
stef
parents:
diff changeset
469 html_copy_img <- htmlLink( path=copy_img, paste('<img id="', copy_img,'" src="',copy_img,'" alt="',bam_file, '" width="', width, '" height="', height, '">', sep='') )
d4d58887f008 Uploaded
stef
parents:
diff changeset
470 html_segm_img <- ''
d4d58887f008 Uploaded
stef
parents:
diff changeset
471 html_bedGraph <- ''
d4d58887f008 Uploaded
stef
parents:
diff changeset
472 region_count <- ''
d4d58887f008 Uploaded
stef
parents:
diff changeset
473 htmlRow <- paste( htmlRow, '<td>', html_copy_thumb, '</td>' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
474
d4d58887f008 Uploaded
stef
parents:
diff changeset
475 if ( doSegment ){
d4d58887f008 Uploaded
stef
parents:
diff changeset
476 segm_img <- plotted_images[[ paste(binSize, bam_file, 'Segmented', sep="_" ) ]]
d4d58887f008 Uploaded
stef
parents:
diff changeset
477 region_count <- plotted_images[[ paste(binSize, bam_file, 'region_count', sep="_" ) ]]
d4d58887f008 Uploaded
stef
parents:
diff changeset
478
d4d58887f008 Uploaded
stef
parents:
diff changeset
479 html_bedGraph <- htmlLink( path=plotted_images[[ paste(binSize, bam_file, 'bedgraph', sep="_" ) ]], 'bedGraph' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
480 html_segm_img <- htmlLink( path=segm_img, paste('<img id="', segm_img,'" src="', segm_img,'" alt="', bam_file, '" width="', width, '" height="', height,'">', sep='') )
d4d58887f008 Uploaded
stef
parents:
diff changeset
481 htmlRow <- paste( htmlRow, '<td>', region_count, ' (', html_bedGraph, ')</td>', sep="" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
482 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
483 plots_html <- paste( plots_html, html_copy_img, "\n", html_segm_img, "\n<br \\>\n", sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
484 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
485 plots_html <- paste( plots_html, "\n<hr \\>\n", sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
486 ## add info to overview table, including small thumbnails
d4d58887f008 Uploaded
stef
parents:
diff changeset
487 htmlRow <- paste( htmlRow, '</tr>', sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
488 cat( htmlRow, "\n" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
489 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
490 cat( "</tbody></table></p>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
491
d4d58887f008 Uploaded
stef
parents:
diff changeset
492 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
493 ## section with various output shown
d4d58887f008 Uploaded
stef
parents:
diff changeset
494 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
495 cat( '<h3 class="qdnaseq">Results: Sample plots</h3><p>', "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
496 ## now include (large) images in html page
d4d58887f008 Uploaded
stef
parents:
diff changeset
497 cat( plots_html, "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
498 cat( "\n</p></body>\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
499 cat( "\n</html>\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
500 sink()
d4d58887f008 Uploaded
stef
parents:
diff changeset
501
d4d58887f008 Uploaded
stef
parents:
diff changeset
502 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
503 ## creating main html output for galaxy history
d4d58887f008 Uploaded
stef
parents:
diff changeset
504 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
505 if ( inGalaxy ){ # dont create when running outside Galaxy
d4d58887f008 Uploaded
stef
parents:
diff changeset
506 sink( file = outputHtml, type = "output" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
507
d4d58887f008 Uploaded
stef
parents:
diff changeset
508 cat( "<head>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
509 cat( "\t", '<link rel="stylesheet" href="', PURE_CSS, '">', "\n", sep='' )
d4d58887f008 Uploaded
stef
parents:
diff changeset
510
d4d58887f008 Uploaded
stef
parents:
diff changeset
511 cat( "<style>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
512 ## include CSS directly into html file
d4d58887f008 Uploaded
stef
parents:
diff changeset
513 cat( paste( "\t", '/* the css here originates from ', CSS_FILE,' */', "\n") )
d4d58887f008 Uploaded
stef
parents:
diff changeset
514 cat( paste( "\t", readLines( CSS_FILE, n = -1)), sep="\n" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
515 cat( "</style>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
516 cat( "</head>", "\n")
d4d58887f008 Uploaded
stef
parents:
diff changeset
517
d4d58887f008 Uploaded
stef
parents:
diff changeset
518 cat( '<h1>QDNAseq Results (', outputName,')</h1>', "\n", sep="")
d4d58887f008 Uploaded
stef
parents:
diff changeset
519 cat( '<p>Explore <a href="', htmlOutputName, '" class="button">the results</a> directly within galaxy</p>', "\n", sep="")
d4d58887f008 Uploaded
stef
parents:
diff changeset
520 cat( '<p>Or download a <a href="', gzipOutputName, '" class="button">zipfile</a> with all output (', zippedSize, ')</p>', "\n", sep="" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
521
d4d58887f008 Uploaded
stef
parents:
diff changeset
522 sink()
d4d58887f008 Uploaded
stef
parents:
diff changeset
523 }
d4d58887f008 Uploaded
stef
parents:
diff changeset
524
d4d58887f008 Uploaded
stef
parents:
diff changeset
525 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
526 ## create final zip and quit with status 0 to tell galaxy all was fine
d4d58887f008 Uploaded
stef
parents:
diff changeset
527 ## ------------------------
d4d58887f008 Uploaded
stef
parents:
diff changeset
528 catMsg( "zipping all output")
d4d58887f008 Uploaded
stef
parents:
diff changeset
529 system( paste( "zip -j ", gzipOutputPath, paste(outputPath,'/', htmlOutputName, sep='') ) )
d4d58887f008 Uploaded
stef
parents:
diff changeset
530 catMsg( "done" )
d4d58887f008 Uploaded
stef
parents:
diff changeset
531 q(status=0)