in reply to Efficient N-Queen solution with Perl

I like this kind of problem. Here's my solution, which finds the 92 solutions for an 8x8 board in under a second (or will solve any NxN board, given enough stack space and time, it blows up for me with "Deep recursion" errors for me on 100x100...), but does not collapse the identical solutions due to rotation and reflection to 12. That's an excercise for someone else :-)
The output is simply the column (or row) for each queen in each succeeding row (or column). It's rather brute force, but sped up slighty from blind brute force by using a hash array. I think its very idiomatic perl, it'd be interesting to compare against the java version:
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]
This algorithm is exponential, though an 8x8 board takes less than a second, a 10x10 board took about 11 seconds and a 11x11 board took ~55 seconds. For a 30x30 board, I'm still seeing how long it takes to find even the first solution :)
(Update2: A chart on this page will give you an idea how long it takes to get the first solutions for brute force algorithms when you change N).

Replies are listed 'Best First'.
(tye)Re: Efficient N-Queen solution with Perl
by tye (Sage) on Nov 20, 2001 at 05:00 UTC

    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")
[reply]
[d/l]

In Section Seekers of Perl Wisdom