Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
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 chilling in the Monastery: (8)
As of 2014-12-27 20:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (177 votes), past polls