Menu
▾
▴
Re: [GMOD-devel] sorting features by score
|
From: Aaron J M. <aj...@vi...> - 2002-08-26 20:09:00
|
I built up the sort routines dynamically in order to support the "sortby =
low_score|length|left" syntax (see the documentation patch towards the
bottom).
-Aaron
On Mon, 26 Aug 2002, Lincoln Stein wrote:
> Hi Aaron,
>
> I was thinking of something more like:
>
> my %SORT_ROUTINES = ( default => \&sort_by_left,
> longest => \&sort_by_longest,
> high_score => \&sort_by_score
> ...);
>
> sub layout {
> ....
> my $sort = $self->option('sort_order');
> $sort ||= 'default';
> my $sort_sub = ref($sort) ? $sort : $SORT_ROUTINES{$sort};
> $sort_sub ||= $SORT_ROUTINES{default}; # just in case
> ...
>
> Then you always call $sort_sub->() instead of having the begin if-else switch.
>
> Lincoln
>
> On Monday 26 August 2002 01:51 pm, Aaron J Mackey wrote:
> > On Mon, 26 Aug 2002, Lincoln Stein wrote:
> > > Aaron, are you willing to take this on?
> >
> > How's something like this? It's a start, but the bump algorithm will need
> > to change ... working on that now ...
> >
> > -Aaron
> >
> > Index: Glyph.pm
> > ===================================================================
> > RCS file: /home/repository/bioperl/bioperl-live/Bio/Graphics/Glyph.pm,v
> > retrieving revision 1.20
> > diff -u -b -B -r1.20 Glyph.pm
> > --- Glyph.pm 2 Aug 2002 22:51:03 -0000 1.20
> > +++ Glyph.pm 26 Aug 2002 17:37:36 -0000
> > @@ -110,6 +110,17 @@
> > return $self->{stop}
> > }
> > sub end { shift->stop }
> > +sub length { my $self = shift; $self->stop - $self->start };
> > +sub score {
> > + my $self = shift;
> > + return $self->{score} if exists $self->{score};
> > + return $self->{score} = ($self->{feature}->score || 0);
> > +}
> > +sub strand {
> > + my $self = shift;
> > + return $self->{strand} if exists $self->{strand};
> > + return $self->{strand} = ($self->{feature}->strand || 0);
> > +}
> > sub map_pt { shift->{factory}->map_pt(@_) }
> > sub map_no_trunc { shift->{factory}->map_no_trunc(@_) }
> >
> > @@ -371,6 +382,57 @@
> > $self->color('connector_color') || $self->fgcolor;
> > }
> >
> > +sub layout_sort {
> > +
> > + my $self = shift;
> > + my $sortfunc;
> > +
> > + my $opt = $self->option("sort_order");
> > + if (!$opt) {
> > + $sortfunc = eval 'sub { $a->left <=> $b->left }';
> > + } elsif (ref $opt eq 'CODE') {
> > + $sortfunc = $opt;
> > + } elsif ($opt =~ /^sub\s+\{/o) {
> > + $sortfunc = eval $opt;
> > + } else {
> > + # build $sortfunc for ourselves:
> > + my @sortbys = split(/\s*\|\s*/o, $opt);
> > + $sortfunc = 'sub { ';
> > + my $sawleft = 0;
> > + for my $sortby (@sortbys) {
> > + if ($sortby eq "left" || $sortby eq "default") {
> > + $sortfunc .= '($a->left <=> $b->left) || ';
> > + $sawleft++;
> > + } elsif ($sortby eq "right") {
> > + $sortfunc .= '($a->right <=> $b->right) || ';
> > + } elsif ($sortby eq "low_score") {
> > + $sortfunc .= '($a->score <=> $b->score) || ';
> > + } elsif ($sortby eq "high_score") {
> > + $sortfunc .= '($b->score <=> $a->score) || ';
> > + } elsif ($sortby eq "longest") {
> > + $sortfunc .= '(($b->length) <=> ($a->length)) || ';
> > + } elsif ($sortby eq "shortest") {
> > + $sortfunc .= '(($a->length) <=> ($b->length)) || ';
> > + } elsif ($sortby eq "strand") {
> > + $sortfunc .= '($b->strand <=> $a->strand) || ';
> > + }
> > + }
> > + unless ($sawleft) {
> > + $sortfunc .= ' ($a->left <=> $b->left) ';
> > + } else {
> > + $sortfunc .= ' 0';
> > + }
> > + $sortfunc .= '}';
> > + $sortfunc = eval $sortfunc;
> > + }
> > +
> > + # would be nice to cache this somehow, but won't this override the
> > + # settings for other tracks?
> > + # $self->factory->set_option(sort_order => $sortfunc);
> > +
> > + return sort $sortfunc @_;
> > +}
> > +
> > # handle collision detection
> > sub layout {
> > my $self = shift;
> > @@ -396,7 +458,7 @@
> > if (abs($bump_direction) <= 1) { # original bump algorithm
> >
> > my %occupied; # format of occupied: key={top,bottom}, value=right
> > - for my $g (sort { $a->left <=> $b->left } @parts) {
> > + for my $g ($self->layout_sort(@parts)) {
> >
> > my $pos = 0;
> > my $left = $g->left;
> > @@ -437,7 +499,7 @@
> > else { # abs(bump) >= 2 -- simple bump algorithm
> > my $pos = 0;
> > my $last;
> > - for my $g (sort { $a->left <=> $b->left } @parts) {
> > + for my $g ($self->layout_sort(@parts)) {
> > next if !defined($last);
> > $pos += $bump_direction > 0 ? $last->{layout_height} + BUMP_SPACING
> >
> > : - ($g->{layout_height}+BUMP_SPACING);
> >
> > @@ -1135,6 +1197,8 @@
> >
> > -description Whether to draw a description 0 (false)
> >
> > + -sort_order Specify layout sort order "default"
> > +
> > For glyphs that consist of multiple segments, the -connector option
> > controls what's drawn between the segments. The default is 0 (no
> > connector). Options include "hat", an upward-angling conector,
> > @@ -1162,6 +1226,42 @@
> > The -strand_arrow option, if true, requests that the glyph indicate
> > which strand it is on, usually by drawing an arrowhead. Not all
> > glyphs can respond appropriately to this request.
> > +
> > +By default, features are drawn with a layout based only on the
> > +position of the feature, assuring a maximal "packing" of the glyphs
> > +when bumped. In some cases, however, it makes sense to display the
> > +glyphs sorted by score or some other comparison, e.g. such that more
> > +"important" features are nearer the top of the display, stacked above
> > +less important features. The -sort_order option allows a few
> > +different built-in values for changing the default sort order (which
> > +is by "left" position): "low_score" (or "high_score") will cause
> > +features to be sorted from lowest to highest score (or vice versa).
> > +"left" (or "default") and "right" values will cause features to be
> > +sorted by their position in the sequence. "longer" (or "shorter")
> > +will cause the longest (or shortest) features to be sorted first, and
> > +"strand" will cause the features to be sorted by strand: "+1"
> > +(forward) then "0" (unknown, or NA) then "-1" (reverse).
> > +
> > +In all cases, the "left" position will be used to break any ties. To
> > +break ties using another field, options may be strung together using a
> > +"|" character; e.g. "strand|low_score|right" would cause the features
> > +to be sorted first by strand, then score (lowest to highest), then by
> > +"right" position in the sequence. Finally, a subroutine coderef can
> > +be provided, which should expect to receive two feature objects (via
> > +the special sort variables $a and $b), and should return -1, 0 or 1
> > +(see Perl's sort() function for more information); this subroutine
> > +will be used without further modification for sorting. For example,
> > +to sort a set of database search hits by bits (stored in the features'
> > +"score" fields), scaled by the log of the alignment length (with
> > +"left" position breaking any ties):
> > +
> > + sort_order = sub { ( $b->score/log($b->length)
> > + <=>
> > + $a->score/log($a->length) )
> > + ||
> > + ( $a->start <=> $b->start )
> > + }
> > +
> >
> > =head1 SUBCLASSING Bio::Graphics::Glyph
>
>
--
Aaron J Mackey
Pearson Laboratory
University of Virginia
(434) 924-2821
am...@vi...
|