Data update

This commit is contained in:
Ingy döt Net 2024-11-04 20:28:54 -08:00
parent 52a6ef48dd
commit 157b70a810
604 changed files with 14253 additions and 2100 deletions

View file

@ -1,26 +1,24 @@
# N-queens problem #
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
INT x = b[y];
BOOL safe := TRUE;
FOR i TO y - LWB b WHILE safe DO
INT t = b[y - i];
IF t = x THEN safe := FALSE
ELIF t = x - i THEN safe := FALSE
ELIF t = x + i THEN safe := FALSE
FI
OD;
FALSE EXIT
break true:
TRUE
NOT safe
);
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
@ -30,15 +28,12 @@ PROC print board = VOID:(
OD
);
main: (
# 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
WHILE y >= LWB b DO
WHILE IF (b[y]+:=1) <= 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

View file

@ -1,4 +1,6 @@
templates queens
data done <=1> local
def n: $;
templates getRowColumn
when <?($@queens.freeRows($.r::raw) <=0>)> do 0 !
@ -14,8 +16,6 @@ templates queens
@queens.freeMins($p.c::raw - $p.r::raw + $n): $p.val::raw;
end setRowColumn
data done <=1>
templates placeQueen
def c: $;
row´1 -> #

View file

@ -0,0 +1,52 @@
queens templates
done requires <|=1>
failed requires <|=0>
n is $;
getRowColumn templates
when <|?($@queens(freeRows:; $(r:)::raw) matches <|=0>)> do 0 !
when <|?($@queens(freeMaxs:; $(r:)::raw + $(c:)::raw) matches <|=0>)> do 0 !
when <|?($@queens(freeMins:; $(c:)::raw - $(r:)::raw + $n) matches <|=0>)> do 0 !
otherwise 1!
end getRowColumn
setRowColumn sink
p is $;
@queens(freeRows:; $p(r:)::raw) set $p(val:)::raw;
@queens(freeMaxs:; $p(c:)::raw + $p(r:)::raw) set $p(val:)::raw;
@queens(freeMins:; $p(c:)::raw - $p(r:)::raw + $n) set $p(val:)::raw;
end setRowColumn
placeQueen templates
{c: $, r: 1} -> # !
when <|done> do done´1!
when <|{c: <|$n + 1..>}> do done´1!
when <|{r: <|$n + 1..>}> do failed´0 !
when <|?($ -> getRowColumn matches <|=1>)> do
current is $;
@queens(queenRows:; $(r:)::raw) set $(c:);
{$, val: 0} -> !setRowColumn
{c: $(c:)::raw + 1, r: 1} -> # -> templates
when <|done> do done´1!
otherwise
{$current, val: 1} -> !setRowColumn
{c: $current(c:), r: $current(r:)::raw + 1} !
end -> # !
otherwise {c: $(c:), r: $(r:)::raw + 1} -> # !
end placeQueen
@ set { freeRows: [1..$n -> 1],
freeMaxs: [1..$n*2 -> 1],
freeMins: [1..$n*2 -> 1],
queenRows: [1..$n -> -1] };
1 -> placeQueen -> templates
when <|done> do $@queens(queenRows:) !
otherwise 'non-existent'!
end!
end queens
'A solution to the 8 queens problem is $:8 -> queens;
' !
'A solution to the 4 queens problem is $:4 -> queens;
' !
'A solution to the 3 queens problem is $:3 -> queens;
' !