In college, for a FORTRAN class, I was assigned the 8-queens problem. At the time I was also taking Pascal and teaching myself 8086 assembler and was a bit overwhelmed with the labwork at the end of the semester.

As the instructor explained it, the intent was to solve the problem recursively. (HINT: it's almost trivial this way. Search with google for "eight queens recursion bit arithmetic" and take the first hit for a particularly clever solution...) Anyway, I realized that I misplaced the assignment and had to do it the night before it was due. So over a 300-baud dialup into a PR1ME system (running PR1MOS 7!) with a line editor I hacked up a Brute Force solution to the problem.

I used a 8-digit octal counter, each digit representing a column and each digit value representing a row on the chessboard. Add one, check for collisions, repeat until overflow to 9 digits of octal. As a test I did a 4x4 board. This worked, then 8x8. This was terribly slow. I started it as a phantom process, logged off, and went to bed at 1am.

The next morning I went into the lab to collect the results. The most *interesting* part was that from 1am to 2am I used 58 minutes of CPU time to solve the problem. The prof was mildly amused as 1. I was the only person to present a correct solution for that class, 2. that I was the first person he'd had to solve it through BF&I and 3. I had the absolute slowest version he'd ever seen. Nontheless, I got full credit for the assignment.

And just think: on comparative hardware in 2002, it'd run in (calculating...) under 4 minutes! Hooray for Moore's law!

I had oft run into the n-queens problem, but rarely with time to try it. (It was not one of the problems I had to solve during my CS classes.) After reading your post, I decided to try it (using Brute-Force, for now). My implementation is below, which I looped thru to run for n=(1..15). Because I just finished it, it is still running, but so far, for n=8, the time was about 6 minutes on a Dell Latitude C600. Enjoy.

#!/usr/bin/perl -w

use strict;
use vars qw($DEBUG);
$| = 1;
$DEBUG = 0;

# According to http://www.schoolnet.ca/vp-pv/amof/e_queeI.htm, 
# the number of solutions for n = 1,2,...,15, 
# is 1, 0, 0, 2, 10, 4, 40, 92, 352, 724, 2680, 14200, 73712, 365596, 
+2279184.

# my $maxcells = 8;
foreach my $maxcells (1..15) {
    my $solutions = 0;
    my $stime = scalar(localtime(time()));
    $solutions = &nqueens($maxcells);
    my $etime = scalar(localtime(time()));

    print <<STATUS;
N: $maxcells
Solutions found: $solutions
End time:    $etime
Start time:  $stime
STATUS
}

sub nqueens {
    my ($maxcell) = @_;
    my @board = (0) x $maxcell;
    my $solution_count = 0;
    print("Test output: ", join('-', @board), "\n" x 2)    
      if ($DEBUG);

    until ($board[$maxcell]) {
        {
            my $count = 0;
            $board[$count]++;
            while (($board[$count] == $maxcell) and 
              ($count < $maxcell)) {
                $board[$count] = 0;
                $count++;
                $board[$count]++;
            }
            my $flag = 1;
            for (my $a = 0; 
              ($a < ($maxcell - 1)) and ($flag); $a++) {
                foreach my $b (($a + 1) .. ($maxcell - 1)) {
                    if (($board[$a] == $board[$b]) or 
                      (abs($board[$a] - $board[$b]) == abs($a - $b))) 
+{
                        $flag = 0;
                        last;
                    }
                }
            }
            print(join('-', @board), "\n") 
              if (($flag) and ($DEBUG));
            $solution_count++  if ($flag);
        }
    }
    return($solution_count);
}
[download]

Update (21 Sep 2002):
Ran the script in the background on a Duron 750, and in case anyone was interested, got the following results so far:


N	Solutions  found	Ended	Started
1	1	Sun Sep 15 19:43:01 2002	Sun Sep 15 19:43:01 2002
2	0	Sun Sep 15 19:43:01 2002	Sun Sep 15 19:43:01 2002
3	0	Sun Sep 15 19:43:01 2002	Sun Sep 15 19:43:01 2002
4	2	Sun Sep 15 19:43:01 2002	Sun Sep 15 19:43:01 2002
5	10	Sun Sep 15 19:43:01 2002	Sun Sep 15 19:43:01 2002
6	4	Sun Sep 15 19:43:05 2002	Sun Sep 15 19:43:01 2002
7	40	Sun Sep 15 19:43:51 2002	Sun Sep 15 19:43:05 2002
8	92	Sun Sep 15 19:59:45 2002	Sun Sep 15 19:43:51 2002
9	352	Mon Sep 16 01:40:22 2002	Sun Sep 15 19:59:45 2002
10	724	Fri Sep 20 09:21:41 2002	Mon Sep 16 01:40:22 2002

re Absolute slowest...

One could argue that the rules are different for non-parameterized (throw-away) problems. If programmer A codes a BF solution that is obviously simple and correct code, then goes to bed and lets the computer do the work, and programmer B works for hours, turns in, and still has to debug it the next day, programmer A had the answer first.

On the assumption that you need to use threads in your solution, here's an idea.

Break the problem up so that you present a stream of partial solutions to a shared queue. Multiple threads can pick partial solutions off of the queue, and determine if the partial solution is in fact a complete solution.

As a partial solution, solve a simpler problem: pretend that Queens move only horizontally or vertically. Add all solutions to this simplified problem to shared queue. The (more computationally expensive?) step of determining if these solutions hold when Queens are allowed to move diagonally can be done in parallel (i.e., by multiple threads).

use strict;
 use Data::Dumper;

 my $SIZE  = shift || 4;
 my @BOARD = map {[(1) x $SIZE]} (1..$SIZE);
 my @SOLUTION;

 # i know that the second argument seems unecessary,
 # but this will used to allow different threads to
 # tackle different starting rows ...
 scan(0,0,[@BOARD],[]);

 print Dumper \@SOLUTION;

 sub scan {
    my ($col,$start_row,$board,$possible) = @_;
    my $copy = [map[@$_],@$board];

    # no more columns? 
    if ($col == $SIZE) {
       # found our solution!
       push @SOLUTION,[@$possible];
       return;
    }

    # find first available row
    for my $row ($start_row..$SIZE-1) {
       if($board->[$row]->[$col]) {

          push @$possible,$row;
          print "available row: $row in col $col: (@$possible)\n";

          mark_attacks($row,$col,$board);
          print_matrix($board);

          scan($col+1,0,[@$board],$possible);

          # i thought that this copy should not even be necessary
          @{$board} = map[@$_],@$copy;

          pop @$possible;
       }
    }

    return;
 }

 sub mark_attacks {
    my ($r,$c,$array) = @_;

    $array->[$r]->[$c] = 'Q';

    # mark horizontal
    $array->[$r]->[$_] = 0 for ($c+1..$SIZE-1);
    # this line will produce 1 solution for n=4 or 5
    #$array->[$r] = [ map {0} @{$array->[$r]} ];

    # mark r-c diagonal
    $array->[--$r]->[++$c] = 0 while ($r > 0) && ($c < $SIZE-1);

    # mark r+c diagonal
    ($r,$c) = @_;
    $array->[++$r]->[++$c] = 0 while ($r < $SIZE-1) && ($c < $SIZE-1);
 }

 sub print_matrix { print join('',@$_),"\n" for @{+shift} }
[download]

That did the trick, thank you very kindly! As my recording engineering professor used to say, "you are only one button push away from getting it right!" This time, looks like i was two away - the deep copy, and moving the pop to inside the conditional (inside the for loop). Wish me luck porting this puppy over to C with the pthread.h library (there are no PthreadMonks last time i checked ...)

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

Call me crazy, but whenever I need a deep copy, I use freezethaw... just to be sure, 'cause data structures have a tendency to grow beyond their original intentions...

#!/usr/bin/perl -w

use strict;
use Data::Dumper;
use FreezeThaw qw/ thaw freeze /;

my $ds = { -foo => [ -bar => [0, 1], 3 ],
           -ping => 1 };

$ds->{-zort} = \$ds;

my ($dsft) = thaw freeze $ds;

$dsft->{-ping} = 2;

print Dumper [$ds, $dsft];
[download]

See... $ds and $dsft are two different objects now! yay. And no matter how they change, the deep copy will work for ever and ever.

[admin@ensim admin]$ perl ./test.pl
$VAR1 = [
          {
            '-zort' => \$VAR1->[0],
            '-ping' => 1,
            '-foo' => [
                        '-bar',
                        [
                          0,
                          1
                        ],
                        3
                      ]
          },
          {
            '-ping' => 2,
            '-zort' => \$VAR1->[1],
            '-foo' => [
                        '-bar',
                        [
                          '0',
                          '1'
                        ],
                        '3'
                      ]
          }
        ];
[admin@ensim admin]$
[download]

The brute force method works (put a queen at (1,1) or top left, and place the next queens in the next column, and so forth) but it's a little inefficient. My approach would start off by placing a queen at (1,1), but the placement of the next queen would be in the next available location that is out of reach of all of the queens placed on the board so far. More queens would be placed in this manner until the number of uncovered places reached zero (solution!) or until we run out of queens.

--t. alex
but my friends call me T.

p.s. And I'm not sure why your second matrix shows

Q 0 0 rather than Q 0 0
1 0 1             0 0 1
1 1 0             0 1 0
[download]

If he is moving across by column, then there is no need to worry about marking and unmarking columns since he will never try placing 2 queens in the same column.

sub mark_attacks {
   my ($r,$c,$array) = @_;

   $array->[$r]->[$c] = 'Q';

   # mark everything

   my $none;

   for my $i (1 .. $SIZE) {
      $none = 1;
      $none = $array->[$r]->[$c + $i] = 0 if ($c + $i < $SIZE);
      $none = $array->[$r]->[$c - $i] = 0 if ($c - $i >= 0);
      $none = $array->[$r + $i]->[$c] = 0 if ($r + $i < $SIZE);
      $none = $array->[$r - $i]->[$c] = 0 if ($r - $i >= 0);
      $none = $array->[$r - $i]->[$c - $i] = 0 if ($r - $i >= 0 and $c
+ - $i >= 0);
      $none = $array->[$r + $i]->[$c + $i] = 0 if ($r + $i < $SIZE and
+ $c + $i < $SIZE);
      $none = $array->[$r - $i]->[$c + $i] = 0 if ($r - $i >= 0 and $c
+ + $i < $SIZE);
      $none = $array->[$r + $i]->[$c - $i] = 0 if ($r + $i < $SIZE and
+ $c - $i >= 0);
      last  if $none;
   }
}
[download]

Good luck in your assignment.

I don't believe it is necessary to check the diagonals of previous columns, since if it were possible for a queen in col 3 to attack the Q in col 1, the reverse is also true... that is, the position the Q in col 3 would have to be in was previously ruled out by the diagonals of Q in col 1.

I believe this depends in how are the queens placed in the board (ie, how the solutions are searched).

For this particular case, you're correct, as queens are apparently placed in each row, from left to right.

Regards.

"I also think than a single loop might improve performance slightly."

Yep, and it is more simple as well:

sub mark_attacks {
   my ($r,$c,$array) = @_;
   my ($u,$d) = ($r,$r);

   # to be removed - just for visualization during debugging
   $array->[$r]->[$c] = 'Q';

   for ($c+1..$size-1) {   
      $array->[$r]->[$_] = 0;
      $array->[--$u]->[$_] = 0 if $u > 0;
      $array->[++$d]->[$_] = 0 if $d < $size-1;
   }

}
[download]

Thanks for the tips. :)

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

There has to be a pop @TEMP when we backtrack to the previous column, whether a solution is found or not. This should automatically clear @TEMP when we backtrack to the 1st column, making the @TEMP = (); line unecessary.

I0 has posted code above that corrects this problem, I believe.

On a side note, it appears you would be including non-distinct (AKA congruent) solutions in your results. Is this a concern?

Uh-oh... I missed that I0 already fixed the problem I pointed out... <ahem> Umm, nice job!

Perhaps my post will clarify jeffa's coding problem and I0's solution for posterity.

Just fill the board with Queens, then clear away the dead ;-)

Posted As A CB Preservation Measure.

After Compline,
Zaxo

Incidentally, search.cpan.org does not find this module.

In other words the queen in the middle can only have other queens at the locations indicated by '?' (or further away). No queen can possibly be at any of the X locations. Adjust the "circle" of knight hops as is appropriate for the actual amount of the board available given the current queen position.

x	?	x	?	x
?	x	x	x	?
x	x	Q	x	x
?	x	x	x	?
x	?	x	?	x

--- demerphq
my friends call me, usually because I'm late....

To compile, be sure and use the -l option with pthread:

gcc queens.c -o queens -lpthread

UPDATE: almost forgot ... a big thanks to jcwren and hacker (with an indirect big thanks to Zaxo) for sharing their C knowledge at Perl site. ;)

Here is Abigail-styled golfed regex approach. It works for me with "8" as argument, but crashes with "5" :)

#!perl -l
sub f{/((.).*)(.)(??{$"x($2!=$3&length$1!=abs$2-$3)})/?0:/.{@ARGV}/?pr
+int:map&f,$_.1..$_."@ARGV"}f
[download]

P.S. Removing one char magically solves crashing:

-l sub f{/((.).*)(.)(??{$2!=$3&&length$1!=abs$2-$3&&0})/?0:/.{@ARGV}/?print:map&f,$_.1..$_."@ARGV"}f

Update on Sep 20: more golf

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;
};
[download]