#!/usr/bin/perl -w 

# This file is part of the Negative Database (NDB),
#   Copyright (C) 2003-2004 elena s ackley and the Regents of the University of New Mexico
# 
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use Time::Local;
use File::Temp;
use strict;


# Figure out where we were executed from and add that directory to the
# include path.  This is unwise in that it opens the possibility of
# sucking in anything included in the directory we're in, not just the
# stuff we want to allow sucking in..

sub BEGIN {
    # Seal us up a bit for living la vida tainted
    $ENV{'PATH'} = "/bin:/usr/bin";
    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

    my $dir = ($0 =~ m!^(.*)/!);
    if ($dir !~ m!^/!) {my $tmp = `pwd`; chop($tmp);}
    @INC=($dir, @INC) unless $INC[0] eq $dir;
}

my $version = "0.40";
my $BINFLAG = 0;
my $USE_PERMUTE = 1;
my $KNDB_ONLY = 0;
my $debug = 0;
my $debug1 = 0;   # details in subs
my $debug2 = 0;   # debug the prefix algorithm
my $debug5 = 0;   # debug kndb
my $debug6 = 0;   # debug rndb
my $debug7 = 0;   # debug rndb - or-ing recs
my $debug8 = 0;   # debug reset wini
my $debug9 = 0;   # debug db test
my $debug10 = 0;   # debug permute db
my $debug_ndb = 0;
my $debug_db = 0;   # if 1, save ascii DB as ADB
my $debugcmd = 0; # debug command line args
my $configfilepath = "./";
my $N = 0;          # size of DB
my $RN = 0;         # records added to RNDB
my $KN = 0;         # records added to KNDB
my $NN = 0;         # records added to NDB
my $LEN = 0;
my $MAXREADLEN;
my $DEFAULTLEN = 40;
my $DEFAULTWINI = 6;
my %RNDB;          # randomized ndb
my %NKDB;          # debug purposes: keys ndb, values kndb  
my %KNDB;          # keys c_key, values of NDB
my %NDB;
my %DB;
my %DBwhash;
my %ADB;           # ascii db unpadded
my %ADBwhash;      # ascii "windows"
my %UDB;
my $MAXL = 50;
my $ln2 = log(2);  # natural log of 2 constant
my $WINI = 0;
my $RESETWINI = 0;
my $WINIRESETFLAG = 1;    # if 0, don't use reset wini, o.w. at least log(LEN) +1;
my $IGNOREWINI = 0;       # if 1, ignore wini.
my $RNDBTIGHTFLAG = 0;    # if 1, or together rnd records; o.w. huge file
my $FENUM = 3;            # to satisfy 3SAT requirement
my $STEP6 = 0;            # default is LEN. 
my $seed = 0;
my $randcalls = 0;
my @PI;                   # permute order
my @PIR;                  # reverse permute order
my %kndb_siv;             # kdnb keys are permuted, siv hash is value
my @sumrecsz;             # array of sizes, 0 - LEN, values count of
                          # recs with that number of specified bits.
my @sumspecifiedbits;     # array for each bit in rec, values count
                          # times this bit is specified
my $MAX_KEY;              # based on KSTATS
my @KSTATS;               # max, totrecsz, totspecifiedbits, 
                          # array sumrecsz, array sumspecifiedbits, num records
my @RSTATS;               # same as KSTATS
my @NSTATS;               # same as KSTATS
my @DBSTATS;              # same as KSTATS
my $WEBDEMO = 0;
&main(@ARGV);

sub usage_abort{
    die "Usage: % perl prefixalg2.pl [-s <uses lastseed>] [-f <num> add to max key size] [-g <num> step 6 max] [-w don't reset wini] [-t do lengthy tests] [-p don't permute] [-k kndb only (no randomization)] [-d demo on web]\n";
}

sub command_args{
    my $cmdlineflag = @_;  #number of args
    my @args = @_;
    $debugcmd && print "got <$cmdlineflag> args\n";

	my $i = 0;

	while($i < $cmdlineflag) {
	    $debugcmd && print "find this arg <$args[$i]>\n";
	    
	    if ( $args[$i] =~ /\-([SsWwGgFfTtPpKkDd\?])$/ ) {
		my $c = uc $1;
		
		$debugcmd && print "arg is <$c>\n";
		
		if ( $c =~ /[WTPKSD]/ ) {
		    if ($c =~ /D/ ) {
			$WEBDEMO = 1;
			Print("WEBBASED DEMO.\n");
		    } elsif ($c =~ /W/ ) {
			$WINIRESETFLAG = 0;
			Print("WINI RESET DISABLED.\n");
		    } elsif ($c =~ /T/ ) {
			$debug_db = 1;
			Print("Complete DB testing will take extra time\n");
		    } elsif ($c =~ /P/ ) {
			$USE_PERMUTE = 0;
			Print("Permutations disabled.\n");
		    } elsif ($c =~ /K/ ) {
			$KNDB_ONLY = 1;
			Print("Only KNDB: no randomization for faster statistics.\n");
		    } elsif ($c =~ /S/ ) {
			$seed = 1;
			Print("Seed is from lastseed file.\n");
		    } else {
			&usage_abort;
		    }
		    $i++;
		} else {                # possible two arg cmds
		    if  ($c =~ /F/ ) {
			if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
			    &usage_abort;
			    $i++;
			} else {              # here parse bit length
			    $debugcmd && Print("2nd arg for F is <$args[$i+1]>\n");
			    $FENUM = $args[$i+1];
			    Print(" Adding $FENUM bits to MAX_KEY for RNDB records\n");
			    $i+=2;
			}
		    } elsif  ($c =~ /G/ ) {
			if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
			    &usage_abort;
			    $i++;
			} else {              # here parse bit length
			    $debugcmd && Print("2nd arg for G is <$args[$i+1]>\n");
			    $STEP6 = $args[$i+1];
			    Print("Generating <$STEP6> records for RNDB at step 6\n");
			    $i+=2;
			}
		    } else {
			&usage_abort;
		    }
		}
	    } else {
		&usage_abort;
	    }
	}	# end while
    return;
}


#read in words with an upper bound length; track the largest; return
#number of records;
sub read_db {
    my $maxl = 0;
    my $rej = 0;
    my $fn = "$configfilepath/DB.txt";
    my $total = 0;

    stat($fn);
    if (! -e _ ) {
	return 0;
    }

    open INDB,$fn || die "Unable to open positive $fn";

    while(<INDB>){
	my $rec="";
	my $okp=0;

	if(/^([01]+)$/ ){
	    if (!$BINFLAG && !$N) {
		$BINFLAG = 1; # detect binary DB
		print("Binary DB detected.");
		&PrintBR();
	    }
	    $rec = $1;
	    $okp = 1;
	} elsif ( /^([\w\S\.\- ]{1,$MAXL})$/ ){
	    $rec = $1;
#	    chop $rec;
	    Print("read DB record: <$rec>\n");
	    $okp = 1;
	} else {
	    Print("rejecting DB record: $_\n");
	    $rej++;
	}
	
	if ( $okp){
	    $total++;
	    my $nrec = lc($rec);  # lowercase for simplicity
	    my $l = length $nrec;
	    $debug && print "read record <$rec>\n";
	    if ($l > $maxl) { $maxl = $l;} 
	    &add_db_rec($nrec);
	    $debug && print "$1\n";
	} 
    }

    close INDB;
    print "\nDB size is $N --- read $total positive records, max length $maxl ";
    $rej && print "(rejected $rej records)";
    if ($total != $N) {
	print "( possible duplicates )";
    }
    &PrintBR();
    &PrintBR();

    $LEN = $maxl;
    if (!$STEP6) { $STEP6 = $LEN; }
    if ($STEP6 > $LEN) { $STEP6 = $LEN; }
    return $N;
}


sub add_db_rec {
    my $rec = $_[0];
    my $l = length $rec;
    my $rtn = 0;
    if(! defined $DB{$rec}) {
	$DB{$rec} = $l;
	!defined $DB{$rec} && die "record <$rec> not added to DB";
	$debug2 && print "ADDED rec to DB <$rec>, length <$l>\n";
	$N++;
	$rtn = 1;
    } else {
	$debug2 && print "Record $rec ALREADY PRESENT, skipping it\n";
    }
    return $rtn;
}


# pad all DB records with blanks to the maximum length read in
sub paddb {
    my $r;
    my %paddb;

    foreach $r (keys %DB) {
	my $s;
	if ($BINFLAG) {
	    $s = &pad_left($r,"0");
	} else {
	    $s = &pad_right($r," ");
	}
	$debug && print "THIS S is <$s>\n";
	$paddb{$s} = $DB{$r};       # unpadded length
    }

    return \%paddb;
}


sub pad_right_length {
    my $s = $_[0];
    my $c = $_[1];
    my $l = $_[2];
    my $sl = length $s;
    my $ns = $s . ($c x ($l - $sl));   # pad with blanks right
    return $ns;
}


sub pad_right {
    my $s = $_[0];
    my $c = $_[1];
    my $ns = &pad_right_length($s,$c,$LEN);
    return $ns;
}


sub pad_left_length {
    my $s = $_[0];
    my $c = $_[1];
    my $l = $_[2];
    my $sl = length $s;
    my $ns = ($c x ($l - $sl)) . $s;    # pad binary input with zeros left
    return $ns;
}


sub pad_left {
    my $s = $_[0];
    my $c = $_[1];
    my $ns = &pad_left_length($s,$c,$LEN);
    return $ns;
}


sub substitute_dots_and_dontcares {
    my $s = $_[0];
    $debug1 && $debug6 && print " sub dots and dontcares in <$s>, now ";
    $s =~ (s/\./\*/g);
    $debug1 && $debug6 && print "<$s>\n";
    return $s;
}


#convert the entire DB to binary ascii values; modify the len global
sub db2ord {
    my %orddb;
    my $r;
    my $nrl;

    $MAXREADLEN = $LEN;
    Print("Maxreadlen is $MAXREADLEN\n");

    $BINFLAG && return \%DB;

    foreach $r (keys %DB) {
	my $nr;
	$nr = convert_to_ord($r);
	$orddb{$nr} = $r;
	$nrl = length $nr;
    }
   
    my $tmp = $LEN; 
    $LEN = $LEN * 8;  #compensate for ascii binary conversion
    if ($STEP6 == $tmp) { $STEP6 = $LEN; } 
    $tmp = $LEN * $N;
    Print("Maxlength now $LEN to compensate for ascii binary conversion\n");
    Print("NDB upper bound is $tmp\n\n");

    if($WEBDEMO)
    {
	print_orddb(\%orddb);
    }

    return \%orddb;
}


sub convert_to_ord {
    my $rec = $_[0];
    my $r = reverse $rec;
    my $i = length $rec;
    my $nr;
    
    $debug && print "here's <$rec>..\n";

    while ($i) {
	my $c = chop($r);
	$debug && print "here's <$c>\n";
	$c = sprintf("%08b",ord($c));
	$debug && print "here's <$c> as ord\n";
	$nr = $nr.$c;
	$i--;
    }

    $debug && print "here's <$rec> converted <$nr>\n";   

    return $nr;
}


# make a hash table of all possible windows for the records in DB
sub dbwin {
    my $r;
    my $dbref = \%DBwhash;

    $debug && print "dbwin..\n";

    foreach $r (keys %DB) {
	$debug2 && print "call make windows for <$r>\n";
	&make_db_windows($r,$LEN,$dbref);
    }
    return;
}


sub adbwin {
    my $r;
    my $dbref = \%ADBwhash;

    $debug && print "adbwin..\n";

    foreach $r (keys %ADB) {
	my $l = length $r;
	$debug2 && print "call make adb windows for <$r>\n";
	&make_db_windows($r,$l,$dbref);
    }
    return;
}


sub make_db_windows {
    my $rec = $_[0];
    my $reclen = $_[1];
    my $dbref = $_[2];
    my $l = $reclen;
    my $r = $rec;

    $debug && print "windows for record <$rec>:\n";

    do {
	$$dbref{$r} = $l;
	$debug && print "windows for record <$r> length <$l>:\n";
	$r = substr($r,0,-1);  # all but the last char
	$l--;
    } while ($l);
}


sub find_pattern_neighbor_missing {
    my $p = $_[0];
    my $f0 = 0;
    my $f1 = 0;
    my $rtn = -1;
    my $x;

    $debug2 && print "looking for missing neighbor to <$p>\n";

    if (defined $DBwhash{$p.0}) {
	$f0++;
	$debug && print "found 0\n";
    }

    if (defined $DBwhash{$p.1}) {
	$f1++;
	$debug && print "found 1\n";
    }

    if ($f0 && $f1) {
	$rtn = 2;        # found both zeros and ones at position i
    } elsif ($f0) {
	$rtn = 1;        # only zero's at position i, one NOT THERE!
    } elsif ($f1) {
	$rtn = 0;        # only one's at position i, zero NOT THERE!
    }
    
    $rtn < 0 && die "impossible result in find_at_position <$p>\n";
    
    return $rtn;
}


sub round_up {
    my $n = $_[0];
    my $v = $_[1];
    !$v && die "round up death <$n> <$v>\n";
    return int($n*$v + .5)/$v;
}


sub logbase2 {
    my $x = $_[0];
    my $y = log($x)/$ln2;
    my $yint = int($y);
    
    $debug && print "The  base-2 log of <$x> is <$y>";
    
    if ($yint < $y) { 
	$yint++;
	$debug && print ", and the next highest int is <$yint>";
    }

    $debug && print "\n";
    return $yint;
}


# the largest prefix window for which all patterns are present
sub find_wini {
    my $wini = 0;  # largest prefix window: all patterns are present
    my $resetwini = 0;  # largest prefix window: all patterns will be present
    
#    print "fpnm #1\n";
    
    $debug && print "in find_wini..\n";
    
    my $z = &find_pattern_neighbor_missing("");
    if ( $z < 2) {
	$wini = 0;        
    } else {
	my $i= 1;
	
	while ($i < $LEN){
	    my $y;
	    foreach $y (keys %DBwhash) {
		if ($DBwhash{$y} == $i) {
#		    Print("fpnm #2\n");
		    $debug && print "finding pattern <$y> of length <$DBwhash{$y}>\n";
		    $z = &find_pattern_neighbor_missing($y);
		    if ( $z < 2) {
			$wini = $i;
			last;
		    } 
		}
	    }
	    if ($wini) { 
		$i = $LEN;
	    } else {
		$i++;
	    }
	}
    }

    Print("Wini is <$wini>\n");

    my $loglen = &logbase2($LEN);    
    if ($wini < $loglen) {
	$resetwini = $loglen;
    }

    Print("RESET Wini is <$resetwini>\n");
    return ($wini,$resetwini);
}


sub prefix {
    my $i= $WINI;
    my $z;
    my $lapse;
    my $perrec;
    my $start = time;

    Print("in prefix to make NDB..\n");

    if ($IGNOREWINI || (!$WINIRESETFLAG && !$WINI)) {
	Print("IGNORING WINI (NDB)\n");
	$z = &find_pattern_neighbor_missing("");
	if ( $z < 2) {
	    &add_ndb_rec($z);    # length is 1, l - length are '*'s
	}
	$i = 1;
    } elsif ($WINI < $RESETWINI && $WINIRESETFLAG && !$IGNOREWINI) {
	my $pc = 2**$RESETWINI;   # every possible combination 2**$resetwini
	my $pi = 0;
	$debug8 && print "($pc) reset wini in ndb\n";

	while($pi < $pc) {
	    my $x;
	    my $v = sprintf("%b",$pi);               # binary form
	    $v = pad_left_length($v,"0",$RESETWINI);
	    $debug8 && print "($pc)($pi)\n"; 
	    if (!defined $DBwhash{$v} ) {
		&add_ndb_rec($v);          # add just prefix and rest '*'s if both not found
	    }
	    $pi++;
	}
	$i=$RESETWINI;                 # continue with the remaining length of rec
    }

    
    while ($i < $LEN){
	my $y;
	foreach $y (sort keys %DBwhash) {
	    $debug && print "finding pattern <$y> of length <$DBwhash{$y}>\n";
	    if ($DBwhash{$y} == $i) {
#		print "fpnm #3\n";
		$z = &find_pattern_neighbor_missing($y);
		if ( $z < 2) {
		    my $pat = $y.$z;
		    &add_ndb_rec($pat);    # length is i+1, l - length are '*'s
		}
	    }
	}
	$i++;
    }

    $lapse = time - $start;
    $perrec = $lapse/$N;
    Print("NDB: created <$NN> records in $lapse time ($perrec sec/DBrec)\n");
    return;
}


sub randomize_ndb {
    my $z;
    my $lapse;
    my $perrec;
    my $start = time;

    Print("\nrandomize_ndb..\n");

    foreach $z (sort keys %NDB) {        # sort for repeatability
	&make_rndb_rec($z);
    }

    $lapse = time - $start;
    $perrec = $lapse/$N;                 # per DB record
    Print("RDB: created <$RN> records in $lapse time ($perrec sec/DBrec)\n");
    
    return;
}


# input is ndb prefix
sub make_rndb_rec {
    my $rec = $_[0];
    my $l = $NDB{$rec};
    my $dc = $LEN - $l;

    $debug6 && print "make_rndb_rec...record <$rec>. length <$l>\n";

    if (!$dc) {
	my $newrec = &pattern_generate($rec);
	$debug6 && print "\nMAKING 1 RNDB RECORD for <$rec>, length <$l>\n";
	&add_rndb_rec($newrec);

    } else {
	my $r = &pad_right($rec,".");  # pad input rec with regex don't cares
	my $j = &determine_minimum_records2add($STEP6);
	my $k = 0;
	my $bn = $MAX_KEY - $l + 1;

	$debug6 && print "\nMAKING at most <$j> RNDB RECORDS for <$rec>, length <$l>\n";
	$debug6 && print "$RN";

	while ($k < $j) {              # at least once though
	    if ($l <= $MAX_KEY) {
		my $ref = &random_distinct_bits_consecutive($bn,$dc,$l);
		my $dbits = scalar @$ref;       # number of indexes  
		&addallbitcombos($r,$ref,$dbits);
	    } else {
		my $newrec = &pattern_generate($r);
		&add_rndb_rec($newrec);
	    }
	    $k++;
	}
    $debug6 && print "\n";
    }
    return;
}


sub determine_minimum_records2add {
    my $step6 = $_[0];
    my $j;
    if ($step6 == 1) {
	$j = 1;
    } else {
	$j = int(&rander($step6));  # step 6
	if (!$j) { $j = 1; }        # minimum one time
    }
    return $j;
}


sub addallbitcombos {
    my $rec = $_[0];
    my $dcixref = $_[1];
    my $dbits = $_[2];
    my $pc = 2**$dbits;   # every possible combination 2**$dbits
    my $i = 0;
    
    $debug6 && print "add all bit combos ($pc) records\n";

    while($i < $pc) {
	my $x;
	my $newrec = $rec;
	my $v = sprintf("%b",$i);           # binary form
	$v = pad_left_length($v,"0",$dbits); # pad left w zeros only to dbits
	$v = reverse $v;
	$debug6 && print " for <$i>, a string of <$dbits> is <$v>\n";

	# sort the indexes in ascending order
	# replaces don't care in newrec with val.
	# from right to left.
	for ($x = 0; $x < $dbits; $x++) {
	    my $y = $$dcixref[$x];
	    my $val = chop($v);             # get the now "last" bit
	    $debug6 && print "splice call #9: <$newrec> at <$y> with <$val>\n";
		$newrec = &splice_string($newrec,$y,$val);
	    $debug6 && print "ss returns <$newrec>\n";
	}
	$newrec = &pattern_generate($newrec);
	&add_rndb_rec($newrec);
	$i++;
    }
    return;
}


# given the number of distinct indexes to select "at most", the range
# of choices (i.e. number of don't cares), and the offset length
# (i.e. the prefix), returns a reference to an array of size of the
# second arg, with dc-number of distinct indexes as its VALUES.
sub random_distinct_bits_consecutive {
    my $num = $_[0];
    my $dc = $_[1];
    my $l = $_[2];
    my $ref;
    
    if ($dc <= $num) {              # done if not enough to choose from
	my $x = 0;
	my @r;
	while ($x < $dc) {
	    $r[$x] = $l + $x;
	    $x++;
	}
	$ref = \@r;
    } elsif ($dc < (2 ** $num)) {         # rhs is a guess
	$ref = &shuffle_bits($num,$dc,$l);  # l rand calls
    } else {
	$ref = &lucky_bits($num,$dc,$l);    # undetermined rand calls
    }
    return $ref;
}


# given the number of distinct indexes to select "at most", the range of
# choices (i.e. number of don't cares), and the record;
# return a reference to array of size of the first arg, with that
# number of distinct (dc) indexes as its VALUES.
sub random_distinct_bits {
    my $num = $_[0];
    my $dc = $_[1];
    my $rec = $_[2];
    my $ref;
    my $choicesref = &list_of_choices($rec);
    my $sz = scalar @$choicesref;

    $sz > $dc && die "random distinct choices <$sz> impossible <$dc>\n";

    if ($dc <= $num) {              # done if not enough to choose from
#	print "rdbits: not enough to choose from\n";
	$ref = $choicesref;             # of %choices;
    } elsif ($dc < (2 ** $num)) {              # rhs is a guess
#	print "rdbits: do the shuffle\n";
	$ref = &shuffle_list($num,$choicesref,$sz);  # l rand calls
    } else {
#	print "rdbits: luckybitslist!!\n";
	$ref = &lucky_bits_list($num,$choicesref,$sz);    # undetermined rand calls
    }
    return $ref;
}


sub list_of_choices {
    my $x = $_[0];
    my @c = ();
    my $i = 0;
    my $l = length $x;
    my $n = 0;

    while ($i < $l) {
	my $s = substr($x,$i,1);
	if ( $s =~ /\./ ) {
	    $c[$n] = $i;
	    $n++;
	}
	$i++;
    }
    return \@c;
}



sub permute_db {
    my %pidb;
    my $r;

    if (!$USE_PERMUTE) { return \%DB;}
    
    &setup_permute_order();
    
    foreach $r (keys %DB) {
	my $s = &permute_record($r);
	$pidb{$s} = $r; 
	$debug10 && print "PIDB of <$r> is <$s>, $pidb{$s}\n";
    }

# built-in sanity check
    if ($debug10) {
	my $s;
	foreach $s (keys %pidb) {
	    my $t = &reverse_permute_record($s);
	    if ( $pidb{$s} !~ /$t/ ) {
		die "BUG <$s>, <$pidb{$s}> not back again to <$t>\n";
	    }
	}
    }
    return \%pidb;
}


# permute a record here 
sub permute_record {
    my $r = $_[0];
    my $l = length $r;
    my $p;
    my $s = "";

    $debug10 && print "permuting record <$r>..\n";

    # permute each record here 
    for ($p = 0; $p < $LEN; $p++) {
	my $tmp;
	$debug10 && print "take <$p>th <$PI[$p]>..\n";
	if ( $l <= $PI[$p] ) {
	    $tmp = ".";
	} else {
	    $tmp = substr($r,$PI[$p],1);
	}
	$s = $s . $tmp;
    }
    return $s;
}


# un-permute a record here
sub reverse_permute_record {
    my $r = $_[0];
    my $l = length $r;
    my $p;
    my $s = "";
	
    for ($p = 0; $p < $LEN; $p++) {
	my $tmp;
	if ($l <= $PIR[$p]) { 
	    $tmp = ".";         # for ndb case
	} else {
	    $tmp = substr($r,$PIR[$p],1);
	}
	$s = $s . $tmp;
    }

    return $s;
}


sub setup_permute_order {
    my $r;
    my $piref;

    $piref = &shuffle_bits($LEN,$LEN,0);
    @PI = @$piref;

    $debug10 && print "permute order now: ";
    for ($r = 0; $r < $LEN; $r++) {
	my $u = $PI[$r];
	$PIR[$u] = $r;
	$debug10 && print "$u ";
#	$debug10 && print "$r/$PI[$r] $u/$PIR[$u], ";
    }
    $debug10 && print "\n";
    
    if ($debug10 ) {
	my $v;
	print "reverse permute order now: ";
	for ($v = 0; $v < $LEN; $v++) {
	    print "$PIR[$v] ";
	}
	print "\n";
    }
    return;
}


sub reverse_permute {
    my $dbref = $_[0];
    my $dbname = $_[1];
    my $r;
    my %pirdb;

    if (!$USE_PERMUTE) { return $dbref;}

    foreach $r (keys %$dbref) {
	my $s = &reverse_permute_record($r);
	$pirdb{$s} = $$dbref{$r}; 
	$debug10 && print "$dbname: PIRDB of <$r> is <$s>, length $pirdb{$s}\n";
    }
    return \%pirdb;
}


# randomly switch all the 'dc' indexes and the pick the first 'num' 
sub shuffle_bits {
    my $num = $_[0];
    my $dc = $_[1];
    my $l = $_[2];
    my $ref;
    my $i;
    my @holder;

    for ($i = 0; $i < $dc; $i++) {
	$holder[$i] = $i + $l;   # init to the indexes
    }

    $ref = &shuffle_list($num,\@holder,$dc);
    return $ref;
}


# general function that picks num elements of alist at random
# returns a list of the alist values (not keys) selected.
sub shuffle_list {
    my $num = $_[0];
    my $alistref = $_[1];
    my $sz = $_[2];   # size of arraylist
    my @r;
    my $i;

    $debug6 && print "Shuffle_list: pick <$num> from <$sz>\n";

    for ($i = 0; $i < $sz; $i++) {
	my $x = int(&rander($sz));
	my $tmp = $$alistref[$i];
	$$alistref[$i] = $$alistref[$x];
	$$alistref[$x] = $tmp;
#	$debug6 && print "swap $$alistref[$x] at <$x> with $$alistref[$i] at <$i>\n";
    }

    $debug6 && print "shuffle_list returns <$num> out of <$sz> selections : ";
    for ($i = 0; $i < $num; $i++) {
	my $pick = $$alistref[$i];
	$r[$i] = $pick;                 # changed v.27 did it break? 
	$debug6 && print "$pick ";
    }
    $debug6 && print "\n";
    return \@r;
}


# lucky bits returns a distinct, random num-out-of-dc indexes as
# values in a array
sub lucky_bits {
    my $num = $_[0];
    my $dc = $_[1];
    my $l = $_[2];
    my $ref;
    my $i;
    my @holder;

    for ($i = 0; $i < $dc; $i++) {
	$holder[$i] = $i + $l;   # init to the indexes
    }

    $ref = &lucky_bits_list($num,\@holder,$dc);
    return $ref;
}


# lucky bits list returns a distinct, random num-out-of-dc indexes as
# values in a list, from alist of possibilites
sub lucky_bits_list {
    my $num = $_[0];
    my $alistref = $_[1];
    my $dc = $_[2];
    my %f = ();
    my @r = ();
    my $c = 0;
    my $y = $dc;
    my $chk = 0;

    $debug6 && print "lucky_bits_list returns <$num> out of <$dc> bits : ";

    while ($c < $num && $y > 0) {
	my $d = 0;
	my $x = int(&rander($dc));
	$chk++;
	while (defined $f{$x}) {
	    $x = int(&rander($dc));
	    $chk++;             # how many times MUST we do this?
	}
	$r[$c] = $$alistref[$x];       # value is the index of record
	$f{$x} = $r[$c];
	$debug6 && print "$r[$c] ";
	$c++;
	$y--;
    }
    $debug6 && print "--- <$chk> times calls to rand.\n";

    return \@r;
}




sub add_rndb_rec {
    my $rec = $_[0];
    my $l = length $rec;
    my $dc = &count_dontcares_rec($rec);
    $RNDB{$rec} = $l - $dc;
    !defined $RNDB{$rec} && die "record <$rec> not added to RNDB";
    $debug6 && print "ADDED rec to RNDB <$rec>, length <$RNDB{$rec}>\n";
    $RN++;
    if ($RNDB{$rec} != $MAX_KEY ) {
	die "rec <$rec> length is <$RNDB{$rec}> not $MAX_KEY\n";
    }
    return 1;
}


sub add_kndb_rec {
    my $rec = $_[0];
    my $val = $_[1];
    my $l = length $rec;
    my $dc = &count_dontcares_rec($rec);
    $KNDB{$rec} = $l - $dc;
    !defined $KNDB{$rec} && die "record <$rec> not added to KNDB";
    $debug2 && print "ADDED rec to KNDB <$rec>, length <$KNDB{$rec}>\n";
    $KN++;
    $NKDB{$val} = $rec;
    return 1;
}


sub add_ndb_rec {
    my $rec = $_[0];
    my $l = length $rec;
    $NDB{$rec} = $l;
    !defined $NDB{$rec} && die "record <$rec> not added to NDB";
    $debug2 && print "ADDED rec to NDB <$rec>, length <$l>\n";
    $NN++;
    return 1;
}


sub pattern_generate {
    my $r = $_[0];
    my $l;
    my $k;
    my $s;
    my $sivref;
    my $dc;
    my $pdbref;
    my $pr;
    my @savepi = @PI;
    my @savepir = @PIR;

    $debug5 && print "\npattern_generate: consider NDB record: <$r>\n";
#	print "call c_key from pg\n";

    $pdbref = &permute_db();     # temp, not changing DB
    $pr = &permute_record($r);

    ($s, $sivref) = &c_key($pr,$pdbref);

    $l = length $s;
    $l > $LEN && die "pg: <$s> is length <$l>\n";
    $dc = &count_dontcares_rec($s);

    $k = &pattern_generate_2($pr,$s,$sivref,$l-$dc);
    $s = &reverse_permute_record($k);

    @PI = @savepi;
    @PIR = @savepir;    
    return $s;
}


# c_key results are input to this function.
sub pattern_generate_2 {
    my $r = $_[0];
    my $s = $_[1];
    my $sivref = $_[2];
    my $l = $_[3];
    my $t = $MAX_KEY - $l;
    my @alist = sort {$a <=> $b} keys %$sivref;   # sort might help reruns
    my $sz = @alist;
    my $k;
    $debug6 && print "t is <$t> and size of siv is <$sz>\n";

    if (!$t || !$sz) {
	$k = $s;
	Print("Warning PG2: not enough bits! (0)\n");
    } elsif ($t >= $sz) {
	$k = $r;
	Print("Warning PG2: not enough bits! ($sz)\n");
    } else {
	my $rixref = &shuffle_list($t,\@alist,$sz);
	my $x;
	$k = $s;
	for ($x = 0; $x < $t; $x++){
	    my $y = $$rixref[$x];
#	    print "splice call #2 with <$y>\n";
	    $k = &splice_string($k,$y,$$sivref{$y});
	}
    }

    $debug6 && print "done: returning <$k>\n\n";

    return $k;
}


# inserts r at position v of string s, returns new string ns.
sub splice_string {
    my $s = $_[0];
    my $v = $_[1];
    my $r = $_[2];
    my $l = length $s;
    
    $l > $LEN && die "length of <$s> is <$l> not $LEN\n";
    $v > $l && die "Bogus splicing position <$v> for string <$s> length <$l>\n";

    $debug && $debug6 &&  print "splice_string: <$s> at <$v> with <$r> length <$l>\n"; 
    my $ns = substr($s,0,$v) . $r;
    if ($v < $l) {
	$ns = $ns . substr($s,$v+1,$l-$v-1);
    }
    $debug1 && $debug6 && print "splice_string: newstring is <$ns>\n"; 
    my $lns = length $ns ;
    $lns > $LEN && die "splice: newstring <$ns> is too big <$lns>\n";
    return $ns;
}


sub c_key {
    my $r = $_[0];
    my $dbref = $_[1];
    my $l = length $r;
    $l > $LEN && die "ckey: string <$r> is length <$l>\n";
    my $s = $r;
    my $v;
    my %cksiv;

    $debug5 && print "\nc_key: consider NDB record: <$r>\n";
    for ($v = 0; $v < $l; $v++) {
	my $c = substr($s,$v,1);             # save for later
	if ($c =~ /\./) { next; }              # nothing to do if already don't care
#	print "splice call #3\n";
	my $f = &splice_string($s,$v,".");
	my $fndpatt = &query_db($f,$dbref);
	
	if (!$fndpatt) {      # remove bit if still not in DB
	    $debug5 && print "c_key: bit index <$v> value <$c> not in DB\n";
	    $s = $f;
	    $cksiv{$v} = $c;    # save index and value
	}
    }

    $s = &pad_right($s,".");    # pad right with don't care's
    $debug5 && print "c_key is <$s>\n";
    return ($s,\%cksiv);
}


# for now let's say, kndb is a hash of c_keys
sub create_kndb {
    my $k;
    my $lapse;
    my $perrec;
    my $start = time;

    Print("\ncreating_knb..(ndb keys only)\n");

    foreach $k (keys %NDB) {
	my $r;
	my $ivref;

#	print "call c_key from kndb\n";
	($r,$ivref) = &c_key($k,\%DB);
	&add_kndb_rec($r,$k);
	$kndb_siv{$k} = $ivref;         # for use later v.34
	if ($debug5) {
	    my $i;
	    my $ref = $kndb_siv{$k};
	    print "for c_key record <$r>:\n";
	    foreach $i (keys  %$ref) {
		print "$i, $$ref{$i}, $$ivref{$i}\n";
	    }
	}
    }

    $lapse = time - $start;
    $perrec = $lapse/$N;
    Print("KNDB: created <$KN> records in $lapse time ($perrec sec/DBrec)\n");

    return;
}


# assumes xndb is unpermuted.
# return maximum c_key record size (in specified bits); setup
# two sum.. arrays of distributions to print later.
sub stats {
    my $dbref = $_[0];
    my $dbname = $_[1];
    my $y;
    my $l;
    my $max = 0;
    my @sumrecsz;
    my @sumspecifiedbits;
    my $totrecsz = 0;
    my $totspecifiedbits = 0;
    my $numrecs = scalar keys %$dbref;

    for ($l = 0; $l <= $LEN; $l++) {   # init arrays
	$sumrecsz[$l] = 0;
	$sumspecifiedbits[$l] = 0;
    } 

    foreach $y (keys %$dbref) {
	my $v = $$dbref{$y};
#	print "rec is <$y>, val is <$v>\n";
	$sumrecsz[$v]++;
	$totrecsz += $v;

	if ( $v > $max ) {
	    $max = $v;
	}

	for ($l = 0; $l < $LEN; $l++) {
	    my $c = substr($y,$l,1);
	    if ( $c =~ /[10]/ ) {
		$sumspecifiedbits[$l]++;
		$totspecifiedbits++;
	    }
	}
    }

    $debug5 && print "HERE YA GO: <$totrecsz>\n";
    return ($max,$totrecsz,$totspecifiedbits,\@sumrecsz,\@sumspecifiedbits,$numrecs);
}



# terribly slow for now - linear in size of xNDB times length of record
sub query {
    my $p = $_[0];
    my $dbref = $_[1];
    my $dbname = $_[2];
    my $rtn = 0;

    $debug9 && print "Query $dbname for <$p>\n..";
    if (!$USE_PERMUTE && $dbname =~ /^N/ ) {
	$rtn = &query_ndb($p);
    } else {
	my $k;

	foreach $k (keys %$dbref) {
	    my $hatk = "^"."$k";
	    $debug9 && print "does <$p> match <$hatk>?\n";
	    if ( $p =~ /$hatk/ ) {
		$debug9 && print "YIKES!! $dbname FOUND <$p> in <$k>\n";
		$rtn = 1;
		last;
	    }
	}
    }

    return $rtn;  # returns zero if not found; o.w. true
}


# use to be at the end of query, but too deeply nested recursion since
# refactoring.
sub verify_query {
    my $p = $_[0];
    my $ans = $_[1];
    my $chk;

    if ($debug5 || $debug6 || $debug9 ) {
	$chk = &query($p,\%NDB,"NDB");
	$chk ^ $ans && die "ndb returns different results for <$p>\n";
    }
    return;
}


# special quick query for un-permuted databases
sub query_ndb {
    my $p = $_[0];
    my $rtn = 0;
    my $plen = 1;
    my $subp;

    $debug9 && print "Query (unpermuted) NDB for <$p>\n..";

    while ($plen <= $LEN){
	$subp = substr($p,0,$plen);
	$debug && print "looking for <$subp>...\n";
	if (defined $NDB{$subp}){
	    $debug9 && print "YIKES!! FOUND <$subp>\n";
	    $rtn = $plen;
	    last;
	}
	$plen++;
    }
    
    return $rtn;  # returns zero if not found; o.w. sub-string length 
}


# dbref is possibly doubly permuted at this point by pattern_generate
sub query_db {
    my $p = $_[0];
    my $dbref = $_[1];
    my $rtn = 0;
    my $hatp = "^"."$p";
    my $k;

    $debug5 && print "Query DB for <$p>\n..";

    foreach $k (keys %$dbref) {
	$debug9 && print "does <$k> match <$hatp>?\n";
	if ( $k =~ /$hatp/ ) {
	    $debug9 && print "YIKES!! DB FOUND <$p> in <$k>\n";
	    $rtn = 1;
	    last;
	}
    }

    return $rtn;  # returns zero if not found; o.w. true
}


sub test_query_ndb {
    my $p = $_[0];
    my $x;
    my $q = 0;

    foreach $x (keys %NDB){
	if ( $p =~ /^$x/ ) {
	    print "$p is represented by $x in NDB\n";
	    $q++;
	}
    }
    
    if ($q > 1 ) {
	$debug && print "$q expressions in NDB represent $p??\n";
    }

    if (!$q) {
	$debug && print "NO expressions in NDB represent $p.\n";
    }

    return $q;
}


# doesn't care if 'don't care' is a dot or an asterik
sub count_dontcares_rec {
    my $rec = $_[0];
    my $dc = $rec =~ s/([\.\*])/$1/g;
    return $dc;
}


sub explicitp_rec {
    my $rec = $_[0];
    my $val = $_[1];
    my $l = length $rec;
    my $explicit = 0;

    if ( $l == $val ) {
	$explicit = 1;
	$debug && print "Explicit <$rec>\n";
    }
    return $explicit;
}
    

sub print_rndb {
    my $y;
    my $explicits=0;

    open OUTRNDB,">$configfilepath/RNDB.txt" || die "unable to open $configfilepath/RNDB.txt" ;

    foreach $y (sort keys %RNDB) {
	my $z = &substitute_dots_and_dontcares($y);
	&explicitp_rec($y,$RNDB{$y}) && $explicits++;
	print OUTRNDB "$z\n";
    }
    
    close OUTRNDB;

    my $sz = scalar keys %RNDB;
    &print_db_summary("RNDB",$sz,$explicits,$RN);
    &print_dimacs($sz,\%RNDB,"RNDB");
    &print_stats("RNDB",\@RSTATS,0);  
    return;
}


sub print_kndb {
    my $y;
    my $explicits=0;

    open OUTKNDB,">$configfilepath/KNDB.txt" || die "Unable to open KNDB.txt";

    foreach $y (sort keys %KNDB) {
	&explicitp_rec($y,$KNDB{$y}) && $explicits++;
	print OUTKNDB "$y\n";
    }
    close OUTKNDB;

    my $sz = scalar keys %KNDB;
    &print_db_summary("KNDB",$sz,$explicits,$KN);
    $debug5 && &print_nkdb();

    &print_dimacs($sz,\%KNDB,"KNDB");
    &print_stats("KNDB",\@KSTATS,0);
    return;
}


sub print_stats {
    my $dbname = $_[0];
    my $statref = $_[1];
    my $permuteflag = $_[2];
    my $totrecsz = $$statref[1];
    my $totspecifiedbits = $$statref[2];
    my $sumrecsz = $$statref[3];
    my $sumspecifiedbits = $$statref[4];
    my $sz = $$statref[5];
    my $z = $sz;
    my $l;
    my $avg;
    my $a;
    my $max=0;

    !$z && die "$dbname couldn't really be empty, now could it?\n";

#    print "<$totrecsz> is this nonzero?\n";
    Print("Distribution of Specified Bits Across $dbname $LEN-bit $N DB records:\n");
    Print("SIZE\tCOUNT\tPERCENTAGE\n");
    for ($l = 0; $l <= $LEN; $l++) {
	if ( ! $$sumrecsz[$l]) { next; }
	$a = ($$sumrecsz[$l] / $z) * 100;
	$a = &round_up($a,100);
	Print("$l\t$$sumrecsz[$l]\t$a%\n");
	if ($l > $max) { $max = $l; } 
    }
    $avg = $totrecsz/$z;
    $avg = &round_up($avg,100);
    if(!$permuteflag){  #print once only
	Print("Average record length is <$avg>; Max is <$max>\n");
	&PrintBR();
	&PrintBR();
    }

    open GPLOT,">$configfilepath/distrib7-$dbname-$permuteflag.dat" || die "can't open gplot file";
    print GPLOT "#Distribution of Specified Bits Across $dbname: $LEN-bit $N DB records\n";
    print GPLOT "#AVGRECSIZE=$avg;NUMRECORDS=$sz;MOSTSPECIFIEDBITS=$max;MAXKEY=$MAX_KEY;FENUM=$FENUM;STEP6=$STEP6;WINI=$WINI;RESETWINI=$RESETWINI\n";
    print GPLOT "#bit count percentage\n";

    if($WEBDEMO){
	my $permstring = "after reverse";
	if($permuteflag) {
	    $permstring = "in";
	}

	print GPLOT "set terminal pbm small color\n";
	print GPLOT "set ylabel \"Number of Specified Appearances in Negative Records\\n(not the don't cares) \"\n";
	print GPLOT "set xlabel \"Bit Location in Negative Record\"\n";
	print GPLOT "set title \"Distribution of Specified Bits Across $dbname\\n Positive DB of $N $LEN-bit records\\n($dbname $permstring permutation)\"\n";
	print GPLOT "plot '-' using 1:2 title \"$dbname\" with linespoints lt 3\n";
    }

    Print("Distribution of specified bits across $dbname $LEN-bit records:\n");
    Print("BIT\tCOUNT\tPERCENTAGE\n");
    for ($l = 0; $l < $LEN; $l++) {
	$a = ($$sumspecifiedbits[$l] / $z) * 100;
	$a = &round_up($a,100);
	Print("$l\t$$sumspecifiedbits[$l]\t$a%\n");
	print GPLOT "$l $$sumspecifiedbits[$l] $a\n";
    }
    $a = $totspecifiedbits/$z;
    $a = &round_up($a,100);
    Print("Average number of specified bits per record (i.e. \"record size\"): <$a>\n\n");
    print GPLOT "\n";
    close GPLOT;

    if ($a != $avg ) {
	print "$dbname: STATS WEIRDNESS!! the average record size ($avg) and the average number of bits per record ($a) should be the same.\n";
    }
    return;
}


sub print_dimacs {
    my $cl = $_[0];
    my $dbref = $_[1];
    my $dbname = $_[2];
    my $va = $LEN;
    my $gl = $cl/$va;
    my $y;

    open OUTDI,">$configfilepath/SAT/$dbname.dimacs" || die "Unable to open SAT dimacs file";

    print OUTDI "c  cnf \#var \#clause\nc \#var is RN, \#clauses is DB reclength\n";
    print OUTDI "c guideline ratio is around 4.3: <$gl>\n";
    print OUTDI "p cnf $va $cl\n";

    foreach $y (sort keys %$dbref) {
	my $i = 0;
	while ($i < $LEN ) { 
	    my $z = $i+1;
	    my $c = substr($y,$i,1);
	    if ( $c =~ /1/) {
		print OUTDI "-$z ";
	    } elsif ( $c =~ /0/ ) {
		print OUTDI "$z ";
	    }
	    $i++;
	}
	print OUTDI "0 \n";  # each line ends with a "0"
    }
    
    close OUTDI;
    return;
}


sub print_nkdb {
    my $y;
    my $explicits=0;
    my $ltewini = 0;

    open OUTNKDB,">$configfilepath/NKDB.txt" || die "Unable to open NKDB";

    foreach $y (sort keys %NKDB) {
	print OUTNKDB "$NKDB{$y}\n";
    }
    close OUTNKDB;

    my $sz = scalar keys %NKDB;
    &print_db_summary("NKDB",$sz,$explicits,$KN);
    return;
}


sub print_ndb {
    my $y;
    my $explicits=0;
    my $ltewini = 0;

    open OUTNDB,">$configfilepath/NDB.txt" || die "Unable to open $configfilepath/NDB.txt";

    foreach $y (sort keys %NDB) {
	my $z = &substitute_dots_and_dontcares($y);
	$z = &pad_right($z,"*");   # pad to right with don't care *'s
	&explicitp_rec($y,$LEN - &count_dontcares_rec($z) ) && $explicits++;
	$NDB{$y} <= $WINI && $ltewini++;
	print OUTNDB "$z\n";
    }
    close OUTNDB;

    my $sz = scalar keys %NDB;
    &print_db_summary("NDB",$sz,$explicits,$NN);
    &print_stats("NDB",\@NSTATS,0);

    if ($ltewini) {
	print "Didn't expect to find <$ltewini> NDB records whose length is less than or equal to Wini <$WINI>\n";
    }
}


# args are name, size, and number of explicit records
# depends on globals for length of record and size of DB.
sub print_db_summary{
    my $name = $_[0];
    my $sz = $_[1];
    my $explicits = $_[2];
    my $n = $_[3];
    my $exp = ($explicits/$N) * 100;
    my $uppersize = $N * $LEN;
    my $szdiff = $n - $sz;

    if ( $name =~ /RNDB/) {
	$uppersize = $uppersize * $uppersize;     # quadratic in DB
    }

    $exp = &round_up($exp,100);
    print("$name size is $sz -- $explicits explicit records ($exp% of DB size)");
    &PrintBR();
    if ( $uppersize < $sz) {
	Print("$name is larger than expected ($uppersize)!!\n");
    } 

    my $np = ($sz/$uppersize) * 100;
    my $np2 = ($sz/$N) * 100;
    $np = &round_up($np,100);
    $np2 = &round_up($np2,100);
    print("$name is $np% of upper bound ($uppersize) -- $np2% of DB size");
    &PrintBR();
    
    $szdiff && print("(but added  <$n> records to $name, possibly <$szdiff> duplicates)") && &PrintBR();

    return;
}


sub print_db {
    my $y;
    my $sz = 0;

    if ($debug) {
	print "DB windows:\n";
	foreach $y (keys %DBwhash) {
	    print "$y\n";
	}
    }
    $debug && print "DB:\n";
    foreach $y (sort keys %DBwhash) {
	if ( $DBwhash{$y} == $LEN) {
	    $debug && print "$y\n"; 
	    $sz++;
	}
    }
    Print("DB size is $sz, record length is $LEN\n");

    # should no longer happen v.40
    if ( $N != $sz) {  
	print "DB is size is different ($sz) than originally read ($N)!!";
	&PrintBR();
	&PrintBR();
	$N = $sz;
    }
}

sub print_orddb {
    my $dbref = $_[0];
    my $y;

    open OUTNDB,">$configfilepath/ORDDB.txt" || die "Unable to open $configfilepath/ORDDB.txt";

    foreach $y (sort keys %$dbref) {
	print OUTNDB "$$dbref{$y}==$y\n";
    }
    close OUTNDB;

    return;
}

sub create_udb {
    my $x = 0;
    my $z = 0;
    my $cnt = 0;
    my $max = 2**$LEN;
    while ($x < $max){
	my $s = sprintf("%b",$x);
	my $l = length $s;
	$z = ("0"x ($LEN - $l)) . $s;
	$debug && print "$z\n";
	if (! defined $DBwhash{$z}){
	    $UDB{$z} = $x;
	    $cnt++;
	}
	$x++;
    }
    Print("UDB has $cnt records.\n");
    if ($cnt + $N != $max){
	Print("UDB has more records than expected!\n");
    }
    return $cnt;
}


# should NOT find DB represented in NDB
sub sanity_check_ndb {
    my $x;

    if ($BINFLAG && $LEN < 8) {
	Print("checking with UDB..\n");
	my $f = 0;
	my $sz = &create_udb();

	foreach $x (keys %UDB) {
	    if (&test_query_ndb($x)){
		$f++;
	    }
	}
	
	if ($f != $sz) {
	    print "PROBLEM WITH NDB AND UDB\n";
	}
    }
    
    Print("sanity checking ndb with all DB windows..\n");
    foreach $x (keys %DBwhash) {
	if ($DBwhash{$x} == $LEN) {
	    if (&test_query_ndb($x)){
		print "PROBLEM WITH NDB AND DB ($x)\n";
	    }
	}
    }
    return;
}


sub test {
    my $dbref = $_[0];
    my $dbname = $_[1];
    my $x;
    my $y = 0;
    my $p = 0;
    my $notfnd = 0;
    my $lapse;
    my $perrec;
    my $start = time;

    Print("\ntesting $dbname with all keys of DB..\n");

    foreach $x (keys %DB) {   # already padded and converted
	$y++;
	if (&query($x,$dbref,$dbname)){
	    $p++;
	    print "PROBLEM #2 WITH $dbname AND DB ($x)\n";
	    }
    }

    if ($debug_db) {
	print "testing $dbname with all windows of ADB..\n";
	foreach $x (sort keys %ADBwhash) {
	    my $x2 = &prep_query($x);      # pad w zeros or blanks
	    my $ordx = &prep2_query($x2);  # converted if ascii
	    my $query = &query($ordx,$dbref,$dbname);
	    &verify_query($ordx,$query);

	    $y++;
	    
	    if (defined $ADB{$x} || defined $ADB{$x2} ) {
		$debug9 && print "<$x> or <$x2> is defined in ADB\n";
		if ($query) {
		    $p++;
		    print "PROBLEM #3 WITH $dbname AND DB ($x2)\n";
		    } 
	    } else {
		$debug9 && print "<$x> or <$x2> is not  defined in ADB\n";
		if (! $query ) {
		    $p++;
		    print "PROBLEM #4  (query returned $query) WITH $dbname AND DB ($x2)\n";
		    }
	    }
	}
    }
    
# one random query for good luck!
    if (!$BINFLAG) {
	$y++;
	$x = &prep_query("phtoaiuwerasnd");
	$x = &convert_to_ord($x);
	
	if (!&query($x,$dbref,$dbname)) {
	    $p++;
	    print "PROBLEM #5 WITH $dbname AND DB (phtaaiuwerasnd)\n";
	    }
    }

    $lapse = time - $start;
    $perrec = $lapse/$y;
    $notfnd = $y - $p;
    Print( "$dbname: didn't find $notfnd records and found $p records in $lapse time ($perrec sec/rec)\n");
    return;
}


sub prep_query {
    my $query = $_[0];
    my $q2 = $query;
    my $ql = length $q2;
    my $q = substr($q2,0,$MAXREADLEN);
    
    if ($ql > $MAXREADLEN ) {
	Print("Max length record is $MAXREADLEN, using <$q> instead of <$query>\n");
	$q2 = $q;

    } else {

	if ($BINFLAG){
#	    $q2 = &pad_right($q,"0");
	    $q2 = &pad_left($q,"0");
	    $debug9 && print "padding <$q left with 0 now <$q2>\n";
	} else {
	    $q = lc $q;   # lower case everythin
	    $q2 = &pad_right_length($q," ",$MAXREADLEN);
	}
	
	($debug9) && print "Fixed length record is 5, padding <$query> to <$q2>\n";
    }

    return $q2;
}


sub prep2_query {
    my $q2 = $_[0];
    my $ordq = $q2;

    if (!$BINFLAG) {
	 $ordq = &convert_to_ord($q2);
	($debug9) && print "ready to query <$q2> as <$ordq>\n";
    }
    return $ordq;
}


sub no_ndb {
    unlink "$configfilepath/NDB.txt";
    return;

    # needs work
    $LEN = $DEFAULTLEN;
    $BINFLAG = 1;
    $N = 8;
    my $pc = 2**$DEFAULTWINI;   # every possible combination 2**$resetwini
    my $pi = 0;
    $debug8 && print "($pc) reset wini in ndb\n";

    while($pi < $pc) {
	my $x;
	my $v = sprintf("%b",$pi);               # binary form
	$v = pad_left_length($v,"0",$DEFAULTWINI);
	$debug8 && print "($pc)($pi)\n"; 
	&add_ndb_rec($v);          # add just prefix and rest '*'s if both not found
	$pi++;
    }
    return $pc;
}



# RANDOM NUMBER STUFF

use integer;

# /* a ub4 is an unsigned 4-byte quantity */

# /* external results */
my (@randrsl, $randcnt);

# /* internal state */
my (@mm);
my ($aa, $bb, $cc) = (0, 0, 0);

sub isaac()
{
    my ($i, $x, $y);

    $cc++;       # /* cc just gets incremented once per 256 results */
    $bb += $cc;  # /* then combined with bb */

    for ($i=0; $i<256; $i++)
    {
	$x = $mm[$i];
	$aa                = $mm[($i+128)&255] + ($aa^($aa << 13));
	$mm[$i]      = $y  = $mm[($x>>2)&255]  + $aa + $bb;
	$randrsl[$i] = $bb = $mm[($y>>10)&255] + $x;
	$i++;

	$x = $mm[$i];
     $aa                = $mm[($i+128)&255] + ($aa^(0x03ffffff & ($aa >>
								  6)));
	$mm[$i]      = $y  = $mm[($x>>2)&255]  + $aa + $bb;
	$randrsl[$i] = $bb = $mm[($y>>10)&255] + $x;
	$i++;

	$x = $mm[$i];
	$aa                = $mm[($i+128)&255] + ($aa^($aa << 2));
	$mm[$i]      = $y  = $mm[($x>>2)&255]  + $aa + $bb;
	$randrsl[$i] = $bb = $mm[($y>>10)&255] + $x;
	$i++;

	$x = $mm[$i];
     $aa                = $mm[($i+128)&255] + ($aa^(0x0000ffff & ($aa >>
								  16)));
	$mm[$i]      = $y  = $mm[($x>>2)&255]  + $aa + $bb;
	$randrsl[$i] = $bb = $mm[($y>>10)&255] + $x;

   }
}


# if (flag==TRUE), then use the contents of randrsl[] to initialize mm[].
sub randinit
{
    my ($flag) = @_;
    my $i;
    my ($a, $b, $c, $d, $e, $f, $g, $h);
    $aa = $bb = $cc = 0;
    $a = $b = $c = $d = $e = $f = $g = $h = 0x9e3779b9;  # /* the golden
                                                         # ratio */

    for ($i=0; $i<4; ++$i)          # /* scramble it */
    {
	                            # "mix"
	$a^=$b<<11; $d+=$a; $b+=$c;
	$b^=0x3fffffff & ($c>>2);  $e+=$b; $c+=$d;
	$c^=$d<<8;  $f+=$c; $d+=$e;
	$d^=0x0000ffff & ($e>>16); $g+=$d; $e+=$f;
	$e^=$f<<10; $h+=$e; $f+=$g;
	$f^=0x0fffffff & ($g>>4);  $a+=$f; $g+=$h;
	$g^=$h<<8;  $b+=$g; $h+=$a;
	$h^=0x007fffff & ($a>>9);  $c+=$h; $a+=$b;
    }

    for ($i=0; $i<256; $i+=8)   # /* fill in mm[] with messy stuff */
    {
     if ($flag)                # /* use all the information in the seed */
     {
	 $a+=$randrsl[$i  ]; $b+=$randrsl[$i+1];
	 $c+=$randrsl[$i+2]; $d+=$randrsl[$i+3];
	 $e+=$randrsl[$i+4]; $f+=$randrsl[$i+5];
	 $g+=$randrsl[$i+6]; $h+=$randrsl[$i+7];
     }
     # "mix"
     $a^=$b<<11; $d+=$a; $b+=$c;
     $b^=0x3fffffff & ($c>>2);  $e+=$b; $c+=$d;
     $c^=$d<<8;  $f+=$c; $d+=$e;
     $d^=0x0000ffff & ($e>>16); $g+=$d; $e+=$f;
     $e^=$f<<10; $h+=$e; $f+=$g;
     $f^=0x0fffffff & ($g>>4);  $a+=$f; $g+=$h;
     $g^=$h<<8;  $b+=$g; $h+=$a;
     $h^=0x007fffff & ($a>>9);  $c+=$h; $a+=$b;
     $mm[$i  ]=$a; $mm[$i+1]=$b; $mm[$i+2]=$c; $mm[$i+3]=$d;
     $mm[$i+4]=$e; $mm[$i+5]=$f; $mm[$i+6]=$g; $mm[$i+7]=$h;
 }

   if ($flag)
   {        # /* do a second pass to make all of the seed affect all of mm
       
    for ($i=0; $i<256; $i+=8)
    {
	$a+=$mm[$i  ]; $b+=$mm[$i+1]; $c+=$mm[$i+2]; $d+=$mm[$i+3];
	$e+=$mm[$i+4]; $f+=$mm[$i+5]; $g+=$mm[$i+6]; $h+=$mm[$i+7];
       # "mix"
	$a^=$b<<11; $d+=$a; $b+=$c;
	$b^=0x3fffffff & ($c>>2);  $e+=$b; $c+=$d;
	$c^=$d<<8;  $f+=$c; $d+=$e;
	$d^=0x0000ffff & ($e>>16); $g+=$d; $e+=$f;
	$e^=$f<<10; $h+=$e; $f+=$g;
	$f^=0x0fffffff & ($g>>4);  $a+=$f; $g+=$h;
	$g^=$h<<8;  $b+=$g; $h+=$a;
	$h^=0x007fffff & ($a>>9);  $c+=$h; $a+=$b;
	$mm[$i  ]=$a; $mm[$i+1]=$b; $mm[$i+2]=$c; $mm[$i+3]=$d;
	$mm[$i+4]=$e; $mm[$i+5]=$f; $mm[$i+6]=$g; $mm[$i+7]=$h;
    }
}

    isaac();               # /* fill in the first set of results */
    $randcnt=256;        # /* prepare to use the first set of results */
}


sub seedrand {
    my $tmp = $_[0];
    if (!$tmp) {
	open DEVR,"/dev/urandom" || die "no urandom file in slash dev\n";
	read DEVR,$seed,1024;
	close DEVR;
	open RS,">$configfilepath/lastseed";
	print RS "$seed\n";
	close RS;
    } else {
	Print("reading seed from lastseed file\n");
	open RS,"$configfilepath/lastseed";
	read RS,$seed,1024;
	close RS;
    }
#    Print("seed is <$seed>\n");
    &convert_string_to_seed();
    &randinit(1);
}


sub convert_string_to_seed {
    my $rcnt = 0;
    my $i;
    for ($i = 0; $i < 1024; $i+=4) {
	my $j;
	my $n = 0;
	for ($j = 0; $j < 4; $j++) {
	    my $c = substr($seed, $i+$j, 1);
	    $c = ord($c);
	    $n = $n + $c<<$j*8;
	}
	$n = $n & 0x7fffffff;
#	Print("seed <$rcnt> is <$n>\n");
	$randrsl[$rcnt++] = $n;
    }
    return;
}



# count rand calls
sub rander {
    my $x = $_[0];
    $randcalls++;
    return &irand($x);
}


sub irand {
    my $mod = $_[0];
    $randcnt--;
#    print "randcnt is <$randcnt>; randcalls is <$randcalls>;";  
    if ($randcnt < 0) {
	&isaac();
	$randcnt = 255;
    }
    my $rnum = $randrsl[$randcnt];
    $rnum = $rnum & 0x7fffffff;      # mask out negative sign bit
#    print "rnum is $rnum; MOD IS $mod\n";
    $rnum = $rnum % $mod;
    return $rnum;
}
    

sub Print {
    my $s = $_[0];
    if(!$WEBDEMO)
    {
	print $s;
    }
    return;
}


sub PrintBR {
    if(!$WEBDEMO)
    {
	print "\n";
    }
    else
    {
	print "<BR>";
    }
    return;
}

sub main{
    my $dbref;
#    print("version $version\n");

    &command_args(@_);
    &seedrand($seed);

    if (! &read_db() || !$LEN ) {
	&no_ndb();
	die "No valid records in the DB\n";
     }

    if ($debug_db) {
	Print("Copying DB as ADB..\n");
	%ADB = %DB;   # copy before padded and converted
	&adbwin();
    }

    $dbref = &paddb();    # pad binary left w zeros; ascii right w blanks
    %DB = %$dbref;
    $dbref = &db2ord();   # LEN adjusted
    %DB = %$dbref;
    $dbref = &permute_db();
    %DB = %$dbref;        # keys are permuted, values are unpermuted keys


    &dbwin();          # all possible binary "windows" including padding 
    ($WINI,$RESETWINI) = &find_wini();
    $debug8 && print "WINI is <$WINI>; RESETWINI is <$RESETWINI>\n";

    &prefix();         # create ndb prefix patterns


    &create_kndb();    # c_keys only, uses prefixes
    @KSTATS = &stats(\%KNDB,"KNDB");
    $MAX_KEY = $KSTATS[0];
    print("MAX KEY size in KNDB is <$MAX_KEY>");
    &PrintBR();
    &PrintBR();

    $MAX_KEY += $FENUM;

    if ($MAX_KEY > $LEN) {     # just found this bug version .4 
	$MAX_KEY = $LEN;
    }

    if ($MAX_KEY < $RESETWINI && !$IGNOREWINI && $WINIRESETFLAG) {
	$MAX_KEY = $RESETWINI;
    }


    $WEBDEMO && &print_stats("KNDB",\@KSTATS,1);  #in permutation, after max_key set

    if (! $KNDB_ONLY ) {
	&randomize_ndb();  # create rndb, uses prefixes
	if($WEBDEMO) {
	    @RSTATS = &stats(\%RNDB,"RNDB");
	    &print_stats("RNDB",\@RSTATS,1);    #in permutation
	}
	$dbref = &reverse_permute(\%RNDB,"RNDB");
	%RNDB = %$dbref;
	@RSTATS = &stats(\%RNDB,"RNDB");
	&print_rndb();    
    }

#safe to do so now..
    $dbref = &reverse_permute(\%KNDB,"KNDB");
    %KNDB = %$dbref;
    @KSTATS = &stats(\%KNDB,"KNDB");   # redo to get after permutation plots
    &print_kndb();

    $dbref =  &reverse_permute(\%NDB,"NDB");
    %NDB = %$dbref;
    @NSTATS = &stats(\%NDB,"NDB");
    &print_ndb();

    $dbref = &reverse_permute(\%DB,"DB");
    %DB = %$dbref;
    &print_db();
    
    $debug_ndb && &sanity_check_ndb();
    &test(\%NDB,"NDB");
    &test(\%KNDB,"KNDB");

    !$KNDB_ONLY &&  &test(\%RNDB,"RNDB");
    print("This entire process required $randcalls random numbers.");
    &PrintBR();
    Print("bye!\n");
}