poker.hoon

::I edited the playing cards library to represent cards as numbers 2-14 instead of 1-13
::If aces are 14 instead of 1, there are fewer annoying edge cases
::Sorry if that is bad
::
/+  playing-cards
:-  %say
|=  [[* eny=@uv *] *]
:-  %noun
=/  deck  (shuffle-deck:playing-cards make-deck:playing-cards eny)
=/  draw-result  (draw:playing-cards 5 deck)
=/  hand1  hand.draw-result
=/  hand2  -:(draw:playing-cards 5 rest.draw-result)
=<
(compare-hands hand1 hand2)
|%
+$  hand-score  [hand-type=@t tiebreak-values=(list @)]
++  card-sorting-function
  |=  [card1=darc:playing-cards card2=darc:playing-cards]
  (lth +:card1 +:card2)
++  compare-hands
  |=  [hand1=deck:playing-cards hand2=deck:playing-cards]
  =/  hand1-score  (score-hand (sort hand1 card-sorting-function))
  =/  hand2-score  (score-hand (sort hand2 card-sorting-function))
  ~&  hand1
  ~&  hand2
  ~&  hand-type.hand1-score
  ~&  hand-type.hand2-score
  =/  hand1-primary-score  (hand-type-to-num hand-type.hand1-score)
  =/  hand2-primary-score  (hand-type-to-num hand-type.hand2-score)
  ?:  (gth hand1-primary-score hand2-primary-score)
    'Hand 1 wins'
  ?:  (gth hand2-primary-score hand1-primary-score)
    'Hand 2 wins'
  ::if the hands have the same type (e.g. pair), we look at tiebreak information
  ::
  =/  i  0
  |-
  ?:  =(i (lent tiebreak-values.hand1-score))
    'Hand ends in a draw'
  =/  tiebreak-value-hand1  (snag i tiebreak-values.hand1-score)
  =/  tiebreak-value-hand2  (snag i tiebreak-values.hand2-score)
  ?:  (gth tiebreak-value-hand1 tiebreak-value-hand2)
    'Hand 1 wins'
  ?:  (gth tiebreak-value-hand2 tiebreak-value-hand1)
    'Hand 2 wins'
  $(i +(i))
++  score-hand
  |=  hand=deck:playing-cards
  ^-  hand-score
  ?:  (is-straight-flush hand)
    ['straight-flush' (get-tiebreak-values hand 'straight-flush')]
  ?:  (is-four-of-a-kind hand)
    ['four-of-a-kind' (get-tiebreak-values hand 'four-of-a-kind')]
  ?:  (is-full-house hand)
    ['full-house' (get-tiebreak-values hand 'full-house')]
  ?:  (is-flush hand)
    ['flush' (get-tiebreak-values hand 'flush')]
  ?:  (is-straight hand)
    ['straight' (get-tiebreak-values hand 'straight')]
  ?:  (is-three-of-a-kind hand)
    ['three-of-a-kind' (get-tiebreak-values hand 'three-of-a-kind')]
  ?:  (is-two-pair hand)
    ['two-pair' (get-tiebreak-values hand 'two-pair')]
  ?:  (is-pair hand)
    ['pair' (get-tiebreak-values hand 'pair')]
  ['high-card' (get-tiebreak-values hand 'high-card')]
++  is-straight-flush
  |=  hand=deck:playing-cards
  &((is-straight hand) (is-flush hand))
++  is-four-of-a-kind
  |=  hand=deck:playing-cards
  =/  i=@  0
  |-
  =/  current-card-value  +:(snag i hand)
  =/  filter-by-value  |=  card=darc:playing-cards  =(+:card current-card-value)
  ?:  =(4 (lent (skim hand filter-by-value)))
    &
  ?:  =(i 1)
    |
  $(i +(i))
++  is-flush
  |=  hand=deck:playing-cards
  ?~  hand
    !!
  =/  first-card-suit  -:i.hand
  |-
  ?~  t.hand
    &
  =/  current-card-suit  -:i.t.hand
  ?:  =(first-card-suit current-card-suit)
    $(hand t.hand)
  |
++  is-straight
  |=  hand=deck:playing-cards
  ?:  (is-wheel-straight hand)
    &
  ?~  hand
    !!
  =/  previous-card-value  +:i.hand
  |-
  ?~  t.hand
    &
  =/  next-card-value  +:i.t.hand
  ?:  =(+(previous-card-value) next-card-value)
    $(hand t.hand, previous-card-value next-card-value)
  |
++  is-wheel-straight
  ::Straight where hand is A-2-3-4-5
  ::
  |=  hand=deck:playing-cards
  ?.  =(2 +:(snag 0 hand))
    |
  ?.  =(3 +:(snag 1 hand))
    |
  ?.  =(4 +:(snag 2 hand))
    |
  ?.  =(5 +:(snag 3 hand))
    |
  ?.  =(14 +:(snag 4 hand))
    |
  &
++  is-three-of-a-kind
  |=  hand=deck:playing-cards
  =/  i=@  0
  =/  three-of-a-kind-found  |
  |-
  ?:  (gth i 3)
    three-of-a-kind-found
  =/  current-card-value  +:(snag i hand)
  =/  filter-by-value  |=  card=darc:playing-cards  =(+:card current-card-value)
  =/  number-of-matches  (lent (skim hand filter-by-value))
  ?:  =(2 number-of-matches)
    |
  ?:  =(3 number-of-matches)
    $(i +(i), three-of-a-kind-found &)
  $(i +(i))
++  is-two-pair
  |=  hand=deck:playing-cards
  =/  i=@  0
  =/  pairs-found  0
  |-
  ?:  (gth i 3)
    =(2 pairs-found)
  =/  current-card-value  +:(snag i hand)
  =/  filter-by-value  |=  card=darc:playing-cards  =(+:card current-card-value)
  =/  number-of-matches  (lent (skim hand filter-by-value))
  ?:  (gth number-of-matches 2)
    |
  ?:  =(2 number-of-matches)
    $(i (add i 2), pairs-found +(pairs-found))
  $(i +(i))
++  is-pair
  |=  hand=deck:playing-cards
  =/  i=@  0
  =/  one-pair-found  |
  |-
  ?:  (gth i 3)
    one-pair-found
  =/  current-card-value  +:(snag i hand)
  =/  filter-by-value  |=  card=darc:playing-cards  =(+:card current-card-value)
  =/  number-of-matches  (lent (skim hand filter-by-value))
  ?:  (gth number-of-matches 2)
    |
  ?:  =(2 number-of-matches)
    $(i (add i 2), one-pair-found !one-pair-found)
  $(i +(i))
++  is-full-house
  |=  hand=deck:playing-cards
  =/  i=@  0
  =/  pair-found  |
  =/  three-of-a-kind-found  |
  |-
  ?:  (gth i 3)
    &(pair-found three-of-a-kind-found)
  =/  current-card-value  +:(snag i hand)
  =/  filter-by-value  |=  card=darc:playing-cards  =(+:card current-card-value)
  =/  number-of-matches  (lent (skim hand filter-by-value))
  ?:  =(2 number-of-matches)
    $(i (add 2 i), pair-found &)
  ?:  =(3 number-of-matches)
    $(i (add 3 i), three-of-a-kind-found &)
  |
++  get-tiebreak-values
  |=  [hand=deck:playing-cards hand-type=@t]
  ^-  (list @)
  ::
  ::Easy cases first
  ::
  ::1. Straight with the highest single highest card wins
  ?:  |(=('straight' hand-type) =('straight-flush' hand-type))
    ::...unless that card happens to be an ace at the bottom of a wheel straight
    ::in which case the 'top' of the straight is 5
    ::
    ?:  (is-wheel-straight hand)
      ~[5]
    ~[+:(snag 4 hand)]
  ::2. Flushes/high-card hands are tiebroken by the single highest card
  ::If 2 hands have the same high card,the 2nd highest decides, then 3rd, etc.
  ::
  ?:  |(=('flush' hand-type) =('high-card' hand-type))
    (turn (flop hand) |=(card=darc:playing-cards +:card))
  ::3. These hands are tiebroken by the value of the large set of 3 or 4
  ::Hands are sorted, so the middle card is always part of the set of 3 or 4
  ::
  ?:  |(=('full-house' hand-type) =('three-of-a-kind' hand-type) =('four-of-a-kind' hand-type))
    ~[+:(snag 2 hand)]
  ::
  ::Relatively more annoying cases are dealt with on their own
  ::
  ?:  =('two-pair' hand-type)
    (get-tiebreak-values-two-pair hand)
  ?:  =('pair' hand-type)
    (get-tiebreak-values-pair hand)
  !!

++  get-tiebreak-values-two-pair
  ::This case is the trickiest because, unlike three/four of a kind...
  ::two competing hands can share have some of the same pairs
  ::So two hands can be tiebroken by the high pair, low pair, or the odd card out
  ::
  |=  hand=deck:playing-cards
  ::The hand is sorted, so cards at indices 1 and 3 will always be part of pairs
  ::
  =/  low-pair-value  +:(snag 1 hand)
  =/  high-pair-value  +:(snag 3 hand)
  =/  filter  |=  card=darc:playing-cards  |(=(+:card low-pair-value) =(+:card high-pair-value))
  =/  one-card-value  +:(snag 0 (skip hand filter))
  ~[high-pair-value low-pair-value one-card-value]

++  get-tiebreak-values-pair
  ::Pairs are tiebroken by the pair's value, followed by high cards
  ::
  |=  hand=deck:playing-cards
  =/  i  0
  |-
  ?:  =(4 i)
    !!
  =/  current-value  +:(snag i hand)
  =/  next-value  +:(snag +(i) hand)
  =/  get-card-value  |=(card=darc:playing-cards +:card)
  =/  filter-by-value  |=  card=darc:playing-cards  =(+:card current-value)
  ?:  =(current-value next-value)
    (weld ~[current-value] (turn (flop (skip hand filter-by-value)) get-card-value))
  $(i +(i))

++  hand-type-to-num
  ::This function is used to help compare hands arithmatically
  ::e.g. a straight-flush is better than a pair, so it will have a higher value
  ::
  |=  hand-type=@t
  ?:  =(hand-type 'high-card')
    0
  ?:  =(hand-type 'pair')
    1
  ?:  =(hand-type 'two-pair')
    2
  ?:  =(hand-type 'three-of-a-kind')
    3
  ?:  =(hand-type 'straight')
    4
  ?:  =(hand-type 'flush')
    5
  ?:  =(hand-type 'full-house')
    6
  ?:  =(hand-type 'four-of-a-kind')
    7
  ?:  =(hand-type 'straight-flush')
    8
  !!
--