Re^2: Sudoku puzzles solved using Regular Expressions

[ikegami]

Hot diggity! I didn't read the puzzle definition closely enough!

Well, I could easily fix that by updating valid(). Give me a few minutes and I'll update this node with a solution that solves the puzzle accurately.

Update: hum... I'm getting protection faults :( I think I can't use regexps in valid() when it's called from within a regexp.

Update: Fine, I won't use regexp in valid(). What follows is my updated solution. The only difference the var $regsz and valid() has an additional check.

#!/usr/bin/perl
    
use strict;
use warnings;


my @grid = (
   [qw(  _ _ _ | 1 _ _ | 7 4 _  )],
   [qw(  _ 5 _ | _ 9 _ | _ 3 2  )],
   [qw(  _ _ 6 | 7 _ _ | 9 _ _  )],
   #     ------+-------+-------
   [qw(  4 _ _ | 8 _ _ | _ _ _  )],
   [qw(  _ 2 _ | _ _ _ | _ 1 _  )],
   [qw(  _ _ _ | _ _ 9 | _ _ 5  )],
   #     ------+-------+-------
   [qw(  _ _ 4 | _ _ 7 | 3 _ _  )],
   [qw(  7 3 _ | _ 2 _ | _ 6 _  )],
   [qw(  _ 6 5 | _ _ 4 | _ _ _  )],
);

@$_ = grep { /[^|]/ } @$_
   foreach @grid;


my $size = @grid;
my $regsz = $size ** 0.5;


our $grid_h = '';
our $grid_v = '';
foreach    my $y (0 .. $#grid) {
   foreach my $x (0 .. $#grid) {
      $grid_h .= $grid[$y][$x];
      $grid_v .= $grid[$x][$y];
   }
}

our $match_grid;


sub print_grid {
   local $_ = $_[0];
   local $\ = "\n";
   print substr($_, 0, $size, '')
      while length;
}


sub valid {
   my ($y, $x, $n) = @_;
   my $spot = substr($grid_h, $y*$size+$x, 1);
   return 1 if $spot eq $n;
   return   if $spot ne '_';

   return if index(substr($grid_h, $y*$size, $size), $n) >= 0;
   return if index(substr($grid_v, $x*$size, $size), $n) >= 0;

   my $ry = int($y / $regsz) * $regsz;
   my $rx = int($x / $regsz) * $regsz;
   foreach my $ry_ ($ry .. $ry+$regsz-1) {
      return if index(substr($grid_h, $ry_*$size+$rx, $regsz), $n) >= 
+0;
   }

   return 1;
}


my $re = '';

my $fail = 'x';

foreach    my $y (0 .. $#grid) {
   foreach my $x (0 .. $#grid) {
      my @attempts;
      foreach my $n (1 .. @grid) {

         # The following statment simplifies the regexp,
         # but makes it specific to the puzzle.
         # Comment it out to make the regexp reusable.
         next unless valid($y, $x, "$n");

         push(@attempts,
            "(?(?{ !valid($y, $x, '$n') })$fail)" .
            "(?{ " .
            "local \$grid_h = \$grid_h; " .
            "substr(\$grid_h, @{[ $y*$size+$x ]}, 1, '$n'); " .
            "local \$grid_v = \$grid_v; " .
            "substr(\$grid_v, @{[ $x*$size+$y ]}, 1, '$n'); " .
            "})"
         );
      }

      $re .= "(?:\n   " . join(" |\n   ", @attempts) . "\n)\n";
   }
}


$re .= "(?{ \$match_grid = \$grid_h })\n";

{
   use re 'eval';
   $re = qr/$re/x;
}

# print($re);

"" =~ $re
   or die("No solution.\n");

print("Original\n");
print("========\n");
print_grid($grid_h);
print("\n");
print("Solution\n");
print("========\n");
print_grid($match_grid);

Original
========
___1__74_
_5__9__32
__67__9__
4__8_____
_2_____1_
_____9__5
__4__73__
73__2__6_
_65__4___

Solution
========
392185746
857496132
146732958
479851623
528673419
613249875
284567391
731928564
965314287

[GrandFather]

I had a play with your code to try and fix the problem, but headed off in a much less elegant direction than you did by adding a $grid_c vector and another nested loop.

It got rather messy rather quickly. :-(

[ikegami]

Yeah, there are diminishing returns to adding more shortcuts.

Technically, $grid_v is not needed at all.

return if index(substr($grid_v, $x*$size, $size), $n) >= 0;

can be written as

foreach my $y_ (0 .. $size-1) {
   return if substr($grid_h, $y_*$size+$x, 1) eq $n;
}

I just thought the former would be faster, even though we must constantly make copies of $grid_v in addition to $grid_h.