Your skill will accomplishwhat the force of many cannot PerlMonks

### Sudoku puzzles solved using Regular Expressions

by ikegami (Pope)
 on Jun 29, 2005 at 20:33 UTC ( #471168=CUFP: print w/replies, xml ) Need Help??

davido brought up the subject of Sudoku puzzles (info, info) in the ChatterBox. He asked: "I've never used the RE engine for puzzles. anyone have any idea how such would be implemented?" The solution below solves Sudoku puzzles using the RE.

```#!/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;

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 \$spot = substr(\$grid_h, \$_[0]*\$size+\$_[1], 1);
return 1 if \$spot eq \$_[2];
return   if \$spot ne '_';

return if index(substr(\$grid_h, \$_[0] * \$size, \$size), \$_[2]) >= 0;
return if index(substr(\$grid_v, \$_[1] * \$size, \$size), \$_[2]) >= 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
========
283156749
157498632
316742958
471835296
529683417
642319875
894567321
738921564
965274183

Comment: This solution localizes the entire grid twice for every attempt, so it uses a lot of memory. It does this to speed up valid. I'm not sure if the cost is worth the benefit. The alternative would be to keep the grid as an array, and just localize the array element.

Comment: This program supports grids of any size (well, 4x4, 9x9, 16x16, ...), although minor tweaking will be needed to generate single character values other than 0-9 for sizes greater than 9x9.

This post is related to this one.

Replies are listed 'Best First'.
Re: Sudoku puzzles solved using Regular Expressions
by davido (Archbishop) on Jun 30, 2005 at 01:07 UTC

I'm going to have to wade through that for a few hours. ;).

By the way, when I first saw a Sudoku puzzle, in my mind I thought, "I wonder if these could be solved by iterating over the eigenstates of anys with various tests using Quantum::Superpositions to isolate possibilities and eliminate non-possibilities." While thinking through it I did some searching here at the Monastery and found someone's already been there and done that: SuDoKu solver.

While Googling I also discovered Sudoku solver in four lines (off site), written in Perl, along with an explanation. It seems someone's been up to some serious golf.

Fun stuff.

Dave

Re: Sudoku puzzles solved using Regular Expressions
by GrandFather (Sage) on Jun 30, 2005 at 00:59 UTC

Neat. A pity the answer is wrong :-).

Consider the top left cell:

```283
157
316

3 repeated and 1 repeated. That's not the way the game is played.

Perl is Huffman encoded by design.

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.

```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

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.
Re: Sudoku puzzles solved using Regular Expressions
by Anonymous Monk on Jun 28, 2010 at 09:30 UTC
Here's a pointer to a solution that only uses a pure regular expression (not using (?{ })/(??{ }) constructs): Sudoku by Regexp.

Create A New User
Node Status?
node history
Node Type: CUFP [id://471168]
Approved by hardburn
Front-paged by hardburn
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (13)
As of 2018-06-20 16:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Should cpanminus be part of the standard Perl release?

Results (116 votes). Check out past polls.

Notices?