Perl Monk, Perl Meditation PerlMonks

Re^3: decomposing binary matrices

by johngg (Canon)
 on Feb 16, 2007 at 23:43 UTC ( #600550=note: print w/replies, xml ) Need Help??

in reply to Re^2: decomposing binary matrices
in thread decomposing binary matrices

From Limbic~Region's reply, it looks like you might have lost your bet. I too have a brute force solver that I wrote a couple of years ago. It would be interesting to compare our approaches so I'll dig my version out and post it as well. I actually wrote it before I had got into solving the puzzles by hand so I ought to have a go at refining it now that I have more strategies to hand.

Cheers,

JohnGG

Update: Here is my brute-force Sudoku solver. Although it has to resort to backtracking if it makes a wrong guess it is fairly efficient because it sorts the empty squares by the number of possible numbers for each square before making a guess. Thus, for a lot of the time, it will make the right choice and it also updates everything and re-sorts after each choice. It will also detect an unsolveable puzzle very quickly as there will be a square with no possible number.

It uses Term::ANSIColor to prettify the output but I'm not sure if that works in Windows terminals. Here's the code

```#!/usr/local/bin/perl -w
#
# Copyright (c) 2005, John Gillman
# All rights reserved
#
# This program is free software. It may be used, re-distributed
# and/or modified under the same terms as Perl 5.8.0 (or later),
# (see http://www.perl.com/perl/misc/Artistic.html).
#
# Force pre-declaration, import Term::ANSIColor to allow bold text
# so as to make printed representations of the puzzle grid more
# readable.
#
use strict;
use Term::ANSIColor qw(:constants);

# Check that we have a single argument which is the name of the
# file containing the puzzle data, i.e which cells have numbers
# and which don't. (And what the numbers are, obviously.)
#
die "usage: sudoku filename\a\n" unless scalar @ARGV == 1;
die "sudoko: \$ARGV[0] does not exist\a\n" unless -e \$ARGV[0];

# Set up formatting components using the Term::ANSIColor constants
# to embolden certain parts so as to replicate the puzzle grid as
# it appears in the newspaper.
#
our \$leftEdge = " " . BOLD . "|" . RESET;
our \$boldLight = BOLD . "~~~~~" . RESET . "|";
our \$boldBold = BOLD . "~~~~~|" . RESET ;
our \$lightBold = "-----" . BOLD . "|" . RESET;
our \$lightLight = "-----|";
our \$spaceBold = "     " . BOLD . "|" . RESET;
our \$spaceLight = "     |";

# Use the components to construct row and column separator lines.
#
our \$boldRowSep = \$leftEdge . (\$boldLight x 2 . \$boldBold) x 3 . "\n";
our \$lightRowSep = \$leftEdge . (\$lightLight x 2 . \$lightBold) x 3 . "\
+n";
our \$colSep = \$leftEdge . (\$spaceLight x 2 . \$spaceBold) x 3 . "\n";

# Initialise puzzle grid to 9 rows and 9 columns of spaces and
# initialise count of solutions found. Puzzle grid is a list of
# lists, columns within rows.
#
our \$rlGrid = [];
{
my @row = ();
push @row, ' ' for 0 .. 8;
@{\$rlGrid->[\$_]} = @row for 0 .. 8;
}
our \$solnCt = 0;

# Set up a hash table with, initially, an entry for each cell, the
# key being "row:column". When a cell is filled, it's corresponding
# entry in the hash is deleted.
#
our \$rhEmpties = {};
foreach my \$row (0 .. 8)
{
foreach my \$col (0 .. 8)
{
\$rhEmpties->{"\$row,\$col"} = [];
}
}

# Open the input file for reading.
#
our \$inputFile = shift;
open IN, "<\$inputFile" or die "open: \$inputFile: \$!\n";

# Declare another grid to hold locations in the grid where numbers
# were placed at the start, declare an anonymous hash that will hold
# locations of empty cells and declare an anonymous hash that will
# hold a list of keys of empty cells in each group of nine. Read
# data lines at the end of the script one at a time. There should
# be nine lines, one for each row, and each line should contain nine
# characters, one for each column with the digits 1 through 9 and
# dots representing blank cells.
#
our \$rlInitialNos = [];
our \$rhEmptyCells = {};
our \$rhAffected = {};
while(<IN>)
{

# Validate input; are there more than nine lines? Drop newline
# and check we have exactly nine valid characters.
#
die "Only nine data lines required for puzzle grid\n" if \$. > 9;
chomp;
die "Line \$.: data -->\$_<-- invalid\n" unless /^[1-9.]{9}\$/;

# Set row number from input data line number, split line into
# individual characters then iterate over the characters.
#
my \$row = \$. - 1;
my @chars = split //;
foreach my \$col (0 .. 8)
{

# If character is a dot, create an empty list in the hash
# of empty cells. Otherwise, put the number found into the
# correct cell of the puzzle grid and set same cell in the
# grid of numbers set at initialisation.
#
if(\$chars[\$col] eq '.')
{
my \$rlGroupKeys = getKeys(\$row, \$col);
my \$cellKey = "r\${row}c\${col}";
\$rhEmptyCells->{\$cellKey} = [];
push @{\$rhAffected->{\$_}}, \$cellKey for @\$rlGroupKeys
}
else
{
\$rlGrid->[\$row]->[\$col] = \$chars[\$col];
\$rlInitialNos->[\$row]->[\$col] ++;
}
}
}

# Close input file. Validate puzzle grid and abort if it is a duffer.
#
close IN or die "close: \$inputFile: \$!\n";
if(my \$gridError = validateGrid(\$rlGrid))
{
print "\nERROR: \$gridError\n\n";
printGrid(\$rlGrid);
die "ABORTING\n";
}

# Show puzzle grid as initialised.
#
print "\nPuzzle grid to solve\n";
printGrid(\$rlGrid);

# Set up an anonymous hash to contain entries keyed by row, column
# or block identifier (r0 thru r8, c0 thru c8 and b00 thru b66, the
# two block digits signifying the row and column of the top-left cell
# of a 3x3 block). The value for each group of nine is an anonymous
# list of numbers that could occupy any empty cell in the group.
# Do rows and columns first, calling groupPossibles() for each.
#
our \$rhGroupsOf9 = {};
foreach my \$rowOrCol (0 .. 8)
{
my \$rowKey = "r\$rowOrCol";
my \$colKey = "c\$rowOrCol";
\$rhGroupsOf9->{\$rowKey} = groupPossibles(\$rlGrid, \$rowKey);
\$rhGroupsOf9->{\$colKey} = groupPossibles(\$rlGrid, \$colKey);
}

# Now do the 3x3 blocks.
#
foreach my \$blockRow (0, 3, 6)
{
foreach my \$blockCol (0, 3, 6)
{
my \$blockKey = "b\$blockRow\$blockCol";
\$rhGroupsOf9->{\$blockKey} = groupPossibles(\$rlGrid, \$blockKey)
+;
}
}

# Now that we know which numbers are possibilities for each group of
# nine we can now populate the lists of possible numbers for each empt
+y
# cell.
#
foreach my \$cell (keys %\$rhEmptyCells)
{
my \$row = substr \$cell, 1, 1;
my \$col = substr \$cell, 3, 1;
my \$rlGroupKeys = getKeys(\$row, \$col);
my %count = ();
foreach my \$group (@\$rlGroupKeys)
{
\$count{\$_} ++ for @{\$rhGroupsOf9->{\$group}};
}
foreach my \$digit (keys %count)
{
delete \$count{\$digit} unless \$count{\$digit} == 3;
}
push @{\$rhEmptyCells->{\$cell}}, keys %count;
}

# Invoke the findSolutions() subroutine, passing it the puzzle
# grid, the groups of nine, empty cells and cells affected hashes
# and the key of the next cell to fill from the empty cells hash.
# The nextCellKey() routine chooses the cell with the fewest possible
# digits. Any solution found will be printed by the findSolutions()
# routine.
#
findSolutions(\$rlGrid, \$rhGroupsOf9, \$rhEmptyCells, \$rhAffected,
nextCellKey(\$rhEmptyCells));

# Print message if no solution was found. Exit program.
#
print "\nNo solution found\n\n" unless \$solnCt;

exit;

#
# -:-:-:- End of main() -:-:-:-
#

#   -------------
sub findSolutions
#   -------------

# Subroutine to populate the grid, a cell at a time, trying
# a possible number then moving on to the next cell by calling
# itself recursively until either a complete solution is
# arrived at or there are no possible values for the cell
# being examined, at which point the routine returns back to
# a previous cell that has other possible numbers to examine.
# If a complete solution is found, i.e. a call to nextCell()
# returns undef because all empty cells have been filled, print
# out the solution grid then return to look for more possible
# solutions.
#

{
# Get the puzzle grid, the hash of possible numbers for each
# row, column or block, the hash of empty cells, the hash of
# cells affected by group and the key of the current empty cell
# that we are about to fill in. If the current cell key is undef
# then there were no empty cells left when findSolutions() was
# called this time so we have a solution. Print it then validate
# it, die if bad, otherwise return.
#
my(\$rlGrid, \$rhGroupsOf9, \$rhEmptyCells, \$rhAffected,
\$currentCellKey) = @_;
unless(\$currentCellKey)
{
print "Solution no. ", ++ \$solnCt, "\n";
printGrid(\$rlGrid);
if(my \$gridError = validateGrid(\$rlGrid))
{
print "\nERROR: \$gridError\n\n";
die "ABORTING\n";
}
return;
}

# Extract row and column from key. Get keys of the groups of nine
# affected by the current cell.
#
my \$row = substr \$currentCellKey, 1, 1;
my \$col = substr \$currentCellKey, 3, 1;
my \$rlGroupKeys = getKeys(\$row, \$col);

# Iterate over the possible values for the current cell as held in
# the \$rhEmptyCells hash.
#
foreach my \$try (@{\$rhEmptyCells->{\$currentCellKey}})
{
# Construct a regular expression used to remove the number
# from lists.
#
my \$rxEliminate = qr{[^\$try]};

# Replicate \$rlGrid, \$rhGroupsOf9, \$rhEmptyCells and \$rhAffect
+ed
# ready to fill in the current cell with it's possible values
# and update the data structures.
#
my \$rlNewGrid = replicateGrid(\$rlGrid);
my \$rhNewGroupsOf9 = replicateHoL(\$rhGroupsOf9);
my \$rhNewEmptyCells = replicateHoL(\$rhEmptyCells);
my \$rhNewAffected = replicateHoL(\$rhAffected);

# Place the number we are trying this time in the replica puzz
+le
# grid. Remove the current cell from the replica empty cells
# hash.
#
\$rlNewGrid->[\$row]->[\$col] = \$try;
delete \$rhNewEmptyCells->{\$currentCellKey};

# Iterate over the groups of nine that are affected by the cur
+rent
# cell, modifying the replica anonymous hashes with the number
+.
#
foreach my \$group (@\$rlGroupKeys)
{
# Update this group to remove the number from it's list of
# possible numbers.
#
@{\$rhNewGroupsOf9->{\$group}} =
grep /\$rxEliminate/, @{\$rhNewGroupsOf9->{\$group}};

# Delete the current cell key from the list of affected ce
+lls
# for this group of nine.
#
@{\$rhNewAffected->{\$group}} =
grep {\$_ !~ /\$currentCellKey/} @{\$rhNewAffected->{\$grou
+p}};

# Now update the possible numbers for each remaining empty
+ cell
# in this group of nine.
#
foreach my \$cellKey (@{\$rhNewAffected->{\$group}})
{
@{\$rhNewEmptyCells->{\$cellKey}} =
grep /\$rxEliminate/, @{\$rhNewEmptyCells->{\$cellKey}
+};
}
}

# Now call findSolutions() recursively with the modified data
# structures and the next cell to examine.
#
findSolutions(\$rlNewGrid, \$rhNewGroupsOf9, \$rhNewEmptyCells,
\$rhNewAffected, nextCellKey(\$rhNewEmptyCells));
}

# Return now that we have tried all possibilities.
#
return;
}

#
# -:-:-:- End of findSolutions() -:-:-:-
#

#   -------
sub getKeys
#   -------

# Subroutine to generate the keys into the \$rhGroupsOf9 anonymous
# hash for a given cell row and column and return a list reference.
#
{
my(\$row, \$col) = @_;
my \$rowKey = "r\$row";
my \$colKey = "c\$col";
my \$blockKey = "b" . int(\$row / 3) * 3 . int(\$col / 3) * 3;
return [\$rowKey, \$colKey, \$blockKey];
}

#
# -:-:-:- End of getKeys() -:-:-:-
#

#   --------------
sub groupPossibles
#   --------------

# Subroutine to return a reference to a list of possible numbers for
# any empty cells in a given row, column or 3x3 block
#
{
# Get puzzle grid and group of 9 key. Initialise a list of numbers
# found for this group. Test whether we are dealing with a row,
# column or block.
#
my(\$rlGrid, \$key) = @_;
my @found = ();
if(\$key =~ /r(\d)/)
{
# It's a row, move along the row pushing any numbers found
# onto the list.
#
my \$row = \$1;
foreach my \$col (0 .. 8)
{
next if \$rlGrid->[\$row]->[\$col] eq ' ';
push @found, \$rlGrid->[\$row]->[\$col];
}
}
elsif(\$key =~ /c(\d)/)
{
# It's a column so move down this time.
#
my \$col = \$1;
foreach my \$row (0 .. 8)
{
next if \$rlGrid->[\$row]->[\$col] eq ' ';
push @found, \$rlGrid->[\$row]->[\$col];
}
}
elsif(\$key =~ /b(\d)(\d)/)
{
# This one's a 3x3 block. Traverse block by columns within
# rows
#
my \$row = \$1;
my \$col = \$2;
for (
my \$blockRow = \$row;
\$blockRow < \$row + 3;
\$blockRow ++)
{
for (
my \$blockCol = \$col;
\$blockCol < \$col + 3;
\$blockCol ++)
{
next if \$rlGrid->[\$blockRow]->[\$blockCol] eq ' ';
push @found, \$rlGrid->[\$blockRow]->[\$blockCol];
}
}
}
else
{
# If we get here then the row/column/block argument is duff.
#
die "groupPossibles(): key not recognised: \$key\n";
}

# Set up a hash with all digits from 1 to 9 as keys. Then delete
# a hash slice of those numbers already found. The remaining keys
# are the possible numbers so return them as a list reference.
#
my %possibles = ();
\$possibles{\$_} ++ for (1 .. 9);
delete @possibles{@found};
return [keys %possibles];
}

#
# -:-:-:- End of groupPossibles() -:-:-:-
#

#   -----------
sub nextCellKey
#   -----------

# Subroutine to return the key into the empty cells hash of the next
# cell to be examined, or undef if there are no empty cells left. Each
# cell is examined to see how many numbers there are possible for it
# and the results are sorted so that those with the fewest are chosen
# next.
#

{
# Get anonymous hash of empty cells, return undef if there are
# no empty cells left,
#
my \$rhEmptyCells = shift;
return undef unless my @keys = keys %\$rhEmptyCells;

# Sort the empty cell into ascending count of possible numbers so
# that cells with fewest possibilities are first, returning the
# first element of the sorted list of keys.
#
return
(
map {\$_->[0]}
sort {\$a->[1] <=> \$b->[1]}
map {[\$_, scalar @{\$rhEmptyCells->{\$_}}]}
@keys
)[0];
}

#
# -:-:-:- End of nextCell() -:-:-:-
#

#   ---------
sub printGrid
#   ---------

# Subroutine to print the supplied grid to STDOUT with formatting to
# improve readability.
#

{
# Get grid to print.
#
my \$rlGrid = shift;

# Print top two lines of the grid that form just the top border an
+d
# the first of the column separators. Initialise row count.
#
print "\n", \$boldRowSep, \$colSep;
my \$rowNo = 0;

# Iterate over the rows in the puzzle grid calling the printRow
# routine to output the line with numbers in.
#
foreach my \$rlRow (@\$rlGrid)
{
printRow(\$rlRow, \$rowNo);

# Increment row number. Print a column separator then a light
# or bold row separator depending whether we have just done a
# block of three rows. Print another column separator ready
# the next row of data unless we are at the end of the grid.
#
\$rowNo ++;
print \$colSep, \$rowNo % 3 ? \$lightRowSep : \$boldRowSep;
print \$colSep unless \$rowNo == 9;
}

# Print a newline after the grid then return.
#
print "\n";
return;
}

#
# -:-:-:- End of printGrid() -:-:-:-
#

#   --------
sub printRow
#   --------

# Subroutine to print the grid rows that contain the actual numbers of
# the puzzle. If the number to be printed in a particular cell is one
# that was set at the beginning, it is printed in bold to stand out.
#

{
# Get a reference to the row to be printed and it's number so that
# the \$rlInitialNos list of lists can be queried. Print the left
# edge of the grid. Initialise column number.
#
my(\$rlRow, \$rowNo) = @_;
print " " . BOLD . "|" . RESET;
my \$colNo = 0;

# Iterate along the row printing each number, bold or otherwise, i
+n
# the correct column with the relevant separator between.
#
foreach my \$col (@\$rlRow)
{
print "  ";
print \$rlInitialNos->[\$rowNo]->[\$colNo] ?
BOLD . \$col . RESET :
\$col;
\$colNo ++;
print \$colNo % 3 ?
"  |" :
"  " . BOLD . "|" . RESET;
}

# Print newline to end the row and return.
#
print "\n";
return;
}

#
# -:-:-:- End of printRow() -:-:-:-
#

#   ------------
sub replicateHoL
#   ------------

# Subroutine to replicate a hash of lists structure as found in the
# \$rhGroupsOf9 and \$rhEmptyCells anonymous hashes and return a referen
+ce
# to a new hash of lists containing the same data.
#
{
# Get original grid, initialise the copy.
#
my \$rhOriginal = shift;
my \$rhReplica = {};

# Iterate over the keys of the original, setting the values of
# the replica to anonymous lists containing the de-referenced
# contents of the original's lists.
#
foreach my \$key (keys %\$rhOriginal)
{
\$rhReplica->{\$key} = [@{\$rhOriginal->{\$key}}];
}

# Return the replica hash of lists.
#
return \$rhReplica;
}

#
# -:-:-:- End of replicateHoL() -:-:-:-
#

#   -------------
sub replicateGrid
#   -------------

# Subroutine to replicate the supplied grid and return a reference to
+a
# new list of lists containing the same data.
#
{
# Get original grid, initialise the copy.
#
my \$rlOriginal = shift;
my \$rlReplica = [];

# Iterate over the rows in the original pushing a reference to a n
+ew
# list onto the replica list of lists containing the dereferenced
# contents of the original row.
#
foreach my \$row (@\$rlOriginal)
{
push @\$rlReplica, [@\$row];
}

# Return the completed grid replica.
#
return \$rlReplica;
}

#
# -:-:-:- End of replicateGrid() -:-:-:-
#

#   ------------
sub validateGrid
#   ------------

# Subroutine to validate the puzzle grid just read from data file.
#

{
# Get grid to validate. Initialise hash that will be used to
# hold the numbers found in each row, column or block so that
# duplicate numbers can be spotted.
#
my \$rlGrid = shift;
my(\$row, \$col, %numbersSeen);

# First, examine grid row by row for duplicates.
#
for \$row (0 .. 8)
{
# Reset numbers seen hash for each row; move along, column
# by column, incrementing hash entry for numbers seen. Ignore
# blank cells.
#
%numbersSeen = ();
for \$col (0 .. 8)
{
next if \$rlGrid->[\$row]->[\$col] eq " ";
\$numbersSeen{\$rlGrid->[\$row]->[\$col]} ++;
}

# Now check each hash entry for multiple numbers. Return an
# error string if a multiple is found.
#
for (keys %numbersSeen)
{
return "Row @{[\$row + 1]} has more than one \$_" if
\$numbersSeen{\$_} > 1;
}
}

# Do the same for columns.
#
for \$col (0 .. 8)
{
# Reset hash for each column this time; move down column, row
+by
# row.
#
%numbersSeen = ();
for \$row (0 .. 8)
{
next if \$rlGrid->[\$row]->[\$col] eq " ";
\$numbersSeen{\$rlGrid->[\$row]->[\$col]} ++;
}

# Again, check for multiples, returning an error string if
# appropriate.
#
for (keys %numbersSeen)
{
return "Column @{[\$col + 1]} has more than one \$_" if
\$numbersSeen{\$_} > 1;
}
}

# Now examine the 3x3 blocks. Check in the order top-left, top-
# centre, top-right, middle-left, middle-centre, middle-right,
# bottom-left, bottom-centre, bottom-right.
#
my @blockNames = qw(
Top-left
Top-centre
Top-right
Middle-left
Middle-centre
Middle-right
Bottom-left
Bottom-centre
Bottom-right);

# Take every third column within every third row as the top-left
# cell in each of our 3x3 blocks.
#
for \$row (0, 3, 6)
{
for \$col (0, 3, 6)
{
# Reset hash, get current block name.
#
%numbersSeen = ();
my \$blockname = shift @blockNames;

# For this block, move across the three columns within
# the three rows recording which numbers we see.
#
for (
my \$blockRow = int(\$row / 3) * 3;
\$blockRow < (int(\$row / 3) + 1) * 3;
\$blockRow ++)
{
for (
my \$blockCol = int(\$col / 3) * 3;
\$blockCol < (int(\$col / 3) + 1) * 3;
\$blockCol ++)
{
next if \$rlGrid->[\$blockRow]->[\$blockCol] eq " ";
\$numbersSeen{\$rlGrid->[\$blockRow]->[\$blockCol]} ++
+;
}
}

# Check, and return error string if multiple found. Only
# detects first error, there may be more.
#
for (keys %numbersSeen)
{
return "\$blockname block has more than one \$_" if
\$numbersSeen{\$_} > 1;
}
}
}

# If all tests have been passed, return 0 (false) so that no error
# is flagged.
#
return 0;
}

#
# -:-:-:- End of validateGrid() -:-:-:-
#
[download]```

It reads the puzzle to be solved from a file specified on the command line and here's an example using the same puzzle grid as Jenda used.

```5...7.682
...596...
.........
....8..49
.36......
.........
..8..7..1
..3..4..7
64.3...2.
[download]```
It seems to be a bit quicker than Jenda's solver but, as I've said, the guessing is somewhat optimised and it wasn't anything like as fast when first written.

Cheers,

JohnGG

Log In?
 Username: Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://600550]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (5)
As of 2022-01-22 15:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
In 2022, my preferred method to securely store passwords is:

Results (63 votes). Check out past polls.

Notices?