Perl Weekly Challenge: Week 354
Challenge 1:
Min Abs Diff
You are given an array of distinct integers.
Write a script to find all pairs of elements with the minimum absolute difference.
Rules (a,b):
1: a, b are from the given array.
2: a < b
3: b - a = min abs diff any two elements in the given array
Example 1
Input: @ints= (4, 2, 1, 3)
Output: [1, 2], [2, 3], [3, 4]
Example 2
Input: @ints = (10, 100, 20, 30)
Output: [10, 20], [20, 30]
Example 3
Input: @ints = (-5, -2, 0, 3)
Output: [-2, 0]
Example 4
Input: @ints = (8, 1, 15, 3)
Output: [1, 3]
Example 5
Input: @ints = (12, 5, 9, 1, 15)
Output: [9, 12], [12, 15]
The first thing we can do is .sort() @ints in ascending numeric order because
obviously numbers that are close to each other will have smaller differences than
those that are further apart.
my @sorted = @ints.sort({ $^a <=> $^b });
We will also create a hash to store the result. The keys will be minimum absolute differences and the values will be the pairs of elements that have that difference.
my %mins;
Starting from the second element (index 1) to the end of the sorted list, we sutbtract
the value of the preceding element from the current one. That is the minimum absolute
difference between the two elements so we add them to %mins.
for 1 .. @sorted.end -> $i {
my $minAbsDiff = @sorted[$i] - @sorted[$i - 1];
%mins{$minAbsDiff}.push( [ @sorted[$i - 1], @sorted[$i] ] );
}
Once we have processed all the integers, we can find the smallest minimum absolute
difference (bit of redundancy there?) with .min() and print all the pairs which have
that value. If the output code seems a little more complicated than necessery, it
is because I am trying to make the output appear in the same format as in the spec.
%mins{ %mins.keys.min }
.map({ q{[} ~ $_.join(q{', '}) ~ q{]} })
.join(q{, })
.say;
For Perl, we need a replacement min() function but otherwise the code is similar to Raku.
my @sorted = sort{ $a <=> $b } @ints;
my %mins;
for my $i (1 .. scalar @sorted - 1) {
my $minAbsDiff = $sorted[$i] - $sorted[$i - 1];
push @{$mins{$minAbsDiff}}, [ $sorted[$i - 1], $sorted[$i] ];
}
say join q{, }, map { q{[} . (join q{, }, @{$_}) . q{]} } @{$mins{ min(keys %mins) }};
Challenge 2:
Shift Grid
You are given
m x nmatrix and an integer,$k > 0.Write a script to shift the given matrix
$ktimes.
Each shift follow the rules:
Rule 1:
Element at grid[i][j] moves to grid[i][j + 1]
This means every element moves one step to the right within its row.
Rule 2:
Element at grid[i][n - 1] moves to grid[i + 1][0]
This handles the last column: elements in the last column of row i wrap to the first column of the next row (i+1).
Rule 3:
Element at grid[m - 1][n - 1] moves to grid[0][0]
This is the bottom-right corner: it wraps to the top-left corner.
Example 1
Input: @matrix = ([1, 2, 3],
[4, 5, 6],
[7, 8, 9],)
$k = 1
Output: ([9, 1, 2],
[3, 4, 5],
[6, 7, 8],)
Rule 1: grid[i][j] -> grid[i][j+1] for j < n-1.
We take elements from the original grid at (i, j) and put them into new_grid[i][j+1].
From original:
(0,0): 1 -> new_grid[0][1] = 1
(0,1): 2 -> new_grid[0][2] = 2
(1,0): 4 -> new_grid[1][1] = 4
(1,1): 5 -> new_grid[1][2] = 5
(2,0): 7 -> new_grid[2][1] = 7
(2,1): 8 -> new_grid[2][2] = 8
New grid looks after Rule 1:
([?, 1, 2],
[?, 4, 5],
[?, 7, 8],)
Rule 2: grid[i][n-1] -> grid[i+1][0] for i < m-1.
Elements from original last column (except last row) go to next row's first column.
From original:
(0,2): 3 -> new_grid[1][0] = 3
(1,2): 6 -> new_grid[2][0] = 6
Now new grid after Rules 1 + 2:
([?, 1, 2],
[3, 4, 5],
[6, 7, 8],)
Rule 3: grid[m-1][n-1] -> grid[0][0].
Original (2,2): 9 -> new_grid[0][0] = 9.
Now new_grid is complete:
([9, 1, 2],
[3, 4, 5],
[6, 7, 8],)
Example 2
Input: @matrix = ([10, 20],
[30, 40],)
$k = 1
Output: ([40, 10],
[20, 30],)
Rule 1 (move right in same row if not last column):
(0,0): 10 -> new[0][1] = 10
(1,0): 30 -> new[1][1] = 30
After Rule 1:
([?, 10],
[?, 30],)
Rule 2 (last col -> next row’s first col, except last row):
(0,1): 20 -> new[1][0] = 20
After Rule 2:
([?, 10],
[20, 30],)
Rule 3 (bottom-right to top-left):
(1,1): 40 -> new[0][0] = 40
After Rule 3:
([40, 10],
[20, 30],)
Example 3
Input: @matrix = ([1, 2],
[3, 4],
[5, 6],)
$k = 1
Output: ([6, 1],
[2, 3],
[4, 5],)
Rule 1:
(0,0): 1 -> new[0][1] = 1
(1,0): 3 -> new[1][1] = 3
(2,0): 5 -> new[2][1] = 5
After Rule 1:
([?, 1],
[?, 3],
[?, 5],)
Rule 2:
(0,1): 2 -> new[1][0] = 2
(1,1): 4 -> new[2][0] = 4
After Rule 2:
([?, 1],
[2, 3],
[4, 5],)
Rule 3:
(2,1): 6 -> new[0][0] = 6
After Rule 3:
([6, 1],
[2, 3],
[4, 5],)
Example 4
Input: @matrix = ([1, 2, 3],
[4, 5, 6],)
$k = 5
Output: ([2, 3, 4],
[5, 6, 1],)
Shift 1
Rule 1
1 -> (0,1)
2 -> (0,2)
4 -> (1,1)
5 -> (1,2)
Rule 2
3 -> (1,0) (last column of row 0)
Rule 3
6 -> (0,0) (bottom-right corner)
Result
[6, 1, 2]
[3, 4, 5]
----------------------------
Shift 2
Starting from the previous matrix:
[6, 1, 2]
[3, 4, 5]
Rule 1
6 -> (0,1)
1 -> (0,2)
3 -> (1,1)
4 -> (1,2)
Rule 2
2 -> (1,0)
Rule 3
5 -> (0,0)
Result
[5, 6, 1]
[2, 3, 4]
----------------------------
Shift 3
[5, 6, 1]
[2, 3, 4]
Rule 2: 1 -> (1,0)
Rule 3: 4 -> (0,0)
Others follow Rule 1
Result
[4, 5, 6]
[1, 2, 3]
----------------------------
Shift 4
[4, 5, 6]
[1, 2, 3]
Result
[3, 4, 5]
[6, 1, 2]
----------------------------
Shift 5
[3, 4, 5]
[6, 1, 2]
Result
[2, 3, 4]
[5, 6, 1]
Final Output (after k = 5 shifts)
([2, 3, 4],
[5, 6, 1])
Example 5
Input: @matrix = ([1, 2, 3, 4])
$k = 1
Output: ([4, 1, 2, 3])
Rule 1:
(0,0): 1 -> new[0][1] = 1
(0,1): 2 -> new[0][2] = 2
(0,2): 3 -> new[0][3] = 3
After Rule 1:
([?, 1, 2, 3])
Rule 2:
(0,3): 4 -> new[1][0] ??
Wait — but i=0, n-1=3, next row i+1=1 doesn’t exist (m=1).
So this is actually a special case where Rule 2 should not apply.
because m=1, so (0,3) goes by Rule 3 actually.
The rules say:
grid[i][j] -> grid[i][j+1] for j < n-1.
grid[i][n-1] -> grid[i+1][0] for i < m-1.
grid[m-1][n-1] -> grid[0][0].
For m = 1:
Elements (0,0),(0,1),(0,2) follow Rule 1 -> (0,1),(0,2),(0,3).
Element (0,3) is (m-1, n-1), so follows Rule 3 -> (0,0).
Actually, that means after Rule 1:
We put 1,2,3 in positions 1,2,3, leaving position 0 empty.
Then Rule 3 puts 4 in position 0.
So final directly:
[4, 1, 2, 3]
The input shall be taken from the command-line where the first argument is $k and
the others are rows of the matrix consisting of elements separated by whitespace.
E.g. for example 4, the input would be 5 "1 2 3" "4 5 6". So first we have to
convert that input back into a 2D matrix.
@matrix = @matrix.map({ [ .words ] });
By the way, we will be modifying $k and @matrix which normally you can't do
because script parameters are immutable. But to make things easier, I have overriden
that by giving them the is copy trait.
Knowing the dimensions of the matrix will be helpful later on.
my $m = @matrix.elems;
my $n = @matrix[0].elems;
A small optimization we can make is to normalize $k to the size of that matrix
as a full rotation does nothing except get us back where we started.
$k %= $m * $n;
The spec and the examples given make it seem our task is terribly complicated but rotating
an array is pretty easy. Raku even has a method to do the work for us. The only problem
is that .rotate() works on 1D arrays. So first we have to "flatten" the matrix.
my @flat = @matrix.map({ $_.flat }).flat;
Now we can rotate the flattened matrix $k times. Actually, .rotate() with a positive
value rotates left whereas we want to rotate right. So we need to pass -$k to get the correct
result.
@flat = @flat.rotate(-$k);
Then we rebuild the shifted matrix from the rotated flat version.
@matrix = ();
while @flat {
@matrix.push(@flat.splice(0, $n));
}
As before, the outputting the rotated matric is complicated by the need to match the format of the spec. Even worse, a matrix with only one row (e.g. example 4) has a different format altogether.
say q{(},
$n < 2
?? q{[} ~ @matrix.join(q{, }) ~ q{]}
!! @matrix.map({ q{[} ~ $_.join(q{, }) ~ q{]} }).join("\n"),
q{)};
Perl doesn't have rotate so we have to make our own.
rotate() takes two parameters, $k the amount of rotation, and @arr the array to rotate.
sub rotate($k, @arr) {
As in Raku, my function will rotate left if given a positive $k or right if given a
negative $k. (If $k == 0 nothing happens; you get back the original array.)
if ($k < 0) {
Rotating right is achieved by taking an element off the end of @arr with pop() and
tacking it back on the front of @arr with unshift(). This is done 1 to $k times.
(note $k would be negative at this point so it has to be negated again to be used in a range.)
In hindsight I see that the loop counter $i is redundant. It's just a habit I guess.
for my $i (1 .. -$k) {
unshift @arr, pop @arr;
}
} elsif ($k > 0) {
for my $i (1 .. $k) {
We rotate left by taking an element off the front of @arr with shift() and
appending it to the end with push().
push @arr, shift @arr;
}
}
Finally, we return the rotated array.
return @arr;
}
The rest of the code works the same as Raku.
@matrix = map { [ split /\s+/ ] } @matrix;
my $m = scalar @matrix;
my $n = scalar @{$matrix[0]};
$k %= $m * $n;
my @flat = map { @{$_} } @matrix;
@flat = rotate(-$k, @flat);
@matrix = ();
while (@flat) {
push @matrix, [splice @flat, 0, $n];
}
say q{(},
($n < 2
? (q{[} . (join q{, }, map { @{$_} } @matrix) . q{]})
: (join "\n", map { q{[} . (join q{, }, @{$_}) . q{]} } @matrix)),
q{)};