Fixed issues with cells loosing information content after normalization

(e.g. true negative controls, that express only the spike in RNA; this expression is lost after normalization to the spike in.)
stela2502 · Feb 15, 2016 · 8c7eeee · 8c7eeee
1 parent 75533df
commit 8c7eeee
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 5 deletions.
diff --git a/SCExV/lib/HTpcrA/Controller/Files.pm b/SCExV/lib/HTpcrA/Controller/Files.pm
@@ -557,6 +557,12 @@ sub R_script {
 	  ->Add("<h3>File Upload</h3>\n<i>options:"
 		  . $self->options_to_HTML_table($dataset)
 		  . "</i>\n" );
+	if ( -f $path."Preprocess.R.log" ){
+		open ( IN , "<".$path."Preprocess.R.log");
+		$c->model('scrapbook')->init( $c->scrapbook() )
+	  		->Add( '<p>'. join("", <IN>)."</p>" );
+	  	close ( IN );
+	}
 	return 1;
 }
 

diff --git a/SCExV/root/R_lib/Tool_Pipe.R b/SCExV/root/R_lib/Tool_Pipe.R
@@ -582,7 +582,7 @@ norm.PCR <- function(tab,meth=c("none","mean control genes","max expression","me
 	no.exp <- which( apply( tab.ret, 2, var) == 0 )
 	if ( length( no.exp) > 0 ) {
 		tab.ret[,-no.exp]
-	}
+	}	
 	tab.ret
 
 }
@@ -838,6 +838,18 @@ createDataObj <- function ( PCR=NULL,  FACS=NULL, max.value=40,
 
 
 	data.filtered <- z.score.PCR.mad(data.filtered)
+	## now I need to drop the not informative samples (if there are any!
+	t <- which(apply( data.filtered$z$PCR, 1, sd) == 0)
+	if ( length(t) > 0 ) {
+		data.filtered <- remove.samples( data.filtered, t )
+		fname <- 'Preprocess.R.log'
+		fileConn<-file( fname )
+		writeLines ( c(paste( length(t),"samples were dropped due to no diversity in the expression values:"),paste( names(t), collapse="; ")
+				), con=fileConn )
+		close(fileConn)
+	}
+
+
 	#data.filtered$z$PCR <- data.filtered$PCR
 	system ( 'mkdir ../4_GEO' )
 	exp.geo <- function ( tab , fname ) {

diff --git a/SCExV/root/R_lib/Tool_Plot.R b/SCExV/root/R_lib/Tool_Plot.R
@@ -605,7 +605,7 @@ analyse.data <- function(obj,onwhat='Expression',groups.n, cmethod, clusterby='M
 					Rowv=RowV,
 					Colv=F,
 					hclustfun = function(c){hclust( c, method=cmethod)}
-			), silent=T)
+			), silent=F)
 
 #	try( collapsed_heatmaps (obj, what='PCR', functions = c('median', 'mean', 'var', 'quantile70' )), silent=T)
 #	try( collapsed_heatmaps (obj, what='FACS', functions = c('median', 'mean', 'var', 'quantile70' )), silent=T)
@@ -618,7 +618,7 @@ analyse.data <- function(obj,onwhat='Expression',groups.n, cmethod, clusterby='M
 					margins = c(1,11), 
 					lwid = c( 1,6), lhei=c(1,5),
 					hclustfun = function(c){hclust( c, method=cmethod)}
-			), silent=T)
+			), silent=F)
 	try( FACS.heatmap ( list( data= t(obj$FACS), genes = colnames(obj$FACS)), 
 					'./facs', 
 					title='FACS data', 
@@ -629,7 +629,7 @@ analyse.data <- function(obj,onwhat='Expression',groups.n, cmethod, clusterby='M
 					margins = c(1,11), 
 					lwid = c( 1,6), lhei=c(1,5),
 					hclustfun = function(c){hclust( c, method=cmethod)}
-			), silent=T)
+			), silent=F)
 
 	try( FACS.heatmap ( list( data= t(obj$FACS)[,order(obj$clusters)], genes = colnames(obj$FACS)), 
 					'./facs_color_groups', 
@@ -642,7 +642,7 @@ analyse.data <- function(obj,onwhat='Expression',groups.n, cmethod, clusterby='M
 					lwid = c( 1,6), lhei=c(1,5),
 					Colv=F,
 					hclustfun = function(c){hclust( c, method=cmethod)}
-			), silent=T)
+			), silent=F)
 
 	ma  <- NULL
 	mv <- NULL