forester/archive/perl/pfam2slx.pl

   1 #! /usr/bin/perl
   2
   3 # Unpack a pfam flatfile, containing many alignments,
   4 # into separate SELEX-format alignment files.
   5 #
   6 # Assumes that ID is the first line in a record,
   7 # that SQ is the last line before the alignment starts,
   8 # and that there is one aligned sequence per line.
   9 #
  10
  11
  12 ################################################################
  13 # PFAMSERVER - The Washington University/St. Louis Pfam web server
  14 # Copyright (C) 1995-1999 Washington University School of Medicine
  15 # Copyright (C) 1995-1999 Sanger Centre/Genome Research Ltd.
  16 # Copyright (C) 1998-1999 Karolinska Institutet Center for Genomics Research
  17 # All Rights Reserved
  18 #
  19 #     This source code is distributed under the terms of the
  20 #     GNU General Public License. See the files COPYRIGHT and LICENSE
  21 #     for details.
  22 #
  23 ################################################################
  24
  25 $cpl = 50;                      # 50 sequence characters per line
  26 $/ = "\n//";            # paragraph mode on // separators
  27
  28 while (<>) {
  29     $in_alignment = 0;
  30     $nseq = 0;
  31     @lines = split(/^/);
  32     while ($line = shift(@lines)) {
  33         if ($in_alignment) {
  34             if    ($line =~ /^\#/) { next; }
  35             elsif ($line =~ /^(\S+)\s+(\S+)/) {
  36                 $name[$nseq] = $1;
  37                 $aseq[$nseq] = $2;
  38                 $nseq++;
  39             }
  40         }
  41         elsif ($line =~ /^\#=GF ID   (\S+)\s*$/) {
  42             $root = $1;
  43             print "working on $root\n";
  44             if (-e "$root") {
  45                 system ("mv $root $root.orig");
  46                 print "$root exists -- moved to $root.orig\n";
  47             }
  48             open(SELEX,">$root") || die;
  49             print SELEX "#=ID $root\n";
  50         }
  51         elsif ($line =~ /^\#=GF AC   (.+)$/) { print SELEX "#=AC $1\n"; }
  52         elsif ($line =~ /^\#=GF DE   (.+)$/) { print SELEX "#=DE $1\n"; }
  53
  54         elsif ($line =~ /^\#=GF GA   (\S+)\s+(\S+)/)
  55         { print SELEX "#=GA $1 $2\n"; }
  56
  57         elsif ($line =~ /^\#=GF TC   (\S+) (\S+)/)
  58         { print SELEX "#=TC $1 $2\n"; }
  59
  60         elsif ($line =~ /^\#=GF NC   (\S+) (\S+)/)
  61         { print SELEX "#=NC $1 $2\n"; }
  62
  63         elsif ($line =~ /^\#=GF SQ   \d+/) {
  64             print SELEX "# $line";
  65             $in_alignment = 1;
  66         }
  67         elsif ($line =~ /^\/\//) {
  68             last;
  69         }
  70         else {
  71             print SELEX "# $line";
  72         }
  73     }
  74
  75                                 # figure out maximum name length
  76     $maxnamelen = 0;
  77     for ($idx = 0; $idx < $nseq; $idx++) {
  78         if (length($name[$idx]) > $maxnamelen) {
  79             $maxnamelen = length($name[$idx]);
  80         }
  81     }
  82                                 # break the alignment across
  83                                 # multiple lines
  84     $alen = length($aseq[0]);
  85     for ($pos = 0; $pos < $alen; $pos += $cpl) {
  86         for ($idx = 0; $idx < $nseq; $idx++) {
  87             printf(SELEX "%-${maxnamelen}s %s\n",
  88                    $name[$idx], substr($aseq[$idx], $pos, $cpl));
  89         }
  90         print SELEX "\n";
  91     }
  92     close SELEX;
  93 }
  94