$ ./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] #### #!/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__