Article: 3066 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:3066
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!wupost!darwin.sura.net!rsg1.er.usgs.gov!ukma!levan
From: [email protected] (Jerry LeVan)
Subject: Eight Queens Solutions
Message-ID: <[email protected]>
Organization: University Of Kentucky, Dept. of Math Sciences
Date: Fri, 28 May 1993 21:11:11 GMT
Lines: 113

Hello,

Last week I asked about solutions to the eight queens
problem (preferably with a "perl" flavor). I got one
response with a elegant solution:

#!/usr/local/bin/perl

# A Perl script to solve the n-queens problem.
#
# Each argument to &next_queen is a row of the board, and the value is
# the column a queen has already been placed at.  It attempts to add
# another queen to the current row so that it doesn't conflict with the
# previous rows.
#
#       Nick Holloway <[email protected]>, 27th May 1993.

$boardsize      = 8;                            # Number of queens

@columns        = ( 0 .. $boardsize-1 );        # Precomputed for speed.

sub next_queen {
   ( print ( "@_\n" ), return ) if @_ == $boardsize;

   column:
   for $column ( @columns ) {
       next if grep ( $_ == $column, @_ );
       $row = @_;
       next if grep ( $_ == $column-$row--, @_ );
       $row = @_;
       next if grep ( $_ == $column+$row--, @_ );

       &next_queen ( @_, $column );
   }
}

&next_queen ();
*********************************************************************

The above code will find all 92 solutions to the eight queens problem
in 12+ seconds on a decstation 3100, both Nick and I found out
that "grep" is much faster than "for".

The following is my (ugly) interpretation of N Wirths solution to the
same problem:

#!/usr/bin/perl

# Find all solutions to the eight queens problem on
# an eight by eight board.
# Jerry LeVan <[email protected]>

@a = (1) x 15 ; # 15 diagonals (1 => unoccupied)
@b = (1) x 15 ; # 15 antidiagonals ( 1 => unoccupied )
@c = (1) x  8 ; #  8 rows ( 1 => unoccupied )

# Store solution here
@x = (undef,(0) x 8 ) ; # skip the zeroth slot

$pflag     =  1 ;  # true if printing solutions desired
$solutions =  0 ;  # total number of solutions
$boardsize =  8 ;  # size of board
@rows      =  (1 .. $boardsize) ;

sub try {

 local($i)=@_ ; # try to put a queen in the ith column

 for $j (@rows ) { # slide down column looking for safe spot
   # is it safe ?
   if ( $a[$i-$j+7] && $b[$i+$j-2] && $c[$j-1]) {

     # yes, mark diagonal, antidiagonal and row as occupied
     $a[$i-$j+7] = $b[$i+$j-2] = --$c[$j-1] ;

     # record solution
     $x[$i] = $j;

     # if not in last column try to extend this solution
     if( $i <  $boardsize ){   &try( $i + 1 ); }
     else {
       # we have a solution so display it
       ++$solutions ;  &printsol if $pflag ;
     }
     # take this queen off and try next row in this column
     $a[$i - $j + 7] = $b[$i + $j -2] = ++$c[$j-1];
   }
  }
}

sub printsol {
 print join(' ',@x), "\n" ;
}

&try(1) ;
print "Exactly $solutions found.\n" ;
*****************************************************************

This solution cranks out the solutions in 6+ seconds on the
decstation.

To keep things in perspective, the C version of the latter
algorithm will find all solutions in less than one clock
tick on the decstation :)

Of course Perl was not intended for this kind of crunching,
but I really liked Nick's solution.

Enjoy

--Jerry LeVan
 [email protected]