Since it's slow like hell (but I've some ideas to speed it up)
Speeding it up turned out to be easier than I thought it was.
Below is reworked program that is dramatically faster that
the original. But first a table comparing running times of
three versions, the original, pure regex solution from the
parent node, the faster (still pure regex) solution presented
below, and the non-pure variant presented last year. The
latter is still the faster solution though.
Timings (values in wall clock seconds):
N Original Faster Non-pure
4 0.035 0.034 0.035
5 0.045 0.036 0.036
6 0.769 0.041 0.038
7 4.833 0.042 0.038
8 0.082 0.049
9 0.072 0.044
10 0.113 0.056
11 3.504 0.051
12 0.096
13 0.071
14 0.577
15 0.467
16 3.864
17 2.289
18 19.630
19 1.324
20 117.227
Before giving the program, some sample output:
$ ./queens -p -n 4
';,a1,a2,a3,a4,
;,b1,b2,b3,b4,
b1:,a3,a4,
b2:,a4,
b3:,a1,
b4:,a1,a2,
;,c1,c2,c3,c4,
c1:,a2,a4,b3,b4,
c2:,a1,a3,b4,
c3:,a2,a4,b1,
c4:,a1,a3,b1,b2,
;,d1,d2,d3,d4,
d1:,a2,a3,b2,b4,c3,c4,
d2:,a1,a3,a4,b1,b3,c4,
d3:,a1,a2,a4,b2,b4,c1,
d4:,a2,a3,b1,b3,c1,c2,
' =~
/^;.*,(\w+),.*
;.*,(\w+),.*
[^;]*\2:.*,\1[^;]*
;.*,(\w+),.*
[^;]*\3:.*,\1.*,\2[^;]*
;.*,(\w+),.*
[^;]*\4:.*,\1.*,\2.*,\3[^;]*
/
[a3 b1 c4 d2]
$ ./queens -n 8
[a8 b4 c1 d3 e6 f2 g7 h5]
And here's the program:
#!/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 @rows = 1 .. $nr_of_queens;
my @cols = ('a' .. 'z') [0 .. $nr_of_queens - 1];
sub a2i {ord ($_ [0]) - ord ('a') + 1}
sub i2a {chr ($_ [0] + ord ('a') - 1)}
# Given a square, return all non-attacked squares on columns to
# the *left* of the given square. (a1 is the lower left corner).
sub free {
my ($C, $R) = $_ [0] =~ /(\D)(\d+)/;
$C = a2i $C;
map {join "" => i2a ($_ -> [0]), $_ -> [1]}
grep {$_ -> [0] != $C &&
$_ -> [1] != $R &&
abs ($_ -> [0] - $C) != abs ($_ -> [1] - $R)}
map {my $c = a2i $_; map {[$c, $_]} @rows} @cols [0 .. $C - 1]
}
my ($str, $re) = ("", "");
foreach my $c (@cols) {
$str .= ";," . (join "," => map {"$c$_"} @rows) . ",\n";
$re .= ";.*,(\\w+),.*\n";
next if $c eq 'a';
map {$str .= "$_:," . join ("," => free ($_)) . ",\n"} map {"$c$_"
+} @rows;
my $C = a2i $c;
$re .= "[^;]*\\$C:" . join ("" => map {".*,\\$_"} 1 .. $C - 1) . "
+[^;]*\n";
}
if ($print || $Print) {
print "'$str' =~ \n/^$re/\n";
exit if $Print;
}
if (my @a = $str =~ /^$re/) {
print "[@a]\n";
}
__END__
Abigail