use warnings;
use strict;
use Data::Dumper;
+use Maasha::Common;
use Maasha::Calc;
use vars qw( @ISA @EXPORT );
sub track_ruler
{
- my ( $width, # draw window width
- $y_offset, # y axis draw offset
- $beg, # base window beg
- $end, # base window end
- $font_size, # font size
- $color, # font color
+ my ( $draw_metrics, # hashref with image draw metrics
+ $cookie, # browser cookie
) = @_;
- my ( $factor, $step, $i, $txt, $x, @ruler );
+ my ( $beg, $end, $factor, $step, $i, $txt, $x, @ruler );
- $factor = $width / ( $end - $beg );
+ $beg = $cookie->{ 'NAV_START' };
+ $end = $cookie->{ 'NAV_END' };
+
+ $factor = $draw_metrics->{ 'IMG_WIDTH' } / ( $end - $beg );
$step = 10;
{
if ( ( $i % $step ) == 0 )
{
- $txt = "$i|";
+ $txt = Maasha::Calc::commify( $i ) . "|";
$x = sprintf( "%.0f", ( $i - $beg - length $txt ) * $factor );
- if ( $x > 0 and $x + ( $font_size * length $txt ) < $width )
+ if ( $x > 0 and $x + ( $draw_metrics->{ 'RULER_FONT_SIZE' } * length $txt ) < $draw_metrics->{ 'IMG_WIDTH' } )
{
push @ruler, {
type => 'text',
txt => $txt,
- font_size => $font_size,
- color => $color,
+ font_size => $draw_metrics->{ 'RULER_FONT_SIZE' },
+ color => $draw_metrics->{ 'RULER_COLOR' },
x1 => $x,
- y1 => $y_offset
+ y1 => $draw_metrics->{ 'TRACK_OFFSET' },
};
}
}
}
+ $draw_metrics->{ 'TRACK_OFFSET' } += $draw_metrics->{ 'TRACK_SPACE' };
+
return wantarray ? @ruler : \@ruler;
}
sub track_seq
{
- my ( $width, # draw window width
- $y_offset, # y axis draw offset
- $seq, # sequence to draw
- $font_size, # font size
- $color, # font color
+ my ( $draw_metrics, # hashref with image draw metrics
+ $cookie, # browser cookie
) = @_;
- my ( @chars, $factor, $i, @seq_list );
+ my ( $file, $fh, $seq, @chars, $factor, $i, @seq_list );
- @chars = split //, $seq;
+ if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 )
+ {
+ $file = path_seq( $cookie );
+ $fh = Maasha::Filesys::file_read_open( $file );
+ $seq = Maasha::Filesys::file_read( $fh, $cookie->{ 'NAV_START' } - 1, $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 );
+ close $fh;
+
+ @chars = split //, $seq;
+
+ $factor = $draw_metrics->{ 'IMG_WIDTH' } / @chars;
+
+ for ( $i = 0; $i < @chars; $i++ ) {
+ push @seq_list, {
+ type => 'text',
+ txt => $chars[ $i ],
+ font_size => $draw_metrics->{ 'SEQ_FONT_SIZE' },
+ color => $draw_metrics->{ 'SEQ_COLOR' },
+ x1 => sprintf( "%.0f", $i * $factor ),
+ y1 => $draw_metrics->{ 'TRACK_OFFSET' },
+ };
+ }
- $factor = $width / @chars;
+ $draw_metrics->{ 'TRACK_OFFSET' } += $draw_metrics->{ 'TRACK_SPACE' };
- for ( $i = 0; $i < @chars; $i++ ) {
- push @seq_list, {
- type => 'text',
- txt => $chars[ $i ],
- font_size => $font_size,
- color => $color,
- x1 => sprintf( "%.0f", $i * $factor ),
- y1 => $y_offset,
- };
+ return wantarray ? @seq_list : \@seq_list;
+ }
+ else
+ {
+ return;
}
-
- return wantarray ? @seq_list : \@seq_list;
}
sub track_feature
{
- my ( $width, # draw window width
- $y_offset, # y axis draw offset
- $beg, # base window beg
- $end, # base window end
- $entries, # list of unsorted KISS entries
+ my ( $track,
+ $draw_metrics,
+ $cookie,
+ ) = @_;
+
+ # Returns a list.
+
+ my ( $index, $count, $track_name, $start, $end, $entries, $features );
+
+ $start = $cookie->{ 'NAV_START' };
+ $end = $cookie->{ 'NAV_END' };
+
+ $index = Maasha::KISS::IO::kiss_index_retrieve( "$track/track_data.kiss.index" );
+ $count = Maasha::KISS::IO::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 => $draw_metrics->{ 'SEQ_FONT_SIZE' },
+ color => $draw_metrics->{ 'SEQ_COLOR' },
+ x1 => 0,
+ y1 => $draw_metrics->{ 'TRACK_OFFSET' },
+ } ];
+
+ $draw_metrics->{ 'TRACK_OFFSET' } += 10;
+
+ if ( $count > 5000 )
+ {
+ $entries = Maasha::KISS::IO::kiss_index_get_blocks( $index, $start, $end );
+ push @{ $features }, Maasha::KISS::Track::track_feature_histogram( $draw_metrics, $start, $end, $entries );
+ }
+ else
+ {
+ $entries = Maasha::KISS::IO::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
+ push @{ $features }, Maasha::KISS::Track::track_feature_linear( $draw_metrics, $start, $end, $entries );
+ }
+
+ return wantarray ? @{ $features } : $features;
+}
+
+
+sub track_feature_linear
+{
+ my ( $draw_metrics, # hashref with image draw metrics
+ $beg, # base window beg
+ $end, # base window end
+ $entries, # list of unsorted KISS entries
) = @_;
# Returns a list.
- my ( $feat_height, $factor, $entry, $y_step, @ladder, $w, $x1, $y1, $x2, $y2, @features );
+ my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, @features );
@{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries };
- $feat_height = 5;
- $factor = $width / ( $end - $beg );
- $y_step = 0;
+ $factor = $draw_metrics->{ 'IMG_WIDTH' } / ( $end - $beg );
+ $y_step = 0;
+ $y_max = 0;
foreach $entry ( @{ $entries } )
{
{
$x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor );
- for ( $y_step = 0; $y_step < @ladder; $y_step++ )
- {
+ for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
last if $x1 >= $ladder[ $y_step ] + 1;
}
- $y1 = $y_offset + ( $feat_height * $y_step );
+ $y1 = $draw_metrics->{ 'TRACK_OFFSET' } + ( $draw_metrics->{ 'FEAT_WIDTH' } * $y_step );
push @features, {
type => 'rect',
- line_width => $feat_height,
- color => 'green',
- title => $entry->{ 'Q_ID' },
+ line_width => $draw_metrics->{ 'FEAT_WIDTH' },
+ color => $draw_metrics->{ 'FEAT_COLOR' },
+ title => "Q_ID: $entry->{ 'Q_ID' } S_BEG: $entry->{ 'S_BEG' } S_END: $entry->{ 'S_END' } STRAND: $entry->{ 'STRAND' }",
+ id => $entry->{ 'Q_ID' },
x1 => $x1,
y1 => $y1,
x2 => $x1 + $w,
- y2 => $y1 + $feat_height,
+ y2 => $y1 + $draw_metrics->{ 'FEAT_WIDTH' },
};
- push @features, feature_align( $entry, $beg, $y1, $factor, $feat_height ) if defined $entry->{ 'ALIGN' };
+ $y_max = Maasha::Calc::max( $y_max, $y_step * $draw_metrics->{ 'FEAT_WIDTH' } );
+
+ push @features, feature_align( $entry, $beg, $y1, $factor, $draw_metrics->{ 'FEAT_WIDTH' } ) if $entry->{ 'ALIGN' } ne '.';
$ladder[ $y_step ] = $x1 + $w;
}
}
+ $draw_metrics->{ 'TRACK_OFFSET' } += $y_max + $draw_metrics->{ 'TRACK_SPACE' };
+
return wantarray ? @features : \@features;
}
{
foreach $align ( split /,/, $entry->{ 'ALIGN' } )
{
- if ( $align =~ /(\d+):(\w)>(\w)/ )
+ if ( $align =~ /(\d+):([ATCGN-])>([ATCGN-])/ )
{
$pos = $1;
$nt_before = $2;
}
else
{
- die;
+ Maasha::Common::error( qq(BAD align descriptor: "$align") );
}
$x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } + $pos - $beg ) * $factor );
push @features, {
type => 'rect',
line_width => $feat_height,
- color => 'red',
+ color => [ 1, 0, 0 ],
title => $align,
x1 => $x1,
y1 => $y_offset,
push @features, {
type => 'text',
font_size => $feat_height + 2,
- color => 'black',
+ color => [ 0, 0, 0 ],
txt => $nt_after,
x1 => $x1 + sprintf( "%.0f", ( $w / 2 ) ) - $feat_height / 2,
y1 => $y_offset + $feat_height,
}
-sub track_histogram
+sub track_feature_histogram
{
- my ( $width, # draw window width
- $y_offset, # y axis draw offset
- $min, # minimum base position
- $max, # maximum base position
- $entries, # list of unsorted KISS entries
+ my ( $draw_metrics, # hashref with image draw metrics
+ $min, # minimum base position
+ $max, # maximum base position
+ $blocks, # list of blocks
) = @_;
# Returns a list.
- my ( $hist_height, $bucket_width, $factor_heigth, $factor_width, $entry, $min_bucket, $max_height, $bucket_beg, $bucket_end, $i, @buckets, $bucket, @hist, $x, $h );
+ my ( $hist_height, $bucket_width, $bucket_count, $min_bucket, $factor, $factor_heigth, $max_height, $block, $bucket_beg, $bucket_end, $i, @buckets, $h, $x, @hist );
- return if $max == $min;
+ return if $max <= $min;
$hist_height = 100; # pixels
- $bucket_width = 5; # pixels
-
- $factor_width = ( $width / $bucket_width ) / ( $max - $min );
+ $bucket_width = 5;
+ $bucket_count = $draw_metrics->{ 'IMG_WIDTH' } / $bucket_width;
+ $factor = ( $draw_metrics->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 );
$min_bucket = 999999999;
$max_height = 0;
- foreach $entry ( @{ $entries } )
+ foreach $block ( @{ $blocks } )
{
- $bucket_beg = int( $entry->{ 'S_BEG' } * $factor_width );
- $bucket_end = int( $entry->{ 'S_END' } * $factor_width );
+ $bucket_beg = int( $block->{ 'BEG' } * $factor );
+ $bucket_end = int( $block->{ 'END' } * $factor );
$min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );
for ( $i = $bucket_beg; $i <= $bucket_end; $i++ )
{
- $buckets[ $i ]++;
+ $buckets[ $i ] += $block->{ 'COUNT' };
$max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] );
}
push @hist, {
type => 'line',
line_width => $bucket_width,
- color => 'green',
+ color => $draw_metrics->{ 'FEAT_COLOR' },
title => "Features: $buckets[ $i ]",
x1 => $x,
- y1 => $y_offset + $hist_height,
+ y1 => $draw_metrics->{ 'TRACK_OFFSET' } + $hist_height,
x2 => $x,
- y2 => $y_offset + $hist_height - $h,
+ y2 => $draw_metrics->{ 'TRACK_OFFSET' } + $hist_height - $h,
};
}
}
}
}
+ $draw_metrics->{ 'TRACK_OFFSET' } += $hist_height + $draw_metrics->{ 'TRACK_SPACE' };
+
return wantarray ? @hist : \@hist;
}
+sub path_seq
+{
+ my ( $cookie,
+ ) = @_;
+
+ # Returns a string.
+
+ my ( $path );
+
+ die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
+ die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
+ die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
+ die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
+ die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
+
+ $path = join( "/",
+ $cookie->{ 'DATA_DIR' },
+ "Users",
+ $cookie->{ 'USER' },
+ $cookie->{ 'CLADE' },
+ $cookie->{ 'GENOME' },
+ $cookie->{ 'ASSEMBLY' },
+ $cookie->{ 'CONTIG' },
+ "Sequence",
+ "sequence.txt"
+ );
+
+ die qq(ERROR: no such file: "$path".\n) if not -e $path;
+
+ return $path;
+}
+
+
+sub path_tracks
+{
+ my ( $cookie,
+ ) = @_;
+
+ # Returns a list.
+ #
+ my ( $path, @tracks );
+
+ die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
+ die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
+ die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
+ die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
+ die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
+
+ $path = join( "/",
+ $cookie->{ 'DATA_DIR' },
+ "Users",
+ $cookie->{ 'USER' },
+ $cookie->{ 'CLADE' },
+ $cookie->{ 'GENOME' },
+ $cookie->{ 'ASSEMBLY' },
+ $cookie->{ 'CONTIG' },
+ "Tracks",
+ );
+
+ if ( -d $path )
+ {
+ @tracks = Maasha::Filesys::ls_dirs( $path );
+
+ @tracks = grep { $_ !~ /\/\.\.?$/ } @tracks;
+
+ return wantarray ? @tracks : \@tracks;
+ }
+ else
+ {
+ return wantarray ? () : [];
+ }
+}
+
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1;
+
projects / biopieces.git / blobdiff