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

[Crabtree, Jonathan]

Jason-

Perhaps a data entry error on my part is to blame, but when I try your
version I still get the warning, and I also get the following runtime
error because Perl can't resolve the reference to $self->SUPER::draw:

Can't locate object method "draw" via package "main" at ./test2.pl line
48, <DATA> line 191.

I agree that the "package MAIN;" is superfluous, but I think you need
the other one (unless you replace SUPER::draw with something more
specific, at which point I think your already-marginal succinctness
advantage goes out the window...)  Does this version work for you,
Marcus?

Jonathan


> -----Original Message-----
> From: Jason Stajich [mailto:jason.stajich at duke.edu] 
> Sent: Thursday, December 09, 2004 2:25 PM
> To: Crabtree, Jonathan
> Cc: Marcus Claesson; Bioperl list
> Subject: Re: [Bioperl-l] Can I get different Graphics::Panel 
> coloursfordifferent HSP frames within the same blast hit?
> 
> 
> 
> 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/
> 
>