Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

comment on
( [id://3333]=superdoc: 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

In reply to Sudoku Solver, and web interface. by JediWizard

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others studying the Monastery: (6)
As of 2024-04-19 11:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found