Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/Variation/Allele.pm @ 0:1f6dce3d34e0
Uploaded
| author | mahtabm |
|---|---|
| date | Thu, 11 Apr 2013 02:01:53 -0400 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:1f6dce3d34e0 |
|---|---|
| 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; |
