[Bioperl-guts-l] bioperl-live/Bio SimpleAlign.pm,1.125,1.126
Christopher John Fields
cjfields at dev.open-bio.org
Mon Jan 29 18:30:16 EST 2007
Update of /home/repository/bioperl/bioperl-live/Bio
In directory dev.open-bio.org:/tmp/cvs-serv32384
Modified Files:
SimpleAlign.pm
Log Message:
Bug 2198
Index: SimpleAlign.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/SimpleAlign.pm,v
retrieving revision 1.125
retrieving revision 1.126
diff -C2 -d -r1.125 -r1.126
*** SimpleAlign.pm 8 Jan 2007 22:14:45 -0000 1.125
--- SimpleAlign.pm 29 Jan 2007 23:30:14 -0000 1.126
***************
*** 2554,2585 ****
}
-
- =head2 annotation
-
- Title : annotation
- Usage : $ann = $aln->annotation or
- $aln->annotation($ann)
- Function: Gets or sets the annotation
- Returns : Bio::AnnotationCollectionI object
- Args : None or Bio::AnnotationCollectionI object
-
- See L<Bio::AnnotationCollectionI> and L<Bio::Annotation::Collection>
- for more information
-
- =cut
-
- sub annotation {
- my ($obj,$value) = @_;
- if( defined $value ) {
- $obj->throw("object of class ".ref($value)." does not implement ".
- "Bio::AnnotationCollectionI. Too bad.")
- unless $value->isa("Bio::AnnotationCollectionI");
- $obj->{'_annotation'} = $value;
- } elsif( ! defined $obj->{'_annotation'}) {
- $obj->{'_annotation'} = Bio::Annotation::Collection->new();
- }
- return $obj->{'_annotation'};
- }
-
=head2 set_displayname_safe
--- 2554,2557 ----
***************
*** 2646,2649 ****
--- 2618,2655 ----
}
+ =head2 sort_by_start
+ Title : sort_by_start
+ Usage : $ali->sort_by_start
+ Function : Changes the order of the alignemnt to the start position of each
+ subalignment
+ Returns :
+ Argument :
+
+ =cut
+
+ sub sort_by_start {
+ my $self = shift;
+ my ($seq,$nse, at arr,%hash,$count);
+ foreach $seq ( $self->each_seq() ) {
+ $nse = $seq->get_nse;
+ $hash{$nse} = $seq;
+ }
+ $count = 0;
+ %{$self->{'_order'}} = (); # reset the hash;
+ foreach $nse ( sort _startend keys %hash) {
+ $self->{'_order'}->{$count} = $nse;
+ $count++;
+ }
+ 1;
+ }
+
+ sub _startend
+ {
+ my ($aname,$astart,$bname,$bstart);
+ ($aname,$astart) = split (/[\/]/,$a);
+ ($bname,$bstart) = split (/[\/]/,$b);
+ return $astart <=> $bstart;
+ }
+
=head2 methods for Bio::FeatureHolder
***************
*** 2786,2789 ****
--- 2792,2827 ----
=cut
+ =head2 methods for Bio::AnnotatableI
+
+ AnnotatableI implementation to support sequence alignments which
+ contain annotation (NEXUS, Stockholm).
+
+ =head2 annotation
+
+ Title : annotation
+ Usage : $ann = $aln->annotation or
+ $aln->annotation($ann)
+ Function: Gets or sets the annotation
+ Returns : Bio::AnnotationCollectionI object
+ Args : None or Bio::AnnotationCollectionI object
+
+ See L<Bio::AnnotationCollectionI> and L<Bio::Annotation::Collection>
+ for more information
+
+ =cut
+
+ sub annotation {
+ my ($obj,$value) = @_;
+ if( defined $value ) {
+ $obj->throw("object of class ".ref($value)." does not implement ".
+ "Bio::AnnotationCollectionI. Too bad.")
+ unless $value->isa("Bio::AnnotationCollectionI");
+ $obj->{'_annotation'} = $value;
+ } elsif( ! defined $obj->{'_annotation'}) {
+ $obj->{'_annotation'} = Bio::Annotation::Collection->new();
+ }
+ return $obj->{'_annotation'};
+ }
+
1;
More information about the Bioperl-guts-l
mailing list