Perl Weekly Challenge: Week 215
Challenge 1:
Odd One Out
You are given a list of words (alphabetic characters only) of same size.
Write a script to remove all words not sorted alphabetically and print the number of words in the list that are not alphabetically sorted.
Example 1
Input: @words = ('abc', 'xyz', 'tsu')
Output: 1
The words 'abc' and 'xyz' are sorted and can't be removed.
The word 'tsu' is not sorted and hence can be removed.
Example 2
Input: @words = ('rat', 'cab', 'dad')
Output: 3
None of the words in the given list are sorted.
Therefore all three needs to be removed.
Example 3
Input: @words = ('x', 'y', 'z')
Output: 0
This challenge got a lot less confusing when I realized that by "all words not sorted alphabetically" what it means "each word not internally sorted alphabetically." With this realization, the solution became straitforward.
We need to record the number of words removed. The spec doesn't ask for the words themselves.
my $removals = 0;
Then for each word...
for @words -> $word {
...we create an alphabetically sorted version by splitting it into characters with .comb(),
sorting that array with .sort() and joining it back together again with .join().
my $sorted = $word.comb.sort.join;
Then the word is compared to its sorted version. If they are not the same, the word is unsorted
and one is added to $removals.
if $word ne $sorted {
$removals++;
}
}
Finally, we print the number of removals.
say $removals;
This is the Perl version.
my $removals = 0;
for my $word (@words) {
The only real stumbling block I faced was having to put parentheses around sort and split in this line.
my $sorted = join q{}, (sort (split //, $word));
if ($word ne $sorted) {
$removals++;
}
}
say $removals;
Challenge 2:
Number Placement
You are given a list of numbers having just 0 and 1. You are also given placement count (>=1).
Write a script to find out if it is possible to replace 0 with 1 in the given list. The only condition is that you can only replace when there is no 1 on either side. Print 1 if it is possible otherwise 0.
Example 1
Input: @numbers = (1,0,0,0,1), $count = 1
Output: 1
You are asked to replace only one 0 as given count is 1.
We can easily replace middle 0 in the list i.e. (1,0,1,0,1).
Example 2
Input: @numbers = (1,0,0,0,1), $count = 2
Output: 0
You are asked to replace two 0's as given count is 2.
It is impossible to replace two 0's.
Example 3
Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3
Output: 1
We get the count and the list of numbers from the command-line arguments.
my ($count, @numbers) = @ARGS;
A variable is created to hold the number of replacements.
my $replaced = 0;
We iterate through @numbers by index.
for 0 .. @numbers.end -> $i {
If the value of the current element is 0 and the values of the elements on either
sides are also 0, we can change it to a 1 and increment $replaced. It later
occurred to me that if this is the first or last element, there will not be a neighboring
element on the left or right side respectively and we can consider that side to be "not a 1"
so I adjusted the code accordingly.
if
@numbers[$i] == 0 &&
($i == 0 || @numbers[$i - 1] == 0) &&
($i == @numbers.end || @numbers[$i + 1] == 0)
{
@numbers[$i] = 1;
$replaced++;
}
If we have made the number of replacements we were supposed to, we can print 1 and leave the script.
if $replaced == $count {
say 1;
exit;
}
}
If we have gotten up to here it means we have not made the number of replacements we were supposed to so we print 0.
say 0;
This is the Perl version.
my ($count, @numbers) = @ARGV;
my $replaced = 0;
if (
$numbers[$i] == 0 &&
($i == 0 || $numbers[$i - 1] == 0) &&
($i == scalar @numbers - 1 || $numbers[$i + 1] == 0)
) {
$numbers[$i] = 1;
$replaced++;
}
if ($replaced == $count) {
say 1;
exit;
}
say 0;