From
EightQueensProblem.
Another fun toy problem for quickly showing off language features. Summary: how may ways can you place eight queens on a chessboard such that no queens are attacking each other?
- Extra credit: solve for arbitrary square board sizes.
- Extra credit: log the solutions found.
- Extra credit: only count solutions unique through reflection, transposition, and rotation.
- Triple credit: solve for 3-D Chessboard http://www.chessvariants.com/3d.dir/startrek.html
- Extra credit: Make a queen program in InterCal.
Someone pointed to an analysis and
CeeLanguage solution for this on the main
EightQueensProblem page.
The name of this page is misleading. The solutions here shown solve the N-queens problem, not just the
EightQueensProblem. However:
- that's because everyone was going for extra credit
- "eight queens" is the more widely used phrase (seen any non-8x8 chess boards lately?),
- there's no essential difference between 8 and N, so it doesn't matter,
- there was no N-queens problem page at the time this page was created.
- Plus it's (paradoxically) sometimes easier to solve a slightly more general problem than the one you are focused on.
- ... although the C bitboard entry would be hard to extend to more than 8x8 boards.
SmlLanguage
(*
* This was mainly written to show that efficient bit manipulation isn't
* the exclusive right of C. There are more concise ways to count
* n-queens in SML.
*
* To compile and run:
* 1. Install MLton (see http://mlton.org/)
* 2. Save this code as "numQueens.sml".
* 3. Go to the directory where you saved "numQueens.sml".
* 3. Compile: mlton numQueens.sml
* 4. Run: ./numQueens 16
*)
open Word infix 2 andb infix 1 orb infix 0 << >>
val (w2s, s2w) = (Int.toString o toIntX, fromInt o valOf o Int.fromString)
fun nQs m =
let fun search (lb, cb, rb, cnt) =
if ~ 0w1 = cb then cnt+0w1
else let fun lp (bs, cnt) =
if ~ 0w1 = bs then cnt
else case notb bs andb bs+0w1 of
b => lp (bs orb b,
search (lb orb b << 0w1, cb orb b,
rb orb b >> 0w1, cnt))
in lp (lb orb cb orb rb, cnt)
end
in search (0w0, ~ 0w1 >> m, 0w0, 0w0)
end
val m = min (fromInt wordSize, s2w (hd (CommandLine.arguments ()))
handle _ => ~ 0w1)
fun lp n = if m < n then ()
else (app print [w2s n, ": ", w2s (nQs n), " total solutions\n"]
; lp (n+0w1))
val () = lp 0w1
Below run was done on my 1.6GHz Pentium M laptop:
$ time ./numQueens 16
1: 1 total solutions
2: 0 total solutions
3: 0 total solutions
4: 2 total solutions
5: 10 total solutions
6: 4 total solutions
7: 40 total solutions
8: 92 total solutions
9: 352 total solutions
10: 724 total solutions
11: 2680 total solutions
12: 14200 total solutions
13: 73712 total solutions
14: 365596 total solutions
15: 2279184 total solutions
16: 14772512 total solutions
real 0m26.547s
user 0m26.491s
sys 0m0.003s
It is
FasterThanCee (at least until the C folks get their act together).
Nope. You used a faster algorithm than anyone else on this page did. It is well-known that there's a big difference between the obvious algorithms and the fastest known algorithms. You're comparing apples and oranges, and the result just tells us what we already knew, which is that the fast algorithms are faster than the obvious algorithms. Try again with the obvious algorithm.
Actually there are several programs (in various languages) on this page that use essential the same algorithm (as my SML version). To me, this algorithm was obvious. Why implement a slow algorithm in C when you can just as easily implement faster algorithms in higher level languages?
In my case, because I had a personal interest in the smallest number of lines of code, but that's fine, use whatever algorithm you like -- but the conclusion is that it is the algorithm that is faster, not the language.
The C version already uses a very different representation of search state (bit vector), as well as a different search algorithm (DFS), compared to some of the other solutions (e.g. Haskell uses lists and the order of evaluation order of Haskell code isn't fixed). You've been comparing apples and oranges long before I came along.
SML and some other languages are in fact sometimes faster than C, using the same algorithm, but you'll never know without a head-to-head comparison.
Why don't you just rewrite the C version instead of bitching and moaning? The better algorithm will, most likely, be even shorter than the current one (speaking of the C version). And I would be surprised if it wasn't AsFastAsSml
?.
Also, it is a category mistake to say that a language is faster/slower than some other language.
True.
I don't see how to use a better algorithm and be even shorter; why do you think that's possible?
There is no fundamental reason why a better algorithm would need to be longer. However, the reason why I think that it is possible, in this case, is that I can visualize how the code will roughly look like (I've written hundreds of thousands of lines of C and C++ code over the years). Geez, do I really have to do everything?
#include <stdio.h>
#include <stdlib.h>
#include <limits.h>
typedef unsigned long ulong;
static const ulong ulong_bit = sizeof(ulong) * CHAR_BIT;
static inline ulong search(ulong lb, ulong cb, ulong rb, ulong cnt) {
if (~0ul == cb)
cnt += 1;
else
for (ulong bs = lb | cb | rb; ~0ul != bs;) {
ulong b = ~bs & (bs+1);
bs |= b;
cnt = search((lb | b) << 1, cb | b, (rb | b) >> 1, cnt);
}
return cnt;
}
static inline ulong nQs(ulong m) { return search(0, ~0ul >> m, 0, 0); }
int main(int argc, char* argv[]) {
ulong a = argc < 2 ? ulong_bit : atol(argv[1]);
ulong n = a < ulong_bit ? a : ulong_bit;
for (ulong i=1; i<=n; ++i)
printf("%li: %li total solutions\n", i, nQs(i));
return 0;
}
Unsurprisingly, it is faster on my laptop (at least when compiled on gcc 4.0.3 with -O2 or -O3) than the MLton compiled SML version. Happy now? ;-)
CeeLanguage -- tiny
This version attempts very short source code (for C, that is), and is just about the same length as the Lisp version below, which I will call a moral victory for a C program :-) It uses bit vectors for simplicity and speed -- valid up to the bit word length of the machine (e.g. 32x32 on a 32 bit machine).
It cranked out the solution to all boards up to 14x14 in 3.3 seconds, and to 15x15 in 21 seconds, whereas other language solutions went up to only 12x12 or 13x13 (presumably due to speed issues) so that seems reasonably fast. 2Ghz Athlon cpu. See
AsFastAsCee ;-) --
DougMerritt
inline int calcDiag1Bit(int max, int row, int col) { return 1 << (max-col-row); }
inline int calcDiag2Bit(int max, int row, int col) { return calcDiag1Bit(max, row, max-col); }
int solve(int max, int solutions, int *rowsUsed, int row, int col, int allCols,
int diag1, int diag2) {
int rowBit, colBit, diag1bit, diag2bit;
for (col=0; col<max; col++) {
if (allCols & (colBit=(1 << col))) continue;
if (diag1 & (diag1bit=calcDiag1Bit(max, row, col))) continue;
if (diag2 & (diag2bit=calcDiag2Bit(max, row, col))) continue;
rowsUsed[row] = col;
if (row >= (max-1))
++solutions;
else
solutions = solve(max, solutions, rowsUsed, row+1, col,
allCols|colBit, diag1|diag1bit, diag2|diag2bit);
}
rowsUsed[row] = -1;
return solutions;
}
int main() {
int i, solutions, rowsUsed[32];
for (i=0; i<32; i++)
rowsUsed[i] = -1;
for (i=1; i<15; i++) {
solutions = solve(i, 0, rowsUsed, 0, 0, 0, 0, 0);
printf("%d: %d total solutions\n", i, solutions);
}
}
Output:
1: 1 total solutions
2: 0 total solutions
3: 0 total solutions
4: 2 total solutions
5: 10 total solutions
6: 4 total solutions
7: 40 total solutions
8: 92 total solutions
9: 352 total solutions
10: 724 total solutions
11: 2680 total solutions
12: 14200 total solutions
13: 73712 total solutions
14: 365596 total solutions
A later run revealed 2279184 solutions for a 15x15 board in 21 seconds, 14772512 solutions for a 16x16 board in 3 min 13 sec.
While I agree that this is a *concise* solution for the C language, it has a flaw: premature optimization. By concentrating on bit-fiddling instead of algorithms, you can fall into the classic trap; The result here is that this code is actually quite slow because it uses a somewhat poor algorithm. By comparison, I have some optimized C code that will do the 15x15 case in 8 seconds on a 500Mhz P3, so more than an order of magnitude gain (I will try and dig up a link for this, it isn't my code). So I guess if your goal is to write the shortest C version you can, you are part way there --- but if you want the fastest there is a lot of room for improvement.
Disagree; the primary motivation for everything was to be concise, including the bit twiddling: it allows testing of many values in parallel, which makes the code significantly shorter than if those values were in an array.
Secondarily I tried to avoid slowing it down unnecessarily, so there were various small things I did, such as throwing in "inline" declarations. This isn't premature optimization, because I was already committed to the algorithm at that point. To my mind, there's a big difference between avoiding pessimizing and actual optimization, because a tiny amount of pessimization avoidance isn't subject to the same critique that premature optimization is.
I wasn't attempting the absolute fastest possible C solution, just a reasonably fast one, but I would be interested in seeing yours.
However, note that your arithemetic is off...that would be 3.5 times faster than my second claim of 28 seconds, not "an order of magnitude". That was a typo; my first claim further up above is correct: 21 seconds, so that's 2.6 times faster. (I've now fixed both figures to be "21".)
- Oops...you said 500Mhz. Well, post it and I'll see what it's like on my Athlon, which may or may not actually be 4 times faster for this application.
I would think that a very small algorithm that's within a factor of 2 in speed of the (let's assume) fastest possible but much longer algorithm is not bad at all.
You also need to account for the order of growth of each algorithm. For instance, comparing the number of inner loops of the first two ForthLanguage entries as N goes from 8 to 12, the first method does 4.3x, 4.4x, 4.8x, and 5.2x times more work for successive N, but the second method (like the Haskell entry) does 5.2x, 5.3x, 5.7x, and 6.1x more work as N increases. No matter how much more optimized the second program is, there will be an N where the first method eventually surpasses it.
Anyway, those are all side issues; a concise expression was my primary goal, and I'm fairly happy with the result. I know bit twiddling has a bad reputation, but personally I think it is quite elegant in this particular solution.
LispLanguage
There are several variants of this problem. Here is some Lisp code to generate a list of all solutions for a given board size (i.e. and n-Queens problem). Solutions are represented by lists of (row . col) pairs. This can probably be improved quite a bit.
(defun n-queens (dimension)
(macrolet ((row (x) `(car ,x))
(col (x) `(cdr ,x)))
(labels ((in-threat (pos1 pos2)
(or (= (row pos1) (row pos2)) (= (col pos1) (col pos2))
(= (- (row pos1) (col pos1)) (- (row pos2) (col pos2)))
(= (+ (row pos1) (col pos1)) (+ (row pos2) (col pos2)))))
(test-pos (pos1 partial-soln)
(dolist (pos2 partial-soln t)
(when (in-threat pos1 pos2)
(return nil))))
(all-cols (row) (loop for col below dimension collecting (cons row col))))
(do ((row 1 (1+ row))
(candidates (all-cols 1))
(solns (mapcar #'list (all-cols 0))))
((>= row dimension) (mapcar #'nreverse solns))
(setf candidates (all-cols row)
solns (loop for soln in solns
for res = (loop for pos in candidates
when (test-pos pos soln)
collect (cons pos soln))
unless (null res)
append res))))))
Mirroring the below table:
CL-USER> (dotimes (n 14) (format t "The ~A-queens problem has ~A solutions.~%" n (length (n-queens n))))
The 0-queens problem has 0 solutions.
The 1-queens problem has 1 solutions.
The 2-queens problem has 0 solutions.
The 3-queens problem has 0 solutions.
The 4-queens problem has 2 solutions.
The 5-queens problem has 10 solutions.
The 6-queens problem has 4 solutions.
The 7-queens problem has 40 solutions.
The 8-queens problem has 92 solutions.
The 9-queens problem has 352 solutions.
The 10-queens problem has 724 solutions.
The 11-queens problem has 2680 solutions.
The 12-queens problem has 14200 solutions.
The 13-queens problem has 73712 solutions.
Interpreted (not compiled) in GNU Clisp, it took 70 seconds to solve up to 11x11 on a 2Ghz Athlon.
This is pretty unfair to lisp, since uncompiled is very unusual, and the above code is (intentionally) not optimized. It is much easier to follow that the bit-fiddling approach (which could also be done in lisp, of course). Furthermore, the lisp actually constructs and reports each solution in an easily readable form. I haven't done it, but from experience with similar things, i expect within a factor of 2x the above c shoudln't be difficult. Probably while maintaining the much more readable/maintainable structure of the lisp code. By the way of somewhat useless comparison, the above code is more than 10x faster by merely compiling it with cmucl, no optimizations (or declarations) at all.
There's nothing unfair about it; I was very careful to say "Interpreted (not compiled)", so that no one would be mislead.
The rest of your bitching and moaning should simply be replaced with a report on how fast it runs when compiled -- obviously it will be much faster. I would have compiled it myself, except I misplaced my cmucl executable when doing rebuilds from source recently.
As for the tradeoff between one algorithm and another in terms of readability and speed, yes, that's always an issue, in every language. I think that bit twiddling is overly maligned, though, because sometimes its compactness improves readability over a longer non-twiddling algorithm. Sometimes.
I think `bitching and moaning' is a bit much. I was trying to make two points: First, that this was an apples and oranges comparison (the algorithms don't do the same thing, and only one of them has been optimized). And second, there is (for whatever reason) a common misconception in the programming world that Lisp is interpreted or byte-compiled. With another language, I probably would have just left your comment as it stands --- however, many people seem to be quite surprised by the fact that the normal case for lisp is to generate native machine code (and pretty efficient code at that). You are quite right about the tradeoffs, sometimes bit fiddling is the thing to do (I did mention that you could do this in lisp as well), but this isn't a good example. In this case, it certainly has reduced the readability/maintainability without approaching optimal performance. If our goal is to write the fastesd n-queens routine we can, then it may be the proper approach to use low-level techniques (although at that point, asm might be the way to go also) but only *after* algorithm analysis. See comments above.
Agreed -- largely. But do note that all I was doing was running the existing language samples to add timings; clearly this is not a scientific way to thoroughly compare the speeds of the languages concerned (which is difficult to do), but it isn't a meaningless thing to do either. It adds information that the original authors left out, that's all.
I think it was left out because it wasn't particularly interesting. Now we seem to have started a conversation about "opimizing n-queens".
- Well...I have to admit that the many comments that "my favorite language will be faster than C reall soon now" irritate me, and that was in the back of my mind when I started timing. The thing about C is that although it's not very modern, it is missing many features, it is bug prone, hard to write highly readable programs, etc, on the other hand, it does tend to be fast. :-) Often that doesn't matter, but sometimes it does, and 8 queens actually is an instance where it does matter, because it is infeasible to find solutions for N > threshold, partly just depending on the language.
Oh, wait...you're saying my bit twiddling reduced readability/maintainability? No, I disagree. Bit manipulation is idiomatic in C, you can't just condemn it outright. Any experienced C programmer will have no troubles.
I wouldn't do that in Smalltalk or Lisp, because they have different idioms. But idioms and idiom guidelines do not, in general, cross language boundaries.
I actually know C a lot better than Lisp; your C solution is not a particularly readable C. And note that nowhere did I condemn bit-twiddling outright; I often use it myself where it is appropriate. Your solution isn't terrible, and comments would address some of this (it certainly isn't heading into the domain of IOCC). The algorithm used in the lisp version is not at all optimal, but very easy to understand. Not true for your algorithm, whether in C or in Lisp. I understand what you did and why, but I can't take seriously a claim that the C code is equivalently readable (for someone versed in both languages, of course). So you see my point was not about idiomatic C vs. idiomatic Lisp, but more about simple algorithms clearly presented vs. speed hacks that are harder to understand and verify. There are places for both (but the second should *always* be avoided unless and until it has been shown to be necessary). You are right about the difficulty of comparing languages. In order to do that, we would have to compare the same algorithms, probably two of them: one for speed of execution (and then you are really comparing compilers) and one for generality (for example, implement the algorithm shown in lisp in C). One nice thing about the lisp version is that it took about 5 minutes to write and verify (the only 'error' was I hadn't thought to reverse the solutions at the end, but that was really aesthetic). I doubt I could have written the C version that fast.
Nor I. That's one of the nice things about Lisp. But although the Lisp version is more readable than my C version, that's apples to oranges. IMHO my C version is more readable than the original C version below; the only thing in mine that is difficult is the mapping from (row,column) to a bit vector -- but bit twiddling is normal in C, so there's tons of it in the original below. You're complaining about my bit twiddling? By C standards, I
minimized the amount of it. ;-)
["Tastes great! ...Less filling!" ;) One person's inscrutible hack is another's idiom. As with all writing, code and comments should be targeted at the audience. In this case, probably the casual programmer who wants to see how different languages attack problems in different ways. Perhaps the person is shopping for a new language. But that audience is likely neither expert in the problem domain nor the languages involved, so the comments should be detailed in both regards. Personally, I don't think
any of the code on this page (or the other language comparison pages) is commented anywhere near well enough for that audience. Personally (C: fluent, Lisp: literate), neither the Lisp nor the tiny C is transparent enough to stand without commentary. It seems that most contributors are more concerned with showing off how few lines/words/characters they can use to solve a problem than how readable their code ends up to the lay programmer. --
IanOsgood (P.S. Of course my own Forth and C entries are perfectly transparent! *ahem* ;) Seriously, I gladly welcome constructive criticism of the clarity of my code.]
Ian, I find your comments interesting. I was not going for brevity with the Lisp solution, it was just a one-pass implementation of one fairly obvious algorithm for this. I would have thought that if you a) understand the problem and b) are Lisp literate, then that solution would pretty much stand on its own (although I could have/should have added a couple of comments about the candidates loop). It seems I was wrong! Certainly the code on a page like this shouldn't duplicate comments about the problem itself...
[Well, perhaps Lisp semi-literate. I mostly learned through implementing the language in the eighties, and know little about macros, 'when', 'unless', and other new-fangled stuff. (All right, call me Lisp illiterate or archaic even. Maybe I should put
LispMe on my toy next to
QuartusForth so I can do some brushing up.)]
Ah, ok I see then. Lisp, without quantifiers, means CommonLisp these days and so the unfamiliar elements for you are actually standard and idiomatic. LispME is, in fact a scheme implemementation, so while it would be fun to play with it won't help you get used to standard lisp :)
Speaking of Scheme...
SchemeLanguage
I wrote this to help me learn Scheme. It's entirely unoptimized, and I focused on readability instead of terseness. If you can make it better, please do.
(define (make-queen row col) (list row col))
(define (get-row queen) (car queen))
(define (get-col queen) (cadr queen))
(define (same-row? nq oq) (= (get-row nq) (get-row oq)))
(define (same-col? nq oq) (= (get-col nq) (get-col oq)))
(define (same-diag? nq oq)
(= (abs (- (get-row nq) (get-row oq)))
(abs (- (get-col nq) (get-col oq)))))
(define (attacks? nq oq)
(or (same-row? nq oq) (same-col? nq oq) (same-diag? nq oq)))
(define (safe? target queens)
(cond ((null? queens) #t)
((attacks? target (car queens)) #f)
(else (safe? target (cdr queens)))))
; Solve for a board size of sz.
(define (solve sz)
(define (s-rec sz x y pos sols)
(cond
; If we've advanced past the last column, we have a solution.
; (By the way, the reverse is because pos is built up backward.)
((> x sz) (cons (reverse pos) sols))
; If we've advanced past the last row, we have a failure.
((> y sz) sols)
; If the queen is safe, the fun begins.
((safe? (make-queen x y) pos)
; This is the backtracking call. This is executed once
; the inner call is complete.
(s-rec sz x (+ y 1) pos
; Run the next column first; if any solutions
; result, they need to be passed to the backtracked
; call.
(s-rec sz (+ x 1) 1
; Add this queen when considering the next
; column's placement.
(cons (make-queen x y) pos)
sols)))
; If this queen isn't safe, move on to the next row.
(else (s-rec sz x (+ y 1) pos sols))))
; Start the recursion.
(s-rec sz 1 1 '() '()))
(define (show-queens n)
(display (list "The" n "queens problem has"
(length (solve n))
"solutions."))
(newline))
Results:
> (for-each show-queens '(1 2 3 4 5 6 7 8 9 10 11))
(The 1 queens problem has 1 solutions.)
(The 2 queens problem has 0 solutions.)
(The 3 queens problem has 0 solutions.)
(The 4 queens problem has 2 solutions.)
(The 5 queens problem has 10 solutions.)
(The 6 queens problem has 4 solutions.)
(The 7 queens problem has 40 solutions.)
(The 8 queens problem has 92 solutions.)
(The 9 queens problem has 352 solutions.)
(The 10 queens problem has 724 solutions.)
(The 11 queens problem has 2680 solutions.)
CeeLanguage
/* 8 Queens problem, bitboard approach */
#include <stdio.h>
typedef unsigned long long BitBoard?; // 64 bits for an 8x8 chess board
void print_board(BitBoard? b) // top left is rank 0, file 0
{
int r,f;
for (r=0; r<8; r++) {
for (f=0; f<8; f++, b>>=1) {
putchar( ' ' );
putchar( (b&1) ? 'Q' : '.' );
}
putchar('\n');
}
putchar('\n');
}
/* masks for eliminating possible queen positions from future tries */
/* they are indexed by rank (then shifted by file) */
BitBoard? attacks[8] = {
~0x81412111090503ffLL, // 00000000 (bit pattern for attacks[0]
~0x412111090503ff03LL, // 00111111 in the order shown by print_board)
~0x2111090503ff0305LL, // 01011111
~0x11090503ff030509LL, // 01101111
~0x090503ff03050911LL, // 01110111
~0x0503ff0305091121LL, // 01111011
~0x03ff030509112141LL, // 01111101
~0xff03050911214181LL // 01111110
};
/* code to calculate attacks at runtime:
BitBoard? attacksForRank(int r0)
{
BitBoard? b = 0;
int r = 0;
while (r < r0) { // diagonal attack
b <<= 8; b |= 1 | 1<<(r0-r); r++;
}
b <<= 8; b |= 0xff; r++; // horizontal attack
while (r < 8) { // diagonal attack
b <<= 8; b |= 1 | 1<<(r-r0); r++;
}
return b;
}
void init_attacks()
{
int r;
for (r=0; r<8; r++) {
attacks[r] = ~attacksForRank(7-r);
}
}
*/
int count = 0; // should be 92
int nodes = 0; // should be 1965
/* try placing queens (q) along file f and recurse to subsequent files */
/* BitBoard? b accumulates a solution, and left tracks possible */
/* future queen positions */
BitBoard? b = 0;
void try_file(int f, BitBoard? left)
{
BitBoard? q = 1<<f;
int r = 0;
nodes++;
while (r < 8) {
if (left & q) {
b ^= q;
if (f < 7) {
try_file(f+1, left & (attacks[r]<<f));
} else {
print_board(b); count++;
}
b ^= q;
}
r++; q <<= 8; // next rank
}
}
main()
{ // init_attacks();
try_file(0, ~0); // ~0: all bits set
printf("%d solutions, %d nodes\n", count, nodes);
}
0.000 seconds to solve 8x8 on 2Ghz Athlon (does not generalize to NxN)
ForthLanguage
\ constants and utilities shared by the various approaches
12 constant maxN
8 value N
: Nbits ( -- mask ) 1 N lshift 1- ;
: lowBit ( mask -- bit ) dup negate and ;
: lowBit- ( mask -- bits ) dup 1- and ;
variable solutions variable nodes variable inner
\ first approach N=8: 92 1073 4380
\ second approach N=8: 92 1964 46752
\ third approach N=8: 92 1965
First approach: track attacks on upcoming ranks.
\ Triangular array of bitmasks, one bit per square
\ recursion depth 0, ranks 0..N-1 are at offsets 0..N-1
\ recursion depth 1, ranks 1..N-1 are at offsets N..N+(N-1)-1
\ etc.
create ranks maxN dup 1+ * 2/ cells allot
: init-ranks
Nbits N 0 do dup ranks I cells + ! loop drop ;
: .sq 1 and if [char] Q else [char] . then space emit ;
: .rank ( mask -- ) N 0 do dup .sq 2/ loop drop cr ;
: .solution \ a solution is encoded in ranks
N ranks begin
dup @ lowBit .rank
over cells + swap 1- swap
over 0= until 2drop cr ;
\ Copy the square availability from the current ranks
\ to the next ranks, excluding attacks by the new queen
\ at nextBit of ^rank.
\ Aborts if there is no possible solution from here.
: exclude ( ranksLeft ^rank -- tf )
over 1- cells over + swap rot ( dest src ranksLeft )
1 do 1 inner +!
2dup dup @ lowBit ( dest src mask ) \ file
dup I lshift or \ left diagonal
dup I rshift or invert \ right diagonal
swap I cells + @ and ( dest masked )
dup 0= if 2drop 2drop unloop false exit then
swap I cells + !
loop 2drop true ;
: tryRank ( ranksLeft ^rank -- ) 1 nodes +!
begin
over 1- if
2dup exclude if
over 1- 2dup 1+ cells + recurse
then
else ( .solution) 1 solutions +! then
dup @ lowBit- dup
while over !
repeat drop 2drop ;
: queens init-ranks N ranks tryRank ;
A smaller but less efficient approach, similar to the Haskell entry below.
create files maxN allot \ Q file per rank
: .sol2 cr N 0 do I files + c@ . loop ;
: safe? ( file rank -- ? )
dup 0 do 1 inner +!
over I files + c@ -
dup 0= if nip nip ( false ) unloop exit then
abs I + over = if 2drop false unloop exit then
loop 2drop true ;
: tryRank2 ( rank -- rank )
dup N = if ( .sol2) 1 solutions +! exit then 1 nodes +!
N 0 do I over safe? if
I over files + c! 1+ recurse 1-
then loop ;
: queens2 1 N 0 do I files c! tryRank2 loop drop ;
This is fastest so far, the elegant approach used by the MCPL entry. Instead of tracking attacks on all future ranks in memory, the attacks of placed queens along files and both diagonals relative to the current rank are carried forward on the stack through the recursion.
: .sol3 ( fn ... f1 x x f0 -- unchanged )
dup N 0 do
I 3 * 4 + pick ( fi fi+1 )
2dup xor .rank nip
loop drop cr ;
: third ( a b c -- a b c a ) 2 pick ; \ >r over r> swap ;
: poss ( a b c -- a b c a&b&c ) dup 2over and and ;
: next3 ( dl dr f Qfilebit -- dl dr f dl' dr' f' )
invert >r third r@ and 2* 1+ third r@ and 2/ third r> and ;
: try ( dl dr f -- ) \ bitmasks for unused diagonals and files
dup if 1 nodes +! poss
begin ?dup while
dup >r lowBit next3 recurse r> lowBit-
repeat
else ( .sol3) 1 solutions +! then drop 2drop ;
: queens3 -1 dup Nbits try ;
Test harness for all methods:
: harness ( 'method -- ) 0 solutions ! 0 nodes ! 0 inner ! cr execute
N . ." queens: " solutions @ . ." solutions, "
nodes @ . ." nodes" inner @ ?dup if . ." , inner loops" then ;
: test ( "method" -- ) ' maxN 0 do I 1+ to N dup harness loop drop ;
test queens
test queens2 \ queens2 takes 10x longer to finish up to N=12, using 20x more inner loops
test queens3 \ about 33% faster than the first approach
Approach #1, "queens": 1.2 seconds to generate all NxN up to 12x12 using GNU Gforth on 2Ghz Athlon (12.5 sec with approach #2, "queens2"); 37.0 seconds to generate up to 14x14.
PerlLanguage
#!/usr/bin/perl -l
sub placequeen
{
$_[0]=~/^(.)(.*(.))(??{abs$1-$3!=length$2 && 'x'})/ ? () :
length $_[0] == 8 ? @_ : map $_[0]=~$_?():placequeen("$_@_"), 0..7
}
print map '.'x$_.'Q'.'.'x(7-$_)."\n", /./g for placequeen;
Slightly generalized by another contributor...
#!/usr/bin/perl -l
sub placequeen {
$_[0]=~/^(.)(.*(.))(??{abs$1-$3!=length$2 && 'x'})/ ? () :
length $_[0] == ($ARGV[0]-0) ? @_ : map $_[0]=~$_?():placequeen("$_@_"), 0..($ARGV[0]-1)
}
print map '.'x$_.'Q'.'.'x(($ARGV[0]-1)-$_)."\n", /./g for placequeen;
Just kidding (because some expect it of perl)...
#!/usr/bin/perl -l
sub placequeen
{
return if $_[0] =~ /^((.).*\2|
0(1|.2|..3|...4|....5|.....6|......7)|
1(0|2|.3|..4|...5|....6|.....7)|
2(.0|1|3|.4|..5|...6|....7)|
3(..0|.1|2|4|.5|..6|...7)|
4(...0|..1|.2|3|5|.6|..7)|
5(....0|...1|..2|.3|4|6|.7)|
6(.....0|....1|...2|..3|.4|5|7)|
7(......0|.....1|....2|...3|..4|.5|6) )/x;
if(length $_[0] < 8) # recurse for next queen
{
placequeen("$_@_") for 0..7;
}
else # found a solution, print it...
{
print map '.'x$_.'Q'.'.'x(7 - $_)."\n", $_[0] =~ /./g;
}
}
placequeen; # start with no rows placed
using a digit from 0 to 7 inclusive for each row, where the digit
represents the column number of the queen in that row.
The second version reduces the problem to its five basic elements (statements),
a validity test, a success test, a recursion to the next row,
a printout of the board, and a starting point.
0.04 seconds to generate 8x8 only (with board-printing code deleted) on 2Ghz Athlon.
McplLanguage:
GET "mcpl.h"
STATIC count, all
FUN try
: ?, =all, ? => count++
: ld, cols, rd => LET poss = ~(ld | cols | rd) & all
WHILE poss DO
{ LET bit = poss & -poss
poss -:= bit
try( (ld|bit)<<1, cols|bit, (rd|bit)>>1 )
}
FUN start : =>
all := 1
FOR n = 1 TO 12 DO
{ count := 0
try(0, 0, 0)
writef("There are %5d solutions to %2d-queens problem\n",
count, n )
all := 2*all + 1
}
RETURN 0
Output:
There are 1 solutions to 1-queens problem
There are 0 solutions to 2-queens problem
There are 0 solutions to 3-queens problem
There are 2 solutions to 4-queens problem
There are 10 solutions to 5-queens problem
There are 4 solutions to 6-queens problem
There are 40 solutions to 7-queens problem
There are 92 solutions to 8-queens problem
There are 352 solutions to 9-queens problem
There are 724 solutions to 10-queens problem
There are 2680 solutions to 11-queens problem
There are 14200 solutions to 12-queens problem
HaskellLanguage:
queens 0 = [[]]
queens (n+1) = [ q:b | b <- queens n; q <- [0..7]; safe q b ]
safe q b = and [ not checks q b i | i <- [0..(b-1)] ]
checks q b i = q=b!!i || abs(q - b!!i)=i+1
HUGS wouldn't run this, I must be making a newbie mistake.
Hmm... quite a few syntactic errors in the code above (where did it come from?).
Try this (from
http://www.haskell.org/pipermail/haskell-cafe/2004-March/005872.html):
boardSize = 8
queens 0 = [[]]
queens n = [ x : y | y <- queens (n-1), x <- [1..boardSize], safe x y 1]
safe x [] n = True
safe x (c:y) n = and [ x /= c , x /= c + n , x /= c - n , safe x y (n+1)]
using a fold:
import Control.Monad
queens boardSize = foldM (\y _ -> [ x : y | x <- [1..boardSize], safe x y 1]) [] [1..boardSize]
safe x [] n = True
safe x (c:y) n = and [ x /= c , x /= c + n , x /= c - n , safe x y (n+1)]
RubyLanguage:
def safe?(col, others)
others.each_with_index do |c, r|
return false if col == c or (col - c).abs == (others.size - r).abs
end
end
def solve(n, solutions = [], cols=[])
return solutions.push(cols) unless cols.size < n
n.times { |col| solve(n, solutions, cols + [col]) if safe?(col, cols) }
return solutions
end
def show_solutions(n)
solutions = solve(n)
puts "There are #{solutions.size} solutions for n = #{n}."
for cols in solutions
puts '', cols.map { |c| (0...n).map { |i| i == c ? 'Q' : '.' }.join }
end
end
--
JasonArhart
PythonLanguage:
NQUEENS = 8
def attack((row1, col1), (row2, col2)):
return (row1 == row2) or (col1 == col2) or abs(row1 - row2) == abs(col1 - col2)
def safe(square, queens):
for queen in queens:
if attack(square, queen): return 0
return 1
def solve(n):
if n == 0: return [[]]
smaller_solutions = solve(n-1)
return [solution+[(n,i+1)]
for i in range(NQUEENS)
for solution in smaller_solutions
if safe((n,i+1), solution)]
for answer in solve(NQUEENS): print answer
Here is an animated version using the
GuidoVanRobot toolkit:
from powerMode import *
def main():
world.positionRobot(1,1, 'E')
world.setWall(1, 8, 'N', 8)
world.setWall(8, 1, 'E', 8)
setDelayAmount(0.002)
beginDisplay(11, 11)
placeQueens(1)
turnoff()
def placeQueens(x):
if x > 8:
printSolution()
takeVictoryLap()
# be greedy, return False
# so we can find the next
# solution
return False
y = 1
while y <= 8:
if placeQueen(x,y):
if placeQueens(x+1):
return True
goto(x, y)
pickbeeper()
y += 1
return False
def placeQueen(x, y):
goto(x,y)
if underAttack(x,y):
return False
placeBeeper()
return True
def printSolution():
positions = []
for x in range(8):
for y in range(8):
if world.beepers.get((x,y), 0):
positions.append((x,y))
print positions
def underAttack(x, y):
for i in range(x):
if world.beepers.get((x-i, y), 0):
return True
if world.beepers.get((x-i, y+i), 0):
return True
if world.beepers.get((x-i, y-i), 0):
return True
return False
def goto(x,y):
curX, curY = world.robot
if curX < x:
while curX < x:
move()
curX += 1
elif curX > x:
turnaround()
while curX > x:
move()
curX -= 1
turnaround()
if curY < y:
turnleft()
while curY < y:
move()
curY += 1
turnright()
elif curY > y:
turnright()
while curY > y:
move()
curY -= 1
turnleft()
return True
def takeVictoryLap():
setDelayAmount(0.1)
goto(8,8)
goto(1,8)
goto(1,1)
goto(8,1)
goto(8,8)
goto(1,8)
goto(1,1)
setDelayAmount(0.002)
def placeBeeper():
world.robotBeepers += 1
putbeeper()
def turnaround():
turnleft()
turnleft()
def turnright():
turnaround()
turnleft()
main()
--
SteveHowell
Sather See
SatherLanguage
-- From: http://www.fleiner.com/claudio/benchmarks/data/queen.sa
-- Copyright (C) International Computer Science Institute, 1995. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--
-- solves the N queen problem
-- Version 1.0, June 1996, by Claudio Fleiner
class QUEEN is
include AREF{CHAR};
shared print_result:BOOL:=false;
str:STR is
res::="QUEENS: ";
loop res:=res+aelt!.int+" "; end;
res:=res+"\n";
return res;
end;
print is #OUT+str; end;
pos(x:INT):INT is
count::=0;
if x=asize then
if print_result then print; end;
return 1;
else
loop i::=asize.times!;
if [i]=0.char then
ok::=true;
loop while!(ok);
j::=asize.times!;
ok:=[j].int=0 or (x+1-[j].int/=i-j and x+1-[j].int/=j-i);
end;
if ok then
[i]:=(x+1).char;
count:=count+pos(x+1);
[i]:=0.char;
end;
end;
end;
end;
return count;
end;
pos:INT is return pos(0); end;
end;
class MAIN is
test is
b::=#QUEEN(8);
QUEEN::print_result:=true;
#OUT+("found "+b.pos+" solutions for the 8 - queen problem\n");
end;
usage is
#ERR+"USAGE: queen TEST | [-p] size\n";
end;
main(argv:ARRAY{STR}):INT is
size::=0;
if argv.size=2 and argv[1]="TEST" then test; return 0; end;
if argv.size=3 then
if argv[1]="-p" then QUEEN::print_result:=true;
else usage; return 1; end;
size:=#INT(argv[2]);
elsif argv.size=2 then
size:=#INT(argv[1]);
else
usage; return 1;
end;
if size<1 or size>99 then usage; return 1; end;
b::=#QUEEN(size);
t::=#TIMES;
found::=b.pos;
d::=t.elapsed;
#OUT+"found "+found+" solutions for the "+size+" - queen problem\n";
#OUT+d.str;
return 0;
end;
end;
J see
JayLanguage
queens=: 3 : 0
z=.i.n,*n=.y
for. }.z do.
b=. -. (i.n) e."1 ,. z +"1 _ ((-i.){:$z) */ _1 0 1
z=. ((+/"1 b)#z),.(,b)#(*/$b)$i.n
end.
)
from
http://jsoftware.com/jwiki/Essays/N_Queens_Problem
or shorter
queens =: (](1&=@(>./@(+/,+//.,+//.@|.))"2#])@,/@:((],"_ _ 1=@i.@#@{.)"2)^:[(1 0&,$0:))
Contributors:
IanOsgood,
DanielSheppard,
DougMerritt,
BenjaminGeiger
CategoryInManyProgrammingLanguages