1 package Maasha::BGB::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 Biopieces Browser tracks.
28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
38 use Maasha::Biopieces;
41 use vars qw( @ISA @EXPORT );
43 @ISA = qw( Exporter );
46 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
51 # Martin A. Hansen, November 2009.
53 # Create a track with a ruler of tics and positions for
56 my ( $cookie, # browser cookie
61 my ( $beg, $end, $factor, $step, $i, $txt, $x, @ruler );
63 $beg = $cookie->{ 'NAV_START' };
64 $end = $cookie->{ 'NAV_END' };
65 $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
69 while ( ( $end - $beg ) / $step > 20 ) {
73 for ( $i = $beg; $i < $end; $i++ )
75 if ( ( $i % $step ) == 0 )
77 $txt = "|" . Maasha::Calc::commify( $i );
78 $x = sprintf( "%.0f", ( ( $i - $beg ) * $factor ) + 2 );
80 if ( $x > 0 and $x + ( $cookie->{ 'RULER_FONT_SIZE' } * length $txt ) < $cookie->{ 'IMG_WIDTH' } )
85 font_size => $cookie->{ 'RULER_FONT_SIZE' },
86 color => $cookie->{ 'RULER_COLOR' },
88 y1 => $cookie->{ 'TRACK_OFFSET' },
94 $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
96 return wantarray ? @ruler : \@ruler;
102 # Martin A. Hansen, November 2009.
104 # Create a sequence track by extracting the appropriate
105 # stretch of sequence from the sequence file.
107 my ( $cookie, # browser cookie
112 my ( $file, $fh, $seq, @chars, $factor, $x_offset, $i, @seq_list );
114 if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 ) # only add sequence if less than or equal to 220.
116 $file = path_seq( $cookie );
117 $fh = Maasha::Filesys::file_read_open( $file );
118 $seq = Maasha::Filesys::file_read( $fh, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 );
121 @chars = split //, $seq;
123 $factor = $cookie->{ 'IMG_WIDTH' } / @chars;
125 $x_offset = sprintf( "%.0f", ( $factor / 2 ) - ( $cookie->{ 'SEQ_FONT_SIZE' } / 2 ) );
126 $x_offset = 0 if $x_offset < 0;
128 for ( $i = 0; $i < @chars; $i++ )
133 font_size => $cookie->{ 'SEQ_FONT_SIZE' },
134 color => $cookie->{ 'SEQ_COLOR' },
135 x1 => sprintf( "%.0f", $x_offset + $i * $factor ),
136 y1 => $cookie->{ 'TRACK_OFFSET' },
140 $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
142 return wantarray ? @seq_list : \@seq_list;
153 # Martin A. Hansen, November 2009.
155 # Create a track with features. If there are more than $cookie->FEAT_MAX
156 # features the track created will be a histogram, else linear.
158 my ( $track, # path to kiss file with track data
159 $cookie, # cookie hash
164 my ( $index, $count, $track_name, $start, $end, $entries, $features );
166 $start = $cookie->{ 'NAV_START' };
167 $end = $cookie->{ 'NAV_END' };
169 $index = Maasha::KISS::kiss_index_retrieve( "$track/track_data.kiss.index" );
170 $count = Maasha::KISS::kiss_index_count( $index, $start, $end );
172 $track_name = ( split "/", $track )[ -1 ];
173 $track_name =~ s/^\d+_//;
174 $track_name =~ s/_/ /g;
179 font_size => $cookie->{ 'SEQ_FONT_SIZE' },
180 color => $cookie->{ 'SEQ_COLOR' },
182 y1 => $cookie->{ 'TRACK_OFFSET' },
185 $cookie->{ 'TRACK_OFFSET' } += 10;
187 if ( $count > $cookie->{ 'FEAT_MAX' } )
189 $entries = Maasha::KISS::kiss_index_get_blocks( $index, $start, $end );
190 push @{ $features }, track_feature_histogram( $cookie, $start, $end, $entries );
194 $entries = Maasha::KISS::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
195 push @{ $features }, track_feature_linear( $cookie, $start, $end, $entries );
198 return wantarray ? @{ $features } : $features;
202 sub track_feature_linear
204 # Martin A. Hansen, November 2009.
206 # Create a linear feature track where the granularity depends
207 # on the lenght of the features and the browser window width.
209 my ( $cookie, # hashref with image draw metrics
210 $beg, # base window beg
211 $end, # base window end
212 $entries, # list of unsorted KISS entries
217 my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, @features );
219 @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries };
221 $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
225 foreach $entry ( @{ $entries } )
227 $w = sprintf( "%.0f", ( $entry->{ 'S_END' } - $entry->{ 'S_BEG' } + 1 ) * $factor );
231 $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor );
233 for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
234 last if $x1 >= $ladder[ $y_step ] + 1;
237 $y1 = $cookie->{ 'TRACK_OFFSET' } + ( ( 0.1 + $cookie->{ 'FEAT_WIDTH' } ) * $y_step );
241 line_width => $cookie->{ 'FEAT_WIDTH' },
242 color => $cookie->{ 'FEAT_COLOR' },
243 title => "Q_ID: $entry->{ 'Q_ID' } S_BEG: $entry->{ 'S_BEG' } S_END: $entry->{ 'S_END' } STRAND: $entry->{ 'STRAND' }",
244 q_id => $entry->{ 'Q_ID' },
245 s_beg => $entry->{ 'S_BEG' },
246 s_end => $entry->{ 'S_END' },
247 strand => $entry->{ 'STRAND' },
251 y2 => $y1 + $cookie->{ 'FEAT_WIDTH' },
254 $y_max = Maasha::Calc::max( $y_max, $y_step * ( 0.1 + $cookie->{ 'FEAT_WIDTH' } ) );
256 push @features, feature_align( $entry, $beg, $y1, $factor, $cookie->{ 'FEAT_WIDTH' } ) if $entry->{ 'ALIGN' } ne '.';
258 $ladder[ $y_step ] = $x1 + $w;
262 $cookie->{ 'TRACK_OFFSET' } += $y_max + $cookie->{ 'TRACK_SPACE' };
264 return wantarray ? @features : \@features;
270 # Martin A. Hansen, November 2009.
272 # Add to feature track alignment info if the granularity is
274 # TODO: The printing of chars is imprecise.
276 my ( $entry, # Partial KISS entry
277 $beg, # base window beg
278 $y_offset, # y axis draw offset
279 $factor, # scale factor
280 $feat_height, # hight of feature in pixels
285 my ( $w, $align, $pos, $nt_before, $nt_after, $x1, @features );
287 $w = sprintf( "%.0f", 1 * $factor );
291 foreach $align ( split /,/, $entry->{ 'ALIGN' } )
293 if ( $align =~ /(\d+):([ATCGN-])>([ATCGN-])/ )
301 Maasha::Common::error( qq(BAD align descriptor: "$align") );
304 $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } + $pos - $beg ) * $factor );
308 line_width => $feat_height,
309 color => [ 1, 0, 0 ],
314 y2 => $y_offset + $feat_height,
317 if ( $w > $feat_height )
321 font_size => $feat_height + 2,
322 color => [ 0, 0, 0 ],
324 x1 => $x1 + sprintf( "%.0f", ( $w / 2 ) ) - $feat_height / 2,
325 y1 => $y_offset + $feat_height,
331 return wantarray ? @features : \@features;
335 sub track_feature_histogram
337 # Martin A. Hansen, November 2009.
339 # Create a feature track as a histogram using information
340 # from the index only thus avoiding to load features from the
343 my ( $cookie, # hashref with image draw metrics
344 $min, # minimum base position
345 $max, # maximum base position
346 $blocks, # list of blocks
351 my ( $hist_height, $bucket_width, $bucket_count, $min_bucket, $factor, $factor_heigth, $max_height, $block, $bucket_beg, $bucket_end, $i, @buckets, $h, $x, @hist );
353 return if $max <= $min;
355 $hist_height = 100; # pixels
357 $bucket_count = $cookie->{ 'IMG_WIDTH' } / $bucket_width;
358 $factor = ( $cookie->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 );
360 $min_bucket = 999999999;
363 foreach $block ( @{ $blocks } )
365 $bucket_beg = int( $block->{ 'BEG' } * $factor );
366 $bucket_end = int( $block->{ 'END' } * $factor );
368 $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );
370 for ( $i = $bucket_beg; $i < $bucket_end; $i++ )
372 $buckets[ $i ] += $block->{ 'COUNT' };
374 $max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] );
378 if ( $max_height > 0 )
380 $factor_heigth = $hist_height / $max_height;
384 for ( $i = $min_bucket; $i < @buckets; $i++ )
386 if ( defined $buckets[ $i ] )
388 $h = sprintf( "%.0f", $buckets[ $i ] * $factor_heigth );
394 line_width => $bucket_width,
395 color => $cookie->{ 'FEAT_COLOR' },
396 title => "Features: $buckets[ $i ]",
398 y1 => $cookie->{ 'TRACK_OFFSET' } + $hist_height,
400 y2 => $cookie->{ 'TRACK_OFFSET' } + $hist_height - $h,
409 $cookie->{ 'TRACK_OFFSET' } += $hist_height + $cookie->{ 'TRACK_SPACE' };
411 return wantarray ? @hist : \@hist;
417 # Martin A. Hansen, November 2009.
419 # Returns the sequence from the contig in the beg/end interval
420 # contained in the cookie.
422 my ( $cookie, # cookie hash
427 my ( $path, $fh, $beg, $end, $len, $dna );
429 $path = path_seq( $cookie );
431 $beg = $cookie->{ 'S_BEG' };
432 $end = $cookie->{ 'S_END' };
435 $len = $end - $beg + 1;
438 $fh = Maasha::Filesys::file_read_open( $path );
440 $dna = Maasha::Filesys::file_read( $fh, $beg, $len );
442 $dna = Maasha::Seq::dna_revcomp( $dna ) if $cookie->{ 'STRAND' } eq '-';
444 Maasha::Seq::wrap( \$dna, 100 );
454 # Martin A. Hansen, November 2009.
456 # Returns the path to the sequence file for a specified
457 # contig as written in the cookie.
459 my ( $cookie, # cookie hash
466 die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
467 die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
468 die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
469 die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
470 die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
473 $cookie->{ 'DATA_DIR' },
476 $cookie->{ 'CLADE' },
477 $cookie->{ 'GENOME' },
478 $cookie->{ 'ASSEMBLY' },
479 $cookie->{ 'CONTIG' },
484 die qq(ERROR: no such file: "$path".\n) if not -e $path;
492 # Martin A. Hansen, November 2009.
494 # Returns a list of paths to all tracks for a specified
495 # contig as written in the cookie.
497 my ( $cookie, # cookie path
502 my ( $path, @tracks );
504 die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
505 die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
506 die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
507 die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
508 die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
511 $cookie->{ 'DATA_DIR' },
514 $cookie->{ 'CLADE' },
515 $cookie->{ 'GENOME' },
516 $cookie->{ 'ASSEMBLY' },
517 $cookie->{ 'CONTIG' },
523 @tracks = Maasha::Filesys::ls_dirs( $path );
525 @tracks = grep { $_ !~ /\/\.\.?$/ } @tracks;
527 return wantarray ? @tracks : \@tracks;
531 return wantarray ? () : [];
538 # Martin A. Hansen, December 2009.
540 # Uses grep to search all tracks in all contigs
541 # for a given pattern and return a list of KISS entries.
543 my ( $cookie, # cookie hash
548 my ( $search_track, $search_term, $contig, @tracks, $track, $file, $line, $out_file, $fh, $entry, @entries );
550 if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
555 $search_track =~ tr/ /_/;
559 $search_term = $cookie->{ 'SEARCH' };
562 foreach $contig ( @{ $cookie->{ 'LIST_CONTIG' } } )
564 $cookie->{ 'CONTIG' } = $contig;
566 push @tracks, path_tracks( $cookie );
569 @tracks = grep /$search_track/i, @tracks if $search_track;
571 foreach $track ( @tracks )
573 $file = "$track/track_data.kiss";
577 $fh = Maasha::Filesys::file_read_open( $file );
579 while ( $line = <$fh> )
583 if ( $line =~ /$search_term/i )
585 $entry = Maasha::KISS::kiss_entry_parse( $line );
587 push @entries, $entry;
595 return wantarray ? @entries : \@entries;
599 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<