Knight's tour: Difference between revisions
m
→{{header|Wren}}: Changed to Wren S/H
Hendursaga (talk | contribs) m (Minor spelling fixes.) |
m (→{{header|Wren}}: Changed to Wren S/H) |
||
| (6 intermediate revisions by 3 users not shown) | |||
Line 972:
1| 12 25 14 31 10 27 36 61
</pre>
=={{header|ATS}}==
Line 2,030 ⟶ 1,948:
</pre>
=={{header|
==={{header|ANSI BASIC}}===
{{trans|BBC BASIC}}
[[File:Knights_Tour.gif|right]]
{{works with|Decimal BASIC}}
ANSI BASIC does not allow function parameters to be passed by reference, so X and Y were made global variables.
<syntaxhighlight lang="basic">100 DECLARE EXTERNAL FUNCTION choosemove
110 !
120 RANDOMIZE
130 PUBLIC NUMERIC X, Y, TRUE, FALSE
140 LET TRUE = -1
150 LET FALSE = 0
160 !
170 SET WINDOW 1,512,1,512
180 SET AREA COLOR "black"
190 FOR x=0 TO 512-128 STEP 128
200 FOR y=0 TO 512-128 STEP 128
210 PLOT AREA:x+64,y;x+128,y;x+128,y+64;x+64,y+64
220 PLOT AREA:x,y+64;x+64,y+64;x+64,y+128;x,y+128
230 NEXT y
240 NEXT x
250 !
260 SET LINE COLOR "red"
270 SET LINE WIDTH 6
280 !
290 PUBLIC NUMERIC Board(0 TO 7,0 TO 7)
300 LET X = 0
310 LET Y = 0
320 LET Total = 0
330 DO
340 LET Board(X,Y) = TRUE
350 PLOT LINES: X*64+32,Y*64+32;
360 LET Total = Total + 1
370 LOOP UNTIL choosemove(X, Y) = FALSE
380 IF Total <> 64 THEN STOP
390 END
400 !
410 EXTERNAL FUNCTION choosemove(X1, Y1)
420 DECLARE EXTERNAL SUB trymove
430 LET M = 9
440 CALL trymove(X1+1, Y1+2, M, newx, newy)
450 CALL trymove(X1+1, Y1-2, M, newx, newy)
460 CALL trymove(X1-1, Y1+2, M, newx, newy)
470 CALL trymove(X1-1, Y1-2, M, newx, newy)
480 CALL trymove(X1+2, Y1+1, M, newx, newy)
490 CALL trymove(X1+2, Y1-1, M, newx, newy)
500 CALL trymove(X1-2, Y1+1, M, newx, newy)
510 CALL trymove(X1-2, Y1-1, M, newx, newy)
520 IF M=9 THEN
530 LET choosemove = FALSE
540 EXIT FUNCTION
550 END IF
560 LET X = newx
570 LET Y = newy
580 LET choosemove = TRUE
590 END FUNCTION
600 !
610 EXTERNAL SUB trymove(X, Y, M, newx, newy)
620 !
630 DECLARE EXTERNAL FUNCTION validmove
640 IF validmove(X,Y) = 0 THEN EXIT SUB
650 IF validmove(X+1,Y+2) <> 0 THEN LET N = N + 1
660 IF validmove(X+1,Y-2) <> 0 THEN LET N = N + 1
670 IF validmove(X-1,Y+2) <> 0 THEN LET N = N + 1
680 IF validmove(X-1,Y-2) <> 0 THEN LET N = N + 1
690 IF validmove(X+2,Y+1) <> 0 THEN LET N = N + 1
700 IF validmove(X+2,Y-1) <> 0 THEN LET N = N + 1
710 IF validmove(X-2,Y+1) <> 0 THEN LET N = N + 1
720 IF validmove(X-2,Y-1) <> 0 THEN LET N = N + 1
730 IF N>M THEN EXIT SUB
740 IF N=M AND RND<.5 THEN EXIT SUB
750 LET M = N
760 LET newx = X
770 LET newy = Y
780 END SUB
790 !
800 EXTERNAL FUNCTION validmove(X,Y)
810 LET validmove = FALSE
820 IF X<0 OR X>7 OR Y<0 OR Y>7 THEN EXIT FUNCTION
830 IF Board(X,Y)=FALSE THEN LET validmove = TRUE
840 END FUNCTION</syntaxhighlight>
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
[[Image:knights_tour_bbc.gif|right]]
Line 3,167:
d6 -> e4 -> c5 -> d3 -> e1 -> g2 -> h4 -> f5
d4 -> e2 -> f4 -> e6 -> g5 -> f3 -> g1 -> h3</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|Forms,Types,SysUtils,Graphics,ExtCtrls}}
[[File:DelphiKnightsTour.png|thumb|none]]
Brute force method. Takes a long time for most solutions, so some optimization should be used. However, it has nice graphics.
<syntaxhighlight lang="Delphi">
{ These routines would normally be in a library,
but are presented here for clarity }
function PointAdd(V1,V2: TPoint): TPoint;
{Add V1 and V2}
begin
Result.X:= V1.X+V2.X;
Result.Y:= V1.Y+V2.Y;
end;
const KnightMoves: array [0..7] of TPoint = (
(X: 2; Y:1),(X: 2; Y:-1),
(X:-2; Y:1),(X:-2; Y:-1),
(X:1; Y: 2),(X:-1; Y: 2),
(X:1; Y:-2),(X:-1; Y:-2));
var Board: array [0..7,0..7] of boolean;
var Path: array of TPoint;
var CellSize,BoardSize: integer;
var CurPos: TPoint;
var BestPath: integer;
{-------------------------------------------------------------}
procedure DrawBestPath(Image: TImage);
begin
Image.Canvas.TextOut(BoardSize+5,5, IntToStr(BestPath));
end;
procedure PushPath(P: TPoint);
begin
SetLength(Path,Length(Path)+1);
Path[High(Path)]:=P;
if Length(Path)>BestPath then BestPath:=Length(Path);
end;
function PopPath: TPoint;
begin
if Length(Path)<1 then exit;
Result:=Path[High(Path)];
SetLength(Path,Length(Path)-1);
end;
procedure ClearPath;
begin
SetLength(Path,0);
end;
{-------- Routines to draw chess board and path --------------}
function GetCellCenter(P: TPoint): TPoint;
{Get pixel position of the center of cell}
begin
Result.X:=CellSize div 2 + CellSize * P.X;
Result.Y:=CellSize div 2 + CellSize * P.Y;
end;
procedure DrawPoint(Canvas: TCanvas; P: TPoint);
{Draw a point on the board}
begin
Canvas.Pen.Color:=clYellow;
Canvas.MoveTo(P.X-1,P.Y-1);
Canvas.LineTo(P.X+1,P.Y+1);
Canvas.MoveTo(P.X+1,P.Y-1);
Canvas.LineTo(P.X-1,P.Y+1);
end;
procedure DrawPathLine(Canvas: TCanvas; P1,P2: TPoint);
{Draw the path line}
var PS1,PS2: TPoint;
begin
PS1:=GetCellCenter(P1);
PS2:=GetCellCenter(P2);
Canvas.Pen.Width:=5;
Canvas.Pen.Color:=clRed;
Canvas.MoveTo(PS1.X,PS1.Y);
Canvas.LineTo(PS2.X,PS2.Y);
DrawPoint(Canvas,PS1);
DrawPoint(Canvas,PS2);
end;
procedure DrawPath(Canvas: TCanvas);
{Draw all points on the path}
var I: integer;
begin
for I:=0 to High(Path)-1 do
begin
DrawPathLine(Canvas, Path[I],Path[I+1]);
end;
end;
procedure DrawBoard(Canvas: TCanvas);
{Draw the chess board}
var R,R2: TRect;
var X,Y: integer;
var Color: TColor;
begin
Canvas.Pen.Color:=clBlack;
R:=Rect(0,0,BoardSize,BoardSize);
Canvas.Rectangle(R);
R:=Rect(0,0,CellSize,CellSize);
for Y:=0 to High(Board[0]) do
for X:=0 to High(Board) do
begin
R2:=R;
if ((X+Y) mod 2)=0 then Color:=clWhite
else Color:=clBlack;
Canvas.Brush.Color:=Color;
OffsetRect(R2,X * CellSize, Y * CellSize);
Canvas.Rectangle(R2);
end;
DrawPath(Canvas);
end;
function AllVisited: boolean;
{Test if all squares have been visit by path}
var X,Y: integer;
begin
Result:=False;
for Y:=0 to High(Board[0]) do
for X:=0 to High(Board) do
if not Board[X,Y] then exit;
Result:=True;
end;
procedure ClearBoard;
{Clear all board positions}
var X,Y: integer;
begin
for Y:=0 to High(Board[0]) do
for X:=0 to High(Board) do
Board[X,Y]:=False;
end;
function IsValidMove(Pos,Move: TPoint): boolean;
{Test if potential move is valid}
var NP: TPoint;
begin
Result:=False;
NP:=PointAdd(Pos,Move);
if (NP.X<0) or (NP.X>High(Board)) or
(NP.Y<0) or (NP.Y>High(Board[0])) then exit;
if Board[NP.X,NP.Y] then exit;
Result:=True;
end;
procedure ConfigureScreen(Image: TImage);
{Configure screen size}
begin
if Image.Width<Image.Height then BoardSize:=Image.Width
else BoardSize:=Image.Height;
CellSize:=BoardSize div 8;
end;
procedure SetPosition(Image: TImage; P: TPoint; Value: boolean);
{Set a new position by adding it to path}
{Marking position as used and redrawing board}
begin
if Value then PushPath(P)
else P:=PopPath;
Board[P.X,P.Y]:=Value;
DrawBoard(Image.Canvas);
DrawBestPath(Image);
Image.Repaint;
end;
procedure TryAllMoves(Image: TImage; Pos: TPoint);
{Recursively try all moves}
var I: integer;
var NewPos: TPoint;
begin
SetPosition(Image,Pos,True);
if AllVisited then exit;
for I:=0 to High(KnightMoves) do
begin
if AbortFlag then Exit;
if IsValidMove(Pos,KnightMoves[I]) then
begin
NewPos:=PointAdd(Pos,KnightMoves[I]);
TryAllMoves(Image,NewPos);
end;
end;
SetPosition(Image,Pos,False);
Application.ProcessMessages;
end;
procedure DoKnightsTour(Image: TImage);
{Solve Knights tour by testing all paths}
begin
BestPath:=0;
ConfigureScreen(Image);
ClearPath;
ClearBoard;
DrawBoard(Image.Canvas);
TryAllMoves(Image, Point(0,0));
end;
</syntaxhighlight>
{{out}}
<pre>
</pre>
=={{header|EchoLisp}}==
Line 4,180 ⟶ 4,416:
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/Knight%27s_tour}}
=={{header|Fortran}}==
Line 11,293 ⟶ 11,525:
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="
construct new(x, y) {
_x = x
| |||