Speed up best-hands a bit using reduce and add a test

diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor
index 5bda23f738ca5bffd301623b50a1deb47178b952..bc09f9fe0fa9b609147c751e7eb01a8e05fba3bc 100644 (file)
--- a/basis/math/combinatorics/combinatorics.factor
+++ b/basis/math/combinatorics/combinatorics.factor
@@ -116,3 +116,10 @@ PRIVATE>
     [ <combo> [ choose [0,b) ] keep ] dip
     '[ _ apply-combination @ ] each ; inline
 
+: map-combinations ( seq k quot -- )
+    [ <combo> [ choose [0,b) ] keep ] dip
+    '[ _ apply-combination @ ] map ; inline
+
+: reduce-combinations ( seq k identity quot -- result )
+    [ -rot ] dip each-combination ; inline
+

diff --git a/extra/poker/poker-tests.factor b/extra/poker/poker-tests.factor
index e2d89620e63e22de25b32b37ebdbee45c7b6c4db..3c8e5159ab8a842f7e3dd72c2d895138c4ed0e4f 100644 (file)
--- a/extra/poker/poker-tests.factor
+++ b/extra/poker/poker-tests.factor
@@ -26,3 +26,5 @@ IN: poker.tests
 
 [ t ] [ "7C 5D 4H 3S 2C" "7D 5D 4D 3C 2S" [ <hand> ] bi@ = ] unit-test
 [ f ] [ "7C 5D 4H 3S 2C" "7D 5D 4D 3C 2S" [ <hand> ] bi@ eq? ] unit-test
+
+[ 190 ] [ "AS KD JC KH 2D 2S KH" best-hand value>> ] unit-test

diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor
index b7661b83dbf2a7ac4e96e51d2e8cbf04eb24842e..baebb25572527eb070b921354ad21d3be97f85ee 100644 (file)
--- a/extra/poker/poker.factor
+++ b/extra/poker/poker.factor
@@ -179,7 +179,7 @@ PRIVATE>
 
 TUPLE: hand
     { cards sequence }
-    { value integer } ;
+    { value integer initial: 9999 } ;
 
 M: hand <=> [ value>> ] compare ;
 M: hand equal?
@@ -189,8 +189,8 @@ M: hand equal?
     parse-cards dup hand-value hand boa ;
 
 : best-hand ( str -- hand )
-    parse-cards 5 all-combinations
-    [ dup hand-value hand boa ] map infimum ;
+    parse-cards 5 hand new
+    [ dup hand-value hand boa min ] reduce-combinations ;
 
 : >cards ( hand -- str )
     cards>> [ card>string ] map " " join ;