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

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/N-queens-problem/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/N-queens_problem

19
Task/N-queens-problem/00-TASK.txt Normal file
View file

@ -0,0 +1,19 @@
Solve the [[WP:Eight_queens_puzzle|eight queens puzzle]].
You can extend the problem to solve the puzzle with a board of size &nbsp; <big>'''N'''x'''N'''</big>.
For the number of solutions for small values of &nbsp; '''N''', &nbsp; see &nbsp; [[oeis:A000170|OEIS: A000170]].
;Related tasks:
* [[A* search algorithm]]
* [[Solve a Hidato puzzle]]
* [[Solve a Holy Knight's tour]]
* [[Knight's tour]]
* [[Peaceful chess queen armies]]
* [[Solve a Hopido puzzle]]
* [[Solve a Numbrix puzzle]]
* [[Solve the no connection puzzle]]
<br><br>

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

@ -0,0 +1,32 @@
-V BoardSize = 8
F underAttack(col, queens)
I col C queens
R 1B
L(x) queens
I abs(col - x) == queens.len - L.index
R 1B
R 0B
F solve(n)
V result = [[Int]()]
[[Int]] newSolutions
L(row) 1 .. n
L(solution) result
L(i) 1 .. BoardSize
I !underAttack(i, solution)
newSolutions.append(solution [+] [i])
swap(&result, &newSolutions)
newSolutions.clear()
R result
print(‘Solutions for a chessboard of size ’String(BoardSize)‘x’String(BoardSize))
print()
L(answer) solve(BoardSize)
L(col) answer
V row = L.index
I row > 0
print(‘ ’, end' ‘’)
print(Char(code' ‘a’.code + row)‘’col, end' ‘’)
print(end' I L.index % 4 == 3 {"\n"} E ‘ ’)

142
Task/N-queens-problem/360-Assembly/n-queens-problem.360 Normal file
View file

@ -0,0 +1,142 @@
* N-QUEENS PROBLEM 04/09/2015
MACRO
&LAB XDECO &REG,&TARGET
&LAB B I&SYSNDX branch around work area
P&SYSNDX DS 0D,PL8 packed
W&SYSNDX DS CL13 char
I&SYSNDX CVD &REG,P&SYSNDX convert to decimal
MVC W&SYSNDX,=X'40202020202020202020212060' nice mask
EDMK W&SYSNDX,P&SYSNDX+2 edit and mark
BCTR R1,0 locate the right place
MVC 0(1,R1),W&SYSNDX+12 move the sign
MVC &TARGET.(12),W&SYSNDX move to target
MEND
NQUEENS CSECT
SAVE (14,12) save registers on entry
BALR R12,0 establish addressability
USING *,R12 set base register
ST R13,SAVEA+4 link mySA->prevSA
LA R11,SAVEA mySA
ST R11,8(R13) link prevSA->mySA
LR R13,R11 set mySA pointer
LA R7,LL l
LA R6,1 i=1
LOOPI LR R1,R6 do i=1 to l
SLA R1,1 i*2
STH R6,A-2(R1) a(i)=i
LA R6,1(R6) i=i+1
BCT R7,LOOPI loop do i
OPENEM OPEN (OUTDCB,OUTPUT) open the printer file
LA R9,1 n=1 start of loop
LOOPN CH R9,L do n=1 to l
BH ELOOPN if n>l then exit loop
SR R8,R8 m=0
LA R10,1 i=1
LR R5,R9 n
SLA R5,1 n*2
BCTR R5,0 r=2*n-1
E40 CR R10,R9 if i>n
BH E80 then goto e80
LR R11,R10 j=i
E50 LR R1,R10 i
SLA R1,1 i*2
LA R6,A-2(R1) r6=@a(i)
LR R1,R11 j
SLA R1,1 j*2
LA R7,A-2(R1) r7=@a(j)
MVC Z,0(R6) z=a(i)
MVC Y,0(R7) y=a(j)
LR R3,R10 i
SH R3,Y -y
AR R3,R9 p=i-y+n
LR R4,R10 i
AH R4,Y +y
BCTR R4,0 q=i+y-1
MVC 0(2,R6),Y a(i)=y
MVC 0(2,R7),Z a(j)=z
LR R1,R3 p
SLA R1,1 p*2
LH R2,U-2(R1) u(p)
LTR R2,R2 if u(p)<>0
BNE E60 then goto e60
LR R1,R4 q
AR R1,R5 q+r
SLA R1,1 (q+r)*2
LH R2,U-2(R1) u(q+r)
C R2,=F'0' if u(q+r)<>0
BNE E60 then goto e60
LR R1,R10 i
SLA R1,1 i*2
STH R11,S-2(R1) s(i)=j
LA R0,1 r0=1
LR R1,R3 p
SLA R1,1 p*2
STH R0,U-2(R1) u(p)=1
LR R1,R4 q
AR R1,R5 q+r
SLA R1,1 (q+r)*2
STH R0,U-2(R1) u(q+r)=1
LA R10,1(R10) i=i+1
B E40 goto e40
E60 LA R11,1(R11) j=j+1
CR R11,R9 if j<=n
BNH E50 then goto e50
E70 BCTR R11,0 j=j-1
CR R11,R10 if j=i
BE E90 goto e90
LR R1,R10 i
SLA R1,1 i*2
LA R6,A-2(R1) r6=@a(i)
LR R1,R11 j
SLA R1,1 j*2
LA R7,A-2(R1) r7=@a(j)
MVC Z,0(R6) z=a(i)
MVC 0(2,R6),0(R7) a(i)=a(j)
MVC 0(2,R7),Z a(j)=z;
B E70 goto e70
E80 LA R8,1(R8) m=m+1
E90 BCTR R10,0 i=i-1
LTR R10,R10 if i=0
BZ ZERO then goto zero
LR R1,R10 i
SLA R1,1 i*2
LH R2,A-2(R1) r2=a(i)
LR R3,R10 i
SR R3,R2 -a(i)
AR R3,R9 p=i-a(i)+n
LR R4,R10 i
AR R4,R2 +a(i)
BCTR R4,0 q=i+a(i)-1
LR R1,R10 i
SLA R1,1 i*2
LH R11,S-2(R1) j=s(i)
LA R0,0 r0=0
LR R1,R3 p
SLA R1,1 p*2
STH R0,U-2(R1) u(p)=0
LR R1,R4 q
AR R1,R5 q+r
SLA R1,1 (q+r)*2
STH R0,U-2(R1) u(q+r)=0
B E60 goto e60
ZERO XDECO R9,PG+0 edit N
XDECO R8,PG+12 edit M
PUT OUTDCB,PG print buffer
LA R9,1(R9) n=n+1
B LOOPN loop do n
ELOOPN CLOSE (OUTDCB) close output
L R13,SAVEA+4 previous save area addrs
RETURN (14,12),RC=0 return to caller with rc=0
LTORG
SAVEA DS 18F save area for chaining
OUTDCB DCB DSORG=PS,MACRF=PM,DDNAME=OUTDD use OUTDD in jcl
LL EQU 14 ll<=16
L DC AL2(LL) input value
A DS (LL)H
S DS (LL)H
Z DS H
Y DS H
PG DS CL24 buffer
U DC (4*LL-2)H'0' stack
REGS make sure to include copybook jcl
END NQUEENS

285
Task/N-queens-problem/ABAP/n-queens-problem.abap Normal file
View file

@ -0,0 +1,285 @@
TYPES: BEGIN OF gty_matrix,
1 TYPE c,
2 TYPE c,
3 TYPE c,
4 TYPE c,
5 TYPE c,
6 TYPE c,
7 TYPE c,
8 TYPE c,
9 TYPE c,
10 TYPE c,
END OF gty_matrix,
gty_t_matrix TYPE STANDARD TABLE OF gty_matrix INITIAL SIZE 8.
DATA: gt_matrix TYPE gty_t_matrix,
gs_matrix TYPE gty_matrix,
gv_count TYPE i VALUE 0,
gv_solut TYPE i VALUE 0.
SELECTION-SCREEN BEGIN OF BLOCK b01 WITH FRAME TITLE text-b01.
PARAMETERS: p_number TYPE i OBLIGATORY DEFAULT 8.
SELECTION-SCREEN END OF BLOCK b01.
" Filling empty table
START-OF-SELECTION.
DO p_number TIMES.
APPEND gs_matrix TO gt_matrix.
ENDDO.
" Recursive Function
PERFORM fill_matrix USING gv_count 1 1 CHANGING gt_matrix.
BREAK-POINT.
*&---------------------------------------------------------------------*
*& Form FILL_MATRIX
*----------------------------------------------------------------------*
FORM fill_matrix USING p_count TYPE i
p_i TYPE i
p_j TYPE i
CHANGING p_matrix TYPE gty_t_matrix.
DATA: lv_i TYPE i,
lv_j TYPE i,
lv_result TYPE c LENGTH 1,
lt_matrix TYPE gty_t_matrix,
lv_count TYPE i,
lv_value TYPE c.
lt_matrix[] = p_matrix[].
lv_count = p_count.
lv_i = p_i.
lv_j = p_j.
WHILE lv_i LE p_number.
WHILE lv_j LE p_number.
CLEAR lv_result.
PERFORM check_position USING lv_i lv_j CHANGING lv_result lt_matrix.
IF lv_result NE 'X'.
MOVE 'X' TO lv_value.
PERFORM get_position USING lv_i lv_j 'U' CHANGING lv_value lt_matrix.
ADD 1 TO lv_count.
IF lv_count EQ p_number.
PERFORM show_matrix USING lt_matrix.
ELSE.
PERFORM fill_matrix USING lv_count lv_i lv_j CHANGING lt_matrix.
ENDIF.
lv_value = space.
PERFORM get_position USING lv_i lv_j 'U' CHANGING lv_value lt_matrix.
SUBTRACT 1 FROM lv_count.
ENDIF.
ADD 1 TO lv_j.
ENDWHILE.
ADD 1 TO lv_i.
lv_j = 1.
ENDWHILE.
ENDFORM. " FILL_MATRIX
*&---------------------------------------------------------------------*
*& Form CHECK_POSITION
*&---------------------------------------------------------------------*
FORM check_position USING value(p_i) TYPE i
value(p_j) TYPE i
CHANGING p_result TYPE c
p_matrix TYPE gty_t_matrix.
PERFORM get_position USING p_i p_j 'R' CHANGING p_result p_matrix.
CHECK p_result NE 'X'.
PERFORM check_horizontal USING p_i p_j CHANGING p_result p_matrix.
CHECK p_result NE 'X'.
PERFORM check_vertical USING p_i p_j CHANGING p_result p_matrix.
CHECK p_result NE 'X'.
PERFORM check_diagonals USING p_i p_j CHANGING p_result p_matrix.
ENDFORM. " CHECK_POSITION
*&---------------------------------------------------------------------*
*& Form GET_POSITION
*&---------------------------------------------------------------------*
FORM get_position USING value(p_i) TYPE i
value(p_j) TYPE i
value(p_action) TYPE c
CHANGING p_result TYPE c
p_matrix TYPE gty_t_matrix.
FIELD-SYMBOLS: <fs_lmatrix> TYPE gty_matrix,
<fs_lfield> TYPE any.
READ TABLE p_matrix ASSIGNING <fs_lmatrix> INDEX p_i.
ASSIGN COMPONENT p_j OF STRUCTURE <fs_lmatrix> TO <fs_lfield>.
CASE p_action.
WHEN 'U'.
<fs_lfield> = p_result.
WHEN 'R'.
p_result = <fs_lfield>.
WHEN OTHERS.
ENDCASE.
ENDFORM. " GET_POSITION
*&---------------------------------------------------------------------*
*& Form CHECK_HORIZONTAL
*&---------------------------------------------------------------------*
FORM check_horizontal USING value(p_i) TYPE i
value(p_j) TYPE i
CHANGING p_result TYPE c
p_matrix TYPE gty_t_matrix.
DATA: lv_j TYPE i,
ls_matrix TYPE gty_matrix.
FIELD-SYMBOLS <fs> TYPE c.
lv_j = 1.
READ TABLE p_matrix INTO ls_matrix INDEX p_i.
WHILE lv_j LE p_number.
ASSIGN COMPONENT lv_j OF STRUCTURE ls_matrix TO <fs>.
IF <fs> EQ 'X'.
p_result = 'X'.
RETURN.
ENDIF.
ADD 1 TO lv_j.
ENDWHILE.
ENDFORM. " CHECK_HORIZONTAL
*&---------------------------------------------------------------------*
*& Form CHECK_VERTICAL
*&---------------------------------------------------------------------*
FORM check_vertical USING value(p_i) TYPE i
value(p_j) TYPE i
CHANGING p_result TYPE c
p_matrix TYPE gty_t_matrix.
DATA: lv_i TYPE i,
ls_matrix TYPE gty_matrix.
FIELD-SYMBOLS <fs> TYPE c.
lv_i = 1.
WHILE lv_i LE p_number.
READ TABLE p_matrix INTO ls_matrix INDEX lv_i.
ASSIGN COMPONENT p_j OF STRUCTURE ls_matrix TO <fs>.
IF <fs> EQ 'X'.
p_result = 'X'.
RETURN.
ENDIF.
ADD 1 TO lv_i.
ENDWHILE.
ENDFORM. " CHECK_VERTICAL
*&---------------------------------------------------------------------*
*& Form CHECK_DIAGONALS
*&---------------------------------------------------------------------*
FORM check_diagonals USING value(p_i) TYPE i
value(p_j) TYPE i
CHANGING p_result TYPE c
p_matrix TYPE gty_t_matrix.
DATA: lv_dx TYPE i,
lv_dy TYPE i.
* I++ J++ (Up Right)
lv_dx = 1.
lv_dy = 1.
PERFORM check_diagonal USING p_i p_j lv_dx lv_dy CHANGING p_result p_matrix.
CHECK p_result NE 'X'.
* I-- J-- (Left Down)
lv_dx = -1.
lv_dy = -1.
PERFORM check_diagonal USING p_i p_j lv_dx lv_dy CHANGING p_result p_matrix.
CHECK p_result NE 'X'.
* I++ J-- (Right Down)
lv_dx = 1.
lv_dy = -1.
PERFORM check_diagonal USING p_i p_j lv_dx lv_dy CHANGING p_result p_matrix.
CHECK p_result NE 'X'.
* I-- J++ (Left Up)
lv_dx = -1.
lv_dy = 1.
PERFORM check_diagonal USING p_i p_j lv_dx lv_dy CHANGING p_result p_matrix.
CHECK p_result NE 'X'.
ENDFORM. " CHECK_DIAGONALS
*&---------------------------------------------------------------------*
*& Form CHECK_DIAGONAL
*&---------------------------------------------------------------------*
FORM check_diagonal USING value(p_i) TYPE i
value(p_j) TYPE i
value(p_dx) TYPE i
value(p_dy) TYPE i
CHANGING p_result TYPE c
p_matrix TYPE gty_t_matrix.
DATA: lv_i TYPE i,
lv_j TYPE i,
ls_matrix TYPE gty_matrix.
FIELD-SYMBOLS <fs> TYPE c.
lv_i = p_i.
lv_j = p_j.
WHILE 1 EQ 1.
ADD: p_dx TO lv_i, p_dy TO lv_j.
IF p_dx EQ 1.
IF lv_i GT p_number. EXIT. ENDIF.
ELSE.
IF lv_i LT 1. EXIT. ENDIF.
ENDIF.
IF p_dy EQ 1.
IF lv_j GT p_number. EXIT. ENDIF.
ELSE.
IF lv_j LT 1. EXIT. ENDIF.
ENDIF.
READ TABLE p_matrix INTO ls_matrix INDEX lv_i.
ASSIGN COMPONENT lv_j OF STRUCTURE ls_matrix TO <fs>.
IF <fs> EQ 'X'.
p_result = 'X'.
RETURN.
ENDIF.
ENDWHILE.
ENDFORM. " CHECK_DIAGONAL
*&---------------------------------------------------------------------*
*& Form SHOW_MATRIX
*----------------------------------------------------------------------*
FORM show_matrix USING p_matrix TYPE gty_t_matrix.
DATA: lt_matrix TYPE gty_t_matrix,
lv_j TYPE i VALUE 1,
lv_colum TYPE string VALUE '-'.
FIELD-SYMBOLS: <fs_matrix> TYPE gty_matrix,
<fs_field> TYPE c.
ADD 1 TO gv_solut.
WRITE:/ 'Solution: ', gv_solut.
DO p_number TIMES.
CONCATENATE lv_colum '----' INTO lv_colum.
ENDDO.
LOOP AT p_matrix ASSIGNING <fs_matrix>.
IF sy-tabix EQ 1.
WRITE:/ lv_colum.
ENDIF.
WRITE:/ '|'.
DO p_number TIMES.
ASSIGN COMPONENT lv_j OF STRUCTURE <fs_matrix> TO <fs_field>.
IF <fs_field> EQ space.
WRITE: <fs_field> ,'|'.
ELSE.
WRITE: <fs_field> COLOR 2 HOTSPOT ON,'|'.
ENDIF.
ADD 1 TO lv_j.
ENDDO.
lv_j = 1.
WRITE: / lv_colum.
ENDLOOP.
SKIP 1.
ENDFORM. " SHOW_MATRIX

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
)

11
Task/N-queens-problem/APL/n-queens-problem.apl Normal file
View file

@ -0,0 +1,11 @@
⍝Solution
accm←{⍺,((⍴⍵)=⍴⊃⍺)↑⊂⍵}
atk←{∪∊(⊂⍵)+¯1 0 1×⊂⌽⍳⍴⍵}
dfs←{⊃∇⍨/⌽(⊂⍺ ⍺⍺ ⍵),⍺ ⍵⍵ ⍵}
qfmt←{⍵∘.=⍳⍴⍵}
subs←{(⊂⍵),¨(⍳⍴⊃⍺)~atk ⍵}
queens←{qfmt¨(↓0 ⍵⍴0)accm dfs subs ⍬}
printqueens←{i←1⋄{⎕←'answer'i⋄⎕←⍵⋄i+←1}¨queens ⍵}
⍝Example
printqueens 6

80
Task/N-queens-problem/ATS/n-queens-problem.ats Normal file
View file

@ -0,0 +1,80 @@
(* ****** ****** *)
//
// Solving N-queen puzzle
//
(* ****** ****** *)
//
// How to test:
// ./queens
// How to compile:
// patscc -DATS_MEMALLOC_LIBC -o queens queens.dats
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
#include
"share/HATS/atspre_staload_libats_ML.hats"
//
(* ****** ****** *)
fun
solutions(N:int) = let
//
fun
show
(
board: list0(int)
) : void =
(
list0_foreach<int>
( list0_reverse(board)
, lam(n) => ((N).foreach()(lam(i) => print_string(if i = n then " Q" else " _")); print_newline())
) ;
print_newline()
)
//
fun
safe
(
i: int, j: int, k: int, xs: list0(int)
) : bool =
(
case+ xs of
| nil0() => true
| cons0(x, xs) => x != i && x != j && x != k && safe(i, j+1, k-1, xs)
)
//
fun
loop
(
col: int, xs: list0(int)
) : void =
(N).foreach()
(
lam(i) =>
if
safe(i, i+1, i-1, xs)
then let
val xs = cons0(i, xs)
in
if col = N then show(xs) else loop(col+1, xs)
end // end of [then]
)
//
in
loop(1, nil0())
end // end of [solutions]
(* ****** ****** *)
val () = solutions(8)
(* ****** ****** *)
implement main0() = ()
(* ****** ****** *)
(* end of [queens.dats] *)

71
Task/N-queens-problem/AWK/n-queens-problem.awk Normal file
View file

@ -0,0 +1,71 @@
#!/usr/bin/gawk -f
# Solve the Eight Queens Puzzle
# Inspired by Raymond Hettinger [https://code.activestate.com/recipes/576647/]
# Just the vector of row positions per column is kept,
# and filled with all possibilities from left to right recursively,
# then checked against the columns left from the current one:
# - is a queen in the same row
# - is a queen in the digonal
# - is a queen in the reverse diagonal
BEGIN {
dim = ARGC < 2 ? 8 : ARGV[1]
# make vec an array
vec[1] = 0
# scan for a solution
if (tryqueen(1, vec, dim))
result(vec, dim)
else
print "No solution with " dim " queens."
}
# try if a queen can be set in column (col)
function tryqueen(col, vec, dim, new) {
for (new = 1; new <= dim; ++new) {
# check all previous columns
if (noconflict(new, col, vec, dim)) {
vec[col] = new
if (col == dim)
return 1
# must try next column(s)
if (tryqueen(col+1, vec, dim))
return 1
}
}
# all tested, failed
return 0
}
# check if setting the queen (new) in column (col) is ok
# by checking the previous colums conflicts
function noconflict(new, col, vec, dim, j) {
for (j = 1; j < col; j++) {
if (vec[j] == new)
return 0 # same row
if (vec[j] == new - col + j)
return 0 # diagonal conflict
if (vec[j] == new + col - j)
return 0 # reverse diagonal conflict
}
# no test failed, no conflict
return 1
}
# print matrix
function result(vec, dim, row, col, sep, lne) {
# print the solution vector
for (row = 1; row <= dim; ++row)
printf " %d", vec[row]
print
# print a board matrix
for (row = 1; row <= dim; ++row) {
lne = "|"
for (col = 1; col <= dim; ++col) {
if (row == vec[col])
lne = lne "Q|"
else
lne = lne "_|"
}
print lne
}
}

50
Task/N-queens-problem/Ada/n-queens-problem-1.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;

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

@ -0,0 +1,49 @@
with Ada.Text_IO;
use Ada.Text_IO;
procedure CountQueens is
function Queens (N : Integer) return Long_Integer is
A : array (0 .. N) of Integer;
U : array (0 .. 2 * N - 1) of Boolean := (others => true);
V : array (0 .. 2 * N - 1) of Boolean := (others => true);
M : Long_Integer := 0;
procedure Sub (I: Integer) is
K, P, Q: Integer;
begin
if N = I then
M := M + 1;
else
for J in I .. N - 1 loop
P := I + A (J);
Q := I + N - 1 - A (J);
if U (P) and then V (Q) then
U (P) := false;
V (Q) := false;
K := A (I);
A (I) := A (J);
A (J) := K;
Sub (I + 1);
U (P) := true;
V (Q) := true;
K := A (I);
A (I) := A (J);
A (J) := K;
end if;
end loop;
end if;
end Sub;
begin
for I in 0 .. N - 1 loop
A (I) := I;
end loop;
Sub (0);
return M;
end Queens;
begin
for N in 1 .. 16 loop
Put (Integer'Image (N));
Put (" ");
Put_Line (Long_Integer'Image (Queens (N)));
end loop;
end CountQueens;

164
Task/N-queens-problem/AppleScript/n-queens-problem.applescript Normal file
View file

@ -0,0 +1,164 @@
-- Finds all possible solutions and the unique patterns.
property Grid_Size : 8
property Patterns : {}
property Solutions : {}
property Test_Count : 0
property Rotated : {}
on run
local diff
local endTime
local msg
local rows
local startTime
set Patterns to {}
set Solutions to {}
set Rotated to {}
set Test_Count to 0
set rows to Make_Empty_List(Grid_Size)
set startTime to current date
Solve(1, rows)
set endTime to current date
set diff to endTime - startTime
set msg to ("Found " & (count Solutions) & " solutions with " & (count Patterns) & " patterns in " & diff & " seconds.") as text
display alert msg
return Solutions
end run
on Solve(row as integer, rows as list)
if row is greater than (count rows) then
Append_Solution(rows)
return
end if
repeat with column from 1 to Grid_Size
set Test_Count to Test_Count + 1
if Place_Queen(column, row, rows) then
Solve(row + 1, rows)
end if
end repeat
end Solve
on abs(n)
if n < 0 then
-n
else
n
end if
end abs
on Place_Queen(column as integer, row as integer, rows as list)
local colDiff
local previousRow
local rowDiff
local testColumn
repeat with previousRow from 1 to (row - 1)
set testColumn to item previousRow of rows
if testColumn is equal to column then
return false
end if
set colDiff to abs(testColumn - column) as integer
set rowDiff to row - previousRow
if colDiff is equal to rowDiff then
return false
end if
end repeat
set item row of rows to column
return true
end Place_Queen
on Append_Solution(rows as list)
local column
local rowsCopy
local testReflection
local testReflectionText
local testRotation
local testRotationText
local testRotations
copy rows to rowsCopy
set end of Solutions to rowsCopy
local rowsCopy
copy rows to testRotation
set testRotations to {}
repeat 3 times
set testRotation to Rotate(testRotation)
set testRotationText to testRotation as text
if Rotated contains testRotationText then
return
end if
set end of testRotations to testRotationText
set testReflection to Reflect(testRotation)
set testReflectionText to testReflection as text
if Rotated contains testReflectionText then
return
end if
set end of testRotations to testReflectionText
end repeat
repeat with testRotationText in testRotations
set end of Rotated to (contents of testRotationText)
end repeat
set end of Rotated to (rowsCopy as text)
set end of Rotated to (Reflect(rowsCopy) as text)
set end of Patterns to rowsCopy
end Append_Solution
on Make_Empty_List(depth as integer)
local i
local emptyList
set emptyList to {}
repeat with i from 1 to depth
set end of emptyList to missing value
end repeat
return emptyList
end Make_Empty_List
on Rotate(rows as list)
local column
local newColumn
local newRow
local newRows
local row
local rowCount
set rowCount to (count rows)
set newRows to Make_Empty_List(rowCount)
repeat with row from 1 to rowCount
set column to (contents of item row of rows)
set newRow to column
set newColumn to rowCount - row + 1
set item newRow of newRows to newColumn
end repeat
return newRows
end Rotate
on Reflect(rows as list)
local column
local newRows
set newRows to {}
repeat with column in rows
set end of newRows to (count rows) - column + 1
end repeat
return newRows
end Reflect

20
Task/N-queens-problem/Arc/n-queens-problem.arc Normal file
View file

@ -0,0 +1,20 @@
(def nqueens (n (o queens))
(if (< len.queens n)
(let row (if queens (+ 1 queens.0.0) 0)
(each col (range 0 (- n 1))
(let new-queens (cons (list row col) queens)
(if (no conflicts.new-queens)
(nqueens n new-queens)))))
(prn queens)))
; check if the first queen in 'queens' lies on the same column or diagonal as
; any of the others
(def conflicts (queens)
(let (curr . rest) queens
(or (let curr-column curr.1
(some curr-column (map [_ 1] rest))) ; columns
(some [diagonal-match curr _] rest))))
(def diagonal-match (curr other)
(is (abs (- curr.0 other.0))
(abs (- curr.1 other.1))))

32
Task/N-queens-problem/Arturo/n-queens-problem.arturo Normal file
View file

@ -0,0 +1,32 @@
result: new []
queens: function [n, i, a, b, c][
if? i < n [
loop 1..n 'j [
if all? @[
not? contains? a j
not? contains? b i+j
not? contains? c i-j
] ->
queens n, i+1, a ++ @[j], b ++ @[i+j], c ++ @[i-j]
]
]
else [
if n = size a ->
'result ++ @[a]
]
]
BoardSize: 6
queens BoardSize, 0, [], [], []
loop result 'solution [
loop solution 'col [
line: new repeat "-" BoardSize
line\[col-1]: `Q`
print line
]
print ""
]

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.basic 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)
}

4
Task/N-queens-problem/Befunge/n-queens-problem.bf Normal file
View file

@ -0,0 +1,4 @@
<+--XX@_v#!:-1,+55,g\1$_:00g2%-0vv:,+55<&,,,,,,"Size: "
"| Q"$$$>:01p:2%!00g0>>^<<!:-1\<1>00p::2%-:40p2/50p2*1+
!77**48*+31p\:1\g,::2\g:,\3\g,,^g>0g++40g%40g\-\40g\`*-
2g05\**!!%6g04-g052!:`\g05::-1/2<^4*2%g05\+*+1*!!%6g04-

61
Task/N-queens-problem/Bracmat/n-queens-problem.bracmat Normal file
View file

@ -0,0 +1,61 @@
( ( printBoard
= board M L x y S R row line
. :?board
& !ups:? [?M
& whl
' ( !arg:(?x.?y) ?arg
& !M:?L
& :?row:?line
& whl
' ( !L+-1:~<0:?L
& !x+1:~>!M:?x
& "---+" !line:?line
& " |" !row:?row
)
& "---+" !line:?line
& " Q |" !row:?row
& whl
' ( !L+-1:~<0:?L
& "---+" !line:?line
& " |" !row:?row
)
& "\n|" !row "\n+" !line !board:?board
)
& str$("\n+" !line !board)
)
( queens
= hor ver up down ups downs a z A Z x y Q
. !arg:(?hor.?ver.?ups.?downs.?Q)
& !ver
: (
& 1+!solutions:?solutions
{ Comment the line below if you only want a count. }
& out$(str$("\nsolution " !solutions) printBoard$!Q)
& ~ { Fail! (and backtrack to find more solutions)}
| #%?y
( ?z
& !hor
: ?A
#%?x
( ?Z
& !x+!y:?up
& !x+-1*!y:?down
& ~(!ups:? !up ?)
& ~(!downs:? !down ?)
& queens
$ ( !A !Z
. !z
. !up !ups
. !down !downs
. (!x.!y) !Q
)
)
)
)
)
& 0:?solutions
& 1 2 3 4 5 6 7 8:?H:?V {You can edit this line to find solutions for other sizes.}
& ( queens$(!H.!V...)
| out$(found !solutions solutions)
)
);

103
Task/N-queens-problem/C++/n-queens-problem-1.cpp Normal file
View file

@ -0,0 +1,103 @@
// Much shorter than the version below;
// uses C++11 threads to parallelize the computation; also uses backtracking
// Outputs all solutions for any table size
#include <vector>
#include <iostream>
#include <iomanip>
#include <thread>
#include <future>
// Print table. 'pos' is a vector of positions – the index in pos is the row,
// and the number at that index is the column where the queen is placed.
static void print(const std::vector<int> &pos)
{
// print table header
for (int i = 0; i < pos.size(); i++) {
std::cout << std::setw(3) << char('a' + i);
}
std::cout << '\n';
for (int row = 0; row < pos.size(); row++) {
int col = pos[row];
std::cout << row + 1 << std::setw(3 * col + 3) << " # ";
std::cout << '\n';
}
std::cout << "\n\n";
}
static bool threatens(int row_a, int col_a, int row_b, int col_b)
{
return row_a == row_b // same row
or col_a == col_b // same column
or std::abs(row_a - row_b) == std::abs(col_a - col_b); // diagonal
}
// the i-th queen is in the i-th row
// we only check rows up to end_idx
// so that the same function can be used for backtracking and checking the final solution
static bool good(const std::vector<int> &pos, int end_idx)
{
for (int row_a = 0; row_a < end_idx; row_a++) {
for (int row_b = row_a + 1; row_b < end_idx; row_b++) {
int col_a = pos[row_a];
int col_b = pos[row_b];
if (threatens(row_a, col_a, row_b, col_b)) {
return false;
}
}
}
return true;
}
static std::mutex print_count_mutex; // mutex protecting 'n_sols'
static int n_sols = 0; // number of solutions
// recursive DFS backtracking solver
static void n_queens(std::vector<int> &pos, int index)
{
// if we have placed a queen in each row (i. e. we are at a leaf of the search tree), check solution and return
if (index >= pos.size()) {
if (good(pos, index)) {
std::lock_guard<std::mutex> lock(print_count_mutex);
print(pos);
n_sols++;
}
return;
}
// backtracking step
if (not good(pos, index)) {
return;
}
// optimization: the first level of the search tree is parallelized
if (index == 0) {
std::vector<std::future<void>> fts;
for (int col = 0; col < pos.size(); col++) {
pos[index] = col;
auto ft = std::async(std::launch::async, [=]{ auto cpos(pos); n_queens(cpos, index + 1); });
fts.push_back(std::move(ft));
}
for (const auto &ft : fts) {
ft.wait();
}
} else { // deeper levels are not
for (int col = 0; col < pos.size(); col++) {
pos[index] = col;
n_queens(pos, index + 1);
}
}
}
int main()
{
std::vector<int> start(12); // 12: table size
n_queens(start, 0);
std::cout << n_sols << " solutions found.\n";
return 0;
}

257
Task/N-queens-problem/C++/n-queens-problem-2.cpp Normal file
View file

@ -0,0 +1,257 @@
// A straight-forward brute-force C++ version with formatted output,
// eschewing obfuscation and C-isms, producing ALL solutions, which
// works on any OS with a text terminal.
//
// Two basic optimizations are applied:
//
// It uses backtracking to only construct potentially valid solutions.
//
// It only computes half the solutions by brute -- once we get the
// queen halfway across the top row, any remaining solutions must be
// reflections of the ones already computed.
//
// This is a bare-bones example, without any progress feedback or output
// formatting controls, which a more complete program might provide.
//
// Beware that computing anything larger than N=14 might take a while.
// (Time gets exponentially worse the higher the number.)
// Copyright 2014 Michael Thomas Greer
// Distributed under the Boost Software License, Version 1.0.
// http://www.boost.org/LICENSE_1_0.txt
#include <algorithm>
#include <ciso646>
#include <iomanip>
#include <iostream>
#include <set>
#include <sstream>
#include <stdexcept>
#include <string>
#include <vector>
// ///////////////////////////////////////////////////////////////////////////
struct queens
/////////////////////////////////////////////////////////////////////////// //
{
// TYPES -------------------------------------------------------------------
// A row or column index. (May be signed or unsigned.)
//
typedef signed char index_type;
// A 'solution' is a row --> column lookup of queens on the board.
//
// It has lexicographical order and can be transformed with a variety of
// reflections, which, when properly combined, produce all possible
// orientations of a solution.
//
struct solution_type: std::vector <index_type>
{
typedef std::vector <index_type> base_type;
// constructors . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
solution_type( std::size_t N ): base_type( N, -1 ) { }
solution_type( const solution_type& s ): base_type( s ) { }
// compare . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
bool operator < ( const solution_type& s ) const
{
auto mm = std::mismatch( begin(), end(), s.begin() );
return (mm.first != end()) and (*mm.first < *mm.second);
}
// transformations . . . . . . . . . . . . . . . . . . . . . . . . . . . .
void vflip() { std::reverse( begin(), end() ); }
void hflip() { for (auto& x : *this) x = size() - 1 - x; }
void transpose()
{
solution_type result( size() );
for (index_type y = 0; (std::size_t)y < size(); y++)
result[ (*this)[ y ] ] = y;
swap( result );
}
};
// MEMBER VALUES -----------------------------------------------------------
const int N;
std::set <solution_type> solutions;
// SOLVER ------------------------------------------------------------------
queens( int N = 8 ):
N( (N < 0) ? 0 : N )
{
// Row by row we create a potentially valid solution.
// If a queen can be placed in a valid spot by the time
// we get to the last row, then we've found a solution.
solution_type solution( N );
index_type row = 0;
while (true)
{
// Advance the queen along the row
++solution[ row ];
// (If we get past halfway through the first row, we're done.)
if ((row == 0) and (solution[ 0 ] > N/2)) break;
if (solution[ row ] < N)
{
// If the queen is in a good spot...
if (ok( solution, row, solution[ row ] ))
{
// ...and we're on the last row
if (row == N-1)
{
// Add the solution we found plus all it's reflections
solution_type
s = solution; solutions.insert( s );
s.vflip(); solutions.insert( s );
s.hflip(); solutions.insert( s );
s.vflip(); solutions.insert( s );
s.transpose(); solutions.insert( s );
s.vflip(); solutions.insert( s );
s.hflip(); solutions.insert( s );
s.vflip(); solutions.insert( s );
}
// otherwise begin marching a queen along the next row
else solution[ ++row ] = -1;
}
// When we get to the end of a row's columns then
// we need to backup a row and continue from there.
}
else --row;
}
}
// HELPER ------------------------------------------------------------------
// This routine helps the solver by identifying column locations
// that do not conflict with queens already placed in prior rows.
bool ok( const solution_type& columns, index_type row, index_type column )
{
for (index_type r = 0; r < row; r++)
{
index_type c = columns[ r ];
index_type delta_row = row - r;
index_type delta_col = (c < column) ? (column - c) : (c - column);
if ((c == column) or (delta_row == delta_col))
return false;
}
return true;
}
// OUTPUT A SINGLE SOLUTION ------------------------------------------------
//
// Formatted as (for example):
//
// d1 b2 g3 c4 f5 h6 e7 a8
// Q - - - - - - -
// - - - - Q - - -
// - - - - - - - Q
// - - - - - Q - -
// - - Q - - - - -
// - - - - - - Q -
// - Q - - - - - -
// - - - Q - - - -
//
friend
std::ostream&
operator << ( std::ostream& outs, const queens::solution_type& solution )
{
static const char* squares[] = { "- ", "Q " };
index_type N = solution.size();
// Display the queen positions
for (auto n = N; n--; )
outs << (char)('a' + solution[ n ]) << (N - n) << " ";
// Display the board
for (auto queen : solution)
{
outs << "\n";
for (index_type col = 0; col < N; col++)
outs << squares[ col == queen ];
}
return outs;
}
// OUTPUT ALL SOLUTIONS ----------------------------------------------------
//
// Display "no solutions" or "N solutions" followed by
// each individual solution, separated by blank lines.
friend
std::ostream&
operator << ( std::ostream& outs, const queens& q )
{
if (q.solutions.empty()) outs << "no";
else outs << q.solutions.size();
outs << " solutions";
std::size_t n = 1;
for (auto solution : q.solutions)
{
outs << "\n\n#" << n++ << "\n" << solution;
}
return outs;
}
};
/* ///////////////////////////////////////////////////////////////////////////
string_to <type> ( x )
/////////////////////////////////////////////////////////////////////////// */
template <typename T>
T string_to( const std::string& s )
{
T result;
std::istringstream ss( s );
ss >> result;
if (!ss.eof()) throw std::runtime_error( "to_string(): invalid conversion" );
return result;
}
template <typename T, T default_value>
T string_to( const std::string& s )
{
try { return string_to <T> ( s ); }
catch (...) { return default_value; }
}
/* ///////////////////////////////////////////////////////////////////////////
main program
/////////////////////////////////////////////////////////////////////////// */
int usage( const std::string& name )
{
std::cerr <<
"usage:\n " << name << " 8\n\n"
""
"Solve the N-Queens problem, brute-force,\n"
"and show all solutions for an 8x8 board.\n\n"
""
"(Specify a value other than 8 for the board size you want.)\n";
return 1;
}
int main( int argc, char** argv )
{
signed N =
(argc < 2) ? 8 :
(argc > 2) ? 0 : string_to <signed, 0> ( argv[ 1 ] );
if (N <= 0) return usage( argv[ 0 ] );
std::cout << queens( N ) << "\n";
}

100
Task/N-queens-problem/C++/n-queens-problem-3.cpp Normal file
View file

@ -0,0 +1,100 @@
#include <windows.h>
#include <iostream>
#include <string>
//--------------------------------------------------------------------------------------------------
using namespace std;
//--------------------------------------------------------------------------------------------------
class point
{
public:
int x, y;
point(){ x = y = 0; }
void set( int a, int b ){ x = a; y = b; }
};
//--------------------------------------------------------------------------------------------------
class nQueens
{
public:
void solve( int c )
{
_count = c; int len = ( c + 1 ) * ( c + 1 ); _queens = new bool[len]; memset( _queens, 0, len );
_cl = new bool[c]; memset( _cl, 0, c ); _ln = new bool[c]; memset( _ln, 0, c );
point pt; pt.set( rand() % c, rand() % c ); putQueens( pt, c ); displayBoard();
delete [] _queens; delete [] _ln; delete [] _cl;
}
private:
void displayBoard()
{
system( "cls" ); string t = "+---+", q = "| Q |", s = "| |";
COORD c = { 0, 0 }; HANDLE h = GetStdHandle( STD_OUTPUT_HANDLE );
for( int y = 0, cy = 0; y < _count; y++ )
{
int yy = y * _count;
for( int x = 0; x < _count; x++ )
{
SetConsoleCursorPosition( h, c ); cout << t;
c.Y++; SetConsoleCursorPosition( h, c );
if( _queens[x + yy] ) cout << q; else cout << s;
c.Y++; SetConsoleCursorPosition( h, c );
cout << t; c.Y = cy; c.X += 4;
}
cy += 2; c.X = 0; c.Y = cy;
}
}
bool checkD( int x, int y, int a, int b )
{
if( x < 0 || y < 0 || x >= _count || y >= _count ) return true;
if( _queens[x + y * _count] ) return false;
if( checkD( x + a, y + b, a, b ) ) return true;
return false;
}
bool check( int x, int y )
{
if( _ln[y] || _cl[x] ) return false;
if( !checkD( x, y, -1, -1 ) ) return false;
if( !checkD( x, y, 1, -1 ) ) return false;
if( !checkD( x, y, -1, 1 ) ) return false;
if( !checkD( x, y, 1, 1 ) ) return false;
return true;
}
bool putQueens( point pt, int cnt )
{
int it = _count;
while( it )
{
if( !cnt ) return true;
if( check( pt.x, pt.y ) )
{
_queens[pt.x + pt.y * _count] = _cl[pt.x] = _ln[pt.y] = true;
point tmp = pt; if( ++tmp.x >= _count ) tmp.x = 0; if( ++tmp.y >= _count ) tmp.y = 0;
if( putQueens( tmp, cnt - 1 ) ) return true;
_queens[pt.x + pt.y * _count] = _cl[pt.x] = _ln[pt.y] = false;
}
if( ++pt.x >= _count ) pt.x = 0;
it--;
}
return false;
}
int _count;
bool* _queens, *_ln, *_cl;
};
//--------------------------------------------------------------------------------------------------
int main( int argc, char* argv[] )
{
nQueens n; int nq;
while( true )
{
system( "cls" ); cout << "Enter board size bigger than 3 (0 - 3 to QUIT): "; cin >> nq;
if( nq < 4 ) return 0; n.solve( nq ); cout << endl << endl;
system( "pause" );
}
return 0;
}
//--------------------------------------------------------------------------------------------------

88
Task/N-queens-problem/C++/n-queens-problem-4.cpp Normal file
View file

@ -0,0 +1,88 @@
#include <windows.h>
#include <iostream>
#include <string>
#include <vector>
#include <algorithm>
//--------------------------------------------------------------------------------------------------
using namespace std;
//--------------------------------------------------------------------------------------------------
typedef unsigned int uint;
//--------------------------------------------------------------------------------------------------
class nQueens_Heuristic
{
public:
void solve( uint n ) { makeList( n ); drawBoard( n ); }
private:
void drawBoard( uint n )
{
system( "cls" ); string t = "+---+", q = "| Q |", s = "| |";
COORD c = { 0, 0 }; HANDLE h = GetStdHandle( STD_OUTPUT_HANDLE );
uint w = 0;
for( uint y = 0, cy = 0; y < n; y++ )
{
for( uint x = 0; x < n; x++ )
{
SetConsoleCursorPosition( h, c ); cout << t;
c.Y++; SetConsoleCursorPosition( h, c );
if( x + 1 == solution[w] ) cout << q; else cout << s;
c.Y++; SetConsoleCursorPosition( h, c );
cout << t; c.Y = cy; c.X += 4;
}
cy += 2; c.X = 0; c.Y = cy; w++;
}
solution.clear(); odd.clear(); evn.clear();
}
void makeList( uint n )
{
uint r = n % 6;
for( uint x = 1; x <= n; x++ )
{
if( x & 1 ) odd.push_back( x );
else evn.push_back( x );
}
if( r == 2 )
{
swap( odd[0], odd[1] );
odd.erase( find( odd.begin(), odd.end(), 5 ) );
odd.push_back( 5 );
}
else if( r == 3 )
{
odd.erase( odd.begin() ); odd.erase( odd.begin() );
odd.push_back( 1 ); odd.push_back( 3 );
evn.erase( evn.begin() ); evn.push_back( 2 );
}
vector<uint>::iterator it = evn.begin();
while( it != evn.end() )
{
solution.push_back( ( *it ) );
it++;
}
it = odd.begin();
while( it != odd.end() )
{
solution.push_back( ( *it ) );
it++;
}
}
vector<uint> odd, evn, solution;
};
//--------------------------------------------------------------------------------------------------
int main( int argc, char* argv[] )
{
uint n; nQueens_Heuristic nQH;
while( true )
{
cout << "Enter board size bigger than 3 (0 - 3 to QUIT): "; cin >> n;
if( n < 4 ) return 0;
nQH.solve( n ); cout << endl << endl;
}
return 0;
}
//--------------------------------------------------------------------------------------------------

43
Task/N-queens-problem/C-sharp/n-queens-problem-1.cs Normal file
View file

@ -0,0 +1,43 @@
using System.Collections.Generic;
using static System.Linq.Enumerable;
using static System.Console;
using static System.Math;
namespace N_Queens
{
static class Program
{
static void Main(string[] args)
{
var n = 8;
var cols = Range(0, n);
var combs = cols.Combinations(2).Select(pairs=> pairs.ToArray());
var solved = from v in cols.Permutations().Select(p => p.ToArray())
where combs.All(c => Abs(v[c[0]] - v[c[1]]) != Abs(c[0] - c[1]))
select v;
WriteLine($"{n}-queens has {solved.Count()} solutions");
WriteLine("Position is row, value is column:-");
var first = string.Join(" ", solved.First());
WriteLine($"First Solution: {first}");
Read();
}
//Helpers
public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> values)
{
if (values.Count() == 1)
return values.ToSingleton();
return values.SelectMany(v => Permutations(values.Except(v.ToSingleton())), (v, p) => p.Prepend(v));
}
public static IEnumerable<IEnumerable<T>> Combinations<T>(this IEnumerable<T> seq) =>
seq.Aggregate(Empty<T>().ToSingleton(), (a, b) => a.Concat(a.Select(x => x.Append(b))));
public static IEnumerable<IEnumerable<T>> Combinations<T>(this IEnumerable<T> seq, int numItems) =>
seq.Combinations().Where(s => s.Count() == numItems);
public static IEnumerable<T> ToSingleton<T>(this T item) { yield return item; }
}
}

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

@ -0,0 +1,38 @@
using System.Collections.Generic;
using static System.Linq.Enumerable;
using static System.Console;
using static System.Math;
namespace N_Queens
{
static class Program
{
static void Main(string[] args)
{
var n = 8;
var cols = Range(0, n);
var solved = from v in cols.Permutations().Select(p => p.ToArray())
where n == (from i in cols select v[i]+i).Distinct().Count()
where n == (from i in cols select v[i]-i).Distinct().Count()
select v;
WriteLine($"{n}-queens has {solved.Count()} solutions");
WriteLine("Position is row, value is column:-");
var first = string.Join(" ", solved.First());
WriteLine($"First Solution: {first}");
Read();
}
//Helpers from https://gist.github.com/martinfreedman/139dd0ec7df4737651482241e48b062f
public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> values)
{
if (values.Count() == 1)
return values.ToSingleton();
return values.SelectMany(v => Permutations(values.Except(v.ToSingleton())), (v, p) => p.Prepend(v));
}
public static IEnumerable<T> ToSingleton<T>(this T item) { yield return item; }
}
}

29
Task/N-queens-problem/C-sharp/n-queens-problem-3.cs Normal file
View file

@ -0,0 +1,29 @@
using static System.Linq.Enumerable;
using static System.Console;
namespace N_Queens
{
static class Program
{
static void Main(string[] args)
{
var n = 8;
var domain = Range(0, n).ToArray();
var amb = new Amb.Amb();
var queens = domain.Select(_ => amb.Choose(domain)).ToArray();
amb.Require(() => n == queens.Select(q=> q.Value).Distinct().Count());
amb.Require(() => n == domain.Select(i=> i + queens[i].Value).Distinct().Count());
amb.Require(() => n == domain.Select(i=> i - queens[i].Value).Distinct().Count());
if (amb.Disambiguate())
{
WriteLine("Position is row, value is column:-");
WriteLine(string.Join(" ", queens.AsEnumerable()));
}
else
WriteLine("amb is angry");
Read();
}
}
}

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;
}

69
Task/N-queens-problem/C/n-queens-problem-4.c Normal file
View file

@ -0,0 +1,69 @@
#include <stdio.h>
#define MAXN 31
int nqueens(int n)
{
int q0,q1;
int cols[MAXN], diagl[MAXN], diagr[MAXN], posibs[MAXN]; // Our backtracking 'stack'
int num=0;
//
// The top level is two fors, to save one bit of symmetry in the enumeration by forcing second queen to
// be AFTER the first queen.
//
for (q0=0; q0<n-2; q0++) {
for (q1=q0+2; q1<n; q1++){
int bit0 = 1<<q0;
int bit1 = 1<<q1;
int d=0; // d is our depth in the backtrack stack
cols[0] = bit0 | bit1 | (-1<<n); // The -1 here is used to fill all 'coloumn' bits after n ...
diagl[0]= (bit0<<1 | bit1)<<1;
diagr[0]= (bit0>>1 | bit1)>>1;
// The variable posib contains the bitmask of possibilities we still have to try in a given row ...
int posib = ~(cols[0] | diagl[0] | diagr[0]);
while (d >= 0) {
while(posib) {
int bit = posib & -posib; // The standard trick for getting the rightmost bit in the mask
int ncols= cols[d] | bit;
int ndiagl = (diagl[d] | bit) << 1;
int ndiagr = (diagr[d] | bit) >> 1;
int nposib = ~(ncols | ndiagl | ndiagr);
posib^=bit; // Eliminate the tried possibility.
// The following is the main additional trick here, as recognizing solution can not be done using stack level (d),
// since we save the depth+backtrack time at the end of the enumeration loop. However by noticing all coloumns are
// filled (comparison to -1) we know a solution was reached ...
// Notice also that avoiding an if on the ncols==-1 comparison is more efficient!
num += ncols==-1;
if (nposib) {
if (posib) { // This if saves stack depth + backtrack operations when we passed the last possibility in a row.
posibs[d++] = posib; // Go lower in stack ..
}
cols[d] = ncols;
diagl[d] = ndiagl;
diagr[d] = ndiagr;
posib = nposib;
}
}
posib = posibs[--d]; // backtrack ...
}
}
}
return num*2;
}
main(int ac , char **av)
{
if(ac != 2) {
printf("usage: nq n\n");
return 1;
}
int n = atoi(av[1]);
if(n<1 || n > MAXN) {
printf("n must be between 2 and 31!\n");
}
printf("Number of solution for %d is %d\n",n,nqueens(n));
}

59
Task/N-queens-problem/CLU/n-queens-problem.clu Normal file
View file

@ -0,0 +1,59 @@
n_queens = cluster is solve
rep = null
own hist: array[int] := array[int]$[]
own solutions: array[string] := array[string]$[]
attack = proc (i,j,col: int) returns (bool)
return(hist[j]=i | int$abs(hist[j]-i)=col-j)
end attack
cur_solution = proc ()
n: int := array[int]$size(hist)
ss: stream := stream$create_output()
for i: int in int$from_to(0,n-1) do
for j: int in int$from_to(0,n-1) do
if j=hist[i] then stream$putc(ss, 'Q')
elseif (i+j)//2 = 1 then stream$putc(ss, ' ')
else stream$putc(ss, '.')
end
end
stream$putc(ss, '\n')
end
array[string]$addh(solutions, stream$get_contents(ss))
end cur_solution
solve_rec = proc (col: int)
n: int := array[int]$size(hist)
if col=n then cur_solution() return end
for i: int in int$from_to(0,n-1) do
j: int := 0
while j<col cand ~attack(i,j,col) do j := j+1 end
if j<col then continue end
hist[col] := i
solve_rec(col+1)
end
end solve_rec
solve = proc (n: int) returns (sequence[string])
hist := array[int]$fill(0,n,0)
solutions := array[string]$[]
solve_rec(0)
return(sequence[string]$a2s(solutions))
end solve
end n_queens
start_up = proc()
N = 8
po: stream := stream$primary_output()
solutions: sequence[string] := n_queens$solve(N)
count: int := 0
for s: string in sequence[string]$elements(solutions) do
count := count + 1
stream$putl(po, "No. " || int$unparse(count) || "\n-------\n" || s)
end
end start_up

23
Task/N-queens-problem/Clojure/n-queens-problem-1.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")

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

@ -0,0 +1,6 @@
(ns queens
(:require [clojure.math.combinatorics :as combo]
(defn queens [n]
(filter (fn [x] (every? #(apply distinct? (map-indexed % x)) [+ -]))
(combo/permutations (range 1 (inc n)))))

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

@ -0,0 +1,9 @@
(defn n-queens [n]
(let[children #(map (partial conj %) (range n))
no-conflict? (fn [x] (or (empty? x)
(every? #(apply distinct? (map-indexed % x))
[+ - (fn[_ v] v)])))]
(filter (every-pred no-conflict? #(= n (count %)))
(tree-seq (every-pred #(> n (count %))
no-conflict?)
children []))))

111
Task/N-queens-problem/CoffeeScript/n-queens-problem.coffee 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)

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

@ -0,0 +1,19 @@
(defun queens (n &optional (m n))
(if (zerop n)
(list nil)
(loop for solution in (queens (1- n) m)
nconc (loop for new-col from 1 to m
when (loop for row from 1 to n
for col in solution
always (/= new-col col (+ col row) (- col row)))
collect (cons new-col solution)))))
(defun print-solution (solution)
(loop for queen-col in solution
do (loop for col from 1 to (length solution)
do (write-char (if (= col queen-col) #\Q #\.)))
(terpri))
(terpri))
(defun print-queens (n)
(mapc #'print-solution (queens n)))

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

@ -0,0 +1,40 @@
(defun queens1 (n)
(let ((a (make-array n))
(s (make-array n))
(u (make-array (list (- (* 4 n) 2)) :initial-element t))
y z (i 0) j p q (r (1- (* 2 n))) (m 0))
(dotimes (i n) (setf (aref a i) i))
(tagbody
L1
(if (>= i n) (go L5))
(setf j i)
L2
(setf y (aref a j) z (aref a i))
(setf p (+ (- i y) n -1) q (+ i y))
(setf (aref a i) y (aref a j) z)
(when (and (aref u p) (aref u (+ q r)))
(setf (aref s i) j (aref u p) nil (aref u (+ q r)) nil)
(incf i)
(go L1))
L3
(incf j)
(if (< j n) (go L2))
L4
(decf j)
(if (= j i) (go L6))
(rotatef (aref a i) (aref a j))
(go L4)
L5
(incf m)
L6
(decf i)
(if (minusp i) (go L7))
(setf p (+ (- i (aref a i)) n -1) q (+ i (aref a i)) j (aref s i))
(setf (aref u p) t (aref u (+ q r)) t)
(go L3)
L7)
m))
> (loop for n from 1 to 14 collect (cons n (queens1 n)))
((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))

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

@ -0,0 +1,21 @@
(defun queens2 (n)
(let ((a (make-array n))
(u (make-array (+ n n -1) :initial-element t))
(v (make-array (+ n n -1) :initial-element t))
(m 0))
(dotimes (i n) (setf (aref a i) i))
(labels ((sub (i)
(if (= i n)
;(push (copy-seq a) s)
(incf m)
(loop for k from i below n do
(let ((p (+ i (aref a k)))
(q (+ (- i (aref a k)) n -1)))
(when (and (aref u p) (aref v q))
(setf (aref u p) nil (aref v q) nil)
(rotatef (aref a i) (aref a k))
(sub (1+ i))
(setf (aref u p) t (aref v q) t)
(rotatef (aref a i) (aref a k))))))))
(sub 0))
m))

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 []

19
Task/N-queens-problem/Curry/n-queens-problem-4.curry Normal file
View file

@ -0,0 +1,19 @@
import CLPFD
import Findall
queens n qs =
qs =:= [_ | _ <- [1..n]]
& domain qs 1 (length qs)
& allDifferent qs
& allSafe qs
& labeling [FirstFail] qs
allSafe [] = success
allSafe (q:qs) = safe q qs 1 & allSafe qs
safe :: Int -> [Int] -> Int -> Success
safe _ [] _ = success
safe q (q1:qs) p = q /=# q1+#p & q /=# q1-#p & safe q qs (p+#1)
-- oneSolution = unpack $ queens 8
-- allSolutions = findall $ queens 8

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

@ -0,0 +1,9 @@
void main() {
import std.stdio, std.algorithm, std.range, permutations2;
enum n = 8;
n.iota.array.permutations.filter!(p =>
n.iota.map!(i => p[i] + i).array.sort().uniq.count == n &&
n.iota.map!(i => p[i] - i).array.sort().uniq.count == n)
.count.writeln;
}

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

@ -0,0 +1,44 @@
enum side = 8;
__gshared int[side] board;
bool isUnsafe(in int y) nothrow @nogc {
immutable int x = board[y];
foreach (immutable i; 1 .. y + 1) {
immutable int t = board[y - i];
if (t == x || t == x - i || t == x + i)
return true;
}
return false;
}
void showBoard() nothrow @nogc {
import core.stdc.stdio;
static int s = 1;
printf("\nSolution #%d:\n", s++);
foreach (immutable y; 0 .. side) {
foreach (immutable x; 0 .. side)
putchar(board[y] == x ? 'Q' : '.');
putchar('\n');
}
}
void main() nothrow @nogc {
int y = 0;
board[0] = -1;
while (y >= 0) {
do {
board[y]++;
} while (board[y] < side && y.isUnsafe);
if (board[y] < side) {
if (y < (side - 1))
board[++y] = -1;
else
showBoard;
} else
y--;
}
}

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

@ -0,0 +1,90 @@
ulong nQueens(in uint nn) pure nothrow @nogc @safe
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;
typeof(return) 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) {
// immutable uint pos = 1U << bits.bsf; // Slower.
immutable uint 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 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(in string[] args) {
import std.stdio, std.conv;
immutable uint side = (args.length >= 2) ? args[1].to!uint : 8;
writefln("N-queens(%d) = %d solutions.", side, side.nQueens);
}

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.write("Q ");
} else {
sb.write("* ");
}
}
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);
}

64
Task/N-queens-problem/Delphi/n-queens-problem.delphi Normal file
View file

@ -0,0 +1,64 @@
program N_queens_problem;
{$APPTYPE CONSOLE}
uses
System.SysUtils;
var
i: Integer;
q: boolean;
a: array[0..8] of boolean;
b: array[0..16] of boolean;
c: array[0..14] of boolean;
x: array[0..8] of Integer;
procedure TryMove(i: Integer);
begin
var j := 1;
while True do
begin
q := false;
if a[j] and b[i + j] and c[i - j + 7] then
begin
x[i] := j;
a[j] := false;
b[i + j] := false;
c[i - j + 7] := false;
if i < 8 then
begin
TryMove(i + 1);
if not q then
begin
a[j] := true;
b[i + j] := true;
c[i - j + 7] := true;
end;
end
else
q := true;
end;
if q or (j = 8) then
Break;
inc(j);
end;
end;
begin
for i := 1 to 8 do
a[i] := true;
for i := 2 to 16 do
b[i] := true;
for i := 0 to 14 do
c[i] := true;
TryMove(1);
if q then
for i := 1 to 8 do
writeln(i, ' ', x[i]);
readln;
end.

38
Task/N-queens-problem/Draco/n-queens-problem.draco Normal file
View file

@ -0,0 +1,38 @@
byte SIZE = 8;
word count;
proc solve([*] int hist; int col) void:
int i, j, n;
n := dim(hist, 1);
if col = n then
count := count + 1;
writeln();
writeln("No. ", count);
writeln("-----");
for i from 0 upto n-1 do
for j from 0 upto n-1 do
write(if j=hist[i] then 'Q'
elif (i+j)&1 /= 0 then ' '
else '.' fi)
od;
writeln()
od
else
for i from 0 upto n-1 do
j := 0;
while j<col and not (hist[j]=i or |(hist[j]-i) = col-j) do
j := j + 1
od;
if j >= col then
hist[col] := i;
solve(hist, col+1)
fi
od
fi
corp
proc nonrec main() void:
[SIZE] int hist;
count := 0;
solve(hist, 0)
corp

84
Task/N-queens-problem/ERRE/n-queens-problem.erre Normal file
View file

@ -0,0 +1,84 @@
!------------------------------------------------
! QUEENS.R : solve queens problem on a NxN board
!------------------------------------------------
PROGRAM QUEENS
DIM COL%[15]
BEGIN
MAXSIZE%=15
PRINT(TAB(25);" --- PROBLEMA DELLE REGINE --- ")
PRINT
PRINT("Board dimension ";)
INPUT(N%)
PRINT
IF (N%<1 OR N%>MAXSIZE%)
THEN
PRINT("Illegal dimension!!")
ELSE
FOR CURCOLNBR%=1 TO N%
COL%[CURCOLNBR%]=0
END FOR
CURCOLNBR%=1
WHILE CURCOLNBR%>0 DO
PLACEDAQUEEN%=FALSE
I%=COL%[CURCOLNBR%]+1
WHILE (I%<=N%) AND NOT PLACEDAQUEEN% DO
PLACEDAQUEEN%=TRUE
J%=1
WHILE PLACEDAQUEEN% AND (J%<CURCOLNBR%) DO
PLACEDAQUEEN%=COL%[J%]<>I%
J%=J%+1
END WHILE
IF PLACEDAQUEEN%
THEN
DIAGNBR%=I%+CURCOLNBR%
J%=1
WHILE PLACEDAQUEEN% AND (J%<CURCOLNBR%) DO
PLACEDAQUEEN%=(COL%[J%]+J%)<>DIAGNBR%
J%=J%+1
END WHILE
ELSE
END IF
IF PLACEDAQUEEN%
THEN
DIAGNBR%=I%-CURCOLNBR%
J%=1
WHILE PLACEDAQUEEN% AND (J%<CURCOLNBR%) DO
PLACEDAQUEEN%=(COL%[J%]-J%)<>DIAGNBR%
J%=J%+1
END WHILE
ELSE
END IF
IF NOT PLACEDAQUEEN%
THEN
I%=I%+1
ELSE
COL%[CURCOLNBR%]=I%
END IF
END WHILE
IF NOT PLACEDAQUEEN%
THEN
COL%[CURCOLNBR%]=0
CURCOLNBR%=CURCOLNBR%-1
ELSE
IF CURCOLNBR%=N%
THEN
NSOL%=NSOL%+1
PRINT("Soluzione";NSOL%;":";)
FOR I%=1 TO N%
PRINT(COL%[I%];)
END FOR
PRINT
ELSE
CURCOLNBR%=CURCOLNBR%+1
END IF
END IF
END WHILE
PRINT("Search completed")
REPEAT
GET(CH$)
UNTIL CH$<>""
END IF
END PROGRAM

49
Task/N-queens-problem/EasyLang/n-queens-problem.easy Normal file
View file

@ -0,0 +1,49 @@
subr show_sol
print "Solution " & n_sol
print ""
for i = 1 to n
write " "
for j = 1 to n
if j = x[i]
write "Q "
else
write ". "
.
.
print ""
.
print ""
.
subr test
ok = 1
for i = 1 to y - 1
if x[y] = x[i] or abs (x[i] - x[y]) = abs (y - i)
ok = 0
.
.
.
n = 8
len x[] n
y = 1
x[1] = 1
while y >= 1
call test
if ok = 1 and y + 1 <= n
y += 1
x[y] = 1
else
if ok = 1
n_sol += 1
if n_sol <= 1
call show_sol
.
.
while y >= 1 and x[y] = n
y -= 1
.
if y >= 1
x[y] += 1
.
.
.
print n_sol & " solutions"

57
Task/N-queens-problem/EchoLisp/n-queens-problem.l Normal file
View file

@ -0,0 +1,57 @@
;; square num is i + j*N
(define-syntax-rule (sq i j) (+ i (* j N)))
;; compute diag number for each square
(define (do-diag1 i0 j0 dnum into: dnum1 N) ;; ++i and ++j diags
(for [(i (in-range i0 N)) (j (in-range j0 N))]
;;(writeln i j 'diag1 dnum)
(vector-set! dnum1 (sq i j) dnum)))
(define (do-diag2 i0 j0 dnum into: dnum2 N) ;; --i and ++j diags
(for [(i (in-range i0 -1 -1)) (j (in-range j0 N))]
;; (writeln i j 'diag2 dnum)
(vector-set! dnum2 (sq i j) dnum)))
(define (init-diags dnum1 dnum2 N)
(define dnum 0)
(for ((j N)) (do-diag1 0 j dnum dnum1 N) (++ dnum))
(for ((i (in-range 1 N)))
(do-diag1 i 0 dnum dnum1 N) (++ dnum))
(set! dnum 0)
(for ((j N)) (do-diag2 (1- N) j dnum dnum2 N) (++ dnum))
(for ((i (1- N))) (do-diag2 i 0 dnum dnum2 N) (++ dnum)))
;; end boring diags part
(define (q-search i N col diag1 diag2 dnum1 dnum2 &hits (ns))
(cond
[(= i N) (set-box! &hits (1+ (unbox &hits))) ] ;; (writeln 'HIT col)
[else
(for ((j N))
(set! ns (sq i j))
#:continue (or [col j] [diag1 [dnum1 ns]] [diag2 [dnum2 ns]])
(vector-set! col j i) ;; move
(vector-set! diag1 [dnum1 ns] #t) ;; flag busy diagonal
(vector-set! diag2 [dnum2 ns] #t)
(q-search (1+ i) N col diag1 diag2 dnum1 dnum2 &hits)
(vector-set! col j #f) ;; unmove
(vector-set! diag1 [dnum1 ns] #f)
(vector-set! diag2 [dnum2 ns] #f))
]))
(define (q-count (N 8))
(define dnum1 (make-vector (* N N)))
(define dnum2 (make-vector (* N N )))
(init-diags dnum1 dnum2 N)
(define diag1 (make-vector (* 2 N) #f)) ; busy diag's
(define diag2 (make-vector (* 2 N) #f))
(define col (make-vector N #f))
(define &hits (box 0))
(q-search 0 N col diag1 diag2 dnum1 dnum2 &hits)
(unbox &hits))
(define (task up-to-n)
(for ((i up-to-n)) (writeln i ' ♕ (q-count i) 'solutions)))

68
Task/N-queens-problem/Eiffel/n-queens-problem.e Normal file
View file

@ -0,0 +1,68 @@
class
QUEENS
create
make
feature {NONE}
counter: INTEGER
place_queens(board: ARRAY[INTEGER]; level: INTEGER)
local
i, j: INTEGER
safe: BOOLEAN
do
if level > board.count
then
counter := counter + 1
else
from
i := 1
until
i > board.count
loop
safe := True
from
j := 1
until
j = level or not safe
loop
if (board[j] = i)
or (j - level = i - board[j])
or (j - level = board[j] - i)
then
safe := False
end
j := j + 1
end
if safe
then
board[level] := i
place_queens(board, level + 1)
end
i := i + 1
end
end
end
feature
possible_positions_of_n_queens(n: INTEGER): INTEGER
local
board: ARRAY[INTEGER]
do
create board.make_filled (0, 1, n)
counter := 0
place_queens(board, 1)
Result := counter
end
make
local
n: INTEGER
do
io.put_string ("Please enter the number of queens: ")
io.read_integer
n := io.last_integer
print("%NPossible number of placings: " + possible_positions_of_n_queens(n).out + "%N")
end
end

38
Task/N-queens-problem/Elixir/n-queens-problem.elixir Normal file
View file

@ -0,0 +1,38 @@
defmodule RC do
def queen(n, display \\ true) do
solve(n, [], [], [], display)
end
defp solve(n, row, _, _, display) when n==length(row) do
if display, do: print(n,row)
1
end
defp solve(n, row, add_list, sub_list, display) do
Enum.map(Enum.to_list(0..n-1) -- row, fn x ->
add = x + length(row) # \ diagonal check
sub = x - length(row) # / diagonal check
if (add in add_list) or (sub in sub_list) do
0
else
solve(n, [x|row], [add | add_list], [sub | sub_list], display)
end
end) |> Enum.sum # total of the solution
end
defp print(n, row) do
IO.puts frame = "+" <> String.duplicate("-", 2*n+1) <> "+"
Enum.each(row, fn x ->
line = Enum.map_join(0..n-1, fn i -> if x==i, do: "Q ", else: ". " end)
IO.puts "| #{line}|"
end)
IO.puts frame
end
end
Enum.each(1..6, fn n ->
IO.puts " #{n} Queen : #{RC.queen(n)}"
end)
Enum.each(7..12, fn n ->
IO.puts " #{n} Queen : #{RC.queen(n, false)}" # no display
end)

80
Task/N-queens-problem/Emacs-Lisp/n-queens-problem.l Normal file
View file

@ -0,0 +1,80 @@
(let ((*result* '()))
(defun grid-cnt (n)
(* n n) )
(defun x-axis (n pos)
(/ pos n) )
(defun y-axis (n pos)
(% pos n) )
(defun chess-cnt (chess-map)
(seq-count (lambda (x) x) chess-map))
(defun check-conflict (n chess-map pos)
(let ((is-conflict nil))
(cl-loop for i from 0 to (1- (grid-cnt n)) while (not is-conflict) do
(when (aref chess-map i)
(when (or (= (x-axis n i) (x-axis n pos))
(= (y-axis n i) (y-axis n pos))
(= (abs (- (x-axis n i) (x-axis n pos)))
(abs (- (y-axis n i) (y-axis n pos))))
)
(setq is-conflict 't)
)
)
)
is-conflict )
)
(defun place-chess (n chess-map start-pos)
(if (< (chess-cnt chess-map) n)
(progn
(let ()
(cl-loop for i from start-pos to (1- (grid-cnt n)) do
(when (not (aref chess-map i)) ;; check if place is empty
;; check if place is on hold by other chess
(when (not (check-conflict n chess-map i))
(let ((map1 (copy-sequence chess-map)))
(aset map1 i 't)
(place-chess n map1 i)
)
)
)
)
)
)
(progn
(if *result* (nconc *result* (list chess-map)) (setq *result* (list chess-map)))
)
)
)
(defun show-result (n)
(let ()
(seq-map (lambda (map1)
(let ((map-txt ""))
(message ">>>>>>>>>>>>>>")
(seq-map-indexed (lambda (elm idx)
(if (= (% idx n) 0)
;;(setq map-text (concat map-txt "\n"))
(progn
(message map-txt)
(setq map-txt "") )
)
(setq map-txt
(concat map-txt (if elm "✓" "⓪")))
) map1)
(message "<<<<<<<<<<<<<<\n")
)
) *result*)
)
(message "%d solutions in total" (length *result*))
)
(defun start-calculate (n)
(let ((chess-map (make-vector (grid-cnt n) nil)))
(place-chess n chess-map 0)
)
(show-result n)
)
(start-calculate 8)
)

83
Task/N-queens-problem/Erlang/n-queens-problem-1.erl Normal file
View file

@ -0,0 +1,83 @@
-module( n_queens ).
-export( [display/1, solve/1, task/0] ).
display( Board ) ->
%% Queens are in the positions in the Board list.
%% Top left corner is {1, 1}, Bottom right is {N, N}. There is a queen in the max column.
N = lists:max( [X || {X, _Y} <- Board] ),
[display_row(Y, N, Board) || Y <- lists:seq(1, N)].
solve( N ) ->
Positions = [{X, Y} || X <- lists:seq(1, N), Y <- lists:seq(1, N)],
try
bt( N, Positions, [] )
catch
_:{ok, Board} -> Board
end.
task() ->
task( 4 ),
task( 8 ).
bt( N, Positions, Board ) -> bt_reject( is_not_allowed_queen_placement(N, Board), N, Positions, Board ).
bt_accept( true, _N, _Positions, Board ) -> erlang:throw( {ok, Board} );
bt_accept( false, N, Positions, Board ) -> bt_loop( N, Positions, [], Board ).
bt_loop( _N, [], _Rejects, _Board ) -> failed;
bt_loop( N, [Position | T], Rejects, Board ) ->
bt( N, T ++ Rejects, [Position | Board] ),
bt_loop( N, T, [Position | Rejects], Board ).
bt_reject( true, _N, _Positions, _Board ) -> backtrack;
bt_reject( false, N, Positions, Board ) -> bt_accept( is_all_queens(N, Board), N, Positions, Board ).
diagonals( N, {X, Y} ) ->
D1 = diagonals( N, X + 1, fun diagonals_add1/1, Y + 1, fun diagonals_add1/1 ),
D2 = diagonals( N, X + 1, fun diagonals_add1/1, Y - 1, fun diagonals_subtract1/1 ),
D3 = diagonals( N, X - 1, fun diagonals_subtract1/1, Y + 1, fun diagonals_add1/1 ),
D4 = diagonals( N, X - 1, fun diagonals_subtract1/1, Y - 1, fun diagonals_subtract1/1 ),
D1 ++ D2 ++ D3 ++ D4.
diagonals( _N, 0, _Change_x, _Y, _Change_y ) -> [];
diagonals( _N, _X, _Change_x, 0, _Change_y ) -> [];
diagonals( N, X, _Change_x, _Y, _Change_y ) when X > N -> [];
diagonals( N, _X, _Change_x, Y, _Change_y ) when Y > N -> [];
diagonals( N, X, Change_x, Y, Change_y ) -> [{X, Y} | diagonals( N, Change_x(X), Change_x, Change_y(Y), Change_y )].
diagonals_add1( N ) -> N + 1.
diagonals_subtract1( N ) -> N - 1.
display_row( Row, N, Board ) ->
[io:fwrite("~s", [display_queen(X, Row, Board)]) || X <- lists:seq(1, N)],
io:nl().
display_queen( X, Y, Board ) -> display_queen( lists:member({X, Y}, Board) ).
display_queen( true ) -> " Q";
display_queen( false ) -> " .".
is_all_queens( N, Board ) -> N =:= erlang:length( Board ).
is_diagonal( _N, [] ) -> false;
is_diagonal( N, [Position | T] ) ->
Diagonals = diagonals( N, Position ),
T =/= (T -- Diagonals)
orelse is_diagonal( N, T ).
is_not_allowed_queen_placement( N, Board ) ->
Pieces = erlang:length( Board ),
{Xs, Ys} = lists:unzip( Board ),
Pieces =/= erlang:length( lists:usort(Xs) )
orelse Pieces =/= erlang:length( lists:usort(Ys) )
orelse is_diagonal( N, Board ).
task( N ) ->
io:fwrite( "N = ~p. One solution.~n", [N] ),
Board = solve( N ),
display( Board ).

14
Task/N-queens-problem/Erlang/n-queens-problem-2.erl Normal file
View file

@ -0,0 +1,14 @@
%%%For 8X8 chessboard with N queens.
-module(queens).
-export([queens/1]).
queens(0) -> [[]];
queens(N) ->
[[Row | Columns] || Columns <- queens(N-1),
Row <- [1,2,3,4,5,6,7,8] -- Columns,
safe(Row, Columns, 1)].
safe(_Row, [], _N) -> true;
safe(Row, [Column|Columns], N) ->
(Row /= Column + N) andalso (Row /= Column - N) andalso
safe(Row, Columns, (N+1)).

42
Task/N-queens-problem/F-Sharp/n-queens-problem.fs Normal file
View file

@ -0,0 +1,42 @@
let rec iterate f value = seq {
yield value
yield! iterate f (f value) }
let up i = i + 1
let right i = i
let down i = i - 1
let noCollisionGivenDir solution number dir =
Seq.forall2 (<>) solution (Seq.skip 1 (iterate dir number))
let goodAddition solution number =
List.forall (noCollisionGivenDir solution number) [ up; right; down ]
let rec extendSolution n ps =
[0..n - 1]
|> List.filter (goodAddition ps)
|> List.map (fun num -> num :: ps)
let allSolutions n =
iterate (List.collect (extendSolution n)) [[]]
// Print one solution for the 8x8 case
let printOneSolution () =
allSolutions 8
|> Seq.item 8
|> Seq.head
|> List.iter (fun rowIndex ->
printf "|"
[0..8] |> List.iter (fun i -> printf (if i = rowIndex then "X|" else " |"))
printfn "")
// Print number of solution for the other cases
let printNumberOfSolutions () =
printfn "Size\tNr of solutions"
[1..11]
|> List.map ((fun i -> Seq.item i (allSolutions i)) >> List.length)
|> List.iteri (fun i cnt -> printfn "%d\t%d" (i+1) cnt)
printOneSolution()
printNumberOfSolutions()

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-1.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

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

@ -0,0 +1,49 @@
\ http://www.forth.org/fd/FD-V02N1.pdf
VOCABULARY nqueens ALSO nqueens DEFINITIONS
8 constant queens
\ Nqueen solution from FD-V02N1.pdf
: 1array CREATE 0 DO 1 , LOOP DOES> SWAP CELLS + ;
queens 1array a \ a,b & c: workspaces for solutions
queens 2* 1array b
queens 2* 1array c
queens 1array x \ trial solutions
: safe ( c i -- n )
SWAP
2DUP - queens 1- + c @ >R
2DUP + b @ >R
DROP a @ R> R> * * ;
: mark ( c i -- )
SWAP
2DUP - queens 1- + c 0 swap !
2DUP + b 0 swap !
DROP a 0 swap ! ;
: unmark ( c i -- )
SWAP
2DUP - queens 1- + c 1 swap !
2DUP + b 1 swap !
DROP a 1 swap ! ;
VARIABLE tries
VARIABLE sols
: .cols queens 0 DO I x @ 1+ 5 .r loop ;
: .sol ." Found on try " tries @ 6 .R .cols cr ;
: try
queens 0
DO 1 tries +!
DUP I safe
IF DUP I mark
DUP I SWAP x !
DUP queens 1- < IF DUP 1+ RECURSE ELSE sols ++ .sol THEN
DUP I unmark
THEN
LOOP DROP ;
: go 0 tries ! CR 0 try CR sols @ . ." solutions Found, for n = " queens . ;
go

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

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

@ -0,0 +1,53 @@
!The preceding program implements recursion using arrays, since Fortran 77 does not allow recursive
!functions. The same algorithm is much easier to follow in Fortran 90, using the RECURSIVE keyword.
!Like previously, the program only counts solutions. It's pretty straightforward to adapt it to print
!them too: one has to replace the 'm = m + 1' instruction with a PRINT statement.
function numq(n)
implicit none
integer :: i, n, m, a(n), numq
logical :: up(2*n - 1), down(2*n - 1)
do i = 1, n
a(i) = i
end do
up = .true.
down = .true.
m = 0
call sub(1)
numq = m
contains
recursive subroutine sub(i)
integer :: i, j, k, p, q, s
do k = i, n
j = a(k)
p = i + j - 1
q = i - j + n
if(up(p) .and. down(q)) then
if(i == n) then
m = m + 1
else
up(p) = .false.
down(q) = .false.
s = a(i)
a(i) = a(k)
a(k) = s
call sub(i + 1)
up(p) = .true.
down(q) = .true.
s = a(i)
a(i) = a(k)
a(k) = s
end if
end if
end do
end subroutine
end function
program queens
implicit none
integer :: numq, n, m
do n = 4, 16
m = numq(n)
print *, n, m
end do
end program

125
Task/N-queens-problem/Fortran/n-queens-problem-4.f Normal file
View file

@ -0,0 +1,125 @@
program queens
use omp_lib
implicit none
integer, parameter :: long = selected_int_kind(17)
integer, parameter :: l = 18
integer, parameter :: nthreads = 16 ! Change to suit your processor
integer :: n, i, j, a(l*l, 2), k, p, q
integer(long) :: s, b(l*l)
real(kind(1d0)) :: t1, t2
! Edit : Added OPEN MP calls to set number of threads
CALL OMP_SET_DYNAMIC(.TRUE.)
CALL OMP_SET_NUM_THREADS(nthreads)
do n = 6, l
k = 0
p = n/2
q = mod(n, 2)*(p + 1)
do i = 1, n
do j = 1, n
if ((abs(i - j) > 1) .and. ((i <= p) .or. ((i == q) .and. (j < 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()
!$omp parallel do schedule(dynamic)
do i = 1, k
b(i) = pqueens(n, a(i, 1), a(i, 2))
end do
!$omp end parallel do
t2 = omp_get_wtime()
print "(I4, I12, F12.3)", n, 2*sum(b(1:k)), t2 - t1
end do
contains
function pqueens(n, k1, k2) result(m)
implicit none
integer(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 i = 1, n
a(i) = i
end do
do i = 1, 4*n - 2
u(i) = 0
end do
m = 0
r = 2*n - 1
if (k1 == k2) return
p = 1 - k1 + n
q = 1 + k1 - 1
if ((u(p) /= 0) .or. (u(q + r) /= 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) /= 0) .or. (u(q + r) /= 0)) return
u(p) = 1
u(q + r) = 1
if (k2 /= 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 > 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) == 0) .and. (u(q + r) == 0)) go to 30
60 j = j + 1
if (j <= n) go to 50
70 j = j - 1
if (j == i) go to 90
z = a(i)
a(i) = a(j)
a(j) = z
go to 70
!valid queens position found
80 m = m + 1
90 i = i - 1
if (i == 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 program

280
Task/N-queens-problem/Fortran/n-queens-problem-5.f Normal file
View file

@ -0,0 +1,280 @@
program example__n_queens
use, intrinsic :: iso_fortran_env, only: output_unit
use, non_intrinsic :: garbage_collector
use, non_intrinsic :: cons_pairs
implicit none
! .true. is good for testing that necessary values are rooted.
! .false. to collect garbage only when the heap reaches a limit.
logical :: aggressive_garbage_collection = .true.
integer :: arg_count
integer :: stat
character(80) :: arg
type(gcroot_t) :: board_sizes
arg_count = command_argument_count ()
if (arg_count < 1) then
call print_usage (output_unit)
else
board_sizes = nil
block
integer :: i
integer :: board_size
do i = 1, arg_count
call get_command_argument (i, arg)
read (arg, *, iostat = stat) board_size
if (stat /= 0 .or. board_size < 1) then
board_size = -1
end if
board_sizes = cons (board_size, board_sizes)
end do
board_sizes = reversex (board_sizes)
end block
if (is_member (int_eq, -1, board_sizes)) then
call print_usage (output_unit)
else
! Use pair_for_each as a way to distinguish the last
! BOARD_SIZE from the others. The last entry will be the final
! pair, and so its CDR will *not* be a pair.
call pair_for_each (find_and_print_all_solutions, &
& circular_list (output_unit), &
& board_sizes)
end if
end if
contains
subroutine print_usage (outp)
integer, intent(in) :: outp
write (outp, '("Usage: example__n_queens BOARD_SIZE [BOARD_SIZE...]")')
write (outp, '("Each BOARD_SIZE must be at least 1.")')
write (outp, '("For each BOARD_SIZE, all solutions are computed before any is printed.")')
end subroutine print_usage
subroutine find_and_print_all_solutions (outp_pair, board_sizes)
class(*), intent(in) :: outp_pair
class(*), intent(in) :: board_sizes
integer :: n_outp
type(gcroot_t) :: all_solutions
n_outp = int_cast (car (outp_pair))
all_solutions = find_all_solutions (car (board_sizes))
call check_garbage
call print_all_solutions (n_outp, car (board_sizes), all_solutions)
call check_garbage
if (is_pair (cdr (board_sizes))) then
! Space between one BOARD_SIZE and another.
write (n_outp, '()')
end if
end subroutine find_and_print_all_solutions
function find_all_solutions (board_size) result (all_solutions)
class(*), intent(in) :: board_size
type(cons_t) :: all_solutions
class(*), allocatable :: solutions
call find_solutions_from_ranks_so_far (board_size, nil, solutions)
all_solutions = solutions
end function find_all_solutions
recursive subroutine find_solutions_from_ranks_so_far (board_size, ranks_so_far, solutions)
class(*), intent(in) :: board_size
class(*), intent(in) :: ranks_so_far
class(*), allocatable, intent(out) :: solutions
type(cons_t) :: ranks
if (length (ranks_so_far) == int_cast (board_size)) then
solutions = list (ranks_so_far)
else
ranks = find_legal_ranks_for_file (int_cast (board_size), ranks_so_far)
solutions = concatenatex (map (find_solutions_from_ranks_so_far, &
& circular_list (board_size), &
& map (kons, ranks, circular_list (ranks_so_far))))
end if
end subroutine find_solutions_from_ranks_so_far
function find_legal_ranks_for_file (board_size, ranks_so_far) result (ranks)
!
! Return a list of all the ranks in the next file, under the
! constraint that a queen placed in the position not be under
! attack.
!
integer, intent(in) :: board_size
class(*), intent(in) :: ranks_so_far
type(cons_t) :: ranks
ranks = iota (board_size, 1) ! All the possible ranks.
ranks = remove_illegal_ranks (ranks, ranks_so_far)
end function find_legal_ranks_for_file
function remove_illegal_ranks (new_ranks, ranks_so_far) result (legal_ranks)
class(*), intent(in) :: new_ranks
class(*), intent(in) :: ranks_so_far
type(cons_t) :: legal_ranks
legal_ranks = filter_map (keep_legal_rank, new_ranks, &
& circular_list (ranks_so_far))
end function remove_illegal_ranks
subroutine keep_legal_rank (rank, ranks_so_far, retval)
class(*), intent(in) :: rank
class(*), intent(in) :: ranks_so_far
class(*), allocatable, intent(out) :: retval
if (rank_is_legal (rank, ranks_so_far)) then
retval = rank
else
retval = .false.
end if
end subroutine keep_legal_rank
function rank_is_legal (new_rank, ranks_so_far) result (bool)
class(*), intent(in) :: new_rank
class(*), intent(in) :: ranks_so_far
logical :: bool
integer :: new_file
type(cons_t) :: files_so_far
new_file = int (length (ranks_so_far)) + 1
files_so_far = iota (new_file - 1, new_file - 1, -1)
bool = every (these_two_queens_are_nonattacking, &
& circular_list (new_file), &
& circular_list (new_rank), &
& files_so_far, &
& ranks_so_far)
end function rank_is_legal
function these_two_queens_are_nonattacking (file1, rank1, file2, rank2) result (bool)
class(*), intent(in) :: file1, rank1
class(*), intent(in) :: file2, rank2
logical :: bool
integer :: f1, r1
integer :: f2, r2
! The rank and the two diagonals must not be the same. (The files
! are known to be different.)
f1 = int_cast (file1)
r1 = int_cast (rank1)
f2 = int_cast (file2)
r2 = int_cast (rank2)
bool = (r1 /= r2 .and. r1 + f1 /= r2 + f2 .and. r1 - f1 /= r2 - f2)
end function these_two_queens_are_nonattacking
subroutine print_all_solutions (outp, board_size, all_solutions)
class(*), intent(in) :: outp
class(*), intent(in) :: board_size
class(*), intent(in) :: all_solutions
integer(size_kind) :: n
n = length (all_solutions)
write (int_cast (outp), '("For a board ", I0, " by ", I0, ", ")', advance = 'no') &
& int_cast (board_size), int_cast (board_size)
if (n == 1) then
write (int_cast (outp), '("there is ", I0, " solution.")') n
else
write (int_cast (outp), '("there are ", I0, " solutions.")') n
end if
call for_each (print_spaced_solution, circular_list (outp), &
& circular_list (board_size), all_solutions)
end subroutine print_all_solutions
subroutine print_spaced_solution (outp, board_size, solution)
class(*), intent(in) :: outp
class(*), intent(in) :: board_size
class(*), intent(in) :: solution
write (int_cast (outp), '()', advance = 'yes')
call print_solution (outp, board_size, solution)
end subroutine print_spaced_solution
subroutine print_solution (outp, board_size, solution)
class(*), intent(in) :: outp
class(*), intent(in) :: board_size
class(*), intent(in) :: solution
integer :: n_outp
integer :: n_board_size
integer :: rank
integer :: file
integer :: file_of_queen
n_outp = int_cast (outp)
n_board_size = int_cast (board_size)
do rank = n_board_size, 1, -1
do file = 1, n_board_size
write (n_outp, '("----")', advance = 'no')
end do
write (n_outp, '("-")', advance = 'yes')
file_of_queen = n_board_size - int (list_index0 (int_eq, circular_list (rank), solution))
do file = 1, n_board_size
if (file == file_of_queen) then
write (n_outp, '("| Q ")', advance = 'no')
else
write (n_outp, '("| ")', advance = 'no')
end if
end do
write (n_outp, '("|")', advance = 'yes')
end do
do file = 1, n_board_size
write (n_outp, '("----")', advance = 'no')
end do
write (n_outp, '("-")', advance = 'yes')
end subroutine print_solution
subroutine kons (x, y, xy)
class(*), intent(in) :: x
class(*), intent(in) :: y
class(*), allocatable, intent(out) :: xy
xy = cons (x, y)
end subroutine kons
pure function int_cast (x) result (val)
class(*), intent(in) :: x
integer :: val
select type (x)
type is (integer)
val = x
class default
error stop
end select
end function int_cast
pure function int_eq (x, y) result (bool)
class(*), intent(in) :: x
class(*), intent(in) :: y
logical :: bool
bool = (int_cast (x) == int_cast (y))
end function int_eq
subroutine check_garbage
if (aggressive_garbage_collection) then
call collect_garbage_now
else
call check_heap_size
end if
end subroutine check_garbage
end program example__n_queens

56
Task/N-queens-problem/FreeBASIC/n-queens-problem-1.basic Normal file
View file

@ -0,0 +1,56 @@
' version 13-04-2017
' compile with: fbc -s console
Dim Shared As ULong count, c()
Sub n_queens(row As ULong, n As ULong, show As ULong = 0)
Dim As ULong x, y
For x = 1 To n
For y = 1 To row -1
If c(y) = x OrElse ((row - y) - Abs(x - c(y))) = 0 Then
Continue For, For
End If
Next
c(row) = x
If row < n Then
n_queens(row +1 , n, show)
Else
count += 1
If show <> 0 Then
For y = 1 To n
Print Using "###"; c(y);
Next
Print
End If
End If
Next
End Sub
' ------=< MAIN >=------
Dim As ULong n = 5
ReDim c(n)
' n_queens(1, n, show = 0 only show total | show <> 0 show every solution
n_queens(1, n, 1)
Print Using "## x ## board, ##### solutions"; n; n; count
Print
For n = 1 To 14
ReDim c(n)
count = 0
n_queens(1, n)
Print Using "A ## x ## board has ######## solutions"; n; n; count
Next
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

41
Task/N-queens-problem/FreeBASIC/n-queens-problem-2.basic Normal file
View file

@ -0,0 +1,41 @@
Sub aux(n As Integer, i As Integer, a() As Integer, _
u() As Integer, v() As Integer, ByRef m As LongInt)
Dim As Integer j, k, p, q
If i > n Then
m += 1
For k = 1 To n : Print a(k); : Next : Print
Else
For j = i To n
k = a(j)
p = i - k + n
q = i + k - 1
If u(p) And v(q) Then
u(p) = 0 : v(q) = 0
a(j) = a(i) : a(i) = k
aux(n, i + 1, a(), u(), v(), m)
u(p) = 1 : v(q) = 1
a(i) = a(j) : a(j) = k
End If
Next
End If
End Sub
Dim As Integer n, i
Dim m As LongInt = 1
If Command(1) <> "" Then
n = CInt(Command(1))
ReDim a(1 To n) As Integer
ReDim u(1 To 2 * n - 1) As Integer
ReDim v(1 To 2 * n - 1) As Integer
For i = 1 To n
a(i) = i
Next
For i = 1 To 2 * n - 1
u(i) = 1
v(i) = 1
Next
m = 0
aux(n, 1, a(), u(), v(), m)
Print m
End If

43
Task/N-queens-problem/FreeBASIC/n-queens-problem-3.basic Normal file
View file

@ -0,0 +1,43 @@
Dim As Integer n, i, j, k, p, q
Dim m As LongInt = 0
If Command(1) <> "" Then
n = CInt(Command(1))
ReDim a(1 To n) As Integer
ReDim s(1 To n) As Integer
ReDim u(1 To 2 * n - 1) As Integer
ReDim v(1 To 2 * n - 1) As Integer
For i = 1 To n
a(i) = i
Next
For i = 1 To 2 * n - 1
u(i) = 1
v(i) = 1
Next
m = 0
i = 1
L1: If i > n Then
m += 1
For k = 1 To n : Print a(k); : Next : Print
Goto L4
End If
j = i
L2: k = a(j)
p = i - k + n
q = i + k - 1
If u(p) And v(q) Then
u(p) = 0 : v(q) = 0
a(j) = a(i) : a(i) = k
s(i) = j
i += 1
Goto L1
End If
L3: j += 1 : If j <= n Goto L2
L4: i -= 1 : If i = 0 Then Print m : End
j = s(i)
k = a(i) : a(i) = a(j) : a(j) = k
p = i - k + n
q = i + k - 1
u(p) = 1 : v(q) = 1
Goto L3
End If

12
Task/N-queens-problem/Frink/n-queens-problem.frink Normal file
View file

@ -0,0 +1,12 @@
solution[board] :=
{
for q = 0 to length[board] - 1
for c = q+1 to length[board] - 1
if board@q == board@c + (c - q) or board@q == board@c - (c - q)
return false
return true
}
for b = array[1 to 8].permute[]
if solution[b]
println[b]

78
Task/N-queens-problem/GAP/n-queens-problem.gap Normal file
View file

@ -0,0 +1,78 @@
NrQueens := function(n)
local a, up, down, m, sub;
a := [1 .. n];
up := ListWithIdenticalEntries(2*n - 1, true);
down := ListWithIdenticalEntries(2*n - 1, true);
m := 0;
sub := function(i)
local j, k, p, q;
for k in [i .. n] do
j := a[k];
p := i + j - 1;
q := i - j + n;
if up[p] and down[q] then
if i = n then
m := m + 1;
else
up[p] := false;
down[q] := false;
a[k] := a[i];
a[i] := j;
sub(i + 1);
up[p] := true;
down[q] := true;
a[i] := a[k];
a[k] := j;
fi;
fi;
od;
end;
sub(1);
return m;
end;
Queens := function(n)
local a, up, down, v, sub;
a := [1 .. n];
up := ListWithIdenticalEntries(2*n - 1, true);
down := ListWithIdenticalEntries(2*n - 1, true);
v := [];
sub := function(i)
local j, k, p, q;
for k in [i .. n] do
j := a[k];
p := i + j - 1;
q := i - j + n;
if up[p] and down[q] then
if i = n then
Add(v, ShallowCopy(a));
else
up[p] := false;
down[q] := false;
a[k] := a[i];
a[i] := j;
sub(i + 1);
up[p] := true;
down[q] := true;
a[i] := a[k];
a[k] := j;
fi;
fi;
od;
end;
sub(1);
return v;
end;
NrQueens(8);
a := Queens(8);;
PrintArray(PermutationMat(PermList(a[1]), 8));
[ [ 1, 0, 0, 0, 0, 0, 0, 0 ],
[ 0, 0, 0, 0, 1, 0, 0, 0 ],
[ 0, 0, 0, 0, 0, 0, 0, 1 ],
[ 0, 0, 0, 0, 0, 1, 0, 0 ],
[ 0, 0, 1, 0, 0, 0, 0, 0 ],
[ 0, 0, 0, 0, 0, 0, 1, 0 ],
[ 0, 1, 0, 0, 0, 0, 0, 0 ],
[ 0, 0, 0, 1, 0, 0, 0, 0 ] ]

61
Task/N-queens-problem/Go/n-queens-problem-1.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])
}
}
}

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

@ -0,0 +1,124 @@
/*
* N-Queens Problem
*
* For an NxN chess board, 'safely' place a chess queen in every column and row such that none can attack another.
* This solution is based Wirth Pascal solution, although a tad cleaner, thus easier to understand as it uses Go/C
* style indexing and naming, and also prints the Queen using a Unicode 'rune' (which other languages do not handle natively).
*
* N rows by N columns are number left to right top to bottom 0 - 7
*
* There are 2N-1 diagonals (showing an 8x8)
* the upper-right to lower-left are numbered row + col that is:
* 0 1 2 3 4 5 6 7
* 1 2 3 4 5 6 7 8
* 2 3 4 5 6 7 8 9
* 3 4 5 6 7 8 9 10
* 4 5 6 7 8 9 10 11
* 5 6 7 8 9 10 11 12
* 6 7 8 9 10 11 12 13
* 7 8 9 10 11 12 13 14
*
* the upper-left to lower-right are numbered N-1 + row - col
* 7 6 5 4 3 2 1 0
* 8 7 6 5 4 3 2 1
* 9 8 7 6 5 4 3 2
* 10 9 8 7 6 5 4 3
* 11 10 9 8 7 6 5 4
* 12 11 10 9 8 7 6 5
* 13 12 11 10 9 8 7 6
* 14 13 12 11 10 9 8 7
*/
package main
import "fmt"
const N = 8
const HAS_QUEEN = false
const EMPTY = true
const UNASSIGNED = -1
const white_queen = '\u2655'
var row_num[N]int // results, indexed by row will be the column where the queen lives (UNASSIGNED) is empty
var right_2_left_diag[(2*N-1)]bool // T if no queen in diag[idx]: row i, column col is diag i+col
var left_2_right_diag[(2*N-1)]bool // T is no queen in diag[idx], row i, column col is N-1 + i-col
func printresults() {
for col := 0; col < N; col++ {
if col != 0 {
fmt.Printf(" ");
}
fmt.Printf("%d,%d", col, row_num[col])
}
fmt.Printf("\n");
for row := 0; row < N; row++ {
for col := 0; col < N; col++ {
if col == row_num[row] {
fmt.Printf(" %c ", white_queen)
} else {
fmt.Printf(" . ")
}
}
fmt.Printf("\n")
}
}
/*
* save a queen on the board by saving where we think it should go, and marking the diagonals as occupied
*/
func savequeen(row int, col int) {
row_num[row] = col // save queen column for this row
right_2_left_diag[row+col] = HAS_QUEEN // mark forward diags as occupied
left_2_right_diag[row-col+(N-1)] = HAS_QUEEN // mark backward diags as occupied
}
/*
* backout a previously saved queen by clearing where we put it, and marking the diagonals as empty
*/
func clearqueen(row int, col int) {
row_num[row] = UNASSIGNED
right_2_left_diag[row+col] = EMPTY
left_2_right_diag[row-col+(N-1)] = EMPTY
}
/*
* for each column try the solutions
*/
func trycol(col int) bool {
// check each row to look for the first empty row that does not have a diagonal in use too
for row := 0; row < N; row++ {
if row_num[row] == UNASSIGNED && // has the row been used yet?
right_2_left_diag[row+col] == EMPTY && // check for the forward diags
left_2_right_diag[row-col+(N-1)] == EMPTY { // check for the backwards diags
savequeen(row, col) // this is a possible solution
// Tricky part here: going forward thru the col up to but not including the rightmost one
// if this fails, we are done, no need to search any more
if col < N-1 && !trycol(col+1) {
// ok this did not work - we need to try a different row, so undo the guess
clearqueen(row, col)
} else {
// we have a solution on this row/col, start popping the stack.
return true
}
}
}
return false // not a solution for this col, pop the stack, undo the last guess, and try the next one
}
func main() {
for i := 0; i < N ; i++ {
row_num[i] = UNASSIGNED
}
for i := 0; i < 2*N-1 ; i++ {
right_2_left_diag[i] = EMPTY
}
for i := 0; i < 2*N-1 ; i++ {
left_2_right_diag[i] = EMPTY
}
trycol(0)
printresults()
}

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

@ -0,0 +1,136 @@
package main
import (
"flag"
"fmt"
"log"
"os"
"time"
"rosettacode.org/dlx" // or where ever you put the dlx package
)
func main() {
log.SetPrefix("N-queens: ")
log.SetFlags(0)
profile := flag.Bool("profile", false, "show DLX profile")
flag.Parse()
for N := 2; N <= 18; N++ {
err := nqueens(N, N == 8, *profile)
if err != nil {
log.Fatal(err)
}
}
}
func nqueens(N int, printFirst, profile bool) error {
// Build a new DLX matrix with 2N primary columns and 4N-6 secondary
// columns: R0..R(N-1), F0..F(N-1), A1..A(2N-3), B1..B(2N-3).
// We also know the number of cells and solution rows required.
m := dlx.NewWithHint(2*N, 4*N-6, N*N*4-4, 8)
s := solution{
N: N,
renumFwd: make([]int, 0, 2*N),
renumBack: make([]int, 2*N),
printFirst: printFirst,
}
// column indexes
iR0 := 0
iF0 := iR0 + N
iA1 := iF0 + N
iB1 := iA1 + 2*N - 3
// Use "organ-pipe" ordering. E.g. for N=8:
// R4 F4 R3 F3 R5 F5 R2 F2 R6 F6 R1 F1 R7 F7 R0 F0
// This can reduce the number of link updates required by
// almost half for large N; see Knuth's paper for details.
mid := N / 2
for off := 0; off <= N-mid; off++ {
i := mid - off
if i >= 0 {
s.renumBack[iR0+i] = len(s.renumFwd)
s.renumBack[iF0+i] = len(s.renumFwd) + 1
s.renumFwd = append(s.renumFwd, iR0+i, iF0+i)
}
if i = mid + off; off != 0 && i < N {
s.renumBack[iR0+i] = len(s.renumFwd)
s.renumBack[iF0+i] = len(s.renumFwd) + 1
s.renumFwd = append(s.renumFwd, iR0+i, iF0+i)
}
}
// Add constraint rows.
// TODO: pre-eliminate symetrical possibilities.
cols := make([]int, 4)
for i := 0; i < N; i++ {
for j := 0; j < N; j++ {
cols[0] = iR0 + i // Ri, rank i
cols[1] = iF0 + j // Fj, file j
a := (i + j) // A(i+j), diagonals
b := (N - 1 - i + j) // B(N-1-i+j), reverse diagonals
cols = cols[:2]
// Do organ-pipe reordering for R and F.
for i, c := range cols {
cols[i] = s.renumBack[c]
}
// Only add diagonals with more than one space; that
// is we omit the corners: A0, A(2N-2), B0, and B(2N-2)
if 0 < a && a < 2*N-2 {
cols = append(cols, iA1+a-1)
}
if 0 < b && b < 2*N-2 {
cols = append(cols, iB1+b-1)
}
m.AddRow(cols)
}
}
// Search for solutions.
start := time.Now()
err := m.Search(s.found)
if err != nil {
return err
}
elapsed := time.Since(start)
fmt.Printf("%d×%d queens has %2d solutions, found in %v\n", N, N, s.count, elapsed)
if profile {
m.ProfileWrite(os.Stderr)
}
return nil
}
type solution struct {
N int
count int
renumFwd []int // for "organ-pipe" column ordering
renumBack []int
printFirst bool
}
func (s *solution) found(m *dlx.Matrix) error {
s.count++
if s.printFirst && s.count == 1 {
fmt.Printf("First %d×%d queens solution:\n", s.N, s.N)
for _, cols := range m.SolutionIDs(nil) {
var r, f int
for _, c := range cols {
// Undo organ-pipe reodering
if c < len(s.renumFwd) {
c = s.renumFwd[c]
}
if c < s.N {
r = c + 1
} else if c < 2*s.N {
f = c - s.N + 1
}
}
fmt.Printf(" R%d F%d\n", r, f)
}
}
return nil
}

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()
}

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

@ -0,0 +1,30 @@
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, delete x d) | x <- d, safe x] where
-- "safe x" tests whether a queen at column x is safe from previous queens
safe x = and [x /= c + n && x /= c - n | (n,c) <- zip [1..] y]
-- prints what the board looks like for a solution; with an extra newline
printSolution y = do
let n = length y
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

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

@ -0,0 +1,11 @@
import Control.Monad (foldM)
import Data.List ((\\))
main :: IO ()
main = mapM_ print $ queens 8
queens :: Int -> [[Int]]
queens n = foldM f [] [1..n]
where
f qs _ = [q:qs | q <- [1..n] \\ qs, q `notDiag` qs]
q `notDiag` qs = and [abs (q - qi) /= i | (qi,i) <- qs `zip` [1..]]

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

@ -0,0 +1,12 @@
import Data.List (nub, permutations)
-- checks if queens are on the same diagonal
-- with [0..] we place each queen on her own row
check f = length . nub . zipWith f [0..]
-- filters out results where 2 or more queens are on the same diagonal
-- with [0..n-1] we place each queeen on her own column
generate n = filter (\x -> check (+) x == n && check (-) x == n) $ permutations [0..n-1]
-- 8 is for "8 queens"
main = print $ generate 8

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

@ -0,0 +1,54 @@
import Data.List (intercalate, transpose)
--------------------- N QUEENS PROBLEM -------------------
queenPuzzle :: Int -> Int -> [[Int]]
queenPuzzle nRows nCols
| nRows <= 0 = [[]]
| otherwise =
foldr
(\x y -> y <> foldr (go x) [] [1 .. nCols])
[]
$ queenPuzzle (pred nRows) nCols
where
go qs iCol b
| safe (nRows - 1) iCol qs = b <> [qs <> [iCol]]
| otherwise = b
safe :: Int -> Int -> [Int] -> Bool
safe iRow iCol qs =
(not . or) $
zipWith
( \sc sr ->
(iCol == sc) || (sc + sr == (iCol + iRow))
|| (sc - sr == (iCol - iRow))
)
qs
[0 .. iRow - 1]
--------------------------- TEST -------------------------
-- 10 columns of solutions for the 7*7 board:
showSolutions :: Int -> Int -> [String]
showSolutions nCols nSize =
unlines
. fmap (intercalate " ")
. transpose
. map boardLines
<$> chunksOf nCols (queenPuzzle nSize nSize)
where
go r x
| r == x = '♛'
| otherwise = '.'
boardLines rows =
[ go r <$> [1 .. (length rows)]
| r <- rows
]
chunksOf :: Int -> [a] -> [[a]]
chunksOf i = splits
where
splits [] = []
splits l = take i l : splits (drop i l)
main :: IO ()
main = (putStrLn . unlines) $ showSolutions 10 7

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

@ -0,0 +1,63 @@
import Control.Monad
import System.Environment
-- | data types for the puzzle
type Row = Int
type State = [Row]
type Thread = [Row]
-- | utility functions
empty = null
-- | Check for infeasible states
infeasible :: Int -> (State, Thread) -> Bool
infeasible n ([], _) = False
infeasible n ((r:rs),t) = length rs >= n || attack r rs || infeasible n (rs, t)
feasible n st = not $ infeasible n st
-- | Check if a row is attacking another row of a state
attack :: Row -> [Row] -> Bool
attack r rs = r `elem` rs
|| r `elem` (upperDiag rs)
|| r `elem` (lowerDiag rs)
where
upperDiag xs = zipWith (-) xs [1..]
lowerDiag xs = zipWith (+) xs [1..]
-- | Check if it is a goal state
isGoal :: Int -> (State, Thread) -> Bool
isGoal n (rs,t) = (feasible n (rs,t)) && (length rs == n)
-- | Perform a move
move :: Int -> (State, Thread) -> (State, Thread)
move x (s,t) = (x:s, x:t)
choices n = [1..n]
moves n = pure move <*> choices n
emptySt = ([],[])
-- | Breadth-first search
bfs :: Int -> [(State, Thread)] -> (State, Thread)
bfs n [] = error "Could not find a feasible solution"
bfs n sts | (not.empty) goal = head goal
| otherwise = bfs n sts2
where
goal = filter (isGoal n) sts2
sts2 = filter (feasible n) $ (moves n) <*> sts
-- | Depth-first search
dfs :: Int -> (State, Thread) -> [(State, Thread)]
dfs n st | isGoal n st = [st]
| infeasible n st = [emptySt]
| otherwise = do x <- [1..n]
st2 <- dfs n $ move x st
guard $ st2 /= emptySt
return st2
main = do
[narg] <- getArgs
let n = read narg :: Int
print (bfs n [emptySt])
print (head $ dfs n emptySt)

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("");
}
}
}
}

38
Task/N-queens-problem/IS-BASIC/n-queens-problem.basic Normal file
View file

@ -0,0 +1,38 @@
100 PROGRAM "NQueens.bas"
110 TEXT 80
120 DO
130 INPUT PROMPT "Size of board (2-12): ":N$
140 LET N=VAL(N$)
150 LOOP UNTIL N>1 AND N<13
160 NUMERIC A(1 TO N),X(1 TO N),B(2 TO 2*N),C(-N+1 TO N-1)
170 LET SOL=0
180 CALL INIT(A):CALL INIT(B):CALL INIT(C)
190 CALL TRY(1)
200 PRINT SOL;"solutions."
210 END
220 DEF WRITE
230 LET S$="":LET SOL=SOL+1
240 FOR K=1 TO N
250 LET S$=S$&CHR$(64+K)&STR$(X(K))&" "
260 NEXT
270 PRINT S$
280 END DEF
290 DEF TRY(I)
300 NUMERIC J
310 FOR J=1 TO N
320 IF A(J) AND B(I+J) AND C(I-J) THEN
330 LET X(I)=J:LET A(J),B(I+J),C(I-J)=0
340 IF I<N THEN
350 CALL TRY(I+1)
360 ELSE
370 CALL WRITE
380 END IF
390 LET A(J),B(I+J),C(I-J)=1
400 END IF
410 NEXT
420 END DEF
430 DEF INIT(REF T)
440 FOR I=LBOUND(T) TO UBOUND(T)
450 LET T(I)=1
460 NEXT
470 END DEF

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-1.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

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

@ -0,0 +1,2 @@
$queenst 8
92 8

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

@ -0,0 +1,2 @@
{.queenst 8
0 4 7 5 2 6 1 3

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--;
}
}
}
}

33
Task/N-queens-problem/JavaScript/n-queens-problem-1.js Normal file
View file

@ -0,0 +1,33 @@
function queenPuzzle(rows, columns) {
if (rows <= 0) {
return [[]];
} else {
return addQueen(rows - 1, columns);
}
}
function addQueen(newRow, columns, prevSolution) {
var newSolutions = [];
var prev = queenPuzzle(newRow, columns);
for (var i = 0; i < prev.length; i++) {
var solution = prev[i];
for (var newColumn = 0; newColumn < columns; newColumn++) {
if (!hasConflict(newRow, newColumn, solution))
newSolutions.push(solution.concat([newColumn]))
}
}
return newSolutions;
}
function hasConflict(newRow, newColumn, solution) {
for (var i = 0; i < newRow; i++) {
if (solution[i] == newColumn ||
solution[i] + i == newColumn + newRow ||
solution[i] - i == newColumn - newRow) {
return true;
}
}
return false;
}
console.log(queenPuzzle(8,8));

129
Task/N-queens-problem/JavaScript/n-queens-problem-2.js Normal file
View file

@ -0,0 +1,129 @@
(() => {
"use strict";
// ---------------- N QUEENS PROBLEM -----------------
// queenPuzzle :: Int -> Int -> [[Int]]
const queenPuzzle = intCols => {
// All solutions for a given number
// of columns and rows.
const go = nRows =>
nRows <= 0 ? [
[]
] : go(nRows - 1).reduce(
(a, solution) => [
...a, ...(
enumFromTo(0)(intCols - 1)
.reduce((b, iCol) =>
safe(
nRows - 1, iCol, solution
) ? (
[...b, [...solution, iCol]]
) : b, [])
)
], []
);
return go;
};
// safe : Int -> Int -> [Int] -> Bool
const safe = (iRow, iCol, solution) =>
!zip(solution)(
enumFromTo(0)(iRow - 1)
)
.some(
([sc, sr]) => (iCol === sc) || (
sc + sr === iCol + iRow
) || (sc - sr === iCol - iRow)
);
// ---------------------- TEST -----------------------
// Ten columns of solutions to the 7*7 board
// main :: IO ()
const main = () =>
// eslint-disable-next-line no-console
console.log(
showSolutions(10)(7)
);
// --------------------- DISPLAY ---------------------
// showSolutions :: Int -> Int -> String
const showSolutions = nCols =>
// Display of solutions, in nCols columns
// for a board of size N * N.
n => chunksOf(nCols)(
queenPuzzle(n)(n)
)
.map(xs => transpose(
xs.map(
rows => rows.map(
r => enumFromTo(1)(rows.length)
.flatMap(
x => r === x ? (
"♛"
) : "."
)
.join("")
)
)
)
.map(cells => cells.join(" "))
)
.map(x => x.join("\n"))
.join("\n\n");
// ---------------- GENERIC FUNCTIONS ----------------
// chunksOf :: Int -> [a] -> [[a]]
const chunksOf = n => {
// xs split into sublists of length n.
// The last sublist will be short if n
// does not evenly divide the length of xs .
const go = xs => {
const chunk = xs.slice(0, n);
return Boolean(chunk.length) ? [
chunk, ...go(xs.slice(n))
] : [];
};
return go;
};
// enumFromTo :: Int -> Int -> [Int]
const enumFromTo = m =>
n => Array.from({
length: 1 + n - m
}, (_, i) => m + i);
// transpose_ :: [[a]] -> [[a]]
const transpose = rows =>
// The columns of the input transposed
// into new rows.
// Simpler version of transpose, assuming input
// rows of even length.
Boolean(rows.length) ? rows[0].map(
(_, i) => rows.flatMap(
v => v[i]
)
) : [];
// zip :: [a] -> [b] -> [(a, b)]
const zip = xs =>
// The paired members of xs and ys, up to
// the length of the shorter of the two lists.
ys => Array.from({
length: Math.min(xs.length, ys.length)
}, (_, i) => [xs[i], ys[i]]);
// MAIN ---
return main();
})();

25
Task/N-queens-problem/Jq/n-queens-problem-1.jq Normal file
View file

@ -0,0 +1,25 @@
def single_solution_queens(n):
def q: "♛";
def init(k): reduce range(0;k) as $i ([]; . + ["."]);
def matrix(k): init(k) as $row | reduce range(0;k) as $i ([]; . + [$row]);
def place(stream; i; j):
# jq indexing is based on offsets but we are using the 1-based formulae:
reduce stream as $s (.; setpath([-1+($s|i), -1+($s|j)]; q) );
def even(k):
if ((k-2) % 6) != 0 then
place( range(1; 1+(k/2)); .; 2*. )
| place( range(1; 1+(k/2)); (k/2) + .; 2*. -1 )
else place( range(1; 1+(k/2)); .; 1 + ((2*. + (k/2) - 3) % k))
| place( range(1; 1+(n/2)); n + 1 - .; n - ((2*. + (n/2) - 3) % n))
end;
matrix(n) # the chess board
| if (n % 2) == 0 then even(n)
else even(n-1) | .[n-1][n-1] = q
end;
# Example:
def pp: reduce .[] as $row
(""; reduce $row[] as $x (.; . + $x) + "\n");
single_solution_queens(8) | pp

8
Task/N-queens-problem/Jq/n-queens-problem-2.jq Normal file
View file

@ -0,0 +1,8 @@
...♛....
.....♛..
.......♛
.♛......
......♛.
♛.......
..♛.....
....♛...

13
Task/N-queens-problem/Jq/n-queens-problem-3.jq Normal file
View file

@ -0,0 +1,13 @@
# permutations of 0 .. (n-1)
def permutations(n):
# Given a single array, generate a stream by inserting n at different positions:
def insert(m;n):
if m >= 0 then (.[0:m] + [n] + .[m:]), insert(m-1;n) else empty end;
if n==0 then []
elif n == 1 then [1]
else
permutations(n-1) | insert(n-1; n)
end;
def count(g): reduce g as $i (0; .+1);

16
Task/N-queens-problem/Jq/n-queens-problem-4.jq Normal file
View file

@ -0,0 +1,16 @@
def queens(n):
def sums:
. as $board
| [ range(0;length) | . + $board[.]]
| unique | length;
def differences:
. as $board
| [ range(0;length) | . - $board[.]]
| unique | length;
def allowable:
length as $n
| sums == $n and differences == $n;
count( permutations(n) | select(allowable) );

1
Task/N-queens-problem/Jq/n-queens-problem-5.jq Normal file
View file

@ -0,0 +1 @@
queens(8)

67
Task/N-queens-problem/Julia/n-queens-problem.julia Normal file
View file

@ -0,0 +1,67 @@
"""
# EightQueensPuzzle
Ported to **Julia** from examples in several languages from
here: https://hbfs.wordpress.com/2009/11/10/is-python-slow
"""
module EightQueensPuzzle
export Board, solve!
mutable struct Board
cols::Int
nodes::Int
diag45::Int
diag135::Int
solutions::Int
Board() = new(0, 0, 0, 0, 0)
end
"Marks occupancy."
function mark!(b::Board, k::Int, j::Int)
b.cols ⊻= (1 << j)
b.diag135 ⊻= (1 << (j+k))
b.diag45 ⊻= (1 << (32+j-k))
end
"Tests if a square is menaced."
function test(b::Board, k::Int, j::Int)
b.cols & (1 << j) +
b.diag135 & (1 << (j+k)) +
b.diag45 & (1 << (32+j-k)) == 0
end
"Backtracking solver."
function solve!(b::Board, niv::Int, dx::Int)
if niv > 0
for i in 0:dx-1
if test(b, niv, i) == true
mark!(b, niv, i)
solve!(b, niv-1, dx)
mark!(b, niv, i)
end
end
else
for i in 0:dx-1
if test(b, 0, i) == true
b.solutions += 1
end
end
end
b.nodes += 1
b.solutions
end
end # module
using .EightQueensPuzzle
for n = 1:17
b = Board()
@show n
print("elapsed:")
solutions = @time solve!(b, n-1, n)
@show solutions
println()
end

Some files were not shown because too many files have changed in this diff Show more