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

In reply to Re: Efficient N-Queen solution with Perl by jynx
in thread Efficient N-Queen solution with Perl by lestrrat

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.