aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

tasks a-s

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 23:57:08 -07:00
parent 47bf37c096
commit b83f433714
12433 changed files with 156208 additions and 123 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Task/N-queens-problem/0DESCRIPTION Normal file
View file

@ -0,0 +1,4 @@
Solve the [[WP:Eight_queens_puzzle|eight queens puzzle]]. You can extend the problem to solve the puzzle with a board of side NxN.
;Cf.
* [[Knight's tour]]

51
Task/N-queens-problem/ALGOL-68/n-queens-problem.alg Normal file
View file

@ -0,0 +1,51 @@
INT ofs = 1, # Algol68 normally uses array offset of 1 #
dim = 8; # dim X dim chess board #
[ofs:dim+ofs-1]INT b;
PROC unsafe = (INT y)BOOL:(
INT i, t, x;
x := b[y];
FOR i TO y - LWB b DO
t := b[y - i];
IF t = x THEN break true
ELIF t = x - i THEN break true
ELIF t = x + i THEN break true
FI
OD;
FALSE EXIT
break true:
TRUE
);
INT s := 0;
PROC print board = VOID:(
INT x, y;
print((new line, "Solution # ", s+:=1, new line));
FOR y FROM LWB b TO UPB b DO
FOR x FROM LWB b TO UPB b DO
print("|"+(b[y]=x|"Q"|: ODD(x+y)|"/"|" "))
OD;
print(("|", new line))
OD
);
main: (
INT y := LWB b;
b[LWB b] := LWB b - 1;
FOR i WHILE y >= LWB b DO
WHILE
b[y]+:=1;
# BREAK # IF b[y] <= UPB b THEN unsafe(y) ELSE FALSE FI
DO SKIP OD;
IF b[y] <= UPB b THEN
IF y < UPB b THEN
b[y+:=1] := LWB b - 1
ELSE
print board
FI
ELSE
y-:=1
FI
OD
)

50
Task/N-queens-problem/Ada/n-queens-problem.ada Normal file
View file

@ -0,0 +1,50 @@
with Ada.Text_IO; use Ada.Text_IO;
procedure Queens is
Board : array (1..8, 1..8) of Boolean := (others => (others => False));
function Test (Row, Column : Integer) return Boolean is
begin
for J in 1..Column - 1 loop
if ( Board (Row, J)
or else
(Row > J and then Board (Row - J, Column - J))
or else
(Row + J <= 8 and then Board (Row + J, Column - J))
) then
return False;
end if;
end loop;
return True;
end Test;
function Fill (Column : Integer) return Boolean is
begin
for Row in Board'Range (1) loop
if Test (Row, Column) then
Board (Row, Column) := True;
if Column = 8 or else Fill (Column + 1) then
return True;
end if;
Board (Row, Column) := False;
end if;
end loop;
return False;
end Fill;
begin
if not Fill (1) then
raise Program_Error;
end if;
for I in Board'Range (1) loop
Put (Integer'Image (9 - I));
for J in Board'Range (2) loop
if Board (I, J) then
Put ("|Q");
elsif (I + J) mod 2 = 1 then
Put ("|/");
else
Put ("| ");
end if;
end loop;
Put_Line ("|");
end loop;
Put_Line (" A B C D E F G H");
end Queens;

80
Task/N-queens-problem/AutoHotkey/n-queens-problem-1.ahk Normal file
View file

@ -0,0 +1,80 @@
;
; Post: http://www.autohotkey.com/forum/viewtopic.php?p=353059#353059
; Timestamp: 05/may/2010
;
MsgBox % funcNQP(5)
MsgBox % funcNQP(8)
Return
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ** USED VARIABLES **
;
; Global: All variables named Array[???]
;
; Function funcNPQ: nQueens , OutText , qIndex
;
; Function Unsafe: nIndex , Idx , Tmp , Aux
;
; Function PutBoard: Output , QueensN , Stc , xxx , yyy
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
funcNQP(nQueens)
{
Global
Array[0] := -1
Local OutText , qIndex := 0
While ( qIndex >= 0 )
{
Array[%qIndex%]++
While ( (Array[%qIndex%] < nQueens) && Unsafe(qIndex) )
Array[%qIndex%]++
If ( Array[%qIndex%] < nQueens )
{
If ( qIndex < nQueens-1 )
qIndex++ , Array[%qIndex%] := -1
Else
PutBoard(OutText,nQueens)
}
Else
qIndex--
}
Return OutText
}
;------------------------------------------
Unsafe(nIndex)
{
Global
Local Idx := 1 , Tmp := 0 , Aux := Array[%nIndex%]
While ( Idx <= nIndex )
{
Tmp := "Array[" nIndex - Idx "]"
Tmp := % %Tmp%
If ( ( Tmp = Aux ) || ( Tmp = Aux-Idx ) || ( Tmp = Aux+Idx ) )
Return 1
Idx++
}
Return 0
}
;------------------------------------------
PutBoard(ByRef Output,QueensN)
{
Global
Static Stc = 0
Local xxx := 0 , yyy := 0
Output .= "`n`nSolution #" (++Stc) "`n"
While ( yyy < QueensN )
{
xxx := 0
While ( xxx < QueensN )
Output .= ( "|" ( ( Array[%yyy%] = xxx ) ? "Q" : "_" ) ) , xxx++
Output .= "|`n" , yyy++
}
}

90
Task/N-queens-problem/AutoHotkey/n-queens-problem-2.ahk Normal file
View file

@ -0,0 +1,90 @@
N := 5
Number: ; main entrance for different # of queens
SI := 1
Progress b2 w250 zh0 fs9, Calculating all solutions for %N% Queens ...
Gosub GuiCreate
Result := SubStr(Queens(N),2)
Progress Off
Gui Show,,%N%-Queens
StringSplit o, Result, `n
Fill: ; show solutions
GuiControl,,SI, %SI% / %o0%
Loop Parse, o%SI%, `,
{
C := A_Index
Loop %N%
GuiControl,,%C%_%A_Index% ; clear fields
GuiControl,,%C%_%A_LoopField%, r
}
Return ;-----------------------------------------------------------------------
Queens(N) { ; Size of the board
Local c, O ; global array r
r1 := 1, c := 2, r2 := 3, O := "" ; init: r%c% = row of Queen in column c
Right: ; move to next column
If (c = N) { ; found solution
Loop %N% ; save row indices of Queens
O .= (A_Index = 1 ? "`n" : ",") r%A_Index%
GOTO % --c ? "Down" : "OUT" ; for ALL solutions
}
c++, r%c% := 1 ; next column, top row
GoTo % BAD(c) ? "Down" : "Right"
Down: ; move down to next row
If (r%c% = N)
GoTo % --c ? "Down" : "OUT"
r%c%++ ; row down
GoTo % BAD(c) ? "Down" : "Right"
OUT:
Return O
} ;----------------------------------------------------------------------------
BAD(c) { ; Check placed Queens against Queen in row r%c%, column c
Loop % c-1
If (r%A_Index% = r%c% || ABS(r%A_Index%-r%c%) = c-A_Index)
Return 1
} ;----------------------------------------------------------------------------
GuiCreate: ; Draw chess board
Gui Margin, 20, 15
Gui Font, s16, Marlett
Loop %N% {
C := A_Index
Loop %N% { ; fields
R := A_Index, X := 40*C-17, Y := 40*R-22
Gui Add, Progress, x%X% y%Y% w41 h41 Cdddddd, % 100*(R+C & 1) ;% shade fields
Gui Add, Text, x%X% y%Y% w41 h41 BackGroundTrans Border Center 0x200 v%C%_%R%
}
}
Gui Add, Button, x%x% w43 h25 gBF, 4 ; forth (default)
Gui Add, Button,xm yp w43 h25 gBF, 3 ; back
Gui Font, bold, Comic Sans MS
Gui Add, Text,% "x62 yp hp Center 0x200 vSI w" 40*N-80
Menu FileMenu, Add, E&xit, GuiClose
Loop 9
Menu CalcMenu, Add, % "Calculate " A_Index+3 " Queens", Calculate ;%
Menu HelpMenu, Add, &About, AboutBox
Menu MainMenu, Add, &File, :FileMenu
Menu MainMenu, Add, &Calculate, :CalcMenu
Menu MainMenu, Add, &Help, :HelpMenu
Gui Menu, Mainmenu
Return ; ----------------------------------------------------------------------
AboutBox: ; message box with AboutText
Gui 1: +OwnDialogs
MsgBox, 64, About N-Queens, Many thanks ...
Return
Calculate: ; menu handler for calculations
N := A_ThisMenuItemPos + 3
Gui Destroy
GoTo Number ; -------------------------------------------------------------
BF:
SI := mod(SI+o0-2*(A_GuiControl=3), o0) + 1 ; left button text is "3"
GoTo Fill ; ----------------------------------------------------------------
GuiClose:
ExitApp

61
Task/N-queens-problem/BBC-BASIC/n-queens-problem.bbc Normal file
View file

@ -0,0 +1,61 @@
Size% = 8
Cell% = 32
VDU 23,22,Size%*Cell%;Size%*Cell%;Cell%,Cell%,16,128+8,5
*font Arial Unicode MS,16
GCOL 3,11
FOR i% = 0 TO Size%-1 STEP 2
RECTANGLE FILL i%*Cell%*2,0,Cell%*2,Size%*Cell%*2
RECTANGLE FILL 0,i%*Cell%*2,Size%*Cell%*2,Cell%*2
NEXT
num% = FNqueens(Size%, Cell%)
SYS "SetWindowText", @hwnd%, "Total " + STR$(num%) + " solutions"
REPEAT : WAIT 1 : UNTIL FALSE
END
DEF FNqueens(n%, s%)
LOCAL i%, j%, m%, p%, q%, r%, a%(), b%(), c%()
DIM a%(n%), b%(n%), c%(4*n%-2)
FOR i% = 1 TO DIM(a%(),1) : a%(i%) = i% : NEXT
m% = 0
i% = 1
j% = 0
r% = 2*n%-1
REPEAT
i% -= 1
j% += 1
p% = 0
q% = -r%
REPEAT
i% += 1
c%(p%) = 1
c%(q%+r%) = 1
SWAP a%(i%),a%(j%)
p% = i% - a%(i%) + n%
q% = i% + a%(i%) - 1
b%(i%) = j%
j% = i% + 1
UNTIL j% > n% OR c%(p%) OR c%(q%+r%)
IF c%(p%)=0 IF c%(q%+r%)=0 THEN
IF m% = 0 THEN
FOR p% = 1 TO n%
MOVE 2*s%*(a%(p%)-1)+6, 2*s%*p%+6
PRINT "♛";
NEXT
ENDIF
m% += 1
ENDIF
j% = b%(i%)
WHILE j% >= n% AND i% <> 0
REPEAT
SWAP a%(i%), a%(j%)
j% = j%-1
UNTIL j% < i%
i% -= 1
p% = i% - a%(i%) + n%
q% = i% + a%(i%) - 1
j% = b%(i%)
c%(p%) = 0
c%(q%+r%) = 0
ENDWHILE
UNTIL i% = 0
= m%

30
Task/N-queens-problem/BCPL/n-queens-problem-1.bcpl Normal file
View file

@ -0,0 +1,30 @@
// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10.
GET "libhdr.h"
GLOBAL { count:ug; all }
LET try(ld, row, rd) BE TEST row=all
THEN count := count + 1
ELSE { LET poss = all & ~(ld | row | rd)
WHILE poss DO
{ LET p = poss & -poss
poss := poss - p
try(ld+p << 1, row+p, rd+p >> 1)
}
}
LET start() = VALOF
{ all := 1
FOR i = 1 TO 16 DO
{ count := 0
try(0, 0, 0)
writef("Number of solutions to %i2-queens is %i7*n", i, count)
all := 2*all + 1
}
RESULTIS 0
}

134
Task/N-queens-problem/BCPL/n-queens-problem-2.bcpl Normal file
View file

@ -0,0 +1,134 @@
GET "libhdr.h"
GET "mc.h"
MANIFEST {
lo=1; hi=16
dlevel=#b0000
// Register mnemonics
ld = mc_a
row = mc_b
rd = mc_c
poss = mc_d
p = mc_e
count = mc_f
}
LET start() = VALOF
{ // Load the dynamic code generation package
LET mcseg = globin(loadseg("mci386"))
LET mcb = 0
UNLESS mcseg DO
{ writef("Trouble with MC package: mci386*n")
GOTO fin
}
// Create an MC instance for hi functions with a data space
// of 10 words and code space of 40000
mcb := mcInit(hi, 10, 40000)
UNLESS mcb DO
{ writef("Unable to create an mci386 instance*n")
GOTO fin
}
mc := 0 // Currently no selected MC instance
mcSelect(mcb)
mcK(mc_debug, dlevel) // Set the debugging level
FOR n = lo TO hi DO
{ mcComment("*n*n// Code for a %nx%n board*n", n, n)
gencode(n) // Compile the code for an nxn board
}
mcF(mc_end) // End of code generation
writef("Code generation complete*n")
FOR n = lo TO hi DO
{ LET k = mcCall(n)
writef("Number of solutions to %i2-queens is %i9*n", n, k)
}
fin:
IF mc DO mcClose()
IF mcseg DO unloadseg(mcseg)
writef("*n*nEnd of run*n")
}
AND gencode(n) BE
{ LET all = (1<<n) - 1
mcKKK(mc_entry, n, 3, 0)
mcRK(mc_mv, ld, 0)
mcRK(mc_mv, row, 0)
mcRK(mc_mv, rd, 0)
mcRK(mc_mv, count, 0)
cmpltry(1, n, all) // Compile the outermost call of try
mcRR(mc_mv, mc_a, count) // return count
mcF(mc_rtn)
mcF(mc_endfn)
}
AND cmpltry(i, n, all) BE
{ LET L = mcNextlab()
mcComment("*n// Start of code from try(%n, %n, %n)*n", i, n, all)
mcRR(mc_mv, poss, ld) // LET poss = (~(ld | row | rd)) & all
mcRR(mc_or, poss, row)
mcRR(mc_or, poss, rd)
mcR (mc_not, poss)
mcRK(mc_and, poss, all)
mcRK(mc_cmp, poss, 0) // IF poss DO
TEST n-i<=2
THEN mcJS(mc_jeq, L) // (use a short jump if near the last row)
ELSE mcJL(mc_jeq, L)
TEST i=n
THEN { // We can place a queen in the final row.
mcR(mc_inc, count) // count := count+1
}
ELSE { // We can place queen(s) in a non final row.
LET M = mcNextlab()
mcL (mc_lab, M) // { Start of REPEATWHILE loop
mcRR(mc_mv, p, poss) // LET p = poss & -poss
mcR (mc_neg, p)
mcRR(mc_and, p, poss) // // p is a valid queens position
mcRR(mc_sub, poss, p) // poss := poss - p
mcR (mc_push, ld) // Save current state
mcR (mc_push, row)
mcR (mc_push, rd)
mcR (mc_push, poss)
// Call try((ld+p)<<1, row+p, (rd+p)>>1)
mcRR(mc_add, ld, p)
mcRK(mc_lsh, ld, 1) // ld := (ld+p)<<1
mcRR(mc_add, row, p) // row := row+p
mcRR(mc_add, rd, p)
mcRK(mc_rsh, rd, 1) // rd := (rd+p)>>1
cmpltry(i+1, n, all) // Compile code for row i+1
mcR (mc_pop, poss) // Restore the state
mcR (mc_pop, rd)
mcR (mc_pop, row)
mcR (mc_pop, ld)
mcRK(mc_cmp, poss, 0)
mcJL(mc_jne, M) // } REPEATWHILE poss
}
mcL(mc_lab, L)
mcComment("// End of code from try(%n, %n, %n)*n*n",
i, n, all)
}

31
Task/N-queens-problem/C/n-queens-problem-1.c Normal file
View file

@ -0,0 +1,31 @@
#include <stdio.h>
#include <stdlib.h>
int count = 0;
void solve(int n, int col, int *hist)
{
if (col == n) {
printf("\nNo. %d\n-----\n", ++count);
for (int i = 0; i < n; i++, putchar('\n'))
for (int j = 0; j < n; j++)
putchar(j == hist[i] ? 'Q' : ((i + j) & 1) ? ' ' : '.');
return;
}
# define attack(i, j) (hist[j] == i || abs(hist[j] - i) == col - j)
for (int i = 0, j = 0; i < n; i++) {
for (j = 0; j < col && !attack(i, j); j++);
if (j < col) continue;
hist[col] = i;
solve(n, col + 1, hist);
}
}
int main(int n, char **argv)
{
if (n <= 1 || (n = atoi(argv[1])) <= 0) n = 8;
int hist[n];
solve(n, 0, hist);
}

38
Task/N-queens-problem/C/n-queens-problem-2.c Normal file
View file

@ -0,0 +1,38 @@
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
typedef uint32_t uint;
uint full, *qs, count = 0, nn;
void solve(uint d, uint c, uint l, uint r)
{
uint b, a, *s;
if (!d) {
count++;
#if 0
printf("\nNo. %d\n===========\n", count);
for (a = 0; a < nn; a++, putchar('\n'))
for (b = 0; b < nn; b++, putchar(' '))
putchar(" -QQ"[((b == qs[a])<<1)|((a + b)&1)]);
#endif
return;
}
a = (c | (l <<= 1) | (r >>= 1)) & full;
if (a != full)
for (*(s = qs + --d) = 0, b = 1; b <= full; (*s)++, b <<= 1)
if (!(b & a)) solve(d, b|c, b|l, b|r);
}
int main(int n, char **argv)
{
if (n <= 1 || (nn = atoi(argv[1])) <= 0) nn = 8;
qs = calloc(nn, sizeof(int));
full = (1U << nn) - 1;
solve(nn, 0, 0, 0);
printf("\nSolutions: %d\n", count);
return 0;
}

91
Task/N-queens-problem/C/n-queens-problem-3.c Normal file
View file

@ -0,0 +1,91 @@
#include <stdio.h>
#include <stdlib.h>
typedef unsigned int uint;
uint count = 0;
#define ulen sizeof(uint) * 8
/* could have defined as int solve(...), but void may have less
chance to confuse poor optimizer */
void solve(int n)
{
int cnt = 0;
const uint full = -(int)(1 << (ulen - n));
register uint bits, pos, *m, d, e;
uint b0, b1, l[32], r[32], c[32], mm[33] = {0};
n -= 3;
/* require second queen to be left of the first queen, so
we ever only test half of the possible solutions. This
is why we can't handle n=1 here */
for (b0 = 1U << (ulen - n - 3); b0; b0 <<= 1) {
for (b1 = b0 << 2; b1; b1 <<= 1) {
d = n;
/* c: columns occupied by previous queens.
l: columns attacked by left diagonals
r: by right diagnoals */
c[n] = b0 | b1;
l[n] = (b0 << 2) | (b1 << 1);
r[n] = (b0 >> 2) | (b1 >> 1);
/* availabe columns on current row. m is stack */
bits = *(m = mm + 1) = full & ~(l[n] | r[n] | c[n]);
while (bits) {
/* d: depth, aka row. counting backwards
because !d is often faster than d != n */
while (d) {
/* pos is right most nonzero bit */
pos = -(int)bits & bits;
/* mark bit used. only put current bits
on stack if not zero, so backtracking
will skip exhausted rows (because reading
stack variable is sloooow compared to
registers) */
if ((bits &= ~pos))
*m++ = bits | d;
/* faster than l[d+1] = l[d]... */
e = d--;
l[d] = (l[e] | pos) << 1;
r[d] = (r[e] | pos) >> 1;
c[d] = c[e] | pos;
bits = full & ~(l[d] | r[d] | c[d]);
if (!bits) break;
if (!d) { cnt++; break; }
}
/* Bottom of stack m is a zero'd field acting
as sentinel. When saving to stack, left
27 bits are the available columns, while
right 5 bits is the depth. Hence solution
is limited to size 27 board -- not that it
matters in foreseeable future. */
d = (bits = *--m) & 31U;
bits &= ~31U;
}
}
}
count = cnt * 2;
}
int main(int c, char **v)
{
int nn;
if (c <= 1 || (nn = atoi(v[1])) <= 0) nn = 8;
if (nn > 27) {
fprintf(stderr, "Value too large, abort\n");
exit(1);
}
/* Can't solve size 1 board; might as well skip 2 and 3 */
if (nn < 4) count = nn == 1;
else solve(nn);
printf("\nSolutions: %d\n", count);
return 0;
}

23
Task/N-queens-problem/Clojure/n-queens-problem.clj Normal file
View file

@ -0,0 +1,23 @@
(def size 8)
(defn extends? [v n]
(let [k (count v)]
(not-any? true?
(for [i (range k) :let [vi (v i)]]
(or
(= vi n) ;check for shared row
(= (- k i) (Math/abs (- n vi)))))))) ;check for shared diagonal
(defn extend [vs]
(for [v vs
n (range 1 (inc size)) :when (extends? v n)]
(conj v n)))
(def solutions
(nth (iterate extend [[]]) size))
(doseq [s solutions]
(println s))
(println (count solutions) "solutions")

111
Task/N-queens-problem/CoffeeScript/n-queens-problem.coffeescript Normal file
View file

@ -0,0 +1,111 @@
# Unlike traditional N-Queens solutions that use recursion, this
# program attempts to more closely model the "human" algorithm.
#
# In this algorithm, the function keeps placing queens on the board
# until there is no longer a safe square. If the 8th queen has been
# placed, the solution is noted. If fewer than 8th queens have been
# placed, then you are at a dead end. In either case, backtracking occurs.
# The LAST queen placed on the board gets pulled, then it gets moved
# to the next safe square. (We backtrack even after a "good" attempt in
# order to get to a new solution.) This backtracking may repeat itself
# several times until the original misplaced queen finally is proven to
# be a dead end.
#
# Many N-Queens solutions use lazy logic (along with geometry shortcuts)
# to determine whether a queen is under attack. In this algorithm, we
# are more proactive, essentially updating a sieve every time we lay a
# queen down. To make backtracking easier, the sieve uses ref-counts vs.
# a simple safe/unsafe boolean.
#
# We precompute the "attack graph" up front, and then we essentially ignore
# the geometry of the problem. This approach, while perhaps suboptimal for
# queens, probably is more flexible for general "coexistence" problems.
nqueens = (n) ->
neighbors = precompute_neighbors(n)
board = []
num_solutions = 0
num_backtracks = 0
queens = []
pos = 0
for p in [0...n*n]
board.push 0
attack = (pos, delta=1) ->
for neighbor in neighbors[pos]
board[neighbor] += delta
backtrack = ->
pos = queens.pop()
attack pos, -1 # unattack queen you just pulled
pos += 1
num_backtracks += 1
# The following loop finds all 92 solutions to
# the 8-queens problem (for n=8).
while true
if pos >= n*n
if queens.length == 0
break
backtrack()
continue
# If a square is empty
if board[pos] == 0
attack pos
queens.push pos
if queens.length == n
num_solutions += 1
show_queens queens, n
backtrack()
pos += 1
console.log "#{num_solutions} solutions"
console.log "#{num_backtracks} backtracks"
precompute_neighbors = (n) ->
# For each board position, build a list of all
# the board positions that would be under attack if
# you placed a queen on it. This assumes a 1d array
# of squares.
neighbors = []
find_neighbors = (pos) ->
arr = []
row = Math.floor pos / n
col = pos % n
for i in [0...n]
if i != col
arr.push row*n + i
r1 = row + col - i
r2 = row + i - col
if 0 <= r1 and r1 < n
arr.push r1*n + i
if 0 <= r2 and r2 < n
arr.push r2*n + i
if i != row
arr.push i*n + col
arr
for pos in [0...n*n]
neighbors.push find_neighbors(pos)
neighbors
show_queens = (queens, n) ->
# precondition: queens is a sorted array of integers,
# and each row is represented
console.log "\n------"
for q in queens
col = q % n
s = ''
for c in [0...n]
if c == col
s += "Q "
else
s += "* "
console.log s + "\n"
nqueens(8)

22
Task/N-queens-problem/Common-Lisp/n-queens-problem.lisp Normal file
View file

@ -0,0 +1,22 @@
(defun n-queens (n m)
(if (= n 1)
(loop for x from 1 to m collect (list x))
(loop for sol in (n-queens (1- n) m) nconc
(loop for col from 1 to m when
(loop for row from 0 to (length sol) for c in sol
always (and (/= col c)
(/= (abs (- c col)) (1+ row)))
finally (return (cons col sol)))
collect it))))
(defun show-solution (b n)
(loop for i in b do
(format t "~{~A~^~}~%"
(loop for x from 1 to n collect (if (= x i) "Q " ". "))))
(terpri))
(let ((i 0) (n 8))
(mapc #'(lambda (s)
(format t "Solution ~a:~%" (incf i))
(show-solution s n))
(n-queens n n)))

58
Task/N-queens-problem/Curry/n-queens-problem-1.curry Normal file
View file

@ -0,0 +1,58 @@
-- 8-queens implementation with the Constrained Constructor pattern
-- Sergio Antoy
-- Fri Jul 13 07:05:32 PDT 2001
-- Place 8 queens on a chessboard so that no queen can capture
-- (and be captured by) any other queen.
-- Non-deterministic choice operator
infixl 0 !
X ! _ = X
_ ! Y = Y
-- A solution is represented by a list of integers.
-- The i-th integer in the list is the column of the board
-- in which the queen in the i-th row is placed.
-- Rows and columns are numbered from 1 to 8.
-- For example, [4,2,7,3,6,8,5,1] is a solution where the
-- the queen in row 1 is in column 4, etc.
-- Any solution must be a permutation of [1,2,...,8].
-- The state of a queen is its position, row and column, on the board.
-- Operation column is a particularly simple instance
-- of a Constrained Constructor pattern.
-- When it is invoked, it produces only valid states.
column = 1 ! 2 ! 3 ! 4 ! 5 ! 6 ! 7 ! 8
-- A path of the puzzle is a sequence of successive placements of
-- queens on the board. It is not explicitly defined as a type.
-- A path is a potential solution in the making.
-- Constrained Constructor on a path
-- Any path must be valid, i.e., any column must be in the range 1..8
-- and different from any other column in the path.
-- Furthermore, the path must be safe for the queens.
-- No queen in a path may capture any other queen in the path.
-- Operation makePath add column n to path c or fails.
makePath c n | valid c && safe c 1 = n:c
where valid c | n =:= column = uniq c
where uniq [] = True
uniq (c:cs) = n /= c && uniq cs
safe [] _ = True
safe (c:cs) k = abs (n-c) /= k && safe cs (k+1)
where abs x = if x < 0 then -x else x
-- extend the path argument till all the queens are on the board
-- see the Incremental Solution pattern
extend p = if (length p == 8)
then p
else extend (makePath p x)
where x free
-- solve the puzzle
main = extend []

34
Task/N-queens-problem/Curry/n-queens-problem-2.curry Normal file
View file

@ -0,0 +1,34 @@
-- N-queens puzzle implemented with "Distinct Choices" pattern
-- Sergio Antoy
-- Tue Sep 4 13:16:20 PDT 2001
-- updated: Mon Sep 23 15:22:15 PDT 2002
import Integer
queens x | y =:= permute x & void (capture y) = y where y free
capture y = let l1,l2,l3,y1,y2 free in
l1 ++ [y1] ++ l2 ++ [y2] ++ l3 =:= y & abs (y1-y2) =:= length l2 + 1
-- negation as failure (implemented by encapsulated search):
void c = (findall \_->c) =:= []
-- How does this permutation algorithm work?
-- Only the elements [0,1,...,n-1] can be permuted.
-- The reason is that each element is used as an index in a list.
-- A list, called store, of free variables of length n is created.
-- Then, the n iterations described below are executed.
-- At the i-th iteration, an element, say s,
-- of the initial list is non-deterministically selected.
-- This element is used as index in the store.
-- The s-th variable of the store is unified with i.
-- At the end of the iterations, the elements of the store
-- are a permutation of [0,1,...,n-1], i.e., the elements
-- are unique since two iterations cannot select the same index.
permute n = result n
where result n = if n==0 then [] else pick n store : result (n-1)
pick i store | store !! k =:= i = k where k = range n
range n | n > 0 = range (n-1) ! (n-1)
store = free
-- end

59
Task/N-queens-problem/Curry/n-queens-problem-3.curry Normal file
View file

@ -0,0 +1,59 @@
-- 8-queens implementation with both the Constrained Constructor
-- and the Fused Generate and Test patterns.
-- Sergio Antoy
-- Fri Jul 13 07:05:32 PDT 2001
-- Place 8 queens on a chessboard so that no queen can capture
-- (and be captured by) any other queen.
-- Non-deterministic choice operator
infixl 0 !
X ! _ = X
_ ! Y = Y
-- A solution is represented by a list of integers.
-- The i-th integer in the list is the column of the board
-- in which the queen in the i-th row is placed.
-- Rows and columns are numbered from 1 to 8.
-- For example, [4,2,7,3,6,8,5,1] is a solution where the
-- the queen in row 1 is in column 4, etc.
-- Any solution must be a permutation of [1,2,...,8].
-- The state of a queen is its position, row and column, on the board.
-- Operation column is a particularly simple instance
-- of a Constrained Constructor pattern.
-- When it is invoked, it produces only valid states.
column = 1 ! 2 ! 3 ! 4 ! 5 ! 6 ! 7 ! 8
-- A path of the puzzle is a sequence of successive placements of
-- queens on the board. It is not explicitly defined as a type.
-- A path is a potential solution in the making.
-- Constrained Constructor on a path
-- Any path must be valid, i.e., any column must be in the range 1..8
-- and different from any other column in the path.
-- Furthermore, the path must be safe for the queens.
-- No queen in a path may capture any other queen in the path.
-- Operation makePath add column n to path c or fails.
makePath c n | valid c && safe c 1 = n:c
where valid c | n =:= column = uniq c
where uniq [] = True
uniq (c:cs) = n /= c && uniq cs
safe [] _ = True
safe (c:cs) k = abs (n-c) /= k && safe cs (k+1)
where abs x = if x < 0 then -x else x
-- extend the path argument till all the queens are on the board
-- see the Incremental Solution pattern
extend p = if (length p == 8)
then p
else extend (makePath p x)
where x free
-- solve the puzzle
main = extend []

44
Task/N-queens-problem/D/n-queens-problem-1.d Normal file
View file

@ -0,0 +1,44 @@
import std.stdio;
enum int SIDE = 8;
int[SIDE] board;
bool unsafe(in int y) nothrow {
immutable int x = board[y];
foreach (i; 1 .. y + 1) {
int t = board[y - i];
if ((t == x) || (t == x - i) || (t == x + i))
return true;
}
return false;
}
void showBoard() {
static int s = 1;
writeln("\nSolution #", s++);
foreach (y; 0 .. SIDE) {
foreach (x; 0 .. SIDE)
write(board[y] == x ? '*' : '.');
writeln();
}
}
void main() {
int y = 0;
board[0] = -1;
while (y >= 0) {
do {
board[y]++;
} while (board[y] < SIDE && unsafe(y));
if (board[y] < SIDE) {
if (y < (SIDE - 1))
board[++y] = -1;
else
showBoard();
} else
y--;
}
}

90
Task/N-queens-problem/D/n-queens-problem-2.d Normal file
View file

@ -0,0 +1,90 @@
import std.stdio, std.conv;
uint nQueens(in uint nn) pure nothrow
in {
assert(nn > 0 && nn <= 27,
"'side' value must be in 1 .. 27.");
} body {
if (nn < 4)
return nn == 1;
enum uint ulen = uint.sizeof * 8;
immutable uint full = uint.max - ((1 << (ulen - nn)) - 1);
immutable n = nn - 3;
uint count;
uint[32] l=void, r=void, c=void;
uint[33] mm; // mm and mmi are a stack
// Require second queen to be left of the first queen, so
// we ever only test half of the possible solutions. This
// is why we can't handle n=1 here.
for (uint b0 = 1U << (ulen - n - 3); b0; b0 <<= 1) {
for (uint b1 = b0 << 2; b1; b1 <<= 1) {
uint d = n;
// c: columns occupied by previous queens.
c[n] = b0 | b1;
// l: columns attacked by left diagonals
l[n] = (b0 << 2) | (b1 << 1);
// r: by right diagnoals
r[n] = (b0 >> 2) | (b1 >> 1);
// availabe columns on current row
uint bits = full & ~(l[n] | r[n] | c[n]);
uint mmi = 1;
mm[mmi] = bits;
while (bits) {
// d: depth, aka row. counting backwards
// because !d is often faster than d != n
while (d) {
// pos is right most nonzero bit
immutable uint pos = -(cast(int)bits) & bits;
// Mark bit used. Only put current bits on
// stack if not zero, so backtracking will
// skip exhausted rows (because reading stack
// variable is slow compared to registers).
bits &= ~pos;
if (bits) {
mm[mmi] = bits | d;
mmi++;
}
d--;
l[d] = (l[d+1] | pos) << 1;
r[d] = (r[d+1] | pos) >> 1;
c[d] = c[d+1] | pos;
bits = full & ~(l[d] | r[d] | c[d]);
if (!bits)
break;
if (!d) {
count++;
break;
}
}
// Bottom of stack m is a zero'd field acting as
// sentinel. When saving to stack, left 27 bits
// are the available columns, while right 5 bits
// is the depth. Hence solution is limited to size
// 27 board -- not that it matters in foreseeable
// future.
mmi--;
bits = mm[mmi];
d = bits & 31U;
bits &= ~31U;
}
}
}
return count * 2;
}
void main(string[] args) {
immutable int side = (args.length >= 2) ? to!int(args[1]) : 8;
writefln("N-queens(%d) = %d solutions.", side, nQueens(side));
}

65
Task/N-queens-problem/Dart/n-queens-problem.dart Normal file
View file

@ -0,0 +1,65 @@
/**
Return true if queen placement q[n] does not conflict with
other queens q[0] through q[n-1]
*/
isConsistent(List q, int n) {
for (int i=0; i<n; i++) {
if (q[i] == q[n]) {
return false; // Same column
}
if ((q[i] - q[n]) == (n - i)) {
return false; // Same major diagonal
}
if ((q[n] - q[i]) == (n - i)) {
return false; // Same minor diagonal
}
}
return true;
}
/**
Print out N-by-N placement of queens from permutation q in ASCII.
*/
printQueens(List q) {
int N = q.length;
for (int i=0; i<N; i++) {
StringBuffer sb = new StringBuffer();
for (int j=0; j<N; j++) {
if (q[i] == j) {
sb.add("Q ");
} else {
sb.add("* ");
}
}
print(sb.toString());
}
print("");
}
/**
Try all permutations using backtracking
*/
enumerate(int N) {
var a = new List(N);
_enumerate(a, 0);
}
_enumerate(List q, int n) {
if (n == q.length) {
printQueens(q);
} else {
for (int i = 0; i < q.length; i++) {
q[n] = i;
if (isConsistent(q, n)){
_enumerate(q, n+1);
}
}
}
}
void main() {
enumerate(4);
}

27
Task/N-queens-problem/Factor/n-queens-problem.factor Normal file
View file

@ -0,0 +1,27 @@
USING: kernel sequences math math.combinatorics formatting io locals ;
IN: queens
: /= ( x y -- ? ) = not ; inline
:: safe? ( board q -- ? )
[let q board nth :> x
q iota [
x swap
[ board nth ] keep
q swap -
[ + /= ]
[ - /= ] 3bi and
] all?
] ;
: solution? ( board -- ? )
dup length iota [ dupd safe? ] all? nip ;
: queens ( n -- l )
iota all-permutations [ solution? ] filter ;
: .queens ( n -- )
queens
[
[ 1 + "%d " printf ] each nl
] each ;

29
Task/N-queens-problem/Forth/n-queens-problem.fth Normal file
View file

@ -0,0 +1,29 @@
variable solutions
variable nodes
: bits ( n -- mask ) 1 swap lshift 1- ;
: lowBit ( mask -- bit ) dup negate and ;
: lowBit- ( mask -- bits ) dup 1- and ;
: next3 ( dl dr f files -- dl dr f dl' dr' f' )
invert >r
2 pick r@ and 2* 1+
2 pick r@ and 2/
2 pick r> and ;
: try ( dl dr f -- )
dup if
1 nodes +!
dup 2over and and
begin ?dup while
dup >r lowBit next3 recurse r> lowBit-
repeat
else 1 solutions +! then
drop 2drop ;
: queens ( n -- )
0 solutions ! 0 nodes !
-1 -1 rot bits try
solutions @ . ." solutions, " nodes @ . ." nodes" ;
8 queens \ 92 solutions, 1965 nodes

101
Task/N-queens-problem/Fortran/n-queens-problem-1.f Normal file
View file

@ -0,0 +1,101 @@
program Nqueens
implicit none
integer, parameter :: n = 8 ! size of board
integer :: file = 1, rank = 1, queens = 0
integer :: i
logical :: board(n,n) = .false.
do while (queens < n)
board(file, rank) = .true.
if(is_safe(board, file, rank)) then
queens = queens + 1
file = 1
rank = rank + 1
else
board(file, rank) = .false.
file = file + 1
do while(file > n)
rank = rank - 1
if (rank < 1) then
write(*, "(a,i0)") "No solution for n = ", n
stop
end if
do i = 1, n
if (board(i, rank)) then
file = i
board(file, rank) = .false.
queens = queens - 1
file = i + 1
exit
end if
end do
end do
end if
end do
call Printboard(board)
contains
function is_safe(board, file, rank)
logical :: is_safe
logical, intent(in) :: board(:,:)
integer, intent(in) :: file, rank
integer :: i, f, r
is_safe = .true.
do i = rank-1, 1, -1
if(board(file, i)) then
is_safe = .false.
return
end if
end do
f = file - 1
r = rank - 1
do while(f > 0 .and. r > 0)
if(board(f, r)) then
is_safe = .false.
return
end if
f = f - 1
r = r - 1
end do
f = file + 1
r = rank - 1
do while(f <= n .and. r > 0)
if(board(f, r)) then
is_safe = .false.
return
end if
f = f + 1
r = r - 1
end do
end function
subroutine Printboard(board)
logical, intent(in) :: board(:,:)
character(n*4+1) :: line
integer :: f, r
write(*, "(a, i0)") "n = ", n
line = repeat("+---", n) // "+"
do r = 1, n
write(*, "(a)") line
do f = 1, n
write(*, "(a)", advance="no") "|"
if(board(f, r)) then
write(*, "(a)", advance="no") " Q "
else if(mod(f+r, 2) == 0) then
write(*, "(a)", advance="no") " "
else
write(*, "(a)", advance="no") "###"
end if
end do
write(*, "(a)") "|"
end do
write(*, "(a)") line
end subroutine
end program

72
Task/N-queens-problem/Fortran/n-queens-problem-2.f Normal file
View file

@ -0,0 +1,72 @@
C This one implements depth-first backtracking.
C See the 2nd program for Scheme on the "Permutations" page for the
C main idea.
C As is, the program only prints the number of n-queens configurations.
C To print also the configurations, uncomment the line after label 80.
program queens
implicit integer(a-z)
parameter(l=18)
dimension a(l),s(l),u(4*l-2)
do 10 i=1,l
10 a(i)=i
do 20 i=1,4*l-2
20 u(i)=0
do 110 n=1,l
m=0
i=1
r=2*n-1
go to 40
30 s(i)=j
u(p)=1
u(q+r)=1
i=i+1
40 if(i.gt.n) go to 80
j=i
50 z=a(i)
y=a(j)
p=i-y+n
q=i+y-1
a(i)=y
a(j)=z
if((u(p).eq.0).and.(u(q+r).eq.0)) goto 30
60 j=j+1
if(j.le.n) go to 50
70 j=j-1
if(j.eq.i) go to 90
z=a(i)
a(i)=a(j)
a(j)=z
go to 70
80 m=m+1
C print *,(a(k),k=1,n)
90 i=i-1
if(i.eq.0) go to 100
p=i-a(i)+n
q=i+a(i)-1
j=s(i)
u(p)=0
u(q+r)=0
go to 60
100 print *,n,m
110 continue
end
C Output
C 1 1
C 2 0
C 3 0
C 4 2
C 5 10
C 6 4
C 7 40
C 8 92
C 9 352
C 10 724
C 11 2680
C 12 14200
C 13 73712
C 14 365596
C 15 2279184
C 16 14772512
C 17 95815104
C 18 666090624

106
Task/N-queens-problem/Fortran/n-queens-problem-3.f Normal file
View file

@ -0,0 +1,106 @@
MODULE QUEENS_MOD
IMPLICIT NONE
INTEGER, PARAMETER :: LONG=SELECTED_INT_KIND(17)
CONTAINS
FUNCTION PQUEENS(N,K1,K2) RESULT(M)
IMPLICIT NONE
INTEGER(KIND=LONG) :: M
INTEGER, INTENT(IN) :: N,K1,K2
INTEGER, PARAMETER :: L=20
INTEGER :: A(L),S(L),U(4*L-2)
INTEGER :: I,J,Y,Z,P,Q,R
DO 10 I=1,N
10 A(I)=I
DO 20 I=1,4*N-2
20 U(I)=0
M=0
R=2*N-1
IF(K1.EQ.K2) RETURN
P=1-K1+N
Q=1+K1-1
IF((U(P).NE.0).OR.(U(Q+R).NE.0)) RETURN
U(P)=1
U(Q+R)=1
Z=A(1)
A(1)=A(K1)
A(K1)=Z
P=2-K2+N
Q=2+K2-1
IF((U(P).NE.0).OR.(U(Q+R).NE.0)) RETURN
U(P)=1
U(Q+R)=1
IF(K2.NE.1) THEN
Z=A(2)
A(2)=A(K2)
A(K2)=Z
ELSE
Z=A(2)
A(2)=A(K1)
A(K1)=Z
END IF
I=3
GO TO 40
30 S(I)=J
U(P)=1
U(Q+R)=1
I=I+1
40 IF(I.GT.N) GO TO 80
J=I
50 Z=A(I)
Y=A(J)
P=I-Y+N
Q=I+Y-1
A(I)=Y
A(J)=Z
IF((U(P).EQ.0).AND.(U(Q+R).EQ.0)) GO TO 30
60 J=J+1
IF(J.LE.N) GO TO 50
70 J=J-1
IF(J.EQ.I) GO TO 90
Z=A(I)
A(I)=A(J)
A(J)=Z
GO TO 70
80 M=M+1
90 I=I-1
IF(I.EQ.2) RETURN
P=I-A(I)+N
Q=I+A(I)-1
J=S(I)
U(P)=0
U(Q+R)=0
GO TO 60
END FUNCTION
END MODULE
PROGRAM QUEENS
USE OMP_LIB
USE QUEENS_MOD
IMPLICIT NONE
INTEGER, PARAMETER :: L=20
INTEGER :: N,I,J,A(L*L,2),K,P,Q
INTEGER(KIND=LONG) :: S,B(L*L)
DOUBLE PRECISION :: T1,T2
DO N=6,18
K=0
P=N/2
Q=MOD(N,2)*(P+1)
DO I=1,N
DO J=1,N
IF((ABS(I-J).GT.1).AND.((I.LE.P).OR.((I.EQ.Q).AND.(J.LT.I)))) THEN
K=K+1
A(K,1)=I
A(K,2)=J
END IF
END DO
END DO
S=0
T1=OMP_GET_WTIME()
C$OMP PARALLEL DO SCHEDULE(DYNAMIC)
DO I=1,K
B(I)=PQUEENS(N,A(I,1),A(I,2))
END DO
C$OMP END PARALLEL DO
T2=OMP_GET_WTIME()
PRINT '(I4,I12,F12.3)',N,2*SUM(B(1:K)),T2-T1
END DO
END PROGRAM

61
Task/N-queens-problem/Go/n-queens-problem.go Normal file
View file

@ -0,0 +1,61 @@
// A fairly literal translation of the example program on the referenced
// WP page. Well, it happened to be the example program the day I completed
// the task. It seems from the WP history that there has been some churn
// in the posted example program. The example program of the day was in
// Pascal and was credited to Niklaus Wirth, from his "Algorithms +
// Data Structures = Programs."
package main
import "fmt"
var (
i int
q bool
a [9]bool
b [17]bool
c [15]bool // offset by 7 relative to the Pascal version
x [9]int
)
func try(i int) {
for j := 1; ; j++ {
q = false
if a[j] && b[i+j] && c[i-j+7] {
x[i] = j
a[j] = false
b[i+j] = false
c[i-j+7] = false
if i < 8 {
try(i + 1)
if !q {
a[j] = true
b[i+j] = true
c[i-j+7] = true
}
} else {
q = true
}
}
if q || j == 8 {
break
}
}
}
func main() {
for i := 1; i <= 8; i++ {
a[i] = true
}
for i := 2; i <= 16; i++ {
b[i] = true
}
for i := 0; i <= 14; i++ {
c[i] = true
}
try(1)
if q {
for i := 1; i <= 8; i++ {
fmt.Println(i, x[i])
}
}
}

24
Task/N-queens-problem/Groovy/n-queens-problem-1.groovy Normal file
View file

@ -0,0 +1,24 @@
def listOrder = { a, b ->
def k = [a.size(), b.size()].min()
def i = (0..<k).find { a[it] != b[it] }
(i != null) ? a[i] <=> b[i] : a.size() <=> b.size()
}
def orderedPermutations = { list ->
def n = list.size()
(0..<n).permutations().sort(listOrder)
}
def diagonalSafe = { list ->
def n = list.size()
n == 1 || (0..<(n-1)).every{ i ->
((i+1)..<n).every{ j ->
!([list[i]+j-i, list[i]+i-j].contains(list[j]))
}
}
}
def queensDistinctSolutions = { n ->
// each permutation is an N-Rooks solution
orderedPermutations((0..<n)).findAll (diagonalSafe)
}

51
Task/N-queens-problem/Groovy/n-queens-problem-2.groovy Normal file
View file

@ -0,0 +1,51 @@
class Reflect {
public static final diag = { list ->
final n = list.size()
def tList = [0] * n
(0..<n).each { tList[list[it]] = it }
tList
}
public static final vert = { list ->
list.reverse()
}
public static final horiz = { list ->
final n = list.size()
list.collect { n - it - 1 }
}
}
enum Rotations {
r0([]),
r90([Reflect.vert, Reflect.diag]),
r180([Reflect.vert, Reflect.diag, Reflect.vert, Reflect.diag]),
r270([Reflect.diag, Reflect.vert]);
private final List operations
private Rotations(List ops) {
operations = ops ?: []
}
public static void eliminateDups(primary, solutions) {
(r0..r270).each { rot -> rot.eliminateDuplicates(primary, solutions) }
}
private void eliminateDuplicates(primary, solutions) {
def rotated = [] + primary
operations.each { rotated = it(rotated) }
solutions.removeAll([rotated, Reflect.vert(rotated)])
}
}
def queensUniqueSolutions = { start ->
assert start instanceof Number || start instanceof List
def qus = (start instanceof Number) \
? queensDistinctSolutions(start) \
: [] + start
for (def i = 0; i < qus.size()-1; i++) {
Rotations.eliminateDups(qus[i], qus[(i+1)..<(qus.size())])
}
qus
}

8
Task/N-queens-problem/Groovy/n-queens-problem-3.groovy Normal file
View file

@ -0,0 +1,8 @@
(1..9).each { n ->
def qds = queensDistinctSolutions(n)
def qus = queensUniqueSolutions(qds)
println ([boardSize:n, "number of distinct solutions":qds.size(), "number of unique solutions":qus.size()])
if(n < 9) { qus.each { println it } }
else { println "first:${qus[0]}"; println "last:${qus[-1]}" }
println()
}

31
Task/N-queens-problem/Haskell/n-queens-problem.hs Normal file
View file

@ -0,0 +1,31 @@
import Control.Monad
import Data.List
-- given n, "queens n" solves the n-queens problem, returning a list of all the
-- safe arrangements. each solution is a list of the columns where the queens are
-- located for each row
queens :: Int -> [[Int]]
queens n = map fst $ foldM oneMoreQueen ([],[1..n]) [1..n] where
-- foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
-- foldM folds (from left to right) in the list monad, which is convenient for
-- "nondeterminstically" finding "all possible solutions" of something. the
-- initial value [] corresponds to the only safe arrangement of queens in 0 rows
-- given a safe arrangement y of queens in the first i rows, and a list of
-- possible choices, "oneMoreQueen y _" returns a list of all the safe
-- arrangements of queens in the first (i+1) rows along with remaining choices
oneMoreQueen (y,d) _ = [ (x:y, d\\[x]) | x <- d, safe x y 1]
-- "safe x y n" tests whether a queen at column x is safe from previous
-- queens as recorded in y, at the distance n rows away
safe x [] n = True
safe x (c:y) n = and [ x /= c , x /= c + n , x /= c - n , safe x y (n+1)]
-- prints what the board looks like for a solution; with an extra newline
printSolution y = let n = length y in
do mapM_ (\x -> putStrLn [if z == x then 'Q' else '.' | z <- [1..n]]) y
putStrLn ""
-- prints all the solutions for 6 queens
main = mapM_ printSolution $ queens 6

95
Task/N-queens-problem/Heron/n-queens-problem.heron Normal file
View file

@ -0,0 +1,95 @@
module NQueens {
inherits {
Heron.Windows.Console;
}
fields {
n : Int = 4;
sols : List = new List();
}
methods {
PosToString(row : Int, col : Int) : String {
return "row " + row.ToString() + ", col " + col.ToString();
}
AddQueen(b : Board, row : Int, col : Int)
{
if (!b.TryAddQueen(row, col))
return;
if (row < n - 1)
foreach (i in 0..n-1)
AddQueen(new Board(b), row + 1, i);
else
sols.Add(b);
}
Main() {
foreach (i in 0..n-1)
AddQueen(new Board(), 0, i);
foreach (b in sols) {
b.Output();
WriteLine("");
}
WriteLine("Found " + sols.Count().ToString() + " solutions");
}
}
}
class Board {
fields {
rows = new List();
}
methods {
Constructor() {
foreach (r in 0..n-1) {
var col = new List();
foreach (c in 0..n-1)
col.Add(false);
rows.Add(col);
}
}
Constructor(b : Board) {
Constructor();
foreach (r in 0..n-1)
foreach (c in 0..n-1)
SetSpaceOccupied(r, c, b.SpaceOccupied(r, c));
}
SpaceOccupied(row : Int, col : Int) : Bool {
return rows[row][col];
}
SetSpaceOccupied(row : Int, col : Int, b : Bool) {
rows[row][col] = b;
}
ValidPos(row : Int, col : Int) : Bool {
return ((row >= 0) && (row < n)) && ((col >= 0) && (col < n));
}
VectorOccupied(row : Int, col : Int, rowDir : Int, colDir : Int) : Bool {
var nextRow = row + rowDir;
var nextCol = col + colDir;
if (!ValidPos(nextRow, nextCol))
return false;
if (SpaceOccupied(nextRow, nextCol))
return true;
return VectorOccupied(nextRow, nextCol, rowDir, colDir);
}
TryAddQueen(row : Int, col : Int) : Bool {
foreach (rowDir in -1..1)
foreach (colDir in -1..1)
if (rowDir != 0 || colDir != 0)
if (VectorOccupied(row, col, rowDir, colDir))
return false;
SetSpaceOccupied(row, col, true);
return true;
}
Output() {
foreach (row in 0..n-1) {
foreach (col in 0..n-1) {
if (SpaceOccupied(row, col)) {
Write("Q");
}
else {
Write(".");
}
}
WriteLine("");
}
}
}
}

16
Task/N-queens-problem/Icon/n-queens-problem-1.icon Normal file
View file

@ -0,0 +1,16 @@
procedure main()
write(q(1), " ", q(2), " ", q(3), " ", q(4), " ", q(5), " ", q(6), " ", q(7), " ", q(8))
end
procedure q(c)
static udiag, ddiag, row
initial {
udiag := list(15, 0)
ddiag := list(15, 0)
row := list(8, 0)
}
every 0 = row[r := 1 to 8] = ddiag[r + c - 1] = udiag[8 + r - c] do # test if free
suspend row[r] <- ddiag[r + c - 1] <- udiag[8 + r - c] <- r # place and yield
end

3
Task/N-queens-problem/Icon/n-queens-problem-2.icon Normal file
View file

@ -0,0 +1,3 @@
procedure main()
every write(q(1), " ", q(2), " ", q(3), " ", q(4), " ", q(5), " ", q(6), " ", q(7), " ", q(8))
end

35
Task/N-queens-problem/Icon/n-queens-problem-3.icon Normal file
View file

@ -0,0 +1,35 @@
global n, rw, dd, ud
procedure main(args)
n := integer(args[1]) | 8
rw := list(n)
dd := list(2*n-1)
ud := list(2*n-1)
solvequeen(1)
end
procedure solvequeen(c)
if (c > n) then return show()
else suspend placequeen(c) & solvequeen(c+1)
end
procedure placequeen(c)
suspend (/rw[r := 1 to n] <- /dd[r+c-1] <- /ud[n+r-c] <- c)
end
procedure show()
static count, line, border
initial {
count := 0
line := repl("| ",n) || "|"
border := repl("----",n) || "-"
}
write("solution: ", count+:=1)
write(" ", border)
every line[4*(!rw - 1) + 3] <- "Q" do {
write(" ", line)
write(" ", border)
}
write()
return # Comment out to see all possible solutions
end

4
Task/N-queens-problem/J/n-queens-problem.j Normal file
View file

@ -0,0 +1,4 @@
perm =: ! A.&i. ] NB. all permutations of integers 0 to y
comb2 =: (, #: I.@,@(</)&i.)~ NB. all size 2 combinations of integers 0 to y
mask =: [ */@:~:&(|@-/) {
queenst=: comb2 (] #"1~ mask)&.|: perm

48
Task/N-queens-problem/Java/n-queens-problem.java Normal file
View file

@ -0,0 +1,48 @@
public class NQueens {
private static int[] b = new int[8];
private static int s = 0;
static boolean unsafe(int y) {
int x = b[y];
for (int i = 1; i <= y; i++) {
int t = b[y - i];
if (t == x ||
t == x - i ||
t == x + i) {
return true;
}
}
return false;
}
public static void putboard() {
System.out.println("\n\nSolution " + (++s));
for (int y = 0; y < 8; y++) {
for (int x = 0; x < 8; x++) {
System.out.print((b[y] == x) ? "|Q" : "|_");
}
System.out.println("|");
}
}
public static void main(String[] args) {
int y = 0;
b[0] = -1;
while (y >= 0) {
do {
b[y]++;
} while ((b[y] < 8) && unsafe(y));
if (b[y] < 8) {
if (y < 7) {
b[++y] = -1;
} else {
putboard();
}
} else {
y--;
}
}
}
}

52
Task/N-queens-problem/Locomotive-Basic/n-queens-problem.locomotive Normal file
View file

@ -0,0 +1,52 @@
10 mode 1:defint a-z
20 while n<4:input "How many queens (N>=4)";n:wend
30 dim q(n),e(n),o(n)
40 r=n mod 6
50 if r<>2 and r<>3 then gosub 320:goto 220
60 for i=1 to int(n/2)
70 e(i)=2*i
80 next
90 for i=1 to round(n/2)
100 o(i)=2*i-1
110 next
120 if r=2 then gosub 410
130 if r=3 then gosub 460
140 s=1
150 for i=1 to n
160 if e(i)>0 then q(s)=e(i):s=s+1
170 next
180 for i=1 to n
190 if o(i)>0 then q(s)=o(i):s=s+1
200 next
210 ' print board
220 cls
230 for i=1 to n
240 locate i,26-q(i):print chr$(238);
250 locate i,24-n :print chr$(96+i);
260 locate n+1,26-i :print i;
270 next
280 locate 1,1
290 call &bb06
300 end
310 ' the simple case
320 p=1
330 for i=1 to n
340 if i mod 2=0 then q(p)=i:p=p+1
350 next
360 for i=1 to n
370 if i mod 2 then q(p)=i:p=p+1
380 next
390 return
400 ' edit list when remainder is 2
410 for i=1 to n
420 if o(i)=3 then o(i)=1 else if o(i)=1 then o(i)=3
430 if o(i)=5 then o(i)=-1 else if o(i)=0 then o(i)=5:return
440 next
450 ' edit list when remainder is 3
460 for i=1 to n
470 if e(i)=2 then e(i)=-1 else if e(i)=0 then e(i)=2:goto 500
480 next
490 ' edit list some more
500 for i=1 to n
510 if o(i)=1 or o(i)=3 then o(i)=-1 else if o(i)=0 then o(i)=1:o(i+1)=3:return
520 next

17
Task/N-queens-problem/Logo/n-queens-problem.logo Normal file
View file

@ -0,0 +1,17 @@
to try :files :diag1 :diag2 :tried
if :files = 0 [make "solutions :solutions+1 show :tried stop]
localmake "safe (bitand :files :diag1 :diag2)
until [:safe = 0] [
localmake "f bitnot bitand :safe minus :safe
try bitand :files :f ashift bitand :diag1 :f -1 (ashift bitand :diag2 :f 1)+1 fput bitnot :f :tried
localmake "safe bitand :safe :safe-1
]
end
to queens :n
make "solutions 0
try (lshift 1 :n)-1 -1 -1 []
output :solutions
end
print queens 8 ; 92

46
Task/N-queens-problem/Lua/n-queens-problem.lua Normal file
View file

@ -0,0 +1,46 @@
N = 8
board = {}
for i = 1, N do
board[i] = {}
for j = 1, N do
board[i][j] = false
end
end
function Allowed( x, y )
for i = 1, x-1 do
if ( board[i][y] ) or ( i <= y and board[x-i][y-i] ) or ( y+i <= N and board[x-i][y+i] ) then
return false
end
end
return true
end
function Find_Solution( x )
for y = 1, N do
if Allowed( x, y ) then
board[x][y] = true
if x == N or Find_Solution( x+1 ) then
return true
end
board[x][y] = false
end
end
return false
end
if Find_Solution( 1 ) then
for i = 1, N do
for j = 1, N do
if board[i][j] then
io.write( "|Q" )
else
io.write( "| " )
end
end
print( "|" )
end
else
print( string.format( "No solution for %d queens.\n", N ) )
end

268
Task/N-queens-problem/MUMPS/n-queens-problem.mumps Normal file
View file

@ -0,0 +1,268 @@
Queens New count,flip,row,sol
Set sol=0
For row(1)=1:1:4 Do try(2) ; Not 8, the other 4 are symmetric...
;
; Remove symmetric solutions
Set sol="" For Set sol=$Order(sol(sol)) Quit:sol="" Do
. New xx,yy
. Kill sol($Translate(sol,12345678,87654321)) ; Vertical flip
. Kill sol($Reverse(sol)) ; Horizontal flip
. Set flip="--------" for xx=1:1:8 Do ; Flip over top left to bottom right diagonal
. . New nx,ny
. . Set yy=$Extract(sol,xx),nx=8+1-xx,ny=8+1-yy
. . Set $Extract(flip,ny)=nx
. . Quit
. Kill sol(flip)
. Set flip="--------" for xx=1:1:8 Do ; Flip over top right to bottom left diagonal
. . New nx,ny
. . Set yy=$Extract(sol,xx),nx=xx,ny=yy
. . Set $Extract(flip,ny)=nx
. . Quit
. Kill sol(flip)
. Quit
;
; Display remaining solutions
Set count=0,sol="" For Set sol=$Order(sol(sol)) Quit:sol="" Do Quit:sol=""
. New s1,s2,s3,txt,x,y
. Set s1=sol,s2=$Order(sol(s1)),s3="" Set:s2'="" s3=$Order(sol(s2))
. Set txt="+--+--+--+--+--+--+--+--+"
. Write !," ",txt Write:s2'="" " ",txt Write:s3'="" " ",txt
. For y=8:-1:1 Do
. . Write !,y," |"
. . For x=1:1:8 Write $Select($Extract(s1,x)=y:" Q",x+y#2:" ",1:"##"),"|"
. . If s2'="" Write " |"
. . If s2'="" For x=1:1:8 Write $Select($Extract(s2,x)=y:" Q",x+y#2:" ",1:"##"),"|"
. . If s3'="" Write " |"
. . If s3'="" For x=1:1:8 Write $Select($Extract(s3,x)=y:" Q",x+y#2:" ",1:"##"),"|"
. . Write !," ",txt Write:s2'="" " ",txt Write:s3'="" " ",txt
. . Quit
. Set txt=" A B C D E F G H"
. Write !," ",txt Write:s2'="" " ",txt Write:s3'="" " ",txt Write !
. Set sol=s3
. Quit
Quit
try(col) New ok,pcol
If col>8 Do Quit
. New out,x
. Set out="" For x=1:1:8 Set out=out_row(x)
. Set sol(out)=1
. Quit
For row(col)=1:1:8 Do
. Set ok=1
. For pcol=1:1:col-1 If row(pcol)=row(col) Set ok=0 Quit
. Quit:'ok
. For pcol=1:1:col-1 If col-pcol=$Translate(row(pcol)-row(col),"-") Set ok=0 Quit
. Quit:'ok
. Do try(col+1)
. Quit
Quit
Do Queens
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| Q|##| |##| |##| | |##| Q|##| |##| |##| | |##| | Q| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| |##| |##| Q|##| | |##| |##| | Q| |##| | |##| |##| |##| | Q| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | |##| | Q| |##| |##| | | Q| |##| |##| |##| | |##| Q|##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| Q|##| |##| |##| | |##| |##| |##| |##| Q| |##| |##| |##| |##| Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | |##| |##| |##| | Q| | |##| |##| | Q| |##| | | Q| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 |##| |##| | Q| |##| | |##| |##| Q|##| |##| | |##| |##| | Q| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | |##| |##| |##| Q|##| | |##| |##| |##| Q|##| | Q|##| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 | Q| |##| |##| |##| | | Q| |##| |##| |##| | |##| |##| |##| Q|##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| |##| | Q| |##| | |##| |##| | Q| |##| | |##| |##| | Q| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| | Q| |##| |##| | |##| | Q| |##| |##| | |##| |##| Q|##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | |##| |##| |##| Q|##| | |##| |##| |##| Q|##| | | Q| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| Q|##| |##| |##| | |##| Q|##| |##| |##| | |##| |##| |##| |##| Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | |##| |##| |##| | Q| | |##| | Q| |##| |##| | |##| |##| Q|##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 |##| |##| | Q| |##| | |##| |##| |##| |##| Q| |##| |##| |##| | Q| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | Q|##| |##| |##| |##| | Q|##| |##| |##| |##| | Q|##| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| |##| Q|##| |##| | |##| |##| | Q| |##| | |##| | Q| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| Q|##| |##| |##| | |##| |##| Q|##| |##| | |##| | Q| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| |##| |##| | Q| | |##| Q|##| |##| |##| | |##| Q|##| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | | Q| |##| |##| |##| | |##| | Q| |##| |##| | |##| |##| |##| Q|##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| |##| |##| |##| Q| |##| |##| |##| Q|##| | |##| | Q| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | |##| |##| | Q| |##| | |##| |##| |##| | Q| | |##| |##| | Q| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 |##| |##| Q|##| |##| | |##| | Q| |##| |##| | |##| |##| |##| |##| Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | Q|##| |##| |##| |##| | Q|##| |##| |##| |##| | Q|##| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| |##| | Q| |##| | |##| |##| |##| | Q| | |##| |##| | Q| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | | Q| |##| |##| |##| | |##| | Q| |##| |##| | |##| | Q| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| |##| |##| | Q| | |##| |##| |##| Q|##| | |##| |##| |##| | Q| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | |##| Q|##| |##| |##| | |##| |##| |##| | Q| | |##| |##| Q|##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| |##| |##| Q|##| | |##| Q|##| |##| |##| | |##| Q|##| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | |##| |##| |##| | Q| | |##| |##| |##| Q|##| | |##| |##| | Q| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 |##| |##| | Q| |##| | | Q| |##| |##| |##| | | Q| |##| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | Q|##| |##| |##| |##| | |##| Q|##| |##| |##| | |##| Q|##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| |##| Q|##| |##| | |##| |##| | Q| |##| | |##| |##| |##| |##| Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| Q|##| |##| |##| | |##| |##| Q|##| |##| | |##| |##| Q|##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| |##| |##| Q|##| | |##| |##| |##| | Q| | |##| |##| |##| | Q| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | |##| |##| |##| | Q| | | Q| |##| |##| |##| | | Q| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| Q|##| |##| |##| | |##| |##| Q|##| |##| | |##| |##| |##| Q|##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | |##| | Q| |##| |##| | |##| |##| |##| | Q| | |##| Q|##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 | Q| |##| |##| |##| | | Q| |##| |##| |##| | | Q| |##| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | |##| |##| |##| Q|##| | |##| Q|##| |##| |##| | |##| | Q| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| |##| | Q| |##| | |##| |##| |##| Q|##| | |##| |##| |##| |##| Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| Q|##| |##| |##| | |##| Q|##| |##| |##| | |##| | Q| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| |##| |##| Q|##| | |##| |##| |##| | Q| | |##| Q|##| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | | Q| |##| |##| |##| | | Q| |##| |##| |##| | |##| |##| |##| | Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| |##| | Q| |##| | |##| |##| |##| |##| Q| |##| |##| | Q| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | |##| |##| |##| | Q| | |##| |##| Q|##| |##| | |##| |##| |##| Q|##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 | Q| |##| |##| |##| | | Q| |##| |##| |##| | | Q| |##| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | |##| |##| |##| Q|##| | |##| | Q| |##| |##| | |##| Q|##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| |##| Q|##| |##| | |##| |##| |##| Q|##| | |##| |##| |##| Q|##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| | Q| |##| |##| | | Q| |##| |##| |##| | |##| | Q| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| Q|##| |##| |##| | |##| |##| Q|##| |##| | |##| |##| |##| |##| Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | |##| |##| Q|##| |##| | |##| |##| | Q| |##| | |##| |##| Q|##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| |##| |##| |##| Q| |##| |##| |##| |##| Q| |##| | Q| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | |##| |##| | Q| |##| | |##| Q|##| |##| |##| | Q|##| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 | Q| |##| |##| |##| | | Q| |##| |##| |##| | |##| |##| |##| | Q| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | |##| Q|##| |##| |##| | |##| |##| |##| Q|##| | | Q| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| |##| |##| | Q| | |##| |##| | Q| |##| | |##| |##| |##| Q|##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| |##| | Q| |##| | |##| Q|##| |##| |##| | |##| Q|##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| | Q| |##| |##| | |##| |##| | Q| |##| | |##| |##| |##| |##| Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | |##| |##| Q|##| |##| | |##| |##| |##| | Q| | |##| | Q| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| |##| |##| |##| Q| |##| |##| Q|##| |##| | |##| |##| |##| | Q| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | Q|##| |##| |##| |##| | Q|##| |##| |##| |##| | Q|##| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 |##| |##| Q|##| |##| | |##| |##| |##| | Q| | |##| |##| |##| Q|##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | | Q| |##| |##| |##| | | Q| |##| |##| |##| | | Q| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| |##| |##| | Q| | |##| |##| |##| Q|##| | |##| |##| | Q| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| |##| | Q| |##| | |##| Q|##| |##| |##| | |##| | Q| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| |##| |##| |##| Q| |##| |##| | Q| |##| | |##| Q|##| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | | Q| |##| |##| |##| | | Q| |##| |##| |##| | |##| |##| |##| | Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| |##| Q|##| |##| | |##| |##| |##| |##| Q| |##| |##| |##| Q|##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | Q|##| |##| |##| |##| | Q|##| |##| |##| |##| | Q|##| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 |##| |##| |##| | Q| | |##| |##| |##| | Q| | |##| | Q| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | |##| |##| Q|##| |##| | |##| | Q| |##| |##| | |##| |##| Q|##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| | Q| |##| |##| | |##| |##| |##| Q|##| | |##| |##| |##| | Q| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
8 | |##| |##| |##| | Q| | | Q| |##| |##| |##| | | Q| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
7 |##| Q|##| |##| |##| | |##| |##| |##| | Q| | |##| |##| | Q| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
6 | |##| |##| Q|##| |##| | |##| |##| Q|##| |##| | |##| |##| |##| Q|##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
5 |##| | Q| |##| |##| | |##| |##| |##| |##| Q| |##| |##| Q|##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
4 | Q|##| |##| |##| |##| | Q|##| |##| |##| |##| | Q|##| |##| |##| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
3 |##| |##| |##| | Q| | |##| |##| Q|##| |##| | |##| |##| |##| |##| Q|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
2 | |##| | Q| |##| |##| | |##| |##| | Q| |##| | |##| |##| | Q| |##|
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
1 |##| |##| |##| Q|##| | |##| | Q| |##| |##| | |##| | Q| |##| |##| |
+--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+ +--+--+--+--+--+--+--+--+
A B C D E F G H A B C D E F G H A B C D E F G H
+--+--+--+--+--+--+--+--+
8 | | Q| |##| |##| |##|
+--+--+--+--+--+--+--+--+
7 |##| |##| |##| Q|##| |
+--+--+--+--+--+--+--+--+
6 | |##| |##| |##| | Q|
+--+--+--+--+--+--+--+--+
5 |##| | Q| |##| |##| |
+--+--+--+--+--+--+--+--+
4 | Q|##| |##| |##| |##|
+--+--+--+--+--+--+--+--+
3 |##| |##| Q|##| |##| |
+--+--+--+--+--+--+--+--+
2 | |##| |##| |##| Q|##|
+--+--+--+--+--+--+--+--+
1 |##| |##| | Q| |##| |
+--+--+--+--+--+--+--+--+
A B C D E F G H

9
Task/N-queens-problem/Mathematica/n-queens-problem-1.math Normal file
View file

@ -0,0 +1,9 @@
safe[q_List, n_] :=
With[{l = Length@q},
Length@Union@q == Length@Union[q + Range@l] ==
Length@Union[q - Range@l] == l]
nQueen[q_List:{}, n_] :=
If[safe[q, n],
If[Length[q] == n, q,
Cases[Flatten[{nQueen[Append[q, #], n]}, 2] & /@ Range[n],
Except[{Null} | {}]]], Null]

5
Task/N-queens-problem/Mathematica/n-queens-problem-2.math Normal file
View file

@ -0,0 +1,5 @@
matrixView[n_] :=
Grid[Normal@
SparseArray[MapIndexed[{#, First@#2} -> "Q" &, #], {n, n}, "."],
Frame -> All] & /@ nQueen[n]
matrixView[6] // OutputForm

18
Task/N-queens-problem/Maxima/n-queens-problem.maxima Normal file
View file

@ -0,0 +1,18 @@
/* translation of Fortran 77, return solutions as permutations */
queens(n) := block([a, i, j, m, p, q, r, s, u, v, w, y, z],
a: makelist(i, i, 1, n), s: a*0, u: makelist(0, i, 1, 4*n - 2),
m: 0, i: 1, r: 2*n - 1, w: [ ], go(L40), L30, s[i]: j, u[p]: 1,
u[q + r]: 1, i: i + 1, L40, if i > n then go(L80), j: i, L50,
z: a[i], y: a[j], p: i - y + n, q: i + y - 1, a[i]: y, a[j]: z,
if u[p] = 0 and u[q + r] = 0 then go(L30), L60, j: j + 1,
if j <= n then go(L50), L70, j: j - 1, if j = i then go(L90),
z: a[i], a[i]: a[j], a[j]: z, go(L70), L80, m: m + 1,
w: endcons(copylist(a), w), L90, i: i - 1, if i = 0 then go(L100),
p: i - a[i] + n, q: i + a[i] - 1, j: s[i], u[p]: 0, u[q + r]: 0,
go(L60), L100, w)$
queens(8); /* [[1, 5, 8, 6, 3, 7, 2, 4],
[1, 6, 8, 3, 7, 4, 2, 5],
...]] */
length(%); /* 92 */

59
Task/N-queens-problem/OCaml/n-queens-problem-1.ocaml Normal file
View file

@ -0,0 +1,59 @@
(* Authors: Nicolas Barnier, Pascal Brisset
Copyright 2004 CENA. All rights reserved.
This code is distributed under the terms of the GNU LGPL *)
open Facile
open Easy
(* Print a solution *)
let print queens =
let n = Array.length queens in
if n <= 10 then (* Pretty printing *)
for i = 0 to n - 1 do
let c = Fd.int_value queens.(i) in (* queens.(i) is bound *)
for j = 0 to n - 1 do
Printf.printf "%c " (if j = c then '*' else '-')
done;
print_newline ()
done
else (* Short print *)
for i = 0 to n-1 do
Printf.printf "line %d : col %a\n" i Fd.fprint queens.(i)
done;
flush stdout;
;;
(* Solve the n-queens problem *)
let queens n =
(* n decision variables in 0..n-1 *)
let queens = Fd.array n 0 (n-1) in
(* 2n auxiliary variables for diagonals *)
let shift op = Array.mapi (fun i qi -> Arith.e2fd (op (fd2e qi) (i2e i))) queens in
let diag1 = shift (+~) and diag2 = shift (-~) in
(* Global constraints *)
Cstr.post (Alldiff.cstr queens);
Cstr.post (Alldiff.cstr diag1);
Cstr.post (Alldiff.cstr diag2);
(* Heuristic Min Size, Min Value *)
let h a = (Var.Attr.size a, Var.Attr.min a) in
let min_min = Goals.Array.choose_index (fun a1 a2 -> h a1 < h a2) in
(* Search goal *)
let labeling = Goals.Array.forall ~select:min_min Goals.indomain in
(* Solve *)
let bt = ref 0 in
if Goals.solve ~control:(fun b -> bt := b) (labeling queens) then begin
Printf.printf "%d backtracks\n" !bt;
print queens
end else
prerr_endline "No solution"
let _ =
if Array.length Sys.argv <> 2
then raise (Failure "Usage: queens <nb of queens>");
Gc.set ({(Gc.get ()) with Gc.space_overhead = 500}); (* May help except with an underRAMed system *)
queens (int_of_string Sys.argv.(1));;

32
Task/N-queens-problem/OCaml/n-queens-problem-2.ocaml Normal file
View file

@ -0,0 +1,32 @@
let solutions n =
let show board =
let pr v =
for i = 1 to n do
print_string (if i=v then " q" else " _");
done;
print_newline() in
List.iter pr board;
print_newline() in
let rec safe i j k = function
| [] -> true
| h::t -> h<>i && h<>j && h<>k && safe i (j+1) (k-1) t in
let rec loop col p =
for i = 1 to n
do
if safe i (i+1) (i-1) p then
let p' = i::p in
if col = n then show p'
else loop (col+1) p'
done in
loop 1 [] in
let n =
if Array.length Sys.argv > 1
then int_of_string Sys.argv.(1)
else 8 in
solutions n

57
Task/N-queens-problem/Objeck/n-queens-problem.objeck Normal file
View file

@ -0,0 +1,57 @@
bundle Default {
class NQueens {
b : static : Int[];
s : static : Int;
function : Main(args : String[]) ~ Nil {
b := Int->New[8];
s := 0;
y := 0;
b[0] := -1;
while (y >= 0) {
do {
b[y]+=1;
}
while((b[y] < 8) & Unsafe(y));
if(b[y] < 8) {
if (y < 7) {
b[y + 1] := -1;
y += 1;
}
else {
PutBoard();
};
}
else {
y-=1;
};
};
}
function : Unsafe(y : Int) ~ Bool {
x := b[y];
for(i := 1; i <= y; i+=1;) {
t := b[y - i];
if(t = x | t = x - i | t = x + i) {
return true;
};
};
return false;
}
function : PutBoard() ~ Nil {
IO.Console->Print("\n\nSolution ")->PrintLine(s + 1);
s += 1;
for(y := 0; y < 8; y+=1;) {
for(x := 0; x < 8; x+=1;) {
IO.Console->Print((b[y] = x) ? "|Q" : "|_");
};
"|"->PrintLine();
};
}
}
}

68
Task/N-queens-problem/Oz/n-queens-problem.oz Normal file
View file

@ -0,0 +1,68 @@
declare
fun {Queens N}
proc {$ Board}
%% a board is a N-tuple of rows
Board = {MakeTuple queens N}
for Y in 1..N do
%% a row is a N-tuple of values in [0,1]
%% (0: no queen, 1: queen)
Board.Y = {FD.tuple row N 0#1}
end
{ForAll {Rows Board} SumIs1}
{ForAll {Columns Board} SumIs1}
%% for every two points on a diagonal
for [X1#Y1 X2#Y2] in {DiagonalPairs N} do
%$ at most one of them has a queen
Board.Y1.X1 + Board.Y2.X2 =<: 1
end
%% enumerate all such boards
{FD.distribute naive {FlatBoard Board}}
end
end
fun {Rows Board}
{Record.toList Board}
end
fun {Columns Board}
for X in {Arity Board.1} collect:C1 do
{C1
for Y in {Arity Board} collect:C2 do
{C2 Board.Y.X}
end}
end
end
proc {SumIs1 Xs}
{FD.sum Xs '=:' 1}
end
fun {DiagonalPairs N}
proc {Coords Root}
[X1#Y1 X2#Y2] = Root
Diff
in
X1::1#N Y1::1#N
X2::1#N Y2::1#N
%% (X1,Y1) and (X2,Y2) are on a diagonal if {Abs X2-X1} = {Abs Y2-Y1}
Diff::1#N-1
{FD.distance X2 X1 '=:' Diff}
{FD.distance Y2 Y1 '=:' Diff}
%% enumerate all such coordinates
{FD.distribute naive [X1 Y1 X2 Y2]}
end
in
{SearchAll Coords}
end
fun {FlatBoard Board}
{Flatten {Record.toList {Record.map Board Record.toList}}}
end
Solutions = {SearchAll {Queens 8}}
in
{Length Solutions} = 92 %% assert
{Inspect {List.take Solutions 3}}

175
Task/N-queens-problem/PHP/n-queens-problem.php Normal file
View file

@ -0,0 +1,175 @@
<html>
<head>
<title>
n x n Queen solving program
</title>
</head>
<body>
<?php
echo "<h1>n x n Queen solving program</h1>";
//Get the size of the board
$boardX = $_POST['boardX'];
$boardY = $_POST['boardX'];
// Function to rotate a board 90 degrees
function rotateBoard($p, $boardX) {
$a=0;
while ($a < count($p)) {
$b = strlen(decbin($p[$a]))-1;
$tmp[$b] = 1 << ($boardX - $a - 1);
++$a;
}
ksort($tmp);
return $tmp;
}
// This function will find rotations of a solution
function findRotation($p, $boardX,$solutions){
$tmp = rotateBoard($p,$boardX);
// Rotated 90
if (in_array($tmp,$solutions)) {}
else {$solutions[] = $tmp;}
$tmp = rotateBoard($tmp,$boardX);
// Rotated 180
if (in_array($tmp,$solutions)){}
else {$solutions[] = $tmp;}
$tmp = rotateBoard($tmp,$boardX);
// Rotated 270
if (in_array($tmp,$solutions)){}
else {$solutions[] = $tmp;}
// Reflected
$tmp = array_reverse($p);
if (in_array($tmp,$solutions)){}
else {$solutions[] = $tmp;}
$tmp = rotateBoard($tmp,$boardX);
// Reflected and Rotated 90
if (in_array($tmp,$solutions)){}
else {$solutions[] = $tmp;}
$tmp = rotateBoard($tmp,$boardX);
// Reflected and Rotated 180
if (in_array($tmp,$solutions)){}
else {$solutions[] = $tmp;}
$tmp = rotateBoard($tmp,$boardX);
// Reflected and Rotated 270
if (in_array($tmp,$solutions)){}
else {$solutions[] = $tmp;}
return $solutions;
}
// This is a function which will render the board
function renderBoard($p,$boardX) {
echo "<table border=1 cellspacing=0 style='text-align:center;display:inline'>";
for ($y = 0; $y < $boardX; ++$y) {
echo '<tr>';
for ($x = 0; $x < $boardX; ++$x){
if (($x+$y) & 1) { $cellCol = '#9C661F';}
else {$cellCol = '#FCE6C9';}
if ($p[$y] == 1 << $x) { echo "<td bgcolor=".$cellCol."><img width=30 height=30 src='./images/blackqueen.png'></td>";}
else { echo "<td bgcolor=".$cellCol."> </td>";}
}
echo '<tr>';
}
echo '<tr></tr></table>&nbsp';
}
//This function allows me to generate the next order of rows.
function pc_next_permutation($p) {
$size = count($p) - 1;
// slide down the array looking for where we're smaller than the next guy
for ($i = $size - 1; $p[$i] >= $p[$i+1]; --$i) { }
// if this doesn't occur, we've finished our permutations
// the array is reversed: (1, 2, 3, 4) => (4, 3, 2, 1)
if ($i == -1) { return false; }
// slide down the array looking for a bigger number than what we found before
for ($j = $size; $p[$j] <= $p[$i]; --$j) { }
// swap them
$tmp = $p[$i]; $p[$i] = $p[$j]; $p[$j] = $tmp;
// now reverse the elements in between by swapping the ends
for (++$i, $j = $size; $i < $j; ++$i, --$j)
{ $tmp = $p[$i]; $p[$i] = $p[$j]; $p[$j] = $tmp; }
return $p;
}
//This function needs to check the current state to see if there are any
function checkBoard($p,$boardX) {
$a = 0; //this is the row being checked
while ($a < count($p)) {
$b = 1;
while ($b < ($boardX - $a)){
$x = $p[$a+$b] << $b;
$y = $p[$a+$b] >> $b;
if ($p[$a] == $x | $p[$a] == $y) { return false;}
++$b;
}
++$a;
}
return true;
}
if (isset($_POST['process']) && isset($_POST['boardX']))
{
//Within here is the code that needs to be run if process is clicked.
//First I need to create the different possible rows
for ($x = 0; $x < $boardX; ++$x){
$row[$x] = 1 << $x;
}
//Now I need to create all the possible orders of rows, will be equal to [boardY]!
$solcount = 0;
$solutions = array();
while ($row != false) {
if (checkBoard($row,$boardX)){
if(!in_array($row,$solutions)){
$solutions[] = $row;
renderBoard($row,$boardX);
$solutions = findRotation($row,$boardX,$solutions);
++$solcount;
}
}
$row = pc_next_permutation($row);
}
echo "<br><br>&nbsp&nbsp&nbsp&nbspRows/Columns: ".$boardX."<br>&nbsp&nbsp&nbsp&nbspUnique Solutions: ".$solcount."<br>&nbsp&nbsp&nbsp&nbspTotal Solutions: ".count($solutions)." - Note: This includes symmetrical solutions<br>";
//print_r($solutions);
}
//This code collects the starting parameters
echo <<<_END
<form name="input" action="queens.php" method="post">
&nbsp&nbsp&nbsp&nbspNumber of columns/rows <select name="boardX" />
<option value="1">One</option>
<option value="2">Two</option>
<option value="3">Three</option>
<option value="4" >Four</option>
<option value="5">Five</option>
<option value="6">Six</option>
<option value="7">Seven</option>
<option value="8" selected="selected">Eight</option>
<option value="9">Nine</option>
<option value="10">Ten</option>
</select>
<input type="hidden" name="process" value="yes" />
&nbsp<input type="submit" value="Process" />
</form>
_END;
?>
</body>
</html>

81
Task/N-queens-problem/Pascal/n-queens-problem.pascal Normal file
View file

@ -0,0 +1,81 @@
program queens;
const l=16;
var i,j,k,m,n,p,q,r,y,z: integer;
a,s: array[1..l] of integer;
u: array[1..4*l-2] of integer;
label L3,L4,L5,L6,L7,L8,L9,L10;
begin
for i:=1 to l do a[i]:=i;
for i:=1 to 4*l-2 do u[i]:=0;
for n:=1 to l do
begin
m:=0;
i:=1;
r:=2*n-1;
goto L4;
L3:
s[i]:=j;
u[p]:=1;
u[q+r]:=1;
i:=i+1;
L4:
if i>n then goto L8;
j:=i;
L5:
z:=a[i];
y:=a[j];
p:=i-y+n;
q:=i+y-1;
a[i]:=y;
a[j]:=z;
if (u[p]=0) and (u[q+r]=0) then goto L3;
L6:
j:=j+1;
if j<=n then goto L5;
L7:
j:=j-1;
if j=i then goto L9;
z:=a[i];
a[i]:=a[j];
a[j]:=z;
goto L7;
L8:
m:=m+1;
{ uncomment the following to print solutions }
{ write(n,' ',m,':');
for k:=1 to n do write(' ',a[k]);
writeln; }
L9:
i:=i-1;
if i=0 then goto L10;
p:=i-a[i]+n;
q:=i+a[i]-1;
j:=s[i];
u[p]:=0;
u[q+r]:=0;
goto L6;
L10:
writeln(n,' ',m);
end;
end.
{ 1 1
2 0
3 0
4 2
5 10
6 4
7 40
8 92
9 352
10 724
11 2680
12 14200
13 73712
14 365596
15 2279184
16 14772512 }

30
Task/N-queens-problem/Perl-6/n-queens-problem.pl6 Normal file
View file

@ -0,0 +1,30 @@
sub MAIN($N = 8) {
sub collision(@field, $row) {
for ^$row -> $i {
my $distance = @field[$i] - @field[$row];
return 1 if $distance == any(0, $row - $i, $i - $row);
}
0;
}
sub search(@field is rw, $row) {
if $row == $N {
return @field;
} else {
for ^$N -> $i {
@field[$row] = $i;
if !collision(@field, $row) {
my @r = search(@field, $row + 1) and return @r;
}
}
}
Nil;
}
for 0 .. $N / 2 {
if my @f = search [$_], 1 {
say ~@f;
last;
}
}
}
# output:
0 4 7 5 2 6 1 3

41
Task/N-queens-problem/Perl/n-queens-problem.pl Normal file
View file

@ -0,0 +1,41 @@
my ($board_size, @occupied, @past, @solutions);
sub try_column {
my ($depth, @diag) = shift;
if ($depth == $board_size) {
push @solutions, "@past\n";
return;
}
# @diag: marks cells diagonally attackable by any previous queens.
# Here it's pre-allocated to double size just so we don't need
# to worry about negative indices.
$#diag = 2 * $board_size;
for (0 .. $#past) {
$diag[ $past[$_] + $depth - $_ ] = 1;
$diag[ $past[$_] - $depth + $_ ] = 1;
}
for my $row (0 .. $board_size - 1) {
next if $occupied[$row] || $diag[$row];
# @past: row numbers of previous queens
# @occupied: rows already used. This gets inherited by each
# recursion so we don't need to repeatedly look them up
push @past, $row;
$occupied[$row] = 1;
try_column($depth + 1);
# clean up, for next recursion
$occupied[$row] = 0;
pop @past;
}
}
$board_size = 12; # takes a minute or so, 14,200 solutions
try_column(0);
local $" = "\n";
print @solutions;
print "total ", scalar(@solutions), " solutions\n";

11
Task/N-queens-problem/PicoLisp/n-queens-problem-1.l Normal file
View file

@ -0,0 +1,11 @@
(load "@lib/simul.l") # for 'permute'
(de queens (N)
(let (R (range 1 N) Cnt 0)
(for L (permute (range 1 N))
(when
(= N # from the Python solution
(length (uniq (mapcar + L R)))
(length (uniq (mapcar - L R))) )
(inc 'Cnt) ) )
Cnt ) )

16
Task/N-queens-problem/PicoLisp/n-queens-problem-2.l Normal file
View file

@ -0,0 +1,16 @@
(de queens (N)
(let (R (range 1 N) L (copy R) X L Cnt 0)
(recur (X) # Permute
(if (cdr X)
(do (length X)
(recurse (cdr X))
(rot X) )
(or
(seek # Direct check for duplicates
'((L) (member (car L) (cdr L)))
(mapcar + L R) )
(seek
'((L) (member (car L) (cdr L)))
(mapcar - L R) )
(inc 'Cnt) ) ) )
Cnt ) )

40
Task/N-queens-problem/PowerBASIC/n-queens-problem.powerbasic Normal file
View file

@ -0,0 +1,40 @@
defint a-z
option base 1
input "n=",n
dim a(n), s(n), u(4*n-2)
for i=1 to n: a(i)=i: next
for i=1 to 4*n-2: u(i)=0: next
m=0
i=1
r=2*n-1
goto 20
10 s(i)=j
u(p)=1
u(q+r)=1
incr i
20 if i>n goto 60
j=i
30 z=a(i)
y=a(j)
p=i-y+n
q=i+y-1
a(i)=y
a(j)=z
if u(p)=0 and u(q+r)=0 goto 10
40 incr j
if j<=n goto 30
50 decr j
if j=i goto 70
swap a(i),a(j)
goto 50
60 incr m
for k=1 to n: print a(k);: next: print
70 decr i
if i=0 goto 80
p=i-a(i)+n
q=i+a(i)-1
j=s(i)
u(p)=0
u(q+r)=0
goto 40
80 print m

21
Task/N-queens-problem/Prolog/n-queens-problem-1.pro Normal file
View file

@ -0,0 +1,21 @@
solution([]).
solution([X/Y|Others]) :-
solution(Others),
member(Y, [1,2,3,4,5,6,7,8]),
noattack(X/Y, Others).
noattack(_,[]).
noattack(X/Y,[X1/Y1|Others]) :-
Y =\= Y1,
Y1 - Y =\= X1 - X,
Y1 - Y =\= X - X1,
noattack(X/Y,Others).
member(Item,[Item|Rest]).
member(Item,[First|Rest]) :-
member(Item,Rest).
template([1/Y1,2/Y2,3/Y3,4/Y4,5/Y5,6/Y6,7/Y7,8/Y8]).

28
Task/N-queens-problem/Prolog/n-queens-problem-2.pro Normal file
View file

@ -0,0 +1,28 @@
solution(Queens) :-
permutation([1,2,3,4,5,6,7,8], Queens),
safe(Queens).
permutation([],[]).
permutation([Head|Tail],PermList) :-
permutation(Tail,PermTail),
del(Head,PermList,PermTail).
del(Item,[Item|List],List).
del(Item,[First|List],[First|List1]) :-
del(Item,List,List1).
safe([]).
safe([Queen|Others]) :-
safe(Others),
noattack(Queen,Others,1).
noattack(_,[],_).
noattack(Y,[Y1|Ylist],Xdist) :-
Y1-Y=\=Xdist,
Y-Y1=\=Xdist,
Dist1 is Xdist + 1,
noattack(Y,Ylist,Dist1).

20
Task/N-queens-problem/Prolog/n-queens-problem-3.pro Normal file
View file

@ -0,0 +1,20 @@
solution(Ylist) :-
sol(Ylist,[1,2,3,4,5,6,7,8],
[1,2,3,4,5,6,7,8],
[-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4,5,6,7],
[2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]).
sol([],[],[],Du,Dv).
sol([Y|Ylist],[X|Dx1],Dy,Du,Dv) :-
del(Y,Dy,Dy1),
U is X-Y,
del(U,Du,Du1),
V is X+Y,
del(V,Dv,Dv1),
sol(Ylist,Dx1, Dy1,Du1,Dv1).
del(Item,[Item|List],List).
del(Item,[First|List],[First|List1]) :-
del(Item,List,List1).

80
Task/N-queens-problem/PureBasic/n-queens-problem.purebasic Normal file
View file

@ -0,0 +1,80 @@
Global solutions
Procedure showBoard(Array queenCol(1))
Protected row, column, n = ArraySize(queenCol())
PrintN(" Solution " + Str(solutions))
For row = 0 To n
For column = 0 To n
If queenCol(row) = column
Print("|Q")
Else
Print("| ")
EndIf
Next
PrintN("|")
Next
EndProcedure
Macro advanceIfPossible()
x + 1
While x <= n And columns(x): x + 1: Wend
If x > n
ProcedureReturn #False ;backtrack
EndIf
EndMacro
Procedure placeQueens(Array queenCol(1), Array columns(1), row = 0)
Protected n = ArraySize(queenCol())
If row > n
solutions + 1
showBoard(queenCol())
ProcedureReturn #False ;backtrack
EndIf
Protected x, queen, passed
While columns(x): x + 1: Wend
;place a new queen in one of the available columns
Repeat
passed = #True
For queen = 0 To row - 1
If ((queenCol(queen) - x) = (queen - row)) Or ((queenCol(queen) - x) = -(queen - row))
advanceIfPossible()
passed = #False
Break ;ForNext loop
EndIf
Next
If passed
queenCol(row) = x: columns(x) = 1
If Not placeQueens(queenCol(), columns(), row + 1)
columns(x) = 0
advanceIfPossible()
EndIf
EndIf
ForEver
EndProcedure
Procedure queens(n)
If n > 0
Dim queenCol(n - 1)
Dim columns(n - 1)
placeQueens(queenCol(), columns())
EndIf
EndProcedure
If OpenConsole()
Define i
For i = 1 To 12
solutions = 0
queens(i)
PrintN(#CRLF$ + Str(solutions) + " solutions found for " + Str(i) + "-queens.")
Input()
Next
Print(#CRLF$ + "Press ENTER to exit")
Input()
CloseConsole()
EndIf

8
Task/N-queens-problem/Python/n-queens-problem-1.py Normal file
View file

@ -0,0 +1,8 @@
from itertools import permutations
n = 8
cols = range(n)
for vec in permutations(cols):
if n == len(set(vec[i]+i for i in cols)) \
== len(set(vec[i]-i for i in cols)):
print ( vec )

2
Task/N-queens-problem/Python/n-queens-problem-2.py Normal file
View file

@ -0,0 +1,2 @@
def board(vec):
print ("\n".join('.' * i + 'Q' + '.' * (n-i-1) for i in vec) + "\n===\n")

17
Task/N-queens-problem/Python/n-queens-problem-3.py Normal file
View file

@ -0,0 +1,17 @@
# From: http://wiki.python.org/moin/SimplePrograms, with permission from the author, Steve Howell
BOARD_SIZE = 8
def under_attack(col, queens):
return col in queens or \
any(abs(col - x) == len(queens)-i for i,x in enumerate(queens))
def solve(n):
solutions = [[]]
for row in range(n):
solutions = [solution+[i+1]
for solution in solutions
for i in range(BOARD_SIZE)
if not under_attack(i+1, solution)]
return solutions
for answer in solve(BOARD_SIZE): print(list(enumerate(answer, start=1)))

19
Task/N-queens-problem/Python/n-queens-problem-4.py Normal file
View file

@ -0,0 +1,19 @@
BOARD_SIZE = 8
def under_attack(col, queens):
return col in queens or \
any(abs(col - x) == len(queens)-i for i,x in enumerate(queens))
def solve(n):
solutions = [[]]
for row in range(n):
solutions = (solution+[i+1]
for solution in solutions # first for clause is evaluated immediately,
# so "solutions" is correctly captured
for i in range(BOARD_SIZE)
if not under_attack(i+1, solution))
return solutions
answers = solve(BOARD_SIZE)
first_answer = next(answers)
print(list(enumerate(first_answer, start=1)))

28
Task/N-queens-problem/R/n-queens-problem.r Normal file
View file

@ -0,0 +1,28 @@
# Brute force, see the "Permutations" page for the next.perm function
safe <- function(p) {
n <- length(p)
for(i in 1:(n-1)) {
for(j in (i+1):n) {
if(abs(p[j] - p[i]) == abs(j - i)) return(FALSE)
}
}
return(TRUE)
}
queens <- function(n) {
p <- 1:n
k <- 0
while(!is.null(p)) {
if(safe(p)) {
cat(p,"\n")
k <- k + 1
}
p <- next.perm(p)
}
return(k)
}
queens(8)
# 1 5 8 6 3 7 2 4
# ...
# 92

64
Task/N-queens-problem/REXX/n-queens-problem.rexx Normal file
View file

@ -0,0 +1,64 @@
/*REXX program place N queens on a NxN chessboard (the 8 queens problem)*/
parse arg N . /*get board size arg (if any). */
if N=='' then N=8 /*No argument? Use the default.*/
file=1; rank=1; q=0 /*starting place, # of queens. */
@.=0; !=left('', 9* (N<18)) /*define empty board, indentation*/
/*═════════════════════════════════════find solution: N queens problem.*/
do while q<N /*keep placing queens until done.*/
@.file.rank=1 /*place a queen on the chessboard*/
if safe?(file,rank) then do; q=q+1 /*if not being attached, eureka! */
file=1 /*another attempt at file #1, */
rank=rank+1 /*and also bump the rank pointer.*/
end
else do /*¬ safe, so it's a bad placement*/
@.file.rank=0 /* So, remove this queen. */
file=file+1 /*try the next file then. */
do while file>N; rank=rank-1
if rank==0 then call noSol
do j=1 for N
if @.j.rank then do; file=j; @.file.rank=0
q=q-1; file=j+1
leave /*j*/
end
end /*j*/
end /*do while file>N*/
end /*else do*/
end /*while q<N*/
/*══════════════════════════════════════show chessboard with a solution.*/
say 'A solution for' N "queens:"; _ = substr( copies("┼───", N) ,2)
lineT = '┌'_"┐"; say; say ! translate(lineT,'┬',"┼")
lineB = '└'_"┘"; lineB = translate(lineB, '┴', "┼")
line = '├'_"┤" /*define a line for cell boundry.*/
bar = '│' /*kinds: horizonal/vertical/salad*/
Bqueen = '░♀░' /*glyph befitting the black queen*/
Wqueen = ' ♀ ' /* " " " white " */
/*═══════════════════════==══════════════place the queens on chessboard.*/
do r=1 for N; if r\==1 then say ! line; _= /*process the rank &*/
do f=1 for N; black=(f+r)//2 /*the file; is it a black square?*/
qgylph=Wqueen; if black then Qgylph=Bqueen /*use a black queen.*/
/*is it black sqare?*/
if @.f.r then _=_ || bar || Qgylph /*use the 3-char symbol for queen*/
else if black then _=_ || bar'░░░' /*¼ dithering char. */
else _=_ || bar' ' /*three blanks. */
end /*f*/ /* [↑] preserve square chessboard*/
say ! _ || bar
end /*r*/ /*80 cols can view 19x19 chessbrd*/
say ! lineB; say /*show last line, + a blank line.*/
exit 1 /*stick a fork in it, we're done.*/
/*──────────────────────────────────NOSOL subroutine────────────────────*/
noSol: say "No solution for" N 'queens.'; exit 0
/*──────────────────────────────────SAFE? subroutine────────────────────*/
safe?: procedure expose @.; parse arg file,rank
do k=rank-1 to 1 by -1; if @.file.k then return 0
end
f=file-1; r=rank-1
do while f\==0 & r\==0; if @.f.r then return 0
f=f-1; r=r-1
end
f=file+1; r=rank-1
do while f<=n & r\==0; if @.f.r then return 0
f=f+1; r=r-1
end
return 1

10
Task/N-queens-problem/Rascal/n-queens-problem.rascal Normal file
View file

@ -0,0 +1,10 @@
import Prelude;
public set[list[int]] Nqueens(int n){
cols = upTill(n);
result = {};
for (vector <- permutations(cols)){
if (n == size({vector[j] + j |j <- cols}) && n == size({vector[j] - j |j <- cols}))
result += vector;}
return result;
}

59
Task/N-queens-problem/Ruby/n-queens-problem.rb Normal file
View file

@ -0,0 +1,59 @@
# 1. Divide n by 12. Remember the remainder (n is 8 for the eight queens
# puzzle).
# 2. Write a list of the even numbers from 2 to n in order.
# 3. If the remainder is 3 or 9, move 2 to the end of the list.
# 4. Append the odd numbers from 1 to n in order, but, if the remainder is 8,
# switch pairs (i.e. 3, 1, 7, 5, 11, 9, …).
# 5. If the remainder is 2, switch the places of 1 and 3, then move 5 to the
# end of the list.
# 6. If the remainder is 3 or 9, move 1 and 3 to the end of the list.
# 7. Place the first-column queen in the row with the first number in the
# list, place the second-column queen in the row with the second number in
# the list, etc.
def n_queens(n)
if n == 1
return "Q"
elsif n < 4
puts "no solutions for n=#{n}"
return ""
end
evens = (2..n).step(2).to_a
odds = (1..n).step(2).to_a
rem = n % 12 # (1)
nums = evens # (2)
nums.push(nums.shift) if rem == 3 or rem == 9 # (3)
# (4)
if rem == 8
odds = odds.each_slice(2).inject([]) {|ary, (a,b)| ary += [b,a]}
end
nums.concat(odds)
# (5)
if rem == 2
idx = []
[1,3,5].each {|i| idx[i] = nums.index(i)}
nums[idx[1]], nums[idx[3]] = nums[idx[3]], nums[idx[1]]
nums.slice!(idx[5])
nums.push(5)
end
# (6)
if rem == 3 or rem == 9
[1,3].each do |i|
nums.slice!( nums.index(i) )
nums.push(i)
end
end
# (7)
board = Array.new(n) {Array.new(n) {"."}}
n.times {|i| board[i][nums[i] - 1] = "Q"}
board.inject("") {|str, row| str << row.join(" ") << "\n"}
end
(1 .. 15).each {|n| puts "n=#{n}"; puts n_queens(n); puts}

58
Task/N-queens-problem/SAS/n-queens-problem.sas Normal file
View file

@ -0,0 +1,58 @@
/* Store all 92 permutations in a SAS dataset. Translation of Fortran 77 */
data queens;
array a{8} p1-p8;
array s{8};
array u{30};
n=8;
do i=1 to n;
a(i)=i;
end;
do i=1 to 4*n-2;
u(i)=0;
end;
m=0;
i=1;
r=2*n-1;
goto L40;
L30:
s(i)=j;
u(p)=1;
u(q+r)=1;
i=i+1;
L40:
if i>n then goto L80;
j=i;
L50:
z=a(i);
y=a(j);
p=i-y+n;
q=i+y-1;
a(i)=y;
a(j)=z;
if u(p)=0 and u(q+r)=0 then goto L30;
L60:
j=j+1;
if j<=n then goto L50;
L70:
j=j-1;
if j=i then goto L90;
z=a(i);
a(i)=a(j);
a(j)=z;
goto L70;
L80:
m=m+1;
output;
L90:
i=i-1;
if i=0 then goto L100;
p=i-a(i)+n;
q=i+a(i)-1;
j=s(i);
u(p)=0;
u(q+r)=0;
goto L60;
L100:
put n m;
keep p1-p8;
run;

23
Task/N-queens-problem/SNOBOL4/n-queens-problem.sno Normal file
View file

@ -0,0 +1,23 @@
* N queens problem
* Set N to the desired number. The program prints out all solution boards.
N = 5
NM1 = N - 1; NP1 = N + 1; NSZ = N * NP1; &STLIMIT = 10 ** 9; &ANCHOR = 1
DEFINE('SOLVE(B)I')
* This pattern tests if the first queen attacks any of the others:
TEST = BREAK('Q') 'Q' (ARBNO(LEN(N) '-') LEN(N) 'Q'
+ | ARBNO(LEN(NP1) '-') LEN(NP1) 'Q'
+ | ARBNO(LEN(NM1) '-') LEN(NM1) 'Q')
P = LEN(NM1) . X LEN(1); L = 'Q' DUPL('-',NM1) ' '
SOLVE() :(END)
SOLVE EQ(SIZE(B),NSZ) :S(PRINT)
* Add another row with a queen:
B = L B
LOOP I = LT(I,N) I + 1 :F(RETURN)
B TEST :S(NEXT)
SOLVE(B)
* Try queen in next square:
NEXT B P = '-' X :(LOOP)
PRINT SOLUTION = SOLUTION + 1
OUTPUT = 'Solution number ' SOLUTION ' is:'
PRTLOOP B LEN(NP1) . OUTPUT = :S(PRTLOOP)F(RETURN)
END

20
Task/N-queens-problem/Scala/n-queens-problem.scala Normal file
View file

@ -0,0 +1,20 @@
case class Pos(row: Int, column: Int) {
def sameRow(p: Pos) = row == p.row
def sameColumn(p: Pos) = column == p.column
def sameDiag(p: Pos) = (p.column - column).abs == (p.row - row).abs
def illegal(p: Pos) = sameRow(p) || sameColumn(p) || sameDiag(p)
def legal(p: Pos) = !illegal(p)
}
def rowSet(size: Int, row: Int) = Iterator.tabulate(size)(column => Pos(row, column))
def expand(solutions: Iterator[List[Pos]], size: Int, row: Int) =
for {
solution <- solutions
pos <- rowSet(size, row)
if solution forall (_ legal pos)
} yield pos :: solution
def seed(size: Int) = rowSet(size, 0) map (sol => List(sol))
def solve(size: Int) = (1 until size).foldLeft(seed(size)) (expand(_, size, _))

39
Task/N-queens-problem/Standard-ML/n-queens-problem.ml Normal file
View file

@ -0,0 +1,39 @@
(*
* val threat : (int * int) -> (int * int) -> bool
* Returns true iff the queens at the given positions threaten each other
*)
fun threat (x, y) (x', y') =
x = x' orelse y = y' orelse abs(x - x') = abs(y - y');
(*
* val conflict : (int * int) -> (int * int) list -> bool
* Returns true if there exists a conflict with the position and the list of queens.
*)
fun conflict pos = List.exists (threat pos);
(*
* val addqueen : (int * int * (int * int) list * (unit -> (int * int) list option)) -> (int * int) list option
* Returns either NONE in the case that no solution exists or SOME(l) where l is a list of positions making up the solution.
*)
fun addqueen(i, n, qs, fc) =
let
fun try j =
if j > n then fc()
else if (conflict (i, j) qs) then try (j + 1)
else if i = n then SOME((i, j)::qs)
else addqueen(i + 1, n, (i,j)::qs, fn() => try (j + 1))
in
try 1
end;
(*
* val queens : int -> (int * int) list option
* Given the board dimension n, returns a solution for the n-queens problem.
*)
fun queens(n) = addqueen(1, n, [], fn () => NONE);
(* SOME [(8,4),(7,2),(6,7),(5,3),(4,6),(3,8),(2,5),(1,1)] *)
queens(8);
(* NONE *)
queens(2);

37
Task/N-queens-problem/SystemVerilog/n-queens-problem.v Normal file
View file

@ -0,0 +1,37 @@
program N_queens;
parameter SIZE_LOG2 = 3;
parameter SIZE = 1 << SIZE_LOG2;
`define ABS_DIFF(a,b) (a>b?a-b:b-a)
class board;
rand bit [SIZE_LOG2-1:0] row[SIZE];
constraint rook_moves {
foreach (row[i]) foreach (row[j]) if (i < j) {
row[i] != row[j];
}
}
constraint diagonal_moves {
foreach (row[i]) foreach (row[j]) if (i < j) {
`ABS_DIFF(row[i], row[j]) != `ABS_DIFF(i,j);
}
}
function void next;
randomize;
foreach (row[i]) begin
automatic bit [SIZE-1:0] x = 1 << row[i];
$display( " %b", x );
end
$display("--");
endfunction
endclass
board b = new;
initial repeat(1) b.next;
endprogram

47
Task/N-queens-problem/Tcl/n-queens-problem.tcl Normal file
View file

@ -0,0 +1,47 @@
package require Tcl 8.5
proc unsafe {y} {
global b
set x [lindex $b $y]
for {set i 1} {$i <= $y} {incr i} {
set t [lindex $b [expr {$y - $i}]]
if {$t==$x || $t==$x-$i || $t==$x+$i} {
return 1
}
}
return 0
}
proc putboard {} {
global b s N
puts "\n\nSolution #[incr s]"
for {set y 0} {$y < $N} {incr y} {
for {set x 0} {$x < $N} {incr x} {
puts -nonewline [expr {[lindex $b $y] == $x ? "|Q" : "|_"}]
}
puts "|"
}
}
proc main {n} {
global b N
set N $n
set b [lrepeat $N 0]
set y 0
lset b 0 -1
while {$y >= 0} {
lset b $y [expr {[lindex $b $y] + 1}]
while {[lindex $b $y] < $N && [unsafe $y]} {
lset b $y [expr {[lindex $b $y] + 1}]
}
if {[lindex $b $y] >= $N} {
incr y -1
} elseif {$y < $N-1} {
lset b [incr y] -1;
} else {
putboard
}
}
}
main [expr {$argc ? int(0+[lindex $argv 0]) : 8}]

18
Task/N-queens-problem/Ursala/n-queens-problem.ursala Normal file
View file

@ -0,0 +1,18 @@
#import std
#import nat
remove_reflections = ^D(length@ht,~&); ~&K2hlPS+ * ^lrNCCs/~&r difference*D
remove_rotations = ~&K2hlrS2S+ * num; ~&srlXSsPNCCs
#executable <'par',''>
#optimize+
queens =
%np+~command.options.&h.keyword.&iNC; -+
~&iNC+ file$[contents: --<''>+ mat` *+ %nP*=*],
remove_rotations+ remove_reflections+ ~&rSSs+ nleq-<&l*rFlhthPXPSPS,
~&i&& ~&lNrNCXX; ~&rr->rl ^/~&l ~&lrrhrSiF4E?/~&rrlPlCrtPX @r ^|/~& ^|T\~& -+
-<&l^|*DlrTS/~& ~&iiDlSzyCK9hlPNNXXtCS,
^jrX/~& @rZK20lrpblPOlrEkPK13lhPK2 ~&i&& nleq$-&lh+-,
^/~&NNXS+iota -<&l+ ~&plll2llr2lrPrNCCCCNXS*=irSxPSp+ ^H/block iota; *iiK0 ^/~& sum+-

57
Task/N-queens-problem/XPL0/n-queens-problem.xpl0 Normal file
View file

@ -0,0 +1,57 @@
def N=8; \board size (NxN)
int R, C; \row and column of board
char B(N,N); \board
include c:\cxpl\codes;
proc Try; \Try adding a queen to the board
int R; \row, for each level of recursion
func Okay;
\Returns 'true' if no row, column, or diagonal from square R,C has a queen
int I;
[for I:= 0 to N-1 do
[if B(I,C) then return false; \row is occupied
if B(R,I) then return false; \column is occupied
if R+I<N & C+I<N then
if B(R+I, C+I) then return false; \diagonal down right
if R-I>=0 & C-I>=0 then
if B(R-I, C-I) then return false; \diagonal up left
if R-I>=0 & C+I<N then
if B(R-I, C+I) then return false; \diagonal up right
if R+I<N & C-I>=0 then
if B(R+I, C-I) then return false; \diagonal down left
];
return true;
]; \Okay
[ \Try
if C>=N then
[for R:= 0 to N-1 do \display solution
[ChOut(0, ^ ); \(avoids scrolling up a color)
for C:= 0 to N-1 do
[Attrib(if (R|C)&1 then $0F else $4F); \checkerboard pattern
ChOut(6, if B(R,C) then $F2 else ^ ); \cute queen symbol
ChOut(6, if B(R,C) then $F3 else ^ );
];
CrLf(0);
];
exit; \one solution is enough
];
for R:= 0 to N-1 do
[if Okay(R,C) then \a queen can be placed here
[B(R,C):= true; \ so do it
C:= C+1; \move to next column
Try; \ and try from there
C:= C-1; \didn't work: backup
B(R,C):= false; \undo queen placement
];
];
]; \Try
[for R:= 0 to N-1 do \clear the board
for C:= 0 to N-1 do
B(R,C):= false;
C:= 0; \start at left column
Try;
]

5
Task/N-queens-problem/XSLT/n-queens-problem-1.xslt Normal file
View file

@ -0,0 +1,5 @@
15863724
16837425
... 88 lines omitted ...
83162574
84136275

126
Task/N-queens-problem/XSLT/n-queens-problem-2.xslt Normal file
View file

@ -0,0 +1,126 @@
<!-- 8-queens.xsl disguised as XML file for the browsers -->
<!-- Valery Chernysh's .xsl.xml technique for execution in all browsers -->
<?xml-stylesheet href="#" type="text/xsl"?>
<!-- alternative over specifying input in data:data section -->
<!DOCTYPE xsl:stylesheet [
<!ENTITY N "8">
]>
<!-- this is the stylesheet being referenced by href="#" above -->
<xsl:stylesheet version="1.0"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:exslt="http://exslt.org/common"
xmlns:n-queens="urn:n-queens"
exclude-result-prefixes="n-queens exslt"
>
<!-- find David Carlisle's exslt:node-set() for IE browsers at bottom -->
<!--
Pattern allowing repeated processing of produced node-set results:
<xsl:variable name="blah0">...</xsl:variable>
<xsl:variable name="blah" select="exslt:node-set($blah0)"/>
-->
<xsl:output omit-xml-declaration="yes"/>
<!-- entry point -->
<xsl:template match="/xsl:stylesheet">
<!-- generate &N;x$&N;board -->
<xsl:variable name="row0">
<xsl:call-template name="n-queens:row">
<xsl:with-param name="n" select="&N;"/>
</xsl:call-template>
</xsl:variable>
<xsl:variable name="row" select="exslt:node-set($row0)"/>
<xsl:variable name="rows0">
<xsl:for-each select="$row/*">
<r><xsl:copy-of select="$row"/></r>
</xsl:for-each>
</xsl:variable>
<xsl:variable name="rows" select="exslt:node-set($rows0)"/>
<html><pre>
<!-- determine all solutions of $N queens problem -->
<xsl:call-template name="n-queens:search">
<xsl:with-param name="b" select="$rows/*"/>
</xsl:call-template>
</pre></html>
</xsl:template>
<!-- recursive search for all solutions -->
<xsl:template name="n-queens:search">
<xsl:param name="b"/> <!-- remaining rows of not threatened fields -->
<xsl:param name="s"/> <!-- partial solution of queens fixated sofar -->
<!-- complete board filled means solution found -->
<xsl:if test="not($b)">
<xsl:value-of select="$s"/><xsl:text>&#10;</xsl:text>
</xsl:if>
<!-- check each remaining possible position in next row -->
<xsl:for-each select="$b[1]/*">
<!-- sieve out fields by new current (.) queen in current row -->
<xsl:variable name="sieved0">
<xsl:call-template name="n-queens:sieve">
<xsl:with-param name="c" select="."/>
<xsl:with-param name="b" select="$b[position()>1]"/>
</xsl:call-template>
</xsl:variable>
<xsl:variable name="sieved" select="exslt:node-set($sieved0)"/>
<!-- recursive call -->
<xsl:call-template name="n-queens:search">
<xsl:with-param name="b" select="$sieved/*"/>
<xsl:with-param name="s" select="concat($s, .)"/>
</xsl:call-template>
</xsl:for-each>
</xsl:template>
<!-- sieve out fields in remaining rows attacked by queen at column $c -->
<xsl:template name="n-queens:sieve">
<xsl:param name="c"/> <!-- column of newly fixed queen -->
<xsl:param name="b"/> <!-- remaining rows -->
<xsl:for-each select="$b">
<!-- row number for diagonal attack determination -->
<xsl:variable name="r" select="position()"/>
<!-- copy fields not vertically or diagonally attacked -->
<r><xsl:copy-of select="*[. != $c][. - $r != $c][. + $r != $c]"/></r>
</xsl:for-each>
</xsl:template>
<!-- generate node-set of the form "<f>1</f><f>2</f>...<f>$n</f>" -->
<xsl:template name="n-queens:row">
<xsl:param name="n"/>
<xsl:if test="$n>0">
<xsl:call-template name="n-queens:row">
<xsl:with-param name="n" select="$n - 1"/>
</xsl:call-template>
<f><xsl:value-of select="$n"/></f>
</xsl:if>
</xsl:template>
<!--
IE browser exslt:node-set() (XSLT 1.0+), w/o msxsl pollution above
from http://dpcarlisle.blogspot.com/2007/05/exslt-node-set-function.html
-->
<msxsl:script xmlns:msxsl="urn:schemas-microsoft-com:xslt"
language="JScript" implements-prefix="exslt"
>
this['node-set'] = function (x) {
return x;
}
</msxsl:script>
</xsl:stylesheet>

69
Task/N-queens-problem/Xanadu/n-queens-problem.xanadu Normal file
View file

@ -0,0 +1,69 @@
int abs(i: int) {
if (i >= 0) return i; else return -i;
}
unit print_dots(n: int) {
while (n > 0) { print_string("."); n = n - 1; }
return;
}
{size:int | 0 < size}
unit print_board (board[size]: int, size: int(size)) {
var: int n, row;;
invariant: [i:nat] (row: int(i))
for (row = 0; row < size; row = row + 1) {
n = board[row];
print_dots(n-1);
print_string("Q");
print_dots(size - n);
print_newline();
}
print_newline();
return;
}
{size:int, j:int | 0 <= j < size}
bool test (j: int(j), board[size]: int) {
var: int diff, i, qi, qj;;
qj = board[j];
invariant: [i:nat] (i: int(i))
for (i = 0; i < j; i = i + 1) {
qi = board[i]; diff = abs (qi - qj);
if (diff == 0) { return false; }
else { if (diff == j - i) return false; }
}
return true;
}
{size:int | 0 < size}
nat queen(size: int(size)) {
var: int board[], next, row; nat count;;
count = 0; row = 0; board = alloc(size, 0);
invariant: [n:nat | n < size] (row: int(n))
while (true) {
next = board[row]; next = next + 1;
if (next > size) {
if (row == 0) break; else { board[row] = 0; row = row - 1; }
} else {
board[row] = next;
if (test(row, board)) {
row = row + 1;
if (row == size) {
count = count + 1;
print_board(board, size);
row = row - 1;
}
}
}
}
return count;
}
int main () {
return queen (8);
}