 Problems? Is your data what you think it is? PerlMonks

### Trying to solve N-Queens

by jeffa (Bishop)
 on Sep 08, 2002 at 21:18 UTC Need Help??

jeffa has asked for the wisdom of the Perl Monks concerning the following question:

Howdy friends. First off, this is a homework question. I have been tasked with chore of solving the N Queens Problem. I feel like i am this close, but yet i just can't wrap my head around solving my problem. What follows is an explanation of my idea, followed by the broken code.

My idea is start with a 2-D array that contains all 1's.

 1 1 1 1 1 1 1 1 1

Then, i start at (0,0) and mark off that row and the diagonals that the Queen can traval as zero:

 Q 0 0 1 0 1 1 1 0

Since i was able to place a Queen at (0,0), i store that row in a temporary array of possible solutions:

(0)

Next, i look at the next column and try to find an available row, which would be the third. Again, mark off that row and it's diagonals:

 Q 0 0 1 0 0 1 Q 0

So now i have two queens (0,2). Move to the next column and try to find an available row. Since none are available, i remove the second Queen from my tempory array and return from the recursive sub. Upon return, i find that there are no more rows left, so i should remove the first Queen from the temporary array and return again.

Here is my broken code. Any help will be greatly appreciated, and if you feel that you would rather just give me hints than outright solve my problem i really understand. This is homework after all .... but do keep in mind that the final product will be C code that uses the pthread library so even if i get this Perl prototype to work, i still have another harder road to travel. :/ Thanks again! :)

UPDATE:
Well, 2 hours later i almost have a solution ... i have elected to remove the original code (you can see it at http://perlmonks.thepen.com/196095_orig.html ). This is soooo close to working ... it outputs the correct number of solutions (and is horribly slow at that), but the solutions are ... not quite right. Here is the updated, not so broken code:
```use strict;
use Data::Dumper;

my \$SIZE  = shift || 4;
my @BOARD = map {[(1) x \$SIZE]} (1..\$SIZE);
my @SOLUTION;
my @TEMP;

scan(0,0,[@BOARD]);

print_solutions(\@SOLUTION);
#print Dumper \@SOLUTION;

sub scan {
#my (\$col,\$start_row,\$board,\$possible) = @_;
my (\$col,\$start_row,\$board) = @_;

# no more columns?
if (\$col == \$SIZE) {
# found our solution!
push @SOLUTION,[@TEMP];
#print "found solution! (@TEMP)\n";
@TEMP = ();
return;
}

# find first available row
for my \$row (\$start_row..\$SIZE-1) {
if(\$board->[\$row]->[\$col]) {

push @TEMP,\$row;
#print "found available row: \$row in col \$col: (@TEMP)\n";

my \$copy = [ map { [@\$_] } @\$board ];
mark_attacks(\$row,\$col,\$board);
#print_matrix(\$board);

scan(\$col+1,0,[@\$board]);
\$board = \$copy;
}
}

pop @TEMP;
return;
}

sub mark_attacks {
my (\$r,\$c,\$array) = @_;

\$array->[\$r]->[\$c] = 'Q';

# mark horizontal
\$array->[\$r]->[\$_] = 0 for (\$c+1..\$SIZE-1);

# mark r-c
\$array->[--\$r]->[++\$c] = 0 while (\$r > 0) && (\$c < \$SIZE-1);

# mark r+c
(\$r,\$c) = @_;
\$array->[++\$r]->[++\$c] = 0 while (\$r < \$SIZE-1) && (\$c < \$SIZE-1);
}

sub print_matrix { print join('',@\$_),"\n" for @{+shift} }

sub print_solutions {
my @array = @{+shift};
for (@array) {
print join(' ',map { \$_ + 1 } @\$_),"\n";
}
print scalar @array, " solutions found\n";
}
And here is sample output for a 5x5 board:
```\$ ./queens.pl 5
1 3 5 2 4
4 2 5 3
2 4 1 3 5
5 3 1 4
3 1 4 2 5
5 2 4 1
4 1 3 5 2
2 5 3 1
5 2 4 1 3
3 1 4 2
10 solutions found
```
Guessing at what is wrong, i would say that i am unecessarily popping @TEMP on line 45.

Originally, i stated that i could not understand why my 2-D board array was being modified when i was passing a copy of it to the next recursive call. The reason was because i was only copying the first dimension:

```\$copy = [@\$board];
instead of performing a deep copy:
```\$copy = [ map { [@\$_] } @\$board];
Almost there :) ... and i do appreciate dws's idea ... if i have enough time i will try a solution like that instead, as this one is not very fast by itself.

jeffa

```L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
```

Replies are listed 'Best First'.
Re: Trying to solve N-Queens
by clintp (Curate) on Sep 09, 2002 at 01:32 UTC
From the Not This Way department, a moral of speed:

In college, for a FORTRAN class, I was assigned the 8-queens problem. At the time I was also taking Pascal and teaching myself 8086 assembler and was a bit overwhelmed with the labwork at the end of the semester.

As the instructor explained it, the intent was to solve the problem recursively. (HINT: it's almost trivial this way. Search with google for "eight queens recursion bit arithmetic" and take the first hit for a particularly clever solution...) Anyway, I realized that I misplaced the assignment and had to do it the night before it was due. So over a 300-baud dialup into a PR1ME system (running PR1MOS 7!) with a line editor I hacked up a Brute Force solution to the problem.

I used a 8-digit octal counter, each digit representing a column and each digit value representing a row on the chessboard. Add one, check for collisions, repeat until overflow to 9 digits of octal. As a test I did a 4x4 board. This worked, then 8x8. This was terribly slow. I started it as a phantom process, logged off, and went to bed at 1am.

The next morning I went into the lab to collect the results. The most *interesting* part was that from 1am to 2am I used 58 minutes of CPU time to solve the problem. The prof was mildly amused as 1. I was the only person to present a correct solution for that class, 2. that I was the first person he'd had to solve it through BF&I and 3. I had the absolute slowest version he'd ever seen. Nontheless, I got full credit for the assignment.

And just think: on comparative hardware in 2002, it'd run in (calculating...) under 4 minutes! Hooray for Moore's law!

I had oft run into the n-queens problem, but rarely with time to try it. (It was not one of the problems I had to solve during my CS classes.) After reading your post, I decided to try it (using Brute-Force, for now). My implementation is below, which I looped thru to run for n=(1..15). Because I just finished it, it is still running, but so far, for n=8, the time was about 6 minutes on a Dell Latitude C600. Enjoy.

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

use strict;
use vars qw(\$DEBUG);
\$| = 1;
\$DEBUG = 0;

# According to http://www.schoolnet.ca/vp-pv/amof/e_queeI.htm,
# the number of solutions for n = 1,2,...,15,
# is 1, 0, 0, 2, 10, 4, 40, 92, 352, 724, 2680, 14200, 73712, 365596,
+2279184.

# my \$maxcells = 8;
foreach my \$maxcells (1..15) {
my \$solutions = 0;
my \$stime = scalar(localtime(time()));
\$solutions = &nqueens(\$maxcells);
my \$etime = scalar(localtime(time()));

print <<STATUS;
N: \$maxcells
Solutions found: \$solutions
End time:    \$etime
Start time:  \$stime
STATUS
}

sub nqueens {
my (\$maxcell) = @_;
my @board = (0) x \$maxcell;
my \$solution_count = 0;
print("Test output: ", join('-', @board), "\n" x 2)
if (\$DEBUG);

until (\$board[\$maxcell]) {
{
my \$count = 0;
\$board[\$count]++;
while ((\$board[\$count] == \$maxcell) and
(\$count < \$maxcell)) {
\$board[\$count] = 0;
\$count++;
\$board[\$count]++;
}
my \$flag = 1;
for (my \$a = 0;
(\$a < (\$maxcell - 1)) and (\$flag); \$a++) {
foreach my \$b ((\$a + 1) .. (\$maxcell - 1)) {
if ((\$board[\$a] == \$board[\$b]) or
(abs(\$board[\$a] - \$board[\$b]) == abs(\$a - \$b)))
+{
\$flag = 0;
last;
}
}
}
print(join('-', @board), "\n")
if ((\$flag) and (\$DEBUG));
\$solution_count++  if (\$flag);
}
}
return(\$solution_count);
}

Update (21 Sep 2002):
Ran the script in the background on a Duron 750, and in case anyone was interested, got the following results so far:
 N Solutions found Ended Started 1 1 Sun Sep 15 19:43:01 2002 Sun Sep 15 19:43:01 2002 2 0 Sun Sep 15 19:43:01 2002 Sun Sep 15 19:43:01 2002 3 0 Sun Sep 15 19:43:01 2002 Sun Sep 15 19:43:01 2002 4 2 Sun Sep 15 19:43:01 2002 Sun Sep 15 19:43:01 2002 5 10 Sun Sep 15 19:43:01 2002 Sun Sep 15 19:43:01 2002 6 4 Sun Sep 15 19:43:05 2002 Sun Sep 15 19:43:01 2002 7 40 Sun Sep 15 19:43:51 2002 Sun Sep 15 19:43:05 2002 8 92 Sun Sep 15 19:59:45 2002 Sun Sep 15 19:43:51 2002 9 352 Mon Sep 16 01:40:22 2002 Sun Sep 15 19:59:45 2002 10 724 Fri Sep 20 09:21:41 2002 Mon Sep 16 01:40:22 2002

re Absolute slowest...

One could argue that the rules are different for non-parameterized (throw-away) problems. If programmer A codes a BF solution that is obviously simple and correct code, then goes to bed and lets the computer do the work, and programmer B works for hours, turns in, and still has to debug it the next day, programmer A had the answer first.

Re: Trying to solve N-Queens
by dws (Chancellor) on Sep 08, 2002 at 22:09 UTC
... do keep in mind that the final product will be C code that uses the pthread library ...

On the assumption that you need to use threads in your solution, here's an idea.

Break the problem up so that you present a stream of partial solutions to a shared queue. Multiple threads can pick partial solutions off of the queue, and determine if the partial solution is in fact a complete solution.

As a partial solution, solve a simpler problem: pretend that Queens move only horizontally or vertically. Add all solutions to this simplified problem to shared queue. The (more computationally expensive?) step of determining if these solutions hold when Queens are allowed to move diagonally can be done in parallel (i.e., by multiple threads).

Re: Trying to solve N-Queens
by I0 (Priest) on Sep 09, 2002 at 02:36 UTC
```use strict;
use Data::Dumper;

my \$SIZE  = shift || 4;
my @BOARD = map {[(1) x \$SIZE]} (1..\$SIZE);
my @SOLUTION;

# i know that the second argument seems unecessary,
# but this will used to allow different threads to
# tackle different starting rows ...
scan(0,0,[@BOARD],[]);

print Dumper \@SOLUTION;

sub scan {
my (\$col,\$start_row,\$board,\$possible) = @_;
my \$copy = [map[@\$_],@\$board];

# no more columns?
if (\$col == \$SIZE) {
# found our solution!
push @SOLUTION,[@\$possible];
return;
}

# find first available row
for my \$row (\$start_row..\$SIZE-1) {
if(\$board->[\$row]->[\$col]) {

push @\$possible,\$row;
print "available row: \$row in col \$col: (@\$possible)\n";

mark_attacks(\$row,\$col,\$board);
print_matrix(\$board);

scan(\$col+1,0,[@\$board],\$possible);

# i thought that this copy should not even be necessary
@{\$board} = map[@\$_],@\$copy;

pop @\$possible;
}
}

return;
}

sub mark_attacks {
my (\$r,\$c,\$array) = @_;

\$array->[\$r]->[\$c] = 'Q';

# mark horizontal
\$array->[\$r]->[\$_] = 0 for (\$c+1..\$SIZE-1);
# this line will produce 1 solution for n=4 or 5
#\$array->[\$r] = [ map {0} @{\$array->[\$r]} ];

# mark r-c diagonal
\$array->[--\$r]->[++\$c] = 0 while (\$r > 0) && (\$c < \$SIZE-1);

# mark r+c diagonal
(\$r,\$c) = @_;
\$array->[++\$r]->[++\$c] = 0 while (\$r < \$SIZE-1) && (\$c < \$SIZE-1);
}

sub print_matrix { print join('',@\$_),"\n" for @{+shift} }
That did the trick, thank you very kindly! As my recording engineering professor used to say, "you are only one button push away from getting it right!" This time, looks like i was two away - the deep copy, and moving the pop to inside the conditional (inside the for loop). Wish me luck porting this puppy over to C with the pthread.h library (there are no PthreadMonks last time i checked ...)

jeffa

```L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
```
Call me crazy, but whenever I need a deep copy, I use freezethaw... just to be sure, 'cause data structures have a tendency to grow beyond their original intentions...
```#!/usr/bin/perl -w

use strict;
use Data::Dumper;
use FreezeThaw qw/ thaw freeze /;

my \$ds = { -foo => [ -bar => [0, 1], 3 ],
-ping => 1 };

\$ds->{-zort} = \\$ds;

my (\$dsft) = thaw freeze \$ds;

\$dsft->{-ping} = 2;

print Dumper [\$ds, \$dsft];
See... \$ds and \$dsft are two different objects now! yay. And no matter how they change, the deep copy will work for ever and ever.
```[admin@ensim admin]\$ perl ./test.pl
\$VAR1 = [
{
'-zort' => \\$VAR1->,
'-ping' => 1,
'-foo' => [
'-bar',
[
0,
1
],
3
]
},
{
'-ping' => 2,
'-zort' => \\$VAR1->,
'-foo' => [
'-bar',
[
'0',
'1'
],
'3'
]
}
];
Re: Trying to solve N-Queens
by fokat (Deacon) on Sep 09, 2002 at 02:51 UTC
I might be wrong, but I am under the impression that you're not considering that queens can attack in columns as well as rows. You should also consider attacking squares that are "before" your current position, like in this untested snippet:

```sub mark_attacks {
my (\$r,\$c,\$array) = @_;

\$array->[\$r]->[\$c] = 'Q';

# mark everything

my \$none;

for my \$i (1 .. \$SIZE) {
\$none = 1;
\$none = \$array->[\$r]->[\$c + \$i] = 0 if (\$c + \$i < \$SIZE);
\$none = \$array->[\$r]->[\$c - \$i] = 0 if (\$c - \$i >= 0);
\$none = \$array->[\$r + \$i]->[\$c] = 0 if (\$r + \$i < \$SIZE);
\$none = \$array->[\$r - \$i]->[\$c] = 0 if (\$r - \$i >= 0);
\$none = \$array->[\$r - \$i]->[\$c - \$i] = 0 if (\$r - \$i >= 0 and \$c
+ - \$i >= 0);
\$none = \$array->[\$r + \$i]->[\$c + \$i] = 0 if (\$r + \$i < \$SIZE and
+ \$c + \$i < \$SIZE);
\$none = \$array->[\$r - \$i]->[\$c + \$i] = 0 if (\$r - \$i >= 0 and \$c
+ + \$i < \$SIZE);
\$none = \$array->[\$r + \$i]->[\$c - \$i] = 0 if (\$r + \$i < \$SIZE and
+ \$c - \$i >= 0);
last  if \$none;
}
}
I also think than a single loop might improve performance slightly.

I don't believe it is necessary to check the diagonals of previous columns, since if it were possible for a queen in col 3 to attack the Q in col 1, the reverse is also true... that is, the position the Q in col 3 would have to be in was previously ruled out by the diagonals of Q in col 1.
I believe this depends in how are the queens placed in the board (ie, how the solutions are searched).

For this particular case, you're correct, as queens are apparently placed in each row, from left to right.

Regards.

"I also think than a single loop might improve performance slightly."

Yep, and it is more simple as well:
```sub mark_attacks {
my (\$r,\$c,\$array) = @_;
my (\$u,\$d) = (\$r,\$r);

# to be removed - just for visualization during debugging
\$array->[\$r]->[\$c] = 'Q';

for (\$c+1..\$size-1) {
\$array->[\$r]->[\$_] = 0;
\$array->[--\$u]->[\$_] = 0 if \$u > 0;
\$array->[++\$d]->[\$_] = 0 if \$d < \$size-1;
}

}
Thanks for the tips. :)

jeffa

```L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
```
Re: Trying to solve N-Queens
by talexb (Canon) on Sep 09, 2002 at 02:50 UTC
Instead of looking at your code, I just visited one of the links that describe the problem, and have this approach to offer (to be coded as you choose).

The brute force method works (put a queen at (1,1) or top left, and place the next queens in the next column, and so forth) but it's a little inefficient. My approach would start off by placing a queen at (1,1), but the placement of the next queen would be in the next available location that is out of reach of all of the queens placed on the board so far. More queens would be placed in this manner until the number of uncovered places reached zero (solution!) or until we run out of queens.

--t. alex
but my friends call me T.

p.s. And I'm not sure why your second matrix shows

```Q 0 0 rather than Q 0 0
1 0 1             0 0 1
1 1 0             0 1 0
Wouldn't the matrices be symmetric about the diagonal?
If he is moving across by column, then there is no need to worry about marking and unmarking columns since he will never try placing 2 queens in the same column.
Re: Trying to solve N-Queens
by Solo (Deacon) on Sep 09, 2002 at 03:44 UTC
It appears to me, one problem arises (the one where the solutions sometimes are too short) when @TEMP is reset each time a solution is found, because we don't always start at the first column to find the next solution. We are only getting the part of the solution that is different from the previous one, since we didn't backtrack all the way to column 1 to rebuild @TEMP.

There has to be a pop @TEMP when we backtrack to the previous column, whether a solution is found or not. This should automatically clear @TEMP when we backtrack to the 1st column, making the @TEMP = (); line unecessary.

I0 has posted code above that corrects this problem, I believe.

On a side note, it appears you would be including non-distinct (AKA congruent) solutions in your results. Is this a concern?

Uh-oh... I missed that I0 already fixed the problem I pointed out... <ahem> Umm, nice job!

Perhaps my post will clarify jeffa's coding problem and I0's solution for posterity.

Re: Trying to solve N-Queens
by Helter (Chaplain) on Sep 09, 2002 at 13:37 UTC
I doubt you have the time to research this path, but while taking a Genetic algorithms class, along with a parallel computing class I was given 2 final projects.

1. Solve one of these problems using a GA( I picked N Queens)
2. Solve a problem using a MP module (in a lab with 8 machines dedicated to running our code).

If you have never heard of GA's, they are quite nifty. The basic flow goes like this:

1. Create a random population. This population is some sort of representation of a possible solution. In this case it is a N^2 string of 0's and 1's. The 1's represent a queen, the 0's no-queen. For speed you can generate by lines such that there is only 1 queen per row, but this is done randomly.
So for N=4 one possible population member is: 0010 1000 0100 0010
This looks like this on the chessboard:
00Q0
Q000
0Q00
00Q0

2. Rank each member using a fitness function, this is usually the most difficult code to generate. If I remember correctly I took a large number, and subtracted off for each queen that collided with another. As an optimization I started in the upper left, and only looked down and down-right, this works because we chose the population to only have a single queen per row. (but no guarantee on columns).

3. The tournament begins. Using the fitness as a weight choose 2 members of the population, with the goal of picking 2 "good" members (higher fitness). Invert the weight and pick 2 of the "worst" members. Cross the 2 "good" members and replace the 2 "worst" members.
Crossing involves picking a random break in the string (on row boundaries so we can still ensure that we only have 1 queen per row.)
Continue for some number of iterations.

4. I added a bail-out for speed, such that if we ever found a solution stop looking, (max fitness value). If we have not hit that condition loop back to 2.

5. To further diversify the population (and attempt to avoid the population converging on a single, possibly bad, solution, you can add "mutations". After the tournaments/crossover (3) pick a few random members, and with a probibility randomly re-generate a portion of the member.

Where this shines is the fact that you can split the work up into many threads to get more work done. I split it up such that I had 1 master, 8 slaves. Each slave would generate it's own population, and do tournaments within it's own population. After each pass each member would take it's best member and send it to a neighbor (thinking of the slaves as a ring), the neighbor would replace it's worst with this new best.

If we found a "perfect" solution the master was notified and it would shut down all the other threads.

While running with this code I was able to solve a N=70 in about an hour, didn't have time to try bigger numbers, had to write the reports for both classes :)

Just another way to think about the problem instead of using brute force.

Helter
Re: Trying to solve N-Queens
by Zaxo (Archbishop) on Sep 09, 2002 at 04:06 UTC

Just fill the board with Queens, then clear away the dead ;-)

Posted As A CB Preservation Measure.

After Compline,
Zaxo

Re: Trying to solve N-Queens
by rinceWind (Monsignor) on Sep 09, 2002 at 10:54 UTC
Sounds like it might be an application for TheDamian's module DFA::Cellular

Incidentally, search.cpan.org does not find this module.

Re: Trying to solve N-Queens
by demerphq (Chancellor) on Sep 09, 2002 at 16:47 UTC
I havent looked at this program in a long time. Sigh. Yet another thing to do when I get the chance. Anyway, just a thought for you (you may have dealt with this already I havent reviewd the code in depth yet) but the closest two queens can get to each other is a knight hop away. (Knights move in an L)

In other words the queen in the middle can only have other queens at the locations indicated by '?' (or further away). No queen can possibly be at any of the X locations. Adjust the "circle" of knight hops as is appropriate for the actual amount of the board available given the current queen position.  x ? x ? x ? x x x ? x x Q x x ? x x x ? x ? x ? x

--- demerphq
my friends call me, usually because I'm late....

Solved N-Queens (warning: C code ahead)
by jeffa (Bishop) on Sep 18, 2002 at 18:07 UTC
My class has received our grades for the project, so i can now post the C version. It is not perfect by any means, but it does work. The algorithm is extremely brute force, and lots of improvements coulde be made, but it is still very fast, thanks to threads. The code takes about 55 seconds to solve a 13x13 board on our 700MHz quad processor box with one thread and about 16 seconds to solve the same board with 4 threads. tye's awesome solution with it's clever optimization of finding only unique solutions took about 2.5 mins to solve a 13x13 board, but that's not comparing apples and oranges.

To compile, be sure and use the -l option with pthread:

```gcc queens.c -o queens -lpthread
```
Run the executable with a -h option for usage instructions.

UPDATE: almost forgot ... a big thanks to jcwren and hacker (with an indirect big thanks to Zaxo) for sharing their C knowledge at Perl site. ;)

Re: Trying to solve N-Queens
by larsen (Parson) on Sep 09, 2002 at 16:44 UTC
Re: Trying to solve N-Queens
by mtve (Deacon) on Sep 10, 2002 at 08:38 UTC

Here is Abigail-styled golfed regex approach. It works for me with "8" as argument, but crashes with "5" :)

```#!perl -l
sub f{/((.).*)(.)(??{\$"x(\$2!=\$3&length\$1!=abs\$2-\$3)})/?0:/.{@ARGV}/?pr
+int:map&f,\$_.1..\$_."@ARGV"}f

P.S. Removing one char magically solves crashing:

-l sub f{/((.).*)(.)(??{\$2!=\$3&&length\$1!=abs\$2-\$3&&0})/?0:/.{@ARGV}/?print:map&f,\$_.1..\$_."@ARGV"}f

Update on Sep 20: more golf

-l /.{@ARGV}/?print:map/((.).*)(.)(??{\$2!=\$3&&length\$1!=abs\$2-\$3&&0})/||do\$0,\$_.1.."\$_@ARGV"
Re: Trying to solve N-Queens
by rir (Vicar) on Sep 12, 2002 at 02:27 UTC
The following is messy in that a few subroutine calls
are eliminated.

A coding optimization that I didn't look at, is making
N a variable. Constants don't seem to cost like routine
calls. Never thought much about it.

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

# nqp -- solve the n-queens problem

use constant N => 10;
use constant VERBOSE => 0;
use constant DEBUG => 0;        # boolean

# This solution uses an imaginary array to represent the
# board.  If this array existed it would be viewed as
# a grid like so:
#
#   0    1     2     ... (n-1)
#   n  (n+1)  (n+2)  ... (2n-1)
#   2n (2n+1) (2n+2) ... (3n-1)
#   .
#   .
#  ((n-1)n)     ...      (nn-1)

my (@q, @row_head, @row_tail);     # the board  <*********<
my \$row = 0;                       # the current rank or row

my (\$rank_loop, \$test_avail, );    # profiling instruments

my \$result = nqs();

if (VERBOSE) {
foreach my \$i ( @\$result) {
&display( \$i);
&graph( \$i);
print "\n";
}
}

print "\nFound ", scalar( @{\$result}),
" solutions for N=", N, ".\n\n";

if ( DEBUG) {
print "\\$rank_loop is \$rank_loop\n";
print "\\$test_avail is \$test_avail\n";
}

exit;
#-------------------

# print the board size and occupied squares
sub display {
my \$b = shift;
print "", N,"Qs: ";
foreach my \$q ( @\$b) {
print "\$q ";
}
print "\n";
}

# print the board state as an ASCII picture
sub graph{
my \$b = shift;
my \$g = ('-' x (N*N));
my @ar;
@ar = split //, \$g;
foreach my \$q ( @\$b) {
\$ar[\$q] = '*';
}
for ( my \$j = 0; \$j < @ar; ++\$j) {
print " \$ar[\$j] ";
print "\n" if ( (\$j+1) % N == 0 );
}
print "\n";
}

use vars "*cq";

# Put a Q in the specified row and return true or on failure undef.
# If the row has no Q, start at head looking for a sq, else start
# looking at square after the  Q already in the row.
# If a Q can not be placed, clear the row and return undef.
#
# This is heavily optimized, that is to say messy.
# The main code optimization is to eliminate a
# &is_available routine call.
#
sub put_q {

my \$i = shift;
*cq = \\$q[\$i];     # symbol table var is faster

if ( ! defined \$cq ){
}else{
++\$cq;
}

my (\$avail, \$c, \$icn_iqn, \$icn );

while ( \$q[\$i] <= \$row_tail[\$i] ){
\$avail = 1;
\$c = \$cq;

\$icn = int(\$c/N);       # Pulled out of below loop

foreach my \$q (@q) {
last if \$q == \$c;  # Always putting last Q in @q
DEBUG && \$test_avail++;

# Check if square is available.
# Note: check along row is not necessary.
# Note: columns are bigger than diagonals
if (
( \$q % N == \$c % N ) or
( (\$icn_iqn = \$icn - int(\$q/N)) ==
(\$c-\$q)/(N+1)) or
( \$icn_iqn == (\$c-\$q)/(N-1))
){
\$avail = 0;
last;
}
}
return \$q[\$i] if \$avail;

++\$cq;
}
\$cq = undef;
}

# The n-Q solver, returns an aref of solutions.
sub nqs {
my \$res = [];

# Setup board, each rank may contain 1 Q.<********<
for my \$i ( 0 ..(N-1) ) {
\$row_tail[\$i] = N*(\$i+1) -1;
\$q[\$i] = undef;
}

# Here is the logic of the solution.    <********<
RANK: {
DEBUG && \$rank_loop++;
if ( defined put_q( \$row)) {
# succeeded placing Q on row
if ( \$row == N-1) {
# have a solution, save it
my @ar  = @q;
push @\$res, \@ar;
redo RANK;
}
++\$row;
redo RANK;
}else{
# clear Q from row and go back
\$q[\$row] = undef;
--\$row;
last if ( \$row < 0);        #  finished
redo RANK;
}
}
return \$res;
};

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://196095]
Front-paged by gmax
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2021-12-06 18:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
R or B?

Results (33 votes). Check out past polls.

Notices?