Perl Weekly Challenge: Week 214
Challenge 1:
Rank Score
You are given a list of scores (>=1).
Write a script to rank each score in descending order. First three will get medals i.e. G (Gold), S (Silver) and B (Bronze). Rest will just get the ranking number.
Using the standard model of giving equal scores equal rank, then advancing that number of ranks.
Example 1
Input: @scores = (1,2,4,3,5)
Output: (5,4,S,B,G)
Score 1 is the 5th rank.
Score 2 is the 4th rank.
Score 4 is the 2nd rank i.e. Silver (S).
Score 3 is the 3rd rank i.e. Bronze (B).
Score 5 is the 1st rank i.e. Gold (G).
Example 2
Input: @scores = (8,5,6,7,4)
Output: (G,4,B,S,5)
Score 8 is the 1st rank i.e. Gold (G).
Score 4 is the 4th rank.
Score 6 is the 3rd rank i.e. Bronze (B).
Score 7 is the 2nd rank i.e. Silver (S).
Score 4 is the 5th rank.
Example 3
Input: @list = (3,5,4,2)
Output: (B,G,S,4)
Example 4
Input: @scores = (2,5,2,1,7,5,1)
Output: (4,S,4,6,G,S,6)
We start by making use of, as I did last week, the .classify() method in order to find
how frequently each element in @scores appears. We end up with %quantities, a hash where
the keys are scores and the values are every occurrence of that score in @scores.
@scores.classify( { $_ }, :into(my %quantities;) );
That's not exactly what we want though. For instance if the score 2 appeared 4 times in @scores, .classify()
would give us 2 => 2 2 2 2 whearas what we would like is 2 => 4. This line does that. There should be a
way to simply combine it into one with the line above but I don't know how.
%quantities = %quantities.keys.map({ $_ => %quantities{$_}.elems; });
Next we sort @scores so that the top score is first and the bottom score is at the end; this is stored as a
new array called @ordered.
my @ordered = @scores.sort({ $^b <=> $^a });
%ranks is a hash whose keys will be the ranks and the values the ordered scores that have that rank.
my %ranks;
The current rank (the top) will be 1.
my $currentRank = 1;
This is the part that challenged me the most. According to the spec, if more than one score shares the same rank
the next rank is not the next consecutive number but advanced by the number of scores that shared the previous rank. To determine how much to skip we have to keep track of how many scores are equal. We already have that data in %quantities we just need to apply to each ordered score.
my $quantity = 0;
We iterate through @ordered by index.
for 0 .. @ordered.end -> $i {
If the value of $quantity is 0 it means we have arrived at a new score. If so, $quantity is set to
the number of times that score occurs as recorded in %quantities.
if $quantity == 0 {
$quantity = %quantities{@ordered[$i]};
}
1 is subtracted from $quantity for the current element in @ordered.
$quantity--;
If the current rank is 1, 2, or 3, the value for this element in %ranks is set to 'G' for Gold, 'S' for
Silver, or 'B' for Bronze. In all other cases, the value is set to $currentRank.
given $currentRank {
when 1 { %ranks{@ordered[$i]} = 'G' };
when 2 { %ranks{@ordered[$i]} = 'S' };
when 3 { %ranks{@ordered[$i]} = 'B' };
default { %ranks{@ordered[$i]} = $currentRank; }
}
if the value of $quantity is 0, we have to increase $currentRank by the number of scores that shared
the current rank. I tried for sometime to combine this check with the other check for $quantity == 0 at
the top of the loop but could not do it without turning the code into spaghetti.
if $quantity == 0 {
$currentRank += %quantities{@ordered[$i]};
}
}
Once all the scores have been processed, we print out the ranks associated with each one in the format the spec suggests.
say q{(}, @scores.map({ %ranks{$_}; }).join(q{,}), q{)};
Here's the Perl version:
Perl doesn't have .classify() but it is easy enough to emulate.
my %quantities;
map { $quantities{$_}++ } @scores;
my @ordered = sort { $b <=> $a } @scores;
my %ranks;
my $currentRank = 1;
my $quantity = 0;
for my $i (0 .. scalar @ordered - 1) {
if ($quantity == 0) {
$quantity = $quantities{$ordered[$i]};
}
$quantity--;
After all this time given/when still causes a warning that the feature is experimental unless
you add use experimental qw/ switch /; to the top of the script.
given ($currentRank) {
when (1) { $ranks{$ordered[$i]} = 'G' };
when (2) { $ranks{$ordered[$i]} = 'S' };
when (3) { $ranks{$ordered[$i]} = 'B' };
default { $ranks{$ordered[$i]} = $currentRank; }
}
if ($quantity == 0) {
$currentRank += $quantities{$ordered[$i]};
}
}
say q{(}, ( join q{,}, map { $ranks{$_}; } @scores ), q{)};
Challenge 2:
Collect Points
You are given a list of numbers.
You will perform a series of removal operations. For each operation, you remove from the list N (one or more) equal and consecutive numbers, and add to your score N × N.
Determine the maximum possible score.
Example 1
Input: @numbers = (2,4,3,3,3,4,5,4,2)
Output: 23
We see three 3's next to each other so let us remove that first and collect 3 x 3 points.
So now the list is (2,4,4,5,4,2).
Let us now remove 5 so that all 4's can be next to each other and collect 1 x 1 point.
So now the list is (2,4,4,4,2).
Time to remove three 4's and collect 3 x 3 points.
Now the list is (2,2).
Finally remove both 2's and collect 2 x 2 points.
So the total points collected is 9 + 1 + 9 + 4 => 23.
Example 2
Input: @numbers = (1,2,2,2,2,1)
Output: 20
Remove four 2's first and collect 4 x 4 points.
Now the list is (1,1).
Finally remove the two 1's and collect 2 x 2 points.
So the total points collected is 16 + 4 => 20.
Example 3
Input: @numbers = (1)
Output: 1
Example 4
Input: @numbers = (2,2,2,1,1,2,2,2)
Output: 40
Remove two 1's = 2 x 2 points.
Now the list is (2,2,2,2,2,2).
Then reomove six 2's = 6 x 6 points.
The MAIN() subroutine in Raku just looks like this:
say findHighest(@numbers);
Of course findHighest() is not quite so simple.
sub findHighest(*@numbers) {
We set up a variable to store the highest score.
my $highestScore = 0;
Then we traverse through @numbers by index.
for 0 .. @numbers.end -> $i {
Each time, we remove a consecutive run of numbers starting from index $i.
my $results = removeConsecutive($i, @numbers);
This is removeConsecutive().
sub removeConsecutive($i, *@numbers) {
The number we are looking for a run of is @numbers[$i]. We store it in the variable $current.
my $current = @numbers[$i];
The length of the run (if there is one) will be stored in $quantity.
my $quantity = 0;
Then from $i to the end of the list (I could have used .end() here; I don't remember why I didn't.)
for $i ..^ @numbers.elems -> $n {
If the number is not the same as current we have reached the end of the run so we can break out of the loop. if @numbers[$n] != $current { last;
If not, $quantity is increased by 1.
} else {
$quantity++;
}
}
Whatever length run of same numbers we found is removed from @numbers.
@numbers.splice($i, $quantity);
The score for this run is $quantity squared. That and the new, possibly shorter @numbers
is returned as a Pair. Why not a list as in the Perl version (see below)? For some reason I was not able
to get it to work properly. @numbers was getting corrupted and I didn't understand why. This on the other
hand works.
return $quantity * $quantity => @numbers;
}
I feel I could possibly have made this function simpler but I lacked the time to investigate further.
Back to findHighest()...
The return value from removeConsecutive() is $results which, as I mentioned previously, is a Pair.
So here we assign the two parts to variables.
my $points = $results.key;
my @newNumbers = $results.value;
$points is added to the return value of a recursive call to findHighest(). When it is finished
recursing all the way, we will have the total score for this permutation of @numbers.
my $score = $points + findHighest(@newNumbers);
if the score is greater than the current highest score, it becomes the new highest score.
if ($score > $highestScore) {
$highestScore = $score;
}
}
When processing of all permutations of @numbers is finished, we return the highest score.
return $highestScore;
}
This is the Perl version of the findHighest() and removeConsecutive() functions.
sub findHighest {
my @numbers = @_;
my $highestScore = 0;
for my $i (0 .. scalar @numbers - 1) {
my ($points, @rest) = removeConsecutive($i, @numbers);
my $score = $points + findHighest(@rest);
if ($score > $highestScore) {
$highestScore = $score;
}
}
return $highestScore;
}
sub removeConsecutive {
my $i = shift;
my @numbers = @_;
my $current = $numbers[$i];
my $quantity = 0;
for my $n ($i .. scalar @numbers - 1) {
if ($numbers[$n] != $current) {
last;
} else {
$quantity++;
}
}
splice @numbers, $i, $quantity;
removeConsecutive() returns multiple values as a list as it should.
return ($quantity * $quantity, @numbers);
}