From: martinahansen Date: Mon, 1 Mar 2010 11:27:28 +0000 (+0000) Subject: added wiggle to BGB X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=de5abed9d513e5d51e7bf6f1ee9feea48dac4ec9;p=biopieces.git added wiggle to BGB git-svn-id: http://biopieces.googlecode.com/svn/trunk@878 74ccb610-7750-0410-82ae-013aeee3265d --- diff --git a/bp_bin/BGB_upload b/bp_bin/BGB_upload index 7f77995..db707a9 100755 --- a/bp_bin/BGB_upload +++ b/bp_bin/BGB_upload @@ -34,6 +34,7 @@ use Maasha::KISS; use Maasha::Biopieces; use Maasha::Fasta; use Maasha::BGB::Common; +use Maasha::BGB::Wiggle; use Maasha::Filesys; use constant { @@ -47,20 +48,21 @@ 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 }, ] ); @@ -109,10 +111,18 @@ if ( $options->{ 'track_name' } ) 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"; } diff --git a/code_perl/Maasha/BGB/Draw.pm b/code_perl/Maasha/BGB/Draw.pm index dcb7ef0..d60c5e4 100644 --- a/code_perl/Maasha/BGB/Draw.pm +++ b/code_perl/Maasha/BGB/Draw.pm @@ -57,7 +57,9 @@ sub draw_feature # Returns nothing. - my ( $feature ); + my ( $feature, $first ); + + $first = 1; foreach $feature ( @{ $features } ) { @@ -69,6 +71,21 @@ sub draw_feature $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( @@ -99,8 +116,11 @@ sub draw_feature $cr->show_text( $feature->{ 'txt' } ); } - $cr->stroke; + #$cr->stroke; } + + $cr->fill_preserve; + $cr->stroke; } diff --git a/code_perl/Maasha/BGB/Track.pm b/code_perl/Maasha/BGB/Track.pm index a3cad5d..8032b82 100644 --- a/code_perl/Maasha/BGB/Track.pm +++ b/code_perl/Maasha/BGB/Track.pm @@ -37,6 +37,7 @@ use Maasha::Filesys; use Maasha::KISS; use Maasha::Biopieces; use Maasha::Seq; +use Maasha::BGB::Wiggle; use vars qw( @ISA @EXPORT ); @@ -166,54 +167,127 @@ 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 + 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. @@ -679,3 +753,55 @@ sub search_tracks_nc 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; +} diff --git a/code_perl/Maasha/Calc.pm b/code_perl/Maasha/Calc.pm index 363648a..5945d4d 100644 --- a/code_perl/Maasha/Calc.pm +++ b/code_perl/Maasha/Calc.pm @@ -386,6 +386,33 @@ sub log10 } +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. diff --git a/code_perl/Maasha/KISS.pm b/code_perl/Maasha/KISS.pm index 5b5bca7..be84108 100644 --- a/code_perl/Maasha/KISS.pm +++ b/code_perl/Maasha/KISS.pm @@ -100,6 +100,40 @@ sub kiss_entry_get } +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. diff --git a/code_perl/Maasha/Matrix.pm b/code_perl/Maasha/Matrix.pm index 5d340f3..9ff8b97 100644 --- a/code_perl/Maasha/Matrix.pm +++ b/code_perl/Maasha/Matrix.pm @@ -29,6 +29,7 @@ package Maasha::Matrix; use warnings; +no warnings 'recursion'; use strict; use Data::Dumper; use Storable qw( dclone ); @@ -958,7 +959,7 @@ sub list_deflate { # 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 @@ -967,26 +968,58 @@ sub list_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 ); + } } diff --git a/www/index.cgi b/www/index.cgi index b717ab9..faec6a5 100755 --- a/www/index.cgi +++ b/www/index.cgi @@ -45,10 +45,10 @@ $cookie = cookie_default( $cgi );; 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, ); @@ -855,6 +855,7 @@ sub section_browse foreach $elem ( @{ $feat } ) { next if $elem->{ 'type' } eq 'text'; + next if $elem->{ 'type' } eq 'wiggle'; #$elem->{ 'strand' } = '+' if $elem->{ 'strand' } eq '+';