Skip to content

Commit

Permalink
Add yacht exercise (#691)
Browse files Browse the repository at this point in the history
* Add yacht exercise
* add a companion module of constants, an enum-ish collection of categories
* yacht solutions uses Readonly
---------

Co-authored-by: Daniel Mita <[email protected]>
  • Loading branch information
glennj and m-dango authored Dec 26, 2024
1 parent d3f2392 commit 5964ce3
Show file tree
Hide file tree
Showing 13 changed files with 531 additions and 1 deletion.
2 changes: 1 addition & 1 deletion .github/workflows/exercises.yml
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ jobs:
perl-version: ${{ matrix.perl }}
distribution: ${{ matrix.distribution }}

- run: cpm install -g Test2::V0 UUID Feature::Compat::Class
- run: cpm install -g Test2::V0 UUID Feature::Compat::Class Readonly

- name: Test with prove
run: prove exercises/practice/*/.meta/solutions/ --recurse --jobs 2
Expand Down
8 changes: 8 additions & 0 deletions config.json
Original file line number Diff line number Diff line change
Expand Up @@ -842,6 +842,14 @@
"prerequisites": [],
"difficulty": 1
},
{
"slug": "yacht",
"name": "Yacht",
"uuid": "253f49a3-44f6-42e8-bd79-f2fa7f70a29a",
"practices": [],
"prerequisites": [],
"difficulty": 4
},
{
"slug": "bottle-song",
"name": "Bottle Song",
Expand Down
30 changes: 30 additions & 0 deletions exercises/practice/yacht/.docs/instructions.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
# Instructions

Given five dice and a category, calculate the score of the dice for that category.

~~~~exercism/note
You'll always be presented with five dice.
Each dice's value will be between one and six inclusively.
The dice may be unordered.
~~~~

## 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.
11 changes: 11 additions & 0 deletions exercises/practice/yacht/.docs/introduction.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
# Introduction

Each year, something new is "all the rage" in your high school.
This year it is a dice game: [Yacht][yacht].

The game of Yacht is from the same family as Poker Dice, Generala and particularly Yahtzee, of which it is a precursor.
The game consists of twelve rounds.
In each, five dice are rolled and the player chooses one of twelve categories.
The chosen category is then used to score the throw of the dice.

[yacht]: https://en.wikipedia.org/wiki/Yacht_(dice_game)
25 changes: 25 additions & 0 deletions exercises/practice/yacht/.meta/config.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
{
"authors": [
"glennj"
],
"contributors": [
"m-dango"
],
"files": {
"solution": [
"lib/Yacht.pm"
],
"test": [
"t/yacht.t"
],
"example": [
".meta/solutions/lib/Yacht.pm"
],
"editor": [
"lib/Yacht/Category.pm"
]
},
"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)"
}
56 changes: 56 additions & 0 deletions exercises/practice/yacht/.meta/solutions/lib/Yacht.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,56 @@
package Yacht;

use strict;
use warnings;
use experimental qw<signatures postderef postderef_qq>;

use Exporter qw<import>;
our @EXPORT_OK = qw<score>;

use List::Util qw(uniq sum all);
use Yacht::Category;

my $dispatch = {
$Yacht::Category::YACHT => sub { scalar( uniq @_ ) == 1 ? 50 : 0; },
$Yacht::Category::CHOICE => sub { sum @_; },
$Yacht::Category::ONES => sub { single( 1, @_ ); },
$Yacht::Category::TWOS => sub { single( 2, @_ ); },
$Yacht::Category::THREES => sub { single( 3, @_ ); },
$Yacht::Category::FOURS => sub { single( 4, @_ ); },
$Yacht::Category::FIVES => sub { single( 5, @_ ); },
$Yacht::Category::SIXES => sub { single( 6, @_ ); },
$Yacht::Category::FULL_HOUSE => sub { full_house(@_); },
$Yacht::Category::FOUR_OF_A_KIND => sub { four_kind(@_); },
$Yacht::Category::LITTLE_STRAIGHT => sub { straight( [ 1 .. 5 ], @_ ); },
$Yacht::Category::BIG_STRAIGHT => sub { straight( [ 2 .. 6 ], @_ ); },
};

sub score ( $dice, $category ) {
return $dispatch->{$category}->( $dice->@* );
}

sub single ( $die, @dice ) {
return $die * grep { $_ == $die } @dice;
}

sub full_house(@dice) {
my @s = sort { $a <=> $b } @dice;
return $s[0] != $s[4] && (
( $s[0] == $s[1] && $s[2] == $s[4] ) ||
( $s[0] == $s[2] && $s[3] == $s[4] )
)
? sum(@dice)
: 0;
}

sub four_kind(@dice) {
my @s = sort { $a <=> $b } @dice;
return ( $s[0] == $s[3] || $s[1] == $s[4] ) ? 4 * $s[2] : 0;
}

sub straight( $wanted, @dice ) {
my @sorted = sort { $a <=> $b } @dice;
return ( all { $sorted[$_] == $wanted->[$_] } 0 .. 4 ) ? 30 : 0;
}

1;
1 change: 1 addition & 0 deletions exercises/practice/yacht/.meta/solutions/t/yacht.t
82 changes: 82 additions & 0 deletions exercises/practice/yacht/.meta/template-data.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,82 @@
subs: score
modules:
- use: Yacht::Category
properties:
score:
test: |-
use Data::Dmp;
my %categories = (
yacht => '$Yacht::Category::YACHT',
choice => '$Yacht::Category::CHOICE',
ones => '$Yacht::Category::ONES',
twos => '$Yacht::Category::TWOS',
threes => '$Yacht::Category::THREES',
fours => '$Yacht::Category::FOURS',
fives => '$Yacht::Category::FIVES',
sixes => '$Yacht::Category::SIXES',
'full house' => '$Yacht::Category::FULL_HOUSE',
'four of a kind' => '$Yacht::Category::FOUR_OF_A_KIND',
'little straight' => '$Yacht::Category::LITTLE_STRAIGHT',
'big straight' => '$Yacht::Category::BIG_STRAIGHT',
);
sprintf(<<'END', dmp($case->{input}{dice}), $categories{$case->{input}{category}}, $case->{expected}, dmp($case->{description}));
is(
score(%s, %s),
%s,
%s,
);
END
stub: |-
use Yacht::Category;
sub score ($dice, $category) {
return undef;
}
example: |-
use List::Util qw(uniq sum all);
use Yacht::Category;
my $dispatch = {
$Yacht::Category::YACHT => sub { scalar( uniq @_ ) == 1 ? 50 : 0; },
$Yacht::Category::CHOICE => sub { sum @_; },
$Yacht::Category::ONES => sub { single( 1, @_ ); },
$Yacht::Category::TWOS => sub { single( 2, @_ ); },
$Yacht::Category::THREES => sub { single( 3, @_ ); },
$Yacht::Category::FOURS => sub { single( 4, @_ ); },
$Yacht::Category::FIVES => sub { single( 5, @_ ); },
$Yacht::Category::SIXES => sub { single( 6, @_ ); },
$Yacht::Category::FULL_HOUSE => sub { full_house(@_); },
$Yacht::Category::FOUR_OF_A_KIND => sub { four_kind(@_); },
$Yacht::Category::LITTLE_STRAIGHT => sub { straight( [ 1 .. 5 ], @_ ); },
$Yacht::Category::BIG_STRAIGHT => sub { straight( [ 2 .. 6 ], @_ ); },
};
sub score ( $dice, $category ) {
return $dispatch->{$category}->($dice->@*);
}
sub single ( $die, @dice ) {
return $die * grep { $_ == $die } @dice;
}
sub full_house(@dice) {
my @s = sort { $a <=> $b } @dice;
return $s[0] != $s[4] && (
( $s[0] == $s[1] && $s[2] == $s[4] ) ||
( $s[0] == $s[2] && $s[3] == $s[4] )
)
? sum(@dice)
: 0;
}
sub four_kind(@dice) {
my @s = sort { $a <=> $b } @dice;
return ( $s[0] == $s[3] || $s[1] == $s[4] ) ? 4 * $s[2] : 0;
}
sub straight( $wanted, @dice ) {
my @sorted = sort { $a <=> $b } @dice;
return ( all { $sorted[$_] == $wanted->[$_] } 0 .. 4 ) ? 30 : 0;
}
97 changes: 97 additions & 0 deletions exercises/practice/yacht/.meta/tests.toml
Original file line number Diff line number Diff line change
@@ -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"
14 changes: 14 additions & 0 deletions exercises/practice/yacht/lib/Yacht.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
package Yacht;

use v5.40;

use Exporter qw<import>;
our @EXPORT_OK = qw<score>;

use Yacht::Category;

sub score ( $dice, $category ) {
return undef;
}

1;
21 changes: 21 additions & 0 deletions exercises/practice/yacht/lib/Yacht/Category.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
package Yacht::Category;

use strict;
use warnings;
use Readonly;

my $n = 1;
Readonly our $ONES => $n++;
Readonly our $TWOS => $n++;
Readonly our $THREES => $n++;
Readonly our $FOURS => $n++;
Readonly our $FIVES => $n++;
Readonly our $SIXES => $n++;
Readonly our $FULL_HOUSE => $n++;
Readonly our $FOUR_OF_A_KIND => $n++;
Readonly our $LITTLE_STRAIGHT => $n++;
Readonly our $BIG_STRAIGHT => $n++;
Readonly our $YACHT => $n++;
Readonly our $CHOICE => $n++;

1;
Loading

0 comments on commit 5964ce3

Please sign in to comment.