Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Untitled

By: a guest on Dec 6th, 2011  |  syntax: None  |  size: 3.79 KB  |  views: 27  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1.  
  2. # Here's an example of having BioPerl write an alignment into the middle
  3. # of an HTML stream:
  4.  
  5. use strict;
  6. use IO::Scalar;
  7. use BIo::AlignIO;
  8.  
  9. my $html = "<h1>Blah!</h1>\n";
  10. my $html_fh = new IO::Scalar \$html;
  11.  
  12. my $io = Bio::AlignIO->new(
  13.    -file => ("t/data/testaln.aln"));
  14. my $aln = $io->next_aln();
  15.  
  16. $io = Bio::AlignIO->new(
  17.    '-fh'=> $html_fh,
  18.    '-format' => 'clustalw');
  19. $io->write_aln($aln);
  20.  
  21. $html .= "<h1>All done! woot!</h1>\n";
  22. print $html;
  23.  
  24.  
  25.  
  26.  
  27. # Here's how Bio::AlignIO::clustalw writes $aln objects to files:
  28.  
  29.  
  30. =head2 write_aln
  31.  
  32.  Title   : write_aln
  33.  Usage   : $stream->write_aln(@aln)
  34.  Function: writes the clustalw-format object (.aln) into the stream
  35.  Returns : 1 for success and 0 for error
  36.  Args    : Bio::Align::AlignI object
  37.  
  38. =cut
  39.  
  40. sub write_aln {
  41.     my ( $self, @aln ) = @_;
  42.     my ( $count, $length, $seq, @seq, $tempcount, $line_len );
  43.     $line_len = $self->line_length || $LINELENGTH;
  44.     foreach my $aln (@aln) {
  45.         if ( !$aln || !$aln->isa('Bio::Align::AlignI') ) {
  46.             $self->warn(
  47. "Must provide a Bio::Align::AlignI object when calling write_aln"
  48.             );
  49.             next;
  50.         }
  51.         my $matchline = $aln->match_line;
  52.         if ( $self->force_displayname_flat ) {
  53.             $aln->set_displayname_flat(1);
  54.         }
  55.         $self->_print(
  56.             sprintf( "CLUSTAL W(%s) multiple sequence alignment\n\n\n",
  57.                 $CLUSTALPRINTVERSION )
  58.         ) or return;
  59.         $length = $aln->length();
  60.         $count  = $tempcount = 0;
  61.         @seq    = $aln->each_seq();
  62.         my $max = 22;
  63.         foreach $seq (@seq) {
  64.             $max = length( $aln->displayname( $seq->get_nse() ) )
  65.               if ( length( $aln->displayname( $seq->get_nse() ) ) > $max );
  66.         }
  67.  
  68.         while ( $count < $length ) {
  69.             my ( $linesubstr, $first ) = ( '', 1 );
  70.             foreach $seq (@seq) {
  71.  
  72.               #
  73.               #  Following lines are to suppress warnings
  74.               #  if some sequences in the alignment are much longer than others.
  75.  
  76.                 my ($substring);
  77.                 my $seqchars = $seq->seq();
  78.               SWITCH: {
  79.                     if ( length($seqchars) >= ( $count + $line_len ) ) {
  80.                         $substring = substr( $seqchars, $count, $line_len );
  81.                         if ($first) {
  82.                             $linesubstr =
  83.                               substr( $matchline, $count, $line_len );
  84.                             $first = 0;
  85.                         }
  86.                         last SWITCH;
  87.                     }
  88.                     elsif ( length($seqchars) >= $count ) {
  89.                         $substring = substr( $seqchars, $count );
  90.                         if ($first) {
  91.                             $linesubstr = substr( $matchline, $count );
  92.                             $first = 0;
  93.                         }
  94.                         last SWITCH;
  95.                     }
  96.                     $substring = "";
  97.                 }
  98.                 $self->_print(
  99.                     sprintf(
  100.                         "%-" . $max . "s %s\n",
  101.                         $aln->displayname( $seq->get_nse() ), $substring
  102.                     )
  103.                 ) or return;
  104.             }
  105.  
  106.             my $percentages = '';
  107.             if ( $self->percentages ) {
  108.                 my ($strcpy) = ($linesubstr);
  109.                 my $count = ( $strcpy =~ tr/\*// );
  110.                 $percentages =
  111.                   sprintf( "\t%d%%", 100 * ( $count / length($linesubstr) ) );
  112.             }
  113.             $self->_print(
  114.                 sprintf(
  115.                     "%-" . $max . "s %s%s\n",
  116.                     '', $linesubstr, $percentages
  117.                 )
  118.             );
  119.             $self->_print( sprintf("\n\n") ) or return;
  120.             $count += $line_len;
  121.         }
  122.     }
  123.     $self->flush if $self->_flush_on_write && defined $self->_fh;
  124.     return 1;
  125. }
clone this paste RAW Paste Data