yacht: add exercise

config.json

@@ -1292,6 +1292,16 @@
         ],
         "difficulty": 5,
         "status": "beta"
+      },
+      {
+        "slug": "yacht",
+        "name": "Yacht",
+        "uuid": "a722b0da-7060-4dd5-930f-4fea566afebf",
+        "practices": [
+          "lists"
+        ],
+        "prerequisites": [],
+        "difficulty": 5
       }
     ],
     "foregone": [

exercises/practice/yacht/.docs/instructions.md

@@ -0,0 +1,35 @@
+# Instructions
+
+The dice game [Yacht][yacht] is from the same family as Poker Dice, Generala and particularly Yahtzee, of which it is a precursor.
+In the game, five dice are rolled and the result can be entered in any of twelve categories.
+The score of a throw of the dice depends on category chosen.
+
+## Scores in Yacht
+
+| Category        | Score                  | Description                              | Example             |
+| --------------- | ---------------------- | ---------------------------------------- | ------------------- |
+| Ones            | 1 × number of ones     | Any combination                          | 1 1 1 4 5 scores 3  |
+| Twos            | 2 × number of twos     | Any combination                          | 2 2 3 4 5 scores 4  |
+| Threes          | 3 × number of threes   | Any combination                          | 3 3 3 3 3 scores 15 |
+| Fours           | 4 × number of fours    | Any combination                          | 1 2 3 3 5 scores 0  |
+| Fives           | 5 × number of fives    | Any combination                          | 5 1 5 2 5 scores 15 |
+| Sixes           | 6 × number of sixes    | Any combination                          | 2 3 4 5 6 scores 6  |
+| Full House      | Total of the dice      | Three of one number and two of another   | 3 3 3 5 5 scores 19 |
+| Four of a Kind  | Total of the four dice | At least four dice showing the same face | 4 4 4 4 6 scores 16 |
+| Little Straight | 30 points              | 1-2-3-4-5                                | 1 2 3 4 5 scores 30 |
+| Big Straight    | 30 points              | 2-3-4-5-6                                | 2 3 4 5 6 scores 30 |
+| Choice          | Sum of the dice        | Any combination                          | 2 3 3 4 6 scores 18 |
+| Yacht           | 50 points              | All five dice showing the same face      | 4 4 4 4 4 scores 50 |
+
+If the dice do not satisfy the requirements of a category, the score is zero.
+If, for example, _Four Of A Kind_ is entered in the _Yacht_ category, zero points are scored.
+A _Yacht_ scores zero if entered in the _Full House_ category.
+
+## Task
+
+Given a list of values for five dice and a category, your solution should return the score of the dice for that category.
+If the dice do not satisfy the requirements of the category your solution should return 0.
+You can assume that five values will always be presented, and the value of each will be between one and six inclusively.
+You should not assume that the dice are ordered.
+
+[yacht]: https://en.wikipedia.org/wiki/Yacht_(dice_game)

exercises/practice/yacht/.meta/config.json

@@ -0,0 +1,19 @@
+{
+  "authors": [
+    "SimaDovakin"
+  ],
+  "files": {
+    "solution": [
+      "./yacht.lisp"
+    ],
+    "test": [
+      "./yacht-test.lisp"
+    ],
+    "example": [
+      "./.meta/example.lisp"
+    ]
+  },
+  "blurb": "Score a single throw of dice in the game Yacht.",
+  "source": "James Kilfiger, using wikipedia",
+  "source_url": "https://en.wikipedia.org/wiki/Yacht_(dice_game)"
+}

exercises/practice/yacht/.meta/example.lisp

@@ -0,0 +1,63 @@
+(defpackage :yacht
+  (:use :cl)
+  (:export :score))
+(in-package :yacht)
+
+(defun hash-values (ht)
+  (let ((vals '()))
+    (progn
+      (loop for v being each hash-value of ht do (setf vals (cons v vals)))
+      vals)))
+
+(defun frequencies (sequence)
+  (let ((occurences (make-hash-table)))
+    (reduce (lambda (acc n)
+                (let ((freq (gethash n acc)))
+                  (if freq
+                      (progn
+                        (setf (gethash n acc) (+ freq 1))
+                        acc
+                      )
+                      (progn
+                        (setf (gethash n acc) 1))))
+                        acc)
+            sequence
+            :initial-value occurences)))
+
+(defun full-house? (scores)
+  (let* ((occurences (frequencies scores))
+         (vals (hash-values occurences)))
+        (equal '(2 3) (sort vals #'<))))
+
+(defun four-of-a-king-dice (occurences)
+  (let ((pair nil))
+    (maphash (lambda (key val)
+              (if (>= val 4)
+                  (setf pair key)))
+             occurences)
+    pair))
+
+(defun score (scores category)
+  "Returns the score of the dice for the given category."
+  (cond ((equal category "ones") (count 1 scores))
+        ((equal category "twos") (* 2 (count 2 scores)))
+        ((equal category "threes") (* 3 (count 3 scores)))
+        ((equal category "fours") (* 4 (count 4 scores)))
+        ((equal category "fives") (* 5 (count 5 scores)))
+        ((equal category "sixes") (* 6 (count 6 scores)))
+        ((equal category "full house") (if (full-house? scores)
+                                           (reduce '+ scores)
+                                           0))
+        ((equal category "four of a kind") (let ((dice (four-of-a-king-dice (frequencies scores))))
+                                                (if dice (* 4 dice) 0)))
+        ((equal category "little straight") (if (equal '(1 2 3 4 5) (sort scores #'<))
+                                                30
+                                                0))
+        ((equal category "big straight") (if (equal '(2 3 4 5 6) (sort scores #'<))
+                                             30
+                                             0))
+        ((equal category "choice") (reduce '+ scores))
+        ((equal category "yacht") (if (= 1 (hash-table-count (frequencies scores)))
+                                      50
+                                      0))
+        (t 0)))

exercises/practice/yacht/.meta/tests.toml

@@ -0,0 +1,97 @@
+# 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.
+
+[3060e4a5-4063-4deb-a380-a630b43a84b6]
+description = "Yacht"
+
+[15026df2-f567-482f-b4d5-5297d57769d9]
+description = "Not Yacht"
+
+[36b6af0c-ca06-4666-97de-5d31213957a4]
+description = "Ones"
+
+[023a07c8-6c6e-44d0-bc17-efc5e1b8205a]
+description = "Ones, out of order"
+
+[7189afac-cccd-4a74-8182-1cb1f374e496]
+description = "No ones"
+
+[793c4292-dd14-49c4-9707-6d9c56cee725]
+description = "Twos"
+
+[dc41bceb-d0c5-4634-a734-c01b4233a0c6]
+description = "Fours"
+
+[f6125417-5c8a-4bca-bc5b-b4b76d0d28c8]
+description = "Yacht counted as threes"
+
+[464fc809-96ed-46e4-acb8-d44e302e9726]
+description = "Yacht of 3s counted as fives"
+
+[d054227f-3a71-4565-a684-5c7e621ec1e9]
+description = "Fives"
+
+[e8a036e0-9d21-443a-8b5f-e15a9e19a761]
+description = "Sixes"
+
+[51cb26db-6b24-49af-a9ff-12f53b252eea]
+description = "Full house two small, three big"
+
+[1822ca9d-f235-4447-b430-2e8cfc448f0c]
+description = "Full house three small, two big"
+
+[b208a3fc-db2e-4363-a936-9e9a71e69c07]
+description = "Two pair is not a full house"
+
+[b90209c3-5956-445b-8a0b-0ac8b906b1c2]
+description = "Four of a kind is not a full house"
+
+[32a3f4ee-9142-4edf-ba70-6c0f96eb4b0c]
+description = "Yacht is not a full house"
+
+[b286084d-0568-4460-844a-ba79d71d79c6]
+description = "Four of a Kind"
+
+[f25c0c90-5397-4732-9779-b1e9b5f612ca]
+description = "Yacht can be scored as Four of a Kind"
+
+[9f8ef4f0-72bb-401a-a871-cbad39c9cb08]
+description = "Full house is not Four of a Kind"
+
+[b4743c82-1eb8-4a65-98f7-33ad126905cd]
+description = "Little Straight"
+
+[7ac08422-41bf-459c-8187-a38a12d080bc]
+description = "Little Straight as Big Straight"
+
+[97bde8f7-9058-43ea-9de7-0bc3ed6d3002]
+description = "Four in order but not a little straight"
+
+[cef35ff9-9c5e-4fd2-ae95-6e4af5e95a99]
+description = "No pairs but not a little straight"
+
+[fd785ad2-c060-4e45-81c6-ea2bbb781b9d]
+description = "Minimum is 1, maximum is 5, but not a little straight"
+
+[35bd74a6-5cf6-431a-97a3-4f713663f467]
+description = "Big Straight"
+
+[87c67e1e-3e87-4f3a-a9b1-62927822b250]
+description = "Big Straight as little straight"
+
+[c1fa0a3a-40ba-4153-a42d-32bc34d2521e]
+description = "No pairs but not a big straight"
+
+[207e7300-5d10-43e5-afdd-213e3ac8827d]
+description = "Choice"
+
+[b524c0cf-32d2-4b40-8fb3-be3500f3f135]
+description = "Yacht as choice"

exercises/practice/yacht/yacht-test.lisp

@@ -0,0 +1,78 @@
+;; Ensures that yacht.lisp and the testing library are always loaded
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (load "yacht")
+  (quicklisp-client:quickload :fiveam))
+
+;; Defines the testing package with symbols from yacht and FiveAM in scope
+;; The `run-tests` function is exported for use by both the user and test-runner
+(defpackage :yacht-test
+  (:use :cl :fiveam)
+  (:export :run-tests))
+
+;; Enter the testing package
+(in-package :yacht-test)
+
+;; Define and enter a new FiveAM test-suite
+(def-suite* yacht-suite)
+
+(test test-1 (is (equal 50 (yacht:score '(5 5 5 5 5) "yacht"))))
+
+(test test-2 (is (equal 0 (yacht:score '(1 3 3 2 5) "yacht"))))
+
+(test test-3 (is (equal 3 (yacht:score '(1 1 1 3 5) "ones"))))
+
+(test test-4 (is (equal 3 (yacht:score '(3 1 1 5 1) "ones"))))
+
+(test test-5 (is (equal 0 (yacht:score '(4 3 6 5 5) "ones"))))
+
+(test test-6 (is (equal 2 (yacht:score '(2 3 4 5 6) "twos"))))
+
+(test test-7 (is (equal 8 (yacht:score '(1 4 1 4 1) "fours"))))
+
+(test test-8 (is (equal 15 (yacht:score '(3 3 3 3 3) "threes"))))
+
+(test test-9 (is (equal 0 (yacht:score '(3 3 3 3 3) "fives"))))
+
+(test test-10 (is (equal 10 (yacht:score '(1 5 3 5 3) "fives"))))
+
+(test test-11 (is (equal 6 (yacht:score '(2 3 4 5 6) "sixes"))))
+
+(test test-12 (is (equal 16 (yacht:score '(2 2 4 4 4) "full house"))))
+
+(test test-13 (is (equal 19 (yacht:score '(5 3 3 5 3) "full house"))))
+
+(test test-14 (is (equal 0 (yacht:score '(2 2 4 4 5) "full house"))))
+
+(test test-15 (is (equal 0 (yacht:score '(1 4 4 4 4) "full house"))))
+
+(test test-16 (is (equal 0 (yacht:score '(2 2 2 2 2) "full house"))))
+
+(test test-17 (is (equal 24 (yacht:score '(6 6 4 6 6) "four of a kind"))))
+
+(test test-18 (is (equal 12 (yacht:score '(3 3 3 3 3) "four of a kind"))))
+
+(test test-19 (is (equal 0 (yacht:score '(3 3 3 5 5) "four of a kind"))))
+
+(test test-20 (is (equal 30 (yacht:score '(3 5 4 1 2) "little straight"))))
+
+(test test-21 (is (equal 0 (yacht:score '(1 2 3 4 5) "big straight"))))
+
+(test test-22 (is (equal 0 (yacht:score '(1 1 2 3 4) "little straight"))))
+
+(test test-23 (is (equal 0 (yacht:score '(1 2 3 4 6) "little straight"))))
+
+(test test-24 (is (equal 0 (yacht:score '(1 1 3 4 5) "little straight"))))
+
+(test test-25 (is (equal 30 (yacht:score '(4 6 2 5 3) "big straight"))))
+
+(test test-26 (is (equal 0 (yacht:score '(6 5 4 3 2) "little straight"))))
+
+(test test-27 (is (equal 0 (yacht:score '(6 5 4 3 1) "big straight"))))
+
+(test test-28 (is (equal 23 (yacht:score '(3 3 5 6 6) "choice"))))
+
+(test test-29 (is (equal 10 (yacht:score '(2 2 2 2 2) "choice"))))
+
+(defun run-tests (&optional (test-or-suite 'yacht-suite))
+  "Provides human readable results of test run. Default to entire suite."
+  (run! test-or-suite))

exercises/practice/yacht/yacht.lisp

@@ -0,0 +1,8 @@
+(defpackage :yacht
+  (:use :cl)
+  (:export :score))
+(in-package :yacht)
+
+(defun score (scores category)
+  "Returns the score of the dice for the given category."
+  )