Archive Ensembl HomeArchive Ensembl Home
BinValueSet.pm
Go to the documentation of this file.
00001 =head1 LICENSE
00002 
00003   Copyright (c) 1999-2012 The European Bioinformatics Institute and
00004   Genome Research Limited.  All rights reserved.
00005 
00006   This software is distributed under a modified Apache license.
00007   For license details, please see
00008 
00009     http://www.ensembl.org/info/about/code_licence.html
00010 
00011 =head1 CONTACT
00012 
00013   Please email comments or questions to the public Ensembl
00014   developers list at <dev@ensembl.org>.
00015 
00016   Questions may also be sent to the Ensembl help desk at
00017   <helpdesk@ensembl.org>.
00018 
00019 =cut
00020 
00021 
00022 =head1 NAME
00023 
00024 Bio::EnsEMBL::DensityPlot::BinValueSet
00025 
00026 =head1 SYNOPSIS
00027 
00028 =head1 DESCRIPTION
00029 
00030 =head1 METHODS
00031 
00032 =cut
00033 
00034 package Bio::EnsEMBL::DensityPlot::BinValueSet;
00035 
00036 use vars qw($AUTOLOAD @ISA);
00037 use strict;
00038 use Bio::EnsEMBL::DensityPlot::BinValue;
00039 
00040 # Object preamble - inheriets from Bio::Root::Object
00041 
00042 use Bio::EnsEMBL::Root;
00043 
00044 @ISA = qw(Bio::EnsEMBL::Root Exporter);
00045 #@EXPORT_OK = qw();
00046 # new() is inherited from Bio::Root::Object
00047 
00048 # _initialize is where the heavy stuff will happen when new is called
00049 
00050 sub new {
00051   my ($class,@args) = @_;
00052     
00053     my $self = {};
00054     bless $self,$class;
00055     $self->{'_bin_array'} = [];
00056     return $self;
00057 }
00058 
00059 
00060 
00061 =head2 add_binvalue
00062 
00063  Title   : add_binValue
00064  Usage   :
00065  Function:
00066  Example :
00067  Returns : 
00068  Args    :
00069 
00070 
00071 =cut
00072 
00073 sub add_binvalue{
00074     my ($self,$value) = @_;
00075 
00076     defined ($value->chromosomestart)   || $self->throw( "Bin Value object does not contain a ChromosomeStart method" );
00077     defined ($value->chromosomeend)     || $self->throw( "Bin Value object does not contain a ChromosomeEnd method"   );
00078     defined ($value->value)             || $self->throw( "Bin Value object does not contain a Value method"           );
00079     $self->_store_biggest($value->value);
00080     $self->_store_smallest($value->value);
00081 
00082     push(@{$self->{'_bin_array'}},$value);
00083 }
00084 
00085 =head2 get_binvalues
00086 
00087  Title   : get_binvalues
00088  Usage   : my @binvalue_objects = $BVSet->get_binvalues
00089  Function: scales all the binvalues by the scale_factor and returns them.
00090  Example :
00091  Returns : array of BinValue objects 
00092  Args    : none
00093 
00094 
00095 =cut
00096 
00097 sub get_binvalues{
00098     my $self = shift;
00099     my $biggest_value   = $self->{'_biggest_value'} || 0;
00100     my $smallest_value  = $self->{'_smallest_value'} || 0;
00101    
00102     if (!defined ($biggest_value)||!defined($smallest_value)){
00103         $self->throw("Cannot scale - no values to scale against");  
00104     }
00105 
00106     my $width = $self->scale_to_fit();
00107 
00108     if ($self->stretch && ($biggest_value-$smallest_value) ){
00109         foreach my $bv (@{ $self->{'_bin_array'}}){
00110             my $scaledval = (($bv->value - $smallest_value) / ($biggest_value-$smallest_value) )* $width;
00111             $bv->scaledvalue($scaledval);
00112         }
00113     } elsif($biggest_value) {
00114         foreach my $bv (@{ $self->{'_bin_array'}}){
00115             my $scaledval = ($bv->value / $biggest_value) * $width;
00116             $bv->scaledvalue($scaledval);
00117         }
00118     } else {
00119         foreach my $bv (@{ $self->{'_bin_array'}}){
00120             $bv->scaledvalue(0);
00121         }
00122     }
00123 
00124    return ( @{ $self->{'_bin_array'}}      );  
00125 
00126 }
00127 
00128 sub size {
00129     my $self = shift;
00130     return scalar @{$self->{'_bin_array'}};
00131 }
00132 
00133 =head2 position
00134 
00135  Title   : position
00136  Usage   : $obj->position($newval)
00137  Function: 
00138  Returns : value of position
00139  Args    : newvalue (optional)
00140 
00141 
00142 =cut
00143 
00144 sub position{
00145    my $self = shift;
00146    if( @_ ) {
00147       my $value = shift;
00148       $self->{'position'} = $value;
00149     }
00150     return $self->{'position'};
00151 
00152 }
00153 
00154 
00155 =head2 label
00156 
00157  Title   : label
00158  Usage   : $obj->label($newval)
00159  Function: 
00160  Returns : value of label
00161  Args    : newvalue (optional)
00162 
00163 
00164 =cut
00165 
00166 sub label{
00167    my $self = shift;
00168    if( @_ ) {
00169       my $value = shift;
00170       $self->{'label'} = $value;
00171     }
00172     return $self->{'label'};
00173 
00174 }
00175 
00176 
00177 =head2 label2
00178 
00179  Title   : label2
00180  Usage   : $obj->label2($newval)
00181  Function: 
00182  Returns : value of label2
00183  Args    : newvalue (optional)
00184 
00185 
00186 =cut
00187 
00188 sub label2{
00189    my $self = shift;
00190    if( @_ ) {
00191       my $value = shift;
00192       $self->{'label2'} = $value;
00193     }
00194     return $self->{'label2'};
00195 
00196 }
00197 
00198 
00199 
00200 =head2 color
00201 
00202  Title   : color
00203  Usage   : $obj->color($newval)
00204  Function: 
00205  Returns : value of color
00206  Args    : newvalue (optional)
00207 
00208 
00209 =cut
00210 
00211 sub color{
00212    my $self = shift;
00213 
00214 
00215    if( @_ ) {
00216       my $value = shift;
00217       $self->{'color'} = $value;
00218     }
00219     return $self->{'color'};
00220 
00221 }
00222 
00223 =head2 shape
00224 
00225  Title   : shape
00226  Usage   : $obj->shape($newval)
00227  Function: 
00228  Returns : value of shape
00229  Args    : newvalue (optional)
00230 
00231 
00232 =cut
00233 
00234 sub shape{
00235    my $self = shift;
00236    if( @_ ) {
00237       my $value = shift;
00238       $self->{'shape'} = $value;
00239     }
00240     return $self->{'shape'};
00241 
00242 }
00243 
00244 
00245 
00246 =head2 stretch
00247 
00248  Title   : stretch
00249  Usage   : $obj->stretch($newval)
00250  Function: gets/sets a boolean for whether we should stretch the data over the
00251  range (i.e. from min to max rather than absolute numbers).
00252  Returns : value of _stretch
00253  Args    : newvalue (optional)
00254 
00255 
00256 =cut
00257 
00258 sub stretch{
00259    my ($self,$value) = @_;
00260    if( defined $value ) {
00261       $self->{'_stretch'} = $value;
00262     }
00263     return $self->{'_stretch'};
00264 }
00265 
00266 
00267 =head2 scale_to_fit
00268 
00269  Title   : scale_to_fit
00270  Usage   : $obj->scale_to_fit($newval)
00271  Function: gets/sets the number that the BinValues are to be scaled against -
00272  i.e. the greatest BinValue->value will be scaled to this number, and the rest
00273  scaled in proportion.
00274  Returns : scale_to_fit value
00275  Args    : newvalue (optional)
00276 
00277 
00278 =cut
00279 
00280 sub scale_to_fit{
00281    my $self = shift;
00282    if( @_ ) {
00283       my $value = shift;
00284       $self->{'_scale_to_fit'} = $value;
00285     }
00286     return $self->{'_scale_to_fit'};
00287 
00288 }
00289 
00290 
00291 =head2 _store_biggest
00292 
00293  Title   : _store_biggest
00294  Usage   : $self->_store_biggest($newval)
00295  Function: internal method for storing the largest BinValue->value in this set.
00296  Returns : biggest value seen so far
00297  Args    : value 
00298 
00299 
00300 =cut
00301 
00302 sub _store_biggest {
00303     my ($self,$val) = @_;
00304     
00305     if (!defined $self->{'_biggest_value'} ||
00306     $val > $self->{'_biggest_value'}){
00307     $self->{'_biggest_value'}=$val;
00308     }
00309 
00310     return $self->{'_biggest_value'};
00311 }
00312 
00313 
00314 
00315 =head2 _store_smallest
00316 
00317  Title   : _store_smallest
00318  Usage   : $self->_store_smallest($newval)
00319  Function: internal method for storing the smallest BinValue->value in this set.
00320  Returns : smallest value seen so far
00321  Args    : value 
00322 
00323 =cut
00324 
00325 sub _store_smallest {
00326     my ($self,$val) = @_;
00327   
00328     if (!defined($self->{'_smallest_value'})){
00329     $self->{'_smallest_value'}=$val;
00330     }
00331 
00332     if (!defined($self->{'_smallest_value'}) ||
00333     $val < $self->{'_smallest_value'}){
00334     $self->{'_smallest_value'}=$val;
00335     }
00336     return $self->{'_smallest_value'};
00337 }
00338 
00339 
00340 
00341 1;