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 # +1a, 4, nonseq, 0 +- .25 .5
  13 # :2 res0_128_128_2.vqd, 4, nonseq, 0 +- 1(.7) 2
  14 # :3 res0_128_128_3.vqd, 4, nonseq, 0 +- 1(.7) 3 5
  15 # :4 res0_128_128_4.vqd, 2, nonseq, 0 +- 1(.7) 3 5 8 11
  16 # :5 res0_128_128_5.vqd, 1, nonseq, 0 +- 1 3 5 8 11 14 17 20 24 28 31 35 39
  17
  18
  19 die "Could not open $ARGV[0]: $!" unless open (F,$ARGV[0]);
  20
  21 $goflag=0;
  22 while($line=<F>){
  23
  24     print "#### $line";
  25     if($line=~m/^GO/){
  26         $goflag=1;
  27         next;
  28     }
  29
  30     if($goflag==0){
  31         if($line=~m/\S+/ && !($line=~m/^\#/) ){
  32             my $command=$line;
  33             print ">>> $command";
  34             die "Couldn't shell command.\n\tcommand:$command\n"
  35                 if syst($command);
  36         }
  37         next;
  38     }
  39
  40     # >res0_128_128
  41     if($line=~m/^>(\S+)\s+(\S*)/){
  42         # set the output name
  43         $globalname=$1;
  44         $interleave=$2;
  45         next;
  46     }
  47
  48     # haux res0_96_128aux.vqd 0,4,2
  49     if($line=~m/^h(.*)/){
  50         # build a huffman book (no mapping)
  51         my($name,$datafile,$arg)=split(' ',$1);
  52
  53         my $command="huffbuild $datafile $arg";
  54         print ">>> $command\n";
  55         die "Couldn't build huffbook.\n\tcommand:$command\n"
  56             if syst($command);
  57         next;
  58     }
  59
  60     # :1 res0_128_128_1.vqd, 4, nonseq, 0 +- 1
  61     if($line=~m/^:(.*)/){
  62         my($namedata,$dim,$seqp,$vals)=split(',',$1);
  63         my($name,$datafile)=split(' ',$namedata);
  64         # build value list
  65         my$plusminus="+";
  66         my$list;
  67         my$thlist;
  68         my$count=0;
  69         foreach my$val (split(' ',$vals)){
  70             if($val=~/\-?\+?\d+/){
  71                 my$th;
  72
  73                 # got an explicit threshhint?
  74                 if($val=~/([0-9\.]+)\(([^\)]+)/){
  75                     $val=$1;
  76                     $th=$2;
  77                 }
  78
  79                 if($plusminus=~/-/){
  80                     $list.="-$val ";
  81                     if(defined($th)){
  82                         $thlist.="," if(defined($thlist));
  83                         $thlist.="-$th";
  84                     }
  85                     $count++;
  86                 }
  87                 if($plusminus=~/\+/){
  88                     $list.="$val ";
  89                     if(defined($th)){
  90                         $thlist.="," if(defined($thlist));
  91                         $thlist.="$th";
  92                     }
  93                     $count++;
  94                 }
  95             }else{
  96                 $plusminus=$val;
  97             }
  98         }
  99         die "Couldn't open temp file temp$$.vql: $!" unless
 100             open(G,">temp$$.vql");
 101         print G "$count $dim 0 ";
 102         if($seqp=~/non/){
 103             print G "0\n$list\n";
 104         }else{
 105             print G "1\n$list\n";
 106         }
 107         close(G);
 108
 109         my $command="latticebuild temp$$.vql > $globalname$name.vqh";
 110         print ">>> $command\n";
 111         die "Couldn't build latticebook.\n\tcommand:$command\n"
 112             if syst($command);
 113
 114         my $command="latticehint $globalname$name.vqh $thlist > temp$$.vqh";
 115         print ">>> $command\n";
 116         die "Couldn't pre-hint latticebook.\n\tcommand:$command\n"
 117             if syst($command);
 118
 119         if($interleave=~/non/){
 120             $restune="res1tune";
 121         }else{
 122             $restune="res0tune";
 123         }
 124
 125         if($seqp=~/cull/){
 126             my $command="$restune temp$$.vqh $datafile 1 > $globalname$name.vqh";
 127             print ">>> $command\n";
 128             die "Couldn't tune latticebook.\n\tcommand:$command\n"
 129                 if syst($command);
 130         }else{
 131             my $command="$restune temp$$.vqh $datafile > $globalname$name.vqh";
 132             print ">>> $command\n";
 133             die "Couldn't tune latticebook.\n\tcommand:$command\n"
 134                 if syst($command);
 135         }
 136
 137         my $command="latticehint $globalname$name.vqh $thlist > temp$$.vqh";
 138         print ">>> $command\n";
 139         die "Couldn't post-hint latticebook.\n\tcommand:$command\n"
 140             if syst($command);
 141
 142         my $command="mv temp$$.vqh $globalname$name.vqh";
 143         print ">>> $command\n";
 144         die "Couldn't rename latticebook.\n\tcommand:$command\n"
 145             if syst($command);
 146
 147         # run the training data through book to cascade
 148         if($interleave=~/non/){
 149             $vqcascade="vqcascade";
 150         }else{
 151             $vqcascade="vqcascade -i";
 152         }
 153
 154         my $command="$vqcascade +$globalname$name.vqh $datafile > temp$$.vqd";
 155         print ">>> $command\n";
 156         die "Couldn't cascade latticebook.\n\tcommand:$command\n"
 157             if syst($command);
 158
 159
 160         my $command="rm temp$$.vql";
 161         print ">>> $command\n";
 162         die "Couldn't remove temp files.\n\tcommand:$command\n"
 163             if syst($command);
 164
 165         next;
 166     }
 167     # +a 4, nonseq, 0 +- 1
 168     if($line=~m/^\+(.*)/){
 169         my($name,$dim,$seqp,$vals)=split(',',$1);
 170
 171         # build value list
 172         my$plusminus="+";
 173         my$list;
 174         my$thlist;
 175         my$count=0;
 176         foreach my$val (split(' ',$vals)){
 177             if($val=~/\-?\+?\d+/){
 178                 my$th;
 179
 180                 # got an explicit threshhint?
 181                 if($val=~/([0-9\.]+)\(([^\)]+)/){
 182                     $val=$1;
 183                     $th=$2;
 184                 }
 185
 186                 if($plusminus=~/-/){
 187                     $list.="-$val ";
 188                     if(defined($th)){
 189                         $thlist.="," if(defined($thlist));
 190                         $thlist.="-$th";
 191                     }
 192                     $count++;
 193                 }
 194                 if($plusminus=~/\+/){
 195                     $list.="$val ";
 196                     if(defined($th)){
 197                         $thlist.="," if(defined($thlist));
 198                         $thlist.="$th";
 199                     }
 200                     $count++;
 201                 }
 202             }else{
 203                 $plusminus=$val;
 204             }
 205         }
 206         die "Couldn't open temp file temp$$.vql: $!" unless
 207             open(G,">temp$$.vql");
 208         print G "$count $dim 0 ";
 209         if($seqp=~/non/){
 210             print G "0\n$list\n";
 211         }else{
 212             print G "1\n$list\n";
 213         }
 214         close(G);
 215
 216         my $command="latticebuild temp$$.vql > $globalname$name.vqh";
 217         print ">>> $command\n";
 218         die "Couldn't build latticebook.\n\tcommand:$command\n"
 219             if syst($command);
 220
 221         my $command="latticehint $globalname$name.vqh $thlist > temp$$.vqh";
 222         print ">>> $command\n";
 223         die "Couldn't pre-hint latticebook.\n\tcommand:$command\n"
 224             if syst($command);
 225
 226         if($interleave=~/non/){
 227             $restune="res1tune";
 228         }else{
 229             $restune="res0tune";
 230         }
 231
 232         if($seqp=~/cull/){
 233             my $command="$restune temp$$.vqh temp$$.vqd 1 > $globalname$name.vqh";
 234             print ">>> $command\n";
 235             die "Couldn't tune latticebook.\n\tcommand:$command\n"
 236                 if syst($command);
 237         }else{
 238             my $command="$restune temp$$.vqh temp$$.vqd > $globalname$name.vqh";
 239             print ">>> $command\n";
 240             die "Couldn't tune latticebook.\n\tcommand:$command\n"
 241                 if syst($command);
 242         }
 243
 244         my $command="latticehint $globalname$name.vqh $thlist > temp$$.vqh";
 245         print ">>> $command\n";
 246         die "Couldn't post-hint latticebook.\n\tcommand:$command\n"
 247             if syst($command);
 248
 249         my $command="mv temp$$.vqh $globalname$name.vqh";
 250         print ">>> $command\n";
 251         die "Couldn't rename latticebook.\n\tcommand:$command\n"
 252             if syst($command);
 253
 254         # run the training data through book to cascade
 255         if($interleave=~/non/){
 256             $vqcascade="vqcascade";
 257         }else{
 258             $vqcascade="vqcascade -i";
 259         }
 260
 261         my $command="$vqcascade +$globalname$name.vqh temp$$.vqd > tempa$$.vqd";
 262         print ">>> $command\n";
 263         die "Couldn't cascade latticebook.\n\tcommand:$command\n"
 264             if syst($command);
 265
 266
 267         my $command="rm temp$$.vql";
 268         print ">>> $command\n";
 269         die "Couldn't remove temp files.\n\tcommand:$command\n"
 270             if syst($command);
 271
 272         my $command="mv tempa$$.vqd temp$$.vqd";
 273         print ">>> $command\n";
 274         die "Couldn't rename temp file.\n\tcommand:$command\n"
 275             if syst($command);
 276
 277         next;
 278     }
 279 }
 280
 281 $command="rm temp$$.vqd";
 282 print ">>> $command\n";
 283 die "Couldn't remove temp files.\n\tcommand:$command\n"
 284     if syst($command);
 285
 286 sub syst{
 287     system(@_)/256;
 288 }