Skip to content

Commit

Permalink
make vista plot functional; density plots are still broken
Browse files Browse the repository at this point in the history
  • Loading branch information
lstein committed Jan 11, 2012
1 parent 0dd9194 commit 5b970e2
Show file tree
Hide file tree
Showing 6 changed files with 54 additions and 130 deletions.
16 changes: 10 additions & 6 deletions lib/Bio/Graphics/Glyph/vista_plot.pm
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -46,8 +46,8 @@ sub my_options {
'vista', 'vista',
"What to show, peaks or signal, both (vista plot) or density graph."], "What to show, peaks or signal, both (vista plot) or density graph."],
graph_type => [ graph_type => [
['whiskers','histogram','boxes','line','points','linepoints'], ['whiskers','histogram','line','points','linepoints'],
'boxes', 'histogram',
"Type of signal graph to show."], "Type of signal graph to show."],
alpha => [ alpha => [
'integer', 'integer',
Expand Down Expand Up @@ -158,13 +158,16 @@ sub draw {
peak => (eval{$feature->get_tag_values('peak_type')})[0], peak => (eval{$feature->get_tag_values('peak_type')})[0],
fasta=> (eval{$feature->get_tag_values('fasta')})[0]); fasta=> (eval{$feature->get_tag_values('fasta')})[0]);
$self->panel->startGroup($gd); $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_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->Bio::Graphics::Glyph::xyplot::draw_label(@_) if $self->option('label');
$self->draw_description(@_) if $self->option('description'); $self->draw_description(@_) if $self->option('description');
$self->panel->endGroup($gd); $self->panel->endGroup($gd);
} }


# this should be refactored from wiggle_xyplot and wiggle_density
sub draw_signal { sub draw_signal {
my $self = shift; my $self = shift;
my $signal_type = shift; my $signal_type = shift;
Expand All @@ -176,8 +179,8 @@ sub draw_signal {
if ($paths->{wig} && $paths->{wig}=~/\.wi\w{1,3}$/) { if ($paths->{wig} && $paths->{wig}=~/\.wi\w{1,3}$/) {
eval "require Bio::Graphics::Wiggle" unless Bio::Graphics::Wiggle->can('new'); eval "require Bio::Graphics::Wiggle" unless Bio::Graphics::Wiggle->can('new');
my $wig = eval { Bio::Graphics::Wiggle->new($paths->{wig}) }; my $wig = eval { Bio::Graphics::Wiggle->new($paths->{wig}) };
$self->wig($paths->{wig}); $self->wig($wig);
$self->draw_wigfile($feature,$self->wig($wig),@_); $self->_draw_wigfile($feature,$wig,@_);
} elsif ($paths->{wig} && $paths->{wig}=~/\.bw$/i) { } elsif ($paths->{wig} && $paths->{wig}=~/\.bw$/i) {
eval "use Bio::DB::BigWig 'binMean'" unless Bio::DB::BigWig->can('new'); eval "use Bio::DB::BigWig 'binMean'" unless Bio::DB::BigWig->can('new');
my @args = (-bigwig => "$paths->{wig}"); my @args = (-bigwig => "$paths->{wig}");
Expand All @@ -188,6 +191,7 @@ sub draw_signal {
push @args,(-fasta => $fasta_accessor); push @args,(-fasta => $fasta_accessor);
} }
my $bigwig = Bio::DB::BigWig->new(@args); my $bigwig = Bio::DB::BigWig->new(@args);
$self->wig($bigwig);
my ($summary) = $bigwig->features(-seq_id => $feature->segment->ref, my ($summary) = $bigwig->features(-seq_id => $feature->segment->ref,
-start => $self->panel->start, -start => $self->panel->start,
-end => $self->panel->end, -end => $self->panel->end,
Expand All @@ -203,7 +207,7 @@ sub draw_signal {
if ($signal_type eq 'density') { if ($signal_type eq 'density') {
$self->Bio::Graphics::Glyph::wiggle_density::draw_coverage($summary,\@vals,@_); $self->Bio::Graphics::Glyph::wiggle_density::draw_coverage($summary,\@vals,@_);
} else { } else {
$self->Bio::Graphics::Glyph::wiggle_xyplot::draw_coverage($summary,\@vals,@_); $self->Bio::Graphics::Glyph::wiggle_data::_draw_coverage($summary,\@vals,@_);
} }
} }
} }
Expand Down
36 changes: 28 additions & 8 deletions lib/Bio/Graphics/Glyph/wiggle_data.pm
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -46,7 +46,6 @@ sub bigwig_stats {
my $self = shift; my $self = shift;
my ($autoscale,$feature) = @_; my ($autoscale,$feature) = @_;
my $s; my $s;

if ($autoscale =~ /global/ or $autoscale eq 'z_score') { if ($autoscale =~ /global/ or $autoscale eq 'z_score') {
$s = $feature->global_stats; $s = $feature->global_stats;
} elsif ($autoscale eq 'chromosome') { } elsif ($autoscale eq 'chromosome') {
Expand Down Expand Up @@ -158,17 +157,18 @@ sub datatype {
my $feature = $self->feature; my $feature = $self->feature;
my ($tag,$value); my ($tag,$value);


foreach $tag ('wigfile','wigdata','densefile','coverage') { for my $t ('wigfile','wigdata','densefile','coverage') {
($value) = eval{$feature->get_tag_values($tag)}; if (my ($v) = eval{$feature->get_tag_values($t)}) {
last if $value; $value = $v;
$tag = $t;
last;
}
} }
unless ($value) { unless ($value) {
$tag = 'statistical_summary'; $tag = 'statistical_summary';
$value = eval{$feature->statistical_summary}; $value = eval{$feature->statistical_summary};
} }
unless ($value) { $tag ||= 'generic';
$tag = 'generic';
}
return wantarray ? ($tag,$value) : $tag; return wantarray ? ($tag,$value) : $tag;
} }


Expand All @@ -178,7 +178,8 @@ sub get_parts {
my ($start,$end) = $self->effective_bounds($feature); my ($start,$end) = $self->effective_bounds($feature);
my ($datatype,$data) = $self->datatype; 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_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_coverage($data,$start,$end) if $datatype eq 'coverage';
return $self->create_parts_from_summary($data,$start,$end) if $datatype eq 'statistical_summary'; return $self->create_parts_from_summary($data,$start,$end) if $datatype eq 'statistical_summary';
Expand Down Expand Up @@ -246,6 +247,25 @@ sub create_parts_from_summary {
return \@vals; 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 { sub subsample {
my $self = shift; my $self = shift;
my ($data,$start,$end) = @_; my ($data,$start,$end) = @_;
Expand Down
110 changes: 4 additions & 106 deletions lib/Bio/Graphics/Glyph/wiggle_density.pm
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -81,66 +81,19 @@ sub draw {
sub draw { sub draw {
my $self = shift; my $self = shift;
my ($gd,$dx,$dy) = @_; my ($gd,$dx,$dy) = @_;
my $feature = $self->feature;
my $datatype = $self->datatype; # found in wiggle_data.pm


$self->panel->startGroup($gd); my $retval = $self->SUPER::draw(@_);
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';


if ($retval) { if ($retval) {
$self->draw_label(@_) if $self->option('label'); $self->draw_label(@_) if $self->option('label');
$self->draw_description(@_) if $self->option('description'); $self->draw_description(@_) if $self->option('description');
$self->panel->endGroup($gd); $self->panel->endGroup($gd);
return; return $retval;
} } else {

return $self->SUPER::Bio::Graphics::Glyph::box::draw(@_);
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(@_);
} }


$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 { sub draw_coverage {
my $self = shift; my $self = shift;
my $feature = shift; my $feature = shift;
Expand Down Expand Up @@ -172,61 +125,6 @@ sub draw_coverage {
$x1,$y1,$x2,$y2); $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 { sub draw_segment {
my $self = shift; my $self = shift;
my ($gd, my ($gd,
Expand Down
14 changes: 8 additions & 6 deletions lib/Bio/Graphics/Glyph/wiggle_whiskers.pm
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -57,10 +57,11 @@ sub my_options {
'The color drawn from -stdev to min.' 'The color drawn from -stdev to min.'
], ],
graph_type => [ graph_type => [
['boxes','whiskers'], ['histogram','whiskers'],
'boxes', 'histogram',
'Type of graph to generate. Options are "boxes" (for a barchart),', 'Type of graph to generate. Options are "histogram" (for a barchart),',
'or "whiskers" (for a whiskerplot showing mean, +/- stdev and max/min.' 'or "whiskers" (for a whiskerplot showing mean, +/- stdev and max/min.',
'The deprecated "boxes" subtype is a synonym for "histogram."'
], ],
} }
} }
Expand All @@ -80,7 +81,7 @@ sub graph_type {


sub glyph_subtype { sub glyph_subtype {
my $self = shift; 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 { sub mean_color {
Expand Down Expand Up @@ -128,6 +129,7 @@ sub draw {
$stats ||= []; $stats ||= [];


my ($min_score,$max_score,$mean,$stdev) = $self->minmax($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 $rescale = $self->option('autoscale') eq 'z_score';


my $side = $self->_determine_side(); my $side = $self->_determine_side();
Expand Down Expand Up @@ -237,7 +239,7 @@ sub _draw_whiskers {
} }
} }


if ($graph_type eq 'boxes') { if ($graph_type =~ /histogram|boxes/) {
if ($mean >= 0) { if ($mean >= 0) {
$gd->line($pos,$origin,$pos,$mean_pos, $mean_color); $gd->line($pos,$origin,$pos,$mean_pos, $mean_color);
$gd->line($pos,$mean_pos,$pos,$plus_one,$stdev_color) if $mean_pos != $plus_one; $gd->line($pos,$mean_pos,$pos,$plus_one,$stdev_color) if $mean_pos != $plus_one;
Expand Down
1 change: 0 additions & 1 deletion lib/Bio/Graphics/Glyph/wiggle_xyplot.pm
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@ use base qw(Bio::Graphics::Glyph::wiggle_data
use IO::File; use IO::File;
use File::Spec; use File::Spec;



sub my_description { sub my_description {
return <<END; return <<END;
This glyph draws quantitative data as an xyplot. It is designed to be This glyph draws quantitative data as an xyplot. It is designed to be
Expand Down
7 changes: 4 additions & 3 deletions lib/Bio/Graphics/Glyph/xyplot.pm
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -41,11 +41,11 @@ sub my_options {
'range to be clipped.' 'range to be clipped.'
], ],
graph_type => [ graph_type => [
['boxes','line','points','linepoints'], ['histogram','line','points','linepoints'],
'boxes', 'histogram',
'Type of graph to generate. Options are "boxes",', 'Type of graph to generate. Options are "boxes",',
'"line","points", or "linepoints".', '"line","points", or "linepoints".',
'The deprecated "histogram" subtype is equivalent to "boxes".' 'The deprecated "boxes" subtype is equivalent to "histogram".'
], ],
point_symbol => [ point_symbol => [
'string', 'string',
Expand Down Expand Up @@ -235,6 +235,7 @@ sub normalize_track {
my ($global_min,$global_max); my ($global_min,$global_max);
for my $g (@glyphs_in_track) { for my $g (@glyphs_in_track) {
my ($min_score,$max_score) = $g->minmax($g->get_parts); 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_min = $min_score if !defined $global_min || $min_score < $global_min;
$global_max = $max_score if !defined $global_max || $max_score > $global_max; $global_max = $max_score if !defined $global_max || $max_score > $global_max;
} }
Expand Down

0 comments on commit 5b970e2

Please sign in to comment.