branch-1-6/Bio/DB/GFF/Util/Binning.pm

   1 =head1 NAME
   2
   3 Bio::DB::GFF::Util::Binning - binning utility for Bio::DB::GFF index
   4
   5 =head1 SYNOPSIS
   6
   7  use Bio::DB::GFF::Util::Binning qw(bin bin_bot bin_top);
   8  my $tier = bin($start,$stop,$min);
   9
  10 =head1 DESCRIPTION
  11
  12 This is a utility module that exports the functions bin(), bin_bot()
  13 and bin_top().  These functions translate a range on the genome into a
  14 named bin that is used as an index in the Bio::DB::GFF schema.  The
  15 index makes certain range retrieval queries much faster.
  16
  17 =head1 API
  18
  19 The remainder of the document describes the function calls.  No calls
  20 are exported by default, but must be imported explicitly.
  21
  22 =over 4
  23
  24 =cut
  25
  26 package Bio::DB::GFF::Util::Binning;
  27
  28 use strict;
  29 require Exporter;
  30 use vars qw(@EXPORT @EXPORT_OK);
  31 use base qw(Exporter);
  32 @EXPORT_OK = qw(bin bin_bot bin_top);
  33 @EXPORT = @EXPORT_OK;
  34 use Bio::Root::Version;
  35
  36 =item $bin_name = bin($start,$stop,$bin_size)
  37
  38 Given a start, stop and bin size on the genome, translate this
  39 location into a bin name.  In a list context, returns the bin tier
  40 name and the position that the bin begins.
  41
  42 =cut
  43
  44 sub bin {
  45   my ($start,$stop,$min) = @_;
  46   $start = abs($start);  # to allow negative coordinates
  47   $stop  = abs($stop);
  48   my $tier = $min;
  49   my ($bin_start,$bin_end);
  50   while (1) {
  51     $bin_start = int $start/$tier;
  52     $bin_end   = int $stop/$tier;
  53     last if $bin_start == $bin_end;
  54     $tier *= 10;
  55   }
  56   return wantarray ? ($tier,$bin_start) : bin_name($tier,$bin_start);
  57 }
  58
  59 =item $bottom = bin_bot($tier,$start)
  60
  61 Given a tier name and a range start position, returns the lower end of
  62 the bin range.
  63
  64 =cut
  65
  66 sub bin_bot {
  67   my $tier = shift;
  68   my $pos  = shift;
  69   bin_name($tier,int(abs($pos)/$tier));
  70 }
  71
  72 =item $top = bin_top($tier,$end)
  73
  74 Given a tier name and the end of a range, returns the upper end of the
  75 bin range.
  76
  77 =cut
  78
  79 sub bin_top {
  80   my $tier = shift;
  81   my $pos  = shift;
  82   bin_name($tier,int(abs($pos)/$tier));  #  bin_name($tier,int($pos/$tier),+1);
  83 }
  84
  85 sub bin_name {
  86   my ($tier, $int, $fudge) = @_;
  87   my $pos = abs($int) + ($fudge || 0);
  88   $pos    = 0 if $pos < 0;
  89   sprintf("%d.%06d",$tier, $pos);
  90 }
  91
  92 sub log10 {
  93   my $i = shift;
  94   log($i)/log(10);
  95 }
  96
  97 1;
  98
  99 =back
 100
 101 =head1 BUGS
 102
 103 None known yet.
 104
 105 =head1 SEE ALSO
 106
 107 L<Bio::DB::GFF>,
 108
 109 =head1 AUTHOR
 110
 111 Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
 112
 113 Copyright (c) 2001 Cold Spring Harbor Laboratory.
 114
 115 This library is free software; you can redistribute it and/or modify
 116 it under the same terms as Perl itself.
 117
 118 =cut