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

[Marcus Claesson]

Yes it now works very well thanks. Excellent! I noticed the error
message with the -w flag but when removing it it disappeared. I guess I
should do without it then. 

Thanks!
Marcus

On Thu, 2004-12-09 at 19:44, Crabtree, Jonathan wrote:
> 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/
> > 
> > 
> 
> _______________________________________________
> Bioperl-l mailing list
> Bioperl-l at portal.open-bio.org
> http://portal.open-bio.org/mailman/listinfo/bioperl-l