Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Sudoku puzzles solved using Regular Expressions

by ikegami (Patriarch)
on Jun 29, 2005 at 20:33 UTC ( [id://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 (Cardinal) 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 (Saint) 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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://471168]
Approved by hardburn
Front-paged by hardburn
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others studying the Monastery: (6)
As of 2024-03-28 14:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found