[Bioperl-l] background layer is not supported in Bioperl 1.6 for Bio::Graphics::Glyph

Xianjun Dong Xianjun.Dong at bccs.uib.no
Sat Jun 13 16:48:16 UTC 2009


Hi, Scott

Before I gave up my own whole solution to use GBrowse, I still want to 
bother you once:

As you suggested, I put -postgrid option when the panel, which will call 
a function to draw the background. The code below is almost copied from 
the online POD of Bio::Graphics::Panel (see 
http://doc.bioperl.org/releases/bioperl-current/bioperl-live/Bio/Graphics/Panel.html 
)

But it still does not work. Could you help to have a look? I paste it 
below. (BTW, the above page of POD, the -postgrid=>\&draw_gap, while the 
gap drawing function is gap_it, not draw_gap. I guess it's a typo. or not?)

  my $panel = *Bio::Graphics::Panel*->new(-segment=>$segment,
                                        -grid=>1,
                                        -width=>600,
                                        -postgrid=> \&draw_gap);
  sub gap_it {
     my $gd    = shift;
     my $panel = shift;
     my ($gap_start,$gap_end) = $panel->location2pixel(500,600);
     my $top                  = $panel->top;
     my $bottom               = $panel->bottom;
     my $gray                 = $panel->translate_color('gray');
     $gd->filledRectangle($gap_start,$top,$gap_end,$bottom,$gray);
}

THanks

Xianjun

-----------------------------------------------

#!/usr/bin/perl
 
use strict;
use lib "$ENV{HOME}/lib";
 
use Bio::Graphics;
use Bio::Graphics::Feature;
my $ftr= 'Bio::Graphics::Feature';
 
# processed_transcript
my $trans1 = 
$ftr->new(-start=>50,-end=>10,-name=>'ZK154.1',-type=>"3'-UTR");
my $trans2 = $ftr->new(-start=>100,-end=>50,-name=>'ZK154.2',-type=>'CDS');
my $trans3 = 
$ftr->new(-start=>350,-end=>225,-name=>'ZK154.3',-type=>'CDS', 
-source=>'a');
my $trans4 = 
$ftr->new(-start=>650,-end=>500,-name=>'ZK154.3',-type=>'CDS', 
-source=>'a');
my $trans5 = 
$ftr->new(-start=>700,-end=>650,-name=>'ZK154.3',-type=>"5'-UTR");
my $trans  = 
$ftr->new(-segments=>[$trans1,$trans2,$trans3,$trans4,$trans5]);

# hightlight
my $trans31 = 
$ftr->new(-start=>240,-end=>450,-name=>'hightlight1',-type=>'background', 
-source=>'a');
my $trans41 = 
$ftr->new(-start=>650,-end=>600,-name=>'hightlight2',-type=>'multihourglass', 
-source=>'b');
 
my $panel= Bio::Graphics::Panel->new(-width=>1200,
                                             -length=>1050,
                                             -start =>0,
                                             -pad_left=>12,
                                             -pad_right=>12
                                             -postgrid=>\&gap_it);

sub gap_it {
     my $gd    = shift;
     my $panel = shift;
     my ($gap_start,$gap_end) = $panel->location2pixel(500,600);
     my $top                  = $panel->top;
     my $bottom               = $gd->height, #panel->bottom;
     my $gray                 = $panel->translate_color('red');
     $gd->filledRectangle($gap_start,$top,$gap_end,$bottom,$gray);
}
# the following track works as I expected in bioperl 1.2.3, but not in 
1.5 and 1.6
#$panel->add_track([$trans41,$trans31],
#          -glyph   => 'background',
#                  -block_bgcolor => sub{return (shift->source eq 
'a')?'#cccccc':'#fffc22'},
#                  );

$panel->add_track($ftr->new(-start=>100,-end=>1000),
                  -glyph=>'arrow',
                  -double=>1,
                  -tick=>2);

$panel->add_track($trans,
          -glyph   => 'transcript2', # 'transcript2', #process_5utr',
                  -fgcolor => 'darkred',
                  -bgcolor => 'darkred',
                  -title => '$source',
                  -link => 
'http://www.ensembl.org/Homo_sapiens/transview?transcript=$name',  #EnsEMBL
                  );
   
print $panel->png;

# the following part works in bioperl 1.5 and 1.6, but not work in 
Bioperl 1.2.3
my $map = $panel->create_web_map("image");
$panel->finished();










Scott Cain wrote:
> Hi Xianjun,
>
> I understand what you want to do, as the current version of gbrowse
> does this, which uses bioperl 1.6.  Without digging through the code,
> I can't tell you exactly how this works and you didn't send your code
> that uses this callback, so I can't try it either.
>
> One thing that is different between your code and gbrowse is that each
> of the tracks is actually a seperate panel (to allow track dragging),
> so it possible that this sort of callback doesn't work for
> Bio::Graphics any more.
>
> Scott
>
> On Saturday, June 13, 2009, Xianjun Dong <Xianjun.Dong at bccs.uib.no> wrote:
>   
>> Hi, Scott
>>
>> Thanks for your reply first.
>>
>> I still have question: I dig out the code from GBrowse (which I paste below). Method make_postgrid_callback gets all highlight region and then use hilite_regions_closure function to draw them out, using the following GD function:
>>
>> $gd->filledRectangle($left+$start,0,$left+$end,$bottom,
>>                           $panel->translate_color($h_color));
>>
>> where the $bottom=$panel->bottom. This is the only difference from my code, where I use $gd->height. I guess they are almost same (except the pad_bottom), we can see this in the code of http://doc.bioperl.org/releases/bioperl-current/bioperl-live/Bio/Graphics/Panel.html#CODE22
>>
>> OK. Anyway, I change to use $panel->bottom, instead of $gd->height, for my highlight regions. The output is same, when using the library of Bioperl 1.6 (or 1.5). You can see the attached image ("test.bioperl1.6.png")
>>
>> OK. I might have not explained my question explicitly. My question is: if using bioperl 1.2.3 (actually the Bio::Graphics in bioperl 1.2.3), I can get the right image I want (see the attached file "test.bioperl1.2.3.png"), where the highlight range will go from the roof to the floor. While in bioperl 1.5 (or 1.6), I only can see the highlight region in its own track, not the whole panel. OK, did I explain clearly now? you can see the difference of the two images.
>>
>> [I am not sure the mailist allow to attach image, otherwise, I put them in the following links:
>> test.bioperl1.6.png:    http://translog.genereg.net/test.bioperl1.6.png
>> test.bioperl1.2.3.png:    http://translog.genereg.net/test.bioperl1.2.3.png ]
>>
>> You can test it and see the difference if you have both 1.2.3 and 1.6 on your computer?
>>
>> Really want to know how this works in bioperl 1.2.3 (Even though this might be a bug at that version, or whatever)
>>
>> Thanks
>>
>> Xianjun
>> =============================================
>>
>> # this generates the callback for highlighting a region
>> sub make_postgrid_callback {
>>  my $settings = shift;
>>  return unless ref $settings->{h_region};
>>
>>  my @h_regions = map {
>>    my ($h_ref,$h_start,$h_end,$h_color) = /^(.+):(\d+)\.\.(\d+)(?:@(\S+))?/;
>>    defined($h_ref) && $h_ref eq $settings->{ref}
>>                 ? [$h_start,$h_end,$h_color||'lightgrey']
>>                 : ()
>>  }
>>    @{$settings->{h_region}};
>>
>>  return unless @h_regions;
>>  return hilite_regions_closure(@h_regions);
>> }
>>
>> # this subroutine generates a Bio::Graphics::Panel callback closure
>> # suitable for hilighting a region of a panel.
>> # The args are a list of [start,end,color]
>> sub hilite_regions_closure {
>>  my @h_regions = @_;
>>
>>  return sub {
>>    my $gd     = shift;
>>    my $panel  = shift;
>>    my $left   = $panel->pad_left;
>>    my $top    = $panel->top;
>>    my $bottom = $panel->bottom;
>>    for my $r (@h_regions) {
>>      my ($h_start,$h_end,$h_color) = @$r;
>>      my ($start,$end) = $panel->location2pixel($h_start,$h_end);
>>      if ($end-$start <= 1) { $end++; $start-- } # so that we always see something
>>      # assuming top is 0 so as to ignore top padding
>>      $gd->filledRectangle($left+$start,0,$left+$end,$bottom,
>>                           $panel->translate_color($h_color));
>>    }
>>  };
>> }
>>
>>
>> Scott Cain wrote:
>>
>> Hello Xianjun,
>>
>> I don't think that approach will work.  What you almost certainly need
>> to do is a postgrid callback that does the drawing of the highlighted
>> region.  For example code of how to do this, take a look at the
>> make_postgrid_callback subroutine in GBrowse 1.69.  The option
>> -postgrid is a method of Bio::Graphics::Panel.
>>
>> Scott
>>
>>
>>
>>
>> On Fri, Jun 12, 2009 at 4:38 PM, Xianjun Dong<Xianjun.Dong at bccs.uib.no> wrote:
>>
>>
>> HI,
>>
>> I am not sure this is the right place I can get help.
>>
>> I've suffered by a problem for several days: I want to highlight parts of
>> regions in my track, using a different background color. To do that, I
>> defined a glyph named "background", based on the
>> 'Bio::Graphics::Glyph::generic' module. I override the draw_component()
>> method, by adding code like below:
>>
>> $gd->filledRectangle($left,0,$right,$gd->height,
>> $self->factory->translate_color($color));
>>
>> # the script is pasted at the end
>>
>> This will draw a rectangle with top=0, bottom=$gd->height. I made the
>> highlight regions into a list of features, and add_track with
>> -glyph=>'background'. (see the following script, test.pl) This really works
>> as I expect, which will add a colored block at background of all tracks in a
>> panel (including the ruler arrow). You can see the output image in attached
>> file "test.bioperl1.2.3.png"
>>
>> Now, the problem comes: when I switch to Bioperl 1.5 (or 1.6), it does not
>> work. Well, it works, but the highlight part only shrink to a low height,
>> instead of covering all tracks in the panel. I also attached the output
>> here, see the file "test.bioperl1.6.png".
>>
>> I tried to think about the reason, the 'background' module is based on the
>> generic module. What can cause the difference? Is it because $gd->height is
>> different, or the tracks followed with 'background' track can not draw from
>> the first position?
>>
>> Well. I can stick to use Bioperl 1.2.3 to avoid the problem. ("Smart person
>> solve problem, wise person avoid problem"...) But another problem is coming:
>> Bio::Graphics in Bioperl 1.2.3 does not support $panel->create_web_map()
>> function, which means I have to use some higher version if I want to create
>> web map for my graphics, but then I have to give up using highlight
>> background.
>>
>> OK. It's long enough for my first-time submission here. Hope someone can
>> throw me some clue.
>>
>> Thanks ahead!!
>>
>> Xianjun
>>
>>
>> ==================== test.pl =======================
>> #!/usr/bin/perl
>>
>> use strict;
>> use lib "$ENV{HOME}/lib";
>>
>> use Bio::Graphics;
>> use Bio::Graphics::Feature;
>> my $ftr= 'Bio::Graphics::Feature';
>>
>> # processed_transcript
>> my $trans1 =
>> $ftr->new(-start=>50,-end=>10,-name=>'ZK154.1',-type=>"3'-UTR");
>> my $trans2 = $ftr->new(-start=>100,-end=>50,-name=>'ZK154.2',-type=>'CDS');
>> my $trans3 = $ftr->new(-start=>350,-end=>225,-name=>'ZK154.3',-type=>'CDS',
>> -source=>'a');
>> my $trans4 = $ftr->new(-start=>650,-end=>500,-name=>'ZK154.3',-type=>'CDS',
>> -source=>'a');
>> my $trans5 =
>> $ftr->new(-start=>700,-end=>650,-name=>'ZK154.3',-type=>"5'-UTR");
>> my $trans  =
>> $ftr->new(-segments=>[$trans1,$trans2,$trans3,$trans4,$trans5]);
>>
>> # hightlight
>> my $trans31 =
>> $ftr->new(-start=>240,-end=>450,-name=>'hightlight1',-type=>'background',
>> -source=>'a');
>> my $trans41 =
>> $ftr->new(-start=>650,-end=>600,-name=>'hightlight2',-type=>'multihourglass',
>> -source=>'b');
>>
>> my $panel= Bio::Graphics::Panel->new(-width=>1200,
>>                                            -length=>1050,
>>                                            -start =>0,
>>                                            -pad_left=>12,
>>                                            -pad_right=>12);
>>
>> # the following track works as I expected in bioperl 1.2.3, but not in 1.5
>> and 1.6
>> $panel->add_track([$trans41,$trans31],
>>         -glyph   => 'background',
>>                 -block_bgcolor => sub{return (shift->source eq
>> 'a')?'#cccccc':'#fffc22'},
>>                 );
>>
>> $panel->add_track($ftr->new(-start=>100,-end=>1000),
>>                 -glyph=>'arrow',
>>                 -double=>1,
>>                 -tick=>2);
>>
>> $panel->add_track($trans,
>>         -glyph   => 'transcript2', # 'transcript2', #process_5utr',
>>                 -fgcolor => 'darkred',
>>                 -bgcolor => 'darkred',
>>                 -title => '$source',
>>                 -link =>
>> 'http://www.ensembl.org/Homo_sapiens/transview?transcript=$name',  #EnsEMBL
>>                 );
>>  print $panel->png;
>>
>> # the following part works in bioperl 1.5 and 1.6, but not work in Bioperl
>> 1.2.3
>> my $map = $panel->create_web_map("image");
>> $panel->finished();
>>
>> 1;
>>
>> ==================== background.pm =======================
>> package Bio::Graphics::Glyph::background;
>>
>> use strict;
>> use base 'Bio::Graphics::Glyph::generic';
>> sub pad_top{
>>  return 0;
>> }
>>
>> sub draw_component {
>>  my $self = shift;
>>  #$self->SUPER::draw_component(@_);
>>  my ($gd,$dx,$dy) = @_;
>>  my ($left,$top,$right,$bottom) = $self->bounds($dx,$dy);
>>
>>  # draw an arrow to indicate the direction of transcript
>>  my $color = $self->option('block_bgcolor') || '#cccccc';
>>  $gd->filledRectangle($left,0,$right,$gd->height,
>> $self->factory->translate_color($color));
>> }
>>
>> 1;
>>
>> --
>> ==========================================
>> Xianjun Dong
>> PhD student, Lenhard group
>> Computational Biology Unit
>> Bergen Center for Computational Science
>> University of Bergen
>> Hoyteknologisenteret, Thormohlensgate 55
>> N-5008 Bergen, Norway
>> E-mail: xianjun.dong at bccs.uib.no
>> Tel.: +47 555 84022
>> Fax : +47 555 84295
>> ==========================================
>>
>>
>> _______________________________________________
>> Bioperl-l mailing list
>> Bioperl-l at lists.open-bio.org
>> http://lists.open-bio.org/mailman/listinfo/bioperl-l
>>
>>
>>
>>
>>
>>
>>
>>
>>
>> --
>> ==========================================
>> Xianjun Dong
>> PhD student, Lenhard group
>> Computational Biology Unit
>> Bergen Center for Computational Science
>> University of Bergen
>> Hoyteknologisenteret, Thormohlensgate 55
>> N-5008 Bergen, Norway
>> E-mail: xianjun.dong at bccs.uib.no
>> Tel.: +47 555 84022
>> Fax : +47 555 84295
>> ==========================================
>>
>>
>>     
>
>   

-- 
==========================================
Xianjun Dong
PhD student, Lenhard group
Computational Biology Unit
Bergen Center for Computational Science
University of Bergen
Hoyteknologisenteret, Thormohlensgate 55
N-5008 Bergen, Norway
E-mail: xianjun.dong at bccs.uib.no
Tel.: +47 555 84022
Fax : +47 555 84295
==========================================




More information about the Bioperl-l mailing list