RosettaCodeData/Task/Knights-tour/ObjectIcon/knights-tour.oi
2023-07-01 13:44:08 -04:00

363 lines
8.4 KiB
Text
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#
# Find Knights Tours.
#
# Using Warnsdorffs 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 Warnsdorffs
# 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