diff --git a/SCExV/lib/HTpcrA/Controller/Files.pm b/SCExV/lib/HTpcrA/Controller/Files.pm index 3ae6995..2ae6425 100644 --- a/SCExV/lib/HTpcrA/Controller/Files.pm +++ b/SCExV/lib/HTpcrA/Controller/Files.pm @@ -557,6 +557,12 @@ sub R_script { ->Add("

File Upload

\noptions:" . $self->options_to_HTML_table($dataset) . "\n" ); + if ( -f $path."Preprocess.R.log" ){ + open ( IN , "<".$path."Preprocess.R.log"); + $c->model('scrapbook')->init( $c->scrapbook() ) + ->Add( '

'. join("", )."

" ); + close ( IN ); + } return 1; } diff --git a/SCExV/root/R_lib/Tool_Pipe.R b/SCExV/root/R_lib/Tool_Pipe.R index 71f1cf2..621e92a 100644 --- 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 index 8a15766..b412d42 100644 --- 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