我正在尝试在 Prolog 中解决 15 个难题，我需要找到最少的移动次数。
在这里，我们有一个带有详细答案的示例拼图。https://rosettacode.org/wiki/15_puzzle_solver
我正在使用 A* 搜索，使用曼哈顿距离作为启发式。
首先，我确保程序是确定性的。规则要么不适用，要么快速失败，要么在没有回溯的情况下运行完成。为了优化空间，我使用了一个数字来表示状态。搜索队列使用二项式队列进行优化，访问检查使用哈希树进行优化。但是，性能仍然很糟糕。
这是我对二项式队列的实现：
:- module(myheap, [myHeapInsert/4, myHeapDeleteMin/4]).
mergeOneTree(Tree, [], [Tree]) :-
Tree = binomialQueueNode(_, _, _, _), !.
mergeOneTree(Tree, [Head|Tail], [Tree,Head|Tail]) :-
Tree = binomialQueueNode(Size, _, _, _),
Head = binomialQueueNode(Head_Size, _, _, _),
Size < Head_Size,
!.
mergeOneTree(Tree, [Head|Tail], Result) :-
Tree = binomialQueueNode(Size, Data, Priority, Subtree_Content-Subtree_Indeterminate),
Head = binomialQueueNode(Size, _, Head_Priority, _),
Priority < Head_Priority,
Concatenation = Subtree_Content-Concatenation_Indeterminate,
Subtree_Indeterminate = [Head|Concatenation_Indeterminate],
DoubleSize is Size *2,
mergeOneTree(binomialQueueNode(DoubleSize, Data, Priority, Concatenation), Tail, Result),
!.
mergeOneTree(Tree, [Head|Tail], Result) :-
Tree = binomialQueueNode(Size, _, Priority, _),
Head = binomialQueueNode(Size, Head_Data, Head_Priority, Head_Subtree_Content-Head_Subtree_Indeterminate),
Priority >= Head_Priority,
Concatenation = Head_Subtree_Content-Concatenation_Indeterminate,
Head_Subtree_Indeterminate = [Tree|Concatenation_Indeterminate],
DoubleSize is Size *2,
mergeOneTree(binomialQueueNode(DoubleSize, Head_Data, Head_Priority, Concatenation), Tail, Result),
!.
mergeOneTree(Tree, [Head|Tail], [Head|TailResult]) :-
Tree = binomialQueueNode(Size, _, _, _),
Head = binomialQueueNode(Head_Size, _, _, _),
Size > Head_Size,
mergeOneTree(Tree, Tail, TailResult),
!.
merge([], X, X) :- !.
merge([H|T], X, R) :- mergeOneTree(H, X, I), merge(T, I, R), !.
findMinTree([H|T], MinTree, Others) :-
findMinTree(H, T, MinTree, Others), !.
findMinTree(CurrentMin, [], CurrentMin, []) :- !.
findMinTree(CurrentMin, [Candidate|Tail], ResultMinTree, [Candidate|ResultOthers]) :-
CurrentMin = binomialQueueNode(_, _, CurrentMin_Priority, _),
Candidate = binomialQueueNode(_, _, Candidate_Priority, _),
Candidate_Priority > CurrentMin_Priority,
findMinTree(CurrentMin, Tail, ResultMinTree, ResultOthers),
!.
findMinTree(CurrentMin, [Candidate|Tail], ResultMinTree, [CurrentMin|ResultOthers]) :-
CurrentMin = binomialQueueNode(_, _, CurrentMin_Priority, _),
Candidate = binomialQueueNode(_, _, Candidate_Priority, _),
Candidate_Priority =< CurrentMin_Priority,
findMinTree(Candidate, Tail, ResultMinTree, ResultOthers),
!.
myHeapInsert(BeforeTree, Data, Priority, AfterTree) :-
mergeOneTree(binomialQueueNode(1, Data, Priority, Dummy-Dummy), BeforeTree, AfterTree), !.
myHeapDeleteMin(BeforeTree, MinData, MinPriority, AfterTree) :-
findMinTree(BeforeTree, MinTree, Others),
MinTree = binomialQueueNode(_, MinData, MinPriority, MinTreeSubTree_Content-MinTreeSubTree_Indeterminate),
MinTreeSubTree_Indeterminate = [],
merge(Others, MinTreeSubTree_Content, AfterTree),
!.
这是我对哈希树的实现：
:- module(myhash, [myHashEmpty/1, myHashGet/4, myHashPut/5]).
reverseBinary(0, 0, []).
reverseBinary(0, L, [0|R]) :- L > 0, D is L - 1, reverseBinary(0, D, R), !.
reverseBinary(1, L, [1|R]) :- L > 0, D is L - 1, reverseBinary(0, D, R), !.
reverseBinary(N, L, Result) :- N > 1, R is N mod 2, Q is (N - R) / 2, D is L - 1, reverseBinary(Q, D, QR), Result = [R|QR], !.
getValue([H|T], Key, Value) :- H = pair(Key, Value); getValue(T, Key, Value), !.
getHash(Key, [], hashTrieLeaf(Values), Value) :- getValue(Values, Key, Value), !.
getHash(Key, [0|T], hashTrieNode(Left,_), Value) :- getHash(Key, T, Left, Value), !.
getHash(Key, [1|T], hashTrieNode(_,Right), Value) :- getHash(Key, T, Right, Value), !.
putHash(Tuple, [], hashTrieNil, hashTrieLeaf([Tuple])) :- !.
putHash(Tuple, [], hashTrieLeaf(Tuples), hashTrieLeaf([Tuple|Tuples])) :- !.
putHash(Tuple, [0|T], hashTrieNil, hashTrieNode(LeftResult, hashTrieNil)) :-
putHash(Tuple, T, hashTrieNil, LeftResult), !.
putHash(Tuple, [0|T], hashTrieNode(Left,Right), hashTrieNode(LeftResult, Right)) :-
putHash(Tuple, T, Left, LeftResult), !.
putHash(Tuple, [1|T], hashTrieNil, hashTrieNode(hashTrieNil, RightResult)) :-
putHash(Tuple, T, hashTrieNil, RightResult), !.
putHash(Tuple, [1|T], hashTrieNode(Left,Right), hashTrieNode(Left, RightResult)) :-
putHash(Tuple, T, Right, RightResult), !.
myHashEmpty(hashTrieNil) :- !.
myHashGet(HashMap, Key, Hash, Value) :- reverseBinary(Hash, 30, HashBits), getHash(Key, HashBits, HashMap, Value), !.
myHashPut(BeforeHashMap, Key, Hash, Value, AfterHashMap) :- reverseBinary(Hash, 30, HashBits), putHash(pair(Key, Value), HashBits, BeforeHashMap, AfterHashMap), !.
最后，解谜代码：
:- set_prolog_stack(global, limit(100 000 000 000)).
:- set_prolog_stack(trail, limit(20 000 000 000)).
:- set_prolog_stack(local, limit(2 000 000 000)).
:- use_module(myheap).
:- use_module(myhash).
hash([], 0) :- !.
hash([H|T], Hash) :- hash(T, R), Hash is (H + 23 * R) mod 1073741824, !.
flatten([[A,B,C,D],[E,F,G,H],[I,J,K,L],[M,N,O,P]],[A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]) :- !.
moves([0,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X10,X01,X02,X03,0,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X10),move([X01,0,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X01)]) :- !.
moves([X00,0,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([0,X00,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X00),move([X00,X11,X02,X03,X10,0,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X11),move([X00,X02,0,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X02)]) :- !.
moves([X00,X01,0,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,0,X01,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X01),move([X00,X01,X12,X03,X10,X11,0,X13,X20,X21,X22,X23,X30,X31,X32,X33],X12),move([X00,X01,X03,0,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X03)]):- !.
moves([X00,X01,X02,0,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,X01,0,X02,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X02),move([X00,X01,X02,X13,X10,X11,X12,0,X20,X21,X22,X23,X30,X31,X32,X33],X13)]):- !.
moves([X00,X01,X02,X03,0,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([0,X01,X02,X03,X00,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X00),move([X00,X01,X02,X03,X20,X11,X12,X13,0,X21,X22,X23,X30,X31,X32,X33],X20),move([X00,X01,X02,X03,X11,0,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X11)]):- !.
moves([X00,X01,X02,X03,X10,0,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,0,X02,X03,X10,X01,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X01),move([X00,X01,X02,X03,0,X10,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X10),move([X00,X01,X02,X03,X10,X21,X12,X13,X20,0,X22,X23,X30,X31,X32,X33],X21),move([X00,X01,X02,X03,X10,X12,0,X13,X20,X21,X22,X23,X30,X31,X32,X33],X12)]):- !.
moves([X00,X01,X02,X03,X10,X11,0,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,X01,0,X03,X10,X11,X02,X13,X20,X21,X22,X23,X30,X31,X32,X33],X02),move([X00,X01,X02,X03,X10,0,X11,X13,X20,X21,X22,X23,X30,X31,X32,X33],X11),move([X00,X01,X02,X03,X10,X11,X22,X13,X20,X21,0,X23,X30,X31,X32,X33],X22),move([X00,X01,X02,X03,X10,X11,X13,0,X20,X21,X22,X23,X30,X31,X32,X33],X13)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,0,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,X01,X02,0,X10,X11,X12,X03,X20,X21,X22,X23,X30,X31,X32,X33],X03),move([X00,X01,X02,X03,X10,X11,0,X12,X20,X21,X22,X23,X30,X31,X32,X33],X12),move([X00,X01,X02,X03,X10,X11,X12,X23,X20,X21,X22,0,X30,X31,X32,X33],X23)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,0,X21,X22,X23,X30,X31,X32,X33],[move([X00,X01,X02,X03,0,X11,X12,X13,X10,X21,X22,X23,X30,X31,X32,X33],X10),move([X00,X01,X02,X03,X10,X11,X12,X13,X30,X21,X22,X23,0,X31,X32,X33],X30),move([X00,X01,X02,X03,X10,X11,X12,X13,X21,0,X22,X23,X30,X31,X32,X33],X21)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,0,X22,X23,X30,X31,X32,X33],[move([X00,X01,X02,X03,X10,0,X12,X13,X20,X11,X22,X23,X30,X31,X32,X33],X11),move([X00,X01,X02,X03,X10,X11,X12,X13,0,X20,X22,X23,X30,X31,X32,X33],X20),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X31,X22,X23,X30,0,X32,X33],X31),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X22,0,X23,X30,X31,X32,X33],X22)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,0,X23,X30,X31,X32,X33],[move([X00,X01,X02,X03,X10,X11,0,X13,X20,X21,X12,X23,X30,X31,X32,X33],X12),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,0,X21,X23,X30,X31,X32,X33],X21),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X32,X23,X30,X31,0,X33],X32),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X23,0,X30,X31,X32,X33],X23)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,0,X30,X31,X32,X33],[move([X00,X01,X02,X03,X10,X11,X12,0,X20,X21,X22,X13,X30,X31,X32,X33],X13),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,0,X22,X30,X31,X32,X33],X22),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X33,X30,X31,X32,0],X33)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,0,X31,X32,X33],[move([X00,X01,X02,X03,X10,X11,X12,X13,0,X21,X22,X23,X20,X31,X32,X33],X20),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X31,0,X32,X33],X31)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,0,X32,X33],[move([X00,X01,X02,X03,X10,X11,X12,X13,X20,0,X22,X23,X30,X21,X32,X33],X21),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,0,X30,X32,X33],X30),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X32,0,X33],X32)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,0,X33],[move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,0,X23,X30,X31,X22,X33],X22),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,0,X31,X33],X31),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X33,0],X33)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,0],[move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,0,X30,X31,X32,X23],X23),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,0,X32],X32)]):- !.
debug([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33]) :- true,write(X00),write('\t'),write(X01),write('\t'),write(X02),write('\t'),write(X03),write('\t'),write('\n'),write(X10),write('\t'),write(X11),write('\t'),write(X12),write('\t'),write(X13),write('\t'),write('\n'),write(X20),write('\t'),write(X21),write('\t'),write(X22),write('\t'),write(X23),write('\t'),write('\n'),write(X30),write('\t'),write(X31),write('\t'),write(X32),write('\t'),write(X33),write('\t'),write('\n'),write('\n').
easy([[1, 2, 3, 4],[5, 6, 0, 8],[9, 10, 7, 11],[13, 14, 15, 12]]).
hard([[15, 14, 1, 6],[ 9, 11, 4, 12],[ 0, 10, 7, 3],[13, 8, 5, 2]]).
dist(A, B, C) :- C is A - B, C >= 0, !.
dist(A, B, C) :- C is B - A, C >= 0, !.
manhattan(L, D) :- manhattan(L, 0, D), !.
manhattan([], _, 0) :- !.
manhattan([0|T], L, D) :-
NextL is L + 1,
manhattan(T, NextL, D),
!.
manhattan([H|T], L, D) :-
H > 0,
CellCol is L mod 4,
CellRow is (L - CellCol) / 4,
DataCol is (H - 1) mod 4,
DataRow is (H - 1- DataCol) / 4,
dist(CellCol, DataCol, CD),
dist(CellRow, DataRow, RD),
NextL is L + 1,
manhattan(T, NextL, TD),
D is CD + RD + TD,
!.
compress([], 0) :- !.
compress([H|T], L) :- compress(T, I), L is I * 16 + H, !.
uncompress(L, R) :- uncompress(L, 16, R), !.
uncompress(_, 0, []) :- !.
uncompress(L, C, [H|T]) :- C > 0, D is C - 1, H is L mod 16, R is (L - H) / 16, uncompress(R, D, T), !.
search(CurrentBoard) :-
myHashEmpty(EmptyHash),
hash(CurrentBoard, CurrentBoardHash),
manhattan(CurrentBoard, CurrentBoardPriority),
compress(CurrentBoard, CurrentBoardCompressed),
myHashPut(EmptyHash, CurrentBoardCompressed, CurrentBoardHash, _, Enqueued),
search(CurrentBoard, CurrentBoardPriority, 0, Enqueued, []), !.
search(CurrentBoard, _, _, _, _) :-
manhattan(CurrentBoard, 0),
!.
search(CurrentBoard, CurrentBoardPriority, CurrentStep, Enqueued, Queue) :-
CurrentBoardPriority > 0,
moves(CurrentBoard, NextMoves),
update_enqueued_queue_all(Enqueued, Queue, NextMoves, CurrentStep, NextEnqueued, ImmediateQueue),
myHeapDeleteMin(ImmediateQueue, NextState, NextBoardPriority, NextQueue),
state(NextBoardCompressed, _, NextStep) = NextState,
uncompress(NextBoardCompressed, NextBoard),
search(NextBoard, NextBoardPriority, NextStep, NextEnqueued, NextQueue),
!.
update_enqueued_queue_all(Enqueued, Queue, [], _, Enqueued, Queue) :- !.
update_enqueued_queue_all(Enqueued, Queue, [Head|Tail], CurrentStep, NextEnqueued, NextQueue) :-
move(HeadBoard, HeadMove) = Head,
hash(HeadBoard, HeadHash),
compress(HeadBoard, HeadBoardCompressed),
update_enqueued_queue(Enqueued, Queue, HeadBoard, HeadBoardCompressed, HeadHash, HeadMove, CurrentStep, ImmediateEnqueued, ImmediateQueue),
update_enqueued_queue_all(ImmediateEnqueued, ImmediateQueue, Tail, CurrentStep, NextEnqueued, NextQueue),
!.
update_enqueued_queue(Enqueued, Queue, Board, BoardCompressed, BoardHash, Move, CurrentStep, NextEnqueued, NextQueue) :-
myHashGet(Enqueued, BoardCompressed, BoardHash, _), NextEnqueued = Enqueued, NextQueue = Queue, !;
NextStep is CurrentStep + 1, manhattan(Board, BoardHeuristic), BoardPriority is NextStep + BoardHeuristic, myHashPut(Enqueued, BoardCompressed, BoardHash, _, NextEnqueued), myHeapInsert(Queue, state(BoardCompressed, Move, NextStep), BoardPriority, NextQueue), !.
solve(X) :- flatten(X, Y), search(Y).
run :- hard(X), solve(X).
按原样，代码在我的计算机上不会在几分钟内运行完成。我做了一个减少目标的配置文件（运行）（例如，当曼哈顿距离为 10 时停止），大部分时间都花在垃圾收集上。
我读过关于 StackOverflow 上的另一个线程谈论同样的事情，“解决方案”是使用约束库，这是我不能使用的东西。
我用尽了我的技巧，坦率地说，我不是一个经常使用 Prolog 的程序员。知道如何在速度方面做得更好吗？