#!/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;
};