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