http://qs321.pair.com?node_id=471213


in reply to Re: Sudoku puzzles solved using Regular Expressions
in thread Sudoku puzzles solved using Regular Expressions

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

Replies are listed 'Best First'.
Re^3: Sudoku puzzles solved using Regular Expressions
by GrandFather (Saint) on Jun 30, 2005 at 05:36 UTC

    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. :-(


    Perl is Huffman encoded by design.

      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.