With the sudoku program I hacked together in the last post, I was able to solve the Irish Independent's Super Sudoku for three weeks running. But then, disaster! It turns out that sudoku puzzles can be pretty fiendish - they are still solvable with a very small set of given numbers.

So my initial logic, just continuously removing numbers that could not possibly be in a cell, did not solve all sudokus. Time for a rethink. After staring at the unsolved output for a while, it occurred to me that sometimes you end up with a set of cells in a vertical, horizontal or home square that are all unsolved, but where only one cell contains a certain number. So lets say the top three cells on the left are 123, 234, 234, with all others in the top row solved. Well then the top left cell must be 1. There are no other possibilities, it's the only place for that number. Now we're suckin' diesel.

For some reason, I think of this new operation as "reducing" the cell possibilities, so henceforth to the code:

sub reduceHome {
  my @cell = @{shift()};
  my $prow = shift;
  my $pcol = shift;

  my $valbin = $cell[$prow][$pcol];
  if( 1 == keys(%{$valbin}) ) {
    return;
  }

  my $foundval;
  for my $val (keys(%{$valbin})) {

    my $found = 0;
    for( my $r = $sqsize*floor($prow / $sqsize); 
         $r < $sqsize*floor(($prow+$sqsize) / $sqsize); 
         $r++ ) {

      for( my $c = $sqsize*floor($pcol / $sqsize); 
           $c < $sqsize*floor(($pcol+$sqsize) / $sqsize); 
           $c++ ) {

        if( $prow != $r || $pcol != $c ) {
          my $testbin = $cell[$r][$c];

          if( "" ne ${$testbin}{$val} ) {
            $found = 1;
          }
        }
      }
    }
    if( !$found ) {
      $foundval = $val;
      last;
    }
  }

  if( "" ne $foundval ) {
    for my $val (keys(%{$valbin})) {
      if( $val ne $foundval ) { 
        delete(${$valbin}{ $val });
      }
    }
  }
}

Yikes. Well what does this monstrosity do? Again I plead guilty to all charges of hacking and offer this code as final proof that Perl is meant to be written, not read. So this just runs through all the cells in the home square of a given cell: $prow, $pcol. The ugly nested for loop in the middle does that by keeping us within the bounds of the home square. So if we're cell 2,2 in a 3x3 sudoku, the home square is defined as all the cells in the range 0,0 - 3,3.

Now, as we run through the cells, if we come across a value $foundval, that is only in one cell, then we can delete all the other numbers from that cell. That's what the last for loop does in a rather pointless way - why not just create a new map with just one entry? I don't know, I was cut-n-pasting I guess.

This operation is also performed horizontally and vertically, so our main loop now does all this:

excludeHome(\@cell,$rowI,$colI);
excludeVertical(\@cell,$rowI,$colI);
excludeHorizontal(\@cell,$rowI,$colI);
reduceHome(\@cell,$rowI,$colI);
reduceVertical(\@cell,$rowI,$colI);
reduceHorizontal(\@cell,$rowI,$colI);

I'd say that's efficient alright. So did this help? You bet! I got another two weeks out of this baby. But, yeah, you guessed, still not enough. Even this code won't solve all sudokus. There's another trick that I came up with though, and we'll look at that the next time.

This post is part of a series on a Perl Suduko solver.