[Bioperl-l] background layer is not supported in Bioperl 1.6 for Bio::Graphics::Glyph
Scott Cain
scott at scottcain.net
Fri Jun 19 03:30:37 UTC 2009
Actually, to be clear, that's bioperl-live and Bio::Graphics version
1.96 from CPAN.
On Thu, Jun 18, 2009 at 11:25 PM, Scott Cain<scott at scottcain.net> wrote:
> Hi Xianjun,
>
> The attached script (which is not too different from yours--I only did
> a little clean up and made the padding consistent) makes the attached
> image, which is what I think you want. I'm using bioperl-live.
>
> Scott
>
>
> On Thu, Jun 18, 2009 at 6:15 AM, Xianjun Dong<Xianjun.Dong at bccs.uib.no> wrote:
>> Hi, Scott,
>>
>> Do you mind to have a look of the code (below my signature) if I use the
>> -postgrid callback correctly?
>> I still cannnot get the background for the whole panel.
>>
>> Thanks
>>
>> Xianjun
>>
>>
>> Xianjun Dong wrote:
>>>
>>> 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?)
>>>
>>> THanks
>>>
>>> Xianjun
>>>
>>> ----------------------------------------------- mytestcode.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
>>> -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
>> ==========================================
>>
>>
>
>
>
> --
> ------------------------------------------------------------------------
> Scott Cain, Ph. D. scott at scottcain dot net
> GMOD Coordinator (http://gmod.org/) 216-392-3087
> Ontario Institute for Cancer Research
>
--
------------------------------------------------------------------------
Scott Cain, Ph. D. scott at scottcain dot net
GMOD Coordinator (http://gmod.org/) 216-392-3087
Ontario Institute for Cancer Research
More information about the Bioperl-l
mailing list