steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add perfect hash optimization for poker vocab

db4
Aaron Schaefer 2009-04-05 21:16:57 -04:00
parent 4a229e5205
commit fda3f6d3f0
3 changed files with 529 additions and 760 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1267
extra/poker/arrays/arrays.factor
View File

File diff suppressed because it is too large Load Diff

2
extra/poker/poker-tests.factor
View File

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

20
extra/poker/poker.factor
View File

@ -4,8 +4,10 @@ USING: accessors ascii binary-search combinators kernel locals math
math.bitwise math.order poker.arrays sequences splitting ; math.bitwise math.order poker.arrays sequences splitting ;
IN: poker 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.suffecool.net/poker/evaluator.html
! http://www.senzee5.com/2006/06/some-perfect-hash.html
<PRIVATE <PRIVATE
@ -124,14 +126,22 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
: prime-bits ( cards -- q ) : prime-bits ( cards -- q )
[ HEX: FF bitand ] map-product ; [ 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 ) : hand-value ( cards -- value )
{ {
{ [ dup flush? ] [ flushes-table lookup ] } { [ dup flush? ] [ flushes-table lookup ] }
{ [ dup unique5? ] [ unique5-table lookup ] } { [ dup unique5? ] [ unique5-table lookup ] }
[ [ prime-bits perfect-hash-find ]
prime-bits products-table sorted-index
values-table nth
]
} cond ; } cond ;
: >card-rank ( card -- str ) : >card-rank ( card -- str )