TracyHarms/PokerHandsScoring

The main program here, 'score', takes poker hands and returns (integer) scores that serve to compare the given hands, where highest score is the winning hand. When more than one hand has the same score, that fact indicates a tie between them.

Although it seems best to hard-code the patterns of matching cards, as done in all examples shown, these can be produced by calculation of partitions.

RankLabels=: '23456789XJQKA'
SuitLabels=: 'HCDS'
makeHand =: verb :' |: 5 2 $ y -. '' '' '

HandNames  =: 'StraightFlush FourOfKind FullHouse Flush Straight ThreeOfKind TwoPair Pair HighCard'
(HandNames)=: NamedHands =: |.i.9
MatchHands =: NamedHands -. StraightFlush, Straight, Flush

MatchPatterns=: 4 1; 3 2; 3 1 1; 2 2 1; 2 1 1 1; 1 1 1 1 1

score =: verb define "2
  IsFlush=. isUniform suits Hand=. y
  IsStraight=. (isAceLowStraight +. isConsecutive) ranks Hand
toDecimalfromBase13 (ScoringTable {~ <  IsFlush , IsStraight)`:6 ranks Hand
)

ScoringTable =: 2 2 $ asMatch ` asStraight ` asFlush ` asStraightFlush

asStraightFlush=: StraightFlush, sortStraight
asFlush        =: Flush, ]
asStraight     =: Straight, sortStraight
asMatch        =: (thisMatch  ,  {. # {:) @ findMatches

findMatches =: [: |: [: (|: \: {.) (~. ,:~ [: +/"1 =)
thisMatch=: MatchHands {~ MatchPatterns i. <@{.

ranks =: [: \:~ RankLabels asIndex {.
suits =:        SuitLabels asIndex {:
asIndex=: dyad : ' , I. |: x E."0 _ y '

toDecimalfromBase13 =: (6 # 13) #. ]

isUniform     =:  -: 1&|.
isConsecutive =:  1 1 1 1 -: 2&(-/\)

sortStraight=: ]`((5#0)"_) @. isAceLowStraight
NB. Ace-low exception is handled by using zeros instead of actual card ranks.
isAceLowStraight=: 12 3 2 1 0 -: ]   NB. the only instance is 5 4 3 2 A

The representation of individual cards is arbitrary. This means the code that implements 'score' works regardless of what atoms represent individual cards. A variety of representations are indicated by the following verbs:

require 'strings'   NB. Used only for the convenience of 'cut'.

RankLabels =: s:@:> cut ' J Q K A' ,~ ": 2+i.9
SuitLabels =: s:@:>  ;: 'H C D S'
makeHand=: verb :' |: 5 2 $ s:@:> cut y '

Alternate1RankLabels =: s:@:> ;: 'Deuce Three Four Five Six Seven Eight Nine Ten Jack Queen King Ace'
Alternate1SuitLabels =: s:@:> ;: 'Hearts Clubs Diamonds Spades'

Alternate2RankLabels =: ;: 'Deuce Three Four Five Six Seven Eight Nine Ten Jack Queen King Ace'
Alternate2SuitLabels =: ;: 'Hearts Clubs Diamonds Spades'

Alternate3RankLabels =: 2 3 4 5 6 7 8 9 10 11 12 13 14
Alternate3SuitLabels =: _1 _2 _3 _4

Alternate4RankLabels =: '23456789XJQKA'
Alternate4SuitLabels =: 'HCDS'
Alternate4makeHand   =: verb :' |: 5 2 $ y -. '' '' '

Here are some examples of use in a console:

   ]PairHand =. makeHand 'J D   J H   10 C   4 S   3 C'
`J `J `10 `4 `3
`D `H `C  `S `C
   score PairHand
649494
   FlushHand =. makeHand '9 H   7 H   4 H   3 H   2 H'
   AceLowHand=. makeHand '5 H   4 D   3 C   2 D   A S'
   score AceLowHand, PairHand,: FlushHand
1485172 649494 2067728
   (#~ [: (= >./) score) AceLowHand, PairHand,: FlushHand
`9 `7 `4 `3 `2
`H `H `H `H `H

I drew on this programming example for an introductory talk on J. In that talk I selectively focused on parts of the code as I moved through the design considerations of the whole. The code used in that talk differed slightly, as follows:

NB. Scores a hand of poker (for ordered comparison)
NB. by Tracy Harms           tracy@kaleidic.com
NB. Presented at Polyglot Meetup, March 3rd, 2010 in Columbus, Ohio.

RankLabels =: '23456789XJQKA'
SuitLabels =: 'HCDS'
makeHand =: verb :' |: 5 2 $ y -. '' '' '

'StraightFlush FourOfKind FullHouse Flush Straight ThreeOfKind TwoPair Pair HighCard'=: |.i.9

score =: verb define "2
  IsFlush=. isUniform suits Hand=. y
  IsStraight=. (isAceLowStraight +. isConsecutive) ranks Hand
toDecfromBase13 (ScoringTable {~ <  IsFlush , IsStraight)`:6 ranks Hand
)

ScoringTable =: 2 2 $ asMatch ` asStraight ` asFlush ` asStraightFlush

asStraightFlush=: StraightFlush, sortStraight
asFlush        =: Flush, ]
asStraight     =: Straight, sortStraight
asMatch        =: (thisMatch  ,  {. # {:) @ findMatches

thisMatch=: verb define
select. onlyMatches y 
  case., 4  do. FourOfKind
  case. 3 2 do. FullHouse
  case., 3  do. ThreeOfKind
  case. 2 2 do. TwoPair
  case., 2  do. Pair
  case.     do. HighCard
end. 
)

ranks =: [: \:~ RankLabels asIndex {.
suits =:        SuitLabels asIndex {:
asIndex=: dyad : ' , I. |: x E."0 _ y '

findMatches =: [: |: [: (|: \: {.) (~. ,:~ [: +/"1 =)
onlyMatches =: (#~ 1<])@ {.   NB. receives result of 'findMatches'

toDecfromBase13=: (6 # 13) #. ]

isUniform     =:  -: 1&|.
isConsecutive =:  (4#_1) -: 2&(-~/\)

sortStraight=: ]`((5#0)"_) @. isAceLowStraight
NB. Ace-low exception is handled by using zeros instead of actual card ranks.
isAceLowStraight=: 12 3 2 1 0 -: ]   NB. the only instance is 5 4 3 2 A