Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
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.

Comments welcome.

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 header(); print "<html>\n<head>\n<title>Sudoku Solver</title>\n"; print "<link rel='stylesheet' type='text/css' href='/sudoku.css' /></h +ead><body>\n<center><div class='header'><span style='align:center;pos +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} }){ $_->add_square($self); } 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; } sub add_square { 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% } .header{ 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

Comment on Sudoku Solver, and web interface.
Select or Download Code
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 (Canon) on Jun 22, 2006 at 03:39 UTC

Log In?
Username:
Password:

What's my password?
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 drinking their drinks and smoking their pipes about the Monastery: (7)
As of 2014-08-29 18:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (286 votes), past polls