1 package Maasha::KISS::Track;
3 # Copyright (C) 2009 Martin A. Hansen.
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 # http://www.gnu.org/copyleft/gpl.html
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
25 # Routines for creating KISS tracks.
28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
36 use vars qw( @ISA @EXPORT );
38 @ISA = qw( Exporter );
41 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
46 my ( $draw_metrics, # hashref with image draw metrics
47 $cookie, # browser cookie
50 my ( $beg, $end, $factor, $step, $i, $txt, $x, @ruler );
52 $beg = $cookie->{ 'NAV_START' };
53 $end = $cookie->{ 'NAV_END' };
55 $factor = $draw_metrics->{ 'IMG_WIDTH' } / ( $end - $beg );
59 while ( ( $end - $beg ) / $step > 20 )
64 for ( $i = $beg; $i < $end; $i++ )
66 if ( ( $i % $step ) == 0 )
68 $txt = Maasha::Calc::commify( $i ) . "|";
69 $x = sprintf( "%.0f", ( $i - $beg - length $txt ) * $factor );
71 if ( $x > 0 and $x + ( $draw_metrics->{ 'RULER_FONT_SIZE' } * length $txt ) < $draw_metrics->{ 'IMG_WIDTH' } )
76 font_size => $draw_metrics->{ 'RULER_FONT_SIZE' },
77 color => $draw_metrics->{ 'RULER_COLOR' },
79 y1 => $draw_metrics->{ 'TRACK_OFFSET' },
85 $draw_metrics->{ 'TRACK_OFFSET' } += $draw_metrics->{ 'TRACK_SPACE' };
87 return wantarray ? @ruler : \@ruler;
93 my ( $draw_metrics, # hashref with image draw metrics
94 $cookie, # browser cookie
97 my ( $file, $fh, $seq, @chars, $factor, $i, @seq_list );
99 if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 )
101 $file = path_seq( $cookie );
102 $fh = Maasha::Filesys::file_read_open( $file );
103 $seq = Maasha::Filesys::file_read( $fh, $cookie->{ 'NAV_START' } - 1, $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 );
106 @chars = split //, $seq;
108 $factor = $draw_metrics->{ 'IMG_WIDTH' } / @chars;
110 for ( $i = 0; $i < @chars; $i++ ) {
114 font_size => $draw_metrics->{ 'SEQ_FONT_SIZE' },
115 color => $draw_metrics->{ 'SEQ_COLOR' },
116 x1 => sprintf( "%.0f", $i * $factor ),
117 y1 => $draw_metrics->{ 'TRACK_OFFSET' },
121 $draw_metrics->{ 'TRACK_OFFSET' } += $draw_metrics->{ 'TRACK_SPACE' };
123 return wantarray ? @seq_list : \@seq_list;
141 my ( $index, $count, $track_name, $start, $end, $entries, $features );
143 $start = $cookie->{ 'NAV_START' };
144 $end = $cookie->{ 'NAV_END' };
146 $index = Maasha::KISS::IO::kiss_index_retrieve( "$track/track_data.kiss.index" );
147 $count = Maasha::KISS::IO::kiss_index_count( $index, $start, $end );
149 $track_name = ( split "/", $track )[ -1 ];
150 $track_name =~ s/^\d+_//;
151 $track_name =~ s/_/ /g;
156 font_size => $draw_metrics->{ 'SEQ_FONT_SIZE' },
157 color => $draw_metrics->{ 'SEQ_COLOR' },
159 y1 => $draw_metrics->{ 'TRACK_OFFSET' },
162 $draw_metrics->{ 'TRACK_OFFSET' } += 10;
166 $entries = Maasha::KISS::IO::kiss_index_get_blocks( $index, $start, $end );
167 push @{ $features }, Maasha::KISS::Track::track_feature_histogram( $draw_metrics, $start, $end, $entries );
171 $entries = Maasha::KISS::IO::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
172 push @{ $features }, Maasha::KISS::Track::track_feature_linear( $draw_metrics, $start, $end, $entries );
175 return wantarray ? @{ $features } : $features;
179 sub track_feature_linear
181 my ( $draw_metrics, # hashref with image draw metrics
182 $beg, # base window beg
183 $end, # base window end
184 $entries, # list of unsorted KISS entries
189 my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, @features );
191 @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries };
193 $factor = $draw_metrics->{ 'IMG_WIDTH' } / ( $end - $beg );
197 foreach $entry ( @{ $entries } )
199 $w = sprintf( "%.0f", ( $entry->{ 'S_END' } - $entry->{ 'S_BEG' } + 1 ) * $factor );
203 $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor );
205 for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
206 last if $x1 >= $ladder[ $y_step ] + 1;
209 $y1 = $draw_metrics->{ 'TRACK_OFFSET' } + ( $draw_metrics->{ 'FEAT_WIDTH' } * $y_step );
213 line_width => $draw_metrics->{ 'FEAT_WIDTH' },
214 color => $draw_metrics->{ 'FEAT_COLOR' },
215 title => "Q_ID: $entry->{ 'Q_ID' } S_BEG: $entry->{ 'S_BEG' } S_END: $entry->{ 'S_END' } STRAND: $entry->{ 'STRAND' }",
216 id => $entry->{ 'Q_ID' },
220 y2 => $y1 + $draw_metrics->{ 'FEAT_WIDTH' },
223 $y_max = Maasha::Calc::max( $y_max, $y_step * $draw_metrics->{ 'FEAT_WIDTH' } );
225 push @features, feature_align( $entry, $beg, $y1, $factor, $draw_metrics->{ 'FEAT_WIDTH' } ) if $entry->{ 'ALIGN' } ne '.';
227 $ladder[ $y_step ] = $x1 + $w;
231 $draw_metrics->{ 'TRACK_OFFSET' } += $y_max + $draw_metrics->{ 'TRACK_SPACE' };
233 return wantarray ? @features : \@features;
241 my ( $entry, # Partial KISS entry
242 $beg, # base window beg
243 $y_offset, # y axis draw offset
244 $factor, # scale factor
245 $feat_height, # hight of feature in pixels
250 my ( $w, $align, $pos, $nt_before, $nt_after, $x1, @features );
252 $w = sprintf( "%.0f", 1 * $factor );
256 foreach $align ( split /,/, $entry->{ 'ALIGN' } )
258 if ( $align =~ /(\d+):([ATCGN-])>([ATCGN-])/ )
266 Maasha::Common::error( qq(BAD align descriptor: "$align") );
269 $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } + $pos - $beg ) * $factor );
273 line_width => $feat_height,
274 color => [ 1, 0, 0 ],
279 y2 => $y_offset + $feat_height,
282 if ( $w > $feat_height )
286 font_size => $feat_height + 2,
287 color => [ 0, 0, 0 ],
289 x1 => $x1 + sprintf( "%.0f", ( $w / 2 ) ) - $feat_height / 2,
290 y1 => $y_offset + $feat_height,
296 return wantarray ? @features : \@features;
300 sub track_feature_histogram
302 my ( $draw_metrics, # hashref with image draw metrics
303 $min, # minimum base position
304 $max, # maximum base position
305 $blocks, # list of blocks
310 my ( $hist_height, $bucket_width, $bucket_count, $min_bucket, $factor, $factor_heigth, $max_height, $block, $bucket_beg, $bucket_end, $i, @buckets, $h, $x, @hist );
312 return if $max <= $min;
314 $hist_height = 100; # pixels
316 $bucket_count = $draw_metrics->{ 'IMG_WIDTH' } / $bucket_width;
317 $factor = ( $draw_metrics->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 );
319 $min_bucket = 999999999;
322 foreach $block ( @{ $blocks } )
324 $bucket_beg = int( $block->{ 'BEG' } * $factor );
325 $bucket_end = int( $block->{ 'END' } * $factor );
327 $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );
329 for ( $i = $bucket_beg; $i <= $bucket_end; $i++ )
331 $buckets[ $i ] += $block->{ 'COUNT' };
333 $max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] );
337 if ( $max_height > 0 )
339 $factor_heigth = $hist_height / $max_height;
343 for ( $i = $min_bucket; $i < @buckets; $i++ )
345 if ( defined $buckets[ $i ] )
347 $h = sprintf( "%.0f", $buckets[ $i ] * $factor_heigth );
353 line_width => $bucket_width,
354 color => $draw_metrics->{ 'FEAT_COLOR' },
355 title => "Features: $buckets[ $i ]",
357 y1 => $draw_metrics->{ 'TRACK_OFFSET' } + $hist_height,
359 y2 => $draw_metrics->{ 'TRACK_OFFSET' } + $hist_height - $h,
368 $draw_metrics->{ 'TRACK_OFFSET' } += $hist_height + $draw_metrics->{ 'TRACK_SPACE' };
370 return wantarray ? @hist : \@hist;
383 die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
384 die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
385 die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
386 die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
387 die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
390 $cookie->{ 'DATA_DIR' },
393 $cookie->{ 'CLADE' },
394 $cookie->{ 'GENOME' },
395 $cookie->{ 'ASSEMBLY' },
396 $cookie->{ 'CONTIG' },
401 die qq(ERROR: no such file: "$path".\n) if not -e $path;
414 my ( $path, @tracks );
416 die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
417 die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
418 die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
419 die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
420 die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
423 $cookie->{ 'DATA_DIR' },
426 $cookie->{ 'CLADE' },
427 $cookie->{ 'GENOME' },
428 $cookie->{ 'ASSEMBLY' },
429 $cookie->{ 'CONTIG' },
435 @tracks = Maasha::Filesys::ls_dirs( $path );
437 @tracks = grep { $_ !~ /\/\.\.?$/ } @tracks;
439 return wantarray ? @tracks : \@tracks;
443 return wantarray ? () : [];
447 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<