Bio/Variation/Allele.pm

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