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

[Jason Stajich]

On Dec 9, 2004, at 1:56 PM, Crabtree, Jonathan wrote:

>
> 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
>
# You can do this even more succinctly  and without the warnings

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 {
sub Bio::Graphics::Glyph::graded_segments::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;
> _______________________________________________
> Bioperl-l mailing list
> Bioperl-l at portal.open-bio.org
> http://portal.open-bio.org/mailman/listinfo/bioperl-l
--
Jason Stajich
jason.stajich at duke.edu
http://www.duke.edu/~jes12/