Knight's tour: Difference between revisions

m
→‎{{header|Wren}}: Changed to Wren S/H
No edit summary
m (→‎{{header|Wren}}: Changed to Wren S/H)
(37 intermediate revisions by 9 users not shown)
Line 25:
{{trans|Python}}
 
<langsyntaxhighlight lang="11l">V _kmoves = [(2, 1), (1, 2), (-1, 2), (-2, 1), (-2, -1), (-1, -2), (1, -2), (2, -1)]
 
F chess2index(=chess, boardsize)
Line 81:
V board = knights_tour(start, boardsize)
print(boardstring(board, boardsize' boardsize))
print()</langsyntaxhighlight>
 
{{out}}
Line 124:
=={{header|360 Assembly}}==
{{trans|BBC PASIC}}
<langsyntaxhighlight lang="360asm">* Knight's tour 20/03/2017
KNIGHT CSECT
USING KNIGHT,R13 base registers
Line 378:
PG DC CL128' ' buffer
YREGS
END KNIGHT</langsyntaxhighlight>
{{out}}
<pre>
Line 396:
First, we specify a naive implementation the package Knights_Tour with naive backtracking. It is a bit more general than required for this task, by providing a mechanism '''not''' to visit certain coordinates. This mechanism is actually useful for the task [[Solve a Holy Knight's tour#Ada]], which also uses the package Knights_Tour.
 
<langsyntaxhighlight Adalang="ada">generic
Size: Integer;
package Knights_Tour is
Line 417:
-- writes The_Tour to the output using Ada.Text_IO;
end Knights_Tour;</langsyntaxhighlight>
 
Here is the implementation:
 
<langsyntaxhighlight Adalang="ada">with Ada.Text_IO, Ada.Integer_Text_IO;
package body Knights_Tour is
Line 505:
end Tour_IO;
end Knights_Tour;</langsyntaxhighlight>
 
Here is the main program:
 
<langsyntaxhighlight Adalang="ada">with Knights_Tour, Ada.Command_Line;
 
procedure Test_Knight is
Line 519:
begin
KT.Tour_IO(KT.Get_Tour(1, 1));
end Test_Knight;</langsyntaxhighlight>
 
For small sizes, this already works well (< 1 sec for size 8). Sample output:
Line 533:
 
For larger sizes we'll use Warnsdorff's heuristic (without any thoughtful tie breaking). We enhance the specification adding a function Warnsdorff_Get_Tour. This enhancement of the package Knights_Tour will also be used for the task [[Solve a Holy Knight's tour#Ada]]. The specification of Warnsdorff_Get_Tour is the following.
<syntaxhighlight lang="ada">
<lang Ada>
function Warnsdorff_Get_Tour(Start_X, Start_Y: Index; Scene: Tour := Empty)
return Tour;
-- uses Warnsdorff heurisitic to find a tour faster
-- same interface as Get_Tour</langsyntaxhighlight>
 
Its implementation is as follows.
 
<langsyntaxhighlight Adalang="ada"> function Warnsdorff_Get_Tour(Start_X, Start_Y: Index; Scene: Tour := Empty)
return Tour is
Done: Boolean;
Line 626:
end if;
return Visited;
end Warnsdorff_Get_Tour;</langsyntaxhighlight>
 
The modification for the main program is trivial:
<langsyntaxhighlight Adalang="ada">with Knights_Tour, Ada.Command_Line;
 
procedure Test_Fast is
Line 639:
begin
KT.Tour_IO(KT.Warnsdorff_Get_Tour(1, 1));
end Test_Fast;</langsyntaxhighlight>
 
This works still well for somewhat larger sizes:
Line 670:
=={{header|ALGOL 68}}==
{{works with|ALGOL 68G|Any - tested with release 2.8.win32}}
<langsyntaxhighlight lang="algol68"># Non-recursive Knight's Tour with Warnsdorff's algorithm #
# If there are multiple choices, backtrack if the first choice doesn't #
# find a solution #
Line 957:
FI
 
)</langsyntaxhighlight>
{{out}}
<pre>
Line 973:
</pre>
 
=={{header|ANSI Standard BASICATS}}==
<syntaxhighlight lang="ats">(*
{{trans|BBC BASIC}}
Find Knight’s Tours.
[[File:Knights_Tour.gif|right]]
 
Using Warnsdorff’s heuristic, find multiple solutions.
ANSI BASIC doesn't allow function parameters to be passed by reference so X and Y were made global variables.
Optionally accept only closed tours.
 
Compile with:
<lang ANSI Standard BASIC>100 DECLARE EXTERNAL FUNCTION choosemove
patscc -O3 -DATS_MEMALLOC_GCBDW -o knights_tour knights_tour.dats -lgc
110 !
 
120 RANDOMIZE
Usage: ./knights_tour [START_POSITION [MAX_TOURS [closed]]]
130 PUBLIC NUMERIC X, Y, TRUE, FALSE
Examples:
140 LET TRUE = -1
./knights_tour (prints one tour starting from a1)
150 LET FALSE = 0
./knights_tour c5
160 !
./knights_tour c5 2000
170 SET WINDOW 1,512,1,512
./knights_tour c5 2000 closed
180 SET AREA COLOR "black"
*)
190 FOR x=0 TO 512-128 STEP 128
 
200 FOR y=0 TO 512-128 STEP 128
#define ATS_DYNLOADFLAG 0 (* No initialization is needed. *)
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
#include "share/atspre_define.hats"
230 NEXT y
#include "share/atspre_staload.hats"
240 NEXT x
 
250 !
#define EMPTY_SQUARE ~1
260 SET LINE COLOR "red"
macdef nil_move = @(~1, ~1)
270 SET LINE WIDTH 6
 
280 !
fn
290 PUBLIC NUMERIC Board(0 TO 7,0 TO 7)
int_right_justified
300 LET X = 0
{i : int}
310 LET Y = 0
{n : int | 0 <= n; n < 100}
320 LET Total = 0
(i : int i,
330 DO
n : int n) :
340 LET Board(X,Y) = TRUE
string =
350 PLOT LINES: X*64+32,Y*64+32;
let
360 LET Total = Total + 1
var buffer : @[char][100] = @[char][100] ('\0')
370 LOOP UNTIL choosemove(X, Y) = FALSE
val _ = $extfcall (int, "snprintf", buffer, 100, "%*i", n, i)
380 IF Total <> 64 THEN STOP
in
390 END
strnptr2string (string1_copy ($UNSAFE.cast{string n} buffer))
400 !
end
410 EXTERNAL FUNCTION choosemove(X1, Y1)
 
420 DECLARE EXTERNAL SUB trymove
typedef move_t (i : int,
430 LET M = 9
j : int) =
440 CALL trymove(X1+1, Y1+2, M, newx, newy)
@(int i, int j)
450 CALL trymove(X1+1, Y1-2, M, newx, newy)
typedef move_t =
460 CALL trymove(X1-1, Y1+2, M, newx, newy)
[i, j : int]
470 CALL trymove(X1-1, Y1-2, M, newx, newy)
move_t (i, j)
480 CALL trymove(X1+2, Y1+1, M, newx, newy)
 
490 CALL trymove(X1+2, Y1-1, M, newx, newy)
fn
500 CALL trymove(X1-2, Y1+1, M, newx, newy)
move_t_is_nil (move : move_t) :<>
510 CALL trymove(X1-2, Y1-1, M, newx, newy)
bool =
520 IF M=9 THEN
let
530 LET choosemove = FALSE
val @(i, j) = move
540 EXIT FUNCTION
val @(i_nil, j_nil) = nil_move
550 END IF
in
560 LET X = newx
(i = i_nil && j = j_nil)
570 LET Y = newy
end
580 LET choosemove = TRUE
 
590 END FUNCTION
fn
600 !
move_t_fprint (f : FILEref,
610 EXTERNAL SUB trymove(X, Y, M, newx, newy)
move : move_t) :
620 !
void =
630 DECLARE EXTERNAL FUNCTION validmove
let
640 IF validmove(X,Y) = 0 THEN EXIT SUB
val @(i, j) = move
650 IF validmove(X+1,Y+2) <> 0 THEN LET N = N + 1
val letter = char2i 'a' + j - 1
660 IF validmove(X+1,Y-2) <> 0 THEN LET N = N + 1
val digit = char2i '0' + i
670 IF validmove(X-1,Y+2) <> 0 THEN LET N = N + 1
in
680 IF validmove(X-1,Y-2) <> 0 THEN LET N = N + 1
fileref_putc (f, letter);
690 IF validmove(X+2,Y+1) <> 0 THEN LET N = N + 1
fileref_putc (f, digit);
700 IF validmove(X+2,Y-1) <> 0 THEN LET N = N + 1
end
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
vtypedef chessboard_vt (t : t@ype,
730 IF N>M THEN EXIT SUB
n_ranks : int,
740 IF N=M AND RND<.5 THEN EXIT SUB
n_files : int,
750 LET M = N
p : addr) =
760 LET newx = X
@{
770 LET newy = Y
pf_board = @[t][n_ranks * n_files] @ p |
780 END SUB
n_ranks = uint n_ranks,
790 !
n_files = uint n_files,
800 EXTERNAL FUNCTION validmove(X,Y)
n_squares = uint (n_ranks * n_files),
810 LET validmove = FALSE
p_board = ptr p
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
vtypedef chessboard_vt (t : t@ype,
840 END FUNCTION</lang>
n_ranks : int,
n_files : int) =
[p : addr]
chessboard_vt (t, n_ranks, n_files, p)
vtypedef chessboard_vt (t : t@ype) =
[n_ranks, n_files : int]
chessboard_vt (t, n_ranks, n_files)
 
fn {t : t@ype}
chessboard_vt_make
{n_ranks, n_files : pos}
(n_ranks : uint n_ranks,
n_files : uint n_files,
fill : t) :
chessboard_vt (t, n_ranks, n_files) =
let
val size = u2sz (n_ranks * n_files)
val @(pf, pfgc | p) = array_ptr_alloc<t> (size)
val _ = array_initize_elt<t> (!p, size, fill)
prval _ = mfree_gc_v_elim pfgc (* Let the memory leak. *)
in
@{
pf_board = pf |
n_ranks = n_ranks,
n_files = n_files,
n_squares = n_ranks * n_files,
p_board = p
}
end
 
fn {t : t@ype}
chessboard_vt_get
{n_ranks, n_files : pos}
{i, j : int}
(chessboard : !chessboard_vt (t, n_ranks, n_files),
i : int i,
j : int j) :
t =
let
val index = (i - 1) + (u2i (chessboard.n_ranks) * (j - 1))
val _ = assertloc (0 <= index)
val _ = assertloc (index < u2i (chessboard.n_squares))
in
array_get_at (!(chessboard.p_board), index)
end
 
fn {t : t@ype}
chessboard_vt_set
{n_ranks, n_files : pos}
{i, j : int}
(chessboard : !chessboard_vt (t, n_ranks, n_files),
i : int i,
j : int j,
value : t) :
void =
let
val index = (i - 1) + (u2i (chessboard.n_ranks) * (j - 1))
val _ = assertloc (0 <= index)
val _ = assertloc (index < u2i (chessboard.n_squares))
in
array_set_at (!(chessboard.p_board), index, value)
end
 
extern fn {t : t@ype}
find_nth_position$equal (x : t,
y : t) :
bool
 
fn {t : t@ype}
find_nth_position
{n_ranks, n_files : pos}
(chessboard : !chessboard_vt (t, n_ranks, n_files),
n : t) :
[i, j : int]
move_t (i, j) =
let
val n_ranks = chessboard.n_ranks
val n_files = chessboard.n_files
 
fun
outer_loop {i : pos | i <= n_ranks + 1} .<n_ranks + 1 - i>.
(chessboard : !chessboard_vt (t, n_ranks, n_files),
i : int i) :
[i, j : int]
move_t (i, j) =
let
fun
inner_loop {j : pos | j <= n_files + 1} .<n_files + 1 - j>.
(chessboard : !chessboard_vt (t, n_ranks, n_files),
j : int j) :
[j : int]
int j =
if u2i n_files < j then
j
else
let
val v = chessboard_vt_get<t> (chessboard, i, j)
in
if find_nth_position$equal<t> (n, v) then
j
else
inner_loop (chessboard, succ j)
end
in
if u2i n_ranks < i then
nil_move
else
let
val j = inner_loop (chessboard, 1)
in
if j <= u2i n_files then
@(i, j)
else
outer_loop (chessboard, succ i)
end
end
in
outer_loop (chessboard, 1)
end
 
implement
find_nth_position$equal<int> (x, y) =
x = y
 
fn
knights_tour_is_closed
{n_ranks, n_files : pos}
(chessboard : !chessboard_vt (int, n_ranks, n_files)) :
bool =
let
val n_squares = chessboard.n_squares
val @(i1, j1) = find_nth_position<int> (chessboard, 1)
val @(i2, j2) = find_nth_position<int> (chessboard, u2i n_squares)
val i_diff = abs (i1 - i2)
val j_diff = abs (j1 - j2)
in
(i_diff = 1 && j_diff = 2) || (i_diff = 2 && j_diff = 1)
end
 
fn
knights_tour_board_fprint
{n_ranks, n_files : pos}
(f : FILEref,
chessboard : !chessboard_vt (int, n_ranks, n_files)) :
void =
{
val n_ranks = chessboard.n_ranks
val n_files = chessboard.n_files
 
fun
outer_loop {i : int | 0 <= i; i <= n_ranks} .<i>.
(chessboard : !chessboard_vt (int, n_ranks, n_files),
i : int i) :
void =
if 0 < i then
{
val _ = fileref_puts (f, " ")
val _ =
let
var j : [j : int] int j
in
for (j := 1; j <= u2i n_files; j := succ j)
fileref_puts (f, "+----")
end
val _ = fileref_puts (f, "+\n")
val _ = fileref_puts (f, int_right_justified (i, 2))
val _ = fileref_puts (f, " ")
 
fun
inner_loop {j : int | 1 <= j; j <= n_files + 1}
(chessboard : !chessboard_vt (int, n_ranks,
n_files),
j : int j) :
void =
if j <= u2i n_files then
{
val v = chessboard_vt_get<int> (chessboard, i, j)
val v = g1ofg0 v
val _ = fileref_puts (f, " | ")
val _ =
if v = EMPTY_SQUARE then
fileref_puts (f, " ")
else
fileref_puts (f, int_right_justified (g1ofg0 v, 2))
val _ = inner_loop (chessboard, succ j)
}
 
val _ = inner_loop (chessboard, 1)
val _ = fileref_puts (f, " |\n")
 
val _ = outer_loop (chessboard, pred i)
}
val _ = outer_loop (chessboard, u2i n_ranks)
val _ = fileref_puts (f, " ")
val _ =
let
var j : [j : int] int j
in
for (j := 1; j <= u2i n_files; j := succ j)
fileref_puts (f, "+----")
end
val _ = fileref_puts (f, "+\n")
val _ = fileref_puts (f, " ")
val _ =
let
var j : [j : int] int j
in
for (j := 1; j <= u2i n_files; j := succ j)
let
val letter = char2i 'a' + j - 1
in
fileref_puts (f, " ");
fileref_putc (f, letter)
end
end
}
 
fn
knights_tour_moves_fprint
{n_ranks, n_files : pos}
(f : FILEref,
chessboard : !chessboard_vt (int, n_ranks, n_files)) :
void =
{
prval _ = mul_pos_pos_pos (mul_make {n_ranks, n_files} ())
 
val n_ranks = chessboard.n_ranks
val n_files = chessboard.n_files
val n_squares = chessboard.n_squares
 
val @(pf, pfgc | p_positions) =
array_ptr_alloc<move_t> (u2sz n_squares)
val _ = array_initize_elt<move_t> (!p_positions, u2sz n_squares,
nil_move)
 
macdef positions = !p_positions
 
fun
loop {k : int | 0 <= k; k <= n_ranks * n_files}
.<n_ranks * n_files - k>.
(positions : &(@[move_t][n_ranks * n_files]),
chessboard : !chessboard_vt (int, n_ranks, n_files),
k : int k) :
void =
if k < u2i n_squares then
{
val i = u2i ((i2u k) mod n_ranks) + 1
val j = u2i ((i2u k) / n_ranks) + 1
val v = chessboard_vt_get<int> (chessboard, i, j)
val v = g1ofg0 v
val _ = assertloc (1 <= v)
val _ = assertloc (v <= u2i n_squares)
val _ = positions[v - 1] := @(i, j)
val _ = loop (positions, chessboard, succ k)
}
val _ = loop (positions, chessboard, 0)
 
fun
loop {k : int | 0 <= k; k < n_ranks * n_files}
.<n_ranks * n_files - k>.
(positions : &(@[move_t][n_ranks * n_files]),
k : int k) :
void =
if k < u2i (pred n_squares) then
{
val _ = move_t_fprint (f, positions[k])
val line_end = (((i2u (k + 1)) mod n_files) = 0U)
val _ =
fileref_puts (f, (if line_end then " ->\n" else " -> "))
val _ = loop (positions, succ k)
}
val _ = loop (positions, 0)
val _ = move_t_fprint (f, positions[pred n_squares])
val _ =
if knights_tour_is_closed (chessboard) then
fileref_puts (f, " -> cycle")
 
val _ = array_ptr_free (pf, pfgc | p_positions)
}
 
typedef knights_moves_t =
@(move_t, move_t, move_t, move_t,
move_t, move_t, move_t, move_t)
 
fn
possible_moves {n_ranks, n_files : pos}
{i, j : int}
(chessboard : !chessboard_vt (int, n_ranks, n_files),
i : int i,
j : int j) :
knights_moves_t =
let
fn
try_move {istride, jstride : int}
(chessboard : !chessboard_vt (int, n_ranks, n_files),
istride : int istride,
jstride : int jstride) :
move_t =
let
val i1 = i + istride
val j1 = j + jstride
in
if i1 < 1 then
nil_move
else if u2i (chessboard.n_ranks) < i1 then
nil_move
else if j1 < 1 then
nil_move
else if u2i (chessboard.n_files) < j1 then
nil_move
else
let
val v = chessboard_vt_get (chessboard, i1, j1) : int
in
if v <> EMPTY_SQUARE then
nil_move
else
@(i1, j1)
end
end
 
val move0 = try_move (chessboard, 1, 2)
val move1 = try_move (chessboard, 2, 1)
val move2 = try_move (chessboard, 1, ~2)
val move3 = try_move (chessboard, 2, ~1)
val move4 = try_move (chessboard, ~1, 2)
val move5 = try_move (chessboard, ~2, 1)
val move6 = try_move (chessboard, ~1, ~2)
val move7 = try_move (chessboard, ~2, ~1)
in
@(move0, move1, move2, move3, move4, move5, move6, move7)
end
 
fn
count_following_moves
{n_ranks, n_files : pos}
{i, j : int}
{n_position : int}
(chessboard : !chessboard_vt (int, n_ranks, n_files),
move : move_t (i, j),
n_position : int n_position) :
uint =
if move_t_is_nil move then
0U
else
let
fn
succ_if_move_is_not_nil
{i, j : int}
(w : uint,
move : move_t (i, j)) :<>
uint =
if move_t_is_nil move then
w
else
succ w
 
val @(i, j) = move
val _ = chessboard_vt_set<int> (chessboard, i, j,
succ n_position)
val following_moves = possible_moves (chessboard, i, j)
 
val w = 0U
val w = succ_if_move_is_not_nil (w, following_moves.0)
val w = succ_if_move_is_not_nil (w, following_moves.1)
val w = succ_if_move_is_not_nil (w, following_moves.2)
val w = succ_if_move_is_not_nil (w, following_moves.3)
val w = succ_if_move_is_not_nil (w, following_moves.4)
val w = succ_if_move_is_not_nil (w, following_moves.5)
val w = succ_if_move_is_not_nil (w, following_moves.6)
val w = succ_if_move_is_not_nil (w, following_moves.7)
 
val _ = chessboard_vt_set<int> (chessboard, i, j, EMPTY_SQUARE)
in
w
end
 
fn
pick_w (w0 : uint,
w1 : uint,
w2 : uint,
w3 : uint,
w4 : uint,
w5 : uint,
w6 : uint,
w7 : uint) :<>
uint =
let
fn
next_pick (u : uint,
v : uint) :<>
uint =
if v = 0U then
u
else if u = 0U then
v
else
min (u, v)
 
val w = 0U
val w = next_pick (w, w0)
val w = next_pick (w, w1)
val w = next_pick (w, w2)
val w = next_pick (w, w3)
val w = next_pick (w, w4)
val w = next_pick (w, w5)
val w = next_pick (w, w6)
val w = next_pick (w, w7)
in
w
end
 
fn
next_moves {n_ranks, n_files : pos}
{i, j : int}
{n_position : int}
(chessboard : !chessboard_vt (int, n_ranks, n_files),
i : int i,
j : int j,
n_position : int n_position) :
knights_moves_t =
(* Prune and sort the moves according to Warnsdorff’s heuristic,
keeping only moves that have the minimum number of legal
following moves. *)
let
val moves = possible_moves (chessboard, i, j)
val w0 = count_following_moves (chessboard, moves.0, n_position)
val w1 = count_following_moves (chessboard, moves.1, n_position)
val w2 = count_following_moves (chessboard, moves.2, n_position)
val w3 = count_following_moves (chessboard, moves.3, n_position)
val w4 = count_following_moves (chessboard, moves.4, n_position)
val w5 = count_following_moves (chessboard, moves.5, n_position)
val w6 = count_following_moves (chessboard, moves.6, n_position)
val w7 = count_following_moves (chessboard, moves.7, n_position)
val w = pick_w (w0, w1, w2, w3, w4, w5, w6, w7)
in
if w = 0U then
@(nil_move, nil_move, nil_move, nil_move,
nil_move, nil_move, nil_move, nil_move)
else
@(if w0 = w then moves.0 else nil_move,
if w1 = w then moves.1 else nil_move,
if w2 = w then moves.2 else nil_move,
if w3 = w then moves.3 else nil_move,
if w4 = w then moves.4 else nil_move,
if w5 = w then moves.5 else nil_move,
if w6 = w then moves.6 else nil_move,
if w7 = w then moves.7 else nil_move)
end
 
fn
make_and_fprint_tours
{n_ranks, n_files : int}
{i, j : int}
{max_tours : int}
(f : FILEref,
n_ranks : int n_ranks,
n_files : int n_files,
i : int i,
j : int j,
max_tours : int max_tours,
closed_only : bool) :
void =
{
val n_ranks = max (1, n_ranks)
val n_files = max (1, n_files)
val i = max (1, min (n_ranks, i))
val j = max (1, min (n_files, j))
val max_tours = max (1, max_tours)
 
val n_ranks = i2u n_ranks
val n_files = i2u n_files
 
val i_start = i
val j_start = j
 
var tours_printed : int = 0
 
val chessboard =
chessboard_vt_make<int> (n_ranks, n_files, g1ofg0 EMPTY_SQUARE)
 
fun
explore {n_ranks, n_files : pos}
{i, j : int}
{n_position : int}
(chessboard : !chessboard_vt (int, n_ranks, n_files),
i : int i,
j : int j,
n_position : int n_position,
tours_printed : &int) :
void =
if tours_printed < max_tours then
let
fn
print_board {i1, j1 : int}
(chessboard : !chessboard_vt (int, n_ranks,
n_files),
tours_printed : &int) :
void =
begin
tours_printed := succ tours_printed;
fprintln! (f, "Tour number ", tours_printed);
knights_tour_moves_fprint (f, chessboard);
fprintln! (f);
knights_tour_board_fprint (f, chessboard);
fprintln! (f);
fprintln! (f)
end
 
fn
satisfies_closedness
{i1, j1 : int}
(move : move_t (i1, j1)) :
bool =
if closed_only then
let
val @(i1, j1) = move
val i_diff = abs (i1 - i_start)
val j_diff = abs (j1 - j_start)
in
(i_diff = 1 && j_diff = 2)
|| (i_diff = 2 && j_diff = 1)
end
else
true
 
fn
try_last_move
{i1, j1 : int}
(chessboard : !chessboard_vt (int, n_ranks,
n_files),
move : move_t (i1, j1),
tours_printed : &int) :
void =
if ~move_t_is_nil move && satisfies_closedness move then
let
val @(i1, j1) = move
in
chessboard_vt_set<int> (chessboard, i1, j1,
n_position + 1);
print_board (chessboard, tours_printed);
chessboard_vt_set<int> (chessboard, i1, j1,
EMPTY_SQUARE)
end
fun
explore_inner (chessboard : !chessboard_vt (int, n_ranks,
n_files),
tours_printed : &int) :
void =
if u2i (chessboard.n_squares) - n_position = 1 then
(* Is the last move possible? If so, make it and print
the board. (Only zero or one of the moves can be
non-nil.) *)
let
val moves = possible_moves (chessboard, i, j)
in
try_last_move (chessboard, moves.0, tours_printed);
try_last_move (chessboard, moves.1, tours_printed);
try_last_move (chessboard, moves.2, tours_printed);
try_last_move (chessboard, moves.3, tours_printed);
try_last_move (chessboard, moves.4, tours_printed);
try_last_move (chessboard, moves.5, tours_printed);
try_last_move (chessboard, moves.6, tours_printed);
try_last_move (chessboard, moves.7, tours_printed)
end
else
let
val moves = next_moves (chessboard, i, j, n_position)
macdef explore_move (move) =
begin
if ~move_t_is_nil ,(move) then
explore (chessboard, (,(move)).0, (,(move)).1,
succ n_position, tours_printed)
end
in
explore_move (moves.0);
explore_move (moves.1);
explore_move (moves.2);
explore_move (moves.3);
explore_move (moves.4);
explore_move (moves.5);
explore_move (moves.6);
explore_move (moves.7)
end
in
chessboard_vt_set<int> (chessboard, i, j, n_position);
explore_inner (chessboard, tours_printed);
chessboard_vt_set<int> (chessboard, i, j, EMPTY_SQUARE)
end
 
val _ = explore (chessboard, i, j, 1, tours_printed)
 
val _ = $UNSAFE.castvwtp0{void} chessboard
}
 
fn
algebraic_notation_to_move (s : string) :
move_t =
let
val s = g1ofg0 s
val n = string_length s
in
if n = 2 then
let
val i = g1ofg0 (char2i (s[1]) - char2i ('0'))
val j = g1ofg0 (char2i (s[0]) - char2i ('a') + 1)
in
@(i, j)
end
else
@(1, 1)
end
 
implement
main0 (argc, argv) =
{
val @(i, j) =
begin
if 2 <= argc then
algebraic_notation_to_move (argv[1])
else
@(1, 1)
end : move_t
 
val max_tours =
begin
if 3 <= argc then
$extfcall (int, "atoi", argv[2])
else
1
end : int
val max_tours = g1ofg0 max_tours
 
val closed_only =
begin
if 4 <= argc then
argv[3] = "closed"
else
false
end : bool
 
val _ = make_and_fprint_tours (stdout_ref, 8, 8, i, j, max_tours,
closed_only)
}</syntaxhighlight>
 
{{out}}
$ ./knights_tour c5 2 closed
<pre>Tour number 1
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> e8 -> d6 -> b5 -> d4 -> f5 -> g7 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 58 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 63 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 60 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 61 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
 
Tour number 2
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> b5 -> d6 -> e8 -> g7 -> f5 -> d4 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 60 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 61 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 58 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 63 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
</pre>
 
=={{header|AutoHotkey}}==
{{libheader|GDIP}}
<langsyntaxhighlight AutoHotkeylang="autohotkey">#SingleInstance, Force
#NoEnv
SetBatchLines, -1
Line 1,152 ⟶ 1,858:
If (A_Gui = 1)
PostMessage, 0xA1, 2
}</langsyntaxhighlight>
{{out}}
For start at b3
Line 1,159 ⟶ 1,865:
 
=={{header|AWK}}==
<syntaxhighlight lang="awk">
<lang AWK>
# syntax: GAWK -f KNIGHTS_TOUR.AWK [-v sr=x] [-v sc=x]
#
Line 1,228 ⟶ 1,934:
}
}
</syntaxhighlight>
</lang>
<p>output:</p>
<pre>
Line 1,242 ⟶ 1,948:
</pre>
 
=={{header|BBC BASIC}}==
==={{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]]
<langsyntaxhighlight lang="bbcbasic"> VDU 23,22,256;256;16,16,16,128
VDU 23,23,4;0;0;0;
OFF
Line 1,304 ⟶ 2,092:
DEF FNvalidmove(X%,Y%)
IF X%<0 OR X%>7 OR Y%<0 OR Y%>7 THEN = FALSE
= NOT(Board%(X%,Y%))</langsyntaxhighlight>
 
=={{header|Bracmat}}==
<langsyntaxhighlight lang="bracmat"> ( knightsTour
= validmoves WarnsdorffSort algebraicNotation init solve
, x y fieldsToVisit
Line 1,411 ⟶ 2,199:
$ (algebraicNotation$(solve$((!x.!y).!fieldsToVisit)))
)
& out$(knightsTour$a1);</langsyntaxhighlight>
 
<pre>a1 b3 a5 b7 d8 f7 h8 g6 f8 h7 g5 h3 g1 e2 c1 a2 b4 a6 b8 c6 a7 c8 e7 g8 h6 g4 h2 f1 d2 b1 a3 c2 e1 f3 h4 g2 e3 d1 b2 a4 c3 b5 d4 f5 d6 c4 e5 d3 f2 h1 g3 e4 c5 d7 b6 a8 c7 d5 f4 e6 g7 e8 f6 h5</pre>
Line 1,419 ⟶ 2,207:
 
The following draws on console the progress of the horsie. Specify board size on commandline, or use default 8.
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
#include <string.h>
Line 1,521 ⟶ 2,309:
 
return 0;
}</langsyntaxhighlight>
 
=={{header|C sharp}}==
<langsyntaxhighlight lang="csharp">using System;
using System.Collections.Generic;
 
Line 1,607 ⟶ 2,395:
}
}
}</langsyntaxhighlight>
 
=={{header|C++}}==
Line 1,614 ⟶ 2,402:
Uses Warnsdorff's rule and (iterative) backtracking if that fails.
 
<langsyntaxhighlight lang="cpp">#include <iostream>
#include <iomanip>
#include <array>
Line 1,757 ⟶ 2,545:
cout << b3 << endl;
return 0;
}</langsyntaxhighlight>
 
Output:
Line 1,812 ⟶ 2,600:
This interactive program will ask for a starting case in algebraic notation and, also, whether a closed tour is desired. Each next move is selected according to Warnsdorff's rule; ties are broken at random.
 
The closed tour algorithm is quite crude: just find tours over and over until one happens to be closed by chance.
 
This code is quite verbose: I tried to make it easy for myself and for otherothers to follow and understand. I'm not a Lisp expert, so I probably missed some idiomatic shortcuts I could have used to make it shorter.
 
For some reason, the interactive part does not work with sbclSBCL, but it works fine witwith clispCLISP.
<langsyntaxhighlight lang="lisp">;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Solving the knight's tour. ;;;
;;; Warnsdorff's rule with random tie break. ;;;
Line 2,004 ⟶ 2,792:
 
(prompt)
(main)</langsyntaxhighlight>
{{out}}
<pre>Starting case (leave blank for random)? a8
Line 2,023 ⟶ 2,811:
=={{header|Clojure}}==
Using warnsdorff's rule
<syntaxhighlight lang="clojure">
<lang Clojure>
(defn isin? [x li]
(not= [] (filter #(= x %) li)))
Line 2,049 ⟶ 2,837:
(let [np (next-move mov pmoves n)]
(recur (conj mov np) (inc x)))))))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,066 ⟶ 2,854:
=={{header|CoffeeScript}}==
This algorithm finds 100,000 distinct solutions to the 8x8 problem in about 30 seconds. It precomputes knight moves up front, so it turns into a pure graph traversal problem. The program uses iteration and backtracking to find solutions.
<langsyntaxhighlight lang="coffeescript">
graph_tours = (graph, max_num_solutions) ->
# graph is an array of arrays
Line 2,181 ⟶ 2,969:
illustrate_knights_tour tours[0], BOARD_WIDTH
illustrate_knights_tour tours.pop(), BOARD_WIDTH
</syntaxhighlight>
</lang>
 
output
<syntaxhighlight lang="text">
> time coffee knight.coffee
100000 tours found (showing first and last)
Line 2,211 ⟶ 2,999:
user 0m25.656s
sys 0m0.253s
</syntaxhighlight>
</lang>
 
=={{header|D}}==
===Fast Version===
{{trans|C++}}
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.random, std.range,
std.conv, std.typecons, std.typetuple;
 
Line 2,292 ⟶ 3,080:
writeln();
}
}</langsyntaxhighlight>
{{out}}
<pre>23 16 11 6 21
Line 2,343 ⟶ 3,131:
===Shorter Version===
{{trans|Haskell}}
<langsyntaxhighlight lang="d">import std.stdio, std.math, std.algorithm, std.range, std.typecons;
 
alias Square = Tuple!(int,"x", int,"y");
Line 2,369 ⟶ 3,157:
const board = iota(1, 9).cartesianProduct(iota(1, 9)).map!Square.array;
writefln("%(%-(%s -> %)\n%)", board.knightTour([sq]).map!toAlg.chunks(8));
}</langsyntaxhighlight>
{{out}}
<pre>e5 -> d7 -> b8 -> a6 -> b4 -> a2 -> c1 -> b3
Line 2,379 ⟶ 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}}==
 
The algorithm uses iterative backtracking and Warnsdorff's heuristic. It can output closed or non-closed tours.
<langsyntaxhighlight lang="lisp">
(require 'plot)
(define *knight-moves*
Line 2,452 ⟶ 3,476:
(play starter 0 starter (dim n) wants-open)
(catch (hit mess) (show-steps n wants-open))))
</syntaxhighlight>
</lang>
 
 
{{out}}
<langsyntaxhighlight lang="lisp">
(k-tour 8 0 #f)
♞-closed-tour: 66 tries.
Line 2,490 ⟶ 3,514:
79 76 83 18 91 74 137 16 169 72 153 14 167 70 157 12 63 68 55 10
82 19 80 75 84 17 92 73 152 15 168 71 154 13 62 69 54 11 52 67
</syntaxhighlight>
</lang>
 
;Plotting:
64 shades of gray. We plot the move sequence in shades of gray, from black to white. The starting square is red. The ending square is green. One can observe that the squares near the border are played first (dark squares).
<langsyntaxhighlight lang="lisp">
(define (step-color x y n last-one)
(letrec ((sq (square (floor x) (floor y) n))
Line 2,504 ⟶ 3,528:
(define ( k-plot n)
(plot-rgb (lambda (x y) (step-color x y n (dim n))) (- n epsilon) (- n epsilon)))
</syntaxhighlight>
</lang>
 
 
Line 2,513 ⟶ 3,537:
=={{header|Elixir}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="elixir">defmodule Board do
import Integer, only: [is_odd: 1]
Line 2,576 ⟶ 3,600:
Board.knight_tour(4,9,1,1)
Board.knight_tour(5,5,1,2)
Board.knight_tour(12,12,2,2)</langsyntaxhighlight>
 
{{out}}
Line 2,622 ⟶ 3,646:
 
=={{header|Elm}}==
<langsyntaxhighlight lang="elm">module Main exposing (main)
 
import Browser exposing (element)
Line 2,967 ⟶ 3,991:
, subscriptions = subscriptions
}
</syntaxhighlight>
</lang>
 
Link to live demo: https://dmcbane.github.io/knights-tour/
Line 2,973 ⟶ 3,997:
=={{header|Erlang}}==
Again I use backtracking. It seemed easier this time.
<syntaxhighlight lang="erlang">
<lang Erlang>
-module( knights_tour ).
 
Line 3,052 ⟶ 4,076:
next_moves_row( 8 ) -> [6, 7];
next_moves_row( N ) -> [N - 2, N - 1, N + 1, N + 2].
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,078 ⟶ 4,102:
=={{header|ERRE}}==
Taken from ERRE distribution disk. Comments are in Italian.
<syntaxhighlight lang="erre">
<lang ERRE>
! **********************************************************************
! * *
Line 3,288 ⟶ 4,312:
UNTIL A$<>""
END PROGRAM
</syntaxhighlight>
</lang>
{{out}}
<pre> *** LA GALOPPATA DEL CAVALIERE ***
Line 3,309 ⟶ 4,333:
 
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang="freebasic">
Dim Shared As Integer tamano, xc, yc, nm
Dim As Integer f, qm, nmov, n = 0
Line 3,367 ⟶ 4,391:
Sleep
End
</syntaxhighlight>
</lang>
{{out}}
[https://www.dropbox.com/s/s3bpwechpoueum4/Knights%20Tour%20FreeBasic.png?dl=0 Knights Tour FreeBasic image]
Line 3,392 ⟶ 4,416:
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Knight%27s_tour}}
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation &mdash;i.e. XML, JSON&mdash; they are intended for storage and transfer purposes more than visualization and edition.
 
=={{header|Fortran}}==
Programs in Fōrmulæ are created/edited online in its [https://formulae.org website], However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.
===FORTRAN 77===
{{trans|ATS}}
{{works with|gfortran|11.2.1}}
{{works with|f2c}}
<syntaxhighlight lang="fortran">C-----------------------------------------------------------------------
C
C Find Knight’s Tours.
C
C Using Warnsdorff’s heuristic, find multiple solutions.
C Optionally accept only closed tours.
C
C This program is migrated from my implementation for ATS/Postiats.
C Arrays with dimension 1:64 take the place of stack frames.
C
C Compile with, for instance:
C
C gfortran -O2 -g -std=legacy -o knights_tour knights_tour.f
C
C or
C
C f2c knights_tour.f
C cc -O -o knights_tour knights_tour.c -lf2c
C
C Usage examples:
C
C One tour starting at a1, either open or closed:
C
C echo "a1 1 F" | ./knights_tour
C
C No more than 2000 closed tours starting at c5:
C
C echo "c5 2000 T" | ./knights_tour
C
C-----------------------------------------------------------------------
 
program ktour
In '''[https://formulae.org/?example=Knight%27s_tour this]''' page you can see the program(s) related to this task and their results.
implicit none
 
character*2 alg
=={{header|Fortran}}==
integer i, j
{{works with|Fortran|2008, 2018}}
integer mxtour
logical closed
 
read (*,*) alg, mxtour, closed
call alg2ij (alg, i, j)
call explor (i, j, mxtour, closed)
 
end
 
C-----------------------------------------------------------------------
 
subroutine explor (istart, jstart, mxtour, closed)
implicit none
 
C Explore the space of 'Warnsdorffian' knight’s paths, looking for
C and printing complete tours.
 
integer istart, jstart ! The starting position.
integer mxtour ! The maximum number of tours to print.
logical closed ! Closed tours only?
 
integer board(1:8,1:8)
integer imove(1:8,1:64)
integer jmove(1:8,1:64)
integer nmove(1:64)
integer n
integer itours
logical goodmv
logical isclos
 
itours = 0
call initbd (board)
n = 1
nmove(1) = 8
imove(8, 1) = istart
jmove(8, 1) = jstart
 
1000 if (itours .lt. mxtour .and. n .ne. 0) then
 
if (nmove(n) .eq. 9) then
n = n - 1
if (n .ne. 0) then
call unmove (board, imove, jmove, nmove, n)
nmove(n) = nmove(n) + 1
end if
else if (goodmv (imove, nmove, n)) then
call mkmove (board, imove, jmove, nmove, n)
if (n .eq. 64) then
if (.not. closed) then
itours = itours + 1
call prnt (board, itours)
else if (isclos (board)) then
itours = itours + 1
call prnt (board, itours)
end if
call unmove (board, imove, jmove, nmove, n)
nmove(n) = 9
else if (n .eq. 63) then
call possib (board, n, imove, jmove, nmove)
n = n + 1
nmove(n) = 1
else
call nxtmov (board, n, imove, jmove, nmove)
n = n + 1
nmove(n) = 1
end if
else
nmove(n) = nmove(n) + 1
end if
 
goto 1000
end if
 
end
 
C-----------------------------------------------------------------------
 
subroutine initbd (board)
implicit none
 
C Initialize a chessboard with empty squares.
 
integer board(1:8,1:8)
 
integer i, j
 
do 1010 j = 1, 8
do 1000 i = 1, 8
board(i, j) = -1
1000 continue
1010 continue
 
end
 
C-----------------------------------------------------------------------
 
subroutine mkmove (board, imove, jmove, nmove, n)
implicit none
 
C Fill a square with a move number.
 
integer board(1:8, 1:8)
integer imove(1:8, 1:64)
integer jmove(1:8, 1:64)
integer nmove(1:64)
integer n
 
board(imove(nmove(n), n), jmove(nmove(n), n)) = n
 
end
 
C-----------------------------------------------------------------------
 
subroutine unmove (board, imove, jmove, nmove, n)
implicit none
 
C Unmake a mkmove.
 
integer board(1:8, 1:8)
integer imove(1:8, 1:64)
integer jmove(1:8, 1:64)
integer nmove(1:64)
integer n
 
board(imove(nmove(n), n), jmove(nmove(n), n)) = -1
 
end
 
C-----------------------------------------------------------------------
 
function goodmv (imove, nmove, n)
implicit none
 
logical goodmv
integer imove(1:8, 1:64)
integer nmove(1:64)
integer n
goodmv = (imove(nmove(n), n) .ne. -1)
 
end
 
C-----------------------------------------------------------------------
 
subroutine prnt (board, itours)
implicit none
 
C Print a knight's tour.
 
integer board(1:8,1:8)
integer itours
 
10000 format (1X)
 
C The following plethora of format statements seemed a simple way to
C get this working with f2c. (For gfortran, the 'I0' format
C sufficed.)
10010 format (1X, "Tour number ", I1)
10020 format (1X, "Tour number ", I2)
10030 format (1X, "Tour number ", I3)
10040 format (1X, "Tour number ", I4)
10050 format (1X, "Tour number ", I5)
10060 format (1X, "Tour number ", I6)
10070 format (1X, "Tour number ", I20)
 
if (itours .lt. 10) then
write (*, 10010) itours
else if (itours .lt. 100) then
write (*, 10020) itours
else if (itours .lt. 1000) then
write (*, 10030) itours
else if (itours .lt. 10000) then
write (*, 10040) itours
else if (itours .lt. 100000) then
write (*, 10050) itours
else if (itours .lt. 1000000) then
write (*, 10060) itours
else
write (*, 10070) itours
end if
call prntmv (board)
call prntbd (board)
write (*, 10000)
 
end
 
C-----------------------------------------------------------------------
 
subroutine prntbd (board)
implicit none
 
C Print a chessboard with the move number in each square.
 
integer board(1:8,1:8)
 
integer i, j
 
10000 format (1X, " ", 8("+----"), "+")
10010 format (1X, I2, " ", 8(" | ", I2), " | ")
10020 format (1X, " ", 8(" ", A1))
 
do 1000 i = 8, 1, -1
write (*, 10000)
write (*, 10010) i, (board(i, j), j = 1, 8)
1000 continue
write (*, 10000)
write (*, 10020) 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h'
 
end
 
C-----------------------------------------------------------------------
 
subroutine prntmv (board)
implicit none
 
C Print the moves of a knight's path, in algebraic notation.
 
integer board(1:8,1:8)
 
integer ipos(1:64)
integer jpos(1:64)
integer numpos
character*2 alg(1:64)
integer columns(1:8)
integer k
integer m
 
character*72 lines(1:8)
 
10000 format (1X, A)
 
call bd2pos (board, ipos, jpos, numpos)
 
C Convert the positions to algebraic notation.
do 1000 k = 1, numpos
call ij2alg (ipos(k), jpos(k), alg(k))
1000 continue
 
C Fill lines with algebraic notations.
do 1020 m = 1, 8
columns(m) = 1
1020 continue
m = 1
do 1100 k = 1, numpos
lines(m)(columns(m) : columns(m) + 1) = alg(k)(1:2)
columns(m) = columns(m) + 2
if (k .ne. numpos) then
lines(m)(columns(m) : columns(m) + 3) = " -> "
columns(m) = columns(m) + 4
else if (numpos .eq. 64 .and.
$ ((abs (ipos(numpos) - ipos(1)) .eq. 2
$ .and. abs (jpos(numpos) - jpos(1)) .eq. 1) .or.
$ ((abs (ipos(numpos) - ipos(1)) .eq. 1
$ .and. abs (jpos(numpos) - jpos(1)) .eq. 2)))) then
lines(m)(columns(m) : columns(m) + 8) = " -> cycle"
columns(m) = columns(m) + 9
endif
if (mod (k, 8) .eq. 0) m = m + 1
1100 continue
 
C Print the lines that have stuff in them.
do 1200 m = 1, 8
if (columns(m) .ne. 1) then
write (*, 10000) lines(m)(1 : columns(m) - 1)
end if
1200 continue
 
end
 
C-----------------------------------------------------------------------
 
function isclos (board)
implicit none
 
C Is a board a closed tour?
 
logical isclos
integer board(1:8,1:8)
integer ipos(1:64) ! The i-positions in order.
integer jpos(1:64) ! The j-positions in order.
integer numpos ! The number of positions so far.
 
call bd2pos (board, ipos, jpos, numpos)
 
isclos = (numpos .eq. 64 .and.
$ ((abs (ipos(numpos) - ipos(1)) .eq. 2
$ .and. abs (jpos(numpos) - jpos(1)) .eq. 1) .or.
$ ((abs (ipos(numpos) - ipos(1)) .eq. 1
$ .and. abs (jpos(numpos) - jpos(1)) .eq. 2))))
 
end
 
C-----------------------------------------------------------------------
 
subroutine bd2pos (board, ipos, jpos, numpos)
implicit none
 
C Convert from a board to a list of board positions.
 
integer board(1:8,1:8)
integer ipos(1:64) ! The i-positions in order.
integer jpos(1:64) ! The j-positions in order.
integer numpos ! The number of positions so far.
 
integer i, j
 
numpos = 0
do 1010 i = 1, 8
do 1000 j = 1, 8
if (board(i, j) .ne. -1) then
numpos = max (board(i, j), numpos)
ipos(board(i, j)) = i
jpos(board(i, j)) = j
end if
1000 continue
1010 continue
 
end
 
C-----------------------------------------------------------------------
 
subroutine nxtmov (board, n, imove, jmove, nmove)
implicit none
 
C Find possible next moves. Prune and sort the moves according to
C Warnsdorff's heuristic, keeping only those that have the minimum
C number of legal following moves.
 
integer board(1:8,1:8)
integer n
integer imove(1:8,1:64)
integer jmove(1:8,1:64)
integer nmove(1:64)
 
integer w1, w2, w3, w4, w5, w6, w7, w8
integer w
integer n1
integer pickw
 
call possib (board, n, imove, jmove, nmove)
 
n1 = n + 1
nmove(n1) = 1
call countf (board, n1, imove, jmove, nmove, w1)
nmove(n1) = 2
call countf (board, n1, imove, jmove, nmove, w2)
nmove(n1) = 3
call countf (board, n1, imove, jmove, nmove, w3)
nmove(n1) = 4
call countf (board, n1, imove, jmove, nmove, w4)
nmove(n1) = 5
call countf (board, n1, imove, jmove, nmove, w5)
nmove(n1) = 6
call countf (board, n1, imove, jmove, nmove, w6)
nmove(n1) = 7
call countf (board, n1, imove, jmove, nmove, w7)
nmove(n1) = 8
call countf (board, n1, imove, jmove, nmove, w8)
 
w = pickw (w1, w2, w3, w4, w5, w6, w7, w8)
 
if (w .eq. 0) then
call disabl (imove(1, n1), jmove(1, n1))
call disabl (imove(2, n1), jmove(2, n1))
call disabl (imove(3, n1), jmove(3, n1))
call disabl (imove(4, n1), jmove(4, n1))
call disabl (imove(5, n1), jmove(5, n1))
call disabl (imove(6, n1), jmove(6, n1))
call disabl (imove(7, n1), jmove(7, n1))
call disabl (imove(8, n1), jmove(8, n1))
else
if (w .ne. w1) call disabl (imove(1, n1), jmove(1, n1))
if (w .ne. w2) call disabl (imove(2, n1), jmove(2, n1))
if (w .ne. w3) call disabl (imove(3, n1), jmove(3, n1))
if (w .ne. w4) call disabl (imove(4, n1), jmove(4, n1))
if (w .ne. w5) call disabl (imove(5, n1), jmove(5, n1))
if (w .ne. w6) call disabl (imove(6, n1), jmove(6, n1))
if (w .ne. w7) call disabl (imove(7, n1), jmove(7, n1))
if (w .ne. w8) call disabl (imove(8, n1), jmove(8, n1))
end if
 
end
 
C-----------------------------------------------------------------------
 
subroutine countf (board, n, imove, jmove, nmove, w)
implicit none
 
C Count the number of moves possible after an nth move.
 
integer board(1:8,1:8)
integer n
integer imove(1:8,1:64)
integer jmove(1:8,1:64)
integer nmove(1:64)
integer w
 
logical goodmv
integer n1
 
if (goodmv (imove, nmove, n)) then
call mkmove (board, imove, jmove, nmove, n)
call possib (board, n, imove, jmove, nmove)
n1 = n + 1
w = 0
if (imove(1, n1) .ne. -1) w = w + 1
if (imove(2, n1) .ne. -1) w = w + 1
if (imove(3, n1) .ne. -1) w = w + 1
if (imove(4, n1) .ne. -1) w = w + 1
if (imove(5, n1) .ne. -1) w = w + 1
if (imove(6, n1) .ne. -1) w = w + 1
if (imove(7, n1) .ne. -1) w = w + 1
if (imove(8, n1) .ne. -1) w = w + 1
call unmove (board, imove, jmove, nmove, n)
else
C The nth move itself is impossible.
w = 0
end if
 
end
 
C-----------------------------------------------------------------------
 
function pickw (w1, w2, w3, w4, w5, w6, w7, w8)
implicit none
 
C From w1..w8, pick out the least nonzero value (or zero if they all
C equal zero).
 
integer pickw
integer w1, w2, w3, w4, w5, w6, w7, w8
 
integer w
integer pickw1
 
w = 0
w = pickw1 (w, w1)
w = pickw1 (w, w2)
w = pickw1 (w, w3)
w = pickw1 (w, w4)
w = pickw1 (w, w5)
w = pickw1 (w, w6)
w = pickw1 (w, w7)
w = pickw1 (w, w8)
 
pickw = w
 
end
 
C-----------------------------------------------------------------------
 
function pickw1 (u, v)
implicit none
 
C A small function used by pickw.
 
integer pickw1
integer u, v
 
if (v .eq. 0) then
pickw1 = u
else if (u .eq. 0) then
pickw1 = v
else
pickw1 = min (u, v)
end if
 
end
 
C-----------------------------------------------------------------------
 
subroutine possib (board, n, imove, jmove, nmove)
implicit none
 
C Find moves that are possible from an nth-move position.
 
integer board(1:8,1:8)
integer n
integer imove(1:8,1:64)
integer jmove(1:8,1:64)
integer nmove(1:64)
 
integer i, j
integer n1
 
i = imove(nmove(n), n)
j = jmove(nmove(n), n)
n1 = n + 1
call trymov (board, i + 1, j + 2, imove(1, n1), jmove(1, n1))
call trymov (board, i + 2, j + 1, imove(2, n1), jmove(2, n1))
call trymov (board, i + 1, j - 2, imove(3, n1), jmove(3, n1))
call trymov (board, i + 2, j - 1, imove(4, n1), jmove(4, n1))
call trymov (board, i - 1, j + 2, imove(5, n1), jmove(5, n1))
call trymov (board, i - 2, j + 1, imove(6, n1), jmove(6, n1))
call trymov (board, i - 1, j - 2, imove(7, n1), jmove(7, n1))
call trymov (board, i - 2, j - 1, imove(8, n1), jmove(8, n1))
 
end
 
C-----------------------------------------------------------------------
 
subroutine trymov (board, i, j, imove, jmove)
implicit none
 
C Try a move to square (i, j).
 
integer board(1:8,1:8)
integer i, j
integer imove, jmove
 
call disabl (imove, jmove)
if (1 .le. i .and. i .le. 8 .and. 1 .le. j .and. j .le. 8) then
if (board(i,j) .eq. -1) then
call enable (i, j, imove, jmove)
end if
end if
 
end
 
C-----------------------------------------------------------------------
 
subroutine enable (i, j, imove, jmove)
implicit none
 
C Enable a potential move.
 
integer i, j
integer imove, jmove
 
imove = i
jmove = j
 
end
 
C-----------------------------------------------------------------------
 
subroutine disabl (imove, jmove)
implicit none
 
C Disable a potential move.
 
integer imove, jmove
 
imove = -1
jmove = -1
 
end
 
C-----------------------------------------------------------------------
 
subroutine alg2ij (alg, i, j)
implicit none
 
C Convert, for instance, 'c5' to i=3,j=5.
 
character*2 alg
integer i, j
 
if (alg(1:1) .eq. 'a') j = 1
if (alg(1:1) .eq. 'b') j = 2
if (alg(1:1) .eq. 'c') j = 3
if (alg(1:1) .eq. 'd') j = 4
if (alg(1:1) .eq. 'e') j = 5
if (alg(1:1) .eq. 'f') j = 6
if (alg(1:1) .eq. 'g') j = 7
if (alg(1:1) .eq. 'h') j = 8
 
if (alg(2:2) .eq. '1') i = 1
if (alg(2:2) .eq. '2') i = 2
if (alg(2:2) .eq. '3') i = 3
if (alg(2:2) .eq. '4') i = 4
if (alg(2:2) .eq. '5') i = 5
if (alg(2:2) .eq. '6') i = 6
if (alg(2:2) .eq. '7') i = 7
if (alg(2:2) .eq. '8') i = 8
 
end
 
C-----------------------------------------------------------------------
 
subroutine ij2alg (i, j, alg)
implicit none
 
C Convert, for instance, i=3,j=5 to 'c5'.
 
integer i, j
character*2 alg
 
character alg1
character alg2
 
if (j .eq. 1) alg1 = 'a'
if (j .eq. 2) alg1 = 'b'
if (j .eq. 3) alg1 = 'c'
if (j .eq. 4) alg1 = 'd'
if (j .eq. 5) alg1 = 'e'
if (j .eq. 6) alg1 = 'f'
if (j .eq. 7) alg1 = 'g'
if (j .eq. 8) alg1 = 'h'
 
if (i .eq. 1) alg2 = '1'
if (i .eq. 2) alg2 = '2'
if (i .eq. 3) alg2 = '3'
if (i .eq. 4) alg2 = '4'
if (i .eq. 5) alg2 = '5'
if (i .eq. 6) alg2 = '6'
if (i .eq. 7) alg2 = '7'
if (i .eq. 8) alg2 = '8'
 
alg(1:1) = alg1
alg(2:2) = alg2
 
end
 
C-----------------------------------------------------------------------</syntaxhighlight>
{{out}}
$ echo "c5 2 T" | ./knights_tour
<pre> Tour number 1
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> e8 -> d6 -> b5 -> d4 -> f5 -> g7 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 58 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 63 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 60 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 61 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
 
Tour number 2
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> b5 -> d6 -> e8 -> g7 -> f5 -> d4 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 60 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 61 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 58 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 63 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
</pre>
 
===Fortran 95===
{{works with|gfortran|11.2.1}}
{{trans|ATS}}
<syntaxhighlight lang="fortran">!-----------------------------------------------------------------------
!
! Find Knight’s Tours.
!
! Using Warnsdorff’s heuristic, find multiple solutions.
! Optionally accept only closed tours.
!
! This program is migrated from my implementation for
! ATS/Postiats. Unlike my FORTRAN 77 implementation (which simply
! cannot do so), it uses a recursive call.
!
! Compile with, for instance:
!
! gfortran -O2 -g -std=f95 -o knights_tour knights_tour.f90
!
! Usage examples:
!
! One tour starting at a1, either open or closed:
!
! echo "a1 1 F" | ./knights_tour
!
! No more than 2000 closed tours starting at c5:
!
! echo "c5 2000 T" | ./knights_tour
!
!-----------------------------------------------------------------------
 
program knights_tour
implicit none
 
character(len = 2) inp__alg
integer inp__istart
integer inp__jstart
integer inp__max_tours
logical inp__closed
 
read (*,*) inp__alg, inp__max_tours, inp__closed
call alg2ij (inp__alg, inp__istart, inp__jstart)
call main (inp__istart, inp__jstart, inp__max_tours, inp__closed)
 
contains
 
subroutine main (istart, jstart, max_tours, closed)
integer, intent(in) :: istart, jstart ! The starting position.
integer, intent(in) :: max_tours ! The max. no. of tours to print.
logical, intent(in) :: closed ! Closed tours only?
 
integer board(1:8,1:8)
integer num_tours_printed
 
num_tours_printed = 0
call init_board (board)
call explore (board, 1, istart, jstart, max_tours, &
& num_tours_printed, closed)
end subroutine main
 
recursive subroutine explore (board, n, i, j, max_tours, &
& num_tours_printed, closed)
 
! Recursively the space of 'Warnsdorffian' knight’s paths, looking
! for and printing complete tours.
 
integer, intent(inout) :: board(1:8,1:8)
integer, intent(in) :: n
integer, intent(in) :: i, j
integer, intent(in) :: max_tours
integer, intent(inout) :: num_tours_printed
logical, intent(in) :: closed
 
integer imove(1:8)
integer jmove(1:8)
integer k
 
if (num_tours_printed < max_tours .and. n /= 0) then
if (is_good_move (i, j)) then
call mkmove (board, i, j, n)
if (n == 63) then
call find_possible_moves (board, i, j, imove, jmove)
call try_last_move (board, n + 1, imove(1), jmove(1), &
& num_tours_printed, closed)
call try_last_move (board, n + 1, imove(2), jmove(2), &
& num_tours_printed, closed)
call try_last_move (board, n + 1, imove(3), jmove(3), &
& num_tours_printed, closed)
call try_last_move (board, n + 1, imove(4), jmove(4), &
& num_tours_printed, closed)
call try_last_move (board, n + 1, imove(5), jmove(5), &
& num_tours_printed, closed)
call try_last_move (board, n + 1, imove(6), jmove(6), &
& num_tours_printed, closed)
call try_last_move (board, n + 1, imove(7), jmove(7), &
& num_tours_printed, closed)
call try_last_move (board, n + 1, imove(8), jmove(8), &
& num_tours_printed, closed)
else
call find_next_moves (board, n, i, j, imove, jmove)
do k = 1, 8
if (is_good_move (imove(k), jmove(k))) then
!
! Here is the recursive call.
!
call explore (board, n + 1, imove(k), jmove(k), &
& max_tours, num_tours_printed, closed)
end if
end do
end if
call unmove (board, i, j)
end if
end if
end subroutine explore
 
subroutine try_last_move (board, n, i, j, num_tours_printed, closed)
integer, intent(inout) :: board(1:8,1:8)
integer, intent(in) :: n
integer, intent(in) :: i, j
integer, intent(inout) :: num_tours_printed
logical, intent(in) :: closed
 
integer ipos(1:64)
integer jpos(1:64)
integer numpos
integer idiff
integer jdiff
 
if (is_good_move (i, j)) then
call mkmove (board, i, j, n)
if (.not. closed) then
num_tours_printed = num_tours_printed + 1
call print_tour (board, num_tours_printed)
else
call board2positions (board, ipos, jpos, numpos)
idiff = abs (i - ipos(1))
jdiff = abs (j - jpos(1))
if ((idiff == 1 .and. jdiff == 2) .or. &
(idiff == 2 .and. jdiff == 1)) then
num_tours_printed = num_tours_printed + 1
call print_tour (board, num_tours_printed)
end if
end if
call unmove (board, i, j)
end if
end subroutine try_last_move
 
subroutine init_board (board)
 
! Initialize a chessboard with empty squares.
 
integer, intent(out) :: board(1:8,1:8)
 
integer i, j
 
do j = 1, 8
do i = 1, 8
board(i, j) = -1
end do
end do
end subroutine init_board
 
subroutine mkmove (board, i, j, n)
 
! Fill a square with a move number.
 
integer, intent(inout) :: board(1:8, 1:8)
integer, intent(in) :: i, j
integer, intent(in) :: n
 
board(i, j) = n
end subroutine mkmove
 
subroutine unmove (board, i, j)
 
! Unmake a mkmove.
 
integer, intent(inout) :: board(1:8, 1:8)
integer, intent(in) :: i, j
 
board(i, j) = -1
end subroutine unmove
 
function is_good_move (i, j)
logical is_good_move
integer, intent(in) :: i, j
 
is_good_move = (i /= -1 .and. j /= -1)
end function is_good_move
 
subroutine print_tour (board, num_tours_printed)
 
! Print a knight's tour.
 
integer, intent(in) :: board(1:8,1:8)
integer, intent(in) :: num_tours_printed
 
write (*, '("Tour number ", I0)') num_tours_printed
call print_moves (board)
call print_board (board)
write (*, '()')
end subroutine print_tour
 
subroutine print_board (board)
 
! Print a chessboard with the move number in each square.
 
integer, intent(in) :: board(1:8,1:8)
 
integer i, j
 
do i = 8, 1, -1
write (*, '(" ", 8("+----"), "+")')
write (*, '(I2, " ", 8(" | ", I2), " | ")') &
i, (board(i, j), j = 1, 8)
end do
write (*, '(" ", 8("+----"), "+")')
write (*, '(" ", 8(" ", A1))') &
'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h'
 
end subroutine print_board
 
subroutine print_moves (board)
 
! Print the moves of a knight's path, in algebraic notation.
 
integer, intent(in) :: board(1:8,1:8)
 
integer ipos(1:64)
integer jpos(1:64)
integer numpos
character(len = 2) alg(1:64)
integer columns(1:8)
integer k
integer m
 
character(len = 72) lines(1:8)
 
call board2positions (board, ipos, jpos, numpos)
 
! Convert the positions to algebraic notation.
do k = 1, numpos
call ij2alg (ipos(k), jpos(k), alg(k))
end do
 
! Fill lines with algebraic notations.
do m = 1, 8
columns(m) = 1
end do
m = 1
do k = 1, numpos
lines(m)(columns(m) : columns(m) + 1) = alg(k)(1:2)
columns(m) = columns(m) + 2
if (k /= numpos) then
lines(m)(columns(m) : columns(m) + 3) = " -> "
columns(m) = columns(m) + 4
else if (numpos == 64 .and. &
((abs (ipos(numpos) - ipos(1)) == 2 &
.and. abs (jpos(numpos) - jpos(1)) == 1) .or. &
((abs (ipos(numpos) - ipos(1)) == 1 &
.and. abs (jpos(numpos) - jpos(1)) == 2)))) then
lines(m)(columns(m) : columns(m) + 8) = " -> cycle"
columns(m) = columns(m) + 9
endif
if (mod (k, 8) == 0) m = m + 1
end do
 
! Print the lines that have stuff in them.
do m = 1, 8
if (columns(m) /= 1) then
write (*, '(A)') lines(m)(1 : columns(m) - 1)
end if
end do
 
end subroutine print_moves
 
function is_closed (board)
 
! Is a board a closed tour?
 
logical is_closed
 
integer board(1:8,1:8)
integer ipos(1:64) ! The i-positions in order.
integer jpos(1:64) ! The j-positions in order.
integer numpos ! The number of positions so far.
 
call board2positions (board, ipos, jpos, numpos)
 
is_closed = (numpos == 64 .and. &
((abs (ipos(numpos) - ipos(1)) == 2 &
.and. abs (jpos(numpos) - jpos(1)) == 1) .or. &
((abs (ipos(numpos) - ipos(1)) == 1 &
.and. abs (jpos(numpos) - jpos(1)) == 2))))
 
end function is_closed
 
subroutine board2positions (board, ipos, jpos, numpos)
 
! Convert from a board to a list of board positions.
 
integer, intent(in) :: board(1:8,1:8)
integer, intent(out) :: ipos(1:64) ! The i-positions in order.
integer, intent(out) :: jpos(1:64) ! The j-positions in order.
integer, intent(out) :: numpos ! The number of positions so far.
 
integer i, j
 
numpos = 0
do i = 1, 8
do j = 1, 8
if (board(i, j) /= -1) then
numpos = max (board(i, j), numpos)
ipos(board(i, j)) = i
jpos(board(i, j)) = j
end if
end do
end do
end subroutine board2positions
 
subroutine find_next_moves (board, n, i, j, imove, jmove)
 
! Find possible next moves. Prune and sort the moves according to
! Warnsdorff's heuristic, keeping only those that have the minimum
! number of legal following moves.
 
integer, intent(inout) :: board(1:8,1:8)
integer, intent(in) :: n
integer, intent(in) :: i, j
integer, intent(inout) :: imove(1:8)
integer, intent(inout) :: jmove(1:8)
 
integer w1, w2, w3, w4, w5, w6, w7, w8
integer w
 
call find_possible_moves (board, i, j, imove, jmove)
 
call count_following (board, n + 1, imove(1), jmove(1), w1)
call count_following (board, n + 1, imove(2), jmove(2), w2)
call count_following (board, n + 1, imove(3), jmove(3), w3)
call count_following (board, n + 1, imove(4), jmove(4), w4)
call count_following (board, n + 1, imove(5), jmove(5), w5)
call count_following (board, n + 1, imove(6), jmove(6), w6)
call count_following (board, n + 1, imove(7), jmove(7), w7)
call count_following (board, n + 1, imove(8), jmove(8), w8)
 
w = pick_w (w1, w2, w3, w4, w5, w6, w7, w8)
 
if (w == 0) then
call disable (imove(1), jmove(1))
call disable (imove(2), jmove(2))
call disable (imove(3), jmove(3))
call disable (imove(4), jmove(4))
call disable (imove(5), jmove(5))
call disable (imove(6), jmove(6))
call disable (imove(7), jmove(7))
call disable (imove(8), jmove(8))
else
if (w /= w1) call disable (imove(1), jmove(1))
if (w /= w2) call disable (imove(2), jmove(2))
if (w /= w3) call disable (imove(3), jmove(3))
if (w /= w4) call disable (imove(4), jmove(4))
if (w /= w5) call disable (imove(5), jmove(5))
if (w /= w6) call disable (imove(6), jmove(6))
if (w /= w7) call disable (imove(7), jmove(7))
if (w /= w8) call disable (imove(8), jmove(8))
end if
 
end subroutine find_next_moves
 
subroutine count_following (board, n, i, j, w)
 
! Count the number of moves possible after an nth move.
 
integer, intent(inout) :: board(1:8,1:8)
integer, intent(in) :: n
integer, intent(in) :: i, j
integer, intent(out) :: w
 
integer imove(1:8)
integer jmove(1:8)
 
if (is_good_move (i, j)) then
call mkmove (board, i, j, n)
call find_possible_moves (board, i, j, imove, jmove)
w = 0
if (is_good_move (imove(1), jmove(1))) w = w + 1
if (is_good_move (imove(2), jmove(2))) w = w + 1
if (is_good_move (imove(3), jmove(3))) w = w + 1
if (is_good_move (imove(4), jmove(4))) w = w + 1
if (is_good_move (imove(5), jmove(5))) w = w + 1
if (is_good_move (imove(6), jmove(6))) w = w + 1
if (is_good_move (imove(7), jmove(7))) w = w + 1
if (is_good_move (imove(8), jmove(8))) w = w + 1
call unmove (board, i, j)
else
! The nth move itself is impossible.
w = 0
end if
 
end subroutine count_following
 
function pick_w (w1, w2, w3, w4, w5, w6, w7, w8) result (w)
 
! From w1..w8, pick out the least nonzero value (or zero if they
! all equal zero).
 
integer, intent(in) :: w1, w2, w3, w4, w5, w6, w7, w8
integer w
 
w = 0
w = pick_w1 (w, w1)
w = pick_w1 (w, w2)
w = pick_w1 (w, w3)
w = pick_w1 (w, w4)
w = pick_w1 (w, w5)
w = pick_w1 (w, w6)
w = pick_w1 (w, w7)
w = pick_w1 (w, w8)
end function pick_w
 
function pick_w1 (u, v)
 
! A small function used by pick_w.
 
integer pick_w1
integer, intent(in) :: u, v
 
if (v == 0) then
pick_w1 = u
else if (u == 0) then
pick_w1 = v
else
pick_w1 = min (u, v)
end if
end function pick_w1
 
subroutine find_possible_moves (board, i, j, imove, jmove)
 
! Find moves that are possible from a position.
 
integer, intent(in) :: board(1:8,1:8)
integer, intent(in) :: i, j
integer, intent(out) :: imove(1:8)
integer, intent(out) :: jmove(1:8)
 
call trymov (board, i + 1, j + 2, imove(1), jmove(1))
call trymov (board, i + 2, j + 1, imove(2), jmove(2))
call trymov (board, i + 1, j - 2, imove(3), jmove(3))
call trymov (board, i + 2, j - 1, imove(4), jmove(4))
call trymov (board, i - 1, j + 2, imove(5), jmove(5))
call trymov (board, i - 2, j + 1, imove(6), jmove(6))
call trymov (board, i - 1, j - 2, imove(7), jmove(7))
call trymov (board, i - 2, j - 1, imove(8), jmove(8))
end subroutine find_possible_moves
 
subroutine trymov (board, i, j, imove, jmove)
 
! Try a move to square (i, j).
 
integer, intent(in) :: board(1:8,1:8)
integer, intent(in) :: i, j
integer, intent(inout) :: imove, jmove
 
call disable (imove, jmove)
if (1 <= i .and. i <= 8 .and. 1 <= j .and. j <= 8) then
if (square_is_empty (board, i, j)) then
call enable (i, j, imove, jmove)
end if
end if
 
end subroutine trymov
 
function square_is_empty (board, i, j)
logical square_is_empty
integer, intent(in) :: board(1:8,1:8)
integer, intent(in) :: i, j
 
square_is_empty = (board(i, j) == -1)
end function square_is_empty
 
subroutine enable (i, j, imove, jmove)
 
! Enable a potential move.
 
integer, intent(in) :: i, j
integer, intent(inout) :: imove, jmove
 
imove = i
jmove = j
end subroutine enable
 
subroutine disable (imove, jmove)
 
! Disable a potential move.
 
integer, intent(out) :: imove, jmove
 
imove = -1
jmove = -1
end subroutine disable
 
subroutine alg2ij (alg, i, j)
 
! Convert, for instance, 'c5' to i=3,j=5.
 
character(len = 2), intent(in) :: alg
integer, intent(out) :: i, j
 
if (alg(1:1) == 'a') j = 1
if (alg(1:1) == 'b') j = 2
if (alg(1:1) == 'c') j = 3
if (alg(1:1) == 'd') j = 4
if (alg(1:1) == 'e') j = 5
if (alg(1:1) == 'f') j = 6
if (alg(1:1) == 'g') j = 7
if (alg(1:1) == 'h') j = 8
 
if (alg(2:2) == '1') i = 1
if (alg(2:2) == '2') i = 2
if (alg(2:2) == '3') i = 3
if (alg(2:2) == '4') i = 4
if (alg(2:2) == '5') i = 5
if (alg(2:2) == '6') i = 6
if (alg(2:2) == '7') i = 7
if (alg(2:2) == '8') i = 8
 
end subroutine alg2ij
 
subroutine ij2alg (i, j, alg)
 
! Convert, for instance, i=3,j=5 to 'c5'.
 
integer, intent(in) :: i, j
character(len = 2), intent(out) :: alg
 
character alg1
character alg2
 
if (j == 1) alg1 = 'a'
if (j == 2) alg1 = 'b'
if (j == 3) alg1 = 'c'
if (j == 4) alg1 = 'd'
if (j == 5) alg1 = 'e'
if (j == 6) alg1 = 'f'
if (j == 7) alg1 = 'g'
if (j == 8) alg1 = 'h'
 
if (i == 1) alg2 = '1'
if (i == 2) alg2 = '2'
if (i == 3) alg2 = '3'
if (i == 4) alg2 = '4'
if (i == 5) alg2 = '5'
if (i == 6) alg2 = '6'
if (i == 7) alg2 = '7'
if (i == 8) alg2 = '8'
 
alg(1:1) = alg1
alg(2:2) = alg2
 
end subroutine ij2alg
 
end program
 
!-----------------------------------------------------------------------</syntaxhighlight>
 
{{out}}
$ echo "c5 2 T" | ./knights_tour
<pre>Tour number 1
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> e8 -> d6 -> b5 -> d4 -> f5 -> g7 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 58 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 63 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 60 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 61 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
 
Tour number 2
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> b5 -> d6 -> e8 -> g7 -> f5 -> d4 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 60 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 61 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 58 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 63 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
</pre>
 
===Fortran 2008===
{{works with|gfortran|11.2.1}}
(This one is ''not'' a translation of my ATS implementation. I wrote it earlier.)
This code has been placed by its author into the public domain, via the Unlicense. For more information, please refer to <http://unlicense.org/>
<langsyntaxhighlight lang="fortran">!!!
!!! Find a Knight’s Tour.
!!!
Line 3,587 ⟶ 5,945:
integer :: warnsdorff_numbers(1:8)
integer :: number_of_unpruned_squares
integer :: least_warnsdorff_number
integer :: i
 
Line 3,606 ⟶ 5,963:
!
number_of_unpruned_squares = 0
least_warnsdorff_number = 100
unvisited_moves = unvisited_knight_moves (path)
do i = 1, unvisited_moves%number_of_squares
Line 3,619 ⟶ 5,975:
unpruned_squares(number_of_unpruned_squares) = unvisited_moves%squares(i)
warnsdorff_numbers(number_of_unpruned_squares) = next_moves%number_of_squares
least_warnsdorff_number = &
& min (least_warnsdorff_number, next_moves%number_of_squares)
end if
end do
Line 3,658 ⟶ 6,012:
character(2), intent(in) :: starting_square
 
logical :: solution_found
type(path_t) :: path
 
Line 3,732 ⟶ 6,085:
end if
end do
end program knights_tour_main</langsyntaxhighlight>
 
$ ./knights_tour a1 b2 c3
Line 3,764 ⟶ 6,117:
=={{header|Go}}==
===Warnsdorf's rule===
<langsyntaxhighlight lang="go">package main
 
import (
Line 3,871 ⟶ 6,224:
}
return true
}</langsyntaxhighlight>
{{out}}
<pre>
Line 3,884 ⟶ 6,237:
</pre>
===Ant colony===
<langsyntaxhighlight lang="go">/* Adapted from "Enumerating Knight's Tours using an Ant Colony Algorithm"
by Philip Hingston and Graham Kendal,
PDF at http://www.cs.nott.ac.uk/~gxk/papers/cec05knights.pdf. */
Line 4,075 ⟶ 6,428:
tourCh <- moves
}
}</langsyntaxhighlight>
Output:
<pre>
Line 4,091 ⟶ 6,444:
 
=={{header|Haskell}}==
<syntaxhighlight lang="haskell">import Data.Bifunctor (bimap)
<lang Haskell>{-# LANGUAGE TupleSections #-}
import Data.Char (chr, ord)
 
import Data.List (intercalate, minimumBy, sort, (\\), intercalate, sort)
import Data.Ord (comparing)
import DataControl.CharMonad (ord, chrjoin)
 
import Data.Bool (bool)
---------------------- KNIGHT'S TOUR ---------------------
 
type Square = (Int, Int)
Line 4,105 ⟶ 6,459:
| otherwise = knightTour $ newSquare : moves
where
newSquare = minimumBy (comparing (length . findMoves)) possibilities
minimumBy
(comparing (length . findMoves))
possibilities
possibilities = findMoves $ head moves
findMoves = (\\ moves) . knightOptions
Line 4,111 ⟶ 6,468:
knightOptions :: Square -> [Square]
knightOptions (x, y) =
knightMoves >>= go . bimap (+ x) (+ y)
where
(\(i, j) ->
go let a = x + imove
| uncurry (&&) (both bonBoard move) = y + j[move]
| otherwise = []
in bool [] [(a, b)] (onBoard a && onBoard b))
 
knightMoves :: [(Int, Int)]
knightMoves =
let((>>=) <*> (\deltas =n [id,-> negate]deltas <*>>= go n)) [1, 2, -1, -2]
where
in deltas >>=
go i x
(\i -> deltas >>= (bool [] . return . (i, )) <*> ((abs i /=) . abs))
| abs i /= abs x = [(i, x)]
| otherwise = []
 
onBoard :: Int -> Bool
onBoard = (&&) . (0 <) <*> (9 >)
 
both :: (a -> b) -> (a, a) -> (b, b)
-- TEST ---------------------------------------------------
both = join bimap
 
--------------------------- TEST -------------------------
startPoint :: String
startPoint = "e5"
 
Line 4,135 ⟶ 6,498:
main =
printTour $
algebraic
algebraic <$> knightTour [(\[x, y] -> (ord x - 96, ord y - 48)) startPoint]
<$> knightTour
[(\[x, y] -> (ord x - 96, ord y - 48)) startPoint]
where
printTour [] = return ()
printTour tour = do
putStrLn $ intercalate " -> " $ take 8 tour
printTour $ drop 8 tour</langsyntaxhighlight>
{{Out}}
<pre>e5 -> f7 -> h8 -> g6 -> h4 -> g2 -> e1 -> f3
Line 4,158 ⟶ 6,523:
 
The algorithm doesn't always generate a complete tour.
<langsyntaxhighlight Iconlang="icon">link printf
 
procedure main(A)
Line 4,258 ⟶ 6,623:
}
every write(hdr2|hdr1|&null)
end</langsyntaxhighlight>
 
The following can be used when debugging to validate the board structure and to image the available moves on the board.
<langsyntaxhighlight Iconlang="icon">procedure DumpBoard(B) #: Dump Board internals
write("Board size=",B.N)
write("Available Moves at start of tour:", ImageMovesTo(B.movesto))
Line 4,271 ⟶ 6,636:
every s ||:= " " || (!sort(movesto[k])|"\n")
return s
end</langsyntaxhighlight>
 
 
Line 4,323 ⟶ 6,688:
'''Solution:'''<br>
[[j:Essays/Knight's Tour|The Knight's tour essay on the Jwiki]] shows a couple of solutions including one using [[wp:Knight's_tour#Warnsdorff.27s_algorithm|Warnsdorffs algorithm]].
<langsyntaxhighlight lang="j">NB. knight moves for each square of a (y,y) board
kmoves=: monad define
t=. (>,{;~i.y) +"1/ _2]\2 1 2 _1 1 2 1 _2 _1 2 _1 _2 _2 1 _2 _1
Line 4,339 ⟶ 6,704:
assert. ~:p
(,~y)$/:p
)</langsyntaxhighlight>
 
'''Example Use:'''
<langsyntaxhighlight lang="j"> ktourw 8 NB. solution for an 8 x 8 board
0 25 14 23 28 49 12 31
15 22 27 50 13 30 63 48
Line 4,363 ⟶ 6,728:
555 558 553 778 563 570 775 780 785 772 1000...
100 551 556 561 102 777 572 771 104 781 57...
557 554 101 552 571 562 103 776 573 770 10...</langsyntaxhighlight>
 
=={{header|Java}}==
{{Works with|Java|7}}
<langsyntaxhighlight lang="java">import java.util.*;
 
public class KnightsTour {
Line 4,464 ⟶ 6,829:
}
}
}</langsyntaxhighlight>
<pre>34 17 20 3 36 7 22 5
19 2 35 40 21 4 37 8
Line 4,475 ⟶ 6,840:
===More efficient non-trackback solution===
{{Works with|Java|8}}
<syntaxhighlight lang="text">
package com.knight.tour;
import java.util.ArrayList;
Line 4,634 ⟶ 6,999:
}
}
</syntaxhighlight>
</lang>
<pre>
Found a path for 8 X 8 chess board.
Line 4,651 ⟶ 7,016:
You can test it [http://paulo-jorente.de/webgames/repos/knightsTour/ here].
 
<langsyntaxhighlight lang="javascript">
class KnightTour {
constructor() {
Line 4,867 ⟶ 7,232:
}
new KnightTour();
</syntaxhighlight>
</lang>
To test it, you'll need an index.html
<pre>
Line 4,937 ⟶ 7,302:
A composition of values, drawing on generic abstractions:
{{Trans|Haskell}}
<langsyntaxhighlight lang="javascript">(() => {
'use strict';
 
Line 5,230 ⟶ 7,595:
// MAIN ---
return main();
})();</langsyntaxhighlight>
{{Out}}
<pre>(Board size 8*8)
Line 5,259 ⟶ 7,624:
=={{header|Julia}}==
Uses the Hidato puzzle solver module, which has its source code listed [[Solve_a_Hidato_puzzle#Julia | here]] in the Hadato task.
<langsyntaxhighlight lang="julia">using .Hidato # Note that the . here means to look locally for the module rather than in the libraries
 
const chessboard = """
Line 5,277 ⟶ 7,642:
hidatosolve(board, maxmoves, knightmoves, fixed, starts[1][1], starts[1][2], 1)
printboard(board)
</langsyntaxhighlight>{{output}}<pre>
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
Line 5,300 ⟶ 7,665:
{{trans|Haskell}}
 
<langsyntaxhighlight lang="scala">data class Square(val x : Int, val y : Int)
 
val board = Array(8 * 8, { Square(it / 8 + 1, it % 8 + 1) })
Line 5,328 ⟶ 7,693:
col = (col + 1) % 8
}
}</langsyntaxhighlight>
 
{{out}}
Line 5,344 ⟶ 7,709:
Influenced by the Python version, although computed tours are different.
 
<langsyntaxhighlight lang="locobasic">10 mode 1:defint a-z
20 input "Board size: ",size
30 input "Start position: ",a$
Line 5,390 ⟶ 7,755:
450 ' skip this move
460 next
470 return</langsyntaxhighlight>
 
[[File:Knights tour Locomotive Basic.png]]
 
=={{header|Lua}}==
<langsyntaxhighlight lang="lua">N = 8
 
moves = { {1,-2},{2,-1},{2,1},{1,2},{-1,2},{-2,1},{-2,-1},{-1,-2} }
Line 5,445 ⟶ 7,810:
print( string.format( "%s%d - %s%d", string.sub("ABCDEFGH",last[1],last[1]), last[2], string.sub("ABCDEFGH",lst[i][1],lst[i][1]), lst[i][2] ) )
last = lst[i]
end</langsyntaxhighlight>
=={{header|M2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
<lang M2000 Interpreter>
Function KnightTour$(StartW=1, StartH=1){
def boolean swapH, swapV=True
Line 5,550 ⟶ 7,915:
Clipboard ex$
Report ex$
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 5,590 ⟶ 7,955:
d6->f5->e3->c4->e5->c6->d4->f3
</pre>
 
=={{header|m4}}==
Warnsdorff’s rule, with random tie-breaks. The program keeps trying
until it finds a solution. Running time can vary a lot.
 
Beware the program writes to a file ‘__random_number__’ in the working directory. (This can be avoided in GNU m4 by using ‘esyscmd’ instead of ‘syscmd’. I do not know how to avoid it in general.)
 
<syntaxhighlight lang="m4">divert(-1)
 
----------------------------------------------------------------------
 
This is free and unencumbered software released into the public
domain.
 
Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.
 
In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.
 
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
 
For more information, please refer to <http://unlicense.org/>
 
----------------------------------------------------------------------
 
Find a Knight's tour, via Warnsdorff's rule.
 
For very old or 'Heirloom' m4, you may need to increase the sizes of
internal structures, with, say,
 
m4 -S 1000 -B 100000 knights_tour.m4
 
But I would use one of OpenBSD m4, GNU m4, etc., instead.
 
----------------------------------------------------------------------
 
dnl Get a random number from 0 to one less than $1.
dnl (Note that this is not a very good RNG. Also it writes a file.)
define(`randnum',
`syscmd(`echo $RANDOM > __random_number__')eval(include(__random_number__) % ( $1 ))')
 
 
dnl The left deconstructors for strings.
define(`string_car',`substr($1,0,1)')
define(`string_cdr',`substr($1,1)')
 
dnl Algebraic notation to 'i0j0', with i the ranks and j the files. Bad
dnl algebraic notation gets tranformed to '99999999'.
define(`alg2ij',
`ifelse($1,`a1',`1010',$1,`a2',`2010',$1,`a3',`3010',$1,`a4',`4010',
$1,`a5',`5010',$1,`a6',`6010',$1,`a7',`7010',$1,`a8',`8010',
$1,`b1',`1020',$1,`b2',`2020',$1,`b3',`3020',$1,`b4',`4020',
$1,`b5',`5020',$1,`b6',`6020',$1,`b7',`7020',$1,`b8',`8020',
$1,`c1',`1030',$1,`c2',`2030',$1,`c3',`3030',$1,`c4',`4030',
$1,`c5',`5030',$1,`c6',`6030',$1,`c7',`7030',$1,`c8',`8030',
$1,`d1',`1040',$1,`d2',`2040',$1,`d3',`3040',$1,`d4',`4040',
$1,`d5',`5040',$1,`d6',`6040',$1,`d7',`7040',$1,`d8',`8040',
$1,`e1',`1050',$1,`e2',`2050',$1,`e3',`3050',$1,`e4',`4050',
$1,`e5',`5050',$1,`e6',`6050',$1,`e7',`7050',$1,`e8',`8050',
$1,`f1',`1060',$1,`f2',`2060',$1,`f3',`3060',$1,`f4',`4060',
$1,`f5',`5060',$1,`f6',`6060',$1,`f7',`7060',$1,`f8',`8060',
$1,`g1',`1070',$1,`g2',`2070',$1,`g3',`3070',$1,`g4',`4070',
$1,`g5',`5070',$1,`g6',`6070',$1,`g7',`7070',$1,`g8',`8070',
$1,`h1',`1080',$1,`h2',`2080',$1,`h3',`3080',$1,`h4',`4080',
$1,`h5',`5080',$1,`h6',`6080',$1,`h7',`7080',$1,`h8',`8080',
`99999999')')
 
dnl The reverse of alg2ij. Bad 'i0j0' get transformed to 'z0'.
define(`ij2alg',
`ifelse($1,`1010',`a1',$1,`2010',`a2',$1,`3010',`a3',$1,`4010',`a4',
$1,`5010',`a5',$1,`6010',`a6',$1,`7010',`a7',$1,`8010',`a8',
$1,`1020',`b1',$1,`2020',`b2',$1,`3020',`b3',$1,`4020',`b4',
$1,`5020',`b5',$1,`6020',`b6',$1,`7020',`b7',$1,`8020',`b8',
$1,`1030',`c1',$1,`2030',`c2',$1,`3030',`c3',$1,`4030',`c4',
$1,`5030',`c5',$1,`6030',`c6',$1,`7030',`c7',$1,`8030',`c8',
$1,`1040',`d1',$1,`2040',`d2',$1,`3040',`d3',$1,`4040',`d4',
$1,`5040',`d5',$1,`6040',`d6',$1,`7040',`d7',$1,`8040',`d8',
$1,`1050',`e1',$1,`2050',`e2',$1,`3050',`e3',$1,`4050',`e4',
$1,`5050',`e5',$1,`6050',`e6',$1,`7050',`e7',$1,`8050',`e8',
$1,`1060',`f1',$1,`2060',`f2',$1,`3060',`f3',$1,`4060',`f4',
$1,`5060',`f5',$1,`6060',`f6',$1,`7060',`f7',$1,`8060',`f8',
$1,`1070',`g1',$1,`2070',`g2',$1,`3070',`g3',$1,`4070',`g4',
$1,`5070',`g5',$1,`6070',`g6',$1,`7070',`g7',$1,`8070',`g8',
$1,`1080',`h1',$1,`2080',`h2',$1,`3080',`h3',$1,`4080',`h4',
$1,`5080',`h5',$1,`6080',`h6',$1,`7080',`h7',$1,`8080',`h8',
`z0')')
 
dnl Move a knight from one square to another by an ij-vector. Both input
dnl and output are algebraic notation. If the move is illegal, it comes
dnl out as 'z0'.
define(`move_by',`ij2alg(eval(alg2ij($3) + 1000 * ( $1 ) + 10 * ( $2 )))')
 
dnl For example, a1d3c5 -> 3
define(`path_length',`eval(len($1) / 2)')
 
dnl The left deconstructors for paths.
define(`path_car',`substr($1,0,2)')
define(`path_cdr',`substr($1,2)')
 
dnl The right deconstructors for paths.
define(`path_last',`substr($1,eval(len($1) - 2))')
define(`path_drop_last',`substr($1,0,eval(len($1) - 2))')
 
dnl Extract the nth position from the path.
define(`path_nth',`substr($1,eval(( $2 ) * 2),2)')
 
define(`random_move',`path_nth($1,randnum(path_length($1)))')
 
dnl Is the position $1 contained in the path $2?
define(`path_contains',`ifelse(index($2,$1),-1,0,1)')
 
dnl Find all moves from position $1 that are not already in
dnl the path $2.
define(`possible_moves',
`ifelse(path_contains(move_by(1,2,$1),$2`'z0),`0',move_by(1,2,$1))`'dnl
ifelse(path_contains(move_by(2,1,$1),$2`'z0),`0',move_by(2,1,$1))`'dnl
ifelse(path_contains(move_by(1,-2,$1),$2`'z0),`0',move_by(1,-2,$1))`'dnl
ifelse(path_contains(move_by(2,-1,$1),$2`'z0),`0',move_by(2,-1,$1))`'dnl
ifelse(path_contains(move_by(-1,2,$1),$2`'z0),`0',move_by(-1,2,$1))`'dnl
ifelse(path_contains(move_by(-2,1,$1),$2`'z0),`0',move_by(-2,1,$1))`'dnl
ifelse(path_contains(move_by(-1,-2,$1),$2`'z0),`0',move_by(-1,-2,$1))`'dnl
ifelse(path_contains(move_by(-2,-1,$1),$2`'z0),`0',move_by(-2,-1,$1))')
 
dnl Count how many moves can follow each move in $1.
define(`follows_counts',
`ifelse($1,`',`',
`path_length(possible_moves(path_car($1),$2))`'follows_counts(path_cdr($1),$2)')')
 
dnl Find the smallest positive digit, or zero.
define(`min_positive',
`ifelse($1,`',0,
`pushdef(`min1',min_positive(string_cdr($1)))`'dnl
pushdef(`val1',string_car($1))`'dnl
ifelse(min1,0,val1,
val1,0,min1,
eval(val1 < min1),1,val1,min1)`'dnl
popdef(`min1',`val1')')')
 
dnl Change everything to zero that is not the minimum positive.
define(`apply_warnsdorff',`_$0(min_positive($1),$1)')
define(`_apply_warnsdorff',
`ifelse($2,`',`',`ifelse(string_car($2),$1,$1,0)`'$0($1,string_cdr($2))')')
 
dnl Find potential next moves that satisfy Warnsdorff's rule.
define(`warnsdorff_moves',
`pushdef(`moves',`possible_moves($1,$2)')`'dnl
pushdef(`selections',`apply_warnsdorff(follows_counts(moves))')`'dnl
_$0(moves,selections)`'dnl
popdef(`moves',`selections')')
define(`_warnsdorff_moves',
`ifelse($1,`',`',
`ifelse(string_car($2),0,`$0(path_cdr($1),string_cdr($2))',
`path_car($1)`'$0(path_cdr($1),string_cdr($2))')')')
 
dnl Find potential next moves for the given path.
define(`next_moves',
`ifelse(path_length($1),63,`possible_moves(path_last($1),$1)',
`warnsdorff_moves(path_last($1),$1)')')
 
define(`find_tour',
`ifelse($2,`',`find_tour($1,$1)',
path_length($2),64,$2,
`pushdef(`moves',next_moves($2))`'dnl
ifelse(moves,`',`find_tour($1)',
`find_tour($1,$2`'random_move(next_moves($2)))')`'dnl
popdef(`moves')')')
 
divert`'dnl
dnl
find_tour(a1)
find_tour(c5)
find_tour(h8)</syntaxhighlight>
 
{{out}}
This is just a sample. Outputs are random.
 
$ m4 knights_tour.m4
<pre>a1c2a3b1d2f1h2g4h6g8e7c8a7b5c7a8b6a4b2d1f2h1g3h5g7e8f6h7f8d7b8a6b4a2c1e2g1h3g5f7h8g6h4g2e1d3c5b7d8e6f4d5c3e4d6f5e3c4a5b3d4c6e5f3
c5b7d8f7h8g6h4g2e1c2a1b3c1a2b4a6b8d7f8h7g5h3g1e2g3h1f2d1b2a4b6a8c7e8g7h5f6g8h6g4h2f1d2b1a3b5a7c8e7d5c3e4d6f5e3c4a5c6d4e6f4d3e5f3
h8g6f8h7g5h3g1e2c1a2b4a6b8d7b6a8c7e8g7h5g3h1f2d1b2a4c5b7a5b3a1c2e1g2h4f3h2f1d2b1a3b5a7c8e7g8h6f7d8e6f4d3e5g4f6d5c3e4d6c4e3f5d4c6</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
'''Solution'''
<langsyntaxhighlight Mathematicalang="mathematica">knightsTourMoves[start_] :=
Module[{
vertexLabels = (# -> ToString@c[[Quotient[# - 1, 8] + 1]] <> ToString[Mod[# - 1, 8] + 1]) & /@ Range[64], knightsGraph,
Line 5,600 ⟶ 8,159:
hamiltonianCycle = ((FindHamiltonianCycle[knightsGraph] /. UndirectedEdge -> DirectedEdge) /. labels)[[1]];
end = Cases[hamiltonianCycle, (x_ \[DirectedEdge] start) :> x][[1]];
FindShortestPath[g, start, end]]</langsyntaxhighlight>
 
'''Usage'''
<langsyntaxhighlight Mathematicalang="mathematica">knightsTourMoves["d8"]
 
(* out *)
Line 5,609 ⟶ 8,168:
"c7", "a8", "b6", "c8", "d6", "e4", "d2", "f1", "e3", "d1", "f2", "h1", "g3", "e2", "c1", "d3", "e1", "g2", "h4", "f5", "e7", "d5", \
"f4", "h5", "g7", "e8", "f6", "g8", "h6", "g4", "h2", "f3", "g1", "h3", "g5", "h7", "f8", "d7", "e5", "g6", "h8", "f7"}
</syntaxhighlight>
</lang>
 
'''Analysis'''
 
'''vertexLabels''' replaces the default vertex (i.e. square) names of the chessboard with the standard algebraic names "a1", "a2",...,"h8".
<syntaxhighlight lang="mathematica">
<lang Mathematica>
vertexLabels = (# -> ToString@c[[Quotient[# - 1, 8] + 1]] <> ToString[Mod[# - 1, 8] + 1]) & /@ Range[64]
 
Line 5,625 ⟶ 8,184:
41 -> "f1", 42 -> "f2", 43 -> "f3", 44 -> "f4", 45 -> "f5", 46 -> "f6", 47 -> "f7", 48 -> "f8",
49 -> "g1", 50 -> "g2", 51 -> "g3", 52 -> "g4", 53 -> "g5", 54 -> "g6",55 -> "g7", 56 -> "g8",
57 -> "h1", 58 -> "h2", 59 -> "h3", 60 -> "h4", 61 -> "h5", 62 -> "h6", 63 -> "h7", 64 -> "h8"}</langsyntaxhighlight>
 
'''knightsGraph''' creates a graph of the solution space.
<langsyntaxhighlight Mathematicalang="mathematica">knightsGraph = KnightTourGraph[i, i, VertexLabels -> vertexLabels, ImagePadding -> 15];</langsyntaxhighlight>
[[File:KnightsTour-3.png]]
 
Find a Hamiltonian cycle (a path that visits each square exactly one time.)
 
<langsyntaxhighlight Mathematicalang="mathematica">hamiltonianCycle = ((FindHamiltonianCycle[knightsGraph] /. UndirectedEdge -> DirectedEdge) /. labels)[[1]];</langsyntaxhighlight>
 
Find the end square:
 
<langsyntaxhighlight Mathematicalang="mathematica">end = Cases[hamiltonianCycle, (x_ \[DirectedEdge] start) :> x][[1]];</langsyntaxhighlight>
 
Find shortest path from the start square to the end square.
 
<syntaxhighlight lang Mathematica="mathematica">FindShortestPath[g, start, end]]</langsyntaxhighlight>
 
=={{header|Mathprog}}==
Line 5,650 ⟶ 8,209:
2. It is possible to specify which square is used for any Knights Move.
 
<syntaxhighlight lang="text">
/*Knights.mathprog
Line 5,712 ⟶ 8,271:
end;
</syntaxhighlight>
</lang>
 
Produces:
 
<syntaxhighlight lang="text">
GLPSOL: GLPK LP/MIP Solver, v4.47
Parameter(s) specified in the command line:
Line 5,762 ⟶ 8,321:
23 10 21 16 25
Model has been successfully processed
</syntaxhighlight>
</lang>
 
and
 
<syntaxhighlight lang="text">
/*Knights.mathprog
Line 5,831 ⟶ 8,390:
end;
</syntaxhighlight>
</lang>
 
Produces:
 
<syntaxhighlight lang="text">
GLPSOL: GLPK LP/MIP Solver, v4.47
Parameter(s) specified in the command line:
Line 5,900 ⟶ 8,459:
10 55 20 57 12 37 40 1
Model has been successfully processed
</syntaxhighlight>
</lang>
 
=={{header|Nim}}==
Line 5,908 ⟶ 8,467:
We have added a case to test the absence of solution. Note that, in this case, there is a lot of backtracking which considerably slows down the execution.
 
<langsyntaxhighlight Nimlang="nim">import algorithm, options, random, parseutils, strutils, strformat
 
type
Line 6,009 ⟶ 8,568:
#run[5]("c4") # No solution, so very slow compared to other cases.
run[8]("b5")
run[31]("a1")</langsyntaxhighlight>
 
{{out}}
Line 6,064 ⟶ 8,623:
4 67 64 61 238 69 96 59 244 71 94 57 310 73 92 55 354 75 90 53 374 77 88 51 156 79 86 49 146 81 84
1 62 3 68 65 60 237 70 95 58 245 72 93 56 311 74 91 54 355 76 89 52 157 78 87 50 147 80 85 48 145</pre>
 
=={{header|ObjectIcon}}==
{{trans|ATS}}
<syntaxhighlight lang="objecticon">#
# Find Knight’s Tours.
#
# Using Warnsdorff’s heuristic, find multiple solutions.
#
# Based on my ATS/Postiats program.
#
# The main difference from the ATS is this program uses a
# co-expression pair to make a generator of solutions, whereas the ATS
# simply prints solutions where they are found.
#
# Usage: ./knights_tour [START_POSITION [MAX_TOURS [closed]]]
# Examples:
# ./knights_tour (prints one tour starting from a1)
# ./knights_tour c5
# ./knights_tour c5 2000
# ./knights_tour c5 2000 closed
#
 
$define DEFAULT_NUMBER_OF_RANKS 8
$define DEFAULT_NUMBER_OF_FILES 8
 
import io
 
procedure main(args)
local f_out
local tours
local tour_board
local n_tour
local starting_position
local i, j
local max_tours
local closed_only
 
starting_position := \algebraic_notation_to_i_j(args[1]) | [1, 1]
i := starting_position[1]
j := starting_position[2]
 
max_tours := integer(args[2]) | 1
closed_only := if \args[3] === "closed" then &yes else &no
 
f_out := FileStream.stdout
 
tours := KnightsTours()
n_tour := 0
if n_tour < max_tours then
every tour_board := tours.generate(i, j, closed_only) do
{
n_tour +:= 1
write("Tour number ", n_tour)
f_out.write(tour_board.make_moves_display())
f_out.write(tour_board.make_board_display())
f_out.write()
if max_tours <= n_tour then
break
}
end
 
procedure algebraic_notation_to_i_j(s)
return [integer(s[2]), ord(s[1]) - ord('a') + 1]
end
 
class Move()
public const i
public const j
 
public new(rank, file)
i := rank
j := file
return
end
 
public make_display(n_ranks)
return char(ord('a') + j - 1) || i
end
end
 
class Chessboard()
 
public const n_ranks
public const n_files
public const n_squares
private board
 
public new(num_ranks, num_files)
/num_ranks := DEFAULT_NUMBER_OF_RANKS
/num_files := DEFAULT_NUMBER_OF_FILES
 
n_files := num_files
n_ranks := num_ranks
n_squares := n_ranks * n_files
board := list(n_squares)
return
end
 
public copy()
local new_board
local i
 
new_board := Chessboard(n_files, n_ranks)
every i := 1 to n_squares do
new_board.board[i] := board[i]
return new_board
end
 
public square(i, j)
# The board is stored in column-major order.
return board[i + (n_ranks * (j - 1))]
end
 
public try(i, j, value)
# Backtracking assignment. Though we use it for ordinary
# assignment.
#
# The board is stored in column-major order.
suspend board[i + (n_ranks * (j - 1))] <- value
end
 
public make_board_display()
local s
local i, j
 
s := ""
every i := n_ranks to 1 by -1 do
{
s ||:= " "
every j := 1 to n_files do
s ||:= "+----"
s ||:= "+\n"
s ||:= right(i, 2) || " "
every j := 1 to n_files do
s ||:= " | " || (\right(square(i, j), 2))
s ||:= " |\n"
}
s ||:= " "
every j := 1 to n_files do
s ||:= "+----"
s ||:= "+\n"
s ||:= " "
every j := 1 to n_files do
s ||:= " " || char(ord('a') + j - 1)
return s
end
 
public make_moves_display()
local positions
local i, j
local s
local first_position, last_position
 
positions := list(n_squares)
every i := 1 to n_ranks do
every j := 1 to n_files do
positions[square(i, j)] := Move(i, j)
 
s := ""
every j := 1 to n_squares - 1 do
{
s ||:= positions[j].make_display()
s ||:= (if j % n_files = 0 then " ->\n" else " -> ")
}
s ||:= positions[n_squares].make_display()
 
first_position := find_nth_position(1)
last_position := find_nth_position(n_squares)
if knight_positions_are_attacking(first_position.i,
first_position.j,
last_position.i,
last_position.j) then
s ||:= " -> cycle"
 
return s
end
 
public find_nth_position(n)
local i, j
local position
 
position := &null
i := 1
while /position & i <= n_ranks do
{
j := 1
while /position & j <= n_files do
{
if square(i, j) = n then
position := Move(i, j)
j +:= 1
}
i +:= 1
}
return position
end
 
end
 
class KnightsTours()
 
public const n_ranks
public const n_files
public const n_squares
private board
 
public new(num_ranks, num_files, i, j, closed_only)
board := Chessboard(num_ranks, num_files)
n_ranks := board.n_ranks
n_files := board.n_files
n_squares := board.n_squares
return
end
 
public generate(i, j, closed_only)
# i,j = starting position.
 
local consumer
local explorer
local tour_board
 
# Simple coroutines. The consumer receives complete tours (each in
# the form of a Chessboard) from the explorer.
consumer := &current
explorer := create explore(consumer, i, j, 1,
closed_only, i, j)
 
while tour_board := @explorer do
suspend tour_board
end
 
private explore(consumer, i, j, n_position,
closed_only, i_start, j_start)
# i,j = starting position.
board.try(i, j, n_position)
explore_inner(consumer, i, j, n_position,
closed_only, i_start, j_start)
board.try(i, j, &null)
end
 
private explore_inner(consumer, i, j, n_position,
closed_only, i_start, j_start)
local moves, mv
 
if n_squares - n_position = 1 then
{
# Is the last move possible? If so, make it and output the
# board. (Only zero or one of the moves can be non-null.)
moves := possible_moves(i, j)
every try_last_move(consumer, moves[1 to 8],
closed_only, i_start, j_start)
}
else
{
moves := next_moves(i, j, n_position)
every mv := !moves do
if \mv then
explore(consumer, mv.i, mv.j, n_position + 1,
closed_only, i_start, j_start)
}
end
 
private try_last_move(consumer, move, closed_only, i_start, j_start)
if \move then
if (/closed_only |
knight_positions_are_attacking(move.i, move.j,
i_start, j_start)) then
{
board.try(move.i, move.j, n_squares)
(board.copy())@consumer
board.try(move.i, move.j, &null)
}
end
 
private next_moves(i, j, n_position)
local moves
local w_list, w
local k
 
moves := possible_moves(i, j)
w_list := list(8)
every k := 1 to 8 do
w_list[k] := count_following_moves(moves[k], n_position)
w := pick_w(w_list)
if w = 0 then
# A dead end.
moves := list(8, &null)
else
# w is least positive number of following moves. Nullify any
# move that has either zero following moves (it is a dead end)
# or more than w following moves (it violates Warnsdorff’s
# heuristic).
every k := 1 to 8 do
if w_list[k] ~= w then
moves[k] := &null
return moves
end
 
private count_following_moves(move, n_position)
local w
local following_moves
 
w := 0
if \move then
{
board.try(move.i, move.j, n_position + 1)
following_moves := possible_moves(move.i, move.j)
every ( \following_moves[1 to 8] & w +:= 1 )
board.try(move.i, move.j, &null)
}
return w
end
 
private pick_w(w_list)
local w
 
w := 0
every w := next_pick (w, w_list[1 to 8])
return w
end
 
private next_pick(u, v)
local w
 
if v = 0 then
w := u
else if u = 0 then
w := v
else
w := min (u, v)
return w
end
 
private possible_moves(i, j)
local move1, move2, move3, move4
local move5, move6, move7, move8
 
move1 := try_move(i + 1, j + 2)
move2 := try_move(i + 2, j + 1)
move3 := try_move(i + 1, j - 2)
move4 := try_move(i + 2, j - 1)
move5 := try_move(i - 1, j + 2)
move6 := try_move(i - 2, j + 1)
move7 := try_move(i - 1, j - 2)
move8 := try_move(i - 2, j - 1)
return [move1, move2, move3, move4,
move5, move6, move7, move8]
end
 
private try_move(i1, j1)
return (1 <= i1 <= n_ranks &
1 <= j1 <= n_files &
/board.square(i1, j1) &
Move(i1, j1)) | &null
end
 
end
 
procedure knight_positions_are_attacking(i1, j1, i2, j2)
local i_diff, j_diff
 
i_diff := abs(i1 - i2)
j_diff := abs(j1 - j2)
return (((i_diff = 2 & j_diff = 1) |
(i_diff = 1 & j_diff = 2)) & &yes) | fail
end</syntaxhighlight>
 
{{out}}
$ ./knights_tour c5 2 closed
<pre>Tour number 1
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> e8 -> d6 -> b5 -> d4 -> f5 -> g7 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 58 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 63 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 60 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 61 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
 
Tour number 2
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> b5 -> d6 -> e8 -> g7 -> f5 -> d4 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 60 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 61 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 58 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 63 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
</pre>
 
=={{header|Perl}}==
Knight's tour using [[wp:Knight's_tour#Warnsdorff.27s_algorithm|Warnsdorffs algorithm]]
<langsyntaxhighlight lang="perl">use strict;
use warnings;
# Find a knight's tour
Line 6,153 ⟶ 9,137:
return unless $square =~ /^([a-h])([1-8])$/;
return (8-$2, ord($1) - ord('a'));
}</langsyntaxhighlight>
 
Sample output (start square c3):
Line 6,161 ⟶ 9,145:
=={{header|Phix}}==
This is pretty fast (<<1s) up to size 48, before some sizes start to take quite some time to complete. It will even solve a 200x200 in 0.67s
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">size</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">8</span><span style="color: #0000FF;">,</span>
Line 6,246 ⟶ 9,230:
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"no solutions found\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 6,259 ⟶ 9,243:
50 27 12 35 64 25 10 7
solution found in 64 tries (0.00s)
</pre>
 
=={{header|Picat}}==
<syntaxhighlight lang="picat">import cp.
 
main =>
N = 8,
A = new_array(N,N),
foreach (R in 1..N, C in 1..N)
Connected = [(R+1, C+2),
(R+1, C-2),
(R-1, C+2),
(R-1, C-2),
(R+2, C+1),
(R+2, C-1),
(R-2, C+1),
(R-2, C-1)],
A[R,C] :: [(R1-1)*N+C1 : (R1,C1) in Connected, R1 >= 1, R1 =< N, C1 >= 1, C1 =< N]
end,
V = vars(A),
circuit(V),
solve([ff],V),
OutputM = new_array(N,N),
fill_output_matrix(N,OutputM,V,1,1),
foreach (R in 1..N)
foreach (C in 1..N)
printf("%3d ", OutputM[R,C])
end,
nl
end.
 
fill_output_matrix(N,OutputM,V,I,Count) =>
if Count =< N*N then
R = (I-1) div N + 1,
C = (I-1) mod N + 1,
OutputM[R,C] = Count,
fill_output_matrix(N,OutputM,V,V[I],Count+1)
end.
</syntaxhighlight>
 
{{out}}
<pre>
1 62 5 10 13 24 55 8
4 11 2 63 6 9 14 23
61 64 35 12 25 56 7 54
34 3 26 59 36 15 22 57
39 60 37 18 27 58 53 16
30 33 40 43 46 17 50 21
41 38 31 28 19 48 45 52
32 29 42 47 44 51 20 49
</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(load "@lib/simul.l")
 
# Build board
Line 6,291 ⟶ 9,325:
(moves Tour) )
(push 'Tour @) )
(flip Tour) )</langsyntaxhighlight>
Output:
<pre>-> (b1 a3 b5 a7 c8 b6 a8 c7 a6 b8 d7 f8 h7 g5 h3 g1 e2 c1 a2 b4 c2 a1 b3 a5 b7
Line 6,299 ⟶ 9,333:
=={{header|PostScript}}==
You probably shouldn't send this to a printer. Solution using Warnsdorffs algorithm.
<langsyntaxhighlight lang="postscript">%!PS-Adobe-3.0
%%BoundingBox: 0 0 300 300
 
Line 6,408 ⟶ 9,442:
3 1 100 { solve } for
 
%%EOF</langsyntaxhighlight>
 
=={{header|Prolog}}==
Line 6,414 ⟶ 9,448:
Knights tour using [[wp:Knight's_tour#Warnsdorff.27s_algorithm|Warnsdorffs algorithm]]
 
<langsyntaxhighlight Prologlang="prolog">% N is the number of lines of the chessboard
knight(N) :-
Max is N * N,
Line 6,494 ⟶ 9,528:
M1 is M + 1,
display(N, M1, T).
</syntaxhighlight>
</lang>
 
Output :
Line 6,533 ⟶ 9,567:
===Alternative version===
{{Works with|GNU Prolog}}
<langsyntaxhighlight lang="prolog">:- initialization(main).
 
 
Line 6,589 ⟶ 9,623:
 
 
main :- make_graph, hamiltonian(5*3,Pn), show_path(Pn), halt.</langsyntaxhighlight>
{{Output}}
<pre> 5 18 35 22 3 16 55 24
Line 6,603 ⟶ 9,637:
=={{header|Python}}==
Knights tour using [[wp:Knight's_tour#Warnsdorff.27s_algorithm|Warnsdorffs algorithm]]
<langsyntaxhighlight lang="python">import copy
 
boardsize=6
Line 6,667 ⟶ 9,701:
start = input('Start position: ')
board = knights_tour(start, boardsize)
print(boardstring(board, boardsize=boardsize))</langsyntaxhighlight>
 
;Sample runs
Line 6,748 ⟶ 9,782:
Based on a slight modification of [[wp:Knight%27s_tour#Warnsdorff.27s_rule|Warnsdorff's algorithm]], in that if a dead-end is reached, the program backtracks to the next best move.
 
<langsyntaxhighlight lang="r">#!/usr/bin/Rscript
# M x N Chess Board.
Line 6,816 ⟶ 9,850:
# Begin tour.
setboard(position, 1); knightTour(position, 2)</langsyntaxhighlight>
 
Output:
Line 6,834 ⟶ 9,868:
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">
#lang racket
(define N 8)
Line 6,859 ⟶ 9,893:
" "))))
(draw (tour (random N) (random N)))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 6,875 ⟶ 9,909:
(formerly Perl 6)
{{trans|Perl}}
<syntaxhighlight lang="raku" line>my @board;
{{works with|rakudo|2015-09-17}}
<lang perl6>my @board;
 
my $I = 8;
Line 6,899 ⟶ 9,932:
# Record current move
push @moves, to_algebraic($i,$j);
# @board[$i] //= []; # (uncomment if autoviv is broken)
@board[$i][$j] = $move;
Line 6,949 ⟶ 9,981:
sub from_algebraic($square where /^ (<[a..z]>) (\d+) $/) {
$I - $1, ord(~$0) - ord('a');
}</langsyntaxhighlight>
(Output identical to Perl's above.)
 
=={{Header|RATFOR}}==
{{trans|ATS}}
For use with the public domain ratfor77 translator and a FORTRAN 77 compiler.
<syntaxhighlight lang="ratfor">#-----------------------------------------------------------------------
#
# Find Knight’s Tours.
#
# Using Warnsdorff’s heuristic, find multiple solutions.
# Optionally accept only closed tours.
#
# This program is migrated from my implementation for ATS/Postiats.
# Arrays with dimension 1:64 take the place of stack frames.
#
# Compile with, for instance:
#
# ratfor77 knights_tour.r > knights_tour.f
# gfortran -O2 -g -std=legacy -o knights_tour knights_tour.f
#
# or
#
# ratfor77 knights_tour.r > knights_tour.f
# f2c knights_tour.f
# cc -O -o knights_tour knights_tour.c -lf2c
#
# Usage examples:
#
# One tour starting at a1, either open or closed:
#
# echo "a1 1 F" | ./knights_tour
#
# No more than 2000 closed tours starting at c5:
#
# echo "c5 2000 T" | ./knights_tour
#
#-----------------------------------------------------------------------
 
program ktour
implicit none
 
character*2 alg
integer i, j
integer mxtour
logical closed
 
read (*,*) alg, mxtour, closed
call alg2ij (alg, i, j)
call explor (i, j, mxtour, closed)
 
end
 
#-----------------------------------------------------------------------
 
subroutine explor (istart, jstart, mxtour, closed)
implicit none
 
# Explore the space of 'Warnsdorffian' knight’s paths, looking for
# and printing complete tours.
 
integer istart, jstart # The starting position.
integer mxtour # The maximum number of tours to print.
logical closed # Closed tours only?
 
integer board(1:8,1:8)
integer imove(1:8,1:64)
integer jmove(1:8,1:64)
integer nmove(1:64)
integer n
integer itours
logical goodmv
logical isclos
 
itours = 0
call initbd (board)
n = 1
nmove(1) = 8
imove(8, 1) = istart
jmove(8, 1) = jstart
 
while (itours < mxtour && n != 0) {
if (nmove(n) == 9) {
n = n - 1
if (n != 0) {
call unmove (board, imove, jmove, nmove, n)
nmove(n) = nmove(n) + 1
}
} else if (goodmv (imove, nmove, n)) {
call mkmove (board, imove, jmove, nmove, n)
if (n == 64) {
if (.not. closed) {
itours = itours + 1
call prnt (board, itours)
} else if (isclos (board)) {
itours = itours + 1
call prnt (board, itours)
}
call unmove (board, imove, jmove, nmove, n)
nmove(n) = 9
} else if (n == 63) {
call possib (board, n, imove, jmove, nmove)
n = n + 1
nmove(n) = 1
} else {
call nxtmov (board, n, imove, jmove, nmove)
n = n + 1
nmove(n) = 1
}
} else {
nmove(n) = nmove(n) + 1
}
}
 
end
 
#-----------------------------------------------------------------------
 
subroutine initbd (board)
implicit none
 
# Initialize a chessboard with empty squares.
 
integer board(1:8,1:8)
 
integer i, j
 
do j = 1, 8 {
do i = 1, 8 {
board(i, j) = -1
}
}
 
end
 
#-----------------------------------------------------------------------
 
subroutine mkmove (board, imove, jmove, nmove, n)
implicit none
 
# Fill a square with a move number.
 
integer board(1:8, 1:8)
integer imove(1:8, 1:64)
integer jmove(1:8, 1:64)
integer nmove(1:64)
integer n
 
board(imove(nmove(n), n), jmove(nmove(n), n)) = n
 
end
 
#-----------------------------------------------------------------------
 
subroutine unmove (board, imove, jmove, nmove, n)
implicit none
 
# Unmake a mkmove.
 
integer board(1:8, 1:8)
integer imove(1:8, 1:64)
integer jmove(1:8, 1:64)
integer nmove(1:64)
integer n
 
board(imove(nmove(n), n), jmove(nmove(n), n)) = -1
 
end
 
#-----------------------------------------------------------------------
 
function goodmv (imove, nmove, n)
implicit none
 
logical goodmv
integer imove(1:8, 1:64)
integer nmove(1:64)
integer n
 
goodmv = (imove(nmove(n), n) != -1)
 
end
 
#-----------------------------------------------------------------------
 
subroutine prnt (board, itours)
implicit none
 
# Print a knight's tour.
 
integer board(1:8,1:8)
integer itours
 
10000 format (1X)
 
# The following plethora of format statements seemed a simple way to
# get this working with f2c. (For gfortran, the 'I0' format
# sufficed.)
10010 format (1X, "Tour number ", I1)
10020 format (1X, "Tour number ", I2)
10030 format (1X, "Tour number ", I3)
10040 format (1X, "Tour number ", I4)
10050 format (1X, "Tour number ", I5)
10060 format (1X, "Tour number ", I6)
10070 format (1X, "Tour number ", I20)
 
if (itours < 10) {
write (*, 10010) itours
} else if (itours < 100) {
write (*, 10020) itours
} else if (itours < 1000) {
write (*, 10030) itours
} else if (itours < 10000) {
write (*, 10040) itours
} else if (itours < 100000) {
write (*, 10050) itours
} else if (itours < 1000000) {
write (*, 10060) itours
} else {
write (*, 10070) itours
}
call prntmv (board)
call prntbd (board)
write (*, 10000)
 
end
 
#-----------------------------------------------------------------------
 
subroutine prntbd (board)
implicit none
 
# Print a chessboard with the move number in each square.
 
integer board(1:8,1:8)
 
integer i, j
 
10000 format (1X, " ", 8("+----"), "+")
10010 format (1X, I2, " ", 8(" | ", I2), " | ")
10020 format (1X, " ", 8(" ", A1))
 
do i = 8, 1, -1 {
write (*, 10000)
write (*, 10010) i, (board(i, j), j = 1, 8)
}
write (*, 10000)
write (*, 10020) 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h'
 
end
 
#-----------------------------------------------------------------------
 
subroutine prntmv (board)
implicit none
 
# Print the moves of a knight's path, in algebraic notation.
 
integer board(1:8,1:8)
 
integer ipos(1:64)
integer jpos(1:64)
integer numpos
character*2 alg(1:64)
integer columns(1:8)
integer k
integer m
 
character*72 lines(1:8)
 
10000 format (1X, A)
 
call bd2pos (board, ipos, jpos, numpos)
 
# Convert the positions to algebraic notation.
do k = 1, numpos {
call ij2alg (ipos(k), jpos(k), alg(k))
}
 
# Fill lines with algebraic notations.
do m = 1, 8 {
columns(m) = 1
}
m = 1
do k = 1, numpos {
lines(m)(columns(m) : columns(m) + 1) = alg(k)(1:2)
columns(m) = columns(m) + 2
if (k != numpos) {
lines(m)(columns(m) : columns(m) + 3) = " -> "
columns(m) = columns(m) + 4
} else if (numpos == 64 && _
((abs (ipos(numpos) - ipos(1)) == 2 _
&& abs (jpos(numpos) - jpos(1)) == 1) _
|| ((abs (ipos(numpos) - ipos(1)) == 1 _
&& abs (jpos(numpos) - jpos(1)) == 2)))) {
lines(m)(columns(m) : columns(m) + 8) = " -> cycle"
columns(m) = columns(m) + 9
}
if (mod (k, 8) == 0) m = m + 1
}
 
# Print the lines that have stuff in them.
do m = 1, 8 {
if (columns(m) != 1) {
write (*, 10000) lines(m)(1 : columns(m) - 1)
}
}
 
end
 
#-----------------------------------------------------------------------
 
function isclos (board)
implicit none
 
# Is a board a closed tour?
 
logical isclos
integer board(1:8,1:8)
integer ipos(1:64) # The i-positions in order.
integer jpos(1:64) # The j-positions in order.
integer numpos # The number of positions so far.
 
call bd2pos (board, ipos, jpos, numpos)
 
isclos = (numpos == 64 && _
((abs (ipos(numpos) - ipos(1)) == 2 _
&& abs (jpos(numpos) - jpos(1)) == 1) _
|| ((abs (ipos(numpos) - ipos(1)) == 1 _
&& abs (jpos(numpos) - jpos(1)) == 2))))
 
end
 
#-----------------------------------------------------------------------
 
subroutine bd2pos (board, ipos, jpos, numpos)
implicit none
 
# Convert from a board to a list of board positions.
 
integer board(1:8,1:8)
integer ipos(1:64) # The i-positions in order.
integer jpos(1:64) # The j-positions in order.
integer numpos # The number of positions so far.
 
integer i, j
 
numpos = 0
do i = 1, 8 {
do j = 1, 8 {
if (board(i, j) != -1) {
numpos = max (board(i, j), numpos)
ipos(board(i, j)) = i
jpos(board(i, j)) = j
}
}
}
 
end
 
#-----------------------------------------------------------------------
 
subroutine nxtmov (board, n, imove, jmove, nmove)
implicit none
 
# Find possible next moves. Prune and sort the moves according to
# Warnsdorff's heuristic, keeping only those that have the minimum
# number of legal following moves.
 
integer board(1:8,1:8)
integer n
integer imove(1:8,1:64)
integer jmove(1:8,1:64)
integer nmove(1:64)
 
integer w1, w2, w3, w4, w5, w6, w7, w8
integer w
integer n1
integer pickw
 
call possib (board, n, imove, jmove, nmove)
 
n1 = n + 1
nmove(n1) = 1
call countf (board, n1, imove, jmove, nmove, w1)
nmove(n1) = 2
call countf (board, n1, imove, jmove, nmove, w2)
nmove(n1) = 3
call countf (board, n1, imove, jmove, nmove, w3)
nmove(n1) = 4
call countf (board, n1, imove, jmove, nmove, w4)
nmove(n1) = 5
call countf (board, n1, imove, jmove, nmove, w5)
nmove(n1) = 6
call countf (board, n1, imove, jmove, nmove, w6)
nmove(n1) = 7
call countf (board, n1, imove, jmove, nmove, w7)
nmove(n1) = 8
call countf (board, n1, imove, jmove, nmove, w8)
 
w = pickw (w1, w2, w3, w4, w5, w6, w7, w8)
 
if (w == 0) {
call disabl (imove(1, n1), jmove(1, n1))
call disabl (imove(2, n1), jmove(2, n1))
call disabl (imove(3, n1), jmove(3, n1))
call disabl (imove(4, n1), jmove(4, n1))
call disabl (imove(5, n1), jmove(5, n1))
call disabl (imove(6, n1), jmove(6, n1))
call disabl (imove(7, n1), jmove(7, n1))
call disabl (imove(8, n1), jmove(8, n1))
} else {
if (w != w1) call disabl (imove(1, n1), jmove(1, n1))
if (w != w2) call disabl (imove(2, n1), jmove(2, n1))
if (w != w3) call disabl (imove(3, n1), jmove(3, n1))
if (w != w4) call disabl (imove(4, n1), jmove(4, n1))
if (w != w5) call disabl (imove(5, n1), jmove(5, n1))
if (w != w6) call disabl (imove(6, n1), jmove(6, n1))
if (w != w7) call disabl (imove(7, n1), jmove(7, n1))
if (w != w8) call disabl (imove(8, n1), jmove(8, n1))
}
 
end
 
#-----------------------------------------------------------------------
 
subroutine countf (board, n, imove, jmove, nmove, w)
implicit none
 
# Count the number of moves possible after an nth move.
 
integer board(1:8,1:8)
integer n
integer imove(1:8,1:64)
integer jmove(1:8,1:64)
integer nmove(1:64)
integer w
 
logical goodmv
integer n1
 
if (goodmv (imove, nmove, n)) {
call mkmove (board, imove, jmove, nmove, n)
call possib (board, n, imove, jmove, nmove)
n1 = n + 1
w = 0
if (imove(1, n1) != -1) w = w + 1
if (imove(2, n1) != -1) w = w + 1
if (imove(3, n1) != -1) w = w + 1
if (imove(4, n1) != -1) w = w + 1
if (imove(5, n1) != -1) w = w + 1
if (imove(6, n1) != -1) w = w + 1
if (imove(7, n1) != -1) w = w + 1
if (imove(8, n1) != -1) w = w + 1
call unmove (board, imove, jmove, nmove, n)
} else {
# The nth move itself is impossible.
w = 0
}
 
end
 
#-----------------------------------------------------------------------
 
function pickw (w1, w2, w3, w4, w5, w6, w7, w8)
implicit none
 
# From w1..w8, pick out the least nonzero value (or zero if they all
# equal zero).
 
integer pickw
integer w1, w2, w3, w4, w5, w6, w7, w8
 
integer w
integer pickw1
 
w = 0
w = pickw1 (w, w1)
w = pickw1 (w, w2)
w = pickw1 (w, w3)
w = pickw1 (w, w4)
w = pickw1 (w, w5)
w = pickw1 (w, w6)
w = pickw1 (w, w7)
w = pickw1 (w, w8)
 
pickw = w
 
end
 
#-----------------------------------------------------------------------
 
function pickw1 (u, v)
implicit none
 
# A small function used by pickw.
 
integer pickw1
integer u, v
 
if (v == 0) {
pickw1 = u
} else if (u == 0) {
pickw1 = v
} else {
pickw1 = min (u, v)
}
 
end
 
#-----------------------------------------------------------------------
 
subroutine possib (board, n, imove, jmove, nmove)
implicit none
 
# Find moves that are possible from an nth-move position.
 
integer board(1:8,1:8)
integer n
integer imove(1:8,1:64)
integer jmove(1:8,1:64)
integer nmove(1:64)
 
integer i, j
integer n1
 
i = imove(nmove(n), n)
j = jmove(nmove(n), n)
n1 = n + 1
call trymov (board, i + 1, j + 2, imove(1, n1), jmove(1, n1))
call trymov (board, i + 2, j + 1, imove(2, n1), jmove(2, n1))
call trymov (board, i + 1, j - 2, imove(3, n1), jmove(3, n1))
call trymov (board, i + 2, j - 1, imove(4, n1), jmove(4, n1))
call trymov (board, i - 1, j + 2, imove(5, n1), jmove(5, n1))
call trymov (board, i - 2, j + 1, imove(6, n1), jmove(6, n1))
call trymov (board, i - 1, j - 2, imove(7, n1), jmove(7, n1))
call trymov (board, i - 2, j - 1, imove(8, n1), jmove(8, n1))
 
end
 
#-----------------------------------------------------------------------
 
subroutine trymov (board, i, j, imove, jmove)
implicit none
 
# Try a move to square (i, j).
 
integer board(1:8,1:8)
integer i, j
integer imove, jmove
 
call disabl (imove, jmove)
if (1 <= i && i <= 8 && 1 <= j && j <= 8) {
if (board(i,j) == -1) {
call enable (i, j, imove, jmove)
}
}
 
end
 
#-----------------------------------------------------------------------
 
subroutine enable (i, j, imove, jmove)
implicit none
 
# Enable a potential move.
 
integer i, j
integer imove, jmove
 
imove = i
jmove = j
 
end
 
#-----------------------------------------------------------------------
 
subroutine disabl (imove, jmove)
implicit none
 
# Disable a potential move.
 
integer imove, jmove
 
imove = -1
jmove = -1
 
end
 
#-----------------------------------------------------------------------
 
subroutine alg2ij (alg, i, j)
implicit none
 
# Convert, for instance, 'c5' to i=3,j=5.
 
character*2 alg
integer i, j
 
if (alg(1:1) == 'a') j = 1
if (alg(1:1) == 'b') j = 2
if (alg(1:1) == 'c') j = 3
if (alg(1:1) == 'd') j = 4
if (alg(1:1) == 'e') j = 5
if (alg(1:1) == 'f') j = 6
if (alg(1:1) == 'g') j = 7
if (alg(1:1) == 'h') j = 8
 
if (alg(2:2) == '1') i = 1
if (alg(2:2) == '2') i = 2
if (alg(2:2) == '3') i = 3
if (alg(2:2) == '4') i = 4
if (alg(2:2) == '5') i = 5
if (alg(2:2) == '6') i = 6
if (alg(2:2) == '7') i = 7
if (alg(2:2) == '8') i = 8
 
end
 
#-----------------------------------------------------------------------
 
subroutine ij2alg (i, j, alg)
implicit none
 
# Convert, for instance, i=3,j=5 to 'c5'.
 
integer i, j
character*2 alg
 
character alg1
character alg2
 
if (j == 1) alg1 = 'a'
if (j == 2) alg1 = 'b'
if (j == 3) alg1 = 'c'
if (j == 4) alg1 = 'd'
if (j == 5) alg1 = 'e'
if (j == 6) alg1 = 'f'
if (j == 7) alg1 = 'g'
if (j == 8) alg1 = 'h'
 
if (i == 1) alg2 = '1'
if (i == 2) alg2 = '2'
if (i == 3) alg2 = '3'
if (i == 4) alg2 = '4'
if (i == 5) alg2 = '5'
if (i == 6) alg2 = '6'
if (i == 7) alg2 = '7'
if (i == 8) alg2 = '8'
 
alg(1:1) = alg1
alg(2:2) = alg2
 
end
 
#-----------------------------------------------------------------------</syntaxhighlight>
 
{{out}}
$ echo "c5 2 T" | ./knights_tour
<pre> Tour number 1
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> e8 -> d6 -> b5 -> d4 -> f5 -> g7 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 58 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 63 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 60 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 61 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
 
Tour number 2
c5 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> h3 ->
g1 -> e2 -> c1 -> a2 -> b4 -> d3 -> e1 -> g2 ->
h4 -> g6 -> h8 -> f7 -> d8 -> b7 -> a5 -> b3 ->
a1 -> c2 -> a3 -> b1 -> d2 -> f3 -> h2 -> f1 ->
g3 -> h1 -> f2 -> e4 -> c3 -> a4 -> b2 -> d1 ->
e3 -> g4 -> h6 -> g8 -> f6 -> h5 -> f4 -> d5 ->
e7 -> c8 -> a7 -> c6 -> e5 -> c4 -> b6 -> a8 ->
c7 -> b5 -> d6 -> e8 -> g7 -> f5 -> d4 -> e6 -> cycle
+----+----+----+----+----+----+----+----+
8 | 56 | 3 | 50 | 21 | 60 | 5 | 44 | 19 |
+----+----+----+----+----+----+----+----+
7 | 51 | 22 | 57 | 4 | 49 | 20 | 61 | 6 |
+----+----+----+----+----+----+----+----+
6 | 2 | 55 | 52 | 59 | 64 | 45 | 18 | 43 |
+----+----+----+----+----+----+----+----+
5 | 23 | 58 | 1 | 48 | 53 | 62 | 7 | 46 |
+----+----+----+----+----+----+----+----+
4 | 38 | 13 | 54 | 63 | 36 | 47 | 42 | 17 |
+----+----+----+----+----+----+----+----+
3 | 27 | 24 | 37 | 14 | 41 | 30 | 33 | 8 |
+----+----+----+----+----+----+----+----+
2 | 12 | 39 | 26 | 29 | 10 | 35 | 16 | 31 |
+----+----+----+----+----+----+----+----+
1 | 25 | 28 | 11 | 40 | 15 | 32 | 9 | 34 |
+----+----+----+----+----+----+----+----+
a b c d e f g h
</pre>
 
 
 
 
=={{header|REXX}}==
Line 6,958 ⟶ 10,706:
 
This is an &nbsp; ''open tour'' &nbsp; solution. &nbsp; (See this task's &nbsp; ''discussion'' &nbsp; page for an explanation, the section is &nbsp; ''The 7x7 problem''.)
<langsyntaxhighlight lang="rexx">/*REXX program solves the knight's tour problem for a (general) NxN chessboard.*/
parse arg N sRank sFile . /*obtain optional arguments from the CL*/
if N=='' | N=="," then N=8 /*No boardsize specified? Use default.*/
Line 6,995 ⟶ 10,743:
end /*try different move. */
end /*t*/ /* [↑] all moves tried.*/
return 0 /*tour is not possible. */</langsyntaxhighlight>
'''output''' &nbsp; when using the default input:
<pre>
Line 7,021 ⟶ 10,769:
=={{header|Ruby}}==
Knights tour using [[wp:Knight's_tour#Warnsdorff.27s_rule|Warnsdorffs rule]]
<langsyntaxhighlight lang="ruby">class Board
Cell = Struct.new(:value, :adj) do
def self.end=(end_val)
Line 7,092 ⟶ 10,840:
knight_tour(5,5,0,1)
 
knight_tour(12,12,1,1)</langsyntaxhighlight>
Which produces:
<pre>
Line 7,138 ⟶ 10,886:
 
=={{header|Rust}}==
<langsyntaxhighlight lang="rust">use std::fmt;
 
const SIZE: usize = 8;
Line 7,248 ⟶ 10,996:
None => println!("Fail!"),
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 7,264 ⟶ 11,012:
 
=={{header|Scala}}==
<syntaxhighlight lang="scala">
<lang Scala>
val b=Seq.tabulate(8,8,8,8)((x,y,z,t)=>(1L<<(x*8+y),1L<<(z*8+t),f"${97+z}%c${49+t}%c",(x-z)*(x-z)+(y-t)*(y-t)==5)).flatten.flatten.flatten.filter(_._4).groupBy(_._1)
def f(p:Long,s:Long,v:Any){if(-1L!=s)b(p).foreach(x=>if((s&x._2)==0)f(x._2,s|x._2,v+x._3))else println(v)}
f(1,1,"a1")
</syntaxhighlight>
</lang>
<pre>
a1b3a5b7c5a4b2c4a3b1c3a2b4a6b8c6a7b5c7a8b6c8d6e4d2f1e3c2d4e2c1d3e1g2f4d5e7g8h6f5h4g6h8f7d8e6f8d7e5g4h2f3g1h3g5h7f6e8g7h5g3h1f2d1
Line 7,274 ⟶ 11,022:
 
=={{header|Scheme}}==
<langsyntaxhighlight lang="scheme">
;;/usr/bin/petite
;;encoding:utf-8
Line 7,321 ⟶ 11,069:
(display (map (lambda(x) (decode x)) result)))
(go (renew position))))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 7,330 ⟶ 11,078:
=={{header|SequenceL}}==
Knights tour using [[wp:Knight's_tour#Warnsdorff.27s_rule|Warnsdorffs rule]] (No Backtracking)
<syntaxhighlight lang="sequencel">
<lang sequenceL>
import <Utilities/Sequence.sl>;
import <Utilities/Conversion.sl>;
Line 7,381 ⟶ 11,129:
value when x = i and y = j else
board[i,j] foreach i within 1 ... size(board), j within 1 ... size(board[1]);
</syntaxhighlight>
</lang>
{{out}}
8 X 8 board:
Line 7,420 ⟶ 11,168:
=={{header|Sidef}}==
{{trans|Raku}}
<langsyntaxhighlight lang="ruby">var board = []
var I = 8
var J = 8
Line 7,480 ⟶ 11,228:
}
print "\n"
}</langsyntaxhighlight>
 
=={{header|Swift}}==
Line 7,486 ⟶ 11,234:
{{trans|Rust}}
 
<langsyntaxhighlight lang="swift">public struct CPoint {
public var x: Int
public var y: Int
Line 7,615 ⟶ 11,363:
}
 
b.printBoard()</langsyntaxhighlight>
 
{{out}}
Line 7,630 ⟶ 11,378:
 
=={{header|Tcl}}==
<langsyntaxhighlight lang="tcl">package require Tcl 8.6; # For object support, which makes coding simpler
 
oo::class create KnightsTour {
Line 7,736 ⟶ 11,484:
expr {$a in [my ValidMoves $b]}
}
}</langsyntaxhighlight>
Demonstrating:
<langsyntaxhighlight lang="tcl">set kt [KnightsTour new]
$kt constructRandom
$kt print
Line 7,745 ⟶ 11,493:
} else {
puts "This is an open tour"
}</langsyntaxhighlight>
Sample output:
<pre>
Line 7,757 ⟶ 11,505:
</pre>
The above code supports other sizes of boards and starting from nominated locations:
<langsyntaxhighlight lang="tcl">set kt [KnightsTour new 7 7]
$kt constructFrom {0 0}
$kt print
Line 7,764 ⟶ 11,512:
} else {
puts "This is an open tour"
}</langsyntaxhighlight>
Which could produce this output:
<pre>
Line 7,777 ⟶ 11,525:
=={{header|Wren}}==
{{trans|Kotlin}}
<langsyntaxhighlight ecmascriptlang="wren">class Square {
construct new(x, y) {
_x = x
Line 7,834 ⟶ 11,582:
System.write((col == 7) ? "\n" : " ")
col = (col + 1) % 8
}</langsyntaxhighlight>
 
{{out}}
Line 7,849 ⟶ 11,597:
 
=={{header|XPL0}}==
<langsyntaxhighlight XPL0lang="xpl0">int Board(8+2+2, 8+2+2); \board array with borders
int LegalX, LegalY; \arrays of legal moves
def IntSize=4; \number of bytes in an integer (4 or 2)
Line 7,899 ⟶ 11,647:
]
else Text(0, "No Solution.^M^J");
]</langsyntaxhighlight>
 
Example output:
Line 7,918 ⟶ 11,666:
 
First we build a generic package for solving any kind of tour over the chess board. Here it is…
<syntaxhighlight lang="text">
<xsl:package xsl:version="3.0"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
Line 7,975 ⟶ 11,723:
</xsl:package>
</syntaxhighlight>
</lang>
 
And now for the style-sheet to solve the Knight’s tour…
 
<syntaxhighlight lang="text">
<xsl:stylesheet version="3.0"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
Line 8,018 ⟶ 11,766:
</xsl:stylesheet>
</syntaxhighlight>
</lang>
 
So an input like this…
 
<syntaxhighlight lang="text">
<tt>
<knight>
Line 8,028 ⟶ 11,776:
</knight>
</tt>
</syntaxhighlight>
</lang>
 
…should be transformed in something like this…
 
<syntaxhighlight lang="text">
<tt>
<knight>
Line 8,041 ⟶ 11,789:
</knight>
</tt>
</syntaxhighlight>
</lang>
 
=={{header|zkl}}==
<langsyntaxhighlight lang="zkl"> // Use Warnsdorff's rule to perform a knights tour of a 8x8 board in
// linear time.
// See Pohl, Ira (July 1967),
Line 8,091 ⟶ 11,839:
fcn(ns){ vm.arglist.apply("%2s".fmt).concat(",")+"\n" });
}
}</langsyntaxhighlight>
 
<langsyntaxhighlight lang="zkl">b:=Board(); b.knightsTour(3,3);
b.println();</langsyntaxhighlight>
{{out}}
<pre>
Line 8,107 ⟶ 11,855:
</pre>
Check that a solution for all squares is found:
<langsyntaxhighlight lang="zkl">[[(x,y); [0..7]; [0..7];
{ b:=Board(); n:=b.knightsTour(x,y); if(n!=64) b.println(">>>",x,",",y) } ]];</langsyntaxhighlight>
{{out}}Nada
 
9,476

edits