[r/dailyprogrammer 361-hard] https://www.reddit.com/r/dailyprogrammer/comments/8ked11/20180518_challenge_361_hard_sudoku_knights_tour

tour.pl

#!/usr/bin/env swipl

:- initialization(main, main).

:- use_module(library(clpfd)).
:- use_module(library(dcg/basics)).


%% tour(Shape, Tour)
% Tour is a tour of a chess board of the given Shape.
% Moves from any cell to any other cell are allowed.
%
% Tour is a term, tour(Shape, Nodes), where Nodes is the list of nodes
% in visitation order. Nodes are natural numbers between 1 and N where N
% is the number of nodes.
tour(Shape, Tour) :-
	Tour = tour(Shape, Nodes),
	Shape = [H, W],
	Length #= H*W,
	length(Nodes, Length),
	Nodes ins 1..Length,
	all_distinct(Nodes).


%% knights_tour(Shape, Tour)
% Tour is a knights tour of a chess board of the given Shape.
% Only valid knight moves are allowed.
%
% See tour/2.
knights_tour(Shape, Tour) :-
	tour(Shape, Tour),
	Tour = tour(Shape, Nodes),
	knights_tour_(Nodes, Tour).

knights_tour_([_LastNode], _Tour) :- !.
knights_tour_([Prev, Next|T], Tour) :-
	tour_node(Tour, [X0, Y0], Prev),
	Tour = tour(Shape, _Nodes),
	Shape = [H, W],
	[Y0, Y1] ins 1..H,
	[X0, X1] ins 1..W,
	[DX,DY] ins -2 \/ -1 \/ +1 \/ +2,
	abs(DX) + abs(DY) #= 3,
	X1 #= X0 + DX,
	Y1 #= Y0 + DY,
	tour_node(Tour, [X1, Y1], Next),
	knights_tour_([Next|T], Tour).


%% tour_node(Tour, Coords, Node)
% Coords is the coordinates of a Node belonging to a Tour.
tour_node(Tour, Coords, Node) :-
	Tour = tour(Shape, _Nodes),
	Shape = [H, W],
	Coords = [Y, X],
	Y in 1..H,
	X in 1..W,
	Node #= (Y-1)*W + (X-1)*1 + 1.


%% board(Shape, Vals, Board)
% Board is a 2D board of the given Shape. Vals is a 1D list of values
% distributed on the board left-to-right, top-to-bottom.
board(Shape, Vals, Board) :-
	Board = board(Shape, Vals),
	Shape = [H, W],
	Length #= H*W,
	length(Vals, Length),
	Vals ins 1..Length.


%% sudoku(Board)
% Board is a 9x9 board whose values constitute a valid standard sudoku.
sudoku(Board) :-
	Shape = [9, 9],
	board(Shape, Vals, Board),
	Vals ins 1..9,

	Rows = [
		[A1, A2, A3, A4, A5, A6, A7, A8, A9],
		[B1, B2, B3, B4, B5, B6, B7, B8, B9],
		[C1, C2, C3, C4, C5, C6, C7, C8, C9],
		[D1, D2, D3, D4, D5, D6, D7, D8, D9],
		[E1, E2, E3, E4, E5, E6, E7, E8, E9],
		[F1, F2, F3, F4, F5, F6, F7, F8, F9],
		[G1, G2, G3, G4, G5, G6, G7, G8, G9],
		[H1, H2, H3, H4, H5, H6, H7, H8, H9],
		[I1, I2, I3, I4, I5, I6, I7, I8, I9]
	],

	Blocks = [
		[A1, A2, A3, B1, B2, B3, C1, C2, C3],
		[A4, A5, A6, B4, B5, B6, C4, C5, C6],
		[A7, A8, A9, B7, B8, B9, C7, C8, C9],
		[D1, D2, D3, E1, E2, E3, F1, F2, F3],
		[D4, D5, D6, E4, E5, E6, F4, F5, F6],
		[D7, D8, D9, F7, F8, F9, E7, E8, E9],
		[G1, G2, G3, H1, H2, H3, I1, I2, I3],
		[G4, G5, G6, H4, H5, H6, I4, I5, I6],
		[G7, G8, G9, I7, I8, I9, H7, H8, H9]
	],

	transpose(Rows, Cols),
	maplist(all_distinct, Rows),
	maplist(all_distinct, Cols),
	maplist(all_distinct, Blocks),

	append(Rows, Vals).




%% board_element(Board, Coords, Element)
% Coords are the coordinates of Element on a Board.
board_element(Board, Coords, Element) :-
	Board = board(Shape, Values),
	Shape = [H, W],
	Coords = [Y, X],
	Y in 1..H,
	X in 1..W,
	I #= (Y-1)*W + (X-1)*1 + 1,
	element(I, Values, Element).


%% print_tour(Tour)
% Prints the Tour to the current output.
print_tour(Tour) :-
	Tour = tour(Shape, Nodes),
	Shape = [H, W],
	forall(between(1, H, Y), (
		forall(between(1, W, X), (
			tour_node(Tour, [Y, X], N),
			element(P, Nodes, N),
			format('~|~t~w~4+', [P])
		)),
		nl
	)).


%% print_board(Board)
% Prints the Board to the current output.
print_board(Board) :-
	Board = board(Shape, _Values),
	Shape = [H, W],
	forall(between(1, H, Y), (
		forall(between(1, W, X), (
			board_element(Board, [Y, X], V),
			format('~|~t~w~4+', [V])
		)),
		nl
	)).


%% read_board(Board, StreamOrFile)
% Reads a board from StreamOrFile.
% StreamOrFile may be a stream alias or a file name.
read_board(Board, StreamOrFile) :-
	is_stream(StreamOrFile), !,
	Stream = StreamOrFile,
	read_board_(Board, Stream).

read_board(Board, StreamOrFile) :-
	File = StreamOrFile,
	open(File, read, Stream, []),
	read_board_(Board, Stream),
	close(Stream).

read_board_(Board, Stream) :-
	Board = board(Shape, Vals),
	Shape = [H, W],
	phrase_from_stream(board_dcg(H, W, Rows), Stream),
	append(Rows, Vals).

board_dcg(H, _, []) --> eos, {H #= 0, !}.
board_dcg(H, W, [R|Rows]) -->
	row_dcg(W, R),
	board_dcg(H-1, W, Rows).

row_dcg(W, []) --> "\n", {W #= 0, !}.
row_dcg(W, [V|Vals]) -->
	integer(V),
	whites,
	row_dcg(W-1, Vals).


%% domain(Vs, Min, Max)
% The lowest bound among finite domain variable Vs is Min.
% The highest bound among finite domain variable Vs is Max.
domain([V], Min, Max) :- !, fd_inf(V, Min), fd_sup(V, Max).
domain([H|T], Min, Max) :-
	domain(T, Min0, Max0),
	fd_inf(H, Min1),
	fd_sup(H, Max1),
	Min #= min(Min0, Min1),
	Max #= max(Max0, Max1).


%% cardinality(+Vs, -Cardinality)
% Cardinality is a list of Key-Num pairs, where Key is in the domain of the
% finite domain variables Vs and Num is its number of occurences. This is
% like the CLP(FD) builtin constraint `global_cardinality`, but Cardinality
% is allowed to be unbound.
cardinality(Vs, Cardinality) :-
	domain(Vs, Min, Max),
	label([Min, Max]),
	findall(K, between(Min, Max, K), Keys),
	pairs_keys_values(Cardinality, Keys, _),
	global_cardinality(Vs, Cardinality).


%% tour_vals(Tour, Board, TourVals)
% TourVals are the values on the Board in the order visited by Tour.
tour_vals(Tour, Board, TourVals) :-
	Tour = tour(Shape, Nodes),
	Board = board(Shape, Vals),
	length(Nodes, Size),
	length(Vals, Size),
	length(TourVals, Size),
	domain(Vals, Min, Max),
	TourVals ins Min..Max,
	cardinality(Vals, Cardinality),
	cardinality(TourVals, Cardinality),
	tour_vals_(Nodes, TourVals, Tour, Board).

tour_vals_([], [], _Tour, _Board).
tour_vals_([N|Nodes], [V|TourVals], Tour, Board) :-
	tour_node(Tour, Coords, N),
	board_element(Board, Coords, V),
	tour_vals_(Nodes, TourVals, Tour, Board).


%% score(Tour, Board, Digits, Score)
% The Digits of Score are taken from the Board in the order visited by Tour.
score(Tour, Board, Digits, Score) :-
	tour_vals(Tour, Board, Digits),
	digits_score(Digits, Score).


%% digits_score(Digits, Score)
% Digits is the list of digits of the integer Score.
digits_score(Digits, Score) :-
	digits_score_(Digits, Score, 0).

digits_score_([], Score, Score) :- !.
digits_score_([D|Digits], Score, Prev) :-
	D in 1..9,
	Next #= 10 * Prev + D,
	digits_score_(Digits, Score, Next).


%% label_optimal(Nodes, Vals)
% Given a list of Nodes from a tour and a list of corresponding Vals from a
% board, label node such that the value in the same position is maximized.
% Note that Vals should be in visitation order (i.e. from tour_vals/3).
label_optimal([], []).
label_optimal([N|Nodes], [V|Vals]) :-
	labeling([max(V)], [N]),
	label_optimal(Nodes, Vals).


%% tour_coords(Tour, CoordList)
% CoordList is a list of [Y, X] pairs giving the coordinates of all nodes in
% the Tour, in the order visited by the Tour.
tour_coords(Tour, CoordList) :-
	Tour = tour(_Shape, Nodes),
	tour_coords_(Nodes, CoordList, Tour).

tour_coords_([], [], _Tour).
tour_coords_([N|Nodes], [Coords|CoordList], Tour) :-
	tour_node(Tour, Coords, N),
	tour_coords_(Nodes, CoordList, Tour).


%% board_grid(Board, Grid)
% Grid is a 2D list representation of the Board.
board_grid(Board, Grid) :-
	Board = board(Shape, Vals),
	Shape = [H, W],
	length(Grid, H),
	maplist([Row] >> length(Row, W), Grid),
	append(Grid, Vals).


%% known_soln(Name, Tour, Board, Score)
% Name identifies a known solution.
% Tour is the 9x9 knights tour of the solution.
% Board is the sudoku board of the solution.
% Score is the score of the Tour on the Board.
known_soln(Name, Tour, Board, Score) :-
	% Read and decode
	known_soln_(Name, CoordList, Grid, Score),
	tour([9,9], Tour),
	tour_coords(Tour, CoordList),
	board_grid(Board, Grid),

	% Verify
	sudoku(Board),
	knights_tour([9,9], Tour),
	score(Tour, Board, _Digits, Score).

known_soln_(u_SingularInfinity_1, [
	[2, 2], [4, 3], [6, 4], [8, 5], [7, 7], [5, 8], [3, 9], [4, 7], [2, 8],
	[1, 6], [3, 5], [5, 4], [6, 2], [8, 3], [9, 1], [7, 2], [8, 4], [9, 6],
	[8, 8], [6, 9], [5, 7], [3, 8], [4, 6], [6, 5], [8, 6], [9, 8], [7, 9],
	[6, 7], [5, 9], [7, 8], [9, 9], [8, 7], [9, 5], [7, 6], [9, 7], [8, 9],
	[6, 8], [4, 9], [3, 7], [1, 8], [2, 6], [1, 4], [3, 3], [4, 1], [5, 3],
	[4, 5], [6, 6], [7, 4], [9, 3], [8, 1], [7, 3], [9, 2], [7, 1], [5, 2],
	[3, 1], [1, 2], [2, 4], [3, 6], [5, 5], [3, 4], [1, 3], [2, 1], [4, 2],
	[6, 1], [8, 2], [9, 4], [7, 5], [5, 6], [4, 8], [2, 9], [1, 7], [2, 5],
	[4, 4], [6, 3], [5, 1], [3, 2], [1, 1], [2, 3], [1, 5], [2, 7], [1, 9]
], [
	[8, 3, 6, 4, 7, 9, 1, 2, 5],
	[4, 9, 7, 1, 2, 5, 3, 8, 6],
	[1, 2, 5, 3, 8, 6, 4, 7, 9],
	[6, 5, 9, 2, 3, 7, 8, 4, 1],
	[7, 4, 2, 8, 5, 1, 6, 9, 3],
	[3, 8, 1, 9, 6, 4, 2, 5, 7],
	[5, 7, 3, 6, 4, 2, 9, 1, 8],
	[2, 1, 8, 7, 9, 3, 5, 6, 4],
	[9, 6, 4, 5, 1, 8, 7, 3, 2]
], 999999988988889778676776338231251274514254562346423654131653645315414612217287735).


%% main(Options)
% Reads a board from the current input and finds the knights tour that
% maximizes the score.
%
% Options:
%     source(Source):
%         If given, read a board from Source, which may be a file name or stream.
%         If Source is unboumd, it defults to 'current_input'.
%         If the option is not given, search for the optimal sudoku board.
%     board(Board):
%         Board is the board of the solution.
%     tour(Tour):
%         Tour is the tour of the solution.
%     score(Score):
%         Score is the score of the solution.
%     prefix(Prefix):
%         Prefix is a prefix of the score.
%         Useful for pruning the search space.
main(Options) :-
	option(source(Source), Options, current_input),
	option(tour(Tour), Options, _),
	option(board(Board), Options, _),
	option(score(Score), Options, _),
	option(prefix(Prefix), Options, _),

	prompt(_, ''),

	% Ensure Prefix is a prefix of Digits.
	once((
		digits_score(DigitsPrefix, Prefix),
		append(DigitsPrefix, _, Digits)
	)),

	% If the source option is given, load the board from that source.
	% Otherwise search for an optimal sudoku board.
	(member(source(Source), Options) ->
		read_board(Board, Source)
	;
		sudoku(Board)
	),

	% Search for the solution using CLP(FD).
	Board = board(Shape, _Values),
	Tour = tour(Shape, Nodes),
	knights_tour(Shape, Tour),
	score(Tour, Board, Digits, Score),
	label_optimal(Nodes, Digits),

	format('Board:'), nl,
	print_board(Board),

	format('Tour:'), nl,
	print_tour(Tour),

	format('Score: '),
	write(Score),
	nl.