Add poker exercise (#142)

config.json

@@ -683,6 +683,14 @@
         "prerequisites": [],
         "difficulty": 7
       },
+      {
+        "slug": "poker",
+        "name": "Poker",
+        "uuid": "08d1815b-185f-4bf3-b63b-99ee0d25c055",
+        "practices": [],
+        "prerequisites": [],
+        "difficulty": 7
+      },
       {
         "slug": "wordy",
         "name": "Wordy",

exercises/practice/poker/.docs/instructions.md

@@ -0,0 +1,7 @@
+# Instructions
+
+Pick the best hand(s) from a list of poker hands.
+
+See [Wikipedia][poker-hands] for an overview of poker hands.
+
+[poker-hands]: https://en.wikipedia.org/wiki/List_of_poker_hands

exercises/practice/poker/.meta/Example.roc

@@ -0,0 +1,108 @@
+module [bestHands]
+
+Value : U8
+Suit : [Spades, Hearts, Diamonds, Clubs]
+Card : { value : Value, suit : Suit }
+Hand : List Card
+HandParsingError : [InvalidNumberOfCards U64, CardWasEmpty, InvalidCardValue (List U8), InvalidCardSuit U8]
+
+bestHands : List Str -> Result (List Str) HandParsingError
+bestHands = \hands ->
+    parsedHands = hands |> List.mapTry? parseHand
+    ranks = parsedHands |> List.map getRank
+    topRank = ranks |> List.max |> Result.withDefault 0
+    List.map2 hands ranks \hand, rank -> { hand, rank }
+    |> List.joinMap \{ hand, rank } ->
+        if rank == topRank then [hand] else []
+    |> Ok
+
+parseHand : Str -> Result Hand HandParsingError
+parseHand = \handStr ->
+    cards = handStr |> Str.split " "
+    numCards = List.len cards
+    if numCards != 5 then
+        Err (InvalidNumberOfCards numCards)
+        else
+
+    cards |> List.mapTry parseCard
+
+parseCard : Str -> Result Card [CardWasEmpty, InvalidCardValue (List U8), InvalidCardSuit U8]
+parseCard = \cardStr ->
+    when cardStr |> Str.toUtf8 is
+        [] -> Err CardWasEmpty
+        [.. as valueChars, suitChar] ->
+            value = parseValue? valueChars
+            suit = parseSuit? suitChar
+            Ok { value, suit }
+
+parseValue : List U8 -> Result Value [InvalidCardValue (List U8)]
+parseValue = \chars ->
+    when chars is
+        [val] if val >= '2' && val <= '9' -> Ok (val - '0')
+        ['1', '0'] -> Ok 10
+        ['J'] -> Ok 11
+        ['Q'] -> Ok 12
+        ['K'] -> Ok 13
+        ['A'] -> Ok 14
+        _ -> Err (InvalidCardValue chars)
+
+parseSuit : U8 -> Result Suit [InvalidCardSuit U8]
+parseSuit = \char ->
+    when char is
+        'S' -> Ok Spades
+        'H' -> Ok Hearts
+        'D' -> Ok Diamonds
+        'C' -> Ok Clubs
+        _ -> Err (InvalidCardSuit char)
+
+getRank : Hand -> U64
+getRank = \hand ->
+    cardValues = hand |> List.map .value |> List.map Num.toU64 |> List.sortAsc
+    isConsecutive =
+        List.map2 cardValues (cardValues |> List.takeLast 4) \card1, card2 -> (card1, card2)
+        |> List.all \(card1, card2) -> card2 - card1 == 1
+    isSpecialStraight = cardValues == [2, 3, 4, 5, 14] # straight starting with Ace
+    isStraight = isConsecutive || isSpecialStraight
+    isFlush = (hand |> List.map .suit |> Set.fromList |> Set.len) == 1
+
+    valueGroups =
+        # Example: [4, 4, 4, 7, 7] -> [{size: 3, value: 4}, {size: 2, value: 7}]
+        cardValues
+        |> List.walk (List.repeat 0 13) \counters, cardValue ->
+            counters |> List.update (cardValue - 2) \groupSize -> groupSize + 1
+        |> List.mapWithIndex \counter, value -> counter * 13 + value
+        |> List.sortDesc
+        |> List.map \groupRank -> { size: groupRank // 13, value: groupRank % 13 + 2 }
+        |> List.dropIf \{ size } -> size == 0
+
+    groupSizes = valueGroups |> List.map .size
+
+    category =
+        if isFlush && isStraight then
+            8 # Straight flush
+        else if groupSizes == [4, 1] then
+            7 # Four of a kind
+        else if groupSizes == [3, 2] then
+            6 # Full house
+        else if isFlush then
+            5 # Flush
+        else if isStraight then
+            4 # Straight
+        else if groupSizes == [3, 1, 1] then
+            3 # Three of a kind
+        else if groupSizes == [2, 2, 1] then
+            2 # Two pairs
+        else if groupSizes == [2, 1, 1, 1] then
+            1 # One pair
+        else
+            0 # High card
+
+    rankWithinCategory =
+        if isSpecialStraight then
+            0 # the straight starting with an Ace is the smallest straight
+        else
+            valueGroups
+            |> List.walk 0 \rank, { value } ->
+                rank * 13 + value - 2
+
+    category * Num.powInt 13 5 + rankWithinCategory

exercises/practice/poker/.meta/config.json

@@ -0,0 +1,19 @@
+{
+  "authors": [
+    "ageron"
+  ],
+  "files": {
+    "solution": [
+      "Poker.roc"
+    ],
+    "test": [
+      "poker-test.roc"
+    ],
+    "example": [
+      ".meta/Example.roc"
+    ]
+  },
+  "blurb": "Pick the best hand(s) from a list of poker hands.",
+  "source": "Inspired by the training course from Udacity.",
+  "source_url": "https://www.udacity.com/course/design-of-computer-programs--cs212"
+}

exercises/practice/poker/.meta/template.j2

@@ -0,0 +1,14 @@
+{%- import "generator_macros.j2" as macros with context -%}
+{{ macros.canonical_ref() }}
+{{ macros.header() }}
+
+import {{ exercise | to_pascal }} exposing [{{ cases[0]["property"] | to_camel }}]
+
+{% for case in cases -%}
+# {{ case["description"] }}
+expect
+    hands = {{ case["input"]["hands"] | to_roc }}
+    result = {{ case["property"] | to_camel }} hands
+    result == Ok {{ case["expected"] | to_roc }}
+
+{% endfor %}

exercises/practice/poker/.meta/tests.toml

@@ -0,0 +1,131 @@
+# This is an auto-generated file.
+#
+# Regenerating this file via `configlet sync` will:
+# - Recreate every `description` key/value pair
+# - Recreate every `reimplements` key/value pair, where they exist in problem-specifications
+# - Remove any `include = true` key/value pair (an omitted `include` key implies inclusion)
+# - Preserve any other key/value pair
+#
+# As user-added comments (using the # character) will be removed when this file
+# is regenerated, comments can be added via a `comment` key.
+
+[161f485e-39c2-4012-84cf-bec0c755b66c]
+description = "single hand always wins"
+
+[370ac23a-a00f-48a9-9965-6f3fb595cf45]
+description = "highest card out of all hands wins"
+
+[d94ad5a7-17df-484b-9932-c64fc26cff52]
+description = "a tie has multiple winners"
+
+[61ed83a9-cfaa-40a5-942a-51f52f0a8725]
+description = "multiple hands with the same high cards, tie compares next highest ranked, down to last card"
+
+[da01becd-f5b0-4342-b7f3-1318191d0580]
+description = "winning high card hand also has the lowest card"
+
+[f7175a89-34ff-44de-b3d7-f6fd97d1fca4]
+description = "one pair beats high card"
+
+[e114fd41-a301-4111-a9e7-5a7f72a76561]
+description = "highest pair wins"
+
+[b3acd3a7-f9fa-4647-85ab-e0a9e07d1365]
+description = "both hands have the same pair, high card wins"
+
+[935bb4dc-a622-4400-97fa-86e7d06b1f76]
+description = "two pairs beats one pair"
+
+[c8aeafe1-6e3d-4711-a6de-5161deca91fd]
+description = "both hands have two pairs, highest ranked pair wins"
+
+[88abe1ba-7ad7-40f3-847e-0a26f8e46a60]
+description = "both hands have two pairs, with the same highest ranked pair, tie goes to low pair"
+
+[15a7a315-0577-47a3-9981-d6cf8e6f387b]
+description = "both hands have two identically ranked pairs, tie goes to remaining card (kicker)"
+
+[f761e21b-2560-4774-a02a-b3e9366a51ce]
+description = "both hands have two pairs that add to the same value, win goes to highest pair"
+
+[fc6277ac-94ac-4078-8d39-9d441bc7a79e]
+description = "two pairs first ranked by largest pair"
+
+[21e9f1e6-2d72-49a1-a930-228e5e0195dc]
+description = "three of a kind beats two pair"
+
+[c2fffd1f-c287-480f-bf2d-9628e63bbcc3]
+description = "both hands have three of a kind, tie goes to highest ranked triplet"
+
+[eb856cc2-481c-4b0d-9835-4d75d07a5d9d]
+description = "with multiple decks, two players can have same three of a kind, ties go to highest remaining cards"
+include = false
+
+[26a4a7d4-34a2-4f18-90b4-4a8dd35d2bb1]
+description = "with multiple decks, two players can have same three of a kind, ties go to highest remaining cards"
+reimplements = "eb856cc2-481c-4b0d-9835-4d75d07a5d9d"
+
+[a858c5d9-2f28-48e7-9980-b7fa04060a60]
+description = "a straight beats three of a kind"
+
+[73c9c756-e63e-4b01-a88d-0d4491a7a0e3]
+description = "aces can end a straight (10 J Q K A)"
+
+[76856b0d-35cd-49ce-a492-fe5db53abc02]
+description = "aces can start a straight (A 2 3 4 5)"
+
+[e214b7df-dcba-45d3-a2e5-342d8c46c286]
+description = "aces cannot be in the middle of a straight (Q K A 2 3)"
+
+[6980c612-bbff-4914-b17a-b044e4e69ea1]
+description = "both hands with a straight, tie goes to highest ranked card"
+
+[5135675c-c2fc-4e21-9ba3-af77a32e9ba4]
+description = "even though an ace is usually high, a 5-high straight is the lowest-scoring straight"
+
+[c601b5e6-e1df-4ade-b444-b60ce13b2571]
+description = "flush beats a straight"
+
+[4d90261d-251c-49bd-a468-896bf10133de]
+description = "both hands have a flush, tie goes to high card, down to the last one if necessary"
+include = false
+
+[e04137c5-c19a-4dfc-97a1-9dfe9baaa2ff]
+description = "both hands have a flush, tie goes to high card, down to the last one if necessary"
+reimplements = "4d90261d-251c-49bd-a468-896bf10133de"
+
+[3a19361d-8974-455c-82e5-f7152f5dba7c]
+description = "full house beats a flush"
+
+[eb73d0e6-b66c-4f0f-b8ba-bf96bc0a67f0]
+description = "both hands have a full house, tie goes to highest-ranked triplet"
+
+[34b51168-1e43-4c0d-9b32-e356159b4d5d]
+description = "with multiple decks, both hands have a full house with the same triplet, tie goes to the pair"
+
+[d61e9e99-883b-4f99-b021-18f0ae50c5f4]
+description = "four of a kind beats a full house"
+
+[2e1c8c63-e0cb-4214-a01b-91954490d2fe]
+description = "both hands have four of a kind, tie goes to high quad"
+
+[892ca75d-5474-495d-9f64-a6ce2dcdb7e1]
+description = "with multiple decks, both hands with identical four of a kind, tie determined by kicker"
+
+[923bd910-dc7b-4f7d-a330-8b42ec10a3ac]
+description = "straight flush beats four of a kind"
+
+[d9629e22-c943-460b-a951-2134d1b43346]
+description = "aces can end a straight flush (10 J Q K A)"
+
+[05d5ede9-64a5-4678-b8ae-cf4c595dc824]
+description = "aces can start a straight flush (A 2 3 4 5)"
+
+[ad655466-6d04-49e8-a50c-0043c3ac18ff]
+description = "aces cannot be in the middle of a straight flush (Q K A 2 3)"
+
+[d0927f70-5aec-43db-aed8-1cbd1b6ee9ad]
+description = "both hands have a straight flush, tie goes to highest-ranked card"
+
+[be620e09-0397-497b-ac37-d1d7a4464cfc]
+description = "even though an ace is usually high, a 5-high straight flush is the lowest-scoring straight flush"

exercises/practice/poker/Poker.roc

@@ -0,0 +1,5 @@
+module [bestHands]
+
+bestHands : List Str -> Result (List Str) _
+bestHands = \hands ->
+    crash "Please implement the 'bestHands' function"