perllib/phash.ph

   1 # -*- perl -*-
   2 #
   3 # Perfect Minimal Hash Generator written in Perl, which produces
   4 # C output.
   5 #
   6 # Requires the CPAN Graph module (tested against 0.81, 0.83, 0.84)
   7 #
   8
   9 require 'random_sv_vectors.ph';
  10 require 'crc64.ph';
  11
  12 #
  13 # Compute the prehash for a key
  14 #
  15 # prehash(key, sv, N)
  16 #
  17 sub prehash($$$) {
  18     my($key, $n, $sv) = @_;
  19     my @c = crc64($sv, $key);
  20
  21     # Create a bipartite graph...
  22     $k1 = (($c[1] & ($n-1)) << 1) + 0; # low word
  23     $k2 = (($c[0] & ($n-1)) << 1) + 1; # high word
  24
  25     return ($k1, $k2);
  26 }
  27
  28 #
  29 # Walk the assignment graph, return true on success
  30 #
  31 sub walk_graph($$$$) {
  32     my($nodeval,$nodeneigh,$n,$v) = @_;
  33     my $nx;
  34
  35     # print STDERR "Vertex $n value $v\n";
  36     $$nodeval[$n] = $v;
  37
  38     foreach $nx (@{$$nodeneigh[$n]}) {
  39         # $nx -> [neigh, hash]
  40         my ($o, $e) = @$nx;
  41
  42         # print STDERR "Edge $n,$o value $e: ";
  43         my $ov;
  44         if (defined($ov = $$nodeval[$o])) {
  45             if ($v+$ov != $e) {
  46                 # Cyclic graph with collision
  47                 # print STDERR "error, should be ", $v+$ov, "\n";
  48                 return 0;
  49             } else {
  50                 # print STDERR "ok\n";
  51             }
  52         } else {
  53             return 0 unless (walk_graph($nodeval, $nodeneigh, $o, $e-$v));
  54         }
  55     }
  56     return 1;
  57 }
  58
  59 #
  60 # Generate the function assuming a given N.
  61 #
  62 # gen_hash_n(N, sv, \%data, run)
  63 #
  64 sub gen_hash_n($$$$) {
  65     my($n, $sv, $href, $run) = @_;
  66     my @keys = keys(%{$href});
  67     my $i, $sv;
  68     my $gr;
  69     my $k, $v;
  70     my $gsize = 2*$n;
  71     my @nodeval;
  72     my @nodeneigh;
  73     my %edges;
  74
  75     for ($i = 0; $i < $gsize; $i++) {
  76         $nodeneigh[$i] = [];
  77     }
  78
  79     %edges = ();
  80     foreach $k (@keys) {
  81         my ($pf1, $pf2) = prehash($k, $n, $sv);
  82         ($pf1,$pf2) = ($pf2,$pf1) if ($pf1 > $pf2); # Canonicalize order
  83
  84         my $pf = "$pf1,$pf2";
  85         my $e = ${$href}{$k};
  86         my $xkey;
  87
  88         if (defined($xkey = $edges{$pf})) {
  89             next if ($e == ${$href}{$xkey}); # Duplicate hash, safe to ignore
  90             if (defined($run)) {
  91                 print STDERR "$run: Collision: $pf: $k with $xkey\n";
  92             }
  93             return;
  94         }
  95
  96         # print STDERR "Edge $pf value $e from $k\n";
  97
  98         $edges{$pf} = $k;
  99         push(@{$nodeneigh[$pf1]}, [$pf2, $e]);
 100         push(@{$nodeneigh[$pf2]}, [$pf1, $e]);
 101     }
 102
 103     # Now we need to assign values to each vertex, so that for each
 104     # edge, the sum of the values for the two vertices give the value
 105     # for the edge (which is our hash index.)  If we find an impossible
 106     # sitation, the graph was cyclic.
 107     @nodeval = (undef) x $gsize;
 108
 109     for ($i = 0; $i < $gsize; $i++) {
 110         if (scalar(@{$nodeneigh[$i]})) {
 111             # This vertex has neighbors (is used)
 112             if (!defined($nodeval[$i])) {
 113                 # First vertex in a cluster
 114                 unless (walk_graph(\@nodeval, \@nodeneigh, $i, 0)) {
 115                     if (defined($run)) {
 116                         print STDERR "$run: Graph is cyclic\n";
 117                     }
 118                     return;
 119                 }
 120             }
 121         }
 122     }
 123
 124     # for ($i = 0; $i < $n; $i++) {
 125     #   print STDERR "Vertex ", $i, ": ", $g[$i], "\n";
 126     # }
 127
 128     if (defined($run)) {
 129         printf STDERR "$run: Done: n = $n, sv = [0x%08x, 0x%08x]\n",
 130         $$sv[0], $$sv[1];
 131     }
 132
 133     return ($n, $sv, \@nodeval);
 134 }
 135
 136 #
 137 # Driver for generating the function
 138 #
 139 # gen_perfect_hash(\%data)
 140 #
 141 sub gen_perfect_hash($) {
 142     my($href) = @_;
 143     my @keys = keys(%{$href});
 144     my @hashinfo;
 145     my $n, $i, $j, $sv, $maxj;
 146     my $run = 1;
 147
 148     # Minimal power of 2 value for N with enough wiggle room.
 149     # The scaling constant must be larger than 0.5 in order for the
 150     # algorithm to ever terminate.
 151     my $room = scalar(@keys)*0.8;
 152     $n = 1;
 153     while ($n < $room) {
 154         $n <<= 1;
 155     }
 156
 157     # Number of times to try...
 158     $maxj = scalar @random_sv_vectors;
 159
 160     for ($i = 0; $i < 4; $i++) {
 161         printf STDERR "%d vectors, trying n = %d...\n",
 162                 scalar @keys, $n;
 163         for ($j = 0; $j < $maxj; $j++) {
 164             $sv = $random_sv_vectors[$j];
 165             @hashinfo = gen_hash_n($n, $sv, $href, $run++);
 166             return @hashinfo if (defined(@hashinfo));
 167         }
 168         $n <<= 1;
 169     }
 170
 171     return;
 172 }
 173
 174 #
 175 # Read input file
 176 #
 177 sub read_input() {
 178     my $key,$val;
 179     my %out;
 180     my $x = 0;
 181
 182     while (defined($l = <STDIN>)) {
 183         chomp $l;
 184         $l =~ s/\s*(\#.*|)$//;
 185
 186         next if ($l eq '');
 187
 188         if ($l =~ /^([^=]+)\=([^=]+)$/) {
 189             $out{$1} = $2;
 190             $x = $2;
 191         } else {
 192             $out{$l} = $x;
 193         }
 194         $x++;
 195     }
 196
 197     return %out;
 198 }
 199
 200 #
 201 # Verify that the hash table is actually correct...
 202 #
 203 sub verify_hash_table($$)
 204 {
 205     my ($href, $hashinfo) = @_;
 206     my ($n, $sv, $g) = @{$hashinfo};
 207     my $k;
 208     my $err = 0;
 209
 210     foreach $k (keys(%$href)) {
 211         my ($pf1, $pf2) = prehash($k, $n, $sv);
 212         my $g1 = ${$g}[$pf1];
 213         my $g2 = ${$g}[$pf2];
 214
 215         if ($g1+$g2 != ${$href}{$k}) {
 216             printf STDERR "%s(%d,%d): %d+%d = %d != %d\n",
 217             $k, $pf1, $pf2, $g1, $g2, $g1+$g2, ${$href}{$k};
 218             $err = 1;
 219         } else {
 220             # printf STDERR "%s: %d+%d = %d ok\n",
 221             # $k, $g1, $g2, $g1+$g2;
 222         }
 223     }
 224
 225     die "$0: hash validation error\n" if ($err);
 226 }
 227
 228 1;