Perl: the Markov chain saw PerlMonks

### Sudoku Solver, and web interface.

by JediWizard (Deacon)
 on Jun 20, 2006 at 19:57 UTC ( #556520=CUFP: print w/replies, xml ) Need Help??

While I was bored the other day, I decided to see if I could come up with a way to programatically solve sudoku puzzles in perl. I have a sudoku game on my palm, and I wanted a program that could solve puzzles at all four difficulty levels. Although I was able to solve puzzles at the first three difficulty setting with little trouble, the "expert" level puzzle forced me to use an algorithm with which I am not satisfied. Below you will find my code.

If you know a better algorithm to replace my poorly named "level4" logic, I'd love to hear about it.

```#!/usr/local/bin/perl -w
use strict;
use CGI qw(:standard);

print "<link rel='stylesheet' type='text/css' href='/sudoku.css' /></h
+ition:relative;top:20%'>Sudoku Solver</span></div>\n";

my(%ParamHash) = ();
foreach my \$param (param()){
\$ParamHash{\$param} = param(\$param);
}

if(exists(\$ParamHash{action}) && \$ParamHash{action} eq 'solve'){
my \$board = Sudoku::Board->new();
foreach my \$sq (grep(/^sq/, keys %ParamHash)){
next if(\$ParamHash{\$sq} < 1);
\$sq=~m/(\d+)/;
my \$sqn = \$1;
print STDERR "\$sqn \$ParamHash{\$sq}\n";
\$board->get_square(\$sqn)->assign_value(\$ParamHash{\$sq});
}

&level1(\$board);

print STDERR "Level 1 logic complete\n";

if(! \$board->is_solved){
print STDERR "Begining level 2 logic\n";
&level2(\$board);
&level1(\$board);
}

if(! \$board->is_solved){
&level3(\$board);
&level2(\$board);
&level1(\$board);
}

if(! \$board->is_solved){
&level4(\$board);
&level3(\$board);
&level2(\$board);
&level1(\$board);
}

# Display Puzzle

print "<div class='board'>\n";
my \$sqn = 0;
for(my \$r=1; \$r<10; \$r++){
print "<div class='r\$r'>\n";
for(my \$i = 1; \$i<10; \$i++){
my \$sq = \$board->get_square(\$sqn);
print "<div class='c\$i'><span style='align:center;position
+:relative;top:30%'>";
if(exists(\$sq->{value})){
print \$sq->{value};
}else{
print "&nbsp;";
}
print "</span></div>\n";
\$sqn++;
}
print "</div>\n";
}
print "</div>\n";

}else{
print "<form name='board' method='post'>\n";
print <<EOF;
<script language='javascript'>
function incrimentSquare(field, square)
{
var val = field.value;
val++;
if(val == 10){
val = 0;
square.innerHTML='';
}else{
square.innerHTML = val;
}
field.value = val;
}
</script>
EOF

print "<div class='board'>\n";
my \$sqid=0;
print "<span id='davey'></span>\n";
for(my \$r=1; \$r<10; \$r++){
print "<div class='r\$r'>\n";
for(my \$i = 1; \$i<10; \$i++){
print "<div class='c\$i' onclick=\"javascript:incrimentSqua
+re(document.forms.board.sq\$sqid, document.getElementById('sq\$sqid'))\
+"><span id='sq\$sqid' style='align:center;position:relative;top:30%'><
+/span>";
print "<input type='hidden' name='sq\$sqid' value='0' />";
print "</div>\n";
\$sqid++;
}
print "</div>\n";
}
print "</div>\n";
print "<input type='hidden' name='action' value='solve' />\n";
print "<input type='button' value='Solve it' onclick='javascript:d
+ocument.forms.board.submit();' />\n";
print "</form>\n";
}

print "</center>\n</body>\n</html>\n";

sub level1
{
my \$board = shift;
my \$action = 1;

while(\$action){
\$action = 0;
foreach my \$offset (0 .. 80){
my \$sq = \$board->get_square(\$offset);
next if(\$sq->{value});
my(@ava) = \$sq->available_values();
if(scalar(@ava) == 1){
\$sq->assign_value(\$ava[0]);
\$action++
}
}
}
}

sub level2
{
my \$board = shift;
my \$action = 1;

INFI: while(\$action){
\$action = 0;
my(@units) = (\$board->get_rows, \$board->get_columns, \$board->g
+et_cubes);
UNI: foreach my \$unit (sort({\$a->available_values <=> \$b->avai
+lable_values} @units)){
my(%ava) = \$unit->get_squares_by_number();
my(@one) = grep({ scalar(@{ \$ava{\$_} }) == 1 } keys %ava);
if(scalar(@one)){
\$action++;
foreach my \$val (@one){
if(! \$ava{\$val}[0]->assign_value(\$val)){
print STDERR "Warning Assign Value Failed!\n";
}
}
&level1(\$board);
last INFI if(\$board->is_solved());
next INFI;
}
}
}
}

sub level3
{
my \$board = shift;
my(@squares) = grep({scalar(\$_->available_values) < 3} \$board->get
+_all_squares());
my(%table, %groups);
foreach my \$sq (@squares){
push @{ \$table{ join(';', \$sq->available_values) } }, \$sq;
}
foreach my \$combo (grep({scalar(@{ \$table{\$_} }) > 1} keys %table)
+){
COMBO: for(my \$si=0; \$si<\$#{ \$table{\$combo} }; \$si++){
for(0 .. 2){
if(\$table{\$combo}[\$si]{groups}[\$_] == \$table{\$combo}[(
+\$si+1)]{groups}[\$_]){
push @{ \$groups{\$combo} }, \$table{\$combo}[\$si]{gro
+ups}[\$_];
last COMBO;
}
}
}
}
foreach my \$cm (keys %groups){
my(\$num1, \$num2) = split(/;/, \$cm);
foreach my \$gr (@{ \$groups{\$cm} }){
foreach my \$sq (\$gr->get_members()){
my(@left) = grep({\$_ != \$num1 && \$_ != \$num2} \$sq->ava
+ilable_values);
if(scalar(@left) == 1){
\$sq->assign_value(\$left[0]);
}
}
}
}
}

sub level4
{
my \$board = shift;

my(@units) = sort({\$a->available_values <=> \$b->available_values}
+(\$board->get_rows, \$board->get_columns, \$board->get_cubes));

foreach my \$unit (@units){
foreach my \$sq (grep({! exists(\$_->{value}) } \$unit->get_membe
+rs)){
my(@values) = \$sq->available_values();
my(@groups) = @{ \$sq->{groups} };
foreach my \$val (@values){
my \$gcc = 0;
GROUP: foreach my \$gr (@groups){
my(%vbn) = \$gr->get_squares_by_number();
foreach my \$osq (grep({\$_ != \$sq} @{\$vbn{\$val}})){
if(scalar(\$osq->available_values) < 3){
\$gcc++;
next GROUP;
}
}
foreach my \$v (keys %vbn){
next if(\$v == \$val);
next if(scalar(grep({\$_ != \$sq} @{ \$vbn{\$v} })
+) > 1);
\$gcc++;
next GROUP;
}
}
if(\$gcc == 3){
\$sq->assign_value(\$val);
return 1;
}
}
}
}
return 0;
}

package Sudoku::Square;

sub new
{
my \$proto = shift;
my(@groups) = @_;
\$proto = ref(\$proto) || \$proto;

my \$self = { groups => \@groups };

foreach (@{ \$self->{groups} }){
}

return bless \$self, \$proto;
}

sub available_values
{
my \$self = shift;
if(\$self->{value}){
return \$self->{value};
}

my(%values);
foreach my \$gr (@{ \$self->{groups} }){
foreach (\$gr->available_values()){
\$values{\$_}++;
#print STDERR "\$_ == \$values{\$_}\n";
}
}
#print STDERR join(", ", grep({\$values{\$_} == 3 } keys %values))."
+\n\n";
return grep({\$values{\$_} == 3 } keys %values);
}

sub assign_value
{
my \$self = shift;
my (\$value) = @_;
my @assigned = ();
foreach my \$gr (@{ \$self->{groups} }){
if(\$gr->take_value(\$value)){
push @assigned, \$gr;
}else{
foreach (@assigned){
\$_->relinquish_value(\$value);
}
return 0;
}
}

\$self->{value} = \$value;

return 1;
}

package Sudoku::Group;

sub new
{
my \$proto = shift;
\$proto = ref(\$proto) || \$proto;
my \$self = {};

my(%values);
@values{ 1 .. 9 } = (1 .. 9);
\$self->{Values} = \%values;

return bless \$self, \$proto;
}

{
my \$self = shift;
push @{ \$self->{squares} }, shift;
return 1;
}

sub get_square
{
my \$self = shift;
return \$self->{squares}[ \$_[0] ];
}

sub take_value
{
my \$self = shift;
my(\$value) = @_;

if(exists(\$self->{Values}{\$value})){
delete(\$self->{Values}{\$value});
return 1;
}else{
return 0;
}

return 0;
}

sub available_values
{
my \$self = shift;
return keys %{ \$self->{Values} };
}

sub relinquish_value
{
my \$self = shift;

my(\$value) = @_;
\$self->{Values}{\$value} = \$value;

return 1;
}

sub get_squares_by_number
{
my \$self = shift;
my(%ava);
foreach my \$sq (\$self->get_members()){
next if(\$sq->{value});
foreach my \$val (\$sq->available_values){
push @{ \$ava{\$val} }, \$sq;
}
}
return %ava;
}
sub get_members
{
my \$self = shift;
return @{ \$self->{squares} };
}

package Sudoku::Board;

sub new
{
my \$proto = shift;
\$proto = ref(\$proto) || \$proto;
my \$self = {};
\$self->{Rows}    = [new Sudoku::Group, new Sudoku::Group, new Sudo
+ku::Group, new Sudoku::Group, new Sudoku::Group, new Sudoku::Group, n
+ew Sudoku::Group, new Sudoku::Group, new Sudoku::Group];
\$self->{Columns} = [new Sudoku::Group, new Sudoku::Group, new Sudo
+ku::Group, new Sudoku::Group, new Sudoku::Group, new Sudoku::Group, n
+ew Sudoku::Group, new Sudoku::Group, new Sudoku::Group];
\$self->{Cubes}   = [new Sudoku::Group, new Sudoku::Group, new Sudo
+ku::Group, new Sudoku::Group, new Sudoku::Group, new Sudoku::Group, n
+ew Sudoku::Group, new Sudoku::Group, new Sudoku::Group];

for(my \$cu=0; \$cu < 9; \$cu++){
my \$cube = \$self->{Cubes}[\$cu];
my \$col_off = ((\$cu % 3) * 3);
my \$row_off = (int(\$cu/3) * 3);
for(my \$r = 0; \$r < 3; \$r++){
my \$row = \$self->{Rows}[(\$r + \$row_off)];
for(my \$c = 0; \$c < 3; \$c++){
my \$sq = Sudoku::Square->new(\$row, \$self->{Columns}[(\$
+c + \$col_off)], \$cube);
}
}
}

return bless \$self, \$proto;
}

sub get_square
{
my \$self = shift;
my(\$sq_num) = @_;
return \$self->{Rows}[(int(\$sq_num/9))]->get_square((\$sq_num % 9));
}

sub get_all_squares
{
my \$self = shift;
return map({ \$_->get_members } \$self->get_rows);
}

sub get_rows
{
my \$self = shift;
return @{ \$self->{Rows} };
}

sub get_columns
{
my \$self = shift;
return @{ \$self->{Columns} };
}

sub get_cubes
{
my \$self = shift;
return @{ \$self->{Cubes} };
}

sub is_solved
{
my \$self = shift;

foreach my \$row (@{ \$self->{Rows} }){
if(scalar(\$row->available_values) > 1){
return 0;
}
}
return 1;
}

The web interface is fairly easy to use. It was tested with Firefox on windows. Please forgive the distortions when the window is scaled.

Caveat: If only given a few squares as a starting point, it will hang. For best results, give it a puzzle with only one possible solution.

Update: Forgot to post my css (doesn't look like much without that)

```<!-- sudoku.css -->
.c1{
position:absolute;
top:0;
left:0;
border-right:thin solid #000000;
border-left:medium solid #000000;
width:11%;
height:100%;
}
.c2{
position:absolute;
top:0;
left:11%;
border-right:thin solid #000000;
width:11%;
height:100%;
}
.c3{
position:absolute;
top:0;
left:22%;
border-right: medium solid #000000;
width:11%;
height:100%;
}
.c4{
position:absolute;
top:0;
left:33%;
border-right:thin solid #000000;
width:11%;
height:100%;
}
.c5{
position:absolute;
top:0;
left:44%;
border-right:thin solid #000000;
width:11%;
height:100%;
}
.c6{
position:absolute;
top:0;
left:55%;
border-right: medium solid #000000;
width:11%;
height:100%;
}
.c7{
position:absolute;
top:0;
left:66%;
border-right:thin solid #000000;
width:11%;
height:100%;
}
.c8{
position:absolute;
top:0;
left:77%;
border-right:thin solid #000000;
width:11%;
height:100%;
}
.c9{
position:absolute;
top:0;
left:88%;
border-right:medium solid #000000;
width:11.5%;
height:100%;
}
.e{
position:absolute;
left: 90;
top: 0;
width:11%;
}
.r1{
position:relative;
top:0%;
border-top:medium solid #000000;
width:100%;
height:11%;
}
.r2{
position:relative;
top:0%;
border-top:thin solid #000000;
width:100%;
height:11%
}
.r3{
position:relative;
border-top:thin solid #000000;
width:100%;
height:11%
}
.r4{
position:relative;
border-top:medium solid #000000;
width:100%;
height:11%
}
.r5{
position:relative;
border-top:thin solid #000000;
width:100%;
height:11%
}
.r6{
position:relative;
border-top:thin solid #000000;
width:100%;
height:11%
}
.r7{
position:relative;
border-top:medium solid #000000;
width:100%;
height:11%
}
.r8{
position:relative;
border-top:thin solid #000000;
width:100%;
height:11%
}
.r9{
position:relative;
border-top:thin solid #000000;
border-bottom:medium solid #000000;
width:100%;
height:10%
}
position:relative;
height:8%;
font-size:larger;
}
.board{
position:relative;
height: 90%;
width: 75%;
}

P.S. In case you could tell, I'm a bit of a css amature

They say that time changes things, but you actually have to change them yourself.

—Andy Warhol

Replies are listed 'Best First'.
Re: Sudoku Solver, and web interface.
by Jaap (Curate) on Jun 21, 2006 at 14:04 UTC
I'm too lazy to look at that huge slab of perl code but i can give you a tip for the css: in stead of writing
```.r1{
border: 1px dotted red;
}
.r2{
border: 1px dotted red;
}
You can write:
```.r1,.r2{
border: 1px dotted red;
}
That will shave some bytes off the css ;-)

Heh... Even I should have known that. Thanks.

They say that time changes things, but you actually have to change them yourself.

—Andy Warhol

Re: Sudoku Solver, and web interface.
by planetscape (Chancellor) on Jun 22, 2006 at 03:39 UTC

Create A New User
Node Status?
node history
Node Type: CUFP [id://556520]
Approved by Tanktalus
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (2)
As of 2021-06-23 17:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
What does the "s" stand for in "perls"? (Whence perls)

Results (121 votes). Check out past polls.

Notices?