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
  10 # haux res0_96_128aux.vqd 0,4,2
  11 # :1 res0_128_128_1.vqd, 4, nonseq cull, 0 +- 1
  12 # +a 4, nonseq, 0 +- .25 .5
  13 # :2 res0_128_128_2.vqd, 4, nonseq, 0 +- 1 2
  14 # :3 res0_128_128_3.vqd, 4, nonseq, 0 +- 1 3 5
  15 # :4 res0_128_128_4.vqd, 2, nonseq, 0 +- 1 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 # +a 4, nonseq, 0 +- .5 1
  18
  19
  20 die "Could not open $ARGV[0]: $!" unless open (F,$ARGV[0]);
  21
  22 while($line=<F>){
  23
  24     print "\n#### $line\n\n";
  25
  26     # >res0_128_128
  27     if($line=~m/^>(.*)/){
  28         # set the output name
  29         $globalname=$1;
  30         next;
  31     }
  32
  33     # haux res0_96_128aux.vqd 0,4,2
  34     if($line=~m/^h(.*)/){
  35         # build a huffman book (no mapping)
  36         my($name,$datafile,$arg)=split(' ',$1);
  37         my $command="huffbuild $datafile $arg > $globalname$name.vqh";
  38         print ">>> $command\n";
  39         die "Couldn't build huffbook.\n\tcommand:$command\n"
  40             if syst($command);
  41         next;
  42     }
  43
  44     # :1 res0_128_128_1.vqd, 4, nonseq, 0 +- 1
  45     if($line=~m/^:(.*)/){
  46         my($namedata,$dim,$seqp,$vals)=split(',',$1);
  47         my($name,$datafile)=split(' ',$namedata);
  48         # build value list
  49         my$plusminus="+";
  50         my$list;
  51         my$count=0;
  52         foreach my$val (split(' ',$vals)){
  53             if($val=~/\-?\+?\d+/){
  54                 if($plusminus=~/-/){
  55                     $list.="-$val ";
  56                     $count++;
  57                 }
  58                 if($plusminus=~/\+/){
  59                     $list.="$val ";
  60                     $count++;
  61                 }
  62             }else{
  63                 $plusminus=$val;
  64             }
  65         }
  66         die "Couldn't open temp file temp$$.vql: $!" unless
  67             open(G,">temp$$.vql");
  68         print G "$count $dim 0 ";
  69         if($seqp=~/non/){
  70             print G "0\n$list\n";
  71         }else{
  72             print G "1\n$list\n";
  73         }
  74         close(G);
  75
  76         my $command="latticebuild temp$$.vql > $globalname$name.vqh";
  77         print ">>> $command\n";
  78         die "Couldn't build latticebook.\n\tcommand:$command\n"
  79             if syst($command);
  80
  81         my $command="latticehint $globalname$name.vqh > temp$$.vqh";
  82         print ">>> $command\n";
  83         die "Couldn't pre-hint latticebook.\n\tcommand:$command\n"
  84             if syst($command);
  85
  86         if($seqp=~/cull/){
  87             my $command="restune temp$$.vqh $datafile 1 > $globalname$name.vqh";
  88             print ">>> $command\n";
  89             die "Couldn't tune latticebook.\n\tcommand:$command\n"
  90                 if syst($command);
  91         }else{
  92             my $command="restune temp$$.vqh $datafile > $globalname$name.vqh";
  93             print ">>> $command\n";
  94             die "Couldn't tune latticebook.\n\tcommand:$command\n"
  95                 if syst($command);
  96         }
  97
  98         my $command="latticehint $globalname$name.vqh > temp$$.vqh";
  99         print ">>> $command\n";
 100         die "Couldn't post-hint latticebook.\n\tcommand:$command\n"
 101             if syst($command);
 102
 103         my $command="mv temp$$.vqh $globalname$name.vqh";
 104         print ">>> $command\n";
 105         die "Couldn't rename latticebook.\n\tcommand:$command\n"
 106             if syst($command);
 107
 108         my $command="rm temp$$.vql";
 109         print ">>> $command\n";
 110         die "Couldn't remove temp files.\n\tcommand:$command\n"
 111             if syst($command);
 112
 113         next;
 114     }
 115 }
 116
 117 sub syst{
 118     system(@_)/256;
 119 }