mason/sequence/threeframe_translate.mas

   1 <%doc>
   2
   3 =head1 NAME
   4
   5 threeframe_translate.mas - display the three-frame translation of a sequence
   6
   7 =head1 ARGS
   8
   9 =head2 seq
  10
  11 The L<Bio::SeqI>-compliant nucleotide sequence to translate and display.
  12
  13 =head2 blast_url
  14
  15 If passed, display 'BLAST' forms for each translation that will post
  16 that translation to the given URL
  17
  18 =cut
  19
  20 </%doc>
  21
  22 <%args>
  23   $seq
  24   $blast_url => undef
  25 </%args>
  26
  27 <%perl>
  28
  29 # translate the sequences and annotate it with methionines,
  30 # stop_codons, and ORFs
  31 my @annotated_translations = map {
  32     my $frame = $_;
  33     my $translation = translate( $seq, $frame );
  34     my @annotations = (
  35         ( map ['methionine', @$_], all_indexes( $translation->seq, 'M' ) ),
  36         ( map ['stop_codon', @$_], all_indexes( $translation->seq, '*' ) ),
  37         ( map ['orf', @$_],        find_orfs( $translation->seq )        ),
  38        );
  39
  40     { frame => $frame, sequence => $translation, annotations => \@annotations }
  41 #    { frame => $frame, sequence => $translation, annotations => [['methionine', 1,2],['stop_codon',1,2],['orf',0,2]] }
  42 } 0..2;
  43
  44 # find the longest orf, and change its type (in the annotations data
  45 # structure) to 'longest_orf'
  46 { my $longest_orf;
  47   my $longest_orf_len = 0;
  48   foreach my $annotation ( map @{$_->{annotations}}, @annotated_translations ) {
  49       next unless $annotation->[0] eq 'orf';
  50       my $orf_len = $annotation->[2] -  $annotation->[1];
  51       if( $orf_len > $longest_orf_len ) {
  52           $longest_orf = $annotation;
  53           $longest_orf_len = $orf_len;
  54       }
  55   }
  56   $longest_orf->[0] = 'longest_orf' if $longest_orf;
  57 }
  58
  59 my $markup_styles = {
  60     map { $_ => [qq'<span class="$_">', '</span>'] }
  61         qw| methionine stop_codon orf longest_orf |
  62    };
  63
  64 </%perl>
  65
  66 <table class="threeframe_translate">
  67 %   for my $translation (@annotated_translations) {
  68    <tr>
  69       <td class="frame"><% $translation->{frame} %></td>
  70       <td class="sequence">
  71        <& /sequence/with_markup.mas,
  72           styles    => $markup_styles,
  73           seq       => $translation->{sequence},
  74           regions   => $translation->{annotations},
  75           blast_url => $blast_url,
  76         &>
  77       </td>
  78    </tr>
  79 % }
  80 <tr><td colspan="2">
  81 <div style="width: 20em; margin: -0.2em 0 0 auto; font-size: 90%">
  82   <span class="sequence"><span class="orf" style="border: 1px solid black">&nbsp;</span></span> open reading frame<br />
  83   <span class="sequence"><span class="longest_orf" style="border: 1px solid black">&nbsp;</span></span> longest open reading frame
  84 </div>
  85 </td></tr>
  86 </table>
  87
  88
  89 <%init>
  90 use Data::Dumper;
  91 use POSIX;
  92
  93 use JSON::Any; my $json = JSON::Any->new;
  94
  95 # given a string and substring, return arrayrefs of the start and end
  96 # (half-open) coordinates of all occurrences of that index for
  97 # example, [ 0,1 ] means the letter only at position 0 in the string
  98 # is included
  99 sub all_indexes {
 100     my ($string,$substring) = @_;
 101     my $len = length $substring
 102         or return;
 103     my @indexes;
 104     my $pos = 0;
 105     while( -1 != (my $inx = index($string,$substring,$pos))) {
 106         push @indexes, [$inx,$inx+$len];
 107         $pos = $inx+1;
 108     }
 109     return @indexes;
 110 }
 111
 112 # return the (half-open) coordinates of all open reading frames in the sequence
 113 sub find_orfs {
 114     my ($string) = @_;
 115     my @orfs;
 116     push @orfs, [ $-[0], $+[0] ] while $string =~ /M[^\*]+/gi;
 117     return @orfs;
 118 }
 119
 120 sub translate {
 121     my ($seq,$frame) = @_;
 122     my $t = $seq->translate( -frame => $frame );
 123     # add the translation frame to the seq name
 124     $t->id( $t->id.':tr'.$frame);
 125     return $t;
 126 }
 127 </%init>