Suduko solver

There are probably tons of these already available, but here is a quick suduko solver (in Perl):

#! /usr/bin/perl

# Example:
#
# echo $'      2  \n  1 9  4 \n 2 1 5  9\n3     6  \n  68 41 5\n  427 8  \n   51    \n     7 3 \n79    5  '| perl suduko-solve.pl
#

use strict;
use warnings;

my $s = read_soduku();

my $res= solve($s);

if($res) {
  print_soduku($res);
  print "Got it!\n";
} else {
  print "Failed :-(\n";
}

exit 0;

sub solve {
  my ($s)= @_;

  my $res= try_solve($s);

  return $s if $res eq 'SOLVED';

  return undef if $res eq 'FAIL';

  # Make a guess, backtracking if we were wrong.
  # Try to find some field where there are only two possibilities.
  my ($a, $b);

 OUTER:
  for my $i (0..8) {
  INNER:
    for my $j (0..8) {
      next INNER if keys(%{$s->[$i][$j]}) == 1;
      if(keys(%{$s->[$i][$j]}) == 2) {
        ($a,$b)= ($i,$j);
        last OUTER;
      } elsif(!defined($a)) {
        ($a,$b)= ($i,$j);
      }
    }
  }

  die "Internal?!?" unless defined($a);

  for my $choice (keys %{$s->[$a][$b]}) {
    my $s_copy = [ map { [ map { { %$_ } } @$_ ] } @$s ];
    $s_copy->[$a][$b] = { $choice => 1 };
    my $res= solve($s_copy);
    return $res if defined($res); # Got it!
  }
  return undef;                 # Failed.
}

sub read_soduku {
  my $s= [ ];

  for(my $i = 0; $i < 9; $i++) {
    my $x = <STDIN>;
    chomp($x);
    if(length($x) < 9) {
      print STDERR "Short line: '$x'\n";
      redo;
    }
    for(my $j = 0; $j < 9; $j++) {
      my $entry= substr($x, $j, 1);
      $s->[$i][$j] = { map(($_ => 1), ($entry eq ' ' ? (1..9) : ($entry))) };
    }
  }

  return $s;
}

sub print_soduku {
  my ($s) = @_;
  for(my $i = 0; $i < 9; $i++) {
    print "---------------------\n" unless $i % 3;
    for(my $j= 0; $j < 9; $j++) {
      print "|" unless $j % 3;
      print((keys(%{$s->[$i][$j]}) > 1 ? ' ' : keys(%{$s->[$i][$j]})),
            ($j == 8 ? "|\n" : " "));
    }
  }
  print "---------------------\n";
}

sub try_solve {
  my ($s)= @_;

  my $done;
  my $progress;

  do {
    $done = 1;                 # Set false when non-determined field found
    $progress= undef;

    for(my $i = 0; $i < 9; $i++) {
      for(my $j = 0; $j < 9; $j++) {
        my $x = $s->[$i][$j];
        return 'FAIL' if keys(%$x) == 0;
        $done = undef if keys(%$x) > 1;
        my $h1= { %$x };
        my $h2= { %$x };
        my $h3= { %$x };
        for(my $a = 0; $a < 9; $a++) {
          if($a != $i) {
            my $y = $s->[$a][$j];
            delete $h1->{$_} for keys(%$y);
            if(keys %$y == 1) {
              $progress = 1 if delete $x->{(keys(%$y))[0]};
            }
          }
          if($a != $j) {
            my $y = $s->[$i][$a];
            delete $h2->{$_} for keys(%$y);
            if(keys %$y == 1) {
              $progress = 1 if delete $x->{(keys(%$y))[0]};
            }
          }
          my $b = 3*int($i/3) + int($a / 3);
          my $c = 3*int($j/3) + $a % 3;
          if($b != $i || $c != $j) {
            my $y = $s->[$b][$c];
            delete $h3->{$_} for keys(%$y);
            if(keys %$y == 1) {
              $progress = 1 if delete $x->{(keys(%$y))[0]};
            }
          }
        }
        return 'FAIL' if keys(%$h1) > 1 || keys(%$h2) > 1 || keys(%$h3) > 1;
        if(keys(%$h1) == 1) {
          delete($x->{$_}) for grep(!$h1->{$_}, keys %$x);
        } elsif(keys(%$h2) == 1) {
          delete($x->{$_}) for grep(!$h2->{$_}, keys %$x);
        } elsif(keys(%$h3) == 1) {
          delete($x->{$_}) for grep(!$h3->{$_}, keys %$x);
        }
      }
    }
  } while(!$done && $progress);

  return $done ? 'SOLVED' : 'UNSOLVED';
}

I wanted to use strategy rather than brute force (not sure what the complexity of that would be; the above seems to solve puzzles in a split second). Strategies are

• If a digit is already in a row/column/square, it cannot occur a second time.
• A digit is known to occur in a field if it cannot occur in any of the 8 other fields of a row/column/square.

These are not sufficient to solve (all) puzzles. Here is another example strategy: If we know in some 3×3 square that some particular digit can only occur in a particular row/column, then that digit can not occur in that digit/column in any other square.

However, at this point I just added a quick backtracking step. It seems the implemented strategies are sufficiently close to a full solution that only very little backtracking is needed, and a solution is usually arrived at instantly.

This example took perhaps an hour to put together. It is a nice example of the usefulness of learning Perl. Because Perl is well suited for a very wide range of programming tasks, the investment needed to learn the language pays off very well. Perl can be used for 2-minute one-liners like this to massage a .h file:

perl -nle 'print "#define prefix_$1 $1" if /^\s*[a-zA-z0-9_ ]+\s+([_a-zA-Z0-9]+)\s*\(/ ' *.h

It can be used for quick hacks like this suduko solver. And it can be used for full-scale application development.

If I were to use different languages for these different tasks, I would have less time to spend on learning each one, and thus would work less efficiently at all of them.