Permalink
Browse files

make vista plot functional; density plots are still broken

  • Loading branch information...
lstein committed Jan 11, 2012
1 parent 0dd9194 commit 5b970e2ce6b63435346a8ac0b55324d9891a1967
@@ -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,@_);
}
}
}
@@ -46,7 +46,6 @@ 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') {
@@ -158,17 +157,18 @@ sub datatype {
my $feature = $self->feature;
my ($tag,$value);
- foreach $tag ('wigfile','wigdata','densefile','coverage') {
- ($value) = eval{$feature->get_tag_values($tag)};
- last if $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};
}
- unless ($value) {
- $tag = 'generic';
- }
+ $tag ||= 'generic';
return wantarray ? ($tag,$value) : $tag;
}
@@ -178,7 +178,8 @@ sub get_parts {
my ($start,$end) = $self->effective_bounds($feature);
my ($datatype,$data) = $self->datatype;
- return $self->subsample($data,$start,$end) if $datatype eq 'wigdata';
+ 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';
@@ -246,6 +247,25 @@ sub create_parts_from_summary {
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) = @_;
@@ -81,66 +81,19 @@ sub draw {
sub draw {
my $self = shift;
my ($gd,$dx,$dy) = @_;
- my $feature = $self->feature;
- my $datatype = $self->datatype; # found in wiggle_data.pm
- $self->panel->startGroup($gd);
- 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 $retval = $self->SUPER::draw(@_);
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 $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(@_);
+ return $retval;
+ } else {
+ return $self->SUPER::Bio::Graphics::Glyph::box::draw(@_);
}
- $self->_draw_wigfile($feature,$wig,@_);
}
-
-sub draw_wigdata {
- my $self = shift;
- my $feature = shift;
- my $data = shift;
-
- my $wig = eval { Bio::Graphics::Wiggle->new() };
- unless ($wig) {
- warn $@;
- return $self->SUPER::draw(@_);
- }
-
- $wig->import_from_wif64($data);
-
- $self->wig($wig);
- $self->_draw_wigfile(@_);
-}
-
sub draw_coverage {
my $self = shift;
my $feature = shift;
@@ -172,61 +125,6 @@ sub draw_coverage {
$x1,$y1,$x2,$y2);
}
-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);
-}
-
-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);
-}
-
sub draw_segment {
my $self = shift;
my ($gd,
@@ -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;
@@ -7,7 +7,6 @@ use base qw(Bio::Graphics::Glyph::wiggle_data
use IO::File;
use File::Spec;
-
sub my_description {
return <<END;
This glyph draws quantitative data as an xyplot. It is designed to be
@@ -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',
@@ -235,6 +235,7 @@ sub normalize_track {
my ($global_min,$global_max);
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;
}

0 comments on commit 5b970e2

Please sign in to comment.