Here's some optimizations,

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]

---

Hope That Helps,
jynx

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).