Poker Fun with XQuery

Poker Fun with XQuery

Posted on January 02, 2019 0 Comments

In this post, we dive into building a full five-card draw poker game with a configurable number of players. Written in XQuery 1.0, along with MarkLogic extensions to the language (the “xquery version 1.0-ml” dialect), this game provides examples of some great programming capabilities, including usage of maps, recursions, random numbers (via xdmp:random()), and side effects (via xdmp:set()). Hopefully, the following will show those new to XQuery a look at the language that they may not get to see in other tutorials or examples.

Getting Started

Let’s start with some general declarations:

xquery version "1.0-ml";

declare variable $shuffle-count as xs:int := 7;
declare variable $player-count as xs:int := 4;
declare variable $players as xs:string* :=
  for $number in (1 to $player-count)
  return concat('Player ', $number);
declare variable $suits as xs:string* := ('♣', '♢', '♡', '♠');
declare variable $aliases as object-node()* := (
  object-node{'rank' : 11, 'label' : 'J'},
  object-node{'rank' : 12, 'label' : 'Q'},
  object-node{'rank' : 13, 'label' : 'K'},
  (: because Aces rank higher than Kings :)
  object-node{'rank' : 14, 'label' : 'A', 'alt-rank' : 1 }
);

Building a Deck of Cards

Next, we build the actual deck of cards. Poker normally treats Aces as higher than King, so set the Ace to a rank of 14 to ease the computation of the winner later on.

declare function local:build-deck(
) as object-node()* {
  for $suit in $suits
  for $rank in (2 to 14)
  return local:build-card($rank, $suit)
};

declare function local:build-card(
  $rank as xs:int,
  $suit as xs:string
) as object-node(){
  let $alias := $aliases[rank = $rank]
  return xdmp:to-json(map:new((
    map:entry('rank', $rank),
    map:entry('suit', $suit),
    if (fn:empty($alias/label)) then ()
    else map:entry('alias', $alias/label),
    if (fn:empty($alias/alt-rank)) then ()
    else map:entry('alt-rank', $alias/alt-rank)
  )))/node()
};

Figure 1: Building the deck of cards

Using xdmp:to-json(map:new()) is a good way to handle cases where some values sequences have multiple or null values. This approach automatically converts an empty sequence to a null-node{}, while converting sequences with multiple values into an array-node{}. If we use a normal object-node{} declaration, then we will encounter an error if we do not handle such cases explicitly (error: XDMP-OBJCONSTRUCTCHILDSEQ: () -- Object nodes cannot have sequence children: alias). The /node() is needed to adhere to the function declaration that requires the function to return an object-node()* and not a document-node().

We could include the Joker card into the mix above, but standard Texas Holdem doesn’t include it. :)

Shuffling the Deck

Armed with a function to build an actual deck, we can now consider how to shuffle the deck. Sticking to our poker theme, we can prepare the logic for a standard riffle shuffle. The riffle shuffle divides the deck into two almost equal halves and then interlaces the cards together.

declare function local:riffle-shuffle(
  $deck as object-node()*
) as object-node()* {
  let $size := fn:count($deck)
  (: get somewhere in the middle :)
  let $cut := $size div 2 + xdmp:random(xs:int($size div 10))
  let $left := $deck[1 to $cut - 1]
  let $right := $deck[$cut to last()]
  return local:weave($left, $right)
};

declare function local:weave(
  $left as object-node()*,
  $right as object-node()*
) as object-node()* {
  if (fn:empty($left)) then $right
  else if (fn:empty($right)) then $left
  else
  let $card :=
    if (xdmp:random(1) gt 0) then
      (: pick card from left :)
      (
        $left[1],
        xdmp:set($left, $left[2 to last()])
      )
    else
      (: pick card from right :)
      (
        $right[1],
        xdmp:set($right, $right[2 to last()])
      )
  return ($card, local:weave($left, $right))
};

Figure 2: Defining the riffle shuffle

Always declare the type of your inputs and results; this will keep your code clean and readable.

Notice the use of xdmp:set in Figure 2, a function useful in overwriting the value of variables in a FLWOR expression. If you tried executing the code below in Figure 3, the recursions will never end and cause the error: XDMP-STACKOVERFLOW: Stack overflow. This error is caused primarily because the inner $left and $right affect the outer variables of the same name as part of the function declaration.

declare function local:weave(
  $left as object-node()*,
  $right as object-node()*
) as object-node()* {
  if (fn:empty($left)) then $right
  else if (fn:empty($right)) then $left
  else
  let $card :=
    if (xdmp:random(1) gt 0) then
      (: pick card from left :)
      (
        let $result := $left[1]
        let $left := $left[2 to last()]
        return $result
      )
    else
      (: pick card from right :)
      (
        let $result := $right[1]
        let $right := $right[2 to last()]
        return $result
      )
  return ($card, local:weave($left, $right))
};

Figure 3: Example code that will cause the dreaded Stack Overflow error

The above implementation of the riffle shuffle in Figure 2 sticks with our poker theme, but we really should use a much simpler and more reliable sort:

declare function local:shuffle(
  $deck as object-node()*
) as object-node()* {
  for $card in $deck
  order by xdmp:random()
  return

Figure 4: Simpler and more reliable sort

Defining Hands

Now that we can shuffle our deck, we need functions to check if card combinations are present. Let’s build the rules check.

Let’s start simple and look for a four-of-a-kind:

declare function local:get-four-of-a-kind(
  $cards as object-node()*
) as object-node()* {
  if (count($cards) lt 4 ) then ()
  else
    for $rank in fn:distinct-values($cards/rank)
    let $quad := $cards[rank = $rank]
    where fn:count($quad) eq 4
    return $quad
};

Figure 5: Is there a four-of-a-kind?

The starting code is rather straightforward; if the number of cards is insufficient to match the required amount, then return nothing. Notice that the prefix of fn: has been omitted in the first call to fn:count. Ever wonder when to use fn and when to not?

We can copy that logic to look for a three-of-a-kind and pairs.

declare function local:get-three-of-a-kind(
  $cards as object-node()*
) as object-node()* {
  if (count($cards) lt 3 ) then ()
  else
    for $rank in fn:distinct-values($cards/rank)
    let $trio := $cards[rank = $rank]
    where fn:count($trio) eq 3
    return $trio
};

Figure 6: Is there a three-of-a-kind? 

declare function local:get-pairs(
  $cards as object-node()*
) as object-node()* {
  if (count($cards) lt 2 ) then ()
  else
    for $rank in fn:distinct-values($cards/rank)
    let $pair := $cards[rank = $rank]
    where fn:count($pair) eq 2
    order by $rank descending
    return $pair
};

Figure 7: Is there a pair?

Note that checking for a pair may return more than one pair. For example, the for loop could iterate through all distinct ranks and find pairs for 9 and 13 (i.e. King). It will not stop at the first occurrence of a pair.

We can now re-use get-three-of-a-kind  and get-two-of-a-kind to check for a full house:

declare function local:get-full-house(
  $cards as object-node()*
) as object-node()* {
  if (count($cards) lt 5 ) then ()
  else
    let $three := local:get-three-of-a-kind($cards)/cards
    let $two := local:get-pairs($cards)/cards
    where (fn:not(fn:empty($three)) and fn:not(fn:empty($two)))
    return ( $three, $two )
};

Figure 8: Is there a full house?

Checking for a flush is even more straight-forward:

declare function local:get-flush(
  $cards as object-node()*
) as object-node()* {
  if (count($cards) lt 5 ) then ()
  else if (count(distinct-values($cards/suit)) gt 1) then ()
  else $cards
};

Figure 9: Is there a flush?

Checking for a straight is a little more complicated. Apart from simple sequences, we need to check for the case of Aces which we currently treat as rank 14. Additionally, a straight from one to five would have 5 as its highest ranking card, not Ace.

declare function local:get-straight(
  $cards as object-node()*
) as object-node()* {
  if (count($cards) lt 5 ) then ()
  else
    let $card-ranks := ($cards/rank, $cards/alt-rank)
    for $rank in (fn:min($cards/rank), $cards/alt-rank)
    where ($card-ranks = $rank and 
      $card-ranks = $rank + 1 and
      $card-ranks = $rank + 2 and
      $card-ranks = $rank + 3 and
      $card-ranks = $rank + 4)
    return $cards
};

Figure 10: Is there a straight?

Notice that we are generating a single dimensional sequence using other sequences in the code let $card-ranks := ($cards/rank, $cards/alt-rank). Be aware that XQuery does not have multi-dimensional sequences. That code will generate a sequence starting with values from $cards/rank, followed by values from $cards/alt-rank.

Additionally, we are comparing a sequence of multiple values against a single value in $card-ranks = $rank. This line can be translated as “does $card-ranks contain the value $rank?” There is a mild difference between the use of = and eq – know why?

We can now reuse the above two functions from Figure 9 (flush) and Figure 10 (straight) to check for a straight flush and a royal flush.

declare function local:get-straight-flush(
  $cards as object-node()*
) as object-node()* {
  if (count($cards) lt 5 ) then ()
  else if (fn:empty(local:get-flush($cards))) then ()
  else if (fn:empty(local:get-straight($cards))) then ()
  else $cards
};

declare function local:get-royal-flush(
  $cards as object-node()*
) as object-node()* {
  if (count($cards) lt 5 ) then ()
  else if ($cards/rank lt 10) then ()
  else if (fn:empty(local:get-straight-flush($cards))) then ()
  else $cards
};

Figure 11: Is there a straight flush or royal flush?

Notice that $cards/rank lt 10 is another area where we are evaluating an entire sequence against a single value. This particular fragment can be translated as: “Is there any value in $cards/rank that is less than 10?”

Kicker Card

Finally, let’s build a simple function to pick out the top card in case no other combinations are present, a.k.a. the kicker card:

declare function local:get-top-card(
  $cards as object-node()*
) as object-node() {
  let $top-card := $cards[rank = fn:max($cards/rank)][1]
  return $top-card
};

Figure 12: Deal a card   

Ranking Hands

We need to rank each card combination, e.g. a royal flush is higher than a straight flush.

declare variable $combinations as object-node()* := (
  object-node { 'label' : 'Royal Flush'    , 'count' : 5, 'rank' : 10, 'function' : 'local:get-royal-flush'},
  object-node { 'label' : 'Straight Flush' , 'count' : 5, 'rank' : 9 , 'function' : 'local:get-straight-flush'},
  object-node { 'label' : 'Four of a Kind' , 'count' : 4, 'rank' : 8 , 'function' : 'local:get-four-of-a-kind'},
  object-node { 'label' : 'Full House'     , 'count' : 5, 'rank' : 7 , 'function' : 'local:get-full-house'},
  object-node { 'label' : 'Flush'          , 'count' : 5, 'rank' : 6 , 'function' : 'local:get-flush'},
  object-node { 'label' : 'Straight'       , 'count' : 5, 'rank' : 5 , 'function' : 'local:get-straight'},
  object-node { 'label' : 'Three of a Kind', 'count' : 3, 'rank' : 4 , 'function' : 'local:get-three-of-a-kind'},
  object-node { 'label' : 'Two Pairs'      , 'count' : 4, 'rank' : 3 , 'function' : 'local:get-pairs'},
  object-node { 'label' : 'One Pair'       , 'count' : 2, 'rank' : 2 , 'function' : 'local:get-pairs'},
  object-node { 'label' : 'Singles'        , 'count' : 1, 'rank' : 1 , 'function' : 'local:get-top-card'}
);

Figure 13: Ranking card combinations

The function property allows us to invoke the corresponding function later on, similar to how Java uses reflections.

Evaluating Hands

We define our logic to evaluate a hand as follows:

declare function local:check-hand(
  $cards as object-node()*
) as object-node() {
  (
    for $combination in $combinations
    let $candidate := xdmp:apply(xdmp:function(xs:QName($combination/function)), $cards)
    where fn:count($candidate) eq $combination/count
    order by $combination/rank descending
    return object-node {
      'label' : $combination/label,
      'cards' : array-node{( $candidate )},
      'rank' : $combination/rank
    }
  )[1]
};

Figure 14: Evaluating a hand

Remember, our for loop will iterate over all combinations, but we are only interested in the highest possible combination, hence we have the expression (…FLWOR…)[1] (which translates into “the inner FLWOR will return a sequence, but I only need the highest/first”).

The function in Figure 14 will only evaluate the best combination for each player’s hand. We need a function to compare player hands and identify which hand is better. We’ll go through this step-by-step to highlight the rules of poker.

declare function local:compare-hands(
  $player-1-cards as object-node()*,
  $player-2-cards as object-node()*
) as xs:int {
  let $player-1-set := local:check-hand($player-1-cards)
  let $player-2-set := local:check-hand($player-2-cards)
  return if ($player-1-set/rank gt $player-2-set/rank) then 1
    else if ($player-1-set/rank lt $player-2-set/rank) then 2

Figure 15: Comparing hands

The starting code in Figure 15 is simple enough: make use of the combination’s rank to identify which is better (e.g. a double-pair hand will win over a single-pair hand). Now we need to handle cases where the combination/set rank is the same:

    (: same set ranks :)
    else if ($player-1-set/rank = (10, 9, 5)) then
      (: straight related :)
      let $player-1-top-rank := local:get-top-card-of-straight($player-1-cards)
      let $player-2-top-rank := local:get-top-card-of-straight($player-2-cards)
      return if ($player-1-top-rank gt $player-2-top-rank) then 1
        else if ($player-1-top-rank lt $player-2-top-rank) then 2
        else 0
...
};

declare function local:get-top-card-of-straight(
  $set-cards as object-node()*
) as xs:int {
  if (min($set-cards/rank) = 2 and max($set-cards/rank) = 14) then 5
  else max($set-cards/rank)
};

Figure 16: What if the combination rank is the same? Highest card.

Royal flush (10), straight flush (9) and straight (5) follow the rule of the highest card. However, in the case of Ace, 2, 3, 4, or 5, the Ace is treated as rank 1, thus having a high card of 5 instead of 14.

else if ($player-1-set/rank = (7)) then
  (: full house :)
  let $player-1-trio := local:get-three-of-a-kind($player-1-cards)[1]
  let $player-2-trio := local:get-three-of-a-kind($player-2-cards)[1]
  return if ($player-1-trio/rank gt $player-2-trio/rank) then 1
    else if ($player-1-trio/rank lt $player-2-trio/rank) then 2
    else
      let $player-1-pair := local:get-pairs($player-1-cards)[1]
      let $player-2-pair := local:get-pairs($player-2-cards)[1]
      return if ($player-1-pair/rank gt $player-2-pair/rank) then 1
      else if ($player-1-pair/rank lt $player-2-pair/rank) then 2
      else 0

Figure 17: Full house uses three-of-a-kind as the deciding factor

Full house (7) will make use of the three-of-a-kind as the main deciding factor. We are also taking into consideration the pairs in case we reuse this code for Texas Holdem. :)

else if ($player-1-set/rank = (3)) then
  (: two pairs :)
  if (max($player-1-set/cards/rank) gt max($player-2-set/cards/rank)) then 1
  else if (max($player-1-set/cards/rank) lt max($player-2-set/cards/rank)) then 2
  else if (min($player-1-set/cards/rank) gt min($player-2-set/cards/rank)) then 1
  else if (min($player-1-set/cards/rank) lt min($player-2-set/cards/rank)) then 2
  else local:compare-kickers(
    local:get-remaining-cards($player-1-cards, $player-1-set),
    local:get-remaining-cards($player-2-cards, $player-2-set)
  )

Figure 18: Comparing two pairs

Two pairs (3) will first take into consideration the higher pair. In the case of a tie on the high pair, the low pair is then considered. Upon further tie, the last card, a.k.a. kicker card, is evaluated. For example, a hand with A, A, 2, 2, 5 will win against K, K, Q, Q, A.

Else
  if (max($player-1-set/cards/rank) gt max($player-2-set/cards/rank)) then 1
  else if (max($player-1-set/cards/rank) lt max($player-2-set/cards/rank)) then 2
  else local:compare-kickers(
    local:get-remaining-cards($player-1-cards, $player-1-set/card),
    local:get-remaining-cards($player-2-cards, $player-2-set/card)
  )

Figure 19: Comparing remaining combinations via highest card or kicker

For the rest of the combinations (i.e. four-of-a-kind, flush, three-of-a-kind, single pair), we first evaluate the highest card of the combination, then in case of a tie, the kicker cards.

declare function local:format-display(
  $set-cards as object-node()*,
  $remaining as object-node()*
) as xs:string {
  fn:string-join((
    for $card in ($set-cards, $remaining)
    return fn:string-join((($card/alias, xs:string($card/rank))[1], $card/suit))
  ), ", ")
};

Figure 20: Display a player’s hand

Lastly, Figure 20 displays a player’s hand and makes our game easier to read.

Let’s Play!

The code below in Figure 21 creates a map that holds the cards dealt for each player.

(: build the deck :)
let $deck := local:build-deck()
(: shuffle :)
let $_ :=
  for $count in (1 to $shuffle-count)
  return xdmp:set($deck, local:shuffle($deck))
(: create the players :)
let $player-cards := map:new((
  for $player in $players
  return map:entry($player, ())
))
(: deal the cards to each player :)
let $_ := 
  (: standard 5 card draw poker :)
  for $counter in (1 to 5)
  for $player in $players
  let $card := (
    $deck[1],
    xdmp:set($deck, $deck[2 to last()])
  )
  return map:put($player-cards, $player, (map:get($player-cards, $player), $card))

Figure 21: Start the game by dealing cards to all players

Remember that (map:get($player-cards, $player), $card creates a single dimensional sequence.

Figure 22 compares each player’s hand and determines which is best. The $winners variable will hold the player name of the winner(s).

(: compare player hands :)
let $winners := ()
let $_ :=
  for $player in $players
  let $compare :=
    for $winner in $winners
    return local:compare-hands(map:get($player-cards, $winner), map:get($player-cards, $player))
  return
    if ($compare = 2) then 
      xdmp:set($winners, $player)
    else if ($compare = 1) then
      (: current set of winners win :)
      ()
    else
      (: it's a tie -- split the pot :)
      xdmp:set($winners, ($winners, $player))

Figure 22: Compare player hands

With that, we can now announce our winner, or winners in case of ties:

for $player in $players
let $cards := map:get($player-cards, $player)
let $set := local:check-hand($cards)
return fn:string-join((
    $player, 
    local:format-display($set/cards, local:get-remaining-cards($cards, $set/cards)),
    $set/label,
    if ($player = $winners) then "Winner!"
    else ()
  )
  , " - "
)

Figure 23: Displaying the winner(s)

Running this code from QConsole might return something like the following:

what's displayed on QConsole after running code through it. Displays stats for players 1-4 with what kind of cards they have and who won. Player 3 wins here.

Figure 24: Sample game output

Congratulations Player 3!!

Conclusion

Hopefully, this was as fun for you to follow along as it was for me to write, and that these examples provided some insight in programming in XQuery.

To all the poker enthusiasts out there, feel free to take this game and run with it. Add logic related to ante, folding, raising…go wild!

Additional Resources

Gabo Manuel

View all posts from Gabo Manuel on the Progress blog. Connect with us about all things application development and deployment, data integration and digital business.

Comments

Comments are disabled in preview mode.
Topics

Sitefinity Training and Certification Now Available.

Let our experts teach you how to use Sitefinity's best-in-class features to deliver compelling digital experiences.

Learn More
Latest Stories
in Your Inbox

Subscribe to get all the news, info and tutorials you need to build better business apps and sites

Loading animation