diff --git a/config.json b/config.json index d0831b0..9859742 100644 --- a/config.json +++ b/config.json @@ -463,6 +463,15 @@ "difficulty": 4, "topics": [] }, + { + "slug": "yacht", + "name": "Yacht", + "uuid": "c4a24f88-febd-4955-a08d-67895a3d119f", + "practices": [], + "prerequisites": [], + "difficulty": 4, + "topics": [] + }, { "slug": "triangle", "name": "Triangle", diff --git a/exercises/practice/yacht/.docs/instructions.md b/exercises/practice/yacht/.docs/instructions.md new file mode 100644 index 0000000..54fdb45 --- /dev/null +++ b/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) diff --git a/exercises/practice/yacht/.meta/config.json b/exercises/practice/yacht/.meta/config.json new file mode 100644 index 0000000..f0b423d --- /dev/null +++ b/exercises/practice/yacht/.meta/config.json @@ -0,0 +1,19 @@ +{ + "authors": [ + "keiravillekode" + ], + "files": { + "solution": [ + "yacht.sml" + ], + "test": [ + "test.sml" + ], + "example": [ + ".meta/example.sml" + ] + }, + "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)" +} diff --git a/exercises/practice/yacht/.meta/example.sml b/exercises/practice/yacht/.meta/example.sml new file mode 100644 index 0000000..f964ca8 --- /dev/null +++ b/exercises/practice/yacht/.meta/example.sml @@ -0,0 +1,110 @@ +datatype category = + Ones + | Twos + | Threes + | Fours + | Fives + | Sixes + | FullHouse + | FourOfAKind + | LittleStraight + | BigStraight + | Choice + | Yacht + +local + fun insert (value: int) (l: int list) = + case l of + nil => value :: nil + | first :: rest => + if value <= first then value :: l + else first :: (insert value rest) + + fun sort (dice: int list): int list = + case dice of + nil => nil + | first :: rest => insert first (sort rest) + + fun total (dice: int list): int = + let + fun recurse (acc: int) (dice: int list): int = + case dice of + nil => acc + | first :: rest => recurse (acc + first) rest + in + recurse 0 dice + end + + fun numbers (number: int) (dice: int list): int = + let + fun recurse (acc: int) (dice: int list): int = + case dice of + nil => acc + | first :: rest => + if first = number then recurse (acc + number) rest + else recurse acc rest + in + recurse 0 dice + end + + fun ones (dice: int list): int = + numbers 1 dice + + fun twos (dice: int list): int = + numbers 2 dice + + fun threes (dice: int list): int = + numbers 3 dice + + fun fours (dice: int list): int = + numbers 4 dice + + fun fives (dice: int list): int = + numbers 5 dice + + fun sixes (dice: int list): int = + numbers 6 dice + + fun fullHouse (dice: int list): int = + if List.nth (dice, 0) = List.nth (dice, 4) then 0 + else if List.nth (dice, 0) = List.nth (dice, 2) andalso List.nth (dice, 3) = List.nth (dice, 4) then total dice + else if List.nth (dice, 0) = List.nth (dice, 1) andalso List.nth (dice, 2) = List.nth (dice, 4) then total dice + else 0 + + fun fourOfAKind (dice: int list): int = + if List.nth (dice, 0) = List.nth (dice, 3) orelse List.nth (dice, 1) = List.nth (dice, 4) then 4 * List.nth (dice, 2) + else 0 + + fun littleStraight (dice: int list): int = + if dice = [1, 2, 3, 4, 5] then 30 + else 0 + + fun bigStraight (dice: int list): int = + if dice = [2, 3, 4, 5, 6] then 30 + else 0 + + fun choice (dice: int list): int = + total dice + + fun yacht (dice: int list): int = + if List.nth (dice, 0) = List.nth (dice, 4) then 50 + else 0 + + fun score' (dice: int list, category): int = + case category of + Ones => ones dice + | Twos => twos dice + | Threes => threes dice + | Fours => fours dice + | Fives => fives dice + | Sixes => sixes dice + | FullHouse => fullHouse dice + | FourOfAKind => fourOfAKind dice + | LittleStraight => littleStraight dice + | BigStraight => bigStraight dice + | Choice => choice dice + | Yacht => yacht dice +in + fun score (dice: int list, category): int = + score' (sort dice, category) +end diff --git a/exercises/practice/yacht/.meta/tests.toml b/exercises/practice/yacht/.meta/tests.toml new file mode 100644 index 0000000..b9d9203 --- /dev/null +++ b/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" diff --git a/exercises/practice/yacht/test.sml b/exercises/practice/yacht/test.sml new file mode 100644 index 0000000..d3175ee --- /dev/null +++ b/exercises/practice/yacht/test.sml @@ -0,0 +1,99 @@ +(* version 1.0.0 *) + +use "testlib.sml"; +use "yacht.sml"; + +infixr |> +fun x |> f = f x + +val testsuite = + describe "yacht" [ + test "Yacht" + (fn _ => score ([5, 5, 5, 5, 5], Yacht) |> Expect.equalTo 50), + + test "Not Yacht" + (fn _ => score ([1, 3, 3, 2, 5], Yacht) |> Expect.equalTo 0), + + test "Ones" + (fn _ => score ([1, 1, 1, 3, 5], Ones) |> Expect.equalTo 3), + + test "Ones, out of order" + (fn _ => score ([3, 1, 1, 5, 1], Ones) |> Expect.equalTo 3), + + test "No ones" + (fn _ => score ([4, 3, 6, 5, 5], Ones) |> Expect.equalTo 0), + + test "Twos" + (fn _ => score ([2, 3, 4, 5, 6], Twos) |> Expect.equalTo 2), + + test "Fours" + (fn _ => score ([1, 4, 1, 4, 1], Fours) |> Expect.equalTo 8), + + test "Yacht counted as threes" + (fn _ => score ([3, 3, 3, 3, 3], Threes) |> Expect.equalTo 15), + + test "Yacht of 3s counted as fives" + (fn _ => score ([3, 3, 3, 3, 3], Fives) |> Expect.equalTo 0), + + test "Fives" + (fn _ => score ([1, 5, 3, 5, 3], Fives) |> Expect.equalTo 10), + + test "Sixes" + (fn _ => score ([2, 3, 4, 5, 6], Sixes) |> Expect.equalTo 6), + + test "Full house two small, three big" + (fn _ => score ([2, 2, 4, 4, 4], FullHouse) |> Expect.equalTo 16), + + test "Full house three small, two big" + (fn _ => score ([5, 3, 3, 5, 3], FullHouse) |> Expect.equalTo 19), + + test "Two pair is not a full house" + (fn _ => score ([2, 2, 4, 4, 5], FullHouse) |> Expect.equalTo 0), + + test "Four of a kind is not a full house" + (fn _ => score ([1, 4, 4, 4, 4], FullHouse) |> Expect.equalTo 0), + + test "Yacht is not a full house" + (fn _ => score ([2, 2, 2, 2, 2], FullHouse) |> Expect.equalTo 0), + + test "Four of a Kind" + (fn _ => score ([6, 6, 4, 6, 6], FourOfAKind) |> Expect.equalTo 24), + + test "Yacht can be scored as Four of a Kind" + (fn _ => score ([3, 3, 3, 3, 3], FourOfAKind) |> Expect.equalTo 12), + + test "Full house is not Four of a Kind" + (fn _ => score ([3, 3, 3, 5, 5], FourOfAKind) |> Expect.equalTo 0), + + test "Little Straight" + (fn _ => score ([3, 5, 4, 1, 2], LittleStraight) |> Expect.equalTo 30), + + test "Little Straight as Big Straight" + (fn _ => score ([1, 2, 3, 4, 5], BigStraight) |> Expect.equalTo 0), + + test "Four in order but not a little straight" + (fn _ => score ([1, 1, 2, 3, 4], LittleStraight) |> Expect.equalTo 0), + + test "No pairs but not a little straight" + (fn _ => score ([1, 2, 3, 4, 6], LittleStraight) |> Expect.equalTo 0), + + test "Minimum is 1, maximum is 5, but not a little straight" + (fn _ => score ([1, 1, 3, 4, 5], LittleStraight) |> Expect.equalTo 0), + + test "Big Straight" + (fn _ => score ([4, 6, 2, 5, 3], BigStraight) |> Expect.equalTo 30), + + test "Big Straight as little straight" + (fn _ => score ([6, 5, 4, 3, 2], LittleStraight) |> Expect.equalTo 0), + + test "No pairs but not a big straight" + (fn _ => score ([6, 5, 4, 3, 1], BigStraight) |> Expect.equalTo 0), + + test "Choice" + (fn _ => score ([3, 3, 5, 6, 6], Choice) |> Expect.equalTo 23), + + test "Yacht as choice" + (fn _ => score ([2, 2, 2, 2, 2], Choice) |> Expect.equalTo 10) + ] + +val _ = Test.run testsuite diff --git a/exercises/practice/yacht/testlib.sml b/exercises/practice/yacht/testlib.sml new file mode 100644 index 0000000..0c8370c --- /dev/null +++ b/exercises/practice/yacht/testlib.sml @@ -0,0 +1,160 @@ +structure Expect = +struct + datatype expectation = Pass | Fail of string * string + + local + fun failEq b a = + Fail ("Expected: " ^ b, "Got: " ^ a) + + fun failExn b a = + Fail ("Expected: " ^ b, "Raised: " ^ a) + + fun exnName (e: exn): string = General.exnName e + in + fun truthy a = + if a + then Pass + else failEq "true" "false" + + fun falsy a = + if a + then failEq "false" "true" + else Pass + + fun equalTo b a = + if a = b + then Pass + else failEq (PolyML.makestring b) (PolyML.makestring a) + + fun nearTo delta b a = + if Real.abs (a - b) <= delta * Real.abs a orelse + Real.abs (a - b) <= delta * Real.abs b + then Pass + else failEq (Real.toString b ^ " +/- " ^ Real.toString delta) (Real.toString a) + + fun anyError f = + ( + f (); + failExn "an exception" "Nothing" + ) handle _ => Pass + + fun error e f = + ( + f (); + failExn (exnName e) "Nothing" + ) handle e' => if exnMessage e' = exnMessage e + then Pass + else failExn (exnMessage e) (exnMessage e') + end +end + +structure TermColor = +struct + datatype color = Red | Green | Yellow | Normal + + fun f Red = "\027[31m" + | f Green = "\027[32m" + | f Yellow = "\027[33m" + | f Normal = "\027[0m" + + fun colorize color s = (f color) ^ s ^ (f Normal) + + val redit = colorize Red + + val greenit = colorize Green + + val yellowit = colorize Yellow +end + +structure Test = +struct + datatype testnode = TestGroup of string * testnode list + | Test of string * (unit -> Expect.expectation) + + local + datatype evaluation = Success of string + | Failure of string * string * string + | Error of string * string + + fun indent n s = (implode (List.tabulate (n, fn _ => #" "))) ^ s + + fun fmt indentlvl ev = + let + val check = TermColor.greenit "\226\156\148 " (* ✔ *) + val cross = TermColor.redit "\226\156\150 " (* ✖ *) + val indentlvl = indentlvl * 2 + in + case ev of + Success descr => indent indentlvl (check ^ descr) + | Failure (descr, exp, got) => + String.concatWith "\n" [indent indentlvl (cross ^ descr), + indent (indentlvl + 2) exp, + indent (indentlvl + 2) got] + | Error (descr, reason) => + String.concatWith "\n" [indent indentlvl (cross ^ descr), + indent (indentlvl + 2) (TermColor.redit reason)] + end + + fun eval (TestGroup _) = raise Fail "Only a 'Test' can be evaluated" + | eval (Test (descr, thunk)) = + ( + case thunk () of + Expect.Pass => ((1, 0, 0), Success descr) + | Expect.Fail (s, s') => ((0, 1, 0), Failure (descr, s, s')) + ) + handle e => ((0, 0, 1), Error (descr, "Unexpected error: " ^ exnMessage e)) + + fun flatten depth testnode = + let + fun sum (x, y, z) (a, b, c) = (x + a, y + b, z + c) + + fun aux (t, (counter, acc)) = + let + val (counter', texts) = flatten (depth + 1) t + in + (sum counter' counter, texts :: acc) + end + in + case testnode of + TestGroup (descr, ts) => + let + val (counter, texts) = foldr aux ((0, 0, 0), []) ts + in + (counter, (indent (depth * 2) descr) :: List.concat texts) + end + | Test _ => + let + val (counter, evaluation) = eval testnode + in + (counter, [fmt depth evaluation]) + end + end + + fun println s = print (s ^ "\n") + in + fun run suite = + let + val ((succeeded, failed, errored), texts) = flatten 0 suite + + val summary = String.concatWith ", " [ + TermColor.greenit ((Int.toString succeeded) ^ " passed"), + TermColor.redit ((Int.toString failed) ^ " failed"), + TermColor.redit ((Int.toString errored) ^ " errored"), + (Int.toString (succeeded + failed + errored)) ^ " total" + ] + + val status = if failed = 0 andalso errored = 0 + then OS.Process.success + else OS.Process.failure + + in + List.app println texts; + println ""; + println ("Tests: " ^ summary); + OS.Process.exit status + end + end +end + +fun describe description tests = Test.TestGroup (description, tests) +fun test description thunk = Test.Test (description, thunk) diff --git a/exercises/practice/yacht/yacht.sml b/exercises/practice/yacht/yacht.sml new file mode 100644 index 0000000..8d6abb0 --- /dev/null +++ b/exercises/practice/yacht/yacht.sml @@ -0,0 +1,16 @@ +datatype category = + Ones + | Twos + | Threes + | Fours + | Fives + | Sixes + | FullHouse + | FourOfAKind + | LittleStraight + | BigStraight + | Choice + | Yacht + +fun score (dice: int list, category): int = + raise Fail "'score' is not implemented"