|
0
|
1 # $Id: Allele.pm,v 1.9 2002/10/22 07:38:49 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Variation::Allele
|
|
|
4 #
|
|
|
5 # Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
|
|
|
6 #
|
|
|
7 # Copyright Heikki Lehvaslaiho
|
|
|
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::Variation::Allele - Sequence object with allele-specific attributes
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 $allele1 = Bio::Variation::Allele->new ( -seq => 'A',
|
|
|
20 -id => 'AC00001.1',
|
|
|
21 -alphabet => 'dna',
|
|
|
22 -is_reference => 1
|
|
|
23 );
|
|
|
24
|
|
|
25 =head1 DESCRIPTION
|
|
|
26
|
|
|
27 List of alleles describe known sequence alternatives in a variable region.
|
|
|
28 Alleles are contained in Bio::Variation::VariantI complying objects.
|
|
|
29 See L<Bio::Variation::VariantI> for details.
|
|
|
30
|
|
|
31 Bio::Varation::Alleles are PrimarySeqI complying objects which can
|
|
|
32 contain database cross references as specified in
|
|
|
33 Bio::DBLinkContainerI interface, too.
|
|
|
34
|
|
|
35 A lot of the complexity with dealing with Allele objects are caused by
|
|
|
36 null alleles; Allele objects that have zero length sequence string.
|
|
|
37
|
|
|
38 In addition describing the allele by its sequence , it possible to
|
|
|
39 give describe repeat structure within the sequence. This done using
|
|
|
40 methods repeat_unit (e.g. 'ca') and repeat_count (e.g. 7).
|
|
|
41
|
|
|
42 =head1 FEEDBACK
|
|
|
43
|
|
|
44 =head2 Mailing Lists
|
|
|
45
|
|
|
46 User feedback is an integral part of the evolution of this and other
|
|
|
47 Bioperl modules. Send your comments and suggestions preferably to the
|
|
|
48 Bioperl mailing lists Your participation is much appreciated.
|
|
|
49
|
|
|
50 bioperl-l@bioperl.org - General discussion
|
|
|
51 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
52
|
|
|
53 =head2 Reporting Bugs
|
|
|
54
|
|
|
55 report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
56 the bugs and their resolution. Bug reports can be submitted via
|
|
|
57 email or the web:
|
|
|
58
|
|
|
59 bioperl-bugs@bio.perl.org
|
|
|
60 http://bugzilla.bioperl.org/
|
|
|
61
|
|
|
62 =head1 AUTHOR - Heikki Lehvaslaiho
|
|
|
63
|
|
|
64 Email: heikki@ebi.ac.uk
|
|
|
65 Address:
|
|
|
66
|
|
|
67 EMBL Outstation, European Bioinformatics Institute
|
|
|
68 Wellcome Trust Genome Campus, Hinxton
|
|
|
69 Cambs. CB10 1SD, United Kingdom
|
|
|
70
|
|
|
71
|
|
|
72 =head1 APPENDIX
|
|
|
73
|
|
|
74 The rest of the documentation details each of the object
|
|
|
75 methods. Internal methods are usually preceded with a _
|
|
|
76
|
|
|
77 =cut
|
|
|
78
|
|
|
79
|
|
|
80 # Let the code begin...
|
|
|
81
|
|
|
82 package Bio::Variation::Allele;
|
|
|
83 my $VERSION=1.0;
|
|
|
84 use vars qw(@ISA);
|
|
|
85 use strict;
|
|
|
86
|
|
|
87 # Object preamble - inheritance
|
|
|
88
|
|
|
89 use Bio::PrimarySeq;
|
|
|
90 use Bio::DBLinkContainerI;
|
|
|
91
|
|
|
92 @ISA = qw( Bio::PrimarySeq Bio::DBLinkContainerI );
|
|
|
93
|
|
|
94 sub new {
|
|
|
95 my($class, @args) = @_;
|
|
|
96 my $self = $class->SUPER::new(@args);
|
|
|
97
|
|
|
98 my($is_reference, $repeat_unit, $repeat_count) =
|
|
|
99 $self->_rearrange([qw(IS_REFERENCE
|
|
|
100 REPEAT_UNIT
|
|
|
101 REPEAT_COUNT
|
|
|
102 )],
|
|
|
103 @args);
|
|
|
104
|
|
|
105 $is_reference && $self->is_reference($is_reference);
|
|
|
106 $repeat_unit && $self->repeat_unit($repeat_unit);
|
|
|
107 $repeat_count && $self->repeat_count($repeat_count);
|
|
|
108
|
|
|
109 return $self; # success - we hope!
|
|
|
110 }
|
|
|
111
|
|
|
112
|
|
|
113 =head2 is_reference
|
|
|
114
|
|
|
115 Title : is_reference
|
|
|
116 Usage : $obj->is_reference()
|
|
|
117 Function: sets and returns boolean values.
|
|
|
118 Unset values return false.
|
|
|
119 Example : $obj->is_reference()
|
|
|
120 Returns : boolean
|
|
|
121 Args : optional true of false value
|
|
|
122
|
|
|
123
|
|
|
124 =cut
|
|
|
125
|
|
|
126
|
|
|
127 sub is_reference {
|
|
|
128 my ($self,$value) = @_;
|
|
|
129 if( defined $value) {
|
|
|
130 $value ? ($value = 1) : ($value = 0);
|
|
|
131 $self->{'is_reference'} = $value;
|
|
|
132 }
|
|
|
133 if( ! exists $self->{'is_reference'} ) {
|
|
|
134 return 0;
|
|
|
135 }
|
|
|
136 else {
|
|
|
137 return $self->{'is_reference'};
|
|
|
138 }
|
|
|
139 }
|
|
|
140
|
|
|
141
|
|
|
142 =head2 add_DBLink
|
|
|
143
|
|
|
144 Title : add_DBLink
|
|
|
145 Usage : $self->add_DBLink($ref)
|
|
|
146 Function: adds a link object
|
|
|
147 Example :
|
|
|
148 Returns :
|
|
|
149 Args :
|
|
|
150
|
|
|
151
|
|
|
152 =cut
|
|
|
153
|
|
|
154
|
|
|
155 sub add_DBLink{
|
|
|
156 my ($self,$com) = @_;
|
|
|
157 if( ! $com->isa('Bio::Annotation::DBLink') ) {
|
|
|
158 $self->throw("Is not a link object but a [$com]");
|
|
|
159 }
|
|
|
160 push(@{$self->{'link'}},$com);
|
|
|
161 }
|
|
|
162
|
|
|
163 =head2 each_DBLink
|
|
|
164
|
|
|
165 Title : each_DBLink
|
|
|
166 Usage : foreach $ref ( $self->each_DBlink() )
|
|
|
167 Function: gets an array of DBlink of objects
|
|
|
168 Example :
|
|
|
169 Returns :
|
|
|
170 Args :
|
|
|
171
|
|
|
172
|
|
|
173 =cut
|
|
|
174
|
|
|
175 sub each_DBLink{
|
|
|
176 my ($self) = @_;
|
|
|
177 return @{$self->{'link'}};
|
|
|
178 }
|
|
|
179
|
|
|
180 =head2 repeat_unit
|
|
|
181
|
|
|
182 Title : repeat_unit
|
|
|
183 Usage : $obj->repeat_unit('ca');
|
|
|
184 Function:
|
|
|
185
|
|
|
186 Sets and returns the sequence of the repeat_unit the
|
|
|
187 allele is composed of.
|
|
|
188
|
|
|
189 Example :
|
|
|
190 Returns : string
|
|
|
191 Args : string
|
|
|
192
|
|
|
193 =cut
|
|
|
194
|
|
|
195 sub repeat_unit {
|
|
|
196 my ($self,$value) = @_;
|
|
|
197 if( defined $value) {
|
|
|
198 $self->{'repeat_unit'} = $value;
|
|
|
199 }
|
|
|
200 if ($self->{'seq'} && $self->{'repeat_unit'} && $self->{'repeat_count'} ) {
|
|
|
201 $self->warn("Repeats do not add up!")
|
|
|
202 if ( $self->{'repeat_unit'} x $self->{'repeat_count'}) ne $self->{'seq'};
|
|
|
203 }
|
|
|
204 return $self->{'repeat_unit'};
|
|
|
205 }
|
|
|
206
|
|
|
207 =head2 repeat_count
|
|
|
208
|
|
|
209 Title : repeat_count
|
|
|
210 Usage : $obj->repeat_count();
|
|
|
211 Function:
|
|
|
212
|
|
|
213 Sets and returns the number of repeat units in the allele.
|
|
|
214
|
|
|
215 Example :
|
|
|
216 Returns : string
|
|
|
217 Args : string
|
|
|
218
|
|
|
219 =cut
|
|
|
220
|
|
|
221
|
|
|
222 sub repeat_count {
|
|
|
223 my ($self,$value) = @_;
|
|
|
224 if( defined $value) {
|
|
|
225 if ( not $value =~ /^\d+$/ ) {
|
|
|
226 $self->throw("[$value] for repeat_count has to be a positive integer\n");
|
|
|
227 } else {
|
|
|
228 $self->{'repeat_count'} = $value;
|
|
|
229 }
|
|
|
230 }
|
|
|
231 if ($self->{'seq'} && $self->{'repeat_unit'} && $self->{'repeat_count'} ) {
|
|
|
232 $self->warn("Repeats do not add up!")
|
|
|
233 if ( $self->{'repeat_unit'} x $self->{'repeat_count'}) ne $self->{'seq'};
|
|
|
234 }
|
|
|
235 return $self->{'repeat_count'};
|
|
|
236 }
|
|
|
237
|
|
|
238 =head2 count
|
|
|
239
|
|
|
240 Title : count
|
|
|
241 Usage : $obj->count();
|
|
|
242 Function:
|
|
|
243
|
|
|
244 Sets and returns the number of times this allele was observed.
|
|
|
245
|
|
|
246 Example :
|
|
|
247 Returns : string
|
|
|
248 Args : string
|
|
|
249
|
|
|
250 =cut
|
|
|
251
|
|
|
252 sub count {
|
|
|
253 my ($self,$value) = @_;
|
|
|
254 if( defined $value) {
|
|
|
255 if ( not $value =~ /^\d+$/ ) {
|
|
|
256 $self->throw("[$value] for count has to be a positive integer\n");
|
|
|
257 } else {
|
|
|
258 $self->{'count'} = $value;
|
|
|
259 }
|
|
|
260 }
|
|
|
261 return $self->{'count'};
|
|
|
262 }
|
|
|
263
|
|
|
264
|
|
|
265 =head2 frequency
|
|
|
266
|
|
|
267 Title : frequency
|
|
|
268 Usage : $obj->frequency();
|
|
|
269 Function:
|
|
|
270
|
|
|
271 Sets and returns the frequency of the allele in the observed
|
|
|
272 population.
|
|
|
273
|
|
|
274 Example :
|
|
|
275 Returns : string
|
|
|
276 Args : string
|
|
|
277
|
|
|
278 =cut
|
|
|
279
|
|
|
280 sub frequency {
|
|
|
281 my ($self,$value) = @_;
|
|
|
282 if( defined $value) {
|
|
|
283 if ( not $value =~ /^\d+$/ ) {
|
|
|
284 $self->throw("[$value] for frequency has to be a positive integer\n");
|
|
|
285 } else {
|
|
|
286 $self->{'frequency'} = $value;
|
|
|
287 }
|
|
|
288 }
|
|
|
289 return $self->{'frequency'};
|
|
|
290 }
|
|
|
291
|
|
|
292
|
|
|
293 1;
|
