Add perfect hash optimization for poker vocab

extra/poker/poker-tests.factor

@@ -8,9 +8,11 @@ IN: poker.tests
 
 [ 7462 ] [ "7C 5D 4H 3S 2C" <hand> value>> ] unit-test
 [ 1601 ] [ "KD QS JC TH 9S" <hand> value>> ] unit-test
+[ 11 ] [ "AC AD AH AS KC" <hand> value>> ] unit-test
 [ 9 ] [ "6C 5C 4C 3C 2C" <hand> value>> ] unit-test
 [ 1 ] [ "AC KC QC JC TC" <hand> value>> ] unit-test
 
 [ "High Card" ] [ "7C 5D 4H 3S 2C" <hand> >value ] unit-test
 [ "Straight" ] [ "KD QS JC TH 9S" <hand> >value ] unit-test
+[ "Four of a Kind" ] [ "AC AD AH AS KC" <hand> >value ] unit-test
 [ "Straight Flush" ] [ "6C 5C 4C 3C 2C" <hand> >value ] unit-test

extra/poker/poker.factor

@@ -4,8 +4,10 @@ USING: accessors ascii binary-search combinators kernel locals math
     math.bitwise math.order poker.arrays sequences splitting ;
 IN: poker
 
-! The algorithm used is based on Cactus Kev's Poker Hand Evaluator:
+! The algorithm used is based on Cactus Kev's Poker Hand Evaluator with
+! the Senzee Perfect Hash Optimization:
 !     http://www.suffecool.net/poker/evaluator.html
+!     http://www.senzee5.com/2006/06/some-perfect-hash.html
 
 <PRIVATE
 
@@ -124,14 +126,22 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
 : prime-bits ( cards -- q )
     [ HEX: FF bitand ] map-product ;
 
+: perfect-hash-find ( q -- value )
+    #! magic to convert a hand's unique identifying bits to the
+    #! proper index for fast lookup in a table of hand values
+    HEX: E91AAA35 +
+    dup -16 shift bitxor
+    dup   8 shift w+
+    dup  -4 shift bitxor
+    [ -8 shift HEX: 1FF bitand adjustments-table nth ]
+    [ dup 2 shift w+ -19 shift ] bi
+    bitxor values-table nth ;
+
 : hand-value ( cards -- value )
     {
         { [ dup flush?   ] [ flushes-table lookup ] }
         { [ dup unique5? ] [ unique5-table lookup ] }
-        [
-            prime-bits products-table sorted-index
-            values-table nth
-        ]
+        [ prime-bits perfect-hash-find ]
     } cond ;
 
 : >card-rank ( card -- str )