more work on KISS

[biopieces.git] / code_perl / Maasha / KISS / Track.pm

package Maasha::KISS::Track;

# Copyright (C) 2009 Martin A. Hansen.

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

# http://www.gnu.org/copyleft/gpl.html


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


# Routines for creating KISS tracks.


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


use warnings;
use strict;
use Data::Dumper;
use Maasha::Calc;
use vars qw( @ISA @EXPORT );

@ISA = qw( Exporter );


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


sub track_ruler
{
    my ( $width,     # draw window width
         $y_offset,  # y axis draw offset
         $beg,       # base window beg
         $end,       # base window end
       ) = @_;

    my ( $factor, $step, $i, $txt, $x, @ruler );

    $factor = $width / ( $end - $beg );
    
    $step = 10;

    while ( ( $end - $beg ) / $step > 20 )
    {
        $step *= 5;
    }

    for ( $i = $beg; $i < $end; $i++ )
    {
        if ( ( $i % $step ) == 0 )
        {
            $txt = "$i|";
            $x   = sprintf( "%.0f", ( $i - $beg - length $txt ) * $factor );

            push @ruler, { txt => $txt, x => $x, y => $y_offset };
        }
    }

    return wantarray ? @ruler : \@ruler;
}


sub track_seq
{
    my ( $width,     # draw window width
         $y_offset,  # y axis draw offset
         $seq,       # sequence to draw
       ) = @_;

    my ( @chars, $factor, $i, @seq_list );

    @chars = split //, $seq;

    $factor = $width / @chars;

    for ( $i = 0; $i < @chars; $i++ ) {
        push @seq_list, { txt => $chars[ $i ], x => sprintf( "%.0f", $i * $factor ), y => $y_offset };
    }

    return wantarray ? @seq_list : \@seq_list;
}


sub track_feature
{
    my ( $width,     # draw window width
         $y_offset,  # y axis draw offset
         $beg,       # base window beg
         $end,       # base window end
         $entries,   # list of unsorted KISS entries 
       ) = @_;

    # Returns a list.
    
    my ( $factor, $entry, $y_step, @ladder, $w, $x1, $y1, $x2, $y2, @features );

    @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries };

    $factor = $width / ( $end - $beg );
    $y_step = 0;

    foreach $entry ( @{ $entries } )
    {
        $w = sprintf( "%.0f", ( $entry->{ 'S_END' } - $entry->{ 'S_BEG' } + 1 ) * $factor );

        if ( $w >= 1 )
        {
            $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor );

            for ( $y_step = 0; $y_step < @ladder; $y_step++ )
            {
                last if $x1 >= $ladder[ $y_step ] + 1; 
            }

            $y1 = $y_offset + ( 5 * $y_step );

            push @features, {
                x1 => $x1,
                y1 => $y1,
                x2 => $x1 + $w,
                y2 => $y1,
            };

            $ladder[ $y_step ] = $x1 + $w;
        }
    }

    return wantarray ? @features : \@features;
}


sub track_histogram
{
    my ( $width,     # draw window width
         $y_offset,  # y axis draw offset
         $min,       # minimum base position
         $max,       # maximum base position
         $entries,   # list of unsorted KISS entries 
       ) = @_;

    # Returns a list.

    my ( $hist_height, $bucket_width, $factor_heigth, $factor_width, $entry, $min_bucket, $max_height, $bucket_beg, $bucket_end, $i, @buckets, $bucket, @hist, $x, $h );

    return if $max == $min;

    $hist_height  = 100;   # pixels
    $bucket_width = 5;     # pixels

    $factor_width = ( $width / $bucket_width ) / ( $max - $min );

    $min_bucket = 999999999;
    $max_height = 0;

    foreach $entry ( @{ $entries } )
    {
        $bucket_beg = int( $entry->{ 'S_BEG' } * $factor_width );
        $bucket_end = int( $entry->{ 'S_END' } * $factor_width );

        $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );

        for ( $i = $bucket_beg; $i <= $bucket_end; $i++ )
        {
            $buckets[ $i ]++;

            $max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] );
        }
    }

    if ( $max_height > 0 )
    {
        $factor_heigth = $hist_height / $max_height;

        $x = 0;

        for ( $i = $min_bucket; $i < @buckets; $i++ )
        {
            if ( defined $buckets[ $i ] )
            {
                $h = sprintf( "%.0f", $buckets[ $i ] * $factor_heigth );

                if ( $h >= 1 )
                {
                    push @hist, {
                        x1      => $x,
                        y1      => $y_offset + $hist_height,
                        x2      => $x,
                        y2      => $y_offset + $hist_height - $h,
                    };
                }
            }

            $x += $bucket_width;
        }
    }

    return wantarray ? @hist : \@hist;
}


sub bucket_round
{
    my ( $num,
         $bucket_size,
       ) = @_;
    
    my ( $div, $int );

    $div = $num / $bucket_size;
    $int = int $div;

    if ( $div - $int >= 0.5 ) {
        return $bucket_size * ( $int + 1 );
    } else {
        return $bucket_size * $int;
    }
}


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

1;