使用 Prolog 优化约束逻辑编程中的寻路
Posted
技术标签:
【中文标题】使用 Prolog 优化约束逻辑编程中的寻路【英文标题】：Optimizing pathfinding in Constraint Logic Programming with Prolog 【发布时间】：2012-01-17 12:57:07 【问题描述】：我正在开发一个小型 prolog 应用程序来解决 Skyscrapers and Fences 难题。
一个未解之谜：
一个已解决的谜题：
当我通过已解决难题的程序时，它会很快，几乎是瞬间为我验证它。当我通过程序非常小的谜题（例如 2x2，当然要修改规则）时，找到解决方案的速度也相当快。
问题在于计算“原生”大小为 6x6 的谜题。在中止它之前，我已经让它运行了 5 个小时左右。时间太长了。
我发现耗时最长的部分是“栅栏”，而不是“摩天大楼”。单独运行“摩天大楼”会产生快速的解决方案。
这是我的栅栏算法：
顶点用数字表示，0 表示路径不经过该特定顶点，> 1 表示该顶点在路径中的顺序。 限制每个单元格周围有适当数量的线条。 这意味着如果两个顶点具有连续编号，则它们是连接的，例如，1 -> 2, 2 -> 1, 1 ->Max, Max -> 1（Max 是路径中的最后一个顶点。通过maximum/2 计算）
确保每个非零顶点至少有两个具有连续编号的相邻顶点
将Max 约束为等于(BoardWidth + 1)^2 - NumberOfZeros（BoardWidth+1 是沿边的顶点数，NumberOfZeros 是通过count/4 计算的）。
使用nvalue(Vertices, Max + 1) 确保Vertices 中不同值的数量为Max（即路径中的顶点数量）加上1（零值）
查找包含3 的第一个单元格并强制路径从那里开始和结束，以提高效率
我可以做些什么来提高效率？代码包含在下面以供参考。
skyscrapersinfences.pro
:-use_module(library(clpfd)).
:-use_module(library(lists)).
:-ensure_loaded('utils.pro').
:-ensure_loaded('s1.pro').
print_row([]).
print_row([Head|Tail]) :-
write(Head), write(' '),
print_row(Tail).
print_board(Board, BoardWidth) :-
print_board(Board, BoardWidth, 0).
print_board(_, BoardWidth, BoardWidth).
print_board(Board, BoardWidth, Index) :-
make_segment(Board, BoardWidth, Index, row, Row),
print_row(Row), nl,
NewIndex is Index + 1,
print_board(Board, BoardWidth, NewIndex).
print_boards([], _).
print_boards([Head|Tail], BoardWidth) :-
print_board(Head, BoardWidth), nl,
print_boards(Tail, BoardWidth).
get_board_element(Board, BoardWidth, X, Y, Element) :-
Index is BoardWidth*Y + X,
get_element_at(Board, Index, Element).
make_column([], _, _, []).
make_column(Board, BoardWidth, Index, Segment) :-
get_element_at(Board, Index, Element),
munch(Board, BoardWidth, MunchedBoard),
make_column(MunchedBoard, BoardWidth, Index, ColumnTail),
append([Element], ColumnTail, Segment).
make_segment(Board, BoardWidth, Index, row, Segment) :-
NIrrelevantElements is BoardWidth*Index,
munch(Board, NIrrelevantElements, MunchedBoard),
select_n_elements(MunchedBoard, BoardWidth, Segment).
make_segment(Board, BoardWidth, Index, column, Segment) :-
make_column(Board, BoardWidth, Index, Segment).
verify_segment(_, 0).
verify_segment(Segment, Value) :-
verify_segment(Segment, Value, 0).
verify_segment([], 0, _).
verify_segment([Head|Tail], Value, Max) :-
Head #> Max #<=> B,
Value #= M+B,
maximum(NewMax, [Head, Max]),
verify_segment(Tail, M, NewMax).
exactly(_, [], 0).
exactly(X, [Y|L], N) :-
X #= Y #<=> B,
N #= M +B,
exactly(X, L, M).
constrain_numbers(Vars) :-
exactly(3, Vars, 1),
exactly(2, Vars, 1),
exactly(1, Vars, 1).
iteration_values(BoardWidth, Index, row, 0, column) :-
Index is BoardWidth - 1.
iteration_values(BoardWidth, Index, Type, NewIndex, Type) :-
\+((Type = row, Index is BoardWidth - 1)),
NewIndex is Index + 1.
solve_skyscrapers(Board, BoardWidth) :-
solve_skyscrapers(Board, BoardWidth, 0, row).
solve_skyscrapers(_, BoardWidth, BoardWidth, column).
solve_skyscrapers(Board, BoardWidth, Index, Type) :-
make_segment(Board, BoardWidth, Index, Type, Segment),
domain(Segment, 0, 3),
constrain_numbers(Segment),
observer(Type, Index, forward, ForwardObserver),
verify_segment(Segment, ForwardObserver),
observer(Type, Index, reverse, ReverseObserver),
reverse(Segment, ReversedSegment),
verify_segment(ReversedSegment, ReverseObserver),
iteration_values(BoardWidth, Index, Type, NewIndex, NewType),
solve_skyscrapers(Board, BoardWidth, NewIndex, NewType).
build_vertex_list(_, Vertices, BoardWidth, X, Y, List) :-
V1X is X, V1Y is Y, V1Index is V1X + V1Y*(BoardWidth+1),
V2X is X+1, V2Y is Y, V2Index is V2X + V2Y*(BoardWidth+1),
V3X is X+1, V3Y is Y+1, V3Index is V3X + V3Y*(BoardWidth+1),
V4X is X, V4Y is Y+1, V4Index is V4X + V4Y*(BoardWidth+1),
get_element_at(Vertices, V1Index, V1),
get_element_at(Vertices, V2Index, V2),
get_element_at(Vertices, V3Index, V3),
get_element_at(Vertices, V4Index, V4),
List = [V1, V2, V3, V4].
build_neighbors_list(Vertices, VertexWidth, X, Y, [NorthMask, EastMask, SouthMask, WestMask], [NorthNeighbor, EastNeighbor, SouthNeighbor, WestNeighbor]) :-
NorthY is Y - 1,
EastX is X + 1,
SouthY is Y + 1,
WestX is X - 1,
NorthNeighborIndex is (NorthY)*VertexWidth + X,
EastNeighborIndex is Y*VertexWidth + EastX,
SouthNeighborIndex is (SouthY)*VertexWidth + X,
WestNeighborIndex is Y*VertexWidth + WestX,
(NorthY >= 0, get_element_at(Vertices, NorthNeighborIndex, NorthNeighbor) -> NorthMask = 1 ; NorthMask = 0),
(EastX < VertexWidth, get_element_at(Vertices, EastNeighborIndex, EastNeighbor) -> EastMask = 1 ; EastMask = 0),
(SouthY < VertexWidth, get_element_at(Vertices, SouthNeighborIndex, SouthNeighbor) -> SouthMask = 1 ; SouthMask = 0),
(WestX >= 0, get_element_at(Vertices, WestNeighborIndex, WestNeighbor) -> WestMask = 1 ; WestMask = 0).
solve_path(_, VertexWidth, 0, VertexWidth) :-
write('end'),nl.
solve_path(Vertices, VertexWidth, VertexWidth, Y) :-
write('switch row'),nl,
Y \= VertexWidth,
NewY is Y + 1,
solve_path(Vertices, VertexWidth, 0, NewY).
solve_path(Vertices, VertexWidth, X, Y) :-
X >= 0, X < VertexWidth, Y >= 0, Y < VertexWidth,
write('Path: '), nl,
write('Vertex width: '), write(VertexWidth), nl,
write('X: '), write(X), write(' Y: '), write(Y), nl,
VertexIndex is X + Y*VertexWidth,
write('1'),nl,
get_element_at(Vertices, VertexIndex, Vertex),
write('2'),nl,
build_neighbors_list(Vertices, VertexWidth, X, Y, [NorthMask, EastMask, SouthMask, WestMask], [NorthNeighbor, EastNeighbor, SouthNeighbor, WestNeighbor]),
L1 = [NorthMask, EastMask, SouthMask, WestMask],
L2 = [NorthNeighbor, EastNeighbor, SouthNeighbor, WestNeighbor],
write(L1),nl,
write(L2),nl,
write('3'),nl,
maximum(Max, Vertices),
write('4'),nl,
write('Max: '), write(Max),nl,
write('Vertex: '), write(Vertex),nl,
(Vertex #> 1 #/\ Vertex #\= Max) #=> (
((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= Vertex - 1)) #\
((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= Vertex - 1)) #\
((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= Vertex - 1)) #\
((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= Vertex - 1))
) #/\ (
((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= Vertex + 1)) #\
((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= Vertex + 1)) #\
((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= Vertex + 1)) #\
((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= Vertex + 1))
),
write('5'),nl,
Vertex #= 1 #=> (
((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= Max)) #\
((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= Max)) #\
((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= Max)) #\
((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= Max))
) #/\ (
((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= 2)) #\
((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= 2)) #\
((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= 2)) #\
((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= 2))
),
write('6'),nl,
Vertex #= Max #=> (
((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= 1)) #\
((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= 1)) #\
((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= 1)) #\
((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= 1))
) #/\ (
((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= Max - 1)) #\
((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= Max - 1)) #\
((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= Max - 1)) #\
((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= Max - 1))
),
write('7'),nl,
NewX is X + 1,
solve_path(Vertices, VertexWidth, NewX, Y).
solve_fences(Board, Vertices, BoardWidth) :-
VertexWidth is BoardWidth + 1,
write('- Solving vertices'),nl,
solve_vertices(Board, Vertices, BoardWidth, 0, 0),
write('- Solving path'),nl,
solve_path(Vertices, VertexWidth, 0, 0).
solve_vertices(_, _, BoardWidth, 0, BoardWidth).
solve_vertices(Board, Vertices, BoardWidth, BoardWidth, Y) :-
Y \= BoardWidth,
NewY is Y + 1,
solve_vertices(Board, Vertices, BoardWidth, 0, NewY).
solve_vertices(Board, Vertices, BoardWidth, X, Y) :-
X >= 0, X < BoardWidth, Y >= 0, Y < BoardWidth,
write('process'),nl,
write('X: '), write(X), write(' Y: '), write(Y), nl,
build_vertex_list(Board, Vertices, BoardWidth, X, Y, [V1, V2, V3, V4]),
write('1'),nl,
get_board_element(Board, BoardWidth, X, Y, Element),
write('2'),nl,
maximum(Max, Vertices),
(V1 #> 0 #/\ V2 #> 0 #/\
(
(V1 + 1 #= V2) #\
(V1 - 1 #= V2) #\
(V1 #= Max #/\ V2 #= 1) #\
(V1 #= 1 #/\ V2 #= Max)
)
) #<=> B1,
(V2 #> 0 #/\ V3 #> 0 #/\
(
(V2 + 1 #= V3) #\
(V2 - 1 #= V3) #\
(V2 #= Max #/\ V3 #= 1) #\
(V2 #= 1 #/\ V3 #= Max)
)
) #<=> B2,
(V3 #> 0 #/\ V4 #> 0 #/\
(
(V3 + 1 #= V4) #\
(V3 - 1 #= V4) #\
(V3 #= Max #/\ V4 #= 1) #\
(V3 #= 1 #/\ V4 #= Max)
)
) #<=> B3,
(V4 #> 0 #/\ V1 #> 0 #/\
(
(V4 + 1 #= V1) #\
(V4 - 1 #= V1) #\
(V4 #= Max #/\ V1 #= 1) #\
(V4 #= 1 #/\ V1 #= Max)
)
) #<=> B4,
write('3'),nl,
sum([B1, B2, B3, B4], #= , C),
write('4'),nl,
Element #> 0 #=> C #= Element,
write('5'),nl,
NewX is X + 1,
solve_vertices(Board, Vertices, BoardWidth, NewX, Y).
sel_next_variable_for_path(Vars,Sel,Rest) :-
% write(Vars), nl,
findall(Idx-Cost, (nth1(Idx, Vars,V), fd_set(V,S), fdset_size(S,Size), fdset_min(S,Min), var_cost(Min,Size, Cost)), L),
min_member(comp, BestIdx-_MinCost, L),
nth1(BestIdx, Vars, Sel, Rest),!.
var_cost(0, _, 1000000) :- !.
var_cost(_, 1, 1000000) :- !.
var_cost(X, _, X).
%build_vertex_list(_, Vertices, BoardWidth, X, Y, List)
constrain_starting_and_ending_vertices(Vertices, [V1,V2,V3,V4]) :-
maximum(Max, Vertices),
(V1 #= 1 #/\ V2 #= Max #/\ V3 #= Max - 1 #/\ V4 #= 2 ) #\
(V1 #= Max #/\ V2 #= 1 #/\ V3 #= 2 #/\ V4 #= Max - 1 ) #\
(V1 #= Max - 1 #/\ V2 #= Max #/\ V3 #= 1 #/\ V4 #= 2 ) #\
(V1 #= 2 #/\ V2 #= 1 #/\ V3 #= Max #/\ V4 #= Max - 1 ) #\
(V1 #= 1 #/\ V2 #= 2 #/\ V3 #= Max - 1 #/\ V4 #= Max ) #\
(V1 #= Max #/\ V2 #= Max - 1 #/\ V3 #= 2 #/\ V4 #= 1 ) #\
(V1 #= Max - 1 #/\ V2 #= 2 #/\ V3 #= 1 #/\ V4 #= Max ) #\
(V1 #= 2 #/\ V2 #= Max - 1 #/\ V3 #= Max #/\ V4 #= 1 ).
set_starting_and_ending_vertices(Board, Vertices, BoardWidth) :-
set_starting_and_ending_vertices(Board, Vertices, BoardWidth, 0, 0).
set_starting_and_ending_vertices(Board, Vertices, BoardWidth, BoardWidth, Y) :-
Y \= BoardWidth,
NewY is Y + 1,
solve_path(Board, Vertices, BoardWidth, 0, NewY).
set_starting_and_ending_vertices(Board, Vertices, BoardWidth, X, Y) :-
X >= 0, X < BoardWidth, Y >= 0, Y < BoardWidth,
build_vertex_list(_, Vertices, BoardWidth, X, Y, List),
get_board_element(Board, BoardWidth, X, Y, Element),
(Element = 3 ->
constrain_starting_and_ending_vertices(Vertices, List)
;
NewX is X + 1,
set_starting_and_ending_vertices(Board, Vertices, BoardWidth, NewX, Y)).
solve(Board, Vertices, BoardWidth) :-
write('Skyscrapers'), nl,
solve_skyscrapers(Board, BoardWidth),
write('Labeling'), nl,
labeling([ff], Board), !,
write('Setting domain'), nl,
NVertices is (BoardWidth+1)*(BoardWidth+1),
domain(Vertices, 0, NVertices),
write('Starting and ending vertices'), nl,
set_starting_and_ending_vertices(Board, Vertices, BoardWidth),
write('Setting maximum'), nl,
maximum(Max, Vertices),
write('1'),nl,
Max #> BoardWidth + 1,
write('2'),nl,
Max #< NVertices,
count(0, Vertices, #=, NZeros),
Max #= NVertices - NZeros,
write('3'),nl,
write('Calling nvalue'), nl,
ValueCount #= Max + 1,
nvalue(ValueCount, Vertices),
write('Solving fences'), nl,
solve_fences(Board, Vertices, BoardWidth),
write('Labeling'), nl,
labeling([ff], Vertices).
main :-
board(Board),
board_width(BoardWidth),
vertices(Vertices),
solve(Board, Vertices, BoardWidth),
%findall(Board,
% labeling([ff], Board),
% Boards
%),
%append(Board, Vertices, Final),
write('done.'),nl,
print_board(Board, 6), nl,
print_board(Vertices, 7).
utils.pro
get_element_at([Head|_], 0, Head).
get_element_at([_|Tail], Index, Element) :-
Index \= 0,
NewIndex is Index - 1,
get_element_at(Tail, NewIndex, Element).
reverse([], []).
reverse([Head|Tail], Inv) :-
reverse(Tail, Aux),
append(Aux, [Head], Inv).
munch(List, 0, List).
munch([_|Tail], Count, FinalList) :-
Count > 0,
NewCount is Count - 1,
munch(Tail, NewCount, FinalList).
select_n_elements(_, 0, []).
select_n_elements([Head|Tail], Count, FinalList) :-
Count > 0,
NewCount is Count - 1,
select_n_elements(Tail, NewCount, Result),
append([Head], Result, FinalList).
generate_list(Element, NElements, [Element|Result]) :-
NElements > 0,
NewNElements is NElements - 1,
generate_list(Element, NewNElements, Result).
generate_list(_, 0, []).
s1.pro
% Skyscrapers and Fences puzzle S1
board_width(6).
%observer(Type, Index, Orientation, Observer),
observer(row, 0, forward, 2).
observer(row, 1, forward, 2).
observer(row, 2, forward, 2).
observer(row, 3, forward, 1).
observer(row, 4, forward, 2).
observer(row, 5, forward, 1).
observer(row, 0, reverse, 1).
observer(row, 1, reverse, 1).
observer(row, 2, reverse, 2).
observer(row, 3, reverse, 3).
observer(row, 4, reverse, 2).
observer(row, 5, reverse, 2).
observer(column, 0, forward, 2).
observer(column, 1, forward, 3).
observer(column, 2, forward, 0).
observer(column, 3, forward, 2).
observer(column, 4, forward, 2).
observer(column, 5, forward, 1).
observer(column, 0, reverse, 1).
observer(column, 1, reverse, 1).
observer(column, 2, reverse, 2).
observer(column, 3, reverse, 2).
observer(column, 4, reverse, 2).
observer(column, 5, reverse, 2).
board(
[
_, _, 2, _, _, _,
_, _, _, _, _, _,
_, 2, _, _, _, _,
_, _, _, 2, _, _,
_, _, _, _, _, _,
_, _, _, _, _, _
]
).
vertices(
[
_, _, _, _, _, _, _,
_, _, _, _, _, _, _,
_, _, _, _, _, _, _,
_, _, _, _, _, _, _,
_, _, _, _, _, _, _,
_, _, _, _, _, _, _,
_, _, _, _, _, _, _
]
).
【问题讨论】：
【参考方案1】：我也和 twinterer 一样，喜欢这个谜题。但作为一个负责人，我必须首先为摩天大楼和栅栏部分找到合适的策略，然后对后者进行深入调试，导致复制变量问题使我锁定了好几个小时。
一旦解决了这个错误，我就面临着第一次尝试的低效率。我在普通的 Prolog 中重新设计了一个类似的模式，只是为了验证它的效率有多低。
至少，我了解如何更有效地使用 CLP(FD) 来模拟问题（在 twinterer 的回答的帮助下），现在程序很快（0.2 秒）。所以现在我可以提示您有关您的代码：所需的约束远比您编写的那些更简单：对于栅栏部分，即固定建筑物的位置，我们有 2 个约束：高度的边数> 0，并将边连接在一起：当使用边时，相邻的总和必须为 1（两边）。
这是我使用 SWI-Prolog 开发的代码的最后一个版本。
/* File: skys.pl
Author: Carlo,,,
Created: Dec 11 2011
Purpose: questions/8458945 on http://***.com
http://***.com/questions/8458945/optimizing-pathfinding-in-constraint-logic-programming-with-prolog
*/
:- module(skys, [skys/0, fences/2, draw_path/2]).
:- [index_square,
lambda,
library(clpfd),
library(aggregate)].
puzzle(1,
[[-,2,3,-,2,2,1,-],
[2,-,-,2,-,-,-,1],
[2,-,-,-,-,-,-,1],
[2,-,2,-,-,-,-,2],
[1,-,-,-,2,-,-,3],
[2,-,-,-,-,-,-,2],
[1,-,-,-,-,-,-,2],
[-,1,1,2,2,2,2,-]]).
skys :-
puzzle(1, P),
skyscrapes(P, Rows),
flatten(Rows, Flat),
label(Flat),
maplist(writeln, Rows),
fences(Rows, Loop),
writeln(Loop),
draw_path(7, Loop).
%% %%%%%%%%%%
% skyscrapes part
% %%%%%%%%%%
skyscrapes(Puzzle, Rows) :-
% massaging definition: separe external 'visibility' counters
first_and_last(Puzzle, Fpt, Lpt, Wpt),
first_and_last(Fpt, -, -, Fp),
first_and_last(Lpt, -, -, Lp),
maplist(first_and_last, Wpt, Lc, Rc, InnerData),
% InnerData it's the actual 'playground', Fp, Lp, Lc, Rc are list of counters
maplist(make_vars, InnerData, Rows),
% exploit symmetry wrt rows/cols
transpose(Rows, Cols),
% each row or col contains once 1,2,3
Occurs = [0-_, 1-1, 2-1, 3-1], % allows any grid size leaving unspecified 0s
maplist(\Vs^global_cardinality(Vs, Occurs), Rows),
maplist(\Vs^global_cardinality(Vs, Occurs), Cols),
% apply 'external visibility' constraint
constraint_views(Lc, Rows),
constraint_views(Fp, Cols),
maplist(reverse, Rows, RRows),
constraint_views(Rc, RRows),
maplist(reverse, Cols, RCols),
constraint_views(Lp, RCols).
first_and_last(List, First, Last, Without) :-
append([[First], Without, [Last]], List).
make_vars(Data, Vars) :-
maplist(\C^V^(C \= (-) -> V #= C ; V in 0..3), Data, Vars).
constraint_views(Ns, Ls) :-
maplist(\N^L^
( N \= (-)
-> constraint_view(0, L, Rs),
sum(Rs, #=, N)
; true
), Ns, Ls).
constraint_view(_, [], []).
constraint_view(Top, [V|Vs], [R|Rs]) :-
R #<==> V #> 0 #/\ V #> Top,
Max #= max(Top, V),
constraint_view(Max, Vs, Rs).
%% %%%%%%%%%%%%%%%
% fences part
% %%%%%%%%%%%%%%%
fences(SkyS, Ps) :-
length(SkyS, D),
% allocate edges
max_dimensions(D, _,_,_,_, N),
N1 is N + 1,
length(Edges, N1),
Edges ins 0..1,
findall((R, C, V),
(nth0(R, SkyS, Row), nth0(C, Row, V), V > 0),
Buildings),
maplist(count_edges(D, Edges), Buildings),
findall((I, Adj1, Adj2),
(between(0, N, I), edge_adjacents(D, I, Adj1, Adj2)),
Path),
maplist(make_path(Edges), Path, Vs),
flatten([Edges, Vs], Gs),
label(Gs),
used_edges_to_path_coords(D, Edges, Ps).
count_edges(D, Edges, (R, C, V)) :-
cell_edges(D, (R, C), Is),
idxs0_to_elems(Is, Edges, Es),
sum(Es, #=, V).
make_path(Edges, (Index, G1, G2), [S1, S2]) :-
idxs0_to_elems(G1, Edges, Adj1),
idxs0_to_elems(G2, Edges, Adj2),
nth0(Index, Edges, Edge),
[S1, S2] ins 0..3,
sum(Adj1, #=, S1),
sum(Adj2, #=, S2),
Edge #= 1 #<==> S1 #= 1 #/\ S2 #= 1.
%% %%%%%%%%%%%%%%
% utility: draw a path with arrows
% %%%%%%%%%%%%%%
draw_path(D, P) :-
forall(between(1, D, R),
( forall(between(1, D, C),
( V is (R - 1) * D + C - 1,
U is (R - 2) * D + C - 1,
( append(_, [V, U|_], P)
-> write(' ^ ')
; append(_, [U, V|_], P)
-> write(' v ')
; write(' ')
)
)),
nl,
forall(between(1, D, C),
( V is (R - 1) * D + C - 1,
( V < 10
-> write(' ') ; true
),
write(V),
U is V + 1,
( append(_, [V, U|_], P)
-> write(' > ')
; append(_, [U, V|_], P)
-> write(' < ')
; write(' ')
)
)),
nl
)
).
% convert from 'edge used flags' to vertex indexes
%
used_edges_to_path_coords(D, EdgeUsedFlags, PathCoords) :-
findall((X, Y),
(nth0(Used, EdgeUsedFlags, 1), edge_verts(D, Used, X, Y)),
Path),
Path = [(First, _)|_],
edge_follower(First, Path, PathCoords).
edge_follower(C, Path, [C|Rest]) :-
( select(E, Path, Path1),
( E = (C, D) ; E = (D, C) )
-> edge_follower(D, Path1, Rest)
; Rest = []
).
输出：
[0,0,2,1,0,3]
[2,1,3,0,0,0]
[0,2,0,3,1,0]
[0,3,0,2,0,1]
[1,0,0,0,3,2]
[3,0,1,0,2,0]
[1,2,3,4,5,6,13,12,19,20,27,34,41,48,47,40,33,32,39,46,45,38,31,24,25,18,17,10,9,16,23,
22,29,30,37,36,43,42,35,28,21,14,7,8,1]
0 1 > 2 > 3 > 4 > 5 > 6
^ v
7 > 8 9 < 10 11 12 < 13
^ v ^ v
14 15 16 17 < 18 19 > 20
^ v ^ v
21 22 < 23 24 > 25 26 27
^ v ^ v
28 29 > 30 31 32 < 33 34
^ v ^ v ^ v
35 36 < 37 38 39 40 41
^ v ^ v ^ v
42 < 43 44 45 < 46 47 < 48
正如我所提到的，我的第一次尝试更“程序化”：它绘制了一个循环，但我无法解决的问题基本上是必须事先知道顶点子集的基数，基于全局约束 all_different。它在缩小的 4*4 拼图上工作起来很痛苦，但我在 6*6 原版上几个小时后停止了它。无论如何，从头开始学习如何使用 CLP(FD) 绘制路径是很有收获的。
t :-
time(fences([[0,0,2,1,0,3],
[2,1,3,0,0,0],
[0,2,0,3,1,0],
[0,3,0,2,0,1],
[1,0,0,0,3,2],
[3,0,1,0,2,0]
],L)),
writeln(L).
fences(SkyS, Ps) :-
length(SkyS, Dt),
D is Dt + 1,
Sq is D * D - 1,
% min/max num. of vertices
aggregate_all(sum(V), (member(R, SkyS), member(V, R)), MinVertsT),
MinVerts is max(4, MinVertsT),
MaxVerts is D * D,
% find first cell with heigth 3, for sure start vertex
nth0(R, SkyS, Row), nth0(C, Row, 3),
% search a path with at least MinVerts
between(MinVerts, MaxVerts, NVerts),
length(Vs, NVerts),
Vs ins 0 .. Sq,
all_distinct(Vs),
% make a loop
Vs = [O|_],
O is R * D + C,
append(Vs, [O], Ps),
% apply #edges check
findall(rc(Ri, Ci, V),
(nth0(Ri, SkyS, Rowi),
nth0(Ci, Rowi, V),
V > 0), VRCs),
maplist(count_edges(Ps, D), VRCs),
connect_path(D, Ps),
label(Vs).
count_edges(Ps, D, rc(R, C, V)) :-
V0 is R * D + C,
V1 is R * D + C + 1,
V2 is (R + 1) * D + C,
V3 is (R + 1) * D + C + 1,
place_edges(Ps, [V0-V1, V0-V2, V1-V3, V2-V3], Ts),
flatten(Ts, Tsf),
sum(Tsf, #=, V).
place_edges([A,B|Ps], L, [R|Rs]) :-
place_edge(L, A-B, R),
place_edges([B|Ps], L, Rs).
place_edges([_], _L, []).
place_edge([M-N | L], A-B, [Y|R]) :-
Y #<==> (A #= M #/\ B #= N) #\/ (A #= N #/\ B #= M),
place_edge(L, A-B, R).
place_edge([], _, []).
connect(X, D, Y) :-
D1 is D - 1,
[R, C] ins 0 .. D1,
X #= R * D + C,
( C #< D - 1, Y #= R * D + C + 1
; R #< D - 1, Y #= (R + 1) * D + C
; C #> 0, Y #= R * D + C - 1
; R #> 0, Y #= (R - 1) * D + C
).
connect_path(D, [X, Y | R]) :-
connect(X, D, Y),
connect_path(D, [Y | R]).
connect_path(_, [_]).
感谢您提出这么有趣的问题。
更多编辑：这里是完整解决方案的主要缺失代码（index_square.pl）
/* File: index_square.pl
Author: Carlo,,,
Created: Dec 15 2011
Purpose: indexing square grid for FD mapping
*/
:- module(index_square,
[max_dimensions/6,
idxs0_to_elems/3,
edge_verts/4,
edge_is_horiz/3,
cell_verts/3,
cell_edges/3,
edge_adjacents/4,
edge_verts_all/2
]).
%
% index row : D, left to right
% index col : D, top to bottom
% index cell : same as top edge or row,col
% index vert : (D + 1) * 2
% index edge : (D * (D + 1)) * 2, first all horiz, then vert
%
% N denote range 0 .. N-1
%
% on a 2*2 grid, the numbering schema is
%
% 0 1
% 0-- 0 --1-- 1 --2
% | | |
% 0 6 0,0 7 0,1 8
% | | |
% 3-- 2 --4-- 3 --5
% | | |
% 1 9 1,0 10 1,1 11
% | | |
% 6-- 4 --7-- 5 --8
%
% while on a 4*4 grid:
%
% 0 1 2 3
% 0-- 0 --1-- 1 --2-- 2 --3-- 3 --4
% | | | | |
% 0 20 21 22 23 24
% | | | | |
% 5-- 4 --6-- 5 --7-- 6 --8-- 7 --9
% | | | | |
% 1 25 26 27 28 29
% | | | | |
% 10--8 --11- 9 --12--10--13--11--14
% | | | | |
% 2 30 31 32 33 34
% | | | | |
% 15--12--16--13--17--14--18--15--19
% | | | | |
% 3 35 36 37 38 39
% | | | | |
% 20--16--21--17--22--18--23--19--24
%
% | |
% --+-- N --+--
% | |
% W R,C E
% | |
% --+-- S --+--
% | |
%
% get range upper value for interesting quantities
%
max_dimensions(D, MaxRow, MaxCol, MaxCell, MaxVert, MaxEdge) :-
MaxRow is D - 1,
MaxCol is D - 1,
MaxCell is D * D - 1,
MaxVert is ((D + 1) * 2) - 1,
MaxEdge is (D * (D + 1) * 2) - 1.
% map indexes to elements
%
idxs0_to_elems(Is, Edges, Es) :-
maplist(nth0_(Edges), Is, Es).
nth0_(Edges, I, E) :-
nth0(I, Edges, E).
% get vertices of edge
%
edge_verts(D, E, X, Y) :-
S is D + 1,
edge_is_horiz(D, E, H),
( H
-> X is (E // D) * S + E mod D,
Y is X + 1
; X is E - (D * S),
Y is X + S
).
% qualify edge as horizontal (never fail!)
%
edge_is_horiz(D, E, H) :-
E >= (D * (D + 1)) -> H = false ; H = true.
% get 4 vertices of cell
%
cell_verts(D, (R, C), [TL, TR, BL, BR]) :-
TL is R * (D + 1) + C,
TR is TL + 1,
BL is TR + D,
BR is BL + 1.
% get 4 edges of cell
%
cell_edges(D, (R, C), [N, S, W, E]) :-
N is R * D + C,
S is N + D,
W is (D * (D + 1)) + R * (D + 1) + C,
E is W + 1.
% get adjacents at two extremities of edge I
%
edge_adjacents(D, I, G1, G2) :-
edge_verts(D, I, X, Y),
edge_verts_all(D, EVs),
setof(E, U^V^(member(E - (U, V), EVs), E \= I, (U == X ; V == X)), G1),
setof(E, U^V^(member(E - (U, V), EVs), E \= I, (U == Y ; V == Y)), G2).
% get all edge_verts/4 for grid D
%
edge_verts_all(D, L) :-
( edge_verts_all_(D, L)
-> true
; max_dimensions(D, _,_,_,_, S), %S is (D + 1) * (D + 2) - 1,
findall(E - (X, Y),
( between(0, S, E),
edge_verts(D, E, X, Y)
), L),
assert(edge_verts_all_(D, L))
).
:- dynamic edge_verts_all_/2.
%% %%%%%%%%%%%%%%%%%%%%
:- begin_tests(index_square).
test(1) :-
cell_edges(2, (0,1), [1, 3, 7, 8]),
cell_edges(2, (1,1), [3, 5, 10, 11]).
test(2) :-
cell_verts(2, (0,1), [1, 2, 4, 5]),
cell_verts(2, (1,1), [4, 5, 7, 8]).
test(3) :-
edge_is_horiz(2, 0, true),
edge_is_horiz(2, 5, true),
edge_is_horiz(2, 6, false),
edge_is_horiz(2, 9, false),
edge_is_horiz(2, 11, false).
test(4) :-
edge_verts(2, 0, 0, 1),
edge_verts(2, 3, 4, 5),
edge_verts(2, 5, 7, 8),
edge_verts(2, 6, 0, 3),
edge_verts(2, 11, 5, 8).
test(5) :-
edge_adjacents(2, 0, A, B), A = [6], B = [1, 7],
edge_adjacents(2, 9, [2, 6], [4]),
edge_adjacents(2, 10, [2, 3, 7], [4, 5]).
test(6) :-
cell_edges(4, (2,1), [9, 13, 31, 32]).
:- end_tests(index_square).
【讨论】：
这非常非常好！感谢您为此工作并发布您的解决方案。我想知道 CLP(FD) 的 automaton/3 或 automaton/8 约束是否也可用于描述此问题中的路径。 我也想知道！我试图理解它，但缺乏例子或解释让我望而却步。底层机制太复杂了，但我会再试一次！ 并且：idxs0_to_elems/3 的定义丢失了（大概在文件“index_square”中）。并且：在您最初的尝试中，您似乎可以使用 library(clpfd) 中的 circuit/1 约束来描述循环。 在发布完整代码时，是否会包含模块 index_square 和 lambda？我想在您的解决方案中跟踪一次运行，以了解搜索策略，并查看我是否可以在 ECLiPSe 中复制它。 index_square.pl 确实包含为后一种方法开发的一些可重用代码：我认为可以重用，所以移动它。我会发布它。 Lambda 它来自 Ulrich Neumerkle，但由于导致最初锁定我的问题（意外复制），我将其删除。 circuit/1 确实应该是要走的路，但它需要整个图表。主要问题是只涉及一个子集。【参考方案2】：快速浏览一下您的程序表明您大量使用了具体化。不幸的是，这样的公式意味着 SICStus 等当前系统的一致性很弱。
然而，通常情况下，事物可以更紧凑地表述，从而获得更好的一致性。下面是一个示例，您可以根据自己的需要进行调整。
比如说，你想表达 (X1,Y1) 和 (X2,Y2) 是水平或垂直的邻居。您可以针对每种可能性说 ( X1+1 #= X2 #/\ Y1 #= Y2 ) #\ ...（并检查您的健康保险是否涵盖 RSI）。
或者你可以说abs(X1-X2)+abs(Y1-Y2) #= 1。在过去，SICStus Prolog 曾经有一个对称的差异(--)/2，但我假设您使用的是版本 4。
以上公式保持区间一致性（至少我从我尝试过的示例中得出了这一结论）：
| ?- X1 in 1..9, abs(X1-X2)+abs(Y1-Y2) #= 1.
X1 in 1..9,
X2 in 0..10,...
所以X2 很容易受到约束！
在某些情况下（正如您在回复中指出的那样），您需要具体化的表单来维护其他约束。在这种情况下，您可以考虑同时发布两者。
翻阅手册，有几个组合约束也可能很有趣。作为快速修复，smt/1 可能会有所帮助（4.2.0 中的新功能）。有兴趣听听这个...
另一种可能是使用其他实现：例如 YAP 的 library(clpfd) 或 SWI。
【讨论】：
感谢您的回答！例如，在solve_vertices/5 中，我需要使用具体化，因为我必须强制成功的数量等于C:sum([B1, B2, B3, B4], #= , C)。
您可以同时发布两者。对于其他 cmets，请参见上文。【参考方案3】：
多么漂亮的小拼图啊！为了理解这些属性，我在 ECLiPSe 中实现了一个解决方案。它可以在这里找到：http://pastebin.com/eZbgjgFA（如果您在代码中看到循环，请不要担心：这些可以很容易地转换为标准 Prolog 谓词。不过，还有其他东西，从 ECLiPSe 转换为 Sicstus 并不那么容易）
执行时间比您报告的要快，但可能会更好：
?- snf(L).
L = [[]([]([](0,0,1,1),[](1,1,0,0),[](0,1,0,1),[](0,1,0,0),[](0,1,0,0),[](0,1,1,1)),
[]([](1,1,0,0),[](0,0,1,0),[](1,1,1,0),[](1,0,0,1),[](0,0,1,0),[](1,1,0,1)),
[]([](1,0,0,0),[](0,0,1,1),[](1,0,0,0),[](0,1,1,1),[](1,0,0,0),[](0,1,1,0)),
[]([](1,0,1,0),[](1,1,0,1),[](0,0,1,0),[](1,1,0,0),[](0,0,0,1),[](0,0,1,0)),
[]([](1,0,0,0),[](0,1,1,1),[](1,0,1,0),[](1,0,1,0),[](1,1,1,0),[](1,0,1,0)),
[]([](1,0,1,1),[](1,1,0,0),[](0,0,1,0),[](1,0,1,1),[](1,0,1,0),[](1,0,1,1))),
...]
Yes (40.42s cpu, solution 1, maybe more)
No (52.88s cpu)
您在答案中看到的是边矩阵。每个内部项表示拼图中的一个字段，哪个边缘是活动的（左、上、右、下）。我编辑了其余的。
我总共使用了八个数组：HxWx4 边数组 (0/1)、一个 (H+1)x(W+1) 每个字段顶点的活动边数组 (0/2)、一个 HxW 数组活动边的总和 (0..3)、建筑物的 HxW 数组 (0/1)、建筑物高度的两个 [H,W]x3 数组和建筑物位置的两个 [H,W]x3 数组。
必须只有一个路径的要求没有作为约束，而只是在标记过程中找到潜在解决方案后作为检查执行。
约束是：
sum 数组必须包含每个字段的有效边的总和
相邻字段的接触边缘必须包含相同的值
顶点必须有两条连接到它们的活动边，或者没有
在每一列/行中，必须放置三个建筑物。一些建筑物是按照拼图的定义放置的
行/列中的每个建筑物高度必须不同
建筑高度对应于该位置的活动边的总和
可见建筑物的数量由拼图的定义指定。这限制了建筑物在行/列中出现的顺序。
建筑物在行/列中的位置必须按升序给出
一旦知道了第一/第二/第三栋建筑的位置，我们就可以推断出一些不能放置建筑的位置。
有了这组约束，我们现在可以进行标注了。标记分两步完成，加快了求解过程。
在第一步中，仅标记建筑物位置。这是最受限制的部分，如果我们在这里找到解决方案，剩下的就容易多了。
在第二步中，所有其他变量都被标记。对于这两个步骤，我都选择了“先失败”作为标记策略，即首先标记具有最小域的变量。
如果不先解决建筑物的位置，程序会花费更长的时间（我总是在几分钟后停止它）。由于我没有第二个拼图实例可用，但我不确定搜索策略是否适用于所有实例
再次查看您的程序，您似乎遵循了类似的策略，即首先放置建筑物。但是，您在设置约束和标签之间进行迭代。这效率不高。在 CLP 中，您应该始终将约束放在前面（除非约束确实取决于部分解决方案的当前状态），并且只有在发布约束时您才搜索解决方案。这样，您可以在搜索过程中检测到所有约束的失败。否则，您可能会找到满足您迄今为止发布的一组约束的部分解决方案，只是发现一旦添加了其他约束，您就无法完成该解决方案。
此外，如果您有不同的变量集，请尝试变量的标记顺序。不过，没有通用的方法。
希望这会有所帮助！
【讨论】：
以上是关于使用 Prolog 优化约束逻辑编程中的寻路的主要内容，如果未能解决你的问题，请参考以下文章