[Bioperl-guts-l] [15631] bioperl-live/trunk/Bio/SimpleAlign.pm: per Tristan' s patch Bug #2805: in array context,

[Mark Allen Jensen]

Revision: 15631
Author:   maj
Date:     2009-04-09 00:45:21 -0400 (Thu, 09 Apr 2009)

Log Message:
-----------
per Tristan's patch Bug #2805: in array context, 
uniq_seq() now returns a sequence type hashref 
along with the new aln object

Modified Paths:
--------------
    bioperl-live/trunk/Bio/SimpleAlign.pm

Modified: bioperl-live/trunk/Bio/SimpleAlign.pm
===================================================================
--- bioperl-live/trunk/Bio/SimpleAlign.pm	2009-04-08 17:37:44 UTC (rev 15630)
+++ bioperl-live/trunk/Bio/SimpleAlign.pm	2009-04-09 04:45:21 UTC (rev 15631)
@@ -619,9 +619,14 @@
              leading and ending gaps ("-") are NOT counted as
              differences.
  Function  : Make a new alignment of unique sequence types (STs)
- Returns   : 1. a new Bio::SimpleAlign object (all sequences renamed as "ST")
+ Returns   : 1a. if called in a scalar context, 
+                a new Bio::SimpleAlign object (all sequences renamed as "ST")
+             1b. if called in an array context, 
+                a new Bio::SimpleAlign object, and a hashref whose keys
+                are sequence types, and whose values are arrayrefs to 
+                lists of sequence ids within the corresponding sequence type
              2. if $aln->verbose > 0, ST of each sequence is sent to 
-                STDERR
+                STDERR (in a tabular format)
  Argument  : None
 
 =cut
@@ -629,9 +634,10 @@
 sub uniq_seq {
     my ($self, $seqid) = @_;
     my $aln = $self->new;
-    my (%member, %order, @seq, @uniq_str);
+    my (%member, %order, @seq, @uniq_str, $st);
     my $order=0;
     my $len = $self->length();
+    $st = {};
     foreach my $seq ( $self->each_seq() ) {
 	my $str = $seq->seq();
 
@@ -686,10 +692,11 @@
 					 );
 	$aln->add_seq($new);
 	foreach (@{$member{$str}}) {
+	    push @{$$st{$order{$str}}}, $_->id(); # per Tristan's patch/Bug #2805
         $self->debug($_->id(), "\t", "ST", $order{$str}, "\n");
         }
     }
-    return $aln;
+    return wantarray ? ($aln, $st) : $aln;
 }
 
 sub _check_uniq {  # check if same seq exists in the alignment