[Bioperl-guts-l] bioperl-live/Bio/Graphics/Glyph merge_parts.pm, NONE, 1.1 minmax.pm, 1.1, 1.2

[Sheldon Mckay]

Update of /home/repository/bioperl/bioperl-live/Bio/Graphics/Glyph
In directory pub.open-bio.org:/tmp/cvs-serv17861

Modified Files:
	minmax.pm 
Added Files:
	merge_parts.pm 
Log Message:
added merge_parts.pm a base class for graded_segments and related glyphs



Index: minmax.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Graphics/Glyph/minmax.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** minmax.pm	25 Sep 2003 22:59:46 -0000	1.1
--- minmax.pm	26 Sep 2005 14:03:19 -0000	1.2
***************
*** 45,49 ****
  =head1 DESCRIPTION
  
! This glyph is the common base class for
  L<Bio::Graphics::Glyph::graded_segments> and
  L<Bio::Graphics::Glyph::xyplot>.  It adds an internal method named
--- 45,49 ----
  =head1 DESCRIPTION
  
! This glyph is a common base class for
  L<Bio::Graphics::Glyph::graded_segments> and
  L<Bio::Graphics::Glyph::xyplot>.  It adds an internal method named
***************
*** 60,64 ****
  L<Bio::Graphics::Track>,
  L<Bio::Graphics::Glyph::graded_segments>,
! L<Bio::Graphics::Glyph::xyplog>,
  
  =head1 AUTHOR
--- 60,64 ----
  L<Bio::Graphics::Track>,
  L<Bio::Graphics::Glyph::graded_segments>,
! L<Bio::Graphics::Glyph::xyplot>,
  
  =head1 AUTHOR

--- NEW FILE: merge_parts.pm ---
package Bio::Graphics::Glyph::merge_parts;

use strict;
use Bio::Graphics::Glyph;
use vars '@ISA';
@ISA = 'Bio::Graphics::Glyph';

sub merge_parts {
    my ($self, at parts)  = @_;
    
    # This is the largest gap across which adjacent segments will be merged
    my $max_gap = $self->max_gap;

    my $last_part;

    my @sorted_parts = sort {$a->start <=> $b->start} @parts;

    for my $part (@sorted_parts) {
        if ($last_part) {
            my $start  = $part->start;
            my $end    = $part->stop;
            my $score  = $part->score;
            my $pstart = $last_part->start;
            my $pend   = $last_part->stop;
            my $pscore = $last_part->score || 0;
            my $len    = 1 + abs($end - $start);
            my $plen   = 1 + abs($pend - $pstart);

            # weighted average score
            my $new_score = (($score*$len)+($pscore*$plen))/($len+$plen);

            # don't merge if there is a gap > than the allowed size
            my $gap   = abs($start - $pend);
            my $total = abs($end - $pstart);

	    my $last_f = $last_part->feature;
            if ($gap > $max_gap) {
                $last_part = $part;
                next;
            }

            $part->{start}    = $pstart;
            $part->{score}    = $new_score;
            my ($left,$right) = $self->map_pt($pstart,$end+1);
            $part->{left}     = $left;
            $part->{width}    = ($right - $left) + 1;

            # flag the left feature for removal
            $last_part->{remove} = 1;
        }

        $last_part = $part;

    }

    @parts =  grep {!defined $_->{remove}} @parts;

    return @parts;
}

# max_gap getter/setter
sub max_gap {
    my $self = shift;
    $self->panel->{max_gap} ||= $self->option('max_gap') || shift;
    return $self->panel->{max_gap} || $self->calculate_max_gap;
}

sub calculate_max_gap {
    my $self = shift;
    my $segment_length = $self->panel->length;

    # allow more aggressive merging for larger segments
    # by exponentially increasing max_gap
    my $max_gap = ($segment_length/10000)*($segment_length/500);

    $self->panel->{max_gap} = $max_gap;

    return $max_gap;
}

1;

__END__

=head1 NAME

Bio::Graphics::Glyph::merge_parts

=head1 SYNOPSIS

  See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.

=head1 DESCRIPTION

This is a base class for
Bio::Graphics::Glyph::graded_segments, 
Bio::Graphics::Glyph::heterogeneous_segments
and Bio::Graphics::Glyph::merged_alignment.
It adds internal methods to support semantic zooming of scored
alignment features. It is not intended for end users.

=head1 BUGS

Please report them.

=head1 SEE ALSO

L<Bio::Graphics::Panel>,
L<Bio::Graphics::Track>,
L<Bio::Graphics::Glyph::graded_segments>
L<Bio::Graphics::Glyph::heterogeneous_segments>
L<Bio::Graphics::Glyph::merged_alignment>

=head1 AUTHOR

Sheldon McKay E<lt>mckays at cshl.eduE<gt>

Copyright (c) 2005 Cold Spring Harbor Laboratory

    This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  See DISCLAIMER.txt for
disclaimers of warranty.

=cut