Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Initial implementation of Annotation::SimpleValue.pm with correspondi…

…ng test file.
  • Loading branch information...
commit 05041b1c75f216c30f38501df70dfe63ea88ef0c 1 parent 9ffac69
@Takadonet Takadonet authored
Showing with 641 additions and 0 deletions.
  1. +249 −0 lib/Bio/Annotation/SimpleValue.pm
  2. +392 −0 t/Annotation/Annotation.t
View
249 lib/Bio/Annotation/SimpleValue.pm
@@ -0,0 +1,249 @@
+class Bio::Annotation::SimpleValue {
+# 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::SimpleValue->new();
+# Function: Instantiate a new SimpleValue object
+# Returns : Bio::Annotation::SimpleValue object
+# Args : -value => $value to initialize the object data field [optional]
+# -tagname => $tag to initialize the tagname [optional]
+# -tag_term => ontology term representation of the tag [optional]
+
+# =cut
+
+
+# =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
+
+method as_text() {
+ return "Value: " ~ self.value;
+}
+
+# =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 ($self) { $self.value() };
+
+method display_text($cb? is copy) {
+ $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
+
+# method hash_tree{
+# my $self = shift;
+
+# my $h = {};
+# $h->{'value'} = $self->value;
+# 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
+
+has $!tagname is rw;
+method tagname($value?){
+ # check for presence of an ontology term
+ if ($!tag_term) {
+ # keep a copy in case the term is removed later
+ $!tagname = $value if $value;
+ # delegate to the ontology term object
+ return self.tag_term.name($value);
+ }
+ $!tagname = $value if $value;
+ return $!tagname;
+}
+
+
+# =head1 Specific accessors for SimpleValue
+
+# =cut
+
+# =head2 value
+
+# Title : value
+# Usage : $obj->value($newval)
+# Function: Get/Set the value for simplevalue
+# Returns : value of value
+# Args : newvalue (optional)
+
+
+# =cut
+
+has $!value is rw;
+
+method value($value?){
+ if ( defined $value) {
+ $!value = $value;
+ }
+ return $!value;
+}
+
+# =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
+
+has $!tag_term is rw;
+method tag_term($value?){
+ if ( defined $value) {
+ $!tag_term = $value;
+ }
+ return $!tag_term;
+}
+
+}
+
+
+# $Id: SimpleValue.pm 16123 2009-09-17 12:57:27Z cjfields $
+#
+# BioPerl module for Bio::Annotation::SimpleValue
+#
+# Please direct questions and support issues to <bioperl-l@bioperl.org>
+#
+# Cared for by bioperl <bioperl-l@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::SimpleValue - A simple scalar
+
+# =head1 SYNOPSIS
+
+# use Bio::Annotation::SimpleValue;
+# use Bio::Annotation::Collection;
+
+# my $col = Bio::Annotation::Collection->new();
+# my $sv = Bio::Annotation::SimpleValue->new(-value => 'someval');
+# $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@bioperl.org - General discussion
+# http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+# =head2 Support
+
+# Please direct usage questions or support issues to the mailing list:
+
+# I<bioperl-l@bioperl.org>
+
+# rather than to the module maintainer directly. Many experienced and
+# reponsive experts will be able look at the problem and quickly
+# address it. Please include a thorough description of the problem
+# with code and data examples if at all possible.
+
+# =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@ebi.ac.uk
+
+# =head1 APPENDIX
+
+# The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
+
+# =cut
+
+
+
View
392 t/Annotation/Annotation.t
@@ -0,0 +1,392 @@
+use v6;
+
+BEGIN {
+ @*INC.push('./lib');
+}
+
+use Test;
+plan 158;
+eval_lives_ok('Bio::Annotation::Collection');
+eval_lives_ok('Bio::Annotation::DBLink');
+eval_lives_ok('Bio::Annotation::Comment');
+eval_lives_ok('Bio::Annotation::Reference');
+eval_lives_ok('Bio::Annotation::Target');
+eval_lives_ok('Bio::Annotation::AnnotationFactory');
+eval_lives_ok('Bio::Annotation::StructuredValue');
+eval_lives_ok('Bio::Annotation::TagTree');
+eval_lives_ok('Bio::Annotation::Tree');
+eval_lives_ok('Bio::Seq');
+eval_lives_ok('Bio::SimpleAlign');
+eval_lives_ok('Bio::Cluster::UniGene');
+eval_lives_ok('Bio::Annotation::SimpleValue','Can load Bio::Annotation::SimpleValue');
+
+use Bio::Annotation::SimpleValue;
+
+#simple value
+my $simple = Bio::Annotation::SimpleValue.new(tagname => 'colour',
+ value => '1',
+ );
+
+# isa_ok($simple, 'Bio::AnnotationI');
+is $simple.display_text, 1;
+is $simple.as_text, 'Value: 1';
+is $simple.value, 1;
+is $simple.tagname, 'colour';
+is $simple.tag_term, Any;
+
+is $simple.value(0), 0;
+is $simple.value, 0;
+is $simple.display_text, 0;
+
+# link
+
+#my $link1 = Bio::Annotation::DBLink.new(database => 'TSC',
+# primary_id => 'TSC0000030',
+# );
+# isa_ok($link1,'Bio::AnnotationI');
+# is $link1.database(), 'TSC';
+# is $link1.primary_id(), 'TSC0000030';
+# is $link1.as_text, 'Direct database link to TSC0000030 in database TSC';
+# my $ac = Bio::Annotation::Collection.new();
+# isa_ok($ac,'Bio::AnnotationCollectionI');
+
+# $ac.add_Annotation('dblink',$link1);
+# $ac.add_Annotation('dblink',
+# Bio::Annotation::DBLink.new(database => 'TSC',
+# primary_id => 'HUM_FABV'));
+
+# my $comment = Bio::Annotation::Comment.new( text => 'sometext');
+# is $comment.text, 'sometext';
+# is $comment.as_text, 'Comment: sometext';
+# $ac.add_Annotation('comment', $comment);
+
+
+
+# my $target = Bio::Annotation::Target.new(target_id => 'F321966.1',
+# start => 1,
+# end => 200,
+# strand => 1,
+# );
+# isa_ok($target,'Bio::AnnotationI');
+# ok $ac.add_Annotation('target', $target);
+
+
+# my $ref = Bio::Annotation::Reference.new( authors => 'author line',
+# title => 'title line',
+# location => 'location line',
+# start => 12);
+# isa_ok($ref,'Bio::AnnotationI');
+# is $ref.authors, 'author line';
+# is $ref.title, 'title line';
+# is $ref.location, 'location line';
+# is $ref.start, 12;
+# is $ref.database, 'MEDLINE';
+# is $ref.as_text, 'Reference: title line';
+# $ac.add_Annotation('reference', $ref);
+
+
+# my $n = 0;
+# foreach my $link ( $ac.get_Annotations('dblink') ) {
+# is $link.database, 'TSC';
+# is $link.tagname(), 'dblink';
+# $n++;
+# }
+# is ($n, 2);
+
+# $n = 0;
+# my @keys = $ac.get_all_annotation_keys();
+# is (scalar(@keys), 4);
+# foreach my $ann ( $ac.get_Annotations() ) {
+# shift(@keys) if ($n > 0) && ($ann.tagname ne $keys[0]);
+# is $ann.tagname(), $keys[0];
+# $n++;
+# }
+# is ($n, 5);
+
+# $ac.add_Annotation($link1);
+
+# $n = 0;
+# foreach my $link ( $ac.get_Annotations('dblink') ) {
+# is $link.tagname(), 'dblink';
+# $n++;
+# }
+# is ($n, 3);
+
+# # annotation of structured simple values (like swissprot''is GN line)
+# my $ann = Bio::Annotation::StructuredValue.new();
+# isa_ok($ann, "Bio::AnnotationI");
+
+# $ann.add_value([-1], "val1");
+# is ($ann.value(), "val1");
+# $ann.value("compat test");
+# is ($ann.value(), "compat test");
+# $ann.add_value([-1], "val2");
+# is ($ann.value(joins => [" AND "]), "compat test AND val2");
+# $ann.add_value([0], "val1");
+# is ($ann.value(joins => [" AND "]), "val1 AND val2");
+# $ann.add_value([-1,-1], "val3", "val4");
+# $ann.add_value([-1,-1], "val5", "val6");
+# $ann.add_value([-1,-1], "val7");
+# is ($ann.value(joins => [" AND "]), "val1 AND val2 AND (val3 AND val4) AND (val5 AND val6) AND val7");
+# is ($ann.value(joins => [" AND ", " OR "]), "val1 AND val2 AND (val3 OR val4) AND (val5 OR val6) AND val7");
+
+# $n = 1;
+# foreach ($ann.get_all_values()) {
+# is ($_, "val".$n++);
+# }
+
+# # nested collections
+# my $nested_ac = Bio::Annotation::Collection.new();
+# $nested_ac.add_Annotation('nested', $ac);
+
+# is (scalar($nested_ac.get_Annotations()), 1);
+# ($ac) = $nested_ac.get_Annotations();
+# isa_ok($ac, "Bio::AnnotationCollectionI");
+# is (scalar($nested_ac.get_all_Annotations()), 6);
+# $nested_ac.add_Annotation('gene names', $ann);
+# is (scalar($nested_ac.get_Annotations()), 2);
+# is (scalar($nested_ac.get_all_Annotations()), 7);
+# is (scalar($nested_ac.get_Annotations('dblink')), 0);
+# my @anns = $nested_ac.get_Annotations('gene names');
+# isa_ok($anns[0], "Bio::Annotation::StructuredValue");
+# @anns = map { $_.get_Annotations('dblink');
+# } $nested_ac.get_Annotations('nested');
+# is (scalar(@anns), 3);
+# is (scalar($nested_ac.flatten_Annotations()), 2);
+# is (scalar($nested_ac.get_Annotations()), 7);
+# is (scalar($nested_ac.get_all_Annotations()), 7);
+
+# SKIP: {
+# test_skip(-tests => 7, -requires_modules => [qw(Graph::Directed Bio::Annotation::OntologyTerm)]);
+# use_ok('Bio::Annotation::OntologyTerm');
+# # OntologyTerm annotation
+# my $termann = Bio::Annotation::OntologyTerm.new(label => 'test case',
+# identifier => 'Ann:00001',
+# ontology => 'dumpster');
+# isa_ok($termann.term,'Bio::Ontology::Term');
+# is ($termann.term.name, 'test case');
+# is ($termann.term.identifier, 'Ann:00001');
+# is ($termann.tagname, 'dumpster');
+# is ($termann.ontology.name, 'dumpster');
+# is ($termann.as_text, "dumpster|test case|");
+# }
+
+# # AnnotatableI
+# my $seq = Bio::Seq.new();
+# isa_ok($seq,"Bio::AnnotatableI");
+# SKIP: {
+# test_skip(-requires_modules => [qw(Bio::SeqFeature::Annotated URI::Escape)],
+# -tests => 4);
+# my $fea = Bio::SeqFeature::Annotated.new();
+# isa_ok($fea, "Bio::SeqFeatureI",'isa SeqFeatureI');
+# isa_ok($fea, "Bio::AnnotatableI",'isa AnnotatableI');
+# $fea = Bio::SeqFeature::Generic.new();
+# isa_ok($fea, "Bio::SeqFeatureI",'isa SeqFeatureI');
+# isa_ok($fea, "Bio::AnnotatableI",'isa AnnotatableI');
+# }
+# my $clu = Bio::Cluster::UniGene.new();
+# isa_ok($clu, "Bio::AnnotatableI");
+# my $aln = Bio::SimpleAlign.new();
+# isa_ok($clu,"Bio::AnnotatableI");
+
+# # tests for Bio::Annotation::AnnotationFactory
+
+# my $factory = Bio::Annotation::AnnotationFactory.new;
+# isa_ok($factory, 'Bio::Factory::ObjectFactoryI');
+
+# # defaults to SimpleValue
+# $ann = $factory.create_object(value => 'peroxisome',
+# tagname => 'cellular component');
+# isa_ok($ann, 'Bio::Annotation::SimpleValue');
+
+# $factory.type('Bio::Annotation::OntologyTerm');
+
+# $ann = $factory.create_object(name => 'peroxisome',
+# tagname => 'cellular component');
+# ok(defined $ann);
+# isa_ok($ann, 'Bio::Annotation::OntologyTerm');
+
+# # unset type()
+# $factory.type(undef);
+# $ann = $factory.create_object(text => 'this is a comment');
+# ok(defined $ann,'Bio::Annotation::Comment');
+
+# isa_ok($ann,'Bio::Annotation::Comment');
+
+# ok $factory.type('Bio::Annotation::Comment');
+# $ann = $factory.create_object(text => 'this is a comment');
+# ok(defined $ann,'Bio::Annotation::Comment');
+# isa_ok($ann,'Bio::Annotation::Comment');
+
+# # factory guessing the type: Comment
+# $factory = Bio::Annotation::AnnotationFactory.new();
+# $ann = $factory.create_object(text => 'this is a comment');
+# ok(defined $ann,'Bio::Annotation::Comment');
+# isa_ok($ann,'Bio::Annotation::Comment');
+
+# # factory guessing the type: Target
+# $factory = Bio::Annotation::AnnotationFactory.new();
+# $ann = $factory.create_object(target_id => 'F1234',
+# start => 1,
+# end => 10 );
+# ok defined $ann;
+# isa_ok($ann,'Bio::Annotation::Target');
+
+# # factory guessing the type: OntologyTerm
+# $factory = Bio::Annotation::AnnotationFactory.new();
+# ok(defined ($ann = $factory.create_object(name => 'peroxisome',
+# tagname => 'cellular component')));
+# like(ref $ann, qr(Bio::Annotation::OntologyTerm));
+
+# # tree
+# my $tree_filename = test_input_file('longnames.dnd');
+# my $tree = Bio::TreeIO.new(file=>$tree_filename).next_tree();
+# my $ann_tree = Bio::Annotation::Tree.new(
+# tagname => 'tree',
+# tree_obj => $tree,
+# );
+
+# isa_ok($ann_tree, 'Bio::AnnotationI');
+# $ann_tree.tree_id('test');
+# is $ann_tree.tree_id(), 'test', "tree_id()";
+# $ann_tree.tagname('tree');
+# is $ann_tree.tagname(), 'tree', "tagname()";
+# my $aln_filename = test_input_file('longnames.aln');
+# use Bio::AlignIO;
+# $aln = Bio::AlignIO.new(file => $aln_filename,
+# format=>'clustalw').next_aln();
+# isa_ok($aln, 'Bio::AnnotatableI');
+# $ac = Bio::Annotation::Collection.new();
+# $ac.add_Annotation('tree',$ann_tree);
+# $aln.annotation($ac);
+# for my $treeblock ( $aln.annotation.get_Annotations('tree') ) {
+# my $treeref = $treeblock.tree();
+# my @nodes = sort { defined $a.id &&
+# defined $b.id &&
+# $a.id cmp $b.id } $treeref.get_nodes();
+# is $nodes[12].id, '183.m01790', "add tree to AlignI";
+# my $str;
+# for my $seq ($aln.each_seq_with_id($nodes[12].id)) {
+# $str = $seq.subseq(1,20);
+# }
+# is( $str, "MDDKELEIPVEHSTAFGQLV", "get seq from node id");
+# }
+
+# # factory guessing the type: Tree
+# $factory = Bio::Annotation::AnnotationFactory.new();
+# $ann = $factory.create_object(tree_obj => $tree);
+# ok defined $ann;
+# isa_ok($ann,'Bio::Annotation::Tree');
+
+# #tagtree
+# my $struct = [ 'genenames' => [
+# ['genename' => [
+# [ 'Name' => 'CALM1' ],
+# ['Synonyms'=> 'CAM1'],
+# ['Synonyms'=> 'CALM'],
+# ['Synonyms'=> 'CAM' ] ] ],
+# ['genename'=> [
+# [ 'Name'=> 'CALM2' ],
+# [ 'Synonyms'=> 'CAM2'],
+# [ 'Synonyms'=> 'CAMB'] ] ],
+# [ 'genename'=> [
+# [ 'Name'=> 'CALM3' ],
+# [ 'Synonyms'=> 'CAM3' ],
+# [ 'Synonyms'=> 'CAMC' ] ] ]
+# ] ];
+
+# my $ann_struct = Bio::Annotation::TagTree.new(tagname => 'gn',
+# value => $struct);
+
+# isa_ok($ann_struct, 'Bio::AnnotationI');
+# my $val = $ann_struct.value;
+# like($val, qr/Name: CALM1/,'default itext');
+
+# # roundtrip
+# my $ann_struct2 = Bio::Annotation::TagTree.new(tagname => 'gn',
+# value => $val);
+# is($ann_struct2.value, $val,'roundtrip');
+
+# # formats
+# like($ann_struct2.value, qr/Name: CALM1/,'itext');
+# $ann_struct2.tagformat('sxpr');
+# like($ann_struct2.value, qr/\(Name "CALM1"\)/,'spxr');
+# $ann_struct2.tagformat('indent');
+# like($ann_struct2.value, qr/Name "CALM1"/,'indent');
+
+# SKIP: {
+# eval {require XML::Parser::PerlSAX};
+# skip ("XML::Parser::PerlSAX rquired for XML",1) if $@;
+# $ann_struct2.tagformat('xml');
+# like($ann_struct2.value, qr/<Name>CALM1<\/Name>/,'xml');
+# }
+
+# # grab Data::Stag nodes, use Data::Stag methods
+# my @nodes = $ann_struct2.children;
+# for my $node (@nodes) {
+# isa_ok($node, 'Data::Stag::StagI');
+# is($node.element, 'genename');
+# # add tag-value data to node
+# $node.set('foo', 'bar');
+# # check output
+# like($node.itext, qr/foo:\s+bar/,'child changes');
+# }
+
+# $ann_struct2.tagformat('itext');
+# like($ann_struct2.value, qr/foo:\s+bar/,'child changes in parent node');
+
+# # pass in a Data::Stag node to value()
+# $ann_struct = Bio::Annotation::TagTree.new(tagname => 'mytags');
+# like($ann_struct.value, qr/^\s+:\s+$/xms, 'no tags');
+# like($ann_struct.value, qr/^\s+:\s+$/xms,'before Stag node');
+# $ann_struct.value($nodes[0]);
+# like($ann_struct.value, qr/Name: CALM1/,'after Stag node');
+# is(ref $ann_struct.node, ref $nodes[0], 'both stag nodes');
+# isnt($ann_struct.node, $nodes[0], 'different instances');
+
+# # pass in another TagTree to value()
+# $ann_struct = Bio::Annotation::TagTree.new(tagname => 'mytags');
+# like($ann_struct.value, qr/^\s+:\s+$/xms,'before TagTree');
+# $ann_struct.value($ann_struct2);
+# like($ann_struct.value, qr/Name: CALM2/,'after TagTree');
+# is(ref $ann_struct.node, ref $ann_struct2.node, 'both stag nodes');
+# isnt($ann_struct.node, $ann_struct2.node, 'different instances');
+
+# # replace the Data::Stag node in the annotation (no copy)
+# $ann_struct = Bio::Annotation::TagTree.new(tagname => 'mytags');
+# like($ann_struct.value, qr/^\s+:\s+$/xms,'before TagTree');
+# $ann_struct.node($nodes[1]);
+# like($ann_struct.value, qr/Name: CALM2/,'after TagTree');
+# is(ref $ann_struct.node, ref $ann_struct2.node, 'stag nodes');
+# is($ann_struct.node, $nodes[1], 'same instance');
+# # replace the Data::Stag node in the annotation (use duplicate)
+# $ann_struct = Bio::Annotation::TagTree.new(tagname => 'mytags');
+# like($ann_struct.value, qr/^\s+:\s+$/xms,'before TagTree');
+# $ann_struct.node($nodes[1],'copy');
+# like($ann_struct.value, qr/Name: CALM2/,'after TagTree');
+# is(ref $ann_struct.node, ref $ann_struct2.node, 'stag nodes');
+# isnt($ann_struct.node, $nodes[1], 'different instance');
+
+# #check insertion in to collection
+# $ann_struct = Bio::Annotation::TagTree.new(value => $struct);
+# $ac = Bio::Annotation::Collection.new();
+
+# $ac.add_Annotation('genenames',$ann_struct);
+# my $ct = 0;
+# for my $tagtree ( $ac.get_Annotations('genenames') ) {
+# isa_ok($tagtree, 'Bio::AnnotationI');
+# for my $node ($tagtree.children) {
+# isa_ok($node, 'Data::Stag::StagI');
+# like($node.itext, qr/Name:\s+CALM/,'child changes');
+# $ct++;
+# }
+# }
+# is($ct,3);
+
+# # factory guessing the type: TagTree
+# $factory = Bio::Annotation::AnnotationFactory.new();
+# $ann = $factory.create_object(value => $struct);
+# ok defined $ann;
+# isa_ok($ann,'Bio::Annotation::TagTree');
+
+done();
Please sign in to comment.
Something went wrong with that request. Please try again.