Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

Sudoku Solver, and web interface.

by JediWizard (Deacon)
on Jun 20, 2006 at 19:57 UTC ( [id://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;
}

[download]

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%;
}

[download]

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;
}

    [download]
    You can write: 
    .r1,.r2{
  border: 1px dotted red;
}

    [download]
    That will shave some bytes off the css ;-)
[reply]
[d/l]
[select]

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

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

      —Andy Warhol

[reply]
[d/l]
Re: Sudoku Solver, and web interface.
by planetscape (Chancellor) on Jun 22, 2006 at 03:39 UTC
[reply]

Back to Cool Uses for Perl

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
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? • Last hour • Other CB clients
Other Users?
Others avoiding work at the Monastery: (3)
As of 2024-04-24 21:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found