More than a year ago, I posted in this section a way of solving the N-queens problem (place N queens on an NxN board such that no two queens attack each other) using a regex. However, the regex was full of (?{ }) and (?(?{ })|) constructs, so it wasn't a real regex, as it executed Perl code all the time.

I never came around explaining how it works, until yesterday when I gave a small talk at a local Perl mongers meeting. Driving home last night, I started realizing that the problem is solvable with pure regexes. No fancy (?{ }) or (?(?{ })|) constructs.

The program below solves the N-queens problem using a pure regex. It takes a few options: -n followed by a number indicates the size of the board, and if you use -p, it prints out the regex (and the string it matches against). -P only prints out the regex and string, but doesn't try to match it. Since it's slow like hell (but I've some ideas to speed it up), try -n 5 or -n 6. -n 8 (the default) takes a long time.

There's no much explaination (yet), but if you see the string and the regex, you can figure it out.

#!/usr/bin/perl

use strict;
use warnings 'all';
    
use Getopt::Long;
    
Getopt::Long::Configure ("bundling");
GetOptions ('p|print'    =>  \my $print,
            'P|Print'    =>  \my $Print,
            'n|number=i' => \(my $nr_of_queens = 8)
);

my $nr_of_rows = $nr_of_queens;
my $nr_of_cols = $nr_of_queens;
                            
my @rows = (1 .. $nr_of_rows);
my @cols = map {chr ($_ - 1 + ord 'a')} 1 .. $nr_of_cols;

# Return positions not attacked by a certain other position.
sub free {
    my $pos = shift;
    my ($col, $row) = $pos =~ /(\D+)(\d+)/;
    $col = ord ($col) - ord ('a') + 1;
    map {my $c = chr ($_ -> [0] - 1 + ord 'a'); "$c$_->[1]"}
        grep {$_ -> [0] != $col && $_ -> [1] != $row &&
              abs ($_ -> [0] - $col) != abs ($_ -> [1] - $row)}
        map {my $c = ord ($_) - ord ('a') + 1; map {[$c, $_]} @rows} @
+cols;
}

my $str = join "\n" => map {my $c = $_;
                            my $l = join "," => map {"$c$_"} @rows;
                            ",$l,"} @cols;
$str .= "\n;\n";

map {$str .= "$_:" . join ("," => free $_) . ",\n"}
     map {my $c = $_; map {"$c$_"} @rows} @cols;

    
my $re  = join "\n" => (".*,(\\w+),.*") x $nr_of_queens;
   $re .= "\n";
            
map {my $q = $_;
     $re .= "[\\x00-\\xFF]*\\n\\$q:";
     map {$re .= ".*\\$_,"} grep {$_ ne $q} 1 .. $nr_of_queens;
     $re .= ".*\n"} 1 .. $nr_of_queens;

if ($print || $Print) {     
    print "'$str' =~ \n/^$re/\n";
    exit if $Print;
}

if (my @a = $str =~ /^$re/) {
    print "[@a]\n"; 
}
    
__END__
[download]

Abigail