Skip to content
  • 10 commits
  • 12 files changed
  • 0 commit comments
  • 1 contributor
View
2 MANIFEST
@@ -97,7 +97,7 @@ lib/Bio/Graphics/Glyph/weighted_arrow.pm
lib/Bio/Graphics/Glyph/whiskerplot.pm
lib/Bio/Graphics/Glyph/wiggle_box.pm
lib/Bio/Graphics/Glyph/wiggle_density.pm
-lib/Bio/Graphics/Glyph/wiggle_minmax.pm
+lib/Bio/Graphics/Glyph/wiggle_data.pm
lib/Bio/Graphics/Glyph/wiggle_whiskers.pm
lib/Bio/Graphics/Glyph/wiggle_xyplot.pm
lib/Bio/Graphics/Glyph/xyplot.pm
View
3 lib/Bio/Graphics/Glyph.pm
@@ -689,7 +689,8 @@ sub hbumppad {
sub default_opacity {
my $self = shift;
return $self->{default_opacity} if defined $self->{default_opacity};
- return $self->{default_opacity} = $self->option('opacity') || 0;
+ my $o = $self->option('opacity');
+ return $self->{default_opacity} = defined $o ? $o : 1.0;
}
# we also look for the "color" option for Ace::Graphics compatibility
View
3 lib/Bio/Graphics/Glyph/generic.pm
@@ -144,6 +144,7 @@ sub font {
sub fontcolor {
my $self = shift;
my $fontcolor = $self->color('labelcolor') || $self->color('fontcolor');
+ warn "opacity = ",$self->default_opacity;
return defined $fontcolor ? $fontcolor : $self->fgcolor;
}
sub font2color {
@@ -460,6 +461,8 @@ sub draw_label {
local $self->{default_opacity} = 1;
my $x = $self->left + $left; # valid for both "top" and "left" because the left-hand side is defined by pad_left
+ warn "draw_label = ",$self->label, ' position = ',$self->label_position," x = $x";
+
my $font = $self->labelfont;
if ($self->label_position eq 'top') {
$x += $self->pad_left; # offset to beginning of the drawn part of the feature
View
12 lib/Bio/Graphics/Glyph/track.pm
@@ -34,6 +34,18 @@ sub draw {
# give the glyph a chance to do track-wide normalization if it supports it
$self->normalize_track(@parts);
+ # dynamic assignment of colors
+ if ($self->option('color_series')) {
+ my @color_series = qw(aqua black blue fuchsia gray green lime maroon navy olive purple red silver teal yellow magenta);
+ my $index = 0;
+ my %color_cache;
+ my $closure = sub {
+ my $glyph = pop;
+ return $color_cache{$glyph} ||= $color_series[$index++ % @color_series];
+ };
+ $self->configure(bgcolor => $closure);
+ }
+
for (my $i=0; $i<@parts; $i++) {
$parts[$i]->draw_highlight($gd,$left,$top);
$parts[$i]->draw($gd,$left,$top,0,1);
View
18 lib/Bio/Graphics/Glyph/vista_plot.pm
@@ -1,7 +1,7 @@
package Bio::Graphics::Glyph::vista_plot;
use strict;
-use base qw(Bio::Graphics::Glyph::wiggle_minmax
+use base qw(Bio::Graphics::Glyph::wiggle_data
Bio::Graphics::Glyph::wiggle_xyplot
Bio::Graphics::Glyph::wiggle_density
Bio::Graphics::Glyph::wiggle_whiskers
@@ -46,8 +46,8 @@ sub my_options {
'vista',
"What to show, peaks or signal, both (vista plot) or density graph."],
graph_type => [
- ['whiskers','histogram','boxes','line','points','linepoints'],
- 'boxes',
+ ['whiskers','histogram','line','points','linepoints'],
+ 'histogram',
"Type of signal graph to show."],
alpha => [
'integer',
@@ -158,13 +158,16 @@ sub draw {
peak => (eval{$feature->get_tag_values('peak_type')})[0],
fasta=> (eval{$feature->get_tag_values('fasta')})[0]);
$self->panel->startGroup($gd);
+ warn "$only_show";
+ $self->configure(opacity => 0.5) if $only_show eq 'vista';
$self->draw_signal($only_show,\%features,@_) if $only_show =~ /signal|density|vista/;
- $self->draw_peaks(\%features,@_) if $features{peak} && $only_show =~ /peaks|vista|both/;
+ $self->draw_peaks(\%features,@_) if $features{peak} && $only_show =~ /peaks|vista/;
$self->Bio::Graphics::Glyph::xyplot::draw_label(@_) if $self->option('label');
$self->draw_description(@_) if $self->option('description');
$self->panel->endGroup($gd);
}
+# this should be refactored from wiggle_xyplot and wiggle_density
sub draw_signal {
my $self = shift;
my $signal_type = shift;
@@ -176,8 +179,8 @@ sub draw_signal {
if ($paths->{wig} && $paths->{wig}=~/\.wi\w{1,3}$/) {
eval "require Bio::Graphics::Wiggle" unless Bio::Graphics::Wiggle->can('new');
my $wig = eval { Bio::Graphics::Wiggle->new($paths->{wig}) };
- $self->wig($paths->{wig});
- $self->draw_wigfile($feature,$self->wig($wig),@_);
+ $self->wig($wig);
+ $self->_draw_wigfile($feature,$wig,@_);
} elsif ($paths->{wig} && $paths->{wig}=~/\.bw$/i) {
eval "use Bio::DB::BigWig 'binMean'" unless Bio::DB::BigWig->can('new');
my @args = (-bigwig => "$paths->{wig}");
@@ -188,6 +191,7 @@ sub draw_signal {
push @args,(-fasta => $fasta_accessor);
}
my $bigwig = Bio::DB::BigWig->new(@args);
+ $self->wig($bigwig);
my ($summary) = $bigwig->features(-seq_id => $feature->segment->ref,
-start => $self->panel->start,
-end => $self->panel->end,
@@ -203,7 +207,7 @@ sub draw_signal {
if ($signal_type eq 'density') {
$self->Bio::Graphics::Glyph::wiggle_density::draw_coverage($summary,\@vals,@_);
} else {
- $self->Bio::Graphics::Glyph::wiggle_xyplot::draw_coverage($summary,\@vals,@_);
+ $self->Bio::Graphics::Glyph::wiggle_data::_draw_coverage($summary,\@vals,@_);
}
}
}
View
436 lib/Bio/Graphics/Glyph/wiggle_data.pm
@@ -0,0 +1,436 @@
+package Bio::Graphics::Glyph::wiggle_data;
+
+use strict;
+use base qw(Bio::Graphics::Glyph::minmax);
+use File::Spec;
+
+sub minmax {
+ my $self = shift;
+ my $parts = shift;
+
+ my $autoscale = $self->option('autoscale') || 'local';
+
+ my $min_score = $self->min_score unless $autoscale eq 'z_score';
+ my $max_score = $self->max_score unless $autoscale eq 'z_score';
+
+ my $do_min = !defined $min_score;
+ my $do_max = !defined $max_score;
+
+ if (@$parts && $self->feature->can('statistical_summary')) {
+ my ($min,$max,$mean,$stdev) = eval {$self->bigwig_stats($autoscale,$self->feature)};
+ $min_score = $min if $do_min;
+ $max_score = $max if $do_max;
+ return $self->sanity_check($min_score,$max_score,$mean,$stdev);
+ }
+
+ elsif (eval {$self->wig}) {
+ if (my ($min,$max,$mean,$stdev) = eval{$self->wig_stats($autoscale,$self->wig)}) {
+ $min_score = $min if $do_min;
+ $max_score = $max if $do_max;
+ return $self->sanity_check($min_score,$max_score,$mean,$stdev);
+ }
+ }
+
+ if ($do_min or $do_max) {
+ my $first = $parts->[0];
+ for my $part (@$parts) {
+ my $s = ref $part ? $part->[2] : $part;
+ next unless defined $s;
+ $min_score = $s if $do_min && (!defined $min_score or $s < $min_score);
+ $max_score = $s if $do_max && (!defined $max_score or $s > $max_score);
+ }
+ }
+ return $self->sanity_check($min_score,$max_score);
+}
+
+sub bigwig_stats {
+ my $self = shift;
+ my ($autoscale,$feature) = @_;
+ my $s;
+ if ($autoscale =~ /global/ or $autoscale eq 'z_score') {
+ $s = $feature->global_stats;
+ } elsif ($autoscale eq 'chromosome') {
+ $s = $feature->chr_stats;
+ } else {
+ $s = $feature->score;
+ }
+ return $self->clip($autoscale,
+ $s->{minVal},$s->{maxVal},Bio::DB::BigWig::binMean($s),Bio::DB::BigWig::binStdev($s));
+}
+
+sub wig_stats {
+ my $self = shift;
+ my ($autoscale,$wig) = @_;
+
+ if ($autoscale =~ /global|chromosome|z_score/) {
+ my $min_score = $wig->min;
+ my $max_score = $wig->max;
+ my $mean = $wig->mean;
+ my $stdev = $wig->stdev;
+ return $self->clip($autoscale,$min_score,$max_score,$mean,$stdev);
+ } else {
+ return;
+ }
+}
+
+sub clip {
+ my $self = shift;
+ my ($autoscale,$min,$max,$mean,$stdev) = @_;
+ return ($min,$max,$mean,$stdev) unless $autoscale =~ /clipped/;
+ my $fold = $self->z_score_bound;
+ my $clip_max = $mean + $stdev*$fold;
+ my $clip_min = $mean - $stdev*$fold;
+ $min = $clip_min if $min < $clip_min;
+ $max = $clip_max if $max > $clip_max;
+ return ($min,$max,$mean,$stdev);
+}
+
+
+sub z_score_bound {
+ my $self = shift;
+ return $self->option('z_score_bound') || 4;
+}
+
+# change the scaling of the data points if z-score autoscaling requested
+sub rescale {
+ my $self = shift;
+ my $points = shift;
+ return $points unless $self->option('autoscale') eq 'z_score';
+
+ my ($min,$max,$mean,$stdev) = $self->minmax($points);
+ foreach (@$points) {
+ $_ = ($_ - $mean) / $stdev;
+ }
+ return $points;
+}
+
+sub global_mean_and_variance {
+ my $self = shift;
+ if (my $wig = $self->wig) {
+ return ($wig->mean,$wig->stdev);
+ } elsif ($self->feature->can('global_mean')) {
+ my $f = $self->feature;
+ return ($f->global_mean,$f->global_stdev);
+ }
+ return;
+}
+
+sub global_min_max {
+ my $self = shift;
+ if (my $wig = $self->wig) {
+ return ($wig->min,$wig->max);
+ } elsif (my $stats = eval {$self->feature->global_stats}) {
+ return ($stats->{minVal},$stats->{maxVal});
+ }
+ return;
+}
+sub series_stdev {
+ my $self = shift;
+ my ($mean,$stdev) = $self->global_mean_and_variance;
+ return $stdev;
+}
+
+sub series_mean {
+ my $self = shift;
+ my ($mean) = $self->global_mean_and_variance;
+ return $mean;
+}
+
+sub series_min {
+ my $self = shift;
+ return ($self->global_min_max)[0];
+}
+
+sub series_max {
+ my $self = shift;
+ return ($self->global_min_max)[1];
+}
+
+sub wig {
+ my $self = shift;
+ my $d = $self->{wig};
+ $self->{wig} = shift if @_;
+ $d;
+}
+
+sub datatype {
+ my $self = shift;
+ my $feature = $self->feature;
+ my ($tag,$value);
+
+ for my $t ('wigfile','wigdata','densefile','coverage') {
+ if (my ($v) = eval{$feature->get_tag_values($t)}) {
+ $value = $v;
+ $tag = $t;
+ last;
+ }
+ }
+ unless ($value) {
+ $tag = 'statistical_summary';
+ $value = eval{$feature->statistical_summary};
+ }
+ $tag ||= 'generic';
+ return wantarray ? ($tag,$value) : $tag;
+}
+
+sub get_parts {
+ my $self = shift;
+ my $feature = $self->feature;
+ my ($start,$end) = $self->effective_bounds($feature);
+ my ($datatype,$data) = $self->datatype;
+
+ return $self->subsample($data,$start,$end) if $datatype eq 'wigdata';
+ return $self->create_parts_from_wigfile($data,$start,$end) if $datatype eq 'wigfile';
+ return $self->create_parts_for_dense_feature($data,$start,$end) if $datatype eq 'densefile';
+ return $self->create_parts_from_coverage($data,$start,$end) if $datatype eq 'coverage';
+ return $self->create_parts_from_summary($data,$start,$end) if $datatype eq 'statistical_summary';
+ return [];
+}
+
+sub effective_bounds {
+ my $self = shift;
+ my $feature = shift;
+ my $panel_start = $self->panel->start;
+ my $panel_end = $self->panel->end;
+ my $start = $feature->start>$panel_start
+ ? $feature->start
+ : $panel_start;
+ my $end = $feature->end<$panel_end
+ ? $feature->end
+ : $panel_end;
+ return ($start,$end);
+}
+
+sub create_parts_for_dense_feature {
+ my $self = shift;
+ my ($dense,$start,$end) = @_;
+
+ my $span = $self->scale> 1 ? $end - $start : $self->width;
+ my $data = $dense->values($start,$end,$span);
+ my $points_per_span = ($end-$start+1)/$span;
+ my @parts;
+
+ for (my $i=0; $i<$span;$i++) {
+ my $offset = $i * $points_per_span;
+ my $value = shift @$data;
+ next unless defined $value;
+ push @parts,[$start + int($i * $points_per_span),
+ $start + int($i * $points_per_span),
+ $value];
+ }
+ return \@parts;
+}
+
+sub create_parts_from_coverage {
+ my $self = shift;
+ my ($array,$start,$end) = @_;
+ $array = [split ',',$array] unless ref $array;
+ return unless @$array;
+
+ my $bases_per_bin = ($end-$start)/@$array;
+ my $pixels_per_base = $self->scale;
+ my @parts;
+ for (my $pixel=0;$pixel<$self->width;$pixel++) {
+ my $offset = $pixel/$pixels_per_base;
+ my $s = $start + $offset;
+ my $e = $s+1; # fill in gaps
+ my $v = $array->[$offset/$bases_per_bin];
+ push @parts,[$s,$s,$v];
+ }
+ return \@parts;
+}
+
+sub create_parts_from_summary {
+ my $self = shift;
+ my ($stats,$start,$end) = @_;
+ $stats ||= [];
+ my @vals = map {$_->{validCount} ? $_->{sumData}/$_->{validCount}:0} @$stats;
+ return \@vals;
+}
+
+sub create_parts_from_wigfile {
+ my $self = shift;
+ my ($path,$start,$end) = @_;
+ $path = $self->rel2abs($path);
+ if ($path =~ /\.wi\w{1,3}$/) {
+ eval "require Bio::Graphics::Wiggle" unless Bio::Graphics::Wiggle->can('new');
+ my $wig = eval { Bio::Graphics::Wiggle->new($path)};
+ return $self->create_parts_for_dense_feature($wig,$start,$end);
+ } elsif ($path =~ /\.bw$/i) {
+ eval "use Bio::DB::BigWig" unless Bio::DB::BigWig->can('new');
+ my $bigwig = Bio::DB::BigWig->new(-bigwig=>$path);
+ my ($summary) = $bigwig->features(-seq_id => $self->feature->segment->ref,
+ -start => $start,
+ -end => $end,
+ -type => 'summary');
+ return $self->create_parts_from_summary($summary->statistical_summary($self->width));
+ }
+}
+
+sub subsample {
+ my $self = shift;
+ my ($data,$start,$end) = @_;
+ my $span = $self->scale > 1 ? $end - $start
+ : $self->width;
+ my $points_per_span = ($end-$start+1)/$span;
+ my @parts;
+ for (my $i=0; $i<$span;$i++) {
+ my $offset = $i * $points_per_span;
+ my $value = $data->[$offset + $points_per_span/2];
+ push @parts,[$start + int($i*$points_per_span),
+ $start + int($i*$points_per_span),
+ $value];
+ }
+ return \@parts;
+}
+
+sub rel2abs {
+ my $self = shift;
+ my $wig = shift;
+ return $wig if ref $wig;
+ my $path = $self->option('basedir');
+ return File::Spec->rel2abs($wig,$path);
+}
+
+sub draw {
+ my $self = shift;
+ my ($gd,$dx,$dy) = @_;
+
+ my $feature = $self->feature;
+ my $datatype = $self->datatype;
+
+ my $retval;
+ $retval = $self->draw_wigfile($feature,@_) if $datatype eq 'wigfile';
+ $retval = $self->draw_wigdata($feature,@_) if $datatype eq 'wigdata';
+ $retval = $self->draw_densefile($feature,@_) if $datatype eq 'densefile';
+ $retval = $self->draw_coverage($feature,@_) if $datatype eq 'coverage';
+ $retval = $self->draw_statistical_summary($feature,@_) if $datatype eq 'statistical_summary';
+ $retval = $self->SUPER::draw(@_) if $datatype eq 'generic';
+
+ return $retval;
+}
+
+sub draw_wigfile {
+ my $self = shift;
+ my $feature = shift;
+
+ my ($wigfile) = eval{$feature->get_tag_values('wigfile')};
+ $wigfile = $self->rel2abs($wigfile);
+
+ eval "require Bio::Graphics::Wiggle" unless Bio::Graphics::Wiggle->can('new');
+ my $wig = ref $wigfile && $wigfile->isa('Bio::Graphics::Wiggle')
+ ? $wigfile
+ : eval { Bio::Graphics::Wiggle->new($wigfile) };
+ unless ($wig) {
+ warn $@;
+ return $self->SUPER::draw(@_);
+ }
+ $self->_draw_wigfile($feature,$wig,@_);
+}
+
+sub draw_wigdata {
+ my $self = shift;
+ my $feature = shift;
+
+ my ($data) = eval{$feature->get_tag_values('wigdata')};
+
+ if (ref $data eq 'ARRAY') {
+ my ($start,$end) = $self->effective_bounds($feature);
+ my $parts = $self->subsample($data,$start,$end);
+ $self->draw_plot($parts,@_);
+ }
+
+ else {
+ my $wig = eval { Bio::Graphics::Wiggle->new() };
+ unless ($wig) {
+ warn $@;
+ return $self->SUPER::draw(@_);
+ }
+
+ $wig->import_from_wif64($data);
+ $self->_draw_wigfile($feature,$wig,@_);
+ }
+}
+
+sub draw_densefile {
+ my $self = shift;
+ my $feature = shift;
+
+ my ($densefile) = eval{$feature->get_tag_values('densefile')};
+ $densefile = $self->rel2abs($densefile);
+
+ my ($denseoffset) = eval{$feature->get_tag_values('denseoffset')};
+ my ($densesize) = eval{$feature->get_tag_values('densesize')};
+ $denseoffset ||= 0;
+ $densesize ||= 1;
+
+ my $smoothing = $self->get_smoothing;
+ my $smooth_window = $self->smooth_window;
+ my $start = $self->smooth_start;
+ my $end = $self->smooth_end;
+
+ my $fh = IO::File->new($densefile) or die "can't open $densefile: $!";
+ eval "require Bio::Graphics::DenseFeature" unless Bio::Graphics::DenseFeature->can('new');
+ my $dense = Bio::Graphics::DenseFeature->new(-fh=>$fh,
+ -fh_offset => $denseoffset,
+ -start => $feature->start,
+ -smooth => $smoothing,
+ -recsize => $densesize,
+ -window => $smooth_window,
+ ) or die "Can't initialize DenseFeature: $!";
+ my $parts = $self->get_parts;
+ $self->draw_plot($parts);
+}
+
+sub draw_coverage {
+ my $self = shift;
+ my $feature = shift;
+
+ my ($array) = eval{$feature->get_tag_values('coverage')};
+ $self->_draw_coverage($feature,$array,@_);
+}
+
+sub draw_statistical_summary {
+ my $self = shift;
+ my $feature = shift;
+ my $stats = $feature->statistical_summary($self->width);
+ $stats ||= [];
+ my @vals = map {$_->{validCount} ? $_->{sumData}/$_->{validCount}:0} @$stats;
+ return $self->_draw_coverage($feature,\@vals,@_);
+}
+
+sub _draw_coverage {
+ my $self = shift;
+ my $feature = shift;
+ my $array = shift;
+
+ $array = [split ',',$array] unless ref $array;
+ return unless @$array;
+
+ my ($start,$end) = $self->effective_bounds($feature);
+ my $bases_per_bin = ($end-$start)/@$array;
+ my $pixels_per_base = $self->scale;
+ my @parts;
+ for (my $pixel=0;$pixel<$self->width;$pixel++) {
+ my $offset = $pixel/$pixels_per_base;
+ my $s = $start + $offset;
+ my $e = $s+1; # fill in gaps
+ my $v = $array->[$offset/$bases_per_bin];
+ push @parts,[$s,$s,$v];
+ }
+ $self->draw_plot(\@parts,@_);
+}
+
+sub _draw_wigfile {
+ my $self = shift;
+ my $feature = shift;
+ my $wig = shift;
+
+ $wig->smoothing($self->get_smoothing);
+ $wig->window($self->smooth_window);
+ $self->wig($wig);
+ my $parts = $self->get_parts;
+ $self->draw_plot($parts,@_);
+}
+
+1;
View
429 lib/Bio/Graphics/Glyph/wiggle_density.pm
@@ -1,8 +1,11 @@
package Bio::Graphics::Glyph::wiggle_density;
use strict;
-use base qw(Bio::Graphics::Glyph::box Bio::Graphics::Glyph::smoothing Bio::Graphics::Glyph::wiggle_minmax);
-use File::Spec;
+use base qw(Bio::Graphics::Glyph::wiggle_data
+ Bio::Graphics::Glyph::box
+ Bio::Graphics::Glyph::smoothing
+ Bio::Graphics::Glyph::xyplot
+ );
sub my_description {
return <<END;
@@ -55,371 +58,90 @@ sub my_options {
};
}
-
-
sub draw {
my $self = shift;
- my ($gd,$left,$top,$partno,$total_parts) = @_;
- my $feature = $self->feature;
-
- my $drawnit;
- $self->panel->startGroup($gd);
- my ($wigfile) = eval{$feature->get_tag_values('wigfile')};
- if ($wigfile) {
- $self->draw_wigfile($self->rel2abs($wigfile),@_);
- $drawnit++;
- }
+ my ($gd,$dx,$dy) = @_;
- my ($wigdata) = eval{$feature->get_tag_values('wigdata')};
- if ($wigdata) {
- $self->draw_wigdata($wigdata,@_);
- $drawnit++;
- }
- my ($densefile) = eval{$feature->get_tag_values('densefile')};
- if ($densefile) {
- $self->draw_densefile($self->rel2abs($feature),$densefile,@_);
- $drawnit++;
- }
- my ($coverage) = eval{$feature->get_tag_values('coverage')};
- if ($coverage) {
- $self->draw_coverage($feature,$coverage,@_);
- $drawnit++;
- }
- # support for BigWig/BigBed
- if ($feature->can('statistical_summary')) {
- my $stats = $feature->statistical_summary($self->width);
- my @vals = map {$_->{validCount} ? $_->{sumData}/$_->{validCount}:0} @$stats;
- $self->draw_coverage($feature,\@vals,@_);
- $drawnit++;
- }
+ warn "label = ",$self->option('label');
+ my $retval = $self->SUPER::draw(@_);
- if ($drawnit) {
+ if ($retval) {
$self->draw_label(@_) if $self->option('label');
$self->draw_description(@_) if $self->option('description');
$self->panel->endGroup($gd);
- return;
- }
-
- else {
- $self->panel->endGroup($gd);
+ return $retval;
+ } else {
+ return $self->Bio::Graphics::Glyph::box::draw(@_);
}
-
- return $self->SUPER::draw(@_);
}
-sub draw_wigfile {
- my $self = shift;
- my $wigfile = shift;
-
- eval "require Bio::Graphics::Wiggle" unless Bio::Graphics::Wiggle->can('new');
- my $wig = ref $wigfile &&a $wigfile->isa('Bio::Graphics::Wiggle')
- ? $wigfile
- : eval { Bio::Graphics::Wiggle->new($wigfile) };
-
- unless ($wig) {
- warn $@;
- return $self->SUPER::draw(@_);
- }
- $self->wig($wig);
-
- $self->_draw_wigfile(@_);
-}
+sub draw_plot {
+ my $self = shift;
+ my $parts = shift;
+ my ($gd,$dx,$dy) = @_;
-sub draw_wigdata {
- my $self = shift;
- my $data = shift;
-
- my $wig = eval { Bio::Graphics::Wiggle->new() };
- unless ($wig) {
- warn $@;
- return $self->SUPER::draw(@_);
+ my $x_scale = $self->scale;
+ my $panel_start = $self->panel->start;
+ my $feature = $self->feature;
+ my $f_start = $feature->start > $panel_start
+ ? $feature->start
+ : $panel_start;
+
+ my ($left,$top,$right,$bottom) = $self->calculate_boundaries($dx,$dy);
+
+ # There is a minmax inherited from xyplot as well as wiggle_data, and I don't want to
+ # rely on Perl's multiple inheritance DFS to find the right one.
+ my ($min_score,$max_score,$mean,$stdev) = $self->minmax($parts);
+ my $rescale = $self->option('autoscale') eq 'z_score';
+
+ my ($scaled_min,$scaled_max);
+ if ($rescale) {
+ $scaled_min = int(($min_score-$mean)/$stdev + 0.5);
+ $scaled_max = int(($max_score-$mean)/$stdev + 0.5);
+ my $bound = $self->z_score_bound;
+ $scaled_max = $bound if $scaled_max > $bound;
+ $scaled_min = -$bound if $scaled_min < -$bound;
+ } else {
+ ($scaled_min,$scaled_max) = ($min_score,$max_score);
}
- $wig->import_from_wif64($data);
-
- $self->wig($wig);
- $self->_draw_wigfile(@_);
-}
-
-sub draw_coverage {
- my $self = shift;
- my $feature = shift;
- my $array = shift;
-
- $array = [split ',',$array] unless ref $array;
- return unless @$array;
- my ($gd,$left,$top) = @_;
-
- my ($start,$end) = $self->effective_bounds($feature);
- my $length = $end - $start + 1;
- my $bases_per_bin = ($end-$start)/@$array;
- my @parts;
- my $samples = $length < $self->panel->width ? $length
- : $self->panel->width;
- my $samples_per_base = $samples/$length;
-
- for (my $i=0;$i<$samples;$i++) {
- my $offset = $i/$samples_per_base;
- my $v = $array->[$offset/$bases_per_bin];
- push @parts,$v;
+ my $pivot = $self->bicolor_pivot;
+ my $positive = $self->pos_color;
+ my $negative = $self->neg_color;
+ my $midpoint = $self->midpoint;
+ my ($rgb_pos,$rgb_neg,$rgb);
+ if ($pivot) {
+ $rgb_pos = [$self->panel->rgb($positive)];
+ $rgb_neg = [$self->panel->rgb($negative)];
+ } else {
+ $rgb = $scaled_max > $scaled_min ? ([$self->panel->rgb($positive)] || [$self->panel->rgb($self->bgcolor)])
+ : ([$self->panel->rgb($negative)] || [$self->panel->rgb($self->bgcolor)]);
}
- my ($x1,$y1,$x2,$y2) = $self->bounds($left,$top);
- $self->draw_segment($gd,
- $start,$end,
- \@parts,
- $start,$end,
- 1,1,
- $x1,$y1,$x2,$y2);
-}
-
-sub effective_bounds { # copied from wiggle_xyplot -- ouch!
- my $self = shift;
- my $feature = shift;
- my $panel_start = $self->panel->start;
- my $panel_end = $self->panel->end;
- my $start = $feature->start>$panel_start
- ? $feature->start
- : $panel_start;
- my $end = $feature->end<$panel_end
- ? $feature->end
- : $panel_end;
- return ($start,$end);
-}
-sub _draw_wigfile {
- my $self = shift;
- my $wig = $self->wig;
- my ($gd,$left,$top) = @_;
-
- my $smoothing = $self->get_smoothing;
- my $smooth_window = $self->smooth_window;
- my $start = $self->smooth_start;
- my $end = $self->smooth_end;
-
- $wig->window($smooth_window);
- $wig->smoothing($smoothing);
- my ($x1,$y1,$x2,$y2) = $self->bounds($left,$top);
- $self->draw_segment($gd,
- $start,$end,
- $wig,$start,$end,
- 1,1,
- $x1,$y1,$x2,$y2);
-}
+ my %color_cache;
-sub draw_densefile {
- my $self = shift;
- my $feature = shift;
- my $densefile = shift;
- my ($gd,$left,$top) = @_;
-
- my ($denseoffset) = eval{$feature->get_tag_values('denseoffset')};
- my ($densesize) = eval{$feature->get_tag_values('densesize')};
- $denseoffset ||= 0;
- $densesize ||= 1;
-
- my $smoothing = $self->get_smoothing;
- my $smooth_window = $self->smooth_window;
- my $start = $self->smooth_start;
- my $end = $self->smooth_end;
-
- my $fh = IO::File->new($densefile) or die "can't open $densefile: $!";
- eval "require Bio::Graphics::DenseFeature" unless Bio::Graphics::DenseFeature->can('new');
-
- my $dense = Bio::Graphics::DenseFeature->new(-fh=>$fh,
- -fh_offset => $denseoffset,
- -start => $feature->start,
- -smooth => $smoothing,
- -recsize => $densesize,
- -window => $smooth_window,
- ) or die "Can't initialize DenseFeature: $!";
-
- my ($x1,$y1,$x2,$y2) = $self->bounds($left,$top);
- $self->draw_segment($gd,
- $start,$end,
- $dense,$start,$end,
- 1,1,
- $x1,$y1,$x2,$y2);
-}
+ $self->panel->startGroup($gd);
+ foreach (@$parts) {
+ my ($start,$end,$score) = @$_;
+ $score = ($score-$mean)/$stdev if $rescale;
+ $score = $scaled_min if $scaled_min > $score;
+ $score = $scaled_max if $scaled_max < $score;
-sub draw_segment {
- my $self = shift;
- my ($gd,
- $start,$end,
- $seg_data,
- $seg_start,$seg_end,
- $step,$span,
- $x1,$y1,$x2,$y2) = @_;
-
- # clip, because wig files do no clipping
- $seg_start = $start if $seg_start < $start;
- $seg_end = $end if $seg_end > $end;
-
- # figure out where we're going to start
- my $scale = $self->scale; # pixels per base pair
- my $pixels_per_span = $scale * $span + 1;
- my $pixels_per_step = 1;
- my $length = $end-$start+1;
-
- # if the feature starts before the data starts, then we need to draw
- # a line indicating missing data (this only happens if something went
- # wrong upstream)
- if ($seg_start > $start) {
- my $terminus = $self->map_pt($seg_start);
- $start = $seg_start;
- $x1 = $terminus;
- }
- # if the data ends before the feature ends, then we need to draw
- # a line indicating missing data (this only happens if something went
- # wrong upstream)
- if ($seg_end < $end) {
- my $terminus = $self->map_pt($seg_end);
- $end = $seg_end;
- $x2 = $terminus;
- }
+ my $x1 = $left + ($start - $f_start) * $x_scale;
+ my $x2 = $left + ($end - $f_start) * $x_scale;
- return unless $start < $end;
-
- # get data values across the area
- my $samples = $length < $self->panel->width ? $length
- : $self->panel->width;
- my $data = ref $seg_data eq 'ARRAY' ? $seg_data
- : $seg_data->values($start,$end,$samples);
-
- # scale the glyph if the data end before the panel does
- my $data_width = $end - $start;
- my $data_width_ratio;
- if ($data_width < $self->panel->length) {
- $data_width_ratio = $data_width/$self->panel->length;
- }
- else {
- $data_width_ratio = 1;
- }
-
- return unless $data && ref $data && @$data > 0;
-
- my $min_value = $self->min_score;
- my $max_value = $self->max_score;
-
- my ($min,$max,$mean,$stdev) = $self->minmax($data);
- unless (defined $min_value && defined $max_value) {
- $min_value ||= $min;
- $max_value ||= $max;
- }
-
- my $rescale = $self->option('autoscale') eq 'z_score';
- my ($scaled_min,$scaled_max);
- if ($rescale) {
- my $bound = $self->z_score_bound;
- $scaled_min = -$bound;
- $scaled_max = +$bound;
- } else {
- ($scaled_min,$scaled_max) = ($min_value,$max_value);
- }
-
- my $t = 0; for (@$data) {$t+=$_}
-
- # allocate colors
- # There are two ways to do this. One is a scale from min to max. The other is a
- # bipartite scale using one color range from zero to min, and another color range
- # from 0 to max. The latter behavior is triggered when the config file contains
- # entries for "pos_color" and "neg_color" and the data ranges from < 0 to > 0.
-
- my $poscolor = $self->pos_color;
- my $negcolor = $self->neg_color;
-
- my $data_midpoint = $self->midpoint;
- $data_midpoint = 0 if $rescale;
- my $bicolor = $poscolor != $negcolor
- && $scaled_min < $data_midpoint
- && $scaled_max > $data_midpoint;
-
- my ($rgb_pos,$rgb_neg,$rgb);
- if ($bicolor) {
- $rgb_pos = [$self->panel->rgb($poscolor)];
- $rgb_neg = [$self->panel->rgb($negcolor)];
- } else {
- $rgb = $scaled_max > $scaled_min ? ([$self->panel->rgb($poscolor)] || [$self->panel->rgb($self->bgcolor)])
- : ([$self->panel->rgb($negcolor)] || [$self->panel->rgb($self->bgcolor)]);
- }
-
-
- my %color_cache;
-
- @$data = reverse @$data if $self->flip;
-
- if (@$data <= $self->panel->width) { # data fits in width, so just draw it
-
- $pixels_per_step = $scale * $step;
- $pixels_per_step = 1 if $pixels_per_step < 1;
- my $datapoints_per_base = @$data/$length;
- my $pixels_per_datapoint = $self->panel->width/@$data * $data_width_ratio;
- for (my $i = 0; $i <= @$data ; $i++) {
- my $x = $x1 + $pixels_per_datapoint * $i;
- my $data_point = $data->[$i];
- defined $data_point || next;
- $data_point = ($data_point-$mean)/$stdev if $rescale;
- $data_point = $scaled_min if $scaled_min > $data_point;
- $data_point = $scaled_max if $scaled_max < $data_point;
-
- my ($r,$g,$b) = $bicolor
- ? $data_point > $data_midpoint ? $self->calculate_color($data_point,$rgb_pos,
- $data_midpoint,$scaled_max)
- : $self->calculate_color($data_point,$rgb_neg,
- $data_midpoint,$scaled_min)
- : $self->calculate_color($data_point,$rgb,
+ my ($r,$g,$b) = $pivot
+ ? $score > $midpoint ? $self->calculate_color($score,$rgb_pos,
+ $midpoint,$scaled_max)
+ : $self->calculate_color($score,$rgb_neg,
+ $midpoint,$scaled_min)
+ : $self->calculate_color($score,$rgb,
$scaled_min,$scaled_max);
- my $idx = $color_cache{$r,$g,$b} ||= $self->panel->translate_color($r,$g,$b);
- $self->filled_box($gd,$x,$y1,$x+$pixels_per_datapoint,$y2,$idx,$idx);
+ my $idx = $color_cache{$r,$g,$b} ||= $self->panel->translate_color($r,$g,$b);
+ # debugging
+ $self->filled_box($gd,$x1,$top,$x2,$bottom,$idx,$idx);
}
-
- } else { # use Sheldon's code to subsample data
- $pixels_per_step = $scale * $step;
- my $pixels = 0;
-
- # only draw boxes 2 pixels wide, so take the mean value
- # for n data points that span a 2 pixel interval
- my $binsize = 2/$pixels_per_step;
- my $pixelstep = $pixels_per_step;
- $pixels_per_step *= $binsize;
- $pixels_per_step *= $data_width_ratio;
- $pixels_per_span = 2;
-
- my $scores = 0;
- my $defined;
-
- for (my $i = $start; $i < $end ; $i += $step) {
- # draw the box if we have accumulated >= 2 pixel's worth of data.
- if ($pixels >= 2) {
- my $data_point = $defined ? $scores/$defined : 0;
- $scores = 0;
- $defined = 0;
-
- $data_point = $scaled_min if $scaled_min > $data_point;
- $data_point = $scaled_max if $scaled_max < $data_point;
- my ($r,$g,$b) = $bicolor
- ? $data_point > $data_midpoint ? $self->calculate_color($data_point,$rgb_pos,
- $data_midpoint,$scaled_max)
- : $self->calculate_color($data_point,$rgb_neg,
- $data_midpoint,$scaled_min)
- : $self->calculate_color($data_point,$rgb,
- $scaled_min,$max_value);
- my $idx = $color_cache{$r,$g,$b} ||= $self->panel->translate_color($r,$g,$b);
- $self->filled_box($gd,$x1,$y1,$x1+$pixels_per_span,$y2,$idx,$idx);
- $x1 += $pixels;
- $pixels = 0;
- }
-
- my $val = shift @$data;
- # don't include undef scores in the mean calculation
- # $scores is the numerator; $defined is the denominator
- $scores += $val if defined $val;
- $defined++ if defined $val;
-
- # keep incrementing until we exceed 2 pixels
- # the step is a fraction of a pixel, not an integer
- $pixels += $pixelstep;
- }
- }
+ return 1;
}
sub calculate_color {
@@ -437,15 +159,6 @@ sub calculate_color {
sub min { $_[0] < $_[1] ? $_[0] : $_[1] }
sub max { $_[0] > $_[1] ? $_[0] : $_[1] }
-# repeated in wiggle_xyplot.pm!
-sub rel2abs {
- my $self = shift;
- my $wig = shift;
- return $wig if ref $wig;
- my $path = $self->option('basedir');
- return File::Spec->rel2abs($wig,$path);
-}
-
sub record_label_positions {
my $self = shift;
my $rlp = $self->option('record_label_positions');
@@ -453,6 +166,10 @@ sub record_label_positions {
return 1;
}
+sub draw_label {
+ shift->Bio::Graphics::Glyph::xyplot::draw_label(@_);
+}
+
1;
__END__
View
157 lib/Bio/Graphics/Glyph/wiggle_minmax.pm
@@ -1,157 +0,0 @@
-package Bio::Graphics::Glyph::wiggle_minmax;
-
-use strict;
-use base qw(Bio::Graphics::Glyph::minmax);
-
-sub minmax {
- my $self = shift;
- my $parts = shift;
-
- my $autoscale = $self->option('autoscale') || 'local';
-
- my $min_score = $self->min_score unless $autoscale eq 'z_score';
- my $max_score = $self->max_score unless $autoscale eq 'z_score';
-
- my $do_min = !defined $min_score;
- my $do_max = !defined $max_score;
-
- if (@$parts && $self->feature->can('statistical_summary')) {
- my ($min,$max,$mean,$stdev) = eval {$self->bigwig_stats($autoscale,$self->feature)};
- $min_score = $min if $do_min;
- $max_score = $max if $do_max;
- return $self->sanity_check($min_score,$max_score,$mean,$stdev);
- }
-
- elsif (eval {$self->wig}) {
- if (my ($min,$max,$mean,$stdev) = eval{$self->wig_stats($autoscale,$self->wig)}) {
- $min_score = $min if $do_min;
- $max_score = $max if $do_max;
- return $self->sanity_check($min_score,$max_score,$mean,$stdev);
- }
- }
-
- if ($do_min or $do_max) {
- my $first = $parts->[0];
- for my $part (@$parts) {
- my $s = ref $part ? $part->[2] : $part;
- next unless defined $s;
- $min_score = $s if $do_min && (!defined $min_score or $s < $min_score);
- $max_score = $s if $do_max && (!defined $max_score or $s > $max_score);
- }
- }
- return $self->sanity_check($min_score,$max_score);
-}
-
-sub bigwig_stats {
- my $self = shift;
- my ($autoscale,$feature) = @_;
- my $s;
-
- if ($autoscale =~ /global/ or $autoscale eq 'z_score') {
- $s = $feature->global_stats;
- } elsif ($autoscale eq 'chromosome') {
- $s = $feature->chr_stats;
- } else {
- $s = $feature->score;
- }
- return $self->clip($autoscale,
- $s->{minVal},$s->{maxVal},Bio::DB::BigWig::binMean($s),Bio::DB::BigWig::binStdev($s));
-}
-
-sub wig_stats {
- my $self = shift;
- my ($autoscale,$wig) = @_;
-
- if ($autoscale =~ /global|chromosome|z_score/) {
- my $min_score = $wig->min;
- my $max_score = $wig->max;
- my $mean = $wig->mean;
- my $stdev = $wig->stdev;
- return $self->clip($autoscale,$min_score,$max_score,$mean,$stdev);
- } else {
- return;
- }
-}
-
-sub clip {
- my $self = shift;
- my ($autoscale,$min,$max,$mean,$stdev) = @_;
- return ($min,$max,$mean,$stdev) unless $autoscale =~ /clipped/;
- my $fold = $self->z_score_bound;
- my $clip_max = $mean + $stdev*$fold;
- my $clip_min = $mean - $stdev*$fold;
- $min = $clip_min if $min < $clip_min;
- $max = $clip_max if $max > $clip_max;
- return ($min,$max,$mean,$stdev);
-}
-
-
-sub z_score_bound {
- my $self = shift;
- return $self->option('z_score_bound') || 4;
-}
-
-# change the scaling of the data points if z-score autoscaling requested
-sub rescale {
- my $self = shift;
- my $points = shift;
- return $points unless $self->option('autoscale') eq 'z_score';
-
- my ($min,$max,$mean,$stdev) = $self->minmax($points);
- foreach (@$points) {
- $_ = ($_ - $mean) / $stdev;
- }
- return $points;
-}
-
-sub global_mean_and_variance {
- my $self = shift;
- if (my $wig = $self->wig) {
- return ($wig->mean,$wig->stdev);
- } elsif ($self->feature->can('global_mean')) {
- my $f = $self->feature;
- return ($f->global_mean,$f->global_stdev);
- }
- return;
-}
-
-sub global_min_max {
- my $self = shift;
- if (my $wig = $self->wig) {
- return ($wig->min,$wig->max);
- } elsif (my $stats = eval {$self->feature->global_stats}) {
- return ($stats->{minVal},$stats->{maxVal});
- }
- return;
-}
-sub series_stdev {
- my $self = shift;
- my ($mean,$stdev) = $self->global_mean_and_variance;
- return $stdev;
-}
-
-sub series_mean {
- my $self = shift;
- my ($mean) = $self->global_mean_and_variance;
- return $mean;
-}
-
-sub series_min {
- my $self = shift;
- return ($self->global_min_max)[0];
-}
-
-sub series_max {
- my $self = shift;
- return ($self->global_min_max)[1];
-}
-
-sub wig {
- my $self = shift;
- my $d = $self->{wig};
- $self->{wig} = shift if @_;
- $d;
-}
-
-
-1;
View
16 lib/Bio/Graphics/Glyph/wiggle_whiskers.pm
@@ -1,7 +1,7 @@
package Bio::Graphics::Glyph::wiggle_whiskers;
use strict;
-use base qw(Bio::Graphics::Glyph::wiggle_minmax
+use base qw(Bio::Graphics::Glyph::wiggle_data
Bio::Graphics::Glyph::wiggle_xyplot
);
@@ -57,10 +57,11 @@ sub my_options {
'The color drawn from -stdev to min.'
],
graph_type => [
- ['boxes','whiskers'],
- 'boxes',
- 'Type of graph to generate. Options are "boxes" (for a barchart),',
- 'or "whiskers" (for a whiskerplot showing mean, +/- stdev and max/min.'
+ ['histogram','whiskers'],
+ 'histogram',
+ 'Type of graph to generate. Options are "histogram" (for a barchart),',
+ 'or "whiskers" (for a whiskerplot showing mean, +/- stdev and max/min.',
+ 'The deprecated "boxes" subtype is a synonym for "histogram."'
],
}
}
@@ -80,7 +81,7 @@ sub graph_type {
sub glyph_subtype {
my $self = shift;
- return $self->option('glyph_subtype') || $self->option('graph_type') || 'boxes';
+ return $self->option('glyph_subtype') || $self->option('graph_type') || 'histogram';
}
sub mean_color {
@@ -128,6 +129,7 @@ sub draw {
$stats ||= [];
my ($min_score,$max_score,$mean,$stdev) = $self->minmax($stats);
+ warn "($min_score,$max_score,$mean,$stdev)";
my $rescale = $self->option('autoscale') eq 'z_score';
my $side = $self->_determine_side();
@@ -237,7 +239,7 @@ sub _draw_whiskers {
}
}
- if ($graph_type eq 'boxes') {
+ if ($graph_type =~ /histogram|boxes/) {
if ($mean >= 0) {
$gd->line($pos,$origin,$pos,$mean_pos, $mean_color);
$gd->line($pos,$mean_pos,$pos,$plus_one,$stdev_color) if $mean_pos != $plus_one;
View
278 lib/Bio/Graphics/Glyph/wiggle_xyplot.pm
@@ -1,13 +1,12 @@
package Bio::Graphics::Glyph::wiggle_xyplot;
use strict;
-use base qw(Bio::Graphics::Glyph::wiggle_minmax
+use base qw(Bio::Graphics::Glyph::wiggle_data
Bio::Graphics::Glyph::xyplot
Bio::Graphics::Glyph::smoothing);
use IO::File;
use File::Spec;
-
sub my_description {
return <<END;
This glyph draws quantitative data as an xyplot. It is designed to be
@@ -94,226 +93,16 @@ sub clip_color {
# we override the draw method so that it dynamically creates the parts needed
# from the wig file rather than trying to fetch them from the database
+
+# sub draw() { } is now mostly in wiggle_data.pm
sub draw {
my $self = shift;
my ($gd,$dx,$dy) = @_;
-
- my $feature = $self->feature;
- my $datatype = $self->datatype;
-
- my $retval;
- $retval = $self->draw_wigfile($feature,@_) if $datatype eq 'wigfile';
- $retval = $self->draw_wigdata($feature,@_) if $datatype eq 'wigdata';
- $retval = $self->draw_densefile($feature,@_) if $datatype eq 'densefile';
- $retval = $self->draw_coverage($feature,@_) if $datatype eq 'coverage';
- $retval = $self->draw_statistical_summary($feature,@_) if $datatype eq 'statistical_summary';
- $retval = $self->SUPER::draw(@_) if $datatype eq 'generic';
+ my $result = $self->Bio::Graphics::Glyph::wiggle_data::draw(@_);
# inhibit the scale if we are non-bumping
$self->configure(-scale => 'none') if $self->bump eq 'overlap';
- return $retval;
-}
-
-sub draw_wigfile {
- my $self = shift;
- my $feature = shift;
-
- my ($wigfile) = eval{$feature->get_tag_values('wigfile')};
- $wigfile = $self->rel2abs($wigfile);
-
- eval "require Bio::Graphics::Wiggle" unless Bio::Graphics::Wiggle->can('new');
- my $wig = ref $wigfile && $wigfile->isa('Bio::Graphics::Wiggle')
- ? $wigfile
- : eval { Bio::Graphics::Wiggle->new($wigfile) };
- unless ($wig) {
- warn $@;
- return $self->SUPER::draw(@_);
- }
- $self->_draw_wigfile($feature,$wig,@_);
-}
-
-sub draw_wigdata {
- my $self = shift;
- my $feature = shift;
-
- my ($data) = eval{$feature->get_tag_values('wigdata')};
-
- if (ref $data eq 'ARRAY') {
- my ($start,$end) = $self->effective_bounds($feature);
- my $parts = $self->subsample($data,$start,$end);
- $self->draw_plot($parts,@_);
- }
-
- else {
- my $wig = eval { Bio::Graphics::Wiggle->new() };
- unless ($wig) {
- warn $@;
- return $self->SUPER::draw(@_);
- }
-
- $wig->import_from_wif64($data);
- $self->_draw_wigfile($feature,$wig,@_);
- }
-}
-
-sub draw_densefile {
- my $self = shift;
- my $feature = shift;
-
- my ($densefile) = eval{$feature->get_tag_values('densefile')};
- $densefile = $self->rel2abs($densefile);
-
- my ($denseoffset) = eval{$feature->get_tag_values('denseoffset')};
- my ($densesize) = eval{$feature->get_tag_values('densesize')};
- $denseoffset ||= 0;
- $densesize ||= 1;
-
- my $smoothing = $self->get_smoothing;
- my $smooth_window = $self->smooth_window;
- my $start = $self->smooth_start;
- my $end = $self->smooth_end;
-
- my $fh = IO::File->new($densefile) or die "can't open $densefile: $!";
- eval "require Bio::Graphics::DenseFeature" unless Bio::Graphics::DenseFeature->can('new');
- my $dense = Bio::Graphics::DenseFeature->new(-fh=>$fh,
- -fh_offset => $denseoffset,
- -start => $feature->start,
- -smooth => $smoothing,
- -recsize => $densesize,
- -window => $smooth_window,
- ) or die "Can't initialize DenseFeature: $!";
- my $parts = $self->get_parts;
- $self->draw_plot($parts);
-}
-
-sub draw_coverage {
- my $self = shift;
- my $feature = shift;
-
- my ($array) = eval{$feature->get_tag_values('coverage')};
- $self->_draw_coverage($feature,$array,@_);
-}
-
-sub draw_statistical_summary {
- my $self = shift;
- my $feature = shift;
- my $stats = $feature->statistical_summary($self->width);
- $stats ||= [];
- my @vals = map {$_->{validCount} ? $_->{sumData}/$_->{validCount}:0} @$stats;
- return $self->_draw_coverage($feature,\@vals,@_);
-}
-
-sub _draw_coverage {
- my $self = shift;
- my $feature = shift;
- my $array = shift;
-
- $array = [split ',',$array] unless ref $array;
- return unless @$array;
-
- my ($start,$end) = $self->effective_bounds($feature);
- my $bases_per_bin = ($end-$start)/@$array;
- my $pixels_per_base = $self->scale;
- my @parts;
- for (my $pixel=0;$pixel<$self->width;$pixel++) {
- my $offset = $pixel/$pixels_per_base;
- my $s = $start + $offset;
- my $e = $s+1; # fill in gaps
- my $v = $array->[$offset/$bases_per_bin];
- push @parts,[$s,$s,$v];
- }
- $self->draw_plot(\@parts,@_);
-}
-
-sub _draw_wigfile {
- my $self = shift;
- my $feature = shift;
- my $wig = shift;
-
- $wig->smoothing($self->get_smoothing);
- $wig->window($self->smooth_window);
- $self->wig($wig);
- my $parts = $self->get_parts;
- $self->draw_plot($parts,@_);
-}
-
-sub datatype {
- my $self = shift;
- my $feature = $self->feature;
- my ($tag,$value);
-
- foreach $tag ('wigfile','wigdata','densefile','coverage') {
- ($value) = eval{$feature->get_tag_values($tag)};
- last if $value;
- }
- unless ($value) {
- $tag = 'statistical_summary';
- $value = eval{$feature->statistical_summary};
- }
- unless ($value) {
- $tag = 'generic';
- }
- return wantarray ? ($tag,$value) : $tag;
-}
-
-sub get_parts {
- my $self = shift;
- my $feature = $self->feature;
- my ($start,$end) = $self->effective_bounds($feature);
- my ($datatype,$data) = $self->datatype;
-
- return $self->subsample($data,$start,$end) if $datatype eq 'wigdata';
- return $self->create_parts_for_dense_feature($data,$start,$end) if $datatype eq 'densefile';
- return $self->create_parts_from_coverage($data,$start,$end) if $datatype eq 'coverage';
- return $self->create_parts_from_summary($data,$start,$end) if $datatype eq 'statistical_summary';
- return [];
-}
-
-sub effective_bounds {
- my $self = shift;
- my $feature = shift;
- my $panel_start = $self->panel->start;
- my $panel_end = $self->panel->end;
- my $start = $feature->start>$panel_start
- ? $feature->start
- : $panel_start;
- my $end = $feature->end<$panel_end
- ? $feature->end
- : $panel_end;
- return ($start,$end);
-}
-
-sub minmax {
- my $self = shift;
- my $parts = shift;
- return $self->Bio::Graphics::Glyph::wiggle_minmax::minmax($parts);
-}
-
-sub create_parts_from_coverage {
- my $self = shift;
- my ($array,$start,$end) = @_;
- $array = [split ',',$array] unless ref $array;
- return unless @$array;
-
- my $bases_per_bin = ($end-$start)/@$array;
- my $pixels_per_base = $self->scale;
- my @parts;
- for (my $pixel=0;$pixel<$self->width;$pixel++) {
- my $offset = $pixel/$pixels_per_base;
- my $s = $start + $offset;
- my $e = $s+1; # fill in gaps
- my $v = $array->[$offset/$bases_per_bin];
- push @parts,[$s,$s,$v];
- }
- return \@parts;
-}
-
-sub create_parts_from_summary {
- my $self = shift;
- my ($stats,$start,$end) = @_;
- $stats ||= [];
- my @vals = map {$_->{validCount} ? $_->{sumData}/$_->{validCount}:0} @$stats;
- return \@vals;
+ return $result;
}
sub draw_plot {
@@ -326,10 +115,9 @@ sub draw_plot {
my ($left,$top,$right,$bottom) = $self->calculate_boundaries($dx,$dy);
- # There is a minmax inherited from xyplot as well as wiggle_minmax, and I don't want to
+ # There is a minmax inherited from xyplot as well as wiggle_data, and I don't want to
# rely on Perl's multiple inheritance DFS to find the right one.
my ($min_score,$max_score,$mean,$stdev) = $self->minmax($parts);
- warn "($min_score,$max_score,$mean,$stdev)";
my $rescale = $self->option('autoscale') eq 'z_score';
my $side = $self->_determine_side();
@@ -340,9 +128,6 @@ sub draw_plot {
my $bound = $self->z_score_bound;
$scaled_max = $bound if $scaled_max > $bound;
$scaled_min = -$bound if $scaled_min < -$bound;
-# my $bound = $self->z_score_bound;
-# $scaled_min = -$bound;
-# $scaled_max = +$bound;
}
elsif ($side) {
$scaled_min = int($min_score - 0.5);
@@ -466,7 +251,6 @@ sub draw_plot {
}
}
-
if ($self->option('variance_band') &&
(my ($mean,$variance) = $self->global_mean_and_variance())) {
if ($rescale) {
@@ -491,7 +275,7 @@ sub draw_plot {
$clip_bottom++;
}
if ($yy2 > $bottom) {
-p $yy2 = $bottom;
+ $yy2 = $bottom;
$clip_bottom++;
}
my $y = $bottom - ($mean - $scaled_min) * $y_scale;
@@ -531,54 +315,6 @@ sub draw_label {
}
-
-# BUG: the next two subroutines should be merged
-sub create_parts_for_dense_feature {
- my $self = shift;
- my ($dense,$start,$end) = @_;
-
- my $span = $self->scale> 1 ? $end - $start : $self->width;
- my $data = $dense->values($start,$end,$span);
- my $points_per_span = ($end-$start+1)/$span;
- my @parts;
-
- for (my $i=0; $i<$span;$i++) {
- my $offset = $i * $points_per_span;
- my $value = shift @$data;
- next unless defined $value;
- push @parts,[$start + int($i * $points_per_span),
- $start + int($i * $points_per_span),
- $value];
- }
- return \@parts;
-}
-
-sub subsample {
- my $self = shift;
- my ($data,$start,$end) = @_;
- my $span = $self->scale > 1 ? $end - $start
- : $self->width;
- my $points_per_span = ($end-$start+1)/$span;
- my @parts;
- for (my $i=0; $i<$span;$i++) {
- my $offset = $i * $points_per_span;
- my $value = $data->[$offset + $points_per_span/2];
- push @parts,[$start + int($i*$points_per_span),
- $start + int($i*$points_per_span),
- $value];
- }
- return \@parts;
-}
-
-sub rel2abs {
- my $self = shift;
- my $wig = shift;
- return $wig if ref $wig;
- my $path = $self->option('basedir');
- return File::Spec->rel2abs($wig,$path);
-}
-
-
1;
__END__
View
8 lib/Bio/Graphics/Glyph/xyplot.pm
@@ -41,11 +41,11 @@ sub my_options {
'range to be clipped.'
],
graph_type => [
- ['boxes','line','points','linepoints'],
- 'boxes',
+ ['histogram','line','points','linepoints'],
+ 'histogram',
'Type of graph to generate. Options are "boxes",',
'"line","points", or "linepoints".',
- 'The deprecated "histogram" subtype is equivalent to "boxes".'
+ 'The deprecated "boxes" subtype is equivalent to "histogram".'
],
point_symbol => [
'string',
@@ -233,9 +233,9 @@ sub normalize_track {
my $self = shift;
my @glyphs_in_track = @_;
my ($global_min,$global_max);
- warn "trackwide normalization(@glyphs_in_track)";
for my $g (@glyphs_in_track) {
my ($min_score,$max_score) = $g->minmax($g->get_parts);
+ warn "($min_score,$max_score)";
$global_min = $min_score if !defined $global_min || $min_score < $global_min;
$global_max = $max_score if !defined $global_max || $max_score > $global_max;
}
View
4 lib/Bio/Graphics/Panel.pm
@@ -983,7 +983,7 @@ sub _translate_color {
my ($opacity,@colors) = @_;
$opacity = '1.0' if $opacity == 1;
my $default_alpha = $self->adjust_alpha($opacity);
- $default_alpha ||= 127;
+ $default_alpha ||= 0;
my $ckey = "@{colors}_${default_alpha}";
return $self->{closestcache}{$ckey} if exists $self->{closestcache}{$ckey};
@@ -993,7 +993,7 @@ sub _translate_color {
my $table = $self->{translations} or return 1;
if (@colors == 3) {
- $index = $gd->colorAllocateAlpha(@colors,$default_alpha);
+ $index = $gd->colorAllocateAlpha(@colors,$default_alpha);
}
elsif ($colors[0] =~ /^\#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i) {
my ($r,$g,$b,$alpha) = (hex($1),hex($2),hex($3),hex($4));

No commit comments for this range

Something went wrong with that request. Please try again.