1package Bio::Graphics::Glyph::merge_parts; 2 3use strict; 4use base qw(Bio::Graphics::Glyph); 5 6sub my_description { 7 return <<END; 8This is a base class for graded_segments, heterogeneous_segments, 9and merged_alignment. 10 11It adds internal methods to support semantic zooming of scored 12alignment features. It is not intended for end users. 13END 14} 15 16sub my_options { 17 { 18 max_gap => [ 19 'integer', 20 undef, 21 'This is the maximum gap, measured in bp, across which the glyph will', 22 'attempt to merge subfeatures in an attempt to simplify the appearance', 23 'at low magnifications. If undef, the max_gap will be calculated using', 24 'a simple exponential heuristic.'], 25 } 26} 27 28sub merge_parts { 29 my ($self,@parts) = @_; 30 31 # This is the largest gap across which adjacent segments will be merged 32 my $max_gap = $self->max_gap; 33 34 my $last_part; 35 36 my @sorted_parts = sort {$a->start <=> $b->start} @parts; 37 38 for my $part (@sorted_parts) { 39 if ($last_part) { 40 my $start = $part->start; 41 my $end = $part->stop; 42 my $score = $part->score; 43 my $pstart = $last_part->start; 44 my $pend = $last_part->stop; 45 my $pscore = $last_part->score || 0; 46 my $len = 1 + abs($end - $start); 47 my $plen = 1 + abs($pend - $pstart); 48 49 # weighted average score 50 my $new_score = (($score*$len)+($pscore*$plen))/($len+$plen); 51 52 # don't merge if there is a gap > than the allowed size 53 my $gap = abs($start - $pend); 54 my $total = abs($end - $pstart); 55 56 my $last_f = $last_part->feature; 57 if ($gap > $max_gap) { 58 $last_part = $part; 59 next; 60 } 61 62 $part->{start} = $pstart; 63 $part->{score} = $new_score; 64 my ($left,$right) = $self->map_pt($pstart,$end+1); 65 $part->{left} = $left; 66 $part->{width} = ($right - $left) + 1; 67 68 # flag the left feature for removal 69 $last_part->{remove} = 1; 70 } 71 72 $last_part = $part; 73 74 } 75 76 @parts = grep {!defined $_->{remove}} @parts; 77 78 return @parts; 79} 80 81sub max_gap { 82 my $self = shift; 83 $self->panel->{max_gap} ||= $self->option('max_gap'); 84 return $self->panel->{max_gap} || $self->calculate_max_gap; 85} 86 87sub calculate_max_gap { 88 my $self = shift; 89 my $segment_length = $self->panel->length; 90 91 # allow more aggressive merging for larger segments 92 # by exponentially increasing max_gap 93 my $max_gap = ($segment_length/10000)*($segment_length/500); 94 95 $self->panel->{max_gap} = $max_gap; 96 97 return $max_gap; 98} 99 1001; 101 102__END__ 103 104=head1 NAME 105 106Bio::Graphics::Glyph::merge_parts - a base class which suppors semantic zooming of scored alignment features 107 108=head1 SYNOPSIS 109 110 See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>. 111 112=head1 DESCRIPTION 113 114This is a base class for 115Bio::Graphics::Glyph::graded_segments, 116Bio::Graphics::Glyph::heterogeneous_segments 117and Bio::Graphics::Glyph::merged_alignment. 118It adds internal methods to support semantic zooming of scored 119alignment features. It is not intended for end users. 120 121=head1 BUGS 122 123Please report them. 124 125=head1 SEE ALSO 126 127L<Bio::Graphics::Panel>, 128L<Bio::Graphics::Track>, 129L<Bio::Graphics::Glyph::graded_segments> 130L<Bio::Graphics::Glyph::heterogeneous_segments> 131L<Bio::Graphics::Glyph::merged_alignment> 132 133=head1 AUTHOR 134 135Sheldon McKay E<lt>mckays@cshl.eduE<gt> 136 137Copyright (c) 2005 Cold Spring Harbor Laboratory 138 139 This library is free software; you can redistribute it and/or modify 140it under the same terms as Perl itself. See DISCLAIMER.txt for 141disclaimers of warranty. 142 143=cut 144