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

Data update

Browse source
This commit is contained in:
Ingy döt Net 2024-07-13 15:19:22 -07:00
parent 29a5eea0d4
commit 5c1bb7bfa9
2011 changed files with 35081 additions and 3229 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,31 +1,87 @@
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.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) ? ' ' : '.');
// In column order, print out the given positions in chess notation.
// For example, when N = 8, the first solution printed is:
// "a1 b5 c8 d6 e3 f7 g2 h4"
static void print_positions(int x[], const size_t n) {
static const char alphabet[] = "abcdefghijklmnopqrstuvwxyz";
return;
// There are only 26 letters in the ASCII alphabet, so
// so don't bother with chess notation above 26.
if (n <= 26) {
for (size_t i = 0; i < n; ++i)
printf("%c%u ", alphabet[i], x[i] + 1);
} else {
for (size_t i = 0; i < n; ++i)
printf("%u ", x[i] + 1);
}
putchar('\n');
}
# 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;
// Print all solutions to the N queens problem, holding the results in
// the intermediate array x, and with the auxiliary boolean arrays a, b, and c.
// x and a are both N elements long, while b and c are 2*N-1 elements long.
// It is assumed that these arrays are zeroed before this routine is called.
static void queens(int x[], bool a[], bool b[], bool c[], const size_t n) {
size_t col, row = 0;
hist[col] = i;
solve(n, col + 1, hist);
advance_row:
if (row >= n) {
print_positions(x, n);
goto backtrack;
}
col = 0;
try_column:
if (!a[col] && !b[col+row-1] && !c[col-row+n]) {
a[col] = true;
b[col+row-1] = true;
c[col-row+n] = true;
x[row] = col;
row++;
goto advance_row;
}
try_again:
if (col < n-1) {
col++;
goto try_column;
}
backtrack:
if (row != 0) {
--row;
col = x[row];
c[col-row+n] = false;
b[col+row-1] = false;
a[col] = false;
goto try_again;
}
}
int main(int n, char **argv)
{
if (n <= 1 || (n = atoi(argv[1])) <= 0) n = 8;
int hist[n];
solve(n, 0, hist);
static void *calloc_wrapper(size_t count, size_t bytesize) {
void *r;
if ((r = calloc(count, bytesize)) == NULL) {
exit(EXIT_FAILURE);
}
return r;
}
int main(int argc, char **argv) {
bool *a, *b, *c;
int n, *x;
if (argc != 2 || (n = atoi(argv[1])) <= 0) {
printf("%s: specify a natural number argument\n", argv[0]);
return 1;
}
x = calloc_wrapper(n, sizeof(x[0]));
a = calloc_wrapper(n, sizeof(a[0]));
b = calloc_wrapper((2 * n - 1), sizeof(b[0]));
c = calloc_wrapper((2 * n - 1), sizeof(c[0]));
queens(x, a, b, c, n);
// Don't bother freeing before exiting.
return 0;
}

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

@ -1,38 +1,31 @@
#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)
int count = 0;
void solve(int n, int col, int *hist)
{
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
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;
}
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);
# 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 || (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;
if (n <= 1 || (n = atoi(argv[1])) <= 0) n = 8;
int hist[n];
solve(n, 0, hist);
}

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

@ -1,91 +1,38 @@
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
typedef unsigned int uint;
uint count = 0;
typedef uint32_t uint;
uint full, *qs, count = 0, nn;
#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)
void solve(uint d, uint c, uint l, uint r)
{
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;
}
}
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;
}
count = cnt * 2;
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 c, char **v)
int main(int n, char **argv)
{
int nn;
if (c <= 1 || (nn = atoi(v[1])) <= 0) nn = 8;
if (n <= 1 || (nn = atoi(argv[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);
qs = calloc(nn, sizeof(int));
full = (1U << nn) - 1;
solve(nn, 0, 0, 0);
printf("\nSolutions: %d\n", count);
return 0;
}

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

@ -1,69 +1,91 @@
#include <stdio.h>
#define MAXN 31
#include <stdlib.h>
int nqueens(int n)
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 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;
int cnt = 0;
const uint full = -(int)(1 << (ulen - n));
register uint bits, pos, *m, d, e;
// 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]);
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);
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.
/* availabe columns on current row. m is stack */
bits = *(m = mm + 1) = full & ~(l[n] | r[n] | c[n]);
// 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;
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;
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;
/* 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;
}
main(int ac , char **av)
int main(int c, char **v)
{
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));
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-5.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));
}

55
Task/N-queens-problem/Commodore-BASIC/n-queens-problem.basic Normal file
View file

@ -0,0 +1,55 @@
100 REM N-QUEENS PROBLEM IN CBM BASIC 2
110 NQ = 8: GOSUB 200: IF A THEN NQ=A
120 PRINT CHR$(147) "SOLVING FOR" NQ "QUEENS"
130 DIM B(NQ), C(NQ), R(NQ):REM BOARD, COLUMN, ROW
140 SP = 0: REM STACK POINTER
150 TI$ = "000000": REM RESET TIMER
160 R(SP) = 0: SP = SP + 1: GOSUB 500: SP = SP - 1:REM PLACE.QUEEN(0)
170 PRINT "FOUND" SC "SOLUTIONS IN" TI / 60 "SECONDS"
180 END
190 REM
200 REM PARSE COMMAND-LINE ARGUMENT
210 P = 512
220 C = PEEK(P): P = P + 1: IF C <> 0 THEN 220
230 C = PEEK(P): P = P + 1: IF C = 78 THEN 290
240 A = 0
250 IF C = 0 THEN 290
260 IF C < 48 OR C > 57 THEN PRINT "USAGE: RUN:<NUMQUEENS>": END
270 A = A * 10 + C - 48
280 C = PEEK(P): P = P + 1: GOTO 250
290 RETURN
295 REM
300 REM COULD.PLACE(ROW, COL): BOOL
310 CP = -1
320 R = R(SP - 1): IF R = 0 THEN RETURN
330 C = C(SP - 1)
340 FOR I = 0 TO R - 1
350 : IF B(I) = C OR B(I) - I = C - R OR B(I) + I = C + R THEN CP = 0
360 : IF CP = 0 THEN I = R - 1
370 NEXT I
380 RETURN
390 REM
400 REM PRINT.SOLUTION
410 SC = SC + 1: PRINT CHR$(19) CHR$(17) CHR$(17) "FOUND SOLUTION" SC CHR$(13)
420 FOR I=0 TO NQ - 1
430 : PRINT " ";
440 : IF B(I) THEN N=B(I):CH=46:GOSUB 600
450 : PRINT "Q";
460 : IF B(I) < NQ - 1 THEN N=NQ - 1 - B(I):CH=46:GOSUB 600
470 : PRINT
480 NEXT I
490 PRINT: RETURN
495 REM PLACE.QUEEN(ROW)
500 IF R(SP - 1) = NQ THEN GOSUB 400: RETURN
510 C(SP - 1) = 0
520 IF C(SP - 1) = NQ THEN 590
530 GOSUB 300: IF CP = 0 THEN 570
540 B(R(SP - 1)) = C(SP - 1)
550 R(SP) = R(SP - 1) + 1: SP = SP + 1:GOSUB 500: SP = SP - 1
560 B(R(SP - 1)) = 0
570 C(SP - 1) = C(SP - 1) + 1
580 GOTO 520
590 RETURN
600 REM PRINT A CHARACTER N TIMES
610 FOR QQ=1 TO N:PRINT CHR$(CH);:NEXT
620 RETURN

109
Task/N-queens-problem/Pascal/n-queens-problem-1.pas
View file

@ -1,81 +1,34 @@
program queens;
program eightqueens(output);
var i: integer;
a: array [1..8] of boolean; { a[j]: no queen in row j }
b: array [2..16] of boolean; { b[k]: no queen in kth diagonal down-left }
c: array [-7..7] of boolean; { c[k]: no queen in kth diagonal down-right }
x: array [1..8] of integer; { x[i]: position of queen in column i }
procedure print;
var k: integer;
begin
for k := 1 to 8 do write(x[k]: 4);
writeln
end { print } ;
const l=16;
var i,j,k,m,n,p,q,r,y,z: integer;
a,s: array[1..l] of integer;
u: array[1..4*l-2] of integer;
label L3,L4,L5,L6,L7,L8,L9,L10;
procedure try(i: integer);
var j: integer;
begin
for j := 1 to 8 do
if a[j] and b[i+j] and c[i-j] then
begin
{ place queen }
x[i] := j;
a[j] := false; b[i+j] := false; c[i-j] := false;
if i < 8 then try(i+1) else print;
{ remove queen }
a[j] := true; b[i+j] := true; c[i-j] := true
end
end { try } ;
begin
for i:=1 to l do a[i]:=i;
for i:=1 to 4*l-2 do u[i]:=0;
for n:=1 to l do
begin
m:=0;
i:=1;
r:=2*n-1;
goto L4;
L3:
s[i]:=j;
u[p]:=1;
u[q+r]:=1;
i:=i+1;
L4:
if i>n then goto L8;
j:=i;
L5:
z:=a[i];
y:=a[j];
p:=i-y+n;
q:=i+y-1;
a[i]:=y;
a[j]:=z;
if (u[p]=0) and (u[q+r]=0) then goto L3;
L6:
j:=j+1;
if j<=n then goto L5;
L7:
j:=j-1;
if j=i then goto L9;
z:=a[i];
a[i]:=a[j];
a[j]:=z;
goto L7;
L8:
m:=m+1;
{ uncomment the following to print solutions }
{ write(n,' ',m,':');
for k:=1 to n do write(' ',a[k]);
writeln; }
L9:
i:=i-1;
if i=0 then goto L10;
p:=i-a[i]+n;
q:=i+a[i]-1;
j:=s[i];
u[p]:=0;
u[q+r]:=0;
goto L6;
L10:
writeln(n,' ',m);
end;
end.
{ 1 1
2 0
3 0
4 2
5 10
6 4
7 40
8 92
9 352
10 724
11 2680
12 14200
13 73712
14 365596
15 2279184
16 14772512 }
for i := 1 to 8 do a[i] := true;
for i := 2 to 16 do b[i] := true;
for i := -7 to 7 do c[i] := true;
try(1)
end .

183
Task/N-queens-problem/Pascal/n-queens-problem-2.pas
View file

@ -1,112 +1,81 @@
program NQueens;
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON}{$OPTIMIZATION REGVAR}{$OPTIMIZATION PeepHole}
{$OPTIMIZATION CSE}{$OPTIMIZATION ASMCSE}
{$ELSE}
{$Apptype console}
{$ENDIF}
program queens;
const l=16;
var i,j,k,m,n,p,q,r,y,z: integer;
a,s: array[1..l] of integer;
u: array[1..4*l-2] of integer;
label L3,L4,L5,L6,L7,L8,L9,L10;
uses
sysutils;// TDatetime
const
nmax = 17;
type
{$IFNDEF FPC}
NativeInt = longInt;
{$ENDIF}
//ala Nikolaus Wirth A-1 = H - 8
//diagonal left (A1) to rigth (H8)
tLR_diagonale = array[-nmax-1..nmax-1] of char;
//diagonal right (A8) to left (H1)
tRL_diagonale = array[0..2*nmax-2] of char;
//up to Col are the used Cols, after that the unused
tFreeCol = array[0..nmax-1] of nativeInt;
var
LR_diagonale:tLR_diagonale;
RL_diagonale:tRL_diagonale;
//Using pChar, cause it is implicit an array
//It is always set to
//@LR_diagonale[row] ,@RL_diagonale[row]
pLR,pRL : pChar;
FreeCol : tFreeCol;
i,
n : nativeInt;
gblCount : nativeUInt;
T0,T1 : TdateTime;
procedure Solution;
var
i : NativeInt;
begin
// Take's a lot of time under DOS/Win32
If gblCount AND $FFF = 0 then
write(gblCount:10,#8#8#8#8#8#8#8#8#8#8);
// IF n< 9 then
IF n < 0 then
for i:=1 to l do a[i]:=i;
for i:=1 to 4*l-2 do u[i]:=0;
for n:=1 to l do
begin
For i := 1 to n do
write(FreeCol[i]:4);
writeln;
m:=0;
i:=1;
r:=2*n-1;
goto L4;
L3:
s[i]:=j;
u[p]:=1;
u[q+r]:=1;
i:=i+1;
L4:
if i>n then goto L8;
j:=i;
L5:
z:=a[i];
y:=a[j];
p:=i-y+n;
q:=i+y-1;
a[i]:=y;
a[j]:=z;
if (u[p]=0) and (u[q+r]=0) then goto L3;
L6:
j:=j+1;
if j<=n then goto L5;
L7:
j:=j-1;
if j=i then goto L9;
z:=a[i];
a[i]:=a[j];
a[j]:=z;
goto L7;
L8:
m:=m+1;
{ uncomment the following to print solutions }
{ write(n,' ',m,':');
for k:=1 to n do write(' ',a[k]);
writeln; }
L9:
i:=i-1;
if i=0 then goto L10;
p:=i-a[i]+n;
q:=i+a[i]-1;
j:=s[i];
u[p]:=0;
u[q+r]:=0;
goto L6;
L10:
writeln(n,' ',m);
end;
end;
procedure SetQueen(Row:nativeInt);
var
i,Col : nativeInt;
begin
IF row <= n then
begin
For i := row to n do
begin
Col := FreeCol[i];
//check diagonals occupied
If (ORD(pLR[-Col]) AND ORD(pRL[Col]))<>0 then
begin
//a "free" position is found
//mark it
pRL[ Col]:=#0; //RL_Diagonale[ Row +Col] := 0;
pLR[-Col]:=#0; //LR_Diagonale[ Row -Col] := 0;
//swap FreeRow[Row<->i]
FreeCol[i] := FreeCol[Row];
//next row
inc(pRL);
inc(pLR);
FreeCol[Row] := Col;
// check next row
SetQueen(Row+1);
//Undo
dec(pLR);
dec(pRL);
FreeCol[Row] := FreeCol[i];
FreeCol[i] := Col;
pRL[ Col]:=#1;
pLR[-Col]:=#1;
end;
end;
end
else
begin
//solution ist found
inc(gblCount);
//Solution
end;
end;
begin
For i := 0 to nmax-1 do
FreeCol[i] := i;
//diagonals filled with True = #1 , something <>0
fillchar(LR_Diagonale[low(LR_Diagonale)],sizeof(tLR_Diagonale),#1);
fillchar(RL_Diagonale[low(RL_Diagonale)],sizeof(tRL_Diagonale),#1);
For n := 1 to nMax do
begin
t0 := time;
pLR:=@LR_Diagonale[0];
pRL:=@RL_Diagonale[0];
gblCount := 0;
SetQueen(1);
t1:= time;
WriteLn(n:6,gblCount:12,FormatDateTime(' NN:SS.ZZZ',T1-t0),' secs');
end;
WriteLn('Fertig');
end.
{ 1 1
2 0
3 0
4 2
5 10
6 4
7 40
8 92
9 352
10 724
11 2680
12 14200
13 73712
14 365596
15 2279184
16 14772512 }

112
Task/N-queens-problem/Pascal/n-queens-problem-3.pas Normal file
View file

@ -0,0 +1,112 @@
program NQueens;
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON}{$OPTIMIZATION REGVAR}{$OPTIMIZATION PeepHole}
{$OPTIMIZATION CSE}{$OPTIMIZATION ASMCSE}
{$ELSE}
{$Apptype console}
{$ENDIF}
uses
sysutils;// TDatetime
const
nmax = 17;
type
{$IFNDEF FPC}
NativeInt = longInt;
{$ENDIF}
//ala Nikolaus Wirth A-1 = H - 8
//diagonal left (A1) to rigth (H8)
tLR_diagonale = array[-nmax-1..nmax-1] of char;
//diagonal right (A8) to left (H1)
tRL_diagonale = array[0..2*nmax-2] of char;
//up to Col are the used Cols, after that the unused
tFreeCol = array[0..nmax-1] of nativeInt;
var
LR_diagonale:tLR_diagonale;
RL_diagonale:tRL_diagonale;
//Using pChar, cause it is implicit an array
//It is always set to
//@LR_diagonale[row] ,@RL_diagonale[row]
pLR,pRL : pChar;
FreeCol : tFreeCol;
i,
n : nativeInt;
gblCount : nativeUInt;
T0,T1 : TdateTime;
procedure Solution;
var
i : NativeInt;
begin
// Take's a lot of time under DOS/Win32
If gblCount AND $FFF = 0 then
write(gblCount:10,#8#8#8#8#8#8#8#8#8#8);
// IF n< 9 then
IF n < 0 then
begin
For i := 1 to n do
write(FreeCol[i]:4);
writeln;
end;
end;
procedure SetQueen(Row:nativeInt);
var
i,Col : nativeInt;
begin
IF row <= n then
begin
For i := row to n do
begin
Col := FreeCol[i];
//check diagonals occupied
If (ORD(pLR[-Col]) AND ORD(pRL[Col]))<>0 then
begin
//a "free" position is found
//mark it
pRL[ Col]:=#0; //RL_Diagonale[ Row +Col] := 0;
pLR[-Col]:=#0; //LR_Diagonale[ Row -Col] := 0;
//swap FreeRow[Row<->i]
FreeCol[i] := FreeCol[Row];
//next row
inc(pRL);
inc(pLR);
FreeCol[Row] := Col;
// check next row
SetQueen(Row+1);
//Undo
dec(pLR);
dec(pRL);
FreeCol[Row] := FreeCol[i];
FreeCol[i] := Col;
pRL[ Col]:=#1;
pLR[-Col]:=#1;
end;
end;
end
else
begin
//solution ist found
inc(gblCount);
//Solution
end;
end;
begin
For i := 0 to nmax-1 do
FreeCol[i] := i;
//diagonals filled with True = #1 , something <>0
fillchar(LR_Diagonale[low(LR_Diagonale)],sizeof(tLR_Diagonale),#1);
fillchar(RL_Diagonale[low(RL_Diagonale)],sizeof(tRL_Diagonale),#1);
For n := 1 to nMax do
begin
t0 := time;
pLR:=@LR_Diagonale[0];
pRL:=@RL_Diagonale[0];
gblCount := 0;
SetQueen(1);
t1:= time;
WriteLn(n:6,gblCount:12,FormatDateTime(' NN:SS.ZZZ',T1-t0),' secs');
end;
WriteLn('Fertig');
end.

30
Task/N-queens-problem/Python/n-queens-problem-7.py
View file

@ -1,23 +1,23 @@
def queens(n):
a = list(range(n))
up = [True]*(2*n - 1)
down = [True]*(2*n - 1)
def sub(i):
if i == n:
yield tuple(a)
else:
def queens(n: int):
def sub(i: int):
if i < n:
for k in range(i, n):
j = a[k]
p = i + j
q = i - j + n - 1
if up[p] and down[q]:
up[p] = down[q] = False
if b[i + j] and c[i - j]:
a[i], a[k] = a[k], a[i]
b[i + j] = c[i - j] = False
yield from sub(i + 1)
up[p] = down[q] = True
b[i + j] = c[i - j] = True
a[i], a[k] = a[k], a[i]
else:
yield a
a = list(range(n))
b = [True] * (2 * n - 1)
c = [True] * (2 * n - 1)
yield from sub(0)
#Count solutions for n=8:
sum(1 for p in queens(8))
sum(1 for p in queens(8)) # count solutions
92

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

@ -1,31 +1,29 @@
def queens_lex(n):
a = list(range(n))
up = [True]*(2*n - 1)
down = [True]*(2*n - 1)
def sub(i):
if i == n:
yield tuple(a)
else:
def queens_lex(n: int):
def sub(i: int):
if i < n:
for k in range(i, n):
j = a[k]
a[i], a[k] = a[k], a[i]
j = a[i]
p = i + j
q = i - j + n - 1
if up[p] and down[q]:
up[p] = down[q] = False
if b[i + j] and c[i - j]:
b[i + j] = c[i - j] = False
yield from sub(i + 1)
up[p] = down[q] = True
x = a[i]
for k in range(i + 1, n):
a[k - 1] = a[k]
a[n - 1] = x
b[i + j] = c[i - j] = True
a[i:(n - 1)], a[n - 1] = a[(i + 1):n], a[i]
else:
yield a
a = list(range(n))
b = [True] * (2 * n - 1)
c = [True] * (2 * n - 1)
yield from sub(0)
next(queens(31))
(0, 2, 4, 1, 3, 8, 10, 12, 14, 6, 17, 21, 26, 28, 25, 27, 24, 30, 7, 5, 29, 15, 13, 11, 9, 18, 22, 19, 23, 16, 20)
[0, 2, 4, 1, 3, 8, 10, 12, 14, 6, 17, 21, 26, 28, 25, 27, 24, 30, 7, 5, 29, 15, 13, 11, 9, 18, 22, 19, 23, 16, 20]
next(queens_lex(31))
(0, 2, 4, 1, 3, 8, 10, 12, 14, 5, 17, 22, 25, 27, 30, 24, 26, 29, 6, 16, 28, 13, 9, 7, 19, 11, 15, 18, 21, 23, 20)
[0, 2, 4, 1, 3, 8, 10, 12, 14, 5, 17, 22, 25, 27, 30, 24, 26, 29, 6, 16, 28, 13, 9, 7, 19, 11, 15, 18, 21, 23, 20]
#Compare to A065188
#1, 3, 5, 2, 4, 9, 11, 13, 15, 6, 8, 19, 7, 22, 10, 25, 27, 29, 31, 12, 14, 35, 37, ...

4
Task/N-queens-problem/Uiua/n-queens-problem.uiua Normal file
View file

@ -0,0 +1,4 @@
N ← 8
Good ← =1⧻◴[⧻◴⟜(∩(⧻◴)⊃+-⇡⧻.)⟜⧻]
⊙◌⍥(⊏⊚≡Good.☇1⊞⊂⇡,),[[]]N
≡(≡(/(⊂⊂)@|/⊂⍜(⊡|@Q◌):↯:@_)⊸⧻)