laurent_r

These are some answers to the Week 86 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a day or so (November 15, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Pair Differences

You are given an array of integers @N and an integer $A.

Write a script to find find if there exists a pair of elements in the array whose difference is $A.

Print 1 if exists otherwise 0.

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

I’ll print not only 1 or 0, but also the first pair found (if any), as it makes it easier to check that the program is correct.

Pair Differences in Raku

For this, we use the combinations method to generate all (unordered) pairs from the input array of integers. Then, we compare the absolute value of the difference between the two integers of the pair with the target, and print out the pair if there is a match. Then we print 1 if we found such pair, and 0 otherwise.

use v6;

my @tests = [ 7, [10, 8, 12, 15, 5]],
            [ 6, [1, 5, 2, 9, 7]], 
            [15, [10, 30, 20, 50, 40]],
            [9, [7, 20, 15, 11, 12]];
for @tests -> @R {
    my $found = False;
    my $target = @R[0];
    say "Testing: target: $target and @R[1]";
    for @R[1].combinations(2) -> $candidate {
        $found = True and say $candidate and last 
            if abs($candidate[0] - $candidate[1]) == $target;
    }
    say +$found;
}

Note that there may be several solutions, but we only print the first one since we are requested to check whether such a pair exists. My initial program found two pairs ((8 15) and (12 5)) for the first test case, but I changed it to print only the first pair.

Output:

Testing: target: 7 and 10 8 12 15 5  # Note: 2 solutions: 8 15 and 12 5
(8 15)
1
Testing: target: 6 and 1 5 2 9 7
(1 7)
1
Testing: target: 15 and 10 30 20 50 40
0
Testing: target: 9 and 7 20 15 11 12
(20 11)
1

Pair Differences in Perl

This is basically a port to Perl of the Raku program above. Please refer to the explanations above if needed. The only significant difference is that Perl doesn’t have a built-in combinations function, so we use two nested forloops to generate all the integer pairs.

use strict;
use warnings;
use feature "say";

my @tests = ( [ 7, [10, 8, 12, 15, 5]],
              [ 6, [1, 5, 2, 9, 7]], 
              [ 15, [10, 30, 20, 50, 40]],
              [ 9, [7, 20, 15, 11, 12]],
            );
for my $R (@tests) {
    my ($target, $test_ref) = @$R;
    my @test = @$test_ref;
    my $found = 0;
    say "Testing: target: $target and @test";
    OUT: for my $i (0..$#test) {
        for my $j ($i..$#test) {
            if (abs($test[$i] - $test[$j]) == $target) {
                $found = 1;
                say +$found, " ($test[$i] $test[$j])" if $found;
                last OUT;
            }

        }

    }
    say "0" unless $found;
}

This is the output generated by this script:

$ perl pair_difference.pl
Testing: target: 7 and 10 8 12 15 5
1 (8 15)
Testing: target: 6 and 1 5 2 9 7
1 (1 7)
Testing: target: 15 and 10 30 20 50 40
0
Testing: target: 9 and 7 20 15 11 12
1 (20 11)

Pair Differences in Scala

This section was added to this blog post on Jan. 15, 2021 and is an implementation of the same ideas as above in Scala:

object pairDiff extends App {
  val target = 7
  val test = List(10, 8, 12, 15, 5)
  var found = 0
  for (i <- 0 to test.length - 1) {
    for (j <- i to test.length - 1) {
      if ((test(i) - test(j)).abs == target) found = 1
    }
  }
  println(found)
}

This program prints out “1”, since it finds (8, 15) to match the target.

Pair Differences in Python

This section was added to this blog post on Jan. 17, 2021. While trying to implement a Python solution, I was looking in the documentation for a combinations built-in function or method in Python, and it suddenly occurred to me that there is a solution that is more efficient than testing all combinations as in the Raku, ¨Perl and Scala scripts above, i.e. storing the array values in a map (or hash) or in a set and looking up in the map or set for a number that would match the difference requirement:

def find_diff (target, int_list):
    my_set = set(int_list)
    for item in my_set:
        if item + target in test:
            # print(item)
            return 1
    return 0

test = (10, 8, 12, 15, 5)
target = 7
print(find_diff(target, test))

This displays the following output:

$ python3 pair_difference.py
1

Task 2: Sudoku Puzzles

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 ]

I have been a great fan of sudoku puzzles ever since they started to become popular in newspapers around 2005. At the time, after having solved manually sudoku puzzles for a few weeks, I wrote a Perl program to solve sudoku puzzles. I unfortunately no longer have this program (I guess I forgot to copy it when I changed computer). This program had a number of features. It could check if a grid was a valid sudoku puzzle (a valid puzzle should have one and only one solution). It implemented five or six different deductive strategies, but I quickly found that some relatively rare grids resisted all deductive approaches (even combined together and repeated). So I had to implement a backtracking brute force algorithm testing out all possibilities for such cases (this is less efficient than deductive approaches in most cases, but it still runs fairly fast). The program could also generate new puzzles.

Here, I’ll employ only one deductive approach (for each hole, check whether there is one and only one possible integer), and loop again until the puzzle is solved or until we can no longer fill a hole with this approach. In the latter case, we employ backtracking brute force. We’ll assume that the input grid a valid sudoku puzzle.

Note that both my Raku and Perl programs start with a grid similar to the example provided in the task description, with underscores to indicate the holes, but the first thing I do is to replace underscores by 0s, because it makes it possible to use numeric comparison operators in the rest of the program.

Sudoku Puzzles in Raku

The most important subroutine is perhaps is-allowed-digit, which, for a given position in the grid and an integer candidate checks that it is a valid candidate, i.e. the row, column and sub-grid don’t contain this candidate.

The next important thing is the while loop. It scans the whole grid and, for each empty position, calls is-allowed-digit for every integer between 1 and 9. If only one integer is allowed, the hole is filled with that candidate. One it has completed this scan, it does it again until there is no hole left (we have the solution) or until one such scan did not find any hole to be filled. In the latter case, the program calls the recursive brute-force-find subroutine, which tries out all possibilities for the remaining holes and backtracks whenever it reaches a dead end.

use v6;

constant MAX = 8;
my @grid =
    [ < _ _ _ 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 2 _ _ 7 4 > ],
    [ < _ 4 _ _ 5 _ _ 3 6 > ],
    [ < 7 _ 3 _ 1 8 _ _ _ > ];

# Replaces _ with 0 and numify values
for @grid <-> $line {
    for @$line <-> $item {
        $item = $item eq '_' ?? 0 !! +$item;
    }
}
.say for @grid; say "";
my %square;
for 0..MAX {
    when 0..2 { %square{$_} = |(0..2)}
    when 3..5 { %square{$_} = |(3..5)}
    when 6..8 { %square{$_} = |(6..8)}
}

sub is-allowed-digit (@grid, Int $k, $position) {
    my ($i, $j) = $position[0, 1];
    return False if $k == @grid[$i].any;         # line
    for 0..MAX -> $n {                           # column
        return False if $k == @grid[$n][$j];
    }
    for %square{$i} -> $m {                      # Square
        return False if $k == (@grid[$m][|%square{$j}]).any;
    } 
    True; 
}

my $solution-found = False;
my $continue = True;
while $continue {
    my $one-change-made = False;
    my $no-hole-left = True;;
    for 0..MAX -> $row {
        for 0..MAX -> $col {
            next if @grid[$row][$col];
            # $no-hole-left = False;
            my @candidates = gather {
                for 1..9 -> $candidate {
                    take $candidate if 
                        is-allowed-digit @grid, $candidate, [$row, $col];
                }
            }
            if @candidates.elems == 1 {
                @grid[$row][$col] = @candidates[0];
                $one-change-made = True;
            } else {
                $no-hole-left = False;
            }
        }
    }
    # .say for @grid;  say ""; # uncomment to see the progress on each iteration
    $solution-found = $no-hole-left;
    $continue = (! $no-hole-left) && $one-change-made;
}
if $solution-found {
say "Solution:";
    .say for @grid;
} else {
    brute-force-find(@grid, 0);
}

sub brute-force-find (@grid is copy, Int $row-id) {
     for 0..MAX -> $i {
        my $hole = (grep {@grid[$i][$_] == 0}, 0..8)[0];
        unless defined $hole {
            if $i == MAX {
                # We've found a solution (no hole, last row)
                .say for @grid;
                return;
            } else {
                next; # No hole, process next row
            }
        }
        my $found_candidate = False;
        for 1..9 -> $k {
            if is-allowed-digit(@grid, $k, [$i, $hole]) {
                @grid[$i][$hole] = $k;
                $found_candidate = True;
                brute-force-find(@grid, $i);
            }
        }
        # we are in a deadend if we did not find any suitable candidate 
        # for the hole. Backtracking needed
        return unless $found_candidate;
    }
}

The program displays the initial grid (after having replaced the underscores with 0s) and the solution:

$ raku sudoku.raku
[0 0 0 2 6 0 7 0 1]
[6 8 0 0 7 0 0 9 0]
[1 9 0 0 0 4 5 0 0]
[8 2 0 1 0 0 0 4 0]
[0 0 4 6 0 2 9 0 0]
[0 5 0 0 0 3 0 2 8]
[0 0 9 3 2 0 0 7 4]
[0 4 0 0 5 0 0 3 6]
[7 0 3 0 1 8 0 0 0]

Solution:
[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]

You may uncomment this code line:

# .say for @grid;  say "";

to see the progress on each iteration of the while loop. Note that this sudoku grid was solved after two iterations of the while loop and therefore did not require any call to the brute force subroutine (and I believe that most sudoku grids don’t need it, only a small proportion of them do).

Sudoku Puzzles in Perl

This is a direct port to Perl of the Raku program above. Please refer to the explanations above if needed.

use strict;
use warnings;
use feature "say";
use constant MAX => 8;

my @grid =
    ( [ qw < _ _ _ 2 6 _ 7 _ 1 > ],
      [ qw < 6 8 _ _ 7 _ _ 9 _ > ],
      [ qw < 1 9 _ _ _ 4 5 _ _ > ],
      [ qw < 8 2 _ 1 _ _ _ 4 _ > ],
      [ qw < _ _ 4 6 _ 2 9 _ _ > ],
      [ qw < _ 5 _ _ _ 3 _ 2 8 > ],
      [ qw < _ _ 9 3 2 _ _ 7 4 > ],
      [ qw < _ 4 _ _ 5 _ _ 3 6 > ],
      [ qw < 7 _ 3 _ 1 8 _ _ _ > ]
    );

# Replaces _ with 0 and numify values
for my $line (@grid) {
    for my $item (@$line) {
        $item = $item eq '_' ? 0 : +$item;
    }
}
say "[ @$_ ]" for @grid; say "";

my %square;
for my $i (0..MAX) {
    $square{$i} = $i <= 2 ? [0..2] :
                  $i >= 6 ? [6..8] :
                  [3..5]; 
}

sub is_allowed_digit {
    my ($grid_ref, $k, $position_ref) = @_;
    my @grid = @$grid_ref;
    my ($i, $j) = @$position_ref;
    return 0 if grep $_ == $k, @{$grid[$i]};       # line
    for my $n (0..MAX) {                           # column
        return 0 if $k == $grid[$n][$j];
    }
    for my $m (@{$square{$i}}) {                   # Square
        return 0 if grep { $k == $grid[$m][$_] } @{$square{$j}};
    } 
    return 1; 
}

my $solution_found = 0;
my $continue = 1;
while ($continue) {
    my $one_change_made = 0;
    my $no_hole_left = 1;
    for my $row (0..MAX) {
        for my $col (0..MAX) {
            next if $grid[$row][$col];
            my @candidates; 
            for my $candidate (1..9) {
                push @candidates, $candidate if 
                    is_allowed_digit(\@grid, $candidate, [$row, $col]);
            }
            if (@candidates == 1) {
                $grid[$row][$col] = $candidates[0];
                $one_change_made = 1;
            } else {
                $no_hole_left = 0;
            }
        }
    }
    # say "[ @$_ ]" for @grid;  say "";
    $solution_found = $no_hole_left;
    $continue = (! $no_hole_left) && $one_change_made;
}
if ($solution_found) {
say "Solution:";
    say "[ @$_ ]" for @grid;
} else {
    brute_force_find(@grid, 0);
}   

sub brute_force_find {
    my @grid = @$_[0];
    my $row_id = $_[1];
    for my $i (0..MAX) {
        my $hole = (grep {$grid[$i][$_] == 0} 0..8)[0];
        unless (defined $hole) {
            if ($i == MAX) {
                # We've found a solution (no hole, last row)
                say "[ @$_ ]" for @grid;
                return;
            } else {
                next; # No hole, process next row
            }
        }
        my $found_candidate = 0;
        for my $k (1..9) {
            if (is_allowed_digit(@grid, $k, [$i, $hole])) {
                $grid[$i][$hole] = $k;
                $found_candidate = 1;
                brute_force_find(@grid, $i);
            }
        }
        # we are in a deadend if we did not find any suitable candidate 
        # for the hole. Backtracking is needed.
        return unless $found_candidate;
    }
}

Output:

$ perl  sudoku.pl
[ 0 0 0 2 6 0 7 0 1 ]
[ 6 8 0 0 7 0 0 9 0 ]
[ 1 9 0 0 0 4 5 0 0 ]
[ 8 2 0 1 0 0 0 4 0 ]
[ 0 0 4 6 0 2 9 0 0 ]
[ 0 5 0 0 0 3 0 2 8 ]
[ 0 0 9 3 2 0 0 7 4 ]
[ 0 4 0 0 5 0 0 3 6 ]
[ 7 0 3 0 1 8 0 0 0 ]

Solution:
[ 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 ]

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, November, 22, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.