Perl Weekly Challenge: Week 86
With Diwali and the Gujarati New Year occurring over the weekend, I was a bit late with this weeks challenge but I did manage to complete it in the end. Best wishes to all for an auspicious and prosperous new year!
Challenge 1:
Pair Difference
You are given an array of integers
@Nand an integer$A.Write a script to find find if there exists a pair of elements in the array whose difference is
$A.1if exists otherwise0.
Example 1:
Input: @N = (10, 8, 12, 15, 5) and $A = 7
Output: 1 as 15 - 8 = 7
Example 2:
Input: @N = (1, 5, 2, 9, 7) and $A = 6
Output: 1 as 7 - 1 = 6
Example 3:
Input: @N = (10, 30, 20, 50, 40) and $A = 15
Output: 0
In Raku, this is almost a one-liner:
say @N.combinations(2).grep({ @_.max - @_.min == $A }).elems ?? 1 !! 0;
Perl is pretty concise too but once again I had to resort to my combinations() function I used last week and that bulked up the script a bit. Also to replace
.min() and .max() methods which Raku has but Perl doesn't (not built in anyway) I used abs().
say scalar(grep { abs($_->[0] - $_->[1]) == $A; } combinations(\@N, 2)) ? 1 : 0;
Challenge 2:
Sudoku Puzzle
You are given Sudoku puzzle (9x9).
Write a script to complete the puzzle and must respect the following rules:
a) Each row must have the numbers 1-9 occuring just once. b) Each column must have the numbers 1-9 occuring just once. c) The numbers 1-9 must occur just once in each of the 9 sub-boxes (3x3) of the grid.
Example:
[ _ _ _ 2 6 _ 7 _ 1 ]
[ 6 8 _ _ 7 _ _ 9 _ ]
[ 1 9 _ _ _ 4 5 _ _ ]
[ 8 2 _ 1 _ _ _ 4 _ ]
[ _ _ 4 6 _ 2 9 _ _ ]
[ _ 5 _ _ _ 3 _ 2 8 ]
[ _ _ 9 3 _ _ _ 7 4 ]
[ _ 4 _ _ 5 _ _ 3 6 ]
[ 7 _ 3 _ 1 8 _ _ _ ]
Output:
[ 4 3 5 2 6 9 7 8 1 ]
[ 6 8 2 5 7 1 4 9 3 ]
[ 1 9 7 8 3 4 5 6 2 ]
[ 8 2 6 1 9 5 3 4 7 ]
[ 3 7 4 6 8 2 9 1 5 ]
[ 9 5 1 7 4 3 6 2 8 ]
[ 5 1 9 3 2 6 8 7 4 ]
[ 2 4 8 9 5 7 1 3 6 ]
[ 7 6 3 4 1 8 2 5 9 ]
As the above puzzle respect the 3 rules including 9-sub-boxes as shown below:
[ 4 3 5 ] [ 2 6 9 ] [ 7 8 1 ]
[ 6 8 2 ] [ 5 7 1 ] [ 4 9 3 ]
[ 1 9 7 ] [ 8 3 4 ] [ 5 6 2 ]
[ 8 2 6 ] [ 1 9 5 ] [ 3 4 7 ]
[ 3 7 4 ] [ 6 8 2 ] [ 9 1 5 ]
[ 9 5 1 ] [ 7 4 3 ] [ 6 2 8 ]
[ 5 1 9 ] [ 3 2 6 ] [ 8 7 4 ]
[ 2 4 8 ] [ 9 5 7 ] [ 1 3 6 ]
[ 7 6 3 ] [ 4 1 8 ] [ 2 5 9 ]
I think this is probably the most ambitious challenge in scope so far and I sat down to code with some trepidation. After doing some research on the Internet, I was relieved to find that it wasn't going to be as difficult as I imagined. This article in particular was helpful in outlining the algorithm needed.
I'll show you the Perl version first.
The process() function reads in a text file representing a sudoku puzzle and converts
it into an array of one array for each line in the puzzle. _ characters are changed
to 0's.
sub process {
my ($file) = @_;
my @puzzle;
open my $fn, '<', $file or die "$OS_ERROR\n";
local $RS = undef;
my $data = <$fn>;
close $fn;
$data =~ s/_/0/g;
my @lines = split /\n/, $data;
for my $line (@lines) {
push @puzzle, [ grep { /\d/ } split //, $line];
}
return @puzzle;
}
The solve() function is the heart of the script. It takes the @puzzle array of
arrays created by process() and scans for 0's. If one is found, it is replaced successively
by numbers from 0 to 9. Which of these is the appropriate one is determined by the isValid()
function which will be described later. If a number has been validated, we recursively
call solve() again to fill the next 0. Often we will reach a dead end and be unable to fill the
space. Then we will have to backtrack and try the next number.
If all numbers have been tried and none of them were valid, the puzzle is unsolvable and a false value is returned.
If there are no more 0's, it means we have successfully solved the puzzle and a true value is returned.
sub solve {
my ($puzzle) = @_;
for my $row (0 .. scalar @{$puzzle} - 1) {
for my $col (0 .. scalar @{$puzzle->[$row]} - 1) {
if ($puzzle->[$row][$col] == 0) {
for my $num (1 .. 9) {
if (isValid($puzzle, $row, $col, $num)) {
$puzzle->[$row][$col] = $num;
if(solve($puzzle)) {
return 1;
}
$puzzle->[$row][$col] = 0;
}
}
return undef;
}
}
}
return 1;
}
The isValid() function does three tests on a number.
- Does it already exist in the current row?
- Does it already exist in the current column?
- Does it already exist in the current 3x3 box?
If the answer to all three of these questions is no, we have a valid number.
sub isValid {
my ($puzzle, $row, $col, $num) = @_;
my @columns = columns($puzzle);
return
!inRow($puzzle, $row, $num) &&
!inCol(\@columns, $col, $num) &&
!inBox($puzzle, $row - $row % 3, $col - $col % 3, $num);
}
These are the functions that implement the actual tests. inCol() needs to know
the values of the items in the column the number is in. We can derive the columns from the
rows of the puzzle and the columns() function does just that.
sub inRow {
my ($puzzle, $row, $num) = @_;
return scalar grep { $_ == $num; } @{$puzzle->[$row]};
}
sub inCol {
my ($columns, $col, $num) = @_;
return scalar grep { $_ == $num; } @{$columns->[$col]};
}
sub inBox {
my ($puzzle, $row, $col, $num) = @_;
my @box;
for my $i ($row .. $row + 2) {
push @box, @{$puzzle->[$i]}[$col .. $col + 2];
}
return scalar grep { $_ == $num; } @box;
}
sub columns {
my ($puzzle) = @_;
my @columns;
for my $i (0 .. scalar @{$puzzle} - 1) {
for my $j (0 .. scalar @{$puzzle->[$i]} - 1) {
push @{$columns[$i]}, @{$puzzle->[$j]}[$i];
}
}
return @columns;
}
The Raku version only has a few interesting differences.
In the validation test functions, we use .any() instead of grep(). As well as
being more concise, this makes the code much more readable.
Also, see that little | in inBox()? Forgetting it cost me over an hour in wasted
debugging time. I had forgotten that Raku by default doesn't flatten arrays when you .push them
the way Perl does. You need | to get the same behavior.
sub inBox(@puzzle, $row, $col, $num) {
my @box;
for $row .. $row + 2 -> $i {
@box.push(| @puzzle[$i][$col .. $col + 2]);
}
return $num == @box.any;
}
sub inCol(@columns, $col, $num) {
return $num == @columns[$col].any;
}
sub inRow(@puzzle, $row, $num) {
return $num == @puzzle[$row].any;
}
To make the @columns array, instead of a separate function, we can use the
zip hyperoperator [Z].
sub isValid(@puzzle, $row, $col, $num) {
my @columns = [Z] @puzzle;
return
!inRow(@puzzle, $row, $num) &&
!inCol(@columns, $col, $num) &&
!inBox(@puzzle, $row - $row % 3, $col - $col % 3, $num);
}
By default, function parameters in Raku are immutable. So we have to declare
@puzzle as is copy in order to be able to modify it.
sub solve(@puzzle is copy) {
for 0 ..^ @puzzle.elems -> $row {
for 0 ..^ @puzzle[$row].elems -> $col {
if @puzzle[$row][$col] == 0 {
for (1 .. 9) -> $num {
if isValid(@puzzle, $row, $col, $num) {
@puzzle[$row][$col] = $num;
if solve(@puzzle) {
return True;
}
@puzzle[$row][$col] = 0;
}
}
return False;
}
}
}
return True;
}