Perl Weekly Challenge: Week 321
Challenge 1:
Distinct Average
You are given an array of numbers with even length.
Write a script to return the count of distinct average. The average is calculate by removing the minimum and the maximum, then average of the two.
Example 1
Input: @nums = (1, 2, 4, 3, 5, 6)
Output: 1
Step 1: Min = 1, Max = 6, Avg = 3.5
Step 2: Min = 2, Max = 5, Avg = 3.5
Step 3: Min = 3, Max = 4, Avg = 3.5
The count of distinct average is 1.
Example 2
nput: @nums = (0, 2, 4, 8, 3, 5)
Output: 2
Step 1: Min = 0, Max = 8, Avg = 4
Step 2: Min = 2, Max = 5, Avg = 3.5
Step 3: Min = 3, Max = 4, Avg = 3.5
The count of distinct average is 2.
Example 3
Input: @nums = (7, 3, 1, 0, 5, 9)
Output: 2
Step 1: Min = 0, Max = 9, Avg = 4.5
Step 2: Min = 1, Max = 7, Avg = 4
Step 3: Min = 3, Max = 5, Avg = 4
The count of distinct average is 2.
Although I suspect that there is a solution that doesn't require it, it is going to simplify things a lot if we start by sorting the input numerically. As function parameters in Raku are mutable, we copy them to a new array in the process.
my @nums = @args.sort({ $^a <=> $^b });
To store the distinct averages we use a Hash. The keys will be averages and the values the number of times each occurs.
my %distinct;
While we have numbers...
while @nums.elems {
...we take the first (index 0) and last (index *-1) numbers and average them. The value of the key for that average
in %distinct is incremented
%distinct{(@nums[0] + @nums[*-1]) / 2}++;
And with an array slice we reduce @nums to the inner elements.
@nums = @nums[1 .. *-2];
}
After we have processed all the numbers, we count how keys there are in %distinct with .keys() and .elems() and print the result with .say().
%distinct.keys.elems.say;
The Perl version works in the same way.
my @nums = sort { $a <=> $b } @ARGV;
my %distinct;
while (scalar @nums) {
$distinct{($nums[0] + $nums[-1]) / 2}++;
@nums = @nums[1 .. $#nums - 1];
}
say scalar keys %distinct;
Challenge 2:
Backspace Compare
You are given two strings containing zero or more #.
Write a script to return true if the two given strings are same by treating # as backspace.
Example 1
Input: $str1 = "ab#c"
$str2 = "ad#c"
Output: true
For first string, we remove "b" as it is followed by "#".
For second string, we remove "d" as it is followed by "#".
In the end both strings became the same.
Example 2
Input: $str1 = "ab##"
$str2 = "a#b#"
Output: true
Example 3
Input: $str1 = "a#b"
$str2 = "c"
Output: false
I thought this would be easy to solve with regular expressions but there was a slight roadbump. Here is the Perl version first.
The regular expression ^#]# matches any character except # followed by #. Substituting a match with an empty
string along with the /g flag to find all matches should do the trick I thought. Well it works for examples 1 and 3 but in 2
there are two 'backspaces' in a row. So what we need to do is remove one match then go back to the start of the now-truncated string and make the second match. There is probably a way to backtrack like this within a regular expression but I couldn't think of it so I used a while loop instead. Because the body of the loop will be empty, I replaced it with undef. we do this for
both input strings.
undef while ($str1 =~ s/[^#]#//);
undef while ($str2 =~ s/[^#]#//);
The loops will end when no more substitutions can be made. Then we check the strings for equality and output the result.
say $str1 eq $str2 ? 'true' : 'false';
Raku turned out to be even more convuluted.
First of all we have the problem of immutability so copies of the input strings had to be made. (Or I guess I could have given them
the is copy attribute which would make them mutable.)
my $copy1 = $str1;
my $copy2 = $str2;
then it seems that the .subst() method doesn't return the number of matches made like Perls' s/// does, instead it returns
the changed copy of the string it was used on so it can't be used as the condition for the while loop. Instead we check if there
are any matches left.
$copy1 = $copy1.subst(/<-[#]> '#' /, :g) while $copy1 ~~ /<-[#]> '#' /;
$copy2 = $copy2.subst(/<-[#]> '#' /, :g) while $copy2 ~~ /<-[#]> '#' /;
say $copy1 eq $copy2;