Drop Genes
\noptions:" . $self->options_to_HTML_table($hash) diff --git a/SCExV/lib/HTpcrA/Controller/DropSamples.pm b/SCExV/lib/HTpcrA/Controller/DropSamples.pm index 43c26f3..fcd2505 100644 --- a/SCExV/lib/HTpcrA/Controller/DropSamples.pm +++ b/SCExV/lib/HTpcrA/Controller/DropSamples.pm @@ -33,11 +33,11 @@ sub index : Path : Form { $self->slurp_Heatmaps( $c, $path ); -# if ( -f "$path/webGL/index.html" ) { + if ( -f "$path/webGL/index.html" ) { $self->{'webGL'} = "$path/webGL/index.html"; $self->slurp_webGL( $c, $self->{'webGL'}, $path ); $c->stash->{'buttons'} = $self->exclude_buttons($c); -# } + } ## now the form to remove the samples $self->{'form_array'} = []; @@ -81,33 +81,9 @@ sub R_remove_samples { my ( $self, $c, $hash ) = @_; my $path = $c->session_path(); - my $script = "source ('libs/Tool_Pipe.R')\n" . "load( 'norm_data.RData')\n"; - - #$hash->{'Samples'} |= []; - if ( defined @{ $hash->{'Samples'} }[0] ) { - $script .= - "remS <- c ('" - . join( "', '", @{ $hash->{'Samples'} } ) - . "')\ndata.filtered = remove.samples(data.filtered, match( remS,rownames(data.filtered\$PCR)) )\n" - if ( @{ $hash->{'Samples'} }[0] =~ m/[\w\d_]+/ ); - } - if ( defined $hash->{'RegExp'} ) { - $script .= -"data.filtered = remove.samples(data.filtered, grep( \"$hash->{'RegExp'}\" ,rownames(data.filtered\$PCR)) )\n" - if ( $hash->{'RegExp'} =~ m/[\w\d_]+/ ); - } - - $script .= -"data.filtered <- sd.filter(data.filtered)\n"."data.filtered <- z.score.PCR.mad(data.filtered)\n"."save( data.filtered, file='norm_data.RData' )\n"; + my $script = $c->model('RScript')->create_script($c, 'remove_samples', $hash ); + $c->model('RScript')->runScript( $c, $path, 'DropSamples.R', $script, 1 ); - open( RSCRIPT, ">$path/DropSamples.R" ) - or Carp::confess( - "I could not create the R script '$path/DropSamples.R'\n$!\n"); - print RSCRIPT $script; - chdir($path); - system( -'/bin/bash -c "DISPLAY=:7 R CMD BATCH --no-readline -- DropSamples.R > R.pre.run.log"' - ); $c->model('scrapbook')->init( $c->scrapbook() ) ->Add("Drop Samples (Cells)
\noptions:" . $self->options_to_HTML_table($hash) @@ -125,10 +101,10 @@ sub Select_Options { $self->{'select_options'} = [ map { { $_ => $_ } - } sort @{ $data_table->GetAsArray('Samples') } + } @{ $data_table->GetAsArray('SampleName') } ]; $self->{"Group_2_Sample"} = - $data_table->GetAsHashedArray( 'Cluster', 'Samples' ); + $data_table->GetAsHashedArray( 'grouping', 'SampleName' ); return $self->{'select_options'}; } diff --git a/SCExV/lib/HTpcrA/Controller/Files.pm b/SCExV/lib/HTpcrA/Controller/Files.pm index 2ae6425..33a482e 100644 --- a/SCExV/lib/HTpcrA/Controller/Files.pm +++ b/SCExV/lib/HTpcrA/Controller/Files.pm @@ -392,7 +392,8 @@ sub upload : Local : Form { $self->config_file( $c, 'Preprocess.Configs.txt', $dataset ); $self->file_upload( $c, $dataset ); $self->R_script( $c, $dataset ); - unless ( -f $path . "../norm_data.RData" ) { + unless ( -f $c->session_path(). "norm_data.RData" ) { + Carp::confess("File ".$c->session_path(). "norm_data.RData". " Not found" ); if ( defined @{ $dataset->{'negControllGenes'} }[0] && length(@{ $dataset->{'negControllGenes'} }[0]) > 0 ) { my $spath = $c->session_path(); open( OUT, ">" . $spath . "Error_system_message.txt" ); @@ -508,113 +509,31 @@ sub R_script { [ map { $_ =~ m/preprocess\/(.+).png/; $1; } @{ $dataset->{'negContr'} } ]; - my $seesion_hash = $c->session(); $dataset->{'maxGenes'} = 0 if ( $dataset->{'maxGenes'} eq "any" ); $dataset->{'maxGenes'} = 3 if ( $dataset->{'maxGenes'} eq "all 4" ); $dataset->{'maxGenes'} = $1 if ( $dataset->{'maxGenes'} =~ m/more than (\d)/ ); #Carp::confess ( root->print_perl_var_def( $seesion_hash->{'PCR'} ) ); - - my $script = - "source ('../libs/Tool_Pipe.R')\n" - . "source ('../libs/Tool_Plot.R')\n" - . "negContrGenes <- NULL\n" - . "plotsvg = 0\n"; - $script .= - "negContrGenes <- c ( '" - . join( "', '", @{ $dataset->{'negControllGenes'} } ) . "')\n" - if ( defined @{ $dataset->{'negControllGenes'} }[0] ); - $script .= "data.filtered <- createDataObj ( PCR= c( '../" - . join( "', '../", - map { $_->{'filename'}.".mod" } @{ $seesion_hash->{'PCRTable'} } ) - . "' ), " - . " PCR2= c( '../" - . join( "', '../", - map { $_->{'filename'}.".mod" } @{ $seesion_hash->{'PCRTable2'} } ) - . "' ), " - . "FACS= c( '../" - . join( "','../", - map { $_->{'filename'}.".mod" } @{ $seesion_hash->{'facsTable'} } ) - . "' ), " - . "ref.genes= c( '" - . join( "', '", @{ $dataset->{'controlM'} } ) . "' )," - . " use_pass_fail = '$dataset->{'use_pass_fail'}', " - . "max.value=40, max.ct= $dataset->{'maxCT'} , max.control=$dataset->{'maxGenes'}, norm.function='$dataset->{'normalize2'}', negContrGenes=negContrGenes )\n" - . "save( data.filtered, file='../norm_data.RData' )\n" - ; - $script =~ s/c\( '.?.?\/?' \)/NULL/g; - - open( RSCRIPT, ">$path/Preprocess.R" ) - or Carp::confess( - "I could not create the R script '$path/Preprocess.R'\n$!\n"); - print RSCRIPT $script; - chdir($path); - system( -'/bin/bash -c "DISPLAY=:7 R CMD BATCH --no-readline -- Preprocess.R > R.pre.run.log"' - ); + + my $script = $c->model('RScript')->create_script($c,'file_load', $dataset); + + $c->model('RScript')->runScript( $c, $c->session_path(), 'Preprocess.R', $script, 1 ); + $c->model('scrapbook')->init( $c->scrapbook() ) ->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("",
P values calculation
\noptions:" diff --git a/SCExV/lib/HTpcrA/Controller/Regroup.pm b/SCExV/lib/HTpcrA/Controller/Regroup.pm index 0d27a3c..1f4ed99 100644 --- a/SCExV/lib/HTpcrA/Controller/Regroup.pm +++ b/SCExV/lib/HTpcrA/Controller/Regroup.pm @@ -25,58 +25,6 @@ Catalyst Controller. =cut -sub index_form { - my ( $self, $c, $path ) = @_; - - opendir( DIR, $path ); - my @files = grep( /Grouping/, readdir(DIR) ); - if ( defined $files[0] ) { - $c->stash->{'Form'} = 1; - $c->form->field( - 'comment' => 'Existing groups', - 'name' => 'UG', - 'options' => [@files] - , ## you will break the R_script changing this text! - 'value' => '', - 'required' => 0, - 'multiple' => 1, - ); - closedir(DIR); - $c->form->submit('Delete group(s)'); - } - else { - $c->stash->{'Form'} = 0; - } - closedir(DIR); - return @files; -} - -sub index : Local : Form { - my ( $self, $c, @args ) = @_; - my $path = $self->check($c); - - my @files = $self->index_form( $c, $path ); - - if ( $c->form->submitted && $c->form->validate ) { - ## exclude some samples!! - $c->stash->{'ERROR'} = []; - my $dataset = $self->__process_returned_form($c); - unless ( ref( $dataset->{'UG'} ) eq "ARRAY" ) { - $dataset->{'UG'} = [ $dataset->{'UG'} ]; - } - foreach ( @{ $dataset->{'UG'} } ) { - next if ( $_ eq "" ); - unlink( $path . "$_" ); - push( @{ $c->stash->{'ERROR'} }, "Group definition '$_' deleted!" ); - $c->model('scrapbook') - ->Add("Re-Grouping - delete grouing data file '$_'.
\n"); - @files = grep !/$_/, @files; - } - $self->index_form( $c, $path ); - - } - $c->stash->{'template'} = 'CustomGroupingsDoc.tt2'; -} sub samplenames : Local : Form { my ( $self, $c, @args ) = @_; @@ -102,13 +50,29 @@ sub samplenames : Local : Form { if ( $c->form->submitted && $c->form->validate ) { ## exclude some samples!! my $analysis_conf = $self->config_file( $c, 'rscript.Configs.txt' ); - $analysis_conf->{'UG'} = - $self->R_userGroups( $c, $self->__process_returned_form($c) ); - $self->config_file( $c, 'rscript.Configs.txt', $analysis_conf ); - unless ( ref( $c->stash->{'ERROR'} ) eq "ARRAY" ) { - $c->res->redirect( $c->uri_for("/analyse/re_run/") ); + my $dataset = $self->__process_returned_form($c); + + my $Rscript = + $c->model('RScript')->create_script( $c, 'userGroups', $dataset ); + $c->model('RScript') + ->runScript( $c, $path, "Grouping_" . $dataset->{'GroupingName'}, + $Rscript, 'wait' ); + + if ( -f $path . "Grouping_R_Error.txt" ) { + open( IN, "<$path" . "Grouping_R_Error.txt" ); + $c->stash->{'ERROR'} = [Create a user defined grouping
\noptions:" + . $self->options_to_HTML_table($dataset) . "\n" + ); + $c->res->redirect( + $c->uri_for("/analyse/re_run/$dataset->{'GroupingName'}") ); $c->detach(); } + } $c->stash->{'template'} = 'SampleNameGroups.tt2'; } @@ -116,7 +80,7 @@ sub samplenames : Local : Form { sub reorder : Local : Form { my ( $self, $c, @args ) = @_; my $path = $self->check($c); - + $self->source_groups($c); $self->JavaScript($c); $self->{'form_array'} = []; @@ -142,22 +106,32 @@ sub reorder : Local : Form { if ( $c->form->submitted && $c->form->validate ) { ## exclude some samples!! my $analysis_conf = $self->config_file( $c, 'rscript.Configs.txt' ); - $analysis_conf->{'UG'} = - $self->R_regroup( $c, $self->__process_returned_form($c) ); - $self->config_file( $c, 'rscript.Configs.txt', $analysis_conf ); + my $dataset = $self->__process_returned_form($c); + my $script = + $c->model('RScript')->create_script( $c, 'regroup', $dataset ); + $c->model('RScript') + ->runScript( $c, $path, 'ReorderGroups.R', $script, 1 ); + unless ( ref( $c->stash->{'ERROR'} ) eq "ARRAY" ) { - $c->res->redirect( $c->uri_for("/analyse/re_run/") ); + $c->model('scrapbook')->init( $c->scrapbook() ) + ->Add("User reordered a given grouping
\noptions:" + . $self->options_to_HTML_table($dataset) + . "\n" ); + $c->res->redirect( + $c->uri_for("/analyse/re_run/$dataset->{GroupingName}") ); $c->detach(); } + } if ( -f $path . 'facs_Heatmap.png' ) { $c->stash->{'HeatmapStatic'} = join( "", $self->create_selector_table_4_figures( - $c, 'heatmaps_s', - 'heatpic_s', 'picture_s', 'CorrelationPlot.png', - 'PCR_Heatmap.png','PCR_color_groups_Heatmap.png', - 'facs_Heatmap.png','facs_color_groups_Heatmap.png', + $c, 'heatmaps_s', + 'heatpic_s', 'picture_s', + 'CorrelationPlot.png', 'PCR_Heatmap.png', + 'PCR_color_groups_Heatmap.png', 'facs_Heatmap.png', + 'facs_color_groups_Heatmap.png', ) ); } @@ -165,8 +139,8 @@ sub reorder : Local : Form { $c->stash->{'HeatmapStatic'} = join( "", $self->create_selector_table_4_figures( - $c, 'heatmaps_s', - 'heatpic_s', 'picture_s', 'CorrelationPlot.png', + $c, 'heatmaps_s', + 'heatpic_s', 'picture_s', 'CorrelationPlot.png', 'PCR_Heatmap.png', 'PCR_color_groups_Heatmap.png', ) @@ -176,91 +150,6 @@ sub reorder : Local : Form { $c->stash->{'template'} = 'Regroup.tt2'; } -sub R_userGroups { - my ( $self, $c, $dataset ) = @_; - my $path = $c->session_path(); - - unlink( $path . "Grouping_R_Error.txt" ) - if ( -f $path . "Grouping_R_Error.txt" ); - - #Carp::confess ( root->print_perl_var_def($dataset) ); - my @groupsnames = split( /\s+/, $dataset->{'Group Names'} ); - my $data_table = - data_table->new( { 'filename' => $path . 'Sample_Colors.xls' } ); - my ($Rscript); - - $Rscript = -"source ('libs/Tool_grouping.R')\nuserGroups <-group_on_strings ( data.filtered, c( '" - . join( "', '", @groupsnames ) - . "' ) )\n"; - - open( OUT, ">$path" . "Grouping_" . $dataset->{'GroupingName'} ) or die $!; - print OUT $Rscript; - close(OUT); - if ( -f $path . "Grouping_R_Error.txt" ) { - open( IN, "<$path" . "Grouping_R_Error.txt" ); - $c->stash->{'ERROR'} = [Create a user defined grouping
\noptions:" - . $self->options_to_HTML_table($dataset) - . "\n" ); - return "Grouping_" . $dataset->{'GroupingName'}; - -} - -sub R_regroup { - my ( $self, $c, $dataset ) = @_; - - my $path = $c->session_path(); - - my $data_table = - data_table->new( { 'filename' => $path . 'Sample_Colors.xls' } ); - my ( $old_ids, $Rscript, $OK ); - ## R dataset: group2sample = list ( '1' = c( 'Sample1', 'Sample2' ) ) - $Rscript = -"source ('libs/Tool_grouping.R')\nuserGroups <-regroup ( data.filtered, list ("; - $OK = 0; - for ( my $i = 1 ; $i <= scalar( keys %$dataset ) ; $i++ ) - { ## scale from 1 to n - next unless ( defined $dataset->{ 'g' . $i } ); - $old_ids = { map { $_ => 1 } $dataset->{ 'g' . $i } =~ m/Group(\d+)/g }; - next if ( keys %$old_ids == 0 ); - $OK++; - $Rscript .= " \n\t'$i' = c('" . join( - "', '", - @{ - $data_table->select_where( - 'Cluster', - sub { - my $v = shift; - return 1 if ( $old_ids->{$v} ); - return 0; - } - )->GetAsArray('Samples') - } - ) . "'),"; - } - if ( $OK < 2 ) { - $c->stash->{'ERROR'} = [ -'Sorry - you have not created enough groups! Min 2 groups are required!' - ]; - } - chop($Rscript); - $Rscript .= " )\n)\n"; - $dataset->{'script'} = $Rscript; - $dataset->{'Sample_Colors.xls'} = $data_table; - open( OUT, ">$path" . "Grouping_" . $dataset->{'GroupingName'} ) or die $!; - print OUT $Rscript; - close(OUT); - $c->model('scrapbook')->init( $c->scrapbook() ) - ->Add("Re-group your groups
\noptions:" - . $self->options_to_HTML_table($dataset) - . "\n" ); - return "Grouping_" . $dataset->{'GroupingName'}; -} - sub rgbToHex { my ( $self, $red, $green, $blue ) = @_; my $string = sprintf( " #%2.2X%2.2X%2.2X\n", $red, $green, $blue ); @@ -273,7 +162,8 @@ sub source_groups { my $path = $c->session_path(); my $data_table = data_table->new(); - open( IN, "<$path" . 'Sample_Colors.xls' ) or die "$!\n"; + open( IN, "<$path" . 'Sample_Colors.xls' ) + or Carp::confess("Internal libraray problem: File not found: $!\n"); $data_table->{'used'} = {}; open( LOG, ">>$path" . "Logfile_Regroup.txt" ); while (\n
";
$c->stash->{'sourceGroups'} .=
"";
$i++;
}
@@ -342,13 +233,16 @@ sub JavaScript {
"",
map {
"copyNames( document.getElementById( 'div$_' ).children, form.g$_ )\n"
- } 1 .. $c->stash->{'groups'})
- . "\n}\n\n"
- . '\n" . '\n"
+ . '\n"
- );
+ . '\n"
+ );
open( LOG, ">>" . $c->session_path() . "Logfile_Regroup.txt" );
print LOG "JavaScript: script:n"
. $self->Script($c)
diff --git a/SCExV/lib/HTpcrA/Controller/analyse.pm b/SCExV/lib/HTpcrA/Controller/analyse.pm
index ba83727..8cdfd75 100644
--- a/SCExV/lib/HTpcrA/Controller/analyse.pm
+++ b/SCExV/lib/HTpcrA/Controller/analyse.pm
@@ -150,7 +150,7 @@ sub update_form {
{
'comment' => 'multi dimensional scaling (MDS) Algorithm',
'name' => 'mds_alg',
- 'options' => [ 'PCA', 'LLE', 'ISOMAP' ],
+ 'options' => [ 'PCA', 'LLE', 'ISOMAP', 'ZIFA' ],
'value' => $hash->{'mds_alg'},
'required' => 1,
'jsclick' => 'mds_show( )'
@@ -177,24 +177,22 @@ sub update_form {
}
);
- opendir( DIR, $c->session_path() );
-
+ my @grps = $self->groupings( $c );
+ $hash->{'UG'} = $grps[0] if ( ! ( $grps[0] eq "none" ) );
push(
@{ $self->{'form_array'} },
{
'comment' => 'Group by: (optional)',
'name' => 'UG',
'type' => 'select',
- 'options' =>
- [ 'none', 'Group by plateID', grep( /Grouping/, readdir(DIR) ) ]
+ 'options' => [ @grps ]
, ## you will break the R_script changing this text!
'value' => $hash->{'UG'},
'required' => 0,
- 'jsclick' =>
- "form_fun_match( 'master', 'UG', 'randomForest', 'randomForest')",
+ # 'jsclick' =>
+ # "form_fun_match( 'master', 'UG', 'randomForest', 'randomForest')",
}
);
- closedir(DIR);
my $type = 'hidden';
push(
@@ -233,6 +231,8 @@ sub update_form {
'required' => 0,
}
);
+
+#$c->stash->{'formNames'} = [map { $_->{'name'} } @{$self->{'form_array'}}[2..(@{$self->{'form_array'}}-1)] ];
$c->form->method('post');
foreach ( @{ $self->{'form_array'} } ) {
$c->form->field( %{$_} );
@@ -240,6 +240,22 @@ sub update_form {
$c->form->submit( ['Run Analysis'] );
}
+sub groupings {
+ my ( $self, $c ) = @_;
+ my $f = File::Spec->catfile( $c->session_path(), 'SCExV_Grps.txt');
+ my @grps;
+ if ( -f $f ){
+ open( GRPS, "<$f" );
+ @grps = map { chomp; $_ } (The analysis section
\nHere you can analyse your uploaded data using the options on the left side.
"; $self->update_form($c); if ( $c->form->submitted && $c->form->validate ) { - + warn "Button return value = ". $c->form->submitted."\n"; my $dataset = $self->__process_returned_form($c); $dataset->{'randomForest'} ||= 10; $self->config_file( $c, 'rscript.Configs.txt', $dataset ) @@ -428,7 +449,7 @@ sub index : Path : Form { ); } elsif ( $c->form->submitted() eq "0E0" ) - { ## remove samples based on the 2D MDS figure! + { ## this is when the RemoveSamples is pressed in 2D MDS view if ( $dataset->{'x1'} =~ m/\d+/ ) { $self->config_file( $c, 'rscript.Configs.txt', $dataset ); my $gg = $c->model('GeneGroups'); @@ -458,31 +479,20 @@ sub index : Path : Form { ); ## now I need to create a new R script!!! - my $script = - 'mark.mds <- read.table( file="' + my $script = $c->model('RScript')->create_script()."\n" + . $c->model('RScript')->_add_fileRead( $path ) + . 'mark.mds <- read.table( file="' . $path . '2D_data.xls' . '" )' . "\n"; - $script .= - "source ('libs/Tool_Plot.R')\n" - . "source ('libs/Tool_Pipe.R')\n" - . "load( 'norm_data.RData')\n"; $script .= $gg->export_R_exclude_samples('mark.mds') - . "data.filtered <- remove.samples( data.filtered, match(excludeSamples, rownames(data.filtered\$PCR) ) )\n" - . "data.filtered <- sd.filter(data.filtered)\n" + . "data <- remove.samples( data, match(excludeSamples, rownames(data\@data) ) )\n" + . "data <- sd.filter(data)\n" . "## write the new data\n" - . "save( data.filtered, file='norm_data.RData' )\n"; - unlink( $c->session_path() . "R.error" ) - if ( -f $c->session_path() . "R.error" ); - open( OUT, ">" . $self->path($c) . "ExcludeSamples.R" ) - or Carp::confess($!); - print OUT $script; - close(OUT); - chdir($path); - system( -'/bin/bash -c "DISPLAY=:7 R CMD BATCH --no-save --no-restore --no-readline -- ExcludeSamples.R"' - ); + . "save( data, file='analysis.RData' )\n"; + + $c->model('RScript')->runScript( $c, $path, "ExcludeSamples.R", $script ); $c->res->redirect( $c->uri_for("/analyse/re_run/") ); $c->detach(); @@ -500,6 +510,7 @@ sub index : Path : Form { } if ( -d $path . 'webGL' ) { my $path = $c->session_path(); + $self->update_form( $c ); if ( -f $path . "R.error" ) { open( IN, "<$path" . "R.error" ); $c->stash->{'message'} .= join( "",Create Grouing based on one gene
\noptions:" - # . $self->options_to_HTML_table($dataset) - # . "\n" ); + $dataset->{'path'} = $self->path($c); + + my $script = $c->model('RScript')->create_script($c, 'geneGroup1D', $dataset ); + $c->model('RScript')->runScript( $c, $c->session_path() , "Grouping.$dataset->{GOI}" , $script ); + return $figure_file; } @@ -168,40 +152,14 @@ sub R_script { ## to plot the histograms!! my ( $self, $c ) = @_; #the dataset created from the input form my $path = $self->path($c); mkdir($path) unless ( -d $path ); + my $dataset; + $dataset->{'path'} = $path; + $dataset->{'subpath'} = 'GG_prep'; + ##init script - my $script = - "source ('../libs/Tool_Pipe.R')\n" . "load( '../norm_data.RData')\n"; - - ## load the previousely defined cut regions - opendir( DIR, $self->path($c) ); - $script .= - "cuts <- vector('list', 1)\n" - . "files <- c( '" - . join( "', '", grep /.cut$/, readdir(DIR) ) . "' )\n"; - closedir(DIR); - $script .= - "library(stringr)\n" - . "for ( i in 1:length(files)){\n" - . " cuts[[i]] <-readLines( files[i] )\n" . "}\n" - . "names(cuts) <- str_replace_all( files, '.cut', '' )\n"; - - ## plot all the expression as histogram - $script .= "plot.histograms ( data.filtered, cuts )\n"; - - $script .= - "## export all gene names for the web frontend\n" - . "n <- rownames(data.filtered\$PCR )\n" - . "if ( ! is.null(data.filtered\$FACS ) ) {\n" - . " n <- c( n , colnames(data.filtered\$FACS) )\n}\n" - . "write( n, 'Genes.txt', ncolumns=1 ) \n"; - open( RSCRIPT, ">$path/Gene_Group_Prepare.R" ) - or Carp::confess( - "I could not create the R script '$path/Gene_Group_Prepare.R'\n$!\n"); - print RSCRIPT $script; - chdir($path); - system( -'/bin/bash -c "DISPLAY=:7 R CMD BATCH --no-readline -- Gene_Group_Prepare.R > R.run.log"' - ); + my $script = $c->model('RScript')->create_script($c, 'geneGroup1D_backend', $dataset ); + $c->model('RScript')->runScript( $c, $path."../", 'Gene_Group_Prepare.R', $script, 1 ); + return 1; } diff --git a/SCExV/lib/HTpcrA/Controller/grouping_2d.pm b/SCExV/lib/HTpcrA/Controller/grouping_2d.pm index 704e988..e27d180 100644 --- a/SCExV/lib/HTpcrA/Controller/grouping_2d.pm +++ b/SCExV/lib/HTpcrA/Controller/grouping_2d.pm @@ -105,6 +105,7 @@ sub index : Path : Form { my $use_data_table_obj = 1 ); if ( $c->form->submitted && $c->form->validate ) { my $dataset = $self->__process_returned_form($c); + $dataset->{'gg'} = $c->model('GeneGroups'); unless ( join( ' ', $geneA, $geneB ) eq join( " ", $dataset->{'gx'}, $dataset->{'gy'} ) ) @@ -119,10 +120,10 @@ sub index : Path : Form { $self->check_local( $c, $geneA, $geneB, $dataset->{'gx'}, $dataset->{'gy'} ); - $gg = $c->model('GeneGroups'); - $gg->read_grouping( $self->path($c) . "Grouping.$geneA.$geneB" ) - if ( -f $self->path($c) . "Grouping.$geneA.$geneB" ); + $dataset->{'gg'}->read_grouping( $path . "Grouping.$geneA.$geneB" ) + if ( -f $path . "Grouping.$geneA.$geneB" ); + if ( $c->form->submitted() eq "Submit" || $c->form->submitted() eq 'Analyze using this grooping' ) { @@ -149,14 +150,17 @@ sub index : Path : Form { foreach ( 'y1', 'y2' ) { $dataset->{$_} = $yaxis->pix2value( $dataset->{$_} ); } - + $dataset->{'groupname'} = "Grouping.$geneA.$geneB"; ##Store the group! - $gg->AddGroup( $geneA, $geneB, map { $dataset->{$_} } 'x1', + $dataset->{'gg'}->AddGroup( $geneA, $geneB, map { $dataset->{$_} } 'x1', 'x2', 'y2', 'y1' ); - $gg->write_R( $c->session_path() . "Grouping.$geneA.$geneB", - 'data.filtered' ); - $gg->write_grouping( - $self->path($c) . "Grouping.$geneA.$geneB" ); + + $dataset->{'gg'}->write_grouping ( join("/",$path,"Grouping.$geneA.$geneB" )); + + my $script = $c->model('RScript')-> create_script($c,'geneGroup2D',$dataset); + $c->model('RScript')->runScript( $c, $c->session_path(), "$dataset->{'groupname'}.R", $script, 1 ); + + $c->model('scrapbook')->init( $c->scrapbook() ) ->Add( "Create Grouing based on two genes
\noptions:" diff --git a/SCExV/lib/HTpcrA/EnableFiles.pm b/SCExV/lib/HTpcrA/EnableFiles.pm index 65eed37..eba6087 100644 --- a/SCExV/lib/HTpcrA/EnableFiles.pm +++ b/SCExV/lib/HTpcrA/EnableFiles.pm @@ -196,7 +196,7 @@ sub file_format_fixes { $filename = root->filemap($filename); } - my $orig_file; + my $outfile = $filename; $outfile = root->filemap( join( "/", @@ -205,7 +205,6 @@ sub file_format_fixes { ); unless ( $outfile->{'total'} eq $filename->{'total'} ) { system("cp '$filename->{'total'}' '$outfile->{'total'}'"); - $orig_file = $filename; $filename = $outfile; $unique->{ $filename->{'filename'} } = 1; } @@ -215,6 +214,7 @@ sub file_format_fixes { ## bloody hack to get rid of the stupid ...3","23,43","32.... format problems $self->__fix_file_problems( $filename->{'total'}, $filetype ); + return ($filename); } @@ -229,12 +229,10 @@ sub __fix_file_problems { ## 1,000 == 1000 !!!!!!! while ("
diff --git a/SCExV/lib/HTpcrA/Model/PValues.pm b/SCExV/lib/HTpcrA/Model/PValues.pm
deleted file mode 100644
index 34df4e0..0000000
--- a/SCExV/lib/HTpcrA/Model/PValues.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package HTpcrA::Model::PValues;
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Model';
-
-=head1 NAME
-
-HTpcrA::Model::PValues - Catalyst Model
-
-=head1 DESCRIPTION
-
-Catalyst Model.
-
-=head1 AUTHOR
-
-Stefan Lang
-
-=head1 LICENSE
-
-This library is free software. You can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
-
-sub create_script {
- my ( $self, $c, $dataset ) = @_;
- my $path = $c->session->{'path'};
- unless ( -f $path . "/norm_data.RData" ) {
- $c->res->redirect( $c->uri_for("/files/upload/") );
- $c->detach();
- }
- $dataset->{'boot'} ||= 1000,
- $dataset->{'lin_lang_file'} ||= 'lin_lang_stats.xls';
- $dataset->{'sca_ofile'} ||= "Significant_genes.csv";
-# unless ( -f $path . "createPvalues.R" ) {
- my $script =
- "source('libs/Tool_PValues.R')\nload('analysis.RData')\n"
- . "stat_obj <- create_p_values( data, boot = $dataset->{'boot'}, "
- . "lin_lang_file= '$dataset->{'lin_lang_file'}', sca_ofile ='$dataset->{'sca_ofile'}' )\n"
- . "save( data, file='analysis.RData' )\n";
- open( OUT, ">" . $path . "createPvalues.R" ) or die "$!\n";
- print OUT $script;
- close(OUT);
-# }
- chdir($path);
- system(
-'/bin/bash -c "DISPLAY=:7 R CMD BATCH --no-save --no-restore --no-readline -- createPvalues.R >> R.run.log"'
- );
- return $dataset;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
diff --git a/SCExV/lib/HTpcrA/Model/RScript.pm b/SCExV/lib/HTpcrA/Model/RScript.pm
new file mode 100644
index 0000000..b846b6c
--- /dev/null
+++ b/SCExV/lib/HTpcrA/Model/RScript.pm
@@ -0,0 +1,504 @@
+package HTpcrA::Model::RScript;
+use Moose;
+use namespace::autoclean;
+use File::Copy "mv";
+
+extends 'Catalyst::Model';
+
+=head1 NAME
+
+HTpcrA::Model::RScript - Catalyst Model
+
+=head1 DESCRIPTION
+
+Catalyst Model.
+
+
+=encoding utf8
+
+=head1 AUTHOR
+
+Stefan Lang
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+=head2 create_script
+
+This function allows slimmer storage + call of Rscripts.
+
+options: ($path, $file, $script, $wait )
+
+=cut
+
+sub runScript {
+ my ( $self, $c, $path, $file, $script, $wait ) = @_;
+ unlink( $c->session_path() . "R.error" )
+ if ( -f $c->session_path() . "R.error" );
+ open( OUT, ">" . $path . $file ) or Carp::confess($!);
+ print OUT $script;
+ close(OUT);
+ $wait ||= '';
+ if ( $wait eq 'NoRun' ) {
+ return 1;
+ }
+ if ($wait) {
+ $wait = '';
+ }
+ else {
+ $wait = '&';
+ }
+ chdir($path);
+ system(
+'/bin/bash -c "DISPLAY=:7 R CMD BATCH --no-save --no-restore --no-readline -- '
+ . $file
+ . " $wait\"" );
+ return 1;
+}
+
+sub create_script {
+ my ( $self, $c, $function, $dataset ) = @_;
+ my $str = join( "\n",
+ "options(rgl.useNULL=TRUE)", "library(Rscexv)", "useGrouping<-NULL", );
+ if ( defined $function ) {
+ unless ( $self->can($function) ) {
+ Carp::confess(
+"Internal server error: R creation function '$function' not defined!\n"
+ );
+ }
+ $str .= "\n" . &{ \&{$function} }( $self, $c, $dataset );
+ }
+ return $str;
+}
+
+
+sub _add_fileRead {
+ my ( $self, $path ) = @_;
+ if ( -f $path . "analysis.RData" ) {
+ return "load('analysis.RData')\ndata.filtered <- data\n";
+ }
+ if ( -f $path . "norm_data.RData" ) {
+ return "load('norm_data.RData')\n";
+ }
+ return '## probably a problem : no file existst in path "' . $path . '"'
+ . "\n";
+}
+
+=head2 pValues
+
+Calulate all p values for the data
+
+=cut
+
+sub pValues {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session->{'path'};
+
+ $dataset->{'boot'} ||= 1000,
+ $dataset->{'lin_lang_file'} ||= 'lin_lang_stats.xls';
+ $dataset->{'sca_ofile'} ||= "Significant_genes.csv";
+ my $script =
+ "load('analysis.RData')\n"
+ . "stat_obj <- create_p_values( data, boot = $dataset->{'boot'}, "
+ . "lin_lang_file= '$dataset->{'lin_lang_file'}', sca_ofile ='$dataset->{'sca_ofile'}' )\n"
+ . "saveObj( data, file='analysis.RData' )\n";
+ return $script;
+}
+
+
+=head2 geneGroup2D
+
+This creates th R script from the grouping_2d controller.
+This is dependant on the GeneGroups class that is provided in the dataset->{'gg'} object.
+
+=cut
+
+sub geneGroup2D {
+ my ( $self, $c, $dataset ) = @_;
+
+ my $script = $self-> _add_fileRead ( $c->session_path() );
+ $script .= $dataset->{'gg'}->export_R( 'data.filtered', $dataset->{'groupname'} );
+ $script .= "saveObj(data.filtered)\n";
+
+ return $script;
+}
+
+
+=head2 geneGroup1D_backend
+
+This R script creates all figures for the web frontend 1D gene grouping
+
+=cut
+
+sub geneGroup1D_backend {
+ my ( $self, $c, $dataset ) = @_;
+ my $script = $self->_add_fileRead( $dataset->{'path'} . "../" );
+
+ ## load the previousely defined cut regions
+ opendir( DIR, $dataset->{'path'} );
+ $script .=
+ "cuts <- list()\n"
+ . "files <- c( '"
+ . join( "', '",
+ map { $dataset->{'subpath'} . "/$_" } grep /.cut$/,
+ readdir(DIR) )
+ . "' )\n";
+ closedir(DIR);
+ $script .=
+ "library(stringr)\n"
+ . "for ( i in 1:length(files)){\n"
+ . " cuts[[i]] <-readLines( files[i] )\n" . "}\n"
+ . "names(cuts) <- str_replace_all( files, '.cut', '' )\n"
+ . "names(cuts) <- str_replace_all( names(cuts), '$dataset->{'subpath'}/', '' )\n";
+
+ ## plot all the expression as histogram
+ $script .=
+"plot.histograms ( data.filtered, cuts, subpath='$dataset->{'subpath'}' )\n";
+
+ $script .=
+ "## export all gene names for the web frontend\n"
+ . "n <- rownames(data.filtered\@data )\n"
+ . "if ( data.filtered\@wFACS ) {\n"
+ . " n <- c( n , colnames(data.filtered\@facs) )\n}\n"
+ . "write( n, file.path( data.filtered\@outpath, '$dataset->{'subpath'}', 'Genes.txt'), ncolumns=1 ) \n";
+ return $script;
+}
+
+=head2 geneGroup1D
+
+This creates a grouping script for a 1D gene group used in the analysis section!
+
+=cut
+
+sub geneGroup1D {
+ my ( $self, $c, $dataset ) = @_;
+
+ my @values = sort { $a <=> $b } split( /\s+/, $dataset->{'cutoff'} );
+ ## store these values for later??
+ open( OUT, ">" . $dataset->{'path'} . "$dataset->{GOI}.cut" );
+ print OUT join( "\n", @values );
+ close(OUT);
+ my $script =
+ $self->_add_fileRead( $dataset->{'path'} . "../" )
+ . "data <- group_1D (data.filtered, '$dataset->{'GOI'}', c("
+ . join( ", ", @values )
+ . " ) )\n"
+ . "saveObj( data )\n";
+ return $script;
+}
+
+=head2 remove_samples
+
+This function is called from the DropGenes contoller
+
+=cut
+
+sub remove_samples {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session_path();
+ my $script = $self->_add_fileRead( $path );
+
+#Carp::confess ("These are the keys - do we have a 'Samples' one?: ". join(", ", keys %$dataset));
+ if ( defined @{ $dataset->{'Samples'} }[0] ) {
+ $script .=
+ "remS <- c ('"
+ . join( "', '", @{ $dataset->{'Samples'} } )
+ . "')\ndata.filtered = remove.samples(data.filtered, match( remS,rownames(data.filtered\@data)) )\n"
+ if ( @{ $dataset->{'Samples'} }[0] =~ m/[\w\d_]+/ );
+ }
+ if ( defined $dataset->{'RegExp'} ) {
+ $script .=
+"data.filtered = remove.samples(data.filtered, grep( \"$dataset->{'RegExp'}\" ,rownames(data.filtered\@data)) )\n"
+ if ( $dataset->{'RegExp'} =~ m/[\w\d_]+/ );
+ }
+
+ $script .=
+ "data.filtered <- sd.filter(data.filtered)\n"
+ . "data <- z.score.PCR.mad(data.filtered)\n"
+ . "save( data, file='analysis.RData' )\n";
+
+ return $script;
+}
+
+=head2 regroup
+
+Creates the script to re-order a grouping. Called by the Regroup controller.
+
+=cut
+
+sub regroup {
+ my ( $self, $c, $dataset ) = @_;
+
+ my $path = $c->session_path();
+ my $Rscript = $self->_add_fileRead($path);
+
+ my $data_table =
+ data_table->new( { 'filename' => $path . 'Sample_Colors.xls' } );
+ my ( $old_ids, $OK );
+ ## R dataset: group2sample = list ( '1' = c( 'Sample1', 'Sample2' ) )
+ $Rscript .= "userGroups <-regroup ( data.filtered, list (";
+ $OK = 0;
+ for ( my $i = 1 ; $i <= scalar( keys %$dataset ) ; $i++ )
+ { ## scale from 1 to n
+ next unless ( defined $dataset->{ 'g' . $i } );
+ $old_ids = { map { $_ => 1 } $dataset->{ 'g' . $i } =~ m/Group(\d+)/g };
+ next if ( keys %$old_ids == 0 );
+ $OK++;
+ $Rscript .= " \n\t'$i' = c('" . join(
+ "', '",
+ @{
+ $data_table->select_where(
+ 'grouping',
+ sub {
+ my $v = shift;
+ return 1 if ( $old_ids->{$v} );
+ return 0;
+ }
+ )->GetAsArray('SampleName')
+ }
+ ) . "'),";
+ }
+ if ( $OK < 2 ) {
+ $c->stash->{'ERROR'} = [
+'Sorry - you have not created enough groups! Min 2 groups are required!'
+ ];
+ }
+ chop($Rscript);
+ $Rscript .= " )\n, name='$dataset->{GroupingName}')\n"
+ . "saveObj(userGroups)\n";
+
+
+ return $Rscript;
+
+}
+
+=head2 userGroups
+
+Create a grouping based on user input pattern match. Called from the Regroups controller.
+=cut
+
+
+sub userGroups {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session_path();
+
+ unlink( $path . "Grouping_R_Error.txt" )
+ if ( -f $path . "Grouping_R_Error.txt" );
+
+ my @groupsnames = split( /\s+/, $dataset->{'Group Names'} );
+ my $data_table =
+ data_table->new( { 'filename' => $path . 'Sample_Colors.xls' } );
+
+ my $Rscript = $self->_add_fileRead($path);
+
+ $Rscript .= "data.filtered <-group_on_strings ( data.filtered, c( '"
+ . join( "', '", @groupsnames )
+ . "' ) )\n" . "saveObj( data.filtered)\n";
+ return $Rscript;
+}
+
+=head2 fixPath
+
+This short R script fixes the path in an uploaded zip file R object!
+
+=cut
+sub fixPath {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session_path();
+ my $script = $self->_add_fileRead($path);
+ $script .= "data\@outpath <- pwd()\n"
+ . "save( data, file='analysis.RData' )\n";
+ return $script;
+}
+
+=head2 remove_genes
+
+This function is called from the DropGenes contoller
+
+=cut
+
+sub remove_genes {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session_path();
+ my $script = $self->_add_fileRead($path);
+
+ if ( defined @{ $dataset->{'Genes'} }[0] ) {
+ $script .=
+ "remS <- c ('"
+ . join( "', '", @{ $dataset->{'Genes'} } ) . "')\n"
+ . "kill <- match( remS,colnames(data.filtered\@data))\n"
+ . "data.filtered = remove.genes(data.filtered, kill[which(is.na(kill) == F )] )\n"
+ . "kill <- match( remS,colnames(data.filtered\@facs))\n"
+ . "data.filtered = remove.FACS.genes(data.filtered, kill[which(is.na(kill) == F )] )\n"
+ if ( @{ $dataset->{'Genes'} }[0] =~ m/[\w\d_]+/ );
+ }
+
+ $script .=
+ "data.filtered <- sd.filter(data.filtered)\n"
+ . "data <- z.score.PCR.mad(data.filtered)\n"
+ . "save( data, file='analysis.RData' )\n";
+ return $script;
+}
+
+=head2 densityPlot
+
+This script calculates the density 3D plot for the analysis page.
+
+=cut
+
+sub densityPlot {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session_path();
+# my $script = $self->file_load($c, $dataset);
+ my $script = $self->_add_fileRead($path);
+ $script .= "library(ks)\n";
+ $script .= "plotDensity(data.filtered)\n";
+ return $script;
+}
+
+=head2 coexpression
+
+Creates the body of the coexpression script, that can be run without waiting for it.
+
+=cut
+
+sub coexpression {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session_path();
+ return
+ $self->_add_fileRead($path)
+ . "t <- coexpressGenes(data)\n"
+ . "write.table(t,'Coexpression_4_Cytoscape.txt',row.names=F, sep=' ')\n";
+}
+
+=head2 RandomForest
+
+Creates the initial RFcluster script - no bells no whistles.
+
+=cut
+
+sub RandomForest {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session_path();
+ return
+ $self->_add_fileRead($path)
+ . "data <- rfCluster(data,rep=1, SGE=F, email, k= $dataset->{'cluster_amount'},"
+ . " slice=4, subset=nrow(data\@data}-20, pics=F ,nforest=500, ntree=500, name='RFclust', recover=F)\n"
+ . "write.table(t,'Coexpression_4_Cytoscape.txt',row.names=F, sep=' ')\n"
+ ."save( data, file='analysis.RData' )\n";
+}
+
+=head2 analyze
+
+Creates the body of the analysis script.
+
+=cut
+
+sub analyze {
+ my ( $self, $c, $dataset ) = @_;
+ my $path = $c->session_path();
+ my $script =
+ $self->_add_fileRead($path);
+
+ if ( -f $path . "Gene_grouping.randomForest.txt" ) {
+ Carp::confess(
+ "RF Grouping is broken in the developmental version! FIXME!!!");
+ $script .=
+ "source ('libs/Tool_RandomForest.R')\n"
+ . "load('RandomForestdistRFobject_genes.RData')\n"
+ . "createGeneGroups_randomForest (data.filtered, $dataset->{'randomForest'})\n"
+ . "source ('Gene_grouping.randomForest.txt')\n";
+ }
+ if ( $dataset->{'UG'} eq "Group by plateID" ) {
+ $script .= "groups.n <- max( as.numeric(data.filtered\@samples[,'ArrayID']))\n"
+ . "useGrouping <- 'ArrayID'\n";
+ }
+ elsif( $dataset->{'UG'} eq "none" ) {
+ $script .= "groups.n <- $dataset->{'cluster_amount'}\n";
+ }
+ elsif ( $dataset->{'UG'} =~ m/\w/ ) { ## an expression based grouping!
+ $script .= "useGrouping <- '$dataset->{'UG'}'\n"
+ . "groups.n <- max( as.numeric(data.filtered\@samples[,useGrouping]))\n ";
+ }
+ else {
+ $script .= "groups.n <-$dataset->{'cluster_amount'}\n";
+ }
+ if ( $dataset->{'move_neg'} ) {
+ $script .= "move.neg <- TRUE\n";
+ }
+ else {
+ $script .= "move.neg <- FALSE\n";
+ }
+ if ( $dataset->{'plot_neg'} ) {
+ $script .= "plot.neg <- TRUE\n";
+ }
+ else {
+ $script .= "plot.neg <- FALSE\n";
+ }
+ if ( $dataset->{'use_beans'} ) {
+ $script .= "beanplots = TRUE\n";
+ }
+ else {
+ $script .= "beanplots = FALSE\n";
+ }
+ $script .=
+ "plotsvg = $dataset->{'plotsvg'}\n"
+ . "zscoredVioplot = $dataset->{'zscoredVioplot'}\n"
+ . "onwhat='$dataset->{'cluster_by'}'\n"
+ . "data <- analyse.data ( data.filtered, groups.n=groups.n, "
+ . "onwhat='$dataset->{'cluster_by'}', clusterby='$dataset->{'cluster_on'}', "
+ . "mds.type='$dataset->{'mds_alg'}', cmethod='$dataset->{'cluster_alg'}', LLEK='$dataset->{'K'}', "
+ . "ctype= '$dataset->{'cluster_type'}', zscoredVioplot = zscoredVioplot"
+ . ", move.neg = move.neg, plot.neg=plot.neg, beanplots=beanplots, plotsvg =plotsvg, useGrouping=useGrouping)\n"
+ . "\n"
+ . " save( data, file='analysis.RData' )\n"
+ . "write.table( cbind(data\@samples[,c(1,2)], 'grouping' = data\@usedObj[['clusters']], colors=data\@usedObj[['colors']]),
+ file='Sample_Colors.xls' , row.names=F, sep='\\t',quote=F )\n";
+
+ unlink("$path/Summary_Stat_Outfile.xls")
+ if ( -f "$path/Summary_Stat_Outfile.xls" );
+ return $script;
+}
+
+=header2
+file_load will create the script used for the file upload.
+=cut
+
+sub file_load {
+ my ( $self, $c, $dataset ) = @_;
+ my $seesion_hash = $c->session();
+ my $path = $c->session_path();
+ if ( -f $path."/analysis.RData" ){
+ mv( $path."/analysis.RData" ,$path."/analysis.old.RData" );
+ }
+ my $script = "negContrGenes <- NULL\n";
+ $script .=
+ "negContrGenes <- c ( '"
+ . join( "', '", @{ $dataset->{'negControllGenes'} } ) . "')\n"
+ if ( defined @{ $dataset->{'negControllGenes'} }[0] and ! @{ $dataset->{'negControllGenes'} }[0] eq "linux" );
+ $dataset->{'controlM'} ||=[];
+ $script .= "data.filtered <- createDataObj ( PCR= c( "
+ . join( ", ",
+ map { "'$_->{'filename'}'" } @{ $seesion_hash->{'PCRTable'} } )
+ . " ), "
+ . "FACS= c( "
+ . join( ", ",
+ map { "'$_->{'filename'}'" } @{ $seesion_hash->{'facsTable'} } )
+ . " ), "
+ . "ref.genes= c( '"
+ . join( "', '", @{ $dataset->{'controlM'} } ) . "' ),"
+ . " use_pass_fail = '$dataset->{'use_pass_fail'}', "
+ . "max.value=40, max.ct= $dataset->{'maxCT'} , max.control=$dataset->{'maxGenes'}, "
+ . "norm.function='$dataset->{'normalize2'}', negContrGenes=negContrGenes )\n"
+ . "save( data.filtered, file=file.path(data.filtered\@outpath,'norm_data.RData') )\n";
+ $script =~ s/c\( '.?.?\/?' \)/NULL/g;
+ return $script;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
diff --git a/SCExV/lib/HTpcrA/Model/java_splicer.pm b/SCExV/lib/HTpcrA/Model/java_splicer.pm
index 6be1369..9867702 100644
--- a/SCExV/lib/HTpcrA/Model/java_splicer.pm
+++ b/SCExV/lib/HTpcrA/Model/java_splicer.pm
@@ -68,6 +68,30 @@ sub java_splice_old {
return { functions => \@functions, md5sums=> \@md5sums, rest =>join("\n",@$all) } ; ## the last entry is the plot script
}
+sub classSplitter {
+ my ( $self, $str ) = @_;
+ my (@return, $use, $position);
+ $position = -1;
+ if ( -f $str ) {
+ open ( IN, "<$str" ) or die $!;
+ $str = join("\n",