Perl Weekly Challenge: Week 391
Challenge 1:
Array Median
You are given two sorted arrays.
Write a script to merge the two given sorted arrays and return the median of the merged array.
Example 1
Input: @arr1 = (2), @arr2 = (4)
Output: 3.0
Merged array: (2,4)
Median: (2+4)/2 => 3
Example 2
Input: @arr1 = (1,2,3), @arr2 = (7,8,9,10)
Output: 7.0
Merged array: (1,2,3,7,8,9,10)
Length of merged array is 7, the 4th element is 7.
Example 3
Input: @arr1 = (), @arr2 = (10,20,30,40)
Output: 25.0
Merged array: (10,20,30,40)
Median: (20+30)/2 => 25
Example 4
Input: @arr1 = (100), @arr2 = (1,2,3,4,5,6,7)
Output: 4.5
Merged array: (1,2,3,4,5,6,7,100)
Median: (4+5)/2 => 4.5
Example 5
Input: @arr1 = (1,2,2), @arr2 = (2,2,3)
Output: 2.0
Merged array: (1,2,2,2,2,3)
Median: (2+2)/2 => 2
The input for my solution is taken from two command-line arguments for the two
arrays where each element is separated by whitespace. So for Example 5, the
input would look like "1 2 2" "2 2 3".
We create the merged aray by concatenating the arguments and splitting them into
individual elements with .words() and then .sort()ing them into ascending
numeric order.
my @merged = "$arr1 $arr2".words.sort({$^a <=> $^b});
We also need to know how many elements there are in @merged.
my $len = @merged.elems;
if $len is even, the median is the middle two elemnts of @merged divided by 2.
if $len %% 2 {
my $mid = $len / 2;
say (@merged[$mid] + @merged[$mid - 1]) / 2;
Otherwise the median is the middle element.
} else {
say @merged[$len / 2];
}
The Perl version works the same as in Raku for the most part.
One small problem I had was with Example 3. The empty first array is treated
as an element by Perl so the middle element for the median was wrong. I got
around it by inserting a call to trim() which is a new builtin function in modern
versions of Perl. It removes leading and trailing whitespace from a string.
my @merged = sort { $a <=> $b } split /\s+/, trim "$arr1 $arr2";
my $len = scalar @merged;
if ($len % 2 == 0) {
my $mid = $len / 2;
say 0+($merged[$mid] + $merged[$mid - 1]) / 2;
} else {
say $merged[$len / 2];
}
Challenge 2:
Arrange Box
You are given an array of box dimensions.
Write a script to determine the maximum number of these boxes that can fit inside each other in a single stack. For a box to fit inside another, it must be smaller in both dimensions.
Example 1
Input: @boxes = ([1, 3], [3, 5], [6, 8], [2, 4])
Output: 4
Sort by width ascending: ([1, 3], [2, 4], [3, 5], [6, 8])
Extract heights: [3, 4, 5, 8]
[1, 3] -> [2, 4] -> [3, 5] -> [6, 8]
Example 2
Input: @boxes = ([4, 5], [4, 6], [6, 7], [2, 3], [4, 3])
Output: 3
Sort by width ascending: ([2, 3], [4, 6], [4, 5], [4, 3], [6, 7])
Extract heights: (3, 6, 5, 3, 7)
[2, 3] -> [4, 5] -> [6, 7]
Example 3
Input: @boxes = ([5, 5], [5, 5], [5, 5])
Output: 1
Sort by width ascending: ([5, 5], [5, 5], [5, 5])
Extract heights: (5, 5, 5)
[5, 5]
Example 4
Input: @boxes = ([2, 100], [3, 200], [4, 300], [5, 50], [5, 400])
Output: 4
Sort by width ascending: ([2, 100], [3, 200], [4, 300], [5, 400], [5, 50])
Extract heights: (100, 200, 300, 400, 50)
[2, 100] -> [3, 200] -> [4, 300] -> [5, 400]
Example 5
Input: @boxes = ([10, 20], [15, 10], [20, 30], [12, 18], [16, 25])
Output: 3
Sort by width ascending: ([10, 20], [12, 18], [15, 10], [16, 25], [20, 30])
Extract heights: (20, 18, 10, 25, 30)
[15, 10] -> [16, 25] -> [20, 30]
As in challenge 1, we get the input from command-line arguments. For Example 1,
the input would be "1 3" "3 5" "6 8" "2 4".
First, we take the input and reconstitute it into an array of arrays. Each inner array represents a box and has two elements, the width and the height.
my @boxes = @args.map({ [ $_.words ] });
@boxes is then .sort()ed by increasing width or if widths are the same, by height.
@boxes = @boxes.sort({ $^a[0] <=> $^b[0] || $^b[1] <=> $^a[1] });
Solving this challenge is a good candidate for dynamic programming. In @longest
we store the longest stack of contained boxes ending at each box. Every box initially forms a stack of length 1, containing only itself.
my @longest = @boxes.map({ 1 });
In a double loop we compare each box to all the boxes before it. its' count in @longestis updated by 1 for every previous box that fits inside it if that is
more than the current count.
for 0 .. @boxes.end -> $i {
for 0 ..^ $i -> $j {
if @boxes[$j][0] < @boxes[$i][0] && @boxes[$j][1] < @boxes[$i][1] {
@longest[$i] = max(@longest[$i], @longest[$j] + 1);
}
}
}
Finally, we find the largest stack length among all possible ending boxes, and print that out.
@longest.max.say;
For Perl, we have to provide our own version of max() otherwise it is the same as Raku.
my @boxes = map { [split /\s+/, $_ ] } @ARGV;
@boxes = sort { $a->[0] <=> $b->[0] || $b->[1] <=> $a->[1] } @boxes;
my @longest = map { 1 } @boxes;
for my $i (keys @boxes) {
for my $j (0 .. $i - 1) {
if ($boxes[$j][0] < $boxes[$i][0] && $boxes[$j][1] < $boxes[$i][1]) {
$longest[$i] = max($longest[$i], $longest[$j] + 1);
}
}
}
say max(@longest);