[Bioperl-l] Can I get different Graphics::Panel coloursfordifferent HSP frames within the same blast hit?

[Crabtree, Jonathan]

Marcus-

>That hack seems to do it. However, my program will be used by people
>installing it themselves so I have to stick with the standard non-hacked
>version of bioperl.

OK, in that case here's an even less elegant solution for you to consider; this one requires you to distribute only a single file.  Just replace 'blastx.out' with the name of your blastx output file in the script below.

Jonathan


#!/usr/bin/perl

# BEGIN HACK

use Bio::Graphics::Glyph::graded_segments;
package Bio::Graphics::Glyph::graded_segments;

# redefine draw method from Bioperl graded_segments package; 
# perl will warn you (and for good reason...) that you're doing this if you run it with the -w flag 
#
sub draw {
  my $self = shift;

  # bail out if this isn't the right kind of feature
  # handle both das-style and Bio::SeqFeatureI style,
  # which use different names for subparts.
  my @parts = $self->parts;
  @parts    = $self if !@parts && $self->level == 0;
  return $self->SUPER::draw(@_) unless @parts;

  my ($min_score,$max_score) = $self->minmax(\@parts);

  return $self->SUPER::draw(@_)
    unless defined($max_score) && defined($min_score)
      && $min_score < $max_score;

  my $span = $max_score - $min_score;

  foreach my $part (@parts) {
    # use part's bgcolor as base color (to be adjusted by score)
    my $fill = $part->bgcolor;
    my ($red,$green,$blue) = $self->panel->rgb($fill);

    my $s = eval { $part->feature->score };
    unless (defined $s) {
      $part->{partcolor} = $fill;
      next;
    }
    my ($r,$g,$b) = $self->calculate_color($s,[$red,$green,$blue],$min_score,$span);
    my $idx      = $self->panel->translate_color($r,$g,$b);
    $part->{partcolor} = $idx;
  }
  $self->SUPER::draw(@_);
}

package MAIN;

# END HACK

use Bio::Graphics;
use Bio::SearchIO;

my $searchio = Bio::SearchIO->new(-file=> 'blastx.out', -format => 'blast');
my $result = $searchio->next_result();
my $panel = Bio::Graphics::Panel->new(-length=> $result->query_length, -width=> 800);
my $track = $panel->add_track(-glyph       => 'graded_segments',
                              -label       => 1,
                              -connector   => 'dashed',
                              -bgcolor      => sub {
                                  my $feature = shift;
                                  my ($frame) = $feature->frame();
                                  return "red" if ($frame =~ /0/);
                                  return "green" if ($frame =~ /1/);
                                  return "blue" if ($frame =~ /2/)},
                              -strand_arrow  => 'tue');
while( my $hit = $result->next_hit ) {
    my $feature = Bio::SeqFeature::Generic->new(-score=>$hit->raw_score,
                                                -frame=> $hit->frame);
    while( my $hsp = $hit->next_hsp ) {
        $feature->add_sub_SeqFeature($hsp,'EXPAND');
    }
    $track->add_feature($feature);
}
print $panel->png;