use Maasha::Biopieces;
use Maasha::Fasta;
use Maasha::BGB::Common;
+use Maasha::BGB::Wiggle;
use Maasha::Filesys;
use constant {
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-my ( $data_dir, $user, $options, $path, $in, $out, $tmp_dir, %fh_hash, $fh_out, $record, $entry, $key, $dst_dir, @nums, $num, $contig_dir );
+my ( $data_dir, $user, $options, $path, $in, $out, $tmp_dir, %fh_hash, $fh_out, $record, $entry, $key, $dst_dir, @nums, $num, $contig_dir, $wig );
$data_dir = Maasha::Biopieces::biopiecesrc( "BGB_DATA_DIR" );
$user = Maasha::Biopieces::biopiecesrc( "BGB_USER" );
$options = Maasha::Biopieces::parse_options(
[
- { long => 'user', short => 'u', type => 'string', mandatory => 'no', default => $user, allowed => undef, disallowed => undef },
- { long => 'clade', short => 'c', type => 'string', mandatory => 'yes', default => undef, allowed => undef, disallowed => undef },
- { long => 'genome', short => 'g', type => 'string', mandatory => 'yes', default => undef, allowed => undef, disallowed => undef },
- { long => 'assembly', short => 'a', type => 'string', mandatory => 'yes', default => undef, allowed => undef, disallowed => undef },
- { long => 'track_name', short => 't', type => 'string', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
- { long => 'force', short => 'f', type => 'flag', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
- { long => 'no_stream', short => 'x', type => 'flag', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
+ { long => 'user', short => 'u', type => 'string', mandatory => 'no', default => $user, allowed => undef, disallowed => undef },
+ { long => 'clade', short => 'c', type => 'string', mandatory => 'yes', default => undef, allowed => undef, disallowed => undef },
+ { long => 'genome', short => 'g', type => 'string', mandatory => 'yes', default => undef, allowed => undef, disallowed => undef },
+ { long => 'assembly', short => 'a', type => 'string', mandatory => 'yes', default => undef, allowed => undef, disallowed => undef },
+ { long => 'track_name', short => 't', type => 'string', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
+ { long => 'track_type', short => 'T', type => 'string', mandatory => 'no', default => 'linear', allowed => 'linear,wiggle', disallowed => undef },
+ { long => 'force', short => 'f', type => 'flag', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
+ { long => 'no_stream', short => 'x', type => 'flag', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
]
);
Maasha::Filesys::dir_create( $dst_dir );
- Maasha::Filesys::file_copy( "$tmp_dir/$key", "$dst_dir/track_data.kiss" );
+ if ( $options->{ 'track_type' } eq 'linear' )
+ {
+ Maasha::Filesys::file_copy( "$tmp_dir/$key", "$dst_dir/track_data.kiss" );
- Maasha::KISS::kiss_sort( "$dst_dir/track_data.kiss" );
- Maasha::KISS::kiss_index( "$dst_dir/track_data.kiss" );
+ Maasha::KISS::kiss_sort( "$dst_dir/track_data.kiss" );
+ Maasha::KISS::kiss_index( "$dst_dir/track_data.kiss" );
+ }
+ elsif ( $options->{ 'track_type' } eq 'wiggle' )
+ {
+ $wig = Maasha::BGB::Wiggle::wiggle_encode( "$tmp_dir/$key" );
+ Maasha::BGB::Wiggle::wiggle_store( "$dst_dir/track_data.wig", $wig );
+ }
unlink "$tmp_dir/$key";
}
# Returns nothing.
- my ( $feature );
+ my ( $feature, $first );
+
+ $first = 1;
foreach $feature ( @{ $features } )
{
$cr->move_to( $feature->{ 'x1' }, $feature->{ 'y1' } );
$cr->line_to( $feature->{ 'x2' }, $feature->{ 'y2' } );
}
+ elsif ( $feature->{ 'type' } eq 'wiggle' )
+ {
+ $cr->set_line_width( $feature->{ 'line_width' } );
+
+ if ( $first )
+ {
+ $cr->move_to( $feature->{ 'x1' }, $feature->{ 'y1' } );
+
+ undef $first;
+ }
+ else
+ {
+ $cr->line_to( $feature->{ 'x2' }, $feature->{ 'y2' } );
+ }
+ }
elsif ( $feature->{ 'type' } eq 'arrow' )
{
draw_arrow_horizontal(
$cr->show_text( $feature->{ 'txt' } );
}
- $cr->stroke;
+ #$cr->stroke;
}
+
+ $cr->fill_preserve;
+ $cr->stroke;
}
use Maasha::KISS;
use Maasha::Biopieces;
use Maasha::Seq;
+use Maasha::BGB::Wiggle;
use vars qw( @ISA @EXPORT );
{
# Martin A. Hansen, November 2009.
- # Create a track with features. If there are more than $cookie->FEAT_MAX
- # features the track created will be a histogram, else linear.
-
- my ( $track, # path to kiss file with track data
+ my ( $track, # path to track data
$cookie, # cookie hash
) = @_;
# Returns a list.
- my ( $index, $count, $track_name, $start, $end, $entries, $features );
-
- $start = $cookie->{ 'NAV_START' };
- $end = $cookie->{ 'NAV_END' };
-
- $index = Maasha::KISS::kiss_index_retrieve( "$track/track_data.kiss.index" );
- $count = Maasha::KISS::kiss_index_count( $index, $start, $end );
+ my ( $data_wig, $data_kiss, $track_name, $features );
$track_name = ( split "/", $track )[ -1 ];
$track_name =~ s/^\d+_//;
$track_name =~ s/_/ /g;
- $features = [ {
+ push @{ $features }, {
type => 'text',
txt => $track_name,
font_size => $cookie->{ 'SEQ_FONT_SIZE' },
color => $cookie->{ 'SEQ_COLOR' },
x1 => 0,
y1 => $cookie->{ 'TRACK_OFFSET' },
- } ];
+ };
$cookie->{ 'TRACK_OFFSET' } += 10;
- if ( $count > $cookie->{ 'FEAT_MAX' } )
+ if ( -f "$track/track_data.wig" )
{
- $entries = Maasha::KISS::kiss_index_get_blocks( $index, $start, $end );
- push @{ $features }, track_feature_histogram( $cookie, $start, $end, $entries );
- }
+ $data_wig = Maasha::BGB::Wiggle::wiggle_retrieve( "$track/track_data.wig", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
+
+ push @{ $features }, track_wiggle( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_wig );
+ }
+ elsif ( -f "$track/track_data.kiss" )
+ {
+ $data_kiss = Maasha::KISS::kiss_retrieve( "$track/track_data.kiss", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
+
+ push @{ $features }, track_linear( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_kiss );
+ }
else
{
- $entries = Maasha::KISS::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
- push @{ $features }, track_feature_linear( $cookie, $start, $end, $entries );
- }
+ Maasha::Common::error( "Unknown track data type" );
+ }
return wantarray ? @{ $features } : $features;
}
-sub track_feature_linear
+sub track_wiggle
+{
+ # Martin A. Hansen, February 2010.
+
+ # Create a wiggle track.
+
+ my ( $cookie, # hashref with image draw metrics
+ $beg, # base window beg
+ $end, # base window end
+ $vals, # wiggle values
+ ) = @_;
+
+ # Returns a list.
+
+ my ( $i, $height, $max_val, $min_val, $max, $factor, $x1, $y1, $x2, $y2, @features );
+
+ $height = 75; # pixels
+
+ ( $min_val, $max_val ) = Maasha::Calc::minmax( $vals );
+
+ $vals = Maasha::BGB::Wiggle::wiggle_normalize( $vals, $cookie->{ 'IMG_WIDTH' } );
+
+ $max = Maasha::Calc::list_max( $vals );
+
+ $factor = $height / $max;
+
+ $x1 = 0;
+ $y1 = $cookie->{ 'TRACK_OFFSET' } + $height;
+
+ for ( $i = 0; $i < scalar @{ $vals }; $i++ )
+ {
+ $x2 = $i;
+ $y2 = $cookie->{ 'TRACK_OFFSET' } + $height - sprintf( "%.0f", $vals->[ $i ] * $factor );
+
+ push @features, {
+ type => 'wiggle',
+ color => $cookie->{ 'FEAT_COLOR' },
+ line_width => 1,
+ x1 => $x1,
+ y1 => $y1,
+ x2 => $x2,
+ y2 => $y2,
+ };
+
+ $x1 = $x2;
+ $y1 = $y2;
+ }
+
+ $x2 = $i;
+ $y2 = $cookie->{ 'TRACK_OFFSET' } + $height;
+
+ push @features, {
+ type => 'wiggle',
+ color => $cookie->{ 'FEAT_COLOR' },
+ line_width => 1,
+ x1 => $x1,
+ y1 => $y1,
+ x2 => $x2,
+ y2 => $y2,
+ };
+
+ unshift @features, {
+ type => 'text',
+ txt => " min: " . Maasha::Calc::commify( $min_val ) . " max: " . Maasha::Calc::commify( $max_val ),
+ font_size => $cookie->{ 'SEQ_FONT_SIZE' } - 2,
+ color => $cookie->{ 'SEQ_COLOR' },
+ x1 => 0,
+ y1 => $cookie->{ 'TRACK_OFFSET' },
+ };
+
+ $cookie->{ 'TRACK_OFFSET' } += $height + $cookie->{ 'TRACK_SPACE' };
+
+ return wantarray ? @features : \@features;
+}
+
+
+sub track_linear
{
# Martin A. Hansen, November 2009.
return wantarray ? @features : \@features;
}
+
+
+
+sub track_feature
+{
+ # Martin A. Hansen, November 2009.
+
+ # Create a track with features. If there are more than $cookie->FEAT_MAX
+ # features the track created will be a histogram, else linear.
+
+ my ( $track, # path to kiss file with track data
+ $cookie, # cookie hash
+ ) = @_;
+
+ # Returns a list.
+
+ my ( $index, $count, $track_name, $start, $end, $entries, $features );
+
+ $start = $cookie->{ 'NAV_START' };
+ $end = $cookie->{ 'NAV_END' };
+
+ $index = Maasha::KISS::kiss_index_retrieve( "$track/track_data.kiss.index" );
+ $count = Maasha::KISS::kiss_index_count( $index, $start, $end );
+
+ $track_name = ( split "/", $track )[ -1 ];
+ $track_name =~ s/^\d+_//;
+ $track_name =~ s/_/ /g;
+
+ $features = [ {
+ type => 'text',
+ txt => $track_name,
+ font_size => $cookie->{ 'SEQ_FONT_SIZE' },
+ color => $cookie->{ 'SEQ_COLOR' },
+ x1 => 0,
+ y1 => $cookie->{ 'TRACK_OFFSET' },
+ } ];
+
+ $cookie->{ 'TRACK_OFFSET' } += 10;
+
+ if ( $count > $cookie->{ 'FEAT_MAX' } )
+ {
+ $entries = Maasha::KISS::kiss_index_get_blocks( $index, $start, $end );
+ push @{ $features }, track_feature_histogram( $cookie, $start, $end, $entries );
+ }
+ else
+ {
+ $entries = Maasha::KISS::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
+ push @{ $features }, track_feature_linear( $cookie, $start, $end, $entries );
+ }
+
+ return wantarray ? @{ $features } : $features;
+}
}
+sub interpolate_linear
+{
+ # Martin A. Hansen, February 2010.
+
+ # Given two data points and an x value returns the
+ # interpolant (y).
+ #
+ # Formula for linear interpolation:
+ # http://en.wikipedia.org/wiki/Interpolation#Example
+
+ my ( $x1,
+ $y1,
+ $x2,
+ $y2,
+ $x
+ ) = @_;
+
+ # Returns a float
+
+ my ( $y );
+
+ $y = $y1 + ( $x - $x1 ) * ( ( $y2 - $y1 ) / ( $x2 - $x1 ) );
+
+ return $y;
+}
+
+
sub overlap
{
# Martin A. Hansen, November 2003.
}
+sub kiss_retrieve
+{
+ # Martin A. Hansen, February 2010.
+
+ # Retrieves KISS entries from a given sorted KISS file
+ # within an optional interval.
+
+ my ( $file, # path to KISS file
+ $beg, # interval begin - OPTIONAL
+ $end, # interval end - OPTIONAL
+ ) = @_;
+
+ # Returns a list.
+
+ my ( $fh, $entry, @entries );
+
+ $beg ||= 0;
+ $end ||= 999999999;
+
+ $fh = Maasha::Filesys::file_read_open( $file );
+
+ while ( $entry = kiss_entry_get( $fh ) )
+ {
+ push @entries, $entry if $entry->[ S_END ] > $beg;
+
+ last if $entry->[ S_BEG ] > $end;
+ }
+
+ close $fh;
+
+ return wantarray ? @entries : \@entries;
+}
+
+
sub kiss_entry_parse
{
# Martin A. Hansen, December 2009.
use warnings;
+no warnings 'recursion';
use strict;
use Data::Dumper;
use Storable qw( dclone );
{
# Martin A. Hansen, September 2009.
- # Defaltes a list of values to a specified size
+ # Deflates a list of values to a specified size
# and at the same time average the values.
my ( $list, # list to deflate
# Returns nothing.
- my ( $old_size, $bucket_size, $bucket_rest, $i, @new_list );
+ my ( $bin_size, $i, @new_list );
- $old_size = scalar @{ $list };
+ Maasha::Common::error( qq(new_size->$new_size must be a positive integer) ) if $new_size < 1;
+ Maasha::Common::error( qq(new_size->$new_size larger than list) ) if $new_size > scalar @{ $list };
- Maasha::Common::error( qq(Can't shrink to a bigger list: $old_size < $new_size ) ) if $old_size < $new_size;
+ $bin_size = int( scalar @{ $list } / $new_size );
- $bucket_size = int( $old_size / $new_size );
- $bucket_rest = $old_size - ( $new_size * $bucket_size );
+ for ( $i = 0; $i < @{ $list } - $bin_size + 1; $i += $bin_size ) {
+ push @new_list, Maasha::Calc::mean( [ @{ $list }[ $i .. $i + $bin_size ] ] );
+ }
+
+ # Maasha::Common::error( sprintf( "List size != new size: %d != %d" ), scalar @new_list, $new_size ) if scalar @new_list != $new_size;
+
+ @{ $list } = @new_list;
+}
- $i = 0;
- while ( $i < $new_size )
+sub list_inflate
+{
+ # Martin A. Hansen, February 2010.
+
+ # Inflates a list of values to a specified size recursively.
+ # Newly introduced elements are means of neighboring elements.
+ # This routine is a rough and not very precise.
+
+ my ( $list,
+ $new_size,
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $len, $diff, $space );
+
+ $len = @{ $list };
+ $diff = $new_size - $len;
+
+ if ( $diff > 0 )
{
- # push @new_list, [ @{ $list }[ $i * $bucket_size .. $i * $bucket_size + $bucket_size - 1 ] ];
- push @new_list, Maasha::Calc::mean( [ @{ $list }[ $i * $bucket_size .. $i * $bucket_size + $bucket_size - 1 ] ] );
+ $space = $len / $diff;
- $i ++;
- }
+ if ( ( $space % 2 ) == 0 )
+ {
+ splice @{ $list }, $len / 2, 0, Maasha::Calc::mean( [ $list->[ $len / 2 ], $list->[ $len / 2 + 1 ] ] );
+ }
+ else
+ {
+ splice @{ $list }, $len * ( 2 / 3 ), 0, Maasha::Calc::mean( [ $list->[ $len * ( 2 / 3 ) ], $list->[ $len * ( 2 / 3 ) + 1 ] ] );
+ splice @{ $list }, $len * ( 1 / 3 ), 0, Maasha::Calc::mean( [ $list->[ $len * ( 1 / 3 ) ], $list->[ $len * ( 1 / 3 ) + 1 ] ] ) if @{ $list } < $new_size;
+ }
- @{ $list } = @new_list;
+ list_inflate( $list, $new_size );
+ }
}
push @html, Maasha::XHTML::html_header(
cgi_header => 1,
- title => "Biopieces Genome Browser",
- css_file => "bgb.css",
- author => "Martin A. Hansen, mail\@maasha.dk",
- description => "Biopieces Genome Browser",
+ title => 'Biopieces Genome Browser',
+ css_file => 'bgb.css',
+ author => 'Martin A. Hansen, mail@maasha.dk',
+ description => 'Biopieces Genome Browser',
keywords => [ qw( Biopieces biopiece genome browser viewer bacterium bacteria prokaryote prokaryotes ) ],
no_cache => 1,
);
foreach $elem ( @{ $feat } )
{
next if $elem->{ 'type' } eq 'text';
+ next if $elem->{ 'type' } eq 'wiggle';
#$elem->{ 'strand' } = '+' if $elem->{ 'strand' } eq '+';
projects / biopieces.git / commitdiff