|
0
|
1 # $Id: Symbol.pm,v 1.6 2002/10/22 07:45:21 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Symbol::Symbol
|
|
|
4 #
|
|
|
5 # Cared for by Jason Stajich <jason@bioperl.org>
|
|
|
6 #
|
|
|
7 # Copyright Jason Stajich
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10
|
|
|
11 # POD documentation - main docs before the code
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Bio::Symbol::Symbol - A biological symbol
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 use Bio::Symbol::Symbol;
|
|
|
20 my $thymine = new Bio::Symbol::Symbol(-name => 'Thy',
|
|
|
21 -token=> 'T');
|
|
|
22 my $a = new Bio::Symbol::Symbol(-token => 'A' );
|
|
|
23 my $u = new Bio::Symbol::Symbol(-token => 'U' );
|
|
|
24 my $g = new Bio::Symbol::Symbol(-token => 'G' );
|
|
|
25
|
|
|
26 my $M = new Bio::Symbol::Symbol(-name => 'Met',
|
|
|
27 -token => 'M',
|
|
|
28 -symbols => [ $a, $u, $g ]);
|
|
|
29
|
|
|
30 my ($name,$token) = ($a->name, $a->token);
|
|
|
31 my @symbols = $a->symbols;
|
|
|
32 my $matches = $a->matches;
|
|
|
33
|
|
|
34 =head1 DESCRIPTION
|
|
|
35
|
|
|
36 Symbol represents a single token in the sequence. Symbol can have
|
|
|
37 multiple synonyms or matches within the same Alphabet, which
|
|
|
38 makes possible to represent ambiguity codes and gaps.
|
|
|
39
|
|
|
40 Symbols can be also composed from ordered list other symbols. For
|
|
|
41 example, codons can be represented by single Symbol using a
|
|
|
42 compound Alphabet made from three DNA Alphabets.
|
|
|
43
|
|
|
44 This module was implemented for the purposes of meeting the
|
|
|
45 BSANE/BioCORBA spec 0.3 only.
|
|
|
46
|
|
|
47 =head1 FEEDBACK
|
|
|
48
|
|
|
49 =head2 Mailing Lists
|
|
|
50
|
|
|
51 User feedback is an integral part of the evolution of this and other
|
|
|
52 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
53 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
54
|
|
|
55 bioperl-l@bioperl.org - General discussion
|
|
|
56 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
57
|
|
|
58 =head2 Reporting Bugs
|
|
|
59
|
|
|
60 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
61 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
62 email or the web:
|
|
|
63
|
|
|
64 bioperl-bugs@bioperl.org
|
|
|
65 http://bugzilla.bioperl.org/
|
|
|
66
|
|
|
67 =head1 AUTHOR - Jason Stajich
|
|
|
68
|
|
|
69 Email jason@bioperl.org
|
|
|
70
|
|
|
71 Describe contact details here
|
|
|
72
|
|
|
73 =head1 CONTRIBUTORS
|
|
|
74
|
|
|
75 Additional contributors names and emails here
|
|
|
76
|
|
|
77 =head1 APPENDIX
|
|
|
78
|
|
|
79 The rest of the documentation details each of the object methods.
|
|
|
80 Internal methods are usually preceded with a _
|
|
|
81
|
|
|
82 =cut
|
|
|
83
|
|
|
84
|
|
|
85 # Let the code begin...
|
|
|
86
|
|
|
87
|
|
|
88 package Bio::Symbol::Symbol;
|
|
|
89 use vars qw(@ISA);
|
|
|
90 use strict;
|
|
|
91
|
|
|
92 # Object preamble - inherits from Bio::Root::Root
|
|
|
93
|
|
|
94 use Bio::Symbol::SymbolI;
|
|
|
95 use Bio::Symbol::Alphabet;
|
|
|
96 use Bio::Root::Root;
|
|
|
97
|
|
|
98 @ISA = qw( Bio::Root::Root Bio::Symbol::SymbolI );
|
|
|
99
|
|
|
100 =head2 new
|
|
|
101
|
|
|
102 Title : new
|
|
|
103 Usage : my $obj = new Bio::Symbol::Symbol();
|
|
|
104 Function: Builds a new Bio::Symbol::Symbol object
|
|
|
105 Returns : Bio::Symbol::Symbol
|
|
|
106 Args : -name => descriptive name (string) [e.g. Met]
|
|
|
107 -token => Shorthand token (string) [e.g. M]
|
|
|
108 -symbols => Symbols that make up this symbol (array) [e.g. AUG]
|
|
|
109 -matches => Alphabet in the event symbol is an ambiguity
|
|
|
110 code.
|
|
|
111
|
|
|
112 =cut
|
|
|
113
|
|
|
114 sub new {
|
|
|
115 my($class,@args) = @_;
|
|
|
116 my $self = $class->SUPER::new(@args);
|
|
|
117 $self->{'_symbols'} = [];
|
|
|
118
|
|
|
119 my ($name, $token, $symbols,
|
|
|
120 $matches) = $self->_rearrange([qw(NAME TOKEN SYMBOLS
|
|
|
121 MATCHES)],
|
|
|
122 @args);
|
|
|
123 $token && $self->token($token);
|
|
|
124 $name && $self->name($name);
|
|
|
125 $symbols && ref($symbols) =~ /array/i && $self->symbols(@$symbols);
|
|
|
126 $matches && $self->matches($matches);
|
|
|
127 return $self;
|
|
|
128 }
|
|
|
129
|
|
|
130 =head2 name
|
|
|
131
|
|
|
132 Title : name
|
|
|
133 Usage : my $name = $symbol->name();
|
|
|
134 Function: Get/Set Descriptive name for Symbol
|
|
|
135 Returns : string
|
|
|
136 Args : (optional) string
|
|
|
137
|
|
|
138 =cut
|
|
|
139
|
|
|
140 sub name {
|
|
|
141 my ($self,$value) = @_;
|
|
|
142 if( $value ) {
|
|
|
143 $self->{'_name'} = $value;
|
|
|
144 }
|
|
|
145 return $self->{'_name'} || '';
|
|
|
146 }
|
|
|
147
|
|
|
148 =head2 token
|
|
|
149
|
|
|
150 Title : token
|
|
|
151 Usage : my $token = $self->token();
|
|
|
152 Function: Get/Set token for this symbol
|
|
|
153 Example : Letter A,C,G,or T for a DNA alphabet Symbol
|
|
|
154 Returns : string
|
|
|
155 Args : (optional) string
|
|
|
156
|
|
|
157 =cut
|
|
|
158
|
|
|
159 sub token{
|
|
|
160 my ($self,$value) = @_;
|
|
|
161 if( $value ) {
|
|
|
162 $self->{'_token'} = $value;
|
|
|
163 }
|
|
|
164 return $self->{'_token'} || '';
|
|
|
165 }
|
|
|
166
|
|
|
167 =head2 symbols
|
|
|
168
|
|
|
169 Title : symbols
|
|
|
170 Usage : my @symbols = $self->symbols();
|
|
|
171 Function: Get/Set Symbols this Symbol is composed from
|
|
|
172 Example : Ambiguity symbols are made up > 1 base symbol
|
|
|
173 Returns : Array of Bio::Symbol::SymbolI objects
|
|
|
174 Args : (optional) Array of Bio::Symbol::SymbolI objects
|
|
|
175
|
|
|
176
|
|
|
177 =cut
|
|
|
178
|
|
|
179 sub symbols{
|
|
|
180 my ($self,@args) = @_;
|
|
|
181 if( @args ) {
|
|
|
182 $self->{'_symbols'} = [@args];
|
|
|
183 }
|
|
|
184 return @{$self->{'_symbols'}};
|
|
|
185 }
|
|
|
186
|
|
|
187 =head2 matches
|
|
|
188
|
|
|
189 Title : matches
|
|
|
190 Usage : my $matchalphabet = $symbol->matches();
|
|
|
191 Function: Get/Set (Sub) alphabet of symbols matched by this symbol
|
|
|
192 including the symbol itself (i.e. if symbol is DNA
|
|
|
193 ambiguity code W then the matches contains symbols for W
|
|
|
194 and T)
|
|
|
195 Returns : Bio::Symbol::AlphabetI
|
|
|
196 Args : (optional) Bio::Symbol::AlphabetI
|
|
|
197
|
|
|
198 =cut
|
|
|
199
|
|
|
200 sub matches{
|
|
|
201 my ($self,$matches) = @_;
|
|
|
202
|
|
|
203 if( $matches ) {
|
|
|
204 if( ! $matches->isa('Bio::Symbol::AlphabetI') ) {
|
|
|
205 $self->warn("Must pass in a Bio::Symbol::AlphabetI object to matches function");
|
|
|
206 # stick with previous value
|
|
|
207 } else {
|
|
|
208 $self->{'_matches'} = $matches;
|
|
|
209 }
|
|
|
210 }
|
|
|
211 return $self->{'_matches'};
|
|
|
212 }
|
|
|
213
|
|
|
214 =head2 equals
|
|
|
215
|
|
|
216 Title : equals
|
|
|
217 Usage : if( $symbol->equals($symbol2) ) { }
|
|
|
218 Function: Tests if a symbol is equal to another
|
|
|
219 Returns : Boolean
|
|
|
220 Args : Bio::Symbol::SymbolI
|
|
|
221
|
|
|
222 =cut
|
|
|
223
|
|
|
224 sub equals{
|
|
|
225 my ($self,$symbol2) = @_;
|
|
|
226 # Let's just test based on Tokens for now
|
|
|
227 # Doesn't handle DNA vs PROTEIN accidential comparisons
|
|
|
228 return $self->token eq $symbol2->token;
|
|
|
229 }
|
|
|
230
|
|
|
231
|
|
|
232 1;
|
