mason/sequence/highlighted.mas

   1 <%doc>
   2
   3 =head1 NAME
   4
   5 /tools/sequence.mas - mason module to display a sequence, either as
   6 fasta text or as nicely formatted html, with optional highlighting of
   7 sub-regions.
   8
   9 =head1 ARGUMENTS
  10
  11 =over 5
  12
  13 =item seq
  14
  15 the sequence [Bio::Seq object]
  16
  17 =item title
  18
  19 the title of this section. Default is sequence id.
  20
  21 =item highlight_description
  22
  23 short plain-text description of the meaning of the highlighted regions,
  24 defaults to 'matches'
  25
  26 =item highlight_coords
  27
  28 a list of ONE-BASED refs to start/end coords, [start, end], [start,
  29 end], ...  Will be highlighted and sequence will be trimmed to show
  30 only a window around these regions, unless whole_seq is set below.
  31
  32 =item whole_seq
  33
  34 Display the entire sequence, do not cut out windows around the
  35 matches.  Default false.
  36
  37 =item width
  38
  39 width in characters to render the sequence, default 90
  40
  41 =item source
  42
  43 optional source name for the sequence, example "BLAST database such
  44 and such", or "Tomato unigene build blah blah"
  45
  46 =item blast_url
  47
  48 Optional URL to which a sequence could be POSTed to pre-fill the BLAST
  49 input form.
  50
  51 =back
  52
  53 =cut
  54
  55 </%doc>
  56
  57 <%args>
  58 $title => undef
  59 $seq
  60 $highlight_description => 'matches'
  61 $highlight_coords      => [ ]
  62 $width     => 100
  63 $source    => '<span class="ghosted">not recorded</span>'
  64 $whole_seq => 0
  65 $blast_url => undef
  66 $collapsable => 0
  67 $collapsed => 0
  68 </%args>
  69
  70 <&| /page/info_section.mas, title => $title || $seq->id(), collapsible=> $collapsable, collapsed=> $collapsed &>
  71
  72     <% info_table_html( 'Sequence ID' => link_identifier($seq->id) || $seq->id,
  73                         'Length'      => commify_number( $seq->length ),
  74                         'Source'      => $source,
  75                         __multicol    => 3,
  76                         __border      => 0,
  77
  78                         )
  79     %>
  80     <% info_table_html( 'Description' => $seq->desc || '<span class="ghosted">none</span>',
  81                         highlighted_regions( $highlight_coords, $highlight_description ),
  82                         __border => 0,
  83                         )
  84     %>
  85
  86     <div style="margin: 0.4em 0">&nbsp;</div>
  87
  88 %   for my $r ( @regions ) {
  89 %       my $w = $r->{window};
  90 %       my $highlight_count = sum map $_->end - $_->start +1, @{$r->{abs_ranges}};
  91
  92         <&| /page/info_section.mas,
  93               title => "Residues ".commify_number( $w->start ).' - '.commify_number( $w->end ),
  94               is_subsection => 1,
  95               subtitle => commify_number( $w->end - $w->start + 1 ).' residues shown, '.commify_number( $highlight_count || 0 ).' highlighted',
  96          &>
  97 %            my $wseq = $w->start == 1 && $w->end == $seq->length ? $seq : $seq->trunc( $w->start, $w->end );
  98 %            if( $wseq->length > 200_000 ) {
  99                  <span class="ghosted">Region too large to display.</span>
 100 %            } else {
 101                  <& /sequence/with_markup.mas,
 102                      width   => $width,
 103                      subdiv  => 10,
 104                      seq     => $wseq,
 105                      styles  => { highlight => [ '<span class="highlighted">', '</span>'] },
 106                      regions => [ map ['highlight', $_->start-1, $_->end], @{ $r->{rel_ranges} } ],
 107                      blast_url => $blast_url,
 108                  &>
 109 %            }
 110        </&>
 111 %    }
 112
 113 </&>
 114
 115 <%init>
 116   # sanitize the coords array (add 0 to all the numbers in it, forcing them to be purely numeric)
 117   my @highlight_coords = map [map $_+0, @$_], @$highlight_coords;
 118
 119   # calculate the pieces of the sequence that we will display, and that we will highlight
 120   my @regions = seq_windows_and_ranges( $seq, \@highlight_coords, $width );
 121
 122 </%init>
 123
 124 <%once>
 125 use List::Util qw/ min max sum /;
 126 use List::MoreUtils qw/ minmax /;
 127 use POSIX;
 128 use Storable 'dclone';
 129
 130 use Bio::Range ();
 131
 132 use CXGN::Page::FormattingHelpers qw(
 133    info_table_html
 134   );
 135
 136 use CXGN::Tools::Identifiers qw/ link_identifier /;
 137 use CXGN::Tools::Text qw/ commify_number /;
 138
 139 use constant LINE_WINDOW_EXPAND => 5;
 140
 141 sub coords_to_ranges {
 142     my ( $seq, $coords ) = @_;
 143     return
 144         map {
 145             Bio::Range->new( -start => max( 1, $_->[0]),
 146                              -end   => min( $seq->length, $_->[1] ),
 147                             )
 148         }
 149         sort { $a->[0] <=> $b->[0] }
 150         @$coords;
 151 }
 152
 153 sub seq_windows_and_ranges {
 154     my ( $seq, $coords, $width ) = @_;
 155
 156     unless ( $coords && @$coords ) {
 157         return {
 158             window     => Bio::Range->new( -start => 1, -end => $seq->length ),
 159             abs_ranges => [],
 160             rel_ranges => [],
 161         };
 162     }
 163
 164     # change the coords into ranges and sort by start coord, also
 165     # clamping them to the sequence length if needed, and merge any
 166     # overlapping ranges
 167     my @ranges = Bio::Range->unions( coords_to_ranges( $seq, $coords ) );
 168
 169     # calculate the windows of context for highlighted regions
 170     my @windows =
 171        # calculate 1-based non-overlapping ranges of *sequence* we will display
 172        sort { $a->start <=> $b->start }
 173        Bio::Range->unions(
 174            map {
 175                my $r = $_;
 176                my $match = Bio::Range->new(
 177                    -start => max( 0,
 178                                   ( POSIX::floor(($r->start-1)/$width) - LINE_WINDOW_EXPAND ),
 179                                 ) * $width + 1,
 180                    -end   => min( $seq->length/$width,
 181                                   ( POSIX::floor(($r->end)/$width ) + 1 + LINE_WINDOW_EXPAND ),
 182                                 ) * $width,
 183                   );
 184            } @ranges
 185        );
 186
 187     # decorate the windows with the other things that are needed to render them
 188     return map {
 189         my $window = $_;
 190
 191         # find ranges appicable to this window
 192         my @window_ranges =
 193             grep { $_->start >= $window->start && $_->end <= $window->end }
 194             @ranges;
 195
 196         # make another set of ranges that are relative to the window
 197         my @rel_window_ranges = map {
 198             my $r = dclone $_;
 199             $r->start( $r->start - $window->start + 1 );
 200             $r->end(   $r->end   - $window->start + 1 );
 201             $r
 202         } @window_ranges;
 203
 204         { window => $window, abs_ranges => \@window_ranges, rel_ranges => \@rel_window_ranges }
 205     } @windows;
 206 }
 207
 208
 209 sub highlighted_regions {
 210     my ( $coords, $highlight_description ) = @_;
 211     return unless $coords && @$coords;
 212
 213     return
 214         "Highlighted Regions ($highlight_description)" =>
 215         join ', ',
 216         map "$_->[0]-$_->[1]",
 217         @$coords;
 218 }
 219
 220 </%once>