Perl Weekly Challenge: Week 335
Challenge 1:
Common Characters
You are given an array of words.
Write a script to return all characters that is in every word in the given array including duplicates.
Example 1
Input: @words = ("bella", "label", "roller")
Output: ("e", "l", "l")
Example 2
Input: @words = ("cool", "lock", "cook")
Output: ("c", "o")
Example 3
Input: @words = ("hello", "world", "pole")
Output: ("l", "o")
Example 4
Input: @words = ("abc", "def", "ghi")
Output: ()
Example 5
Input: @words = ("aab", "aac", "aaa")
Output: ("a", "a")
I did not think it could be possible but Raku can solve this challenge in one line.
And even in this one line, a lot of the code is only for formatting the output in the style of the spec. The important
parts start in the middle with @*ARGS which contains the input words in the form of command-line arguments. We use
.map() to process each of these. First each argument is converted to a Seq with .comb() and then into a Bag with .Bag(). The keys of this Bag will be the unique letters in that word and the values the number of occurrences of that letter in the word. Then we use [∩] metaoperator to get the intersection of these Bags. The keys of the
resulting Set will be only the letters that occur in every word. Some of these letters may occur more than once
in every word (such as l in example 1 for instance.) We account for this with another .map(). This time we duplicate each letter (as I mentioned, a .key() in each Bag) with the number of times it occurs (the value() of that key) using the xx operator. The rest of the code is, as I said, for cosmetic purposes.
say q{(}, ([∩] @*ARGS.map({.comb.Bag})).map({ "\"{.key}\"" xx .value }).sort.join(q{, }),q{)}
Perl doesn't have an intersection operator. I had written a replacement subroutine before but it was not very good so I decided to rewrite it properly.
The subroutine below takes references to two arrays as its' parameters.
sub intersection($arr1, $arr2) {
A Hash is set up that will hold the elements that intersect between the two arrays as keys and the number of times
each element occurs as values.
my %count;
It is populated with the elements of the first array.
for my $elem (@$arr1) {
$count{$elem}++;
}
Now we create an empty array to hold the intersection.
my @result;
We then iterate over each element in the second array. For each element...
for my $elem (@$arr2) {
...we check if that element exists in %count with a non-zero value, which means it was present in the first array and hasn't already been added to the result the maximum number of times it appears in both arrays.
if ($count{$elem}) {
If so, we push the element into @result and decrement its count in %count to avoid adding duplicates beyond their occurrence in the first array.
push @result, $elem;
$count{$elem}--;
}
}
Finally, we return the @result array, which contains the intersection of the two input arrays, including duplicate elements if they appear multiple times in both arrays.
return @result;
}
Our intersection() subroutine still has one drawback over Raku's version; it only works on two arrays at a time.
We get around this by first removing the first word from @words with shift() and turning it into an array of individual letters with split().
my @letters = split //, shift @words;
This array is successively combined with each subsequent word and run through intersection() creating a
cumulative intersection of, eventually, all the words in the input.
for my $word (@words) {
@letters = intersection(\@letters, [split //, $word]);
}
This intersection is then printed out in the same style as in the spec.
say q{(}, (join q{, }, map { "\"$_\"" } sort @letters ), q{)};
Challenge 2:
Find Winner
You are given an array of all moves by the two players.
Write a script to find the winner of the
TicTacToe gameif found based on the moves provided in the given array.UPDATE: Order move is in the order - A, B, A, B, A, ….
Example 1
Input: @moves = ([0,0],[2,0],[1,1],[2,1],[2,2])
Output: A
Game Board:
[ A _ _ ]
[ B A B ]
[ _ _ A ]
Example 2
Input: @moves = ([0,0],[1,1],[0,1],[0,2],[1,0],[2,0])
Output: B
Game Board:
[ A A B ]
[ A B _ ]
[ B _ _ ]
Example 3
Input: @moves = ([0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2])
Output: Draw
Game Board:
[ A A B ]
[ B B A ]
[ A B A ]
Example 4
Input: @moves = ([0,0],[1,1])
Output: Pending
Game Board:
[ A _ _ ]
[ _ B _ ]
[ _ _ _ ]
Example 5
Input: @moves = ([1,1],[0,0],[2,2],[0,1],[1,0],[0,2])
Output: B
Game Board:
[ B B B ]
[ A A _ ]
[ _ _ A ]
I think my solution to this is quite ingenious if I do say so myself.
First we set up some variables to hold state.
$A and $B will hold the cumulative board positions for players A and B respectively.
my $A = 0;
my $B = 0;
The $result hold the current victory state of the game. It is initialized to pending to indicate a game
still in progress.
my $result = 'Pending';
The input is taken from the command-line arguments and stored in @moves. For example 1, it would look like this:
0,0 2,0 1,1 2,1 2,2. (Note there's a mistake in the picture that accompanies example 1. It makes no difference to the result though.)
using .kv() we get the index of each argument (stored in $turn) and it's value (stored in $square) $square is
again split() into $row and $column and these are converted from strings to integers.
for @moves.kv -> $turn, $square {
my ($row, $col) = $square.split(q{,})».Int;
If the $turn is an even number it is player A's turn.
if $turn %% 2 {
This is the ingenious bit. Each square of the board is assigned a unique number like this:
10 | 11 | 12
-----+------+------
100 | 101 | 102
-----+------+------
1000 | 1001 | 1002
This values can easily be calculated on the basis of $row and $col like this:
$A += 10 ** ($row + 1) + $col;
As you will have noticed this number is added to the value of $A.
The value of $A is used to determine if player A is the winner . If so, the $result is changed to A,
and we stop processing moves.
if isWinner($A) {
$result = 'A';
last;
}
}
isWinner() takes the value of a player ($A or $B) and compares it to a value equal to
the sum of the values of either a row column or diagonal. So we can quickly calculate a winning
situation without multiple comparisons. It will return True if a winning condition was matched or False
otherwise.
sub isWinner($player) {
return (33, 303, 3003, 1110, 1113, 1116).grep($player).so;
}
Back to MAIN(), if the value of $turn is odd, we follow the same procedure but for player B.
else {
$B += 10 ** ($row + 1) + $col;
if isWinner($B) {
$result = 'B';
last;
}
}
If we are on the 9th turn and neither side has won, it is a draw. We set the result appropriately and stop processing.
if $turn == 8 {
$result = 'Draw';
last;
}
}
Finally, we print $result.
say $result;
The Perl version is a close copy of Raku.
sub isWinner($player) {
return grep { $_ == $player } (33, 303, 3003, 1110, 1113, 1116);
}
my $A = 0;
my $B = 0;
my $result = 'Pending';
for my $turn (keys @moves) {
my ($row, $col) = split q{,}, $moves[$turn];
if ($turn % 2) {
$B += 10 ** ($row + 1) + $col;
if (isWinner($B)) {
$result = 'B';
last;
}
}
else {
$A += 10 ** ($row + 1) + $col;
if (isWinner($A)) {
$result = 'A';
last;
}
}
if ($turn == 8) {
$result = 'Draw';
last;
}
}
say $result;