An AI course that I took a couple years ago had a "fastest N-queens solver" competition as one of the assignments. I took a look around the net and found some papers on N-queens solutions... the best one I found was O(n), on average. IIRC, it had two steps:

1. From left to right, place queens randomly on the columns. Keep trying to place a given queen until you don't have any conflicts. Do this about 2n times.
2. Pick two queens that have conflicts, and swap their columns. (There were a bunch of heuristics here for picking the "right" queens -- IIRC, I ignored them.)

The point is, if your algorithm is faster (better time complexity) than his, it doesn't matter if you write it in QBasic and he uses hand-tuned assembly... just crank up N until your curve beats his. Fast algorithms are the best kind of optimization, whether you write them in baby-Perl or golf-Perl.

Since I was more interested in writing games, simulations, and comm software than solving logic problems it didn't hold any interest for me. But after a couple of weeks it was apparent that no-one else was making any headway on solving the problem. The instructor gloated.

One afternoon I hacked up a pure Brute Force and Ignorance solution. Howzat? All of the arrangements of 8 queens on a chessboard can be represented as a base-8 counter. Initialize it to 00000000 and add one. Check to see if any digits are repeated or any digits are rows+cols offset from each other (diagonal). Lather, rinse, repeat. It took all of an hour to write and debug, most of that fighting the line editor.

Unleashing that on our Prime 950 (I think it was running PrimeOS 7?) it immediately ground the entire machine to a slow death. Fearing being tortured by my classmates and having the lab people hunt me down like an animal, I managed to stop the program and sneak out. Before I did, I set the program to run at midnight (a phantom job) that night and dump results (the octal numbers representing successful matches) to a file.

The next morning I got the results. 96 matches (which was correct) including rotations and mirrors. The job ran for 1 hour and 10 minutes, and used 1 hour and 3 minutes of CPU time. Thank God this particular University didn't charge students for CPU time.

I used Pascal (which I liked better at the time) to take the results and format them according to the instructor's wishes. I had actually used FORTRAN to solve the problem, so I wasn't cheating... </geezer>

In sort, place N queens on an N by N chessboard, such that no queen can take any other queen.

The N-queen problem has been around for a while, as you probably guessed from the aforementioned page calling a 1977 article "recent".

Cheers,
Paul

use strict;
use warnings;

my $n = shift || 8;

my @board;
# Initialize board
for my $i (1..$n) {
  for my $j (1..$n) {
    $board[$i]{$j} = 1;
  }
}

my @positions;
put_q(1);

sub put_q {
  my $i = shift;
  for my $j (keys %{$board[$i]}) {
    if ($i == $n) {
      print "@positions[1..$#positions] $j\n";
    } else {
      $positions[$i] = $j;
      my $marked = mark_board($i, $j);
      put_q($i+1);
      unmark_board($marked);
    }
  }
}

sub mark_board {
  my ($i, $j) = @_;
  my $j1 = my $j2 = $j;
  my @marked;
  for my $x ($i+1..$n) {
    push @marked, [$x, $j1] if --$j1 >= 1  and delete $board[$x]{$j1};
    push @marked, [$x, $j2] if ++$j2 <= $n and delete $board[$x]{$j2};
    push @marked, [$x, $j] if delete $board[$x]{$j};
  }
  return \@marked;
}

sub unmark_board {
  $board[$_->[0]]{$_->[1]} = 1 for @{$_[0]};
}
[download]

Rather obfuscated and brute force (updated to handle more than 8 queens):

#!/usr/bin/perl -w

use strict;

my $N= @ARGV ? $ARGV[0] : 8;
my $max= $N - 1;
my $zero= "";
vec( $zero, $max, 1 )= 0;
my $chars= length($zero);
my $board= $zero x $N;
my @col= map { my $c= $zero; vec($c,$_,1)= 1; $c } 0..$max;
my $down= $board . join "", @col;
my $up= $board . join "", reverse @col;
my %pos;
@pos{@col}= 0..$max;
my $sols= 0;
sub AddQueen {
    my( $q, $board, $sol )= @_;
    if(  $q == $N  ) {
        $sols++;
        warn Xform($sol),
            " solution $sols: @pos{ $sol =~ /.{$chars}/gos }\n";
        return;
    }
    my $row= substr($board,$q*$chars,$chars);
    for my $bit (  @col  ) {
        if(  $zero eq ( $bit & $row )  ) {
            AddQueen(
                $q+1,
                $board
                | $bit x $N
                | substr( $up, (2*$N-1-$pos{$bit}-$q)*$chars )
                | substr( $down, ($N+$pos{$bit}-$q)*$chars ),
                $sol.$bit
            );
        }
    }
}

my $uniq= 0;
my %uniq;
sub Xform {
    my( $sol )= @_;
    return "Duplicate"   if  $uniq{$sol};
    $uniq++;
    $uniq{$sol}++;                              # Identity
    my( @sol )= @pos{ $sol =~ /.{$chars}/gos };
    my( @los )= map {$max-$_} @sol;             # For - mirror
    $uniq{join "", @col[reverse @sol]}++;       # | mirror
    $uniq{join "", @col[@los]}++;               # - mirror
    $uniq{join "", @col[reverse @los]}++;       # -| = 180 turn
    @sol[@sol]= 0..$max;                        # For \ mirror
    @los[reverse @los]= 0..$max;                # Add |\ = -|\ = /
    $uniq{join "", @col[@sol]}++;               # \ mirror
    $uniq{join "", @col[reverse @sol]}++;       # \| = +90 turn
    $uniq{join "", @col[@los]}++;               # / mirror
    $uniq{join "", @col[reverse @los]}++;       # /| = -90 turn
    return "Unique";
}

AddQueen( 0, $board, "" );
warn "Total of $uniq unique solutions (in ",
    time()-$^T, " secs).\n";
[download]

        - tye (but my friends call me "Tye")

So here's the code... let me first say that I think this only finds one solution, and that's it.

The first two are the original code that was presented to me...

Original Perl Code

#!/usr/local/bin/perl

sub dump() {
    my ($i, $j);
    print(sprintf("%s\n", $head));
    for ($i = 0; $i < $size ; $i++) {
        $l = "";
                for ($j = 0; $j < $size; $j++) {
                        if ( $bd[$i * $size + $j] ) {
                                $l .= " O";
                        } else {
                                $l .= " -";
                        }
                }
                print(sprintf("%s\n",$l));
        }
}

sub initBd() {
    for ($i = 0; $i < $size ; $i++) {
                for ($j = 0; $j < $size; $j++) {
            $bd[$i * $size + $j] = 0;
        }
    }
}

sub isValidPos() {
    my ($x, $y) = @_;
    my ($i, $c, $j0, $j1);
        for ($i = $x-1, $c = 1; $i >= 0; $i--, $c++) {
                if ($bd[$i * $size + $y]){
                        return 0;
                }

                $j0 = $y - $c;
                if ($j0 >= 0 && $bd[ $i * $size + $j0] ){
                        return 0;
                }

                $j1 = $y + $c;
                if ($j1 < $size && $bd[$i * $size + $j1] ){
                        return 0;
                }

        }
        return 1;
}

sub checkPos() {
    my ($x, $y) = @_;
    my ($j);
        for ( $j = $y; $j < $size ; $j++) {
                if ( &isValidPos($x, $j)) {
                        $bd[$x * $size + $j] = 1;
                        if ($x + 1 >= $size ) {
                                &dump();
                                $bd[$x * $size + $j] = 0;

                return 0;
                        }
                        if (! &checkPos($x+1, 0)) {
                return 0;
            }
                        $bd[$x * $size + $j] = 0;
                }
        }
    return 1;
}

sub main() {

    $size = 8;
    for ($i = 0; $i <= $#ARGV; $i++) {
        if ("-s" eq $ARGV[$i]) {
            $i++;
            $size = $ARGV[$i];
        } 
    }

    $head = "";
    for ($i = 0; $i < $size; $i++) {
                $head .= "--";
        }


    &initBd();
    $t1 = time();
    &checkPos(0, 0);
    $t2 = time();
    print(sprintf("Elapsed time = %d\n", ($t2 - $t1) * 1000 ));
}

&main();
exit(0);
[download]

Java Code

public class NQ {
    boolean[][] bd; 
    int    size;
    String    head;
    int    totalCount;
    static    long st, et;

    NQ(int n) {
        size = n;
        bd = new boolean[n][n];
        head = "";
        totalCount = 0;

        for (int i = 0; i < n; i++) {
            head += "--";
        }
    }

    public void dump() {
        System.out.println("Count: " + totalCount);
        System.out.println(head);
        for (int i = 0; i < size ; i++) {
            String l = "";
            for (int j = 0; j < size; j++) {
                if ( bd[i][j]) {
                    l += " O";
                } else {
                    l += " -";
                }
            }
            System.out.println(l);
        }
    }

    private boolean isValidPos(int x,  int y) {
        int i, j0, j1, c;
        totalCount++;
        for (i = x-1, c = 1; i >= 0; i--, c++) {
            // hrizontal line check
            if (bd[i][y]){
                return false;
            }

            // diagonal1 check 
            j0 = y - c;
            if (j0 >= 0 && bd[i][j0]){
                return false;
            }

            // diagonal2 check
            j1 = y + c;
            if (j1 < size && bd[i][j1]){
                return false;
            }
        }
        return true;
    }

    private boolean checkPos(int x, int y) {
        int j;
        for ( j = y; j < size ; j++) {
            if (isValidPos(x, j)) {
                bd[x][j] = true;

                if (x + 1 >= size ) {
                    dump();
                    bd[x][j] = false;

                    // if this returns true, it continues searching...
                    return false;
                }

                if (!checkPos(x+1, 0)) {
                    return false;
                }
                bd[x][j] = false;
            } 
        }
        return true;
    }

    public static void main(String[] argv) {
        int a = 8; // default

        for ( int i = 0; i < argv.length; i++) {
            if (argv[i].equals("-s")) {
                try {
                    a = Integer.parseInt(argv[i+1]);
                } catch (Exception e) {
                    e.printStackTrace();
                }
            }
        }

        NQ eq = new NQ(a);
        System.out.println("Board Size = " + eq.bd.length);

        st = System.currentTimeMillis();
        eq.checkPos(0, 0);
        et = System.currentTimeMillis();
        String ept = Long.toString(et - st);
        System.out.println("Elapsed time (msec): " + ept);
    }
}
[download]

(Somewhat) Optimized Perl Code

An here's the code with the optimization. It's exactly the same algorithm, just cut the overhead of calling subs and what not. The interesting thing I found about this is that if you use for( 0..$size ) in the outer loop, it seems to slow down things a bit. I thought that was more efficient under perl... hmm.

use strict;
use vars qw/ @bd $size /;

sub solve
{
    $size   = shift;
    @bd     = (0)x$size**2;

    checkPos(0,0);
#   dump_bd();
}

sub dump_bd
{
    my $i_size;
    for my $i( 0..$size-1 ) {
        $i_size = $i * $size;
        print (
            map{ $_ ? ' 0' : ' -' } @bd[ $i_size .. $i_size + $size - 
+1 ]
        );
        print "\n";
    }
}

sub checkPos
{
    my ($x, $y) = @_;
    my $x_size = $x * $size;
    my( $i_size, $cur_pos, $j0, $j1 );
OUTER:
    for( my $j = 0; $j < $size; $j++ ) {
        for( my $i = $x-1, my $c = 1; $i >= 0; $i--, $c++) {
             $i_size = $i * $size;
             $bd[$i_size + $j] && next OUTER;
             ( $j0 = $j - $c ) > -1 && $bd[ $i_size + $j0] && next OUT
+ER;
             ( $j1 = $j + $c ) < $size && $bd[$i_size + $j1] && next O
+UTER;
        }

        $cur_pos = $x_size + $j;
        $bd[ $cur_pos ] = 1;
        ($x + 1 >= $size ) && return 0;
        checkPos($x+1, 0) || return 0;
        $bd[ $cur_pos ] = 0;
    }
    return 1;
}

1;
[download]

Just for the record, I cut the overhead of calling subroutines and in fact, minimized blocks ( like, if{} for{}, etc ) and gained a 30% increase in speed.

I believe what prompted me to do this was somebody's posting on perlmonks, but I forget who at this point...

In any case, perl still remains about 100 times slower than Java. ugh.

Here's a thought:

Post your proposed solution and let us have a try at it. I'm positive that there's a number of optimizations you haven't seen, cause you're the original author. (This applies to everyone, including tilly, tye, and merlyn.)

(Only Erudil doesn't need this kind of help ... he needs a completely different form of help. *grins*)

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

Thanks for posting your original code. It was about 100-times slower than runrig's code (for fairly small numbers of queens and only counting how long it took runrig's code to find the first match).

My updated code actually does more than runrig's (checks for duplicates) but runs quite a bit faster. For example, runrig's takes about 28 seconds to find the 2680 solutions for 11 queens while mine takes about 7 seconds (and notes that only 341 solutions are unique). Sorry, I don't feel like running more samples and making more comparisons than those at the moment.

So at least a great deal of the speed problem isn't Perl's fault in this case. ;)

The original posting is on my scratchpad. All that I've done is to modify the output of a2p on the original awk code.

Coincidentally, the usenet post was comparing the speed of awk and Perl and a prominent Perlmonk gets a mention. The author of the awk program is Mike Brennan who wrote mawk. Ultimately however, these lang versus lang games prove very little.

#!/usr/local/bin/perl -w

# Comments from the origianl posting
#
#    queens    # solves 8-queen problem
#    queens 5  # solves 5-queen problem
#    1  3  5  2  4
#    5  3  1  4  2
#    1  4  2  5  3
#    5  2  4  1  3
#    2  4  1  3  5
#    4  2  5  3  1
#    2  5  3  1  4
#    4  1  3  5  2
#
# Each row shows a solution and the 5-queens problem has 8 solutions.
# The first solution (1 3 5 2 4) is
#
#    Q * * * *
#    * * Q * *
#    * * * * Q
#    * Q * * *
#    * * * Q *
#

use strict;

my $sz = $ARGV[0] || 8;

die "Board must be >= 4x4\n" if $sz < 4;

my @soln;

for (my $i = 1; $i <= $sz / 2; $i++) {
    $soln[0] = $i;

    df_queens($sz, 1, @soln);
}


# print a solution and it's symmetry about the vertical axis
sub print_soln {

    my $soln_sz =  shift;
    my @soln    = @_;

    printf ' %2d', $_ for @soln;
    print "\n";

    # print symmetric soln
    my $X = $soln_sz + 1;
    printf ' %2d', $X - $_ for @soln;
    print "\n";
}


# depth first seach for solutions
sub df_queens {

    my $prob_sz = shift;
    my $soln_sz = shift;
    my @soln    = @_;

    if ($prob_sz == $soln_sz) {
        print_soln($soln_sz, @soln );
        return;
    }

    my $new_r   = $soln_sz + 1;

    for my $new_c ( 1 .. $prob_sz) {
        my $ok = 1;
        for my $r   ( 1 .. $soln_sz) {
            my $c = $soln[$r-1];
            if ( $c       == $new_c             ||
                ($c + $r) == ($new_c + $new_r)  ||
                ($c - $r) == ($new_c - $new_r))
            {
                $ok = 0;
                last;
            }
        }

        if ($ok) {
            $soln[$new_r-1] = $new_c;
            df_queens($prob_sz, $new_r, @soln);
        }
    }
}
[download]

--
John.

hmmm... that doesn't seem to work properly for me. For starters the line:

my $sz = $ARGV[1] || 8;
[download]

looks suspicious, I think it should be $ARGV[0]. But even after changing that, I'm not getting any output from the above program.

% ./queens 10
% ./queens 2
Board must be >= 4x4
[download]

-Blake

Unfortunately, i've been having some problems with the code that i can't put a handle on. Usually you'll get a result for 20 queens within 5 seconds. 50 queens? about 20 seconds, usually less than 30 seconds. Unfortunately sometimes it infinite loops, and i have absolutely no idea where. The main problem i have is that the OOP code i originally used gets a huge speed bump when running under Devel::DProf. So much so that it only takes 4 seconds to do 100 queens. It took about 3 minutes to do 1000. But Devel::DProf slows this script version. Can anyone tell me why?

NOTE: These times are for a Redhat Linux box using 64Mb of RAM and a Pentium 200MHz. Your times will vary. (Testing under DarwinPerl with 128MB and a 733MHz processor is much faster :)

Anyway, here's the script version, reasonably fast. It could still be optimized tremendously, but there's only one algorithmic optimization that i didn't do. It doesn't make a huge difference in speed, so i don't think it's worth the time for now. If you're interested in the OO code i can post that too.

Major Optimizations of Note:
1) only O(N) time to recheck all queens contentions
2) board setup in O(N) (if it matters)
3) O(N log N) to pick a queen (i'd like to drop that, but i need the sort to know which queens to pick :(

#!/usr/local/bin/perl -w
use strict;

my $size = 8;
$size = shift() || $size;

# Queens are anon arrays set up like so: [x, y, #contentions]
my @queen;

my ($cqueens, $uqueens) = setup();

while (@{$cqueens} > 0) {
  my ($queen1, $queen2) = pickQueens($cqueens);
  my $ff = @{$cqueens} == 2 ? "true" : "false";

  ($cqueens, $uqueens) = quickCheck($queen1, $queen2, swap($queen1,$qu
+een2));

  # if we had two before and we have two again, then put one of the
  # uncontested back into the mix so that we have the possibility of
  # finishing still.
  if (($ff eq "true") && @{$cqueens} == 2) {
    my $rdm = int rand(@{$uqueens})+1;
    push @{$cqueens}, splice @{$uqueens}, $rdm, 1;
  }
}

print "The board after finishing:\n";
my $x;
foreach (@queen) {
  print ++$x, " ", (join",",map{$_+1}@$_[0,1]), "\n";
}

sub setup {
  my @poss = (0..$size-1);

  foreach my $x (0..$size-1) {
    my $y = int rand(@poss);
    ($y) = splice @poss, $y, 1;
    push @queen, [$x,$y,0];
  }

  # This does the initial check, other checks are handled by quickChec
+k :)
  foreach my $q1 (@queen) {
    LOOP: foreach my $q2 (@queen) {
      next LOOP if $q1->[0]==$q2->[0] && $q1->[1]==$q2->[1];
      $q1->[2]++ if abs($q1->[0]-$q2->[0])==abs($q1->[1]-$q2->[1]);
    }
  }

  my ($cq, $uq) = ([],[]);
  $_->[2] ? (push @{$cq}, $_) : (push @{$uq}, $_) foreach @queen;

  return $cq, $uq;
}

sub swap {
  my ($oq1, $oq2) = @_;
  my $nq1 = [$oq2->[0],$oq1->[1],$oq1->[2]];
  my $nq2 = [$oq1->[0],$oq2->[1],$oq2->[2]];
 
  return $nq1, $nq2;
}

sub pickQueens {
  my @queens = @{ shift() };
  return @queens if @queens <= 2;
  my ($q1, $q2);

  @queens = map { my$q=$_; map{$q->[1]}1..$_->[0] }
            sort{ $b->[0] <=> $a->[0] }
            map { [$_->[2], $_] } @queens;

  $q1 = shift @queens;
  shift @queens for (1..$q1->[2] - 1);
  $q2 = $queens[int rand(@queens)];

  return $q1, $q2;
}

sub quickCheck {
  my ($oq1,$oq2,$nq1,$nq2) = @_;

  foreach (@queen) {
    if (($oq1->[0]==$_->[0] && $oq1->[1]==$_->[1]) ||
        ($oq2->[0]==$_->[0] && $oq2->[1]==$_->[1])) {
      next;
    }
    if (linear(@$oq1[0,1],@$_[0,1]) && !linear(@$nq1[0,1],@$_[0,1])) {
      $_->[2]--;
      $oq1->[2]--;
    }
    if (linear(@$oq2[0,1],@$_[0,1]) && !linear(@$nq2[0,1],@$_[0,1])) {
      $_->[2]--;
      $oq2->[2]--;
    }
    if (!linear(@$oq1[0,1],@$_[0,1]) && linear(@$nq1[0,1],@$_[0,1])) {
      $_->[2]++;
      $oq1->[2]++;
    }
    if (!linear(@$oq2[0,1],@$_[0,1]) && linear(@$nq2[0,1],@$_[0,1])) {
      $_->[2]++;
      $oq2->[2]++;
    }
  }

  $oq1->[0] = $nq1->[0]; $oq1->[1] = $nq1->[1];
  $oq2->[0] = $nq2->[0]; $oq2->[1] = $nq2->[1];

  my ($contested, $uncontested) = ([],[]);
  $_->[2] ? (push @$contested, $_) : (push @$uncontested, $_) foreach 
+@queen;

  return $contested, $uncontested;
}

sub linear {
  my ($x1,$y1,$x2,$y2) = @_;
  return abs($x1-$x2)==abs($y1-$y2);
}
[download]

update:hmm, didn't notice that people were posting code that found all solutions to a given N. i was under the impression that the problem only needed to find one. oops. As for my code, an abstract can be downloaded here (if anyone's interested after seeing my failed attempt at the problem).