Perl Weekly Challenge: Week 291
Challenge 1:
Middle Index
You are given an array of integers,
@ints.Write a script to find the leftmost middle index (MI) i.e. the smallest amongst all the possible ones.
A middle index is an index where ints[0] + ints[1] + … + ints[MI-1] == ints[MI+1] + ints[MI+2] + … + ints[ints.length-1].
If MI == 0, the left side sum is considered to be 0. Similarly,
if MI == ints.length - 1, the right side sum is considered to be 0.
Return the leftmost MI that satisfies the condition, or -1 if there is no such index.
Example 1
Input: @ints = (2, 3, -1, 8, 4)
Output: 3
The sum of the numbers before index 3 is: 2 + 3 + -1 = 4
The sum of the numbers after index 3 is: 4 = 4
Example 2
Input: @ints = (1, -1, 4)
Output: 2
The sum of the numbers before index 2 is: 1 + -1 = 0
The sum of the numbers after index 2 is: 0
Example 3
Input: @ints = (2, 5)
Output: -1
There is no valid MI.
This wasn't too difficult; the spec gives all the steps needed.
First, we set up a place to store the middle index. Its' initial value is -1.
my $mi = -1;
Then for each index of the @ints array (which we get from the command-line arguments...)
for @ints.keys -> $i {
...we assume it is the middle index. We take the sum all the elements before it (or 0 if this is the first index) and the sum of all the elements after it (or 0 if it is the last index) and compare the two values. If they are equal...
if (@ints[0 .. $i - 1].sum // 0) == (@ints[$i + 1 .. *].sum // 0) {
We make this index the official middle index and stop processing.
$mi = $i;
last;
}
Otherwise we continue on to the next index.
}
Finally we print the middle index whatever value it may have.
say $mi;
The Perl version is pretty much the same except we have to provide our own sum() function.
my $mi = -1;
for my $i (keys @ints) {
if ((sum(@ints[0 .. $i - 1]) // 0) == (sum(@ints[$i + 1 .. $#ints]) // 0)) {
$mi = $i;
last;
}
}
say $mi;
Challenge 2:
Poker Hands
A draw poker hand consists of 5 cards, drawn from a pack of 52: no jokers, no wild cards. An ace can rank either high or low.
Write a script to determine the following three things:
1. How many different 5-card hands can be dealt?
2. How many different hands of each of the 10 ranks can be dealt?
See here for descriptions of the 10 ranks of Poker hands:
https://en.wikipedia.org/wiki/List_of_poker_hands#Hand-ranking_categories
3. Check the ten numbers you get in step 2 by adding them together
and showing that they're equal to the number you get in step 1.
Question 1 is the easiest to amswer. Representing each card in the pack as a number from 1 to 52,
(1 .. 52).combinations(5).elems.say
gives us 2,598,860 as the number of possible 5-card hands.
Question 2 requires some more work. The easiest way would be to calculated the mathematical frequency of each tyoe of hand. In fact, the Wikipedia article mentioned in the spec has all the formulas laid out in tablular form. However I chose to do it the long way round by calculating every possible hand and classifying which type it is.
For this I first needed a representation of a playing card. A card has two features: One of 4 suits and a rank from ace to king. (An added complication from the spec is that an ace can sometimes be considered higher than a king in some type of hand as we shall see.) I chose to represent suits as a number from 1 to 4 and ranks as a number from 1 to 13. The class below models this:
class Card {
has Int $.suit;
has Int $.rank;
}
In real production code I would add some validation to make sure no one e.g. assigned -1 to suit or 17 to rank etc. but this is good enough for the current purpose.
Now in the MAIN() function we create an array of Card objects and fill it with 52 individual cards.
my Card @cards;
for (1 .. 4) -> $suit {
for (1 .. 13) -> $rank {
@cards.push(Card.new(suit => $suit, rank => $rank));
}
}
A hash is declared to store how many hands of each rank there are.
my %frequencies;
The complete list of hands is generated.
my @hands = @cards.combinations(5);
And their total number is stored for later use. This is 2,598,860 as mentioned before.
my $total = @hands.elems;
Now each hand is analyzed and classified according to its' type. The key in %frequencies for that
rank is incremented.
for @hands -> $hand {
%frequencies{classify(@$hand)}++;
}
Let's look at the classify() function in detail.
sub classify(@hand) {
We need to know two things about each hand; how many cards of each suit and how many cards of each rank there are. These two hashes store that information.
my %suitFreq;
my %rankFreq;
for @hand -> $card {
%suitFreq{$card.suit}++;
%rankFreq{$card.rank}++;
}
There are two main classes of poker hands. One determined merely by the quantity of cards and the other where other factors such as sequence matters.
An array of the number of cards with the same rank in ascending order is calculated. A switch (given/when) statement uses
it to classify the hand.
given %rankFreq.values.sort {
For example if a hand has 1 card of a particular rank (doesn't matter which one) and 4 cards of another rank, it is "Four of a Kind" and this is returned.
when [1, 4] { return 'fourofakind'; }
The same process is used to classify the following types of hand:
when [2, 3] { return 'fullhouse'; }
when [1, 1, 3] { return 'threeofakind'; }
when [1, 2, 2] { return 'twopair'; }
when [1, 1, 1, 2] { return 'pair'; }
Things get more complicated when all the cards differ in rank.
when [1, 1, 1, 1, 1] {
We are going to need to know several additional facts about the hand.
Whether all the cards are of the same suit.
my $sameSuit = %suitFreq.elems == 1;Whether the hand consists of an ace, 10, jack, queen and king. In this case the ace is considered to be a higher value than the king.
my @ranks = %rankFreq.keys.sort({ $^a <=> $^b }); my $aceHigh = @ranks ~~ [1, 10, 11, 12, 13];Whether the cards form a strictly ascending sequence. If the rank of the highest card minus the rank of the lowest card is 4 this will be true.
my $sequential = @ranks[4] - @ranks[0] == 4;
Now we classify the rest of the types based on these criteria.
if $sameSuit {
if $aceHigh {
return 'royalflush';
} elsif $sequential {
return 'straightflush';
} else {
return 'flush';
}
} else {
if $sequential || $aceHigh {
return 'straight';
} else {
return 'highcard';
}
}
}
It's always a good practice to include a default case in a switch though it is impossible to actually get here.
default { return q{}; }
}
}
Back to MAIN() all that remains is to print out the total...
say 'Total Possible Hands = ', $total;
...the frequncy of each hand type (question 2 from the spec...)
say 'Royal Flush = ', %frequencies<royalflush>;
say 'Straight Flush = ', %frequencies<straightflush>;
say 'Four of a Kind = ', %frequencies<fourofakind>;
say 'Full house = ', %frequencies<fullhouse>;
say 'Flush = ', %frequencies<flush>;
say 'Straight = ', %frequencies<straight>;
say 'Three of a Kind = ', %frequencies<threeofakind>;
say 'Two Pair = ', %frequencies<twopair>;
say 'Pair = ', %frequencies<pair>;
say 'High Card = ', %frequencies<highcard>;
...and lastly, to answer question 3, we compare the total number of hands to the sum of all frequencies.
say 'Does Total Possible Hands equal the sum of all rank frequencies? ', $total == %frequencies.values.sum;
For the Perl version, as we often do, we need to provide replacements for Raku features not in core Perl namely combinations() and sum(). I already had those from previous challenges.
For the Card class we can use an exciting new feature in recent versions of Perl. It
doesn't seem to be all there yet; notably support for automatic generation of accessors and mutators which is why I had to
explicitly add the suit() and rank() methods but it is a welcome development in any case.
class Card {
field $suit :param;
field $rank :param;
method suit() {
return $suit;
}
method rank() {
return $rank;
}
}
Because class support is still considered an experimental feature we have to add these lines to the top of the script to enable it.
use feature qw/ class /;
no warnings 'experimental::class';
The other big difference is that given/when support is now deprecated in Perl. In itself that's not a big deal as we can use a
series of ifs but smartmatching is also deprecated. So we need a function that compares two lists.
compare() takes references to two lists as parameters.
sub compare($listref1, $listref2) {
The first step is to see if the lists are the same length. If they are not, they are obviously not equivalent.
if (scalar @{$listref1} != scalar @{$listref1}) {
return false;
}
Next we compares the two lists element by element. If the elements are not equal, the lists are not equivalent.
for my $i (keys @{$listref1}) {
if ($listref1->[$i] != $listref2->[$i]) {
return false;
}
}
If both tests are passed the lists are equivalent.
return true;
}
You will note the function returns true or false. To enable support for this, we need to add these lines to
the top of the script:
use builtin qw/ true false /;
no warnings 'experimental::builtin';
The Perl version of classify() looks like this:
sub classify(@hand) {
my %suitFreq;
my %rankFreq;
for my $card (@hand) {
$suitFreq{$card->suit}++;
$rankFreq{$card->rank}++;
}
my @sorted = sort (values %rankFreq);
# say join q{, }, @sorted;
if (compare(\@sorted, [1, 4])) { return 'fourofakind'; }
if (compare(\@sorted, [2, 3])) { return 'fullhouse'; }
if (compare(\@sorted, [1, 1, 3])) { return 'threeofakind'; }
if (compare(\@sorted, [1, 2, 2])) { return 'twopair'; }
if (compare(\@sorted, [1, 1, 1, 2])) { return 'pair'; }
if (compare(\@sorted, [1, 1, 1, 1, 1])) {
my $sameSuit = scalar keys %suitFreq == 1;
my @ranks = sort { $a <=> $b } keys %rankFreq;
my $aceHigh = compare(\@ranks, [1, 10, 11, 12, 13]);
my $sequential = $ranks[4] - $ranks[0] == 4;
if ($sameSuit) {
if ($aceHigh) {
return 'royalflush';
} elsif ($sequential) {
return 'straightflush';
} else {
return 'flush';
}
} else {
if ($sequential || $aceHigh) {
return 'straight';
} else {
return 'highcard';
}
}
}
return q{};
}
And the main body of the script looks like this:
my Card @cards;
for my $suit (1 .. 4) {
for my $rank (1 .. 13) {
push @cards, Card->new(suit => $suit, rank => $rank);
}
}
my %frequencies;
my @hands = combinations(\@cards, 5);
my $total = scalar @hands;
for my $hand (@hands) {
$frequencies{classify(@{$hand})}++;
}
say 'Total Possible Hands = ', $total;
say 'Royal Flush = ', $frequencies{royalflush};
say 'Straight Flush = ', $frequencies{straightflush};
say 'Four of a Kind = ', $frequencies{fourofakind};
say 'Full house = ', $frequencies{fullhouse};
say 'Flush = ', $frequencies{flush};
say 'Straight = ', $frequencies{straight};
say 'Three of a Kind = ', $frequencies{threeofakind};
say 'Two Pair = ', $frequencies{twopair};
say 'Pair = ', $frequencies{pair};
say 'High Card = ', $frequencies{highcard};
say 'Does Total Possible Hands equal the sum of all rank frequencies? ', $total == sum(values %frequencies) ? 'True' : 'False';