Perl Weekly Challenge: Week 318
Challenge 1:
Group Position
You are given a string of lowercase letters.
Write a script to find the position of all groups in the given string. Three or more consecutive letters form a group. Return "” if none found.
Example 1
Input: $str = "abccccd"
Output: "cccc"
Example 2
Input: $str = "aaabcddddeefff"
Output: "aaa", "dddd", "fff"
Example 3
Input: $str = "abcdd"
Output: ""
This seemed like it would be a good candidate for using regular expressions but it turned out to be a little trickier than I expected. I still managed to get the solution down to onw line in Raku and two lines in Perl. Here is the Perl version first.
The regular expression has two parts; it matches a single character (.; to follow the spec precisely I should have used [a-z])
followed by two or more ({2,}) instances of the same character (\2.) Each of these parts is wrapped in parentheses to capture them as groups. The whole thing is wrapped in parentheses to capture both parts as one group. (That's why the backreference to part 1 is \2. From the outside in, it is the second capture group. The problem is that gave me, for example 1, ('cccc', 'c', 'ccc') which is not what we want. So I tried putting ?: in both the inner capture groups. That will surpress them for capturing while still allowing them to be used for grouping. The problem is that now backreferences don't work. You can leave the ?: in the second group which will give you ('cccc', 'c') which is better but still not the output we want. I'm sure Perl has a clever way around this but I didn't have the time or patience to figure it out so instead I used grep() to filter out the results that are only one character long. This is horribly kludgy but it works and @groups only contains the sequences of three or more consecutive letters.
my @groups = grep { length != 1 } ($str =~ /((.)(?:\2{2,}))/gmx);
The second line only formats the output in the same format as the spec or prints "" if no sequences were found.
say @groups ? (join q{, }, map { "\"$_\"" } @groups) : q{""};
I still find Raku regular expressions to be a bit weird but one good change it has made is in the way capture groups work. No need
for an extra grep() here.
say (@*ARGS[0].match(/ (.) $0 ** 2..* /, :g)).map({ "\"$_\"" }).join(", ") || q{""}
Challenge 2:
Reverse Equals
You are given two arrays of integers, each containing the same elements as the other.
Write a script to return true if one array can be made to equal the other by reversing exactly one contiguous subarray.
Example 1
Input: @source = (3, 2, 1, 4)
@target = (1, 2, 3, 4)
Output: true
Reverse elements: 0-2
Example 2
Input: @source = (1, 3, 4)
@target = (4, 1, 3)
Output: false
Example 3
Input: @source = (2)
@target = (2)
Output: true
First we get the input as two command-line arguments where each one is a string of integers separated by spaces. Each is
split back into an array with .words().
my @source = $str1.words;
my @target = $str2.words;
We also need a variable to store the result. By default it is going to be False.
my $result = False;
Using a double loop we determine the start and end index of each possible subarray in @source.
TOP: for 0 ..^ @source.elems -> $i {
for $i ..^ @source.elems -> $j {
We create a copy of @source we can alter.
my @temp = @source;
We find the current subarray in @temp ($i .. $j) and reverse it using .reverse() and put it back into @temp
using .splice().
@temp.splice($i, $j - $i + 1, @temp[$i..$j].reverse);
We .join() @temp and @target back into strings and compare them. If they are equal, $result is set to True and
we stop the loops.
if @temp.join eq @target.join {
$result = True;
last TOP;
}
}
}
Finally, we print the value of $result.
say $result;
The Perl version works the same as in Raku.
my @source = split /\s+/, shift;
my @target = split /\s+/, shift;
my $result = false;
TOP: for my $i (0 .. scalar @source - 1) {
for my $j ($i .. scalar @source - 1) {
my @temp = @source;
splice @temp, $i, $j - $i + 1, reverse @temp[$i..$j];
if ((join q{}, @temp) eq (join q{}, @target)) {
$result = true;
last TOP;
}
}
}
say $result ? 'true' : 'false';