Home | History | Annotate | Download | only in vq 
      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 44c0_s/resaux_0.vqd res0_96_128aux 0,4,2 9
     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 44c0_s/resaux_0.vqd res0_96_128aux 0,4,2 9
     48     if($line=~m/^h(.*)/){
     49 	# build a huffman book (no mapping) 
     50 	my($name,$datafile,$bookname,$interval,$range)=split(' ',$1);
     51  
     52 	# check the desired subdir to see if the data file exists
     53 	if(-e $datafile){
     54 	    my $command="cp $datafile $bookname.tmp";
     55 	    print ">>> $command\n";
     56 	    die "Couldn't access partition data file.\n\tcommand:$command\n" 
     57 		if syst($command);
     58 
     59 	    my $command="huffbuild $bookname.tmp $interval";
     60 	    print ">>> $command\n";
     61 	    die "Couldn't build huffbook.\n\tcommand:$command\n" 
     62 		if syst($command);
     63 
     64 	    my $command="rm $bookname.tmp";
     65 	    print ">>> $command\n";
     66 	    die "Couldn't remove temporary file.\n\tcommand:$command\n" 
     67 		if syst($command);
     68 	}else{
     69 	    my $command="huffbuild $bookname.tmp 0-$range";
     70 	    print ">>> $command\n";
     71 	    die "Couldn't build huffbook.\n\tcommand:$command\n" 
     72 		if syst($command);
     73 
     74 	}
     75 	next;
     76     }
     77 
     78     # :1 res0_128_128_1.vqd, 4, nonseq, 0 +- 1
     79     if($line=~m/^:(.*)/){
     80 	my($namedata,$dim,$seqp,$vals)=split(',',$1);
     81 	my($name,$datafile)=split(' ',$namedata);
     82 	# build value list
     83 	my$plusminus="+";
     84 	my$list;
     85 	my$thlist;
     86 	my$count=0;
     87 	foreach my$val (split(' ',$vals)){
     88 	    if($val=~/\-?\+?\d+/){
     89 		my$th;
     90 
     91 		# got an explicit threshhint?
     92 		if($val=~/([0-9\.]+)\(([^\)]+)/){
     93 		    $val=$1;
     94 		    $th=$2;
     95 		}
     96 
     97 		if($plusminus=~/-/){
     98 		    $list.="-$val ";
     99 		    if(defined($th)){
    100 			$thlist.="," if(defined($thlist));
    101 			$thlist.="-$th";
    102 		    }
    103 		    $count++;
    104 		}
    105 		if($plusminus=~/\+/){
    106 		    $list.="$val ";
    107 		    if(defined($th)){
    108 			$thlist.="," if(defined($thlist));
    109 			$thlist.="$th";
    110 		    }
    111 		    $count++;
    112 		}
    113 	    }else{
    114 		$plusminus=$val;
    115 	    }
    116 	}
    117 	die "Couldn't open temp file $globalname$name.vql: $!" unless
    118 	    open(G,">$globalname$name.vql");
    119 	print G "$count $dim 0 ";
    120 	if($seqp=~/non/){
    121 	    print G "0\n$list\n";
    122 	}else{	
    123 	    print G "1\n$list\n";
    124 	}
    125 	close(G);
    126 
    127 	my $command="latticebuild $globalname$name.vql > $globalname$name.vqh";
    128 	print ">>> $command\n";
    129 	die "Couldn't build latticebook.\n\tcommand:$command\n" 
    130 	    if syst($command);
    131 
    132 	if(-e $datafile){
    133 	
    134 	    if($interleave=~/non/){
    135 		$restune="res1tune";
    136 	    }else{
    137 		$restune="res0tune";
    138 	    }
    139 	    
    140 	    if($seqp=~/cull/){
    141 		my $command="$restune $globalname$name.vqh $datafile 1 > temp$$.vqh";
    142 		print ">>> $command\n";
    143 		die "Couldn't tune latticebook.\n\tcommand:$command\n" 
    144 		    if syst($command);
    145 	    }else{
    146 		my $command="$restune $globalname$name.vqh $datafile > temp$$.vqh";
    147 		print ">>> $command\n";
    148 		die "Couldn't tune latticebook.\n\tcommand:$command\n" 
    149 		    if syst($command);
    150 	    }
    151 
    152 	    my $command="mv temp$$.vqh $globalname$name.vqh";
    153 	    print ">>> $command\n";
    154 	    die "Couldn't rename latticebook.\n\tcommand:$command\n" 
    155 		if syst($command);
    156 
    157 	}else{
    158 	    print "No matching training file; leaving this codebook untrained.\n";
    159 	}
    160 
    161 	my $command="rm $globalname$name.vql";
    162 	print ">>> $command\n";
    163 	die "Couldn't remove temp files.\n\tcommand:$command\n" 
    164 	    if syst($command);
    165 
    166 	next;
    167     }
    168 }
    169 
    170 $command="rm -f temp$$.vqd";
    171 print ">>> $command\n";
    172 die "Couldn't remove temp files.\n\tcommand:$command\n" 
    173     if syst($command);
    174 
    175 sub syst{
    176     system(@_)/256;
    177 }
    178