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

[Jason Stajich]

Ah right - wasn't really looking at the code in the method - if you 
want to call SUPER then you would need to declare the package as you 
did (and then later reset the package to MAIN) I guess.  So ignore 
me... Sorry.

-jason
On Dec 9, 2004, at 2:44 PM, 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
>
>
--
Jason Stajich
jason.stajich at duke.edu
http://www.duke.edu/~jes12/