vq/make_residue_books.pl

   1 #!/usr/bin/perl
   2
   3 # quick, very dirty little script so that we can put all the
   4 # information for building a residue book set (except the original
   5 # partitioning) in one spec file.
   6
   7 #eg:
   8
   9 # >res0_128_128 interleaved
  10 # haux res0_96_128aux.vqd 0,4,2
  11 # :1 res0_128_128_1.vqd, 4, nonseq cull, 0 +- 1
  12 # :2 res0_128_128_2.vqd, 4, nonseq, 0 +- 1(.7) 2
  13 # :3 res0_128_128_3.vqd, 4, nonseq, 0 +- 1(.7) 3 5
  14 # :4 res0_128_128_4.vqd, 2, nonseq, 0 +- 1(.7) 3 5 8 11
  15 # :5 res0_128_128_5.vqd, 1, nonseq, 0 +- 1 3 5 8 11 14 17 20 24 28 31 35 39
  16
  17
  18 die "Could not open $ARGV[0]: $!" unless open (F,$ARGV[0]);
  19
  20 $goflag=0;
  21 while($line=<F>){
  22
  23     print "#### $line";
  24     if($line=~m/^GO/){
  25         $goflag=1;
  26         next;
  27     }
  28
  29     if($goflag==0){
  30         if($line=~m/\S+/ && !($line=~m/^\#/) ){
  31             my $command=$line;
  32             print ">>> $command";
  33             die "Couldn't shell command.\n\tcommand:$command\n"
  34                 if syst($command);
  35         }
  36         next;
  37     }
  38
  39     # >res0_128_128
  40     if($line=~m/^>(\S+)\s+(\S*)/){
  41         # set the output name
  42         $globalname=$1;
  43         $interleave=$2;
  44         next;
  45     }
  46
  47     # haux res0_96_128aux.vqd 0,4,2
  48     if($line=~m/^h(.*)/){
  49         # build a huffman book (no mapping)
  50         my($name,$datafile,$arg)=split(' ',$1);
  51
  52         my $command="huffbuild $datafile $arg";
  53         print ">>> $command\n";
  54         die "Couldn't build huffbook.\n\tcommand:$command\n"
  55             if syst($command);
  56         next;
  57     }
  58
  59     # :1 res0_128_128_1.vqd, 4, nonseq, 0 +- 1
  60     if($line=~m/^:(.*)/){
  61         my($namedata,$dim,$seqp,$vals)=split(',',$1);
  62         my($name,$datafile)=split(' ',$namedata);
  63         # build value list
  64         my$plusminus="+";
  65         my$list;
  66         my$thlist;
  67         my$count=0;
  68         foreach my$val (split(' ',$vals)){
  69             if($val=~/\-?\+?\d+/){
  70                 my$th;
  71
  72                 # got an explicit threshhint?
  73                 if($val=~/([0-9\.]+)\(([^\)]+)/){
  74                     $val=$1;
  75                     $th=$2;
  76                 }
  77
  78                 if($plusminus=~/-/){
  79                     $list.="-$val ";
  80                     if(defined($th)){
  81                         $thlist.="," if(defined($thlist));
  82                         $thlist.="-$th";
  83                     }
  84                     $count++;
  85                 }
  86                 if($plusminus=~/\+/){
  87                     $list.="$val ";
  88                     if(defined($th)){
  89                         $thlist.="," if(defined($thlist));
  90                         $thlist.="$th";
  91                     }
  92                     $count++;
  93                 }
  94             }else{
  95                 $plusminus=$val;
  96             }
  97         }
  98         die "Couldn't open temp file temp$$.vql: $!" unless
  99             open(G,">temp$$.vql");
 100         print G "$count $dim 0 ";
 101         if($seqp=~/non/){
 102             print G "0\n$list\n";
 103         }else{
 104             print G "1\n$list\n";
 105         }
 106         close(G);
 107
 108         my $command="latticebuild temp$$.vql > $globalname$name.vqh";
 109         print ">>> $command\n";
 110         die "Couldn't build latticebook.\n\tcommand:$command\n"
 111             if syst($command);
 112
 113         my $command="latticehint $globalname$name.vqh $thlist > temp$$.vqh";
 114         print ">>> $command\n";
 115         die "Couldn't pre-hint latticebook.\n\tcommand:$command\n"
 116             if syst($command);
 117
 118         if(-e $datafile){
 119
 120             if($interleave=~/non/){
 121                 $restune="res1tune";
 122             }else{
 123                 $restune="res0tune";
 124             }
 125
 126             if($seqp=~/cull/){
 127                 my $command="$restune temp$$.vqh $datafile 1 > $globalname$name.vqh";
 128                 print ">>> $command\n";
 129                 die "Couldn't tune latticebook.\n\tcommand:$command\n"
 130                     if syst($command);
 131             }else{
 132                 my $command="$restune temp$$.vqh $datafile > $globalname$name.vqh";
 133                 print ">>> $command\n";
 134                 die "Couldn't tune latticebook.\n\tcommand:$command\n"
 135                     if syst($command);
 136             }
 137
 138             my $command="latticehint $globalname$name.vqh $thlist > temp$$.vqh";
 139             print ">>> $command\n";
 140             die "Couldn't post-hint latticebook.\n\tcommand:$command\n"
 141                 if syst($command);
 142
 143         }else{
 144             print "No matching training file; leaving this codebook untrained.\n";
 145         }
 146
 147         my $command="mv temp$$.vqh $globalname$name.vqh";
 148         print ">>> $command\n";
 149         die "Couldn't rename latticebook.\n\tcommand:$command\n"
 150             if syst($command);
 151
 152         my $command="rm temp$$.vql";
 153         print ">>> $command\n";
 154         die "Couldn't remove temp files.\n\tcommand:$command\n"
 155             if syst($command);
 156
 157         next;
 158     }
 159 }
 160
 161 $command="rm -f temp$$.vqd";
 162 print ">>> $command\n";
 163 die "Couldn't remove temp files.\n\tcommand:$command\n"
 164     if syst($command);
 165
 166 sub syst{
 167     system(@_)/256;
 168 }