diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor index 5bda23f738..bc09f9fe0f 100644 --- a/basis/math/combinatorics/combinatorics.factor +++ b/basis/math/combinatorics/combinatorics.factor @@ -116,3 +116,10 @@ PRIVATE> [ [ choose [0,b) ] keep ] dip '[ _ apply-combination @ ] each ; inline +: map-combinations ( seq k quot -- ) + [ [ 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 e2d89620e6..3c8e5159ab 100644 --- 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" [ ] bi@ = ] unit-test [ f ] [ "7C 5D 4H 3S 2C" "7D 5D 4D 3C 2S" [ ] 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 b7661b83db..baebb25572 100644 --- 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 ;