[Bioperl-guts-l] [14789] bioperl-live/trunk/Bio: phyloxml: new module for clade_relation seq_relation
miraceti at dev.open-bio.org
miraceti at dev.open-bio.org
Wed Aug 6 11:56:26 EDT 2008
Revision: 14789
Author: miraceti
Date: 2008-08-06 11:56:25 -0400 (Wed, 06 Aug 2008)
Log Message:
-----------
phyloxml: new module for clade_relation seq_relation
Modified Paths:
--------------
bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
Added Paths:
-----------
bioperl-live/trunk/Bio/Annotation/Relation.pm
Added: bioperl-live/trunk/Bio/Annotation/Relation.pm
===================================================================
--- bioperl-live/trunk/Bio/Annotation/Relation.pm (rev 0)
+++ bioperl-live/trunk/Bio/Annotation/Relation.pm 2008-08-06 15:56:25 UTC (rev 14789)
@@ -0,0 +1,284 @@
+# $Id: Relation.pm 14708 2008-06-10 00:08:17Z heikki $
+#
+# BioPerl module for Bio::Annotation::Relation
+#
+# Cared for by bioperl <bioperl-l at bioperl.org>
+#
+# Copyright bioperl
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Annotation::Relation - Relationship (pairwise) with other objects SeqI and NodeI;
+
+=head1 SYNOPSIS
+
+ use Bio::Annotation::Relation;
+ use Bio::Annotation::Collection;
+
+ my $col = Bio::Annotation::Collection->new();
+ my $sv = Bio::Annotation::Relation->new(-type => "paralogy" -to => "someSeqI");
+ $col->add_Annotation('tagname', $sv);
+
+=head1 DESCRIPTION
+
+Scalar value annotation object
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to one
+of the Bioperl mailing lists. Your participation is much appreciated.
+
+ bioperl-l at bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+the bugs and their resolution. Bug reports can be submitted via
+the web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR - Ewan Birney
+
+Email birney at ebi.ac.uk
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
+
+=cut
+
+
+# Let the code begin...
+
+
+package Bio::Annotation::Relation;
+use strict;
+
+# Object preamble - inherits from Bio::Root::Root
+
+#use Bio::Ontology::TermI;
+
+use base qw(Bio::Root::Root Bio::AnnotationI);
+
+=head2 new
+
+ Title : new
+ Usage : my $sv = Bio::Annotation::Relation->new();
+ Function: Instantiate a new Relation object
+ Returns : Bio::Annotation::Relation object
+ Args : -type => $type of relation [optional]
+ -to => $obj which $self is in relation to [optional]
+ -tagname => $tag to initialize the tagname [optional]
+ -tag_term => ontology term representation of the tag [optional]
+
+=cut
+
+sub new{
+ my ($class, at args) = @_;
+
+ my $self = $class->SUPER::new(@args);
+
+ my ($type, $to, $tag, $term) =
+ $self->_rearrange([qw(TYPE TO TAGNAME TAG_TERM)], @args);
+
+ # set the term first
+ defined $term && $self->tag_term($term);
+ defined $type && $self->type($type);
+ defined $to && $self->to($to);
+ defined $tag && $self->tagname($tag);
+
+ return $self;
+}
+
+
+=head1 AnnotationI implementing functions
+
+=cut
+
+=head2 as_text
+
+ Title : as_text
+ Usage : my $text = $obj->as_text
+ Function: return the string "Value: $v" where $v is the value
+ Returns : string
+ Args : none
+
+
+=cut
+
+sub as_text{
+ my ($self) = @_;
+
+ return $self->type." to ".$self->to->id;
+}
+
+=head2 display_text
+
+ Title : display_text
+ Usage : my $str = $ann->display_text();
+ Function: returns a string. Unlike as_text(), this method returns a string
+ formatted as would be expected for te specific implementation.
+
+ One can pass a callback as an argument which allows custom text
+ generation; the callback is passed the current instance and any text
+ returned
+ Example :
+ Returns : a string
+ Args : [optional] callback
+
+=cut
+
+{
+ my $DEFAULT_CB = sub { return $_[0]->type." to ".$_[0]->to->id };
+ #my $DEFAULT_CB = sub { $_[0]->value};
+
+ sub display_text {
+ my ($self, $cb) = @_;
+ $cb ||= $DEFAULT_CB;
+ $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
+ return $cb->($self);
+ }
+
+}
+
+=head2 hash_tree
+
+ Title : hash_tree
+ Usage : my $hashtree = $value->hash_tree
+ Function: For supporting the AnnotationI interface just returns the value
+ as a hashref with the key 'value' pointing to the value
+ Returns : hashrf
+ Args : none
+
+
+=cut
+
+sub hash_tree{
+ my $self = shift;
+
+ my $h = {};
+ $h->{'type'} = $self->type;
+ $h->{'to'} = $self->to;
+ return $h;
+}
+
+=head2 tagname
+
+ Title : tagname
+ Usage : $obj->tagname($newval)
+ Function: Get/set the tagname for this annotation value.
+
+ Setting this is optional. If set, it obviates the need to
+ provide a tag to AnnotationCollection when adding this
+ object.
+
+ Example :
+ Returns : value of tagname (a scalar)
+ Args : new value (a scalar, optional)
+
+
+=cut
+
+sub tagname{
+ my $self = shift;
+
+ # check for presence of an ontology term
+ if($self->{'_tag_term'}) {
+ # keep a copy in case the term is removed later
+ $self->{'tagname'} = $_[0] if @_;
+ # delegate to the ontology term object
+ return $self->tag_term->name(@_);
+ }
+ return $self->{'tagname'} = shift if @_;
+ return $self->{'tagname'};
+}
+
+
+=head1 Specific accessors for Relation
+
+=cut
+
+=head2 type
+
+ Title : type
+ Usage : $obj->type($newval)
+ Function: Get/Set the type
+ Returns : type of relation
+ Args : newtype (optional)
+
+
+=cut
+
+sub type{
+ my ($self,$type) = @_;
+
+ if( defined $type) {
+ $self->{'type'} = $type;
+ }
+ return $self->{'type'};
+}
+
+=head2 to
+
+ Title : to
+ Usage : $obj->to($newval)
+ Function: Get/Set the object which $self is in relation to
+ Returns : the object which the relation applies to
+ Args : new target object (optional)
+
+
+=cut
+
+sub to{
+ my ($self,$to) = @_;
+
+ if( defined $to) {
+ $self->{'to'} = $to;
+ }
+ return $self->{'to'};
+}
+
+=head2 tag_term
+
+ Title : tag_term
+ Usage : $obj->tag_term($newval)
+ Function: Get/set the L<Bio::Ontology::TermI> object representing
+ the tag name.
+
+ This is so you can specifically relate the tag of this
+ annotation to an entry in an ontology. You may want to do
+ this to associate an identifier with the tag, or a
+ particular category, such that you can better match the tag
+ against a controlled vocabulary.
+
+ This accessor will return undef if it has never been set
+ before in order to allow this annotation to stay
+ light-weight if an ontology term representation of the tag
+ is not needed. Once it is set to a valid value, tagname()
+ will actually delegate to the name() of this term.
+
+ Example :
+ Returns : a L<Bio::Ontology::TermI> compliant object, or undef
+ Args : on set, new value (a L<Bio::Ontology::TermI> compliant
+ object or undef, optional)
+
+
+=cut
+
+sub tag_term{
+ my $self = shift;
+
+ return $self->{'_tag_term'} = shift if @_;
+ return $self->{'_tag_term'};
+}
+
+1;
Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
===================================================================
--- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-08-05 22:48:06 UTC (rev 14788)
+++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-08-06 15:56:25 UTC (rev 14789)
@@ -68,6 +68,7 @@
use Bio::Tree::Tree;
use Bio::Tree::AnnotatableNode;
use Bio::Annotation::SimpleValue;
+use Bio::Annotation::Relation;
use XML::LibXML;
use XML::LibXML::Reader;
use base qw(Bio::TreeIO);
@@ -504,10 +505,36 @@
{
my ($self) = @_;
my $valuestr = '';
- foreach (keys %{$self->current_attr}) {
- $valuestr .= $_."=".$self->current_attr->{$_}." ";
+ my $id_ref_0 = $self->current_attr->{'id_ref_0'};
+ my $id_ref_1 = $self->current_attr->{'id_ref_1'};
+
+ my @srcbyidref = ();
+ $srcbyidref[0] = $self->{'_id_link'}->{$id_ref_0};
+ $srcbyidref[1] = $self->{'_id_link'}->{$id_ref_1};
+
+ # exception when id_ref is defined but id_src is not, or vice versa.
+ if ( ($id_ref_0 xor $srcbyidref[0])||($id_ref_1 xor $srcbyidref[1]) ) {
+ $self->throw("id_ref and id_src incompatible: $id_ref_0, $id_ref_1, ", $srcbyidref[0], $srcbyidref[1]);
}
- $self->prev_attr->{$self->current_element} = $valuestr;
+ my $relationtype = $self->current_attr->{'type'};
+
+ # set id_ref_0
+ my $ac0 = $srcbyidref[0]->annotation;
+ my $newann = new Bio::Annotation::Relation(
+ '-type' => $relationtype,
+ '-to' => $srcbyidref[1],
+ '-tagname' => $self->current_element
+ );
+ $ac0->add_Annotation($self->current_element, $newann);
+ # set id_ref_1
+ my $ac1 = $srcbyidref[1]->annotation;
+ $newann = new Bio::Annotation::Relation(
+ '-type' => $relationtype,
+ '-to' => $srcbyidref[0],
+ '-tagname' => $self->current_element
+ );
+ $ac1->add_Annotation($self->current_element, $newann);
+
}
More information about the Bioperl-guts-l
mailing list