The following is messy in that a few subroutine calls
are eliminated.
A coding optimization that I didn't look at, is making
N a variable. Constants don't seem to cost like routine
calls. Never thought much about it.
#!/usr/bin/perl -w
use strict;
# nqp -- solve the n-queens problem
use constant N => 10;
use constant VERBOSE => 0;
use constant DEBUG => 0; # boolean
# This solution uses an imaginary array to represent the
# board. If this array existed it would be viewed as
# a grid like so:
#
# 0 1 2 ... (n-1)
# n (n+1) (n+2) ... (2n-1)
# 2n (2n+1) (2n+2) ... (3n-1)
# .
# .
# ((n-1)n) ... (nn-1)
my (@q, @row_head, @row_tail); # the board <*********<
my $row = 0; # the current rank or row
my ($rank_loop, $test_avail, ); # profiling instruments
my $result = nqs();
if (VERBOSE) {
foreach my $i ( @$result) {
&display( $i);
&graph( $i);
print "\n";
}
}
print "\nFound ", scalar( @{$result}),
" solutions for N=", N, ".\n\n";
if ( DEBUG) {
print "\$rank_loop is $rank_loop\n";
print "\$test_avail is $test_avail\n";
}
exit;
#-------------------
# print the board size and occupied squares
sub display {
my $b = shift;
print "", N,"Qs: ";
foreach my $q ( @$b) {
print "$q ";
}
print "\n";
}
# print the board state as an ASCII picture
sub graph{
my $b = shift;
my $g = ('-' x (N*N));
my @ar;
@ar = split //, $g;
foreach my $q ( @$b) {
$ar[$q] = '*';
}
for ( my $j = 0; $j < @ar; ++$j) {
print " $ar[$j] ";
print "\n" if ( ($j+1) % N == 0 );
}
print "\n";
}
use vars "*cq";
# Put a Q in the specified row and return true or on failure undef.
# If the row has no Q, start at head looking for a sq, else start
# looking at square after the Q already in the row.
# If a Q can not be placed, clear the row and return undef.
#
# This is heavily optimized, that is to say messy.
# The main code optimization is to eliminate a
# &is_available routine call.
#
sub put_q {
my $i = shift;
*cq = \$q[$i]; # symbol table var is faster
if ( ! defined $cq ){
$cq = $row_head[$i];
}else{
++$cq;
}
my ($avail, $c, $icn_iqn, $icn );
while ( $q[$i] <= $row_tail[$i] ){
$avail = 1;
$c = $cq;
$icn = int($c/N); # Pulled out of below loop
foreach my $q (@q) {
last if $q == $c; # Always putting last Q in @q
DEBUG && $test_avail++;
# Check if square is available.
# Note: check along row is not necessary.
# Note: columns are bigger than diagonals
if (
( $q % N == $c % N ) or
( ($icn_iqn = $icn - int($q/N)) ==
($c-$q)/(N+1)) or
( $icn_iqn == ($c-$q)/(N-1))
){
$avail = 0;
last;
}
}
return $q[$i] if $avail;
++$cq;
}
$cq = undef;
}
# The n-Q solver, returns an aref of solutions.
sub nqs {
my $res = [];
# Setup board, each rank may contain 1 Q.<********<
for my $i ( 0 ..(N-1) ) {
$row_head[$i] = N*$i;
$row_tail[$i] = N*($i+1) -1;
$q[$i] = undef;
}
# Here is the logic of the solution. <********<
RANK: {
DEBUG && $rank_loop++;
if ( defined put_q( $row)) {
# succeeded placing Q on row
if ( $row == N-1) {
# have a solution, save it
my @ar = @q;
push @$res, \@ar;
redo RANK;
}
++$row;
redo RANK;
}else{
# clear Q from row and go back
$q[$row] = undef;
--$row;
last if ( $row < 0); # finished
redo RANK;
}
}
return $res;
};