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