This glyph draws DNA sequences. At high magnifications, this glyph
will draw the actual base pairs of the sequence (both strands). At
low magnifications, the glyph will plot the GC content. By default,
the GC calculation will use non-overlapping bins, but this can be
changed by specifying the gc_window option, in which case, a
sliding window calculation will be used.
For this glyph to work, the feature must return a DNA sequence string
in response to the dna() method.
The following options are standard among all Glyphs. See
Bio::Graphics::Glyph for a full explanation.
Option Description Default
------ ----------- -------
-fgcolor Foreground color black
-outlinecolor Synonym for -fgcolor
-bgcolor Background color turquoise
-fillcolor Synonym for -bgcolor
-linewidth Line width 1
-height Height of glyph 10
-font Glyph font gdSmallFont
-connector Connector type 0 (false)
-connector_color
Connector color black
-label Whether to draw a label 0 (false)
-description Whether to draw a description 0 (false)
-hilite Highlight color undef (no color)
In addition to the common options, the following glyph-specific
options are recognized:
Option Description Default
------ ----------- -------
-do_gc Whether to draw the GC true
graph at low mags
-gc_window Size of the sliding window <none>
to use in the GC content
calculation. If this is
not defined, non-
overlapping bins will be
used. If this is set to
"auto", then the glyph will
choose a window equal to
1% of the interval.
-gc_bins Fixed number of intervals 100
to sample across the
panel.
-axis_color Color of the vertical axes fgcolor
in the GC content graph
-strand Show both forward and auto
reverse strand, one of
"forward", "reverse",
"both" or "auto".
In "auto" mode,
+1 strand features will
show the plus strand
-1 strand features will
show the reverse complement
and strandless features will
show both
NOTE: -gc_window=>'auto' gives nice results and is recommended for
drawing GC content. The GC content axes draw slightly outside the
panel, so you may wish to add some extra padding on the right and
left.
None available.
sub draw_component
{ my $self = shift;
my $gd = shift;
my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
my $dna = eval { $self->feature->seq };
$dna = $dna->seq if ref($dna) and $dna->can('seq'); $dna or return;
$dna = $dna->seq if ref($dna) && $dna->can('seq');
if ($self->dna_fits) {
$self->draw_dna($gd,$dna,$x1,$y1,$x2,$y2);
} elsif ($self->do_gc) {
$self->draw_gc_content($gd,$dna,$x1,$y1,$x2,$y2);
}} |
sub draw_dna
{ my $self = shift;
my ($gd,$dna,$x1,$y1,$x2,$y2) = @_;
my $pixels_per_base = $self->scale;
my $feature = $self->feature;
my $strand = $feature->strand || 1;
$strand *= -1 if $self->{flip};
my @bases = split '',$strand >= 0 ? $dna : $self->reversec($dna);
my $color = $self->fgcolor;
my $font = $self->font;
my $lineheight = $font->height;
$y1 -= $lineheight/2 - 3; my $strands = $self->option('strand') || 'auto';
my ($forward,$reverse);
if ($strands eq 'auto') {
$forward = $feature->strand >= 0;
$reverse = $feature->strand <= 0;
} elsif ($strands eq 'both') {
$forward = $reverse = 1;
} elsif ($strands eq 'reverse') {
$reverse = 1;
} else {
$forward = 1;
}
$x1 += $pixels_per_base - $font->width - 1 if $strand < 0;
for (my $i=0;$i<@bases;$i++) {
my $x = $x1 + $i * $pixels_per_base;
$gd->char($font,$x+2,$y1,$bases[$i],$color) if $forward;
$gd->char($font,$x+2,$y1+($forward ? $lineheight:0),
$complement{$bases[$i]}||$bases[$i],$color) if $reverse;
}} |
sub draw_gc_content
{ my $self = shift;
my $gd = shift;
my $dna = shift;
my ($x1,$y1,$x2,$y2) = @_;
my $bin_size = length($dna) / ($self->option('gc_bins') || 100); $bin_size = 10 if $bin_size < 10;
my $gc_window = $self->option('gc_window');
if ($gc_window && $gc_window eq 'auto' or $gc_window <= length($dna)) {
$gc_window = length($dna)/100; }
my @bins;
my @datapoints;
my $maxgc = -1000;
my $mingc = +1000;
if ($gc_window)
{
for (my $i=$gc_window/2; $i <= length($dna) - $gc_window/2; $i++)
{
my $subseq = substr($dna, $i-$gc_window/2, $gc_window); my $gc = $subseq =~ tr/gcGC/gcGC/;
my $content = $gc / $gc_window; push @datapoints, $content;
$maxgc = $content if ($content > $maxgc);
$mingc = $content if ($content < $mingc);
}
push @datapoints, 0.5 unless @datapoints;
my $scale = $maxgc - $mingc;
foreach (my $i; $i < @datapoints; $i++)
{
$datapoints[$i] = ($datapoints[$i] - $mingc) / $scale; }
$maxgc = int($maxgc * 100);
$mingc = int($mingc * 100);
}
else
{
for (my $i = 0; $i < length($dna) - $bin_size; $i+= $bin_size) {
my $subseq = substr($dna,$i,$bin_size);
my $gc = $subseq =~ tr/gcGC/gcGC/;
my $content = $gc/$bin_size; $maxgc = $content if ($content > $maxgc);
$mingc = $content if ($content < $mingc);
push @bins,$content;
}
my $scale = $maxgc - $mingc;
foreach (my $i; $i < @bins; $i++)
{
$bins[$i] = ($bins[$i] - $mingc) / $scale; }
$maxgc = int($maxgc * 100);
$mingc = int($mingc * 100);
}
push @bins,0.5 unless @bins; my $bin_width = ($x2-$x1)/@bins; my $bin_height = $y2-$y1;
my $fgcolor = $self->fgcolor;
my $bgcolor = $self->factory->translate_color($self->panel->gridcolor);
my $axiscolor = $self->color('axis_color') || $fgcolor;
my $fontwidth = $self->font->width;
$gd->line($x1, $y1, $x1, $y2, $axiscolor);
$gd->line($x2-2,$y1, $x2-2,$y2, $axiscolor);
$gd->line($x1, $y1, $x1+3,$y1, $axiscolor);
$gd->line($x1, $y2, $x1+3,$y2, $axiscolor);
$gd->line($x1, ($y2+$y1)/2,$x1+3,($y2+$y1)/2,$axiscolor);
$gd->line($x2-4,$y1, $x2-1, $y1, $axiscolor);
$gd->line($x2-4,$y2, $x2-1, $y2, $axiscolor);
$gd->line($x2-4,($y2+$y1)/2,$x2-1,($y2+$y1)/2,$axiscolor);
$gd->line($x1+5,$y2, $x2-5,$y2, $bgcolor);
$gd->line($x1+5,($y2+$y1)/2,$x2-5,($y2+$y1)/2,$bgcolor);
$gd->line($x1+5,$y1, $x2-5,$y1, $bgcolor);
$gd->string($self->font,$x1-length('% gc')*$fontwidth,$y1,'% gc',$axiscolor) if $bin_height > $self->font->height*2;
$gd->string($self->font,$x2+3,$y1,"${maxgc}%",$axiscolor)
if $bin_height > $self->font->height*2.5;
$gd->string($self->font,$x2+3,$y2-$self->font->height,"${mingc}%",$axiscolor)
if $bin_height > $self->font->height*2.5;
if ($gc_window)
{
my $graphwidth = $x2 - $x1;
my $scale = $graphwidth / @datapoints; my $gc_window_width = $gc_window/2 * $self->panel->scale; for (my $i = 1; $i < @datapoints; $i++)
{
my $x = $i + $gc_window_width;
my $xlo = $x1 + ($x - 1) * $scale;
my $xhi = $x1 + $x * $scale;
last if $xhi >= $self->panel->right-$gc_window_width;
my $y = $y2 - ($bin_height*$datapoints[$i]);
$gd->line($xlo, $y2 - ($bin_height*$datapoints[$i-1]),
$xhi, $y,
$fgcolor);
}
}
else
{
for (my $i = 0; $i < @bins; $i++)
{
my $bin_start = $x1+$i*$bin_width;
my $bin_stop = $bin_start + $bin_width;
my $y = $y2 - ($bin_height*$bins[$i]);
$gd->line($bin_start,$y,
$bin_stop,$y,
$fgcolor);
$gd->line($bin_stop,$y,
$bin_stop,$y2 - ($bin_height*$bins[$i+1]),
$fgcolor)
if $i < @bins-1;
}
} } |
Please report them.
Lincoln Stein <lstein@cshl.org>.
Sliding window GC calculation added by Peter Ashton <pda@sanger.ac.uk>.
Copyright (c) 2001 Cold Spring Harbor Laboratory
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.