Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 609 lines (453 sloc) 15.68 kb
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
1 =head1 NAME
2
66ac9b4 Oops. Forgot to change Bio::PSU to Bio::
kdj authored
3 Bio::Tk::HitDisplay - Frame-based widget for displaying Fasta or
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
4 Blast hits/HSPs with optional text annotation
5
6 =head1 SYNOPSIS
7
66ac9b4 Oops. Forgot to change Bio::PSU to Bio::
kdj authored
8 use Bio::Tk::HitDisplay;
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
9 ...
10 $hds = $parent->HitDisplay(?options?);
11
12 =head1 DESCRIPTION
13
14 B<HitDisplay> is a Frame-based widget which contains a Canvas. When
15 provided with a list of data structures, each representing a hit of a
16 query sequence to a database, it draws:
17
18 =over
19
20 =item * A scale
21
22 This is marked in residues (aa for a protein query, nt for a nucleic
23 acid query)
24
25 =item * The query sequence
26
27 Represented as a single green line
28
29 =item * Database hits
30
31 A line for each Fasta hit, or a group of lines for each Blast hit (one
32 per HSP)
33
34 =back
35
36 The coordinates of the hits/HSPs on the subject sequence (i.e. the
37 sequence in the database) are indicated below the ends of each line.
38
39 The B<HitDisplay> delegates all standard options to the Canvas contained
40 within it. The non-standard options for B<HitDisplay> are:
41
42 =over
43
cbf1619 @heikkil POD fixes
heikkil authored
44 =item B<-hitdata> =E<gt> \@hitdata
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
45
46 The structure of each element of this list is quite complex. They are
47 normally generated from object(s) representing Blast or Fasta hits e.g.
48
49 Bio::PSU::IO::Blast::Hit
50 Bio::PSU::IO::Fasta::Hit
51
52 by their respective adapters
53
54 Bio::PSU::IO::Blast::HitAdapter
55 Bio::PSU::IO::Fasta::HitAdapter
56
57 This is normally hidden, unless you want to go and look.
58
59 Each element is a reference to a hash containing the following keys
60 and values:
61
62 { q_id => 'query id',
63 s_id => 'subject id',
64 expect => 'expect value',
65 score => 'percentage identity',
66 overlap => 'length of hit',
67 q_len => 'query length',
68 s_len => 'subject length',
69 data => \@data,
70 text => "Some text",
71 callback => $callback }
72
73 @data is a list of references to lists, each of which contains the
74 coordinates of a single Fasta hit or Blast HSP on both the query and
75 subject sequences. Each innermost list contains 4 values; the start
76 and end coordinates on the query sequence (indices 0 and 1) and the
77 start and end coordinates on the subject sequence (indices 2 and 3). A
78 Blast hit with 3 HSPs will look like this:
79
80 [ [ q_start1, q_end1, s_start1, s_end1 ],
81 [ q_start2, q_end2, s_start2, s_end2 ],
82 [ q_start3, q_end3, s_start3, s_end3 ] ]
83
84 The text field may contain any text which should be associated with
85 that hit e.g. a more detailed account of the result or of the subject
86 sequence. The display of this text is bound to a right mouse button
87 click on the subject id in the canvas window. The text will appear
88 just below the hit with one click and a subsequent click will hide it
89 again.
90
91 The callback is a code reference which, if defined, will be bound to a
92 left mouse button click on the subject id in the canvas window.
93
cbf1619 @heikkil POD fixes
heikkil authored
94 =item B<-hitcolours> =E<gt> \%colourhash
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
95
96 The hits or HSPs will be colour-coded according to percentage identity
cbf1619 @heikkil POD fixes
heikkil authored
97 according to the key-E<gt>value pairs in the colourhash. The default
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
98 values are:
99
100 { 90 => 'red',
101 80 => 'orange',
102 60 => 'gold',
103 40 => 'yellow' }
104
cbf1619 @heikkil POD fixes
heikkil authored
105 This indicates that hits where the query is E<gt>= 90% identical to the
106 subject will be red, E<gt>= 80% will be orange etc. The hash supplied to
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
107 B<-hitcolours> will override the defaults.
108
cbf1619 @heikkil POD fixes
heikkil authored
109 =item B<-interval> =E<gt> integer E<gt>= 10
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
110
111 This defines the vertical spacing between hit lines on the canvas. The
112 minimum (and default) value is 10.
113
114 =back
115
116 Mouse bindings provided:
117
118 =over
119
120 =item * Vertical scrolling
121
122 Wheel-mouse support is provided by binding buttons 4 and 5 to vertical
123 scrolling (standard Z-axis mapping under XFree86 on Linux).
124
125 =item * Panning
126
127 Holding down the middle mouse button while dragging will pan the
128 canvas in all directions
129
130 =item * Display/hide all text annotations
131
132 Double-clicking the left mouse button within the canvas will display
133 all text annotations, while double-clicking with the right button will
134 hide them. This is slow at the moment, with more than about 20 hits.
135
136 =back
137
138 Possible improvements:
139
140 =over
141
142 =item * Speed up opening/closing all text annotations at once
143
144 =item * Items other than text between the hits
145
146 =item * Make more of the canvas configurable
147
148 Mouse bindings should be made configurable. Perhaps the canvas items
149 making up each hit should be given a unique tag
150
151 =back
152
153 =head1 METHODS
154
155 Interaction with this widget should generally be by means of the
156 standard Perl/Tk options. Internal methods are documented below.
157
158 =head1 AUTHOR
159
160 Keith James (kdj@sanger.ac.uk)
161
162 =head1 ACKNOWLEDGEMENTS
163
164 See Bio::PSU.pod
165
166 =head1 COPYRIGHT
167
168 Copyright (C) 2000 Keith James. All Rights Reserved.
169
170 =head1 DISCLAIMER
171
172 This module is provided "as is" without warranty of any kind. It
173 may redistributed under the same conditions as Perl itself.
174
175 =cut
176
66ac9b4 Oops. Forgot to change Bio::PSU to Bio::
kdj authored
177 package Bio::Tk::Hitdisplay;
f9d39c4 Added HitDisplay; Frame-based widget to display Blast/Fasta type results
kdj authored
178
179 use strict;
180 use Carp;
181 use Tk::Frame;
182 use Tk::Canvas;
183
184 use vars qw(@ISA);
185
186 @ISA = qw(Tk::Frame);
187
188 Tk::Widget->Construct('HitDisplay');
189
190 =head2 Populate
191
192 Title : Populate
193 Usage : N/A
194 Function: Standard composite Frame-based widget setup.
195 : See 'man Tk::composite' for details
196 Returns : Nothing
197 Args : Hash reference
198
199 =cut
200
201 sub Populate
202 {
203 my ($self, $args) = @_;
204
205 my $hitdata = delete $args->{-hitdata};
206 my $interval = delete $args->{-interval};
207 my $hitcolours = delete $args->{-hitcolours};
208
209 my $defaultcolours = { 90 => 'red',
210 80 => 'orange',
211 60 => 'gold',
212 40 => 'yellow' };
213
214 # A hash for storing callbacks, passed by reference to subs
215 my $callbackbox = { annotate => [],
216 deannotate => [] };
217
218 my $hititems = [];
219
220 # Check colour option passed in by user
221 if (defined $hitcolours)
222 {
223 unless (ref($hitcolours) eq 'HASH')
224 {
225 carp "Value passed to -hitcolours was not a hash reference; using defaults";
226 $hitcolours = $defaultcolours;
227 }
228 }
229 else
230 {
231 $hitcolours = $defaultcolours
232 }
233
234 # Check interval option passed in by user; default is 10
235 unless (defined $interval and $interval >= 10)
236 {
237 carp "Value passed to -interval was too small; using minimum (10)";
238 $interval = 10;
239 }
240
241 $self->SUPER::Populate($args);
242
243 $self->fontCreate('hv-n-tiny', -family => 'helvetica',
244 -size => 8, -weight => 'normal');
245 $self->fontCreate('hv-n-small', -family => 'helvetica',
246 -size => 10, -weight => 'normal');
247 $self->fontCreate('hv-b-small', -family => 'helvetica',
248 -size => 10, -weight => 'bold');
249 $self->fontCreate('hv-n-med', -family => 'helvetica',
250 -size => 12, -weight => 'normal');
251
252 my $cv = $self->Canvas->pack(-anchor => 'w',
253 -side => 'top',
254 -fill => 'both');
255
256 # Bindings to allow dragging movement
257 $cv->CanvasBind('<Button-2>', \&scroll_mark);
258 $cv->CanvasBind('<Button2-Motion>', [\&scroll_drag, 4]);
259
260 # Open/close all
261 $cv->CanvasBind('<Double-Button-1>', [\&open_all, $callbackbox]);
262 $cv->CanvasBind('<Double-Button-3>', [\&close_all, $callbackbox]);
263
264 # Binding to allow wheel-mouse scrolling
265 $cv->CanvasBind('<Button-4>', sub { $cv->yviewScroll(-1, 'units') });
266 $cv->CanvasBind('<Button-5>', sub { $cv->yviewScroll( 1, 'units') });
267
268 if (defined $hitdata)
269 {
270 $self->draw_scale($cv, $hitdata, 10, 100, 10);
271 $self->draw_align($cv, $hitdata, 10, 100, 70, $interval, $hitcolours, $callbackbox);
272 }
273 $cv->configure(-scrollregion => [$cv->bbox("all")]);
274
275 # All configuration options get passed to the canvas
276 $self->Advertise('Canvas' => $cv);
277 $self->ConfigSpecs(DEFAULT => [$cv]);
278 $self->Delegates(DEFAULT => $cv);
279 }
280
281 =head2 draw_align
282
283 Title : draw_align
284 Usage : N/A
285 Function: Draws hit text, line and coords for the hits
286 Returns : Nothing
287 Args : Canvas, hitdata hash reference, left margin for text,
288 : x coord for lines, y coord for lines, interval between
289 : sets of lines (representing 1 Fasta hit or 1+ Blast
290 : HSPs), hitcolours hash reference
291
292 =cut
293
294 sub draw_align
295 {
296 my ($self, $cv, $hitdata, $lmargin, $x, $y, $interval, $hitcolours, $callbackbox) = @_;
297
298 # Each element represents a hit (Fasta hit or collections of Blast HSPs)
299 foreach (@$hitdata)
300 {
301 my $q_id = $_->{q_id};
302 my $s_id = $_->{s_id};
303 my $pc = $_->{score};
304 my $expect = $_->{expect};
305 my $overlap = $_->{overlap};
306 my $q_len = $_->{q_len};
307 my $s_len = $_->{s_len};
308 my $data = $_->{data};
309 my $text = $_->{text};
310 my $callback = $_->{callback};
311 my $width = 4;
312 my $colour = 'black';
313
314 $q_id = "<query>" unless defined $q_id;
315 $s_id = "<subject>" unless defined $s_id;
316 $text = "" unless defined $text;
317
318 # Set colour according to % identity
319 foreach (sort keys %$hitcolours)
320 {
321 if ($pc >= $_) { $colour = $hitcolours->{$_} }
322 }
323
324 # Truncate over-long subject names
325 if (length($s_id) > 10)
326 {
327 $s_id = substr($s_id, 0, 9) . "..."
328 }
329
330 # Create subject name labels
331 my $t = $cv->createText($lmargin, $y,
332 -text => "$s_id",
333 -anchor => 'w',
334 -justify => 'left',
335 -font => 'hv-n-small',
336 -fill => 'blue');
337
338 # @$data is a list of list references to data of the form:
339 # [$q_start, $q_end, $s_start, $s_end]
340 # Here we sort by subject start position (index 2)
341 my @sorted = sort { $a->[2] <=> $b->[2] } @$data;
342
343 # Mark in HSP/Hit lines, alternating HSPs up & down for clarity
344 my $down = 0;
345 foreach (@sorted)
346 {
347 h_line($cv, $_, $x, $y, $width, $colour);
348
349 if ($down) { $y -= 15; $down = 0}
350 else { $y += 15; $down = 1}
351 }
352
353 # Do we need more space after HSPs?
354 my $spacer = 0;
355 if (scalar @$data > 1)
356 {
357 $y += 20;
358 $spacer = 15;
359
360 # Correct HSP alternation
361 if ($down) { $y -= 15 }
362 }
363
364 $y += $interval;
365
366 my $annotate = sub { annotate_hit($cv, $t, $text, $interval + $spacer, $callbackbox) };
367 push(@{$callbackbox->{annotate}}, $annotate);
368
369 # Bind action to subject name labels
370 $cv->bind($t, '<Button-3>', $annotate);
371
372 # Bind cursor change as a visual cue to click on the labels
373 $cv->bind($t, '<Enter>', sub { $cv->configure(-cursor => 'hand2') });
374 $cv->bind($t, '<Leave>', sub { $cv->configure(-cursor => 'left_ptr') });
375
376 # Bind user supplied callback to subject name labels
377 $cv->bind($t, '<Button-1>', $callback) if defined $callback;
378 }
379 }
380
381 =head2 h_line
382
383 Title : h_line
384 Usage : N/A
385 Function: Draws a single hit/HSP line with the subject coords
386 : below it
387 Returns : Nothing
388 Args : Canvas, hit hash reference, x coord for line,
389 : y coord for line, line width, line colour
390
391 =cut
392
393 sub h_line
394 {
395 my ($cv, $ref, $x, $y, $width, $colour) = @_;
396
397 # Text indicates subject coordinates
398 $cv->createText($ref->[0] + $x, $y + 7,
399 -text => $ref->[2],
400 -justify => 'left',
401 -font => 'hv-n-tiny');
402
403 $cv->createText($ref->[1] + $x, $y + 7,
404 -text => $ref->[3],
405 -justify => 'right',
406 -font => 'hv-n-tiny');
407
408 $cv->createLine($ref->[0] + $x, $y,
409 $ref->[1] + $x, $y,
410 -width => $width,
411 -fill => $colour);
412 }
413
414 =head2 draw_scale
415
416 Title : draw_scale
417 Usage : N/A
418 Function: Draws scale alongside line representing query
419 : sequence
420 Returns : Nothing
421 Args : Canvas, hit hash reference, left margin for text
422 : x coord for line, y coord for line
423
424 =cut
425
426 sub draw_scale
427 {
428 my ($self, $cv, $hitdata, $lmargin, $x, $y) = @_;
429
430 # Draw subject line
431 my $q_id = $hitdata->[0]->{q_id};
432 my $len = $hitdata->[0]->{q_len};
433
434 # Truncate over-long query names
435 if (length($q_id) > 10)
436 {
437 $q_id = substr($q_id, 0, 9) . "..."
438 }
439
440 # Scale ticks are marked every $div residues
441 my $div = 50;
442 my $ticks = sprintf("%d", $len / $div);
443 $ticks++ if $len % $div;
444
445 # Blank scale line
446 $cv->createLine($x, $y,
447 $x + $ticks * $div, $y,
448 -width => 1,
449 -fill => 'black');
450
451 # Ticks and labels
452 for (my $i = 0; $i <= $ticks; $i++)
453 {
454 $cv->createLine($x + $i * $div, $y,
455 $x + $i * $div, $y + 5,
456 -width => 1,
457 -fill => 'black');
458
459 $cv->createText($x + $i * $div, $y + 10,
460 -text => $i * $div + 1,
461 -anchor => 'w',
462 -justify => 'right',
463 -font => 'hv-n-small');
464 }
465
466 # Subject name
467 $cv->createText($lmargin, $y + 30,
468 -text => "$q_id",
469 -anchor => 'w',
470 -justify => 'left',
471 -font => 'hv-b-small');
472
473 # Subject line
474 $cv->createLine($x, $y + 30,
475 $x + $len, $y + 30,
476 -width => 4,
477 -fill => 'green');
478 }
479
480 =head2 deannotate_hit
481
482 Title : deannotate_hit
483 Usage : N/A
484 Function: Reverses the effect of annotate_hit
485 Returns : Nothing
486 Args : Canvas, text item (subject id), text to be inserted
487 : in gap, interval between hits
488
489 =cut
490
491 sub deannotate_hit
492 {
493 my ($cv, $t, $text, $interval, $td, $td_ht) = @_;
494
495 # Do nothing if the hit is already closed
496 return if ! grep /open/, $cv->gettags($t);
497
498 # Delete the hit details and remove the 'open' tags
499 $cv->delete($td);
500 my ($tx, $ty) = $cv->coords($t);
501 $cv->dtag($t, 'open');
502
503 # Shuffle up canvas items below the hit title
504 foreach ($cv->find('all'))
505 {
506 my ($x, $y) = $cv->coords($_);
507 $cv->move($_, 0, - $td_ht) if $y > $ty + $interval;
508 }
509
510 # Change the binding and colour of the closed hit
511 $cv->bind($t, '<Button-3>', [\&annotate_hit, $t, $text, $interval]);
512
513 $cv->itemconfigure($t, -fill => 'blue');
514
515 $cv->configure(-scrollregion => [$cv->bbox('all')]);
516 }
517
518 =head2 annotate_hit
519
520 Title : annotate_hit
521 Usage : N/A
522 Function: Displays hit annotation below a hit line by shuffling
523 : all canvas elements down the canvas and placing the
524 : annotation text in the gap
525 Returns : Nothing
526 Args : Canvas, text item (subject id), text to be inserted
527 : in gap, interval between hits
528
529 =cut
530
531 sub annotate_hit
532 {
533 my ($cv, $t, $text, $interval, $callbackbox) = @_;
534
535 # Do nothing if the hit is already open
536 return if grep /open/, $cv->gettags($t);
537
538 # Mark this hit title as open
539 my ($tx, $ty) = $cv->coords($t);
540 $cv->addtag('open', 'withtag', $t);
541
542 # Insert hit details in the gap created
543 my $td = $cv->createText($tx + 100, $ty + $interval,
544 -text => $text,
545 -justify => 'left',
546 -anchor => 'nw',
547 -font => 'hv-n-small',
548 -tags => 'working');
549
550 # Calculate the height of the newly added text. Movement
551 # is calculated with reference to the interval between hits
552 # plus this height
553 my @tdbox = $cv->bbox($td);
554 my $td_ht = $tdbox[3] - $tdbox[1];
555
556 # Shuffle down any canvas items below the title but
557 # not the newly added text
558 foreach ($cv->find('withtag', '!working'))
559 {
560 my ($x, $y) = $cv->coords($_);
561 $cv->move($_, 0, $td_ht) if $y > ($ty + $interval);
562 }
563
564 # Finished working on the added text
565 $cv->dtag($td, 'working');
566
567 my $deannotate = sub { deannotate_hit($cv, $t, $text, $interval, $td, $td_ht) };
568 push(@{$callbackbox->{deannotate}}, $deannotate);
569
570 # Change the binding and colour of the open hit
571 $cv->bind($t, '<Button-3>', $deannotate);
572
573 $cv->itemconfigure($t, -fill => 'black');
574
575 $cv->configure(-scrollregion => [$cv->bbox('all')]);
576 }
577
578 sub open_all
579 {
580 my ($cv, $callbackbox) = @_;
581 my $callbacks = $callbackbox->{annotate};
582
583 foreach (@$callbacks) { &$_ }
584 }
585
586 sub close_all
587 {
588 my ($cv, $callbackbox) = @_;
589 my $callbacks = $callbackbox->{deannotate};
590
591 foreach (@$callbacks) { &$_ }
592 }
593
594 sub scroll_mark
595 {
596 my ($cv) = @_;
597 my $e = $cv->XEvent;
598
599 $cv->scanMark($e->x, $e->y);
600 }
601
602 sub scroll_drag
603 {
604 my ($cv, $sensit) = @_;
605 my $e = $cv->XEvent;
606
607 $cv->scanDragto($e->x, $e->y, $sensit);
608 }
Something went wrong with that request. Please try again.