试图解决Prolog中的跳钉拼图

Question

九洞有8个钉子.开始时,左边的四个红色钉子和右边的四个蓝色钉子,以及它们之间的一个空洞.谜题是将所有红色向右移动,将蓝色钉向左移动(在另一个相反方向).这些是合法的举措:

1. 钉子可能只向前移动(红色可能向右移动而蓝色向左移动).
2. 栓钉可向前移动一步到打开位置.
3. 如果超出它的位置是打开的,那么一个挂钩可能会跳过一个相反颜色的挂钩.

这是我写的,但它不起作用

% Form of board, b for blue, r for red, o for empty.
% [ [r,r,r,r], [o], [b,b,b,b] ]

% jumps 
linjmp([x, x, o | T], [o, o, x | T]).
linjmp([o, x, x | T], [x, o, o | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).


% Series of legal boards.
series(From, To, [From, To]) :- jump(From, To).
series(From, To, [From, By | Rest])
        :- jump(From, By), 
           series(By, To, [By | Rest]).

% Print a series of boards.  This puts one board per line and looks a lot
% nicer than the jumble that appears when the system simply beltches out
% a list of boards.  The write_ln predicate is a built-in which always
% succeeds (is always satisfied), but prints as a side-effect.  Therefore
% print_series(Z) will succeed with any list, and the members of the list
% will be printed, one per line, as a side-effect of that success.
print_series_r([]) :- 
    write_ln('*******************************************************').
print_series_r([X|Y]) :- write_ln(X), print_series_r(Y).
print_series(Z) :- 
    write_ln('\n*******************************************************'),
    print_series_r(Z).

% A solution.
solution(L) :- series([[r,r,r,r], [o], [b,b,b,b]],
                   [[b,b,b,b], [o], [r,r,r,r]], L).

% Find a print the first solution.  
solve :- solution(X), print_series(X).

% Find all the solutions.
solveall :- solve, fail.

% This finds each solution with stepping.
solvestep(Z) :- Z = next, solution(X), print_series(X).

当它工作时它应该是这样的:

?- consult(linejump).
% linejump compiled 0.00 sec, 3,612 bytes
true.

?- solve.

*******************************************************
[r, r, r, r, o, b, b, b, b]
[r, r, r, o, r, b, b, b, b]
[r, r, r, b, r, o, b, b, b]
[r, r, r, b, r, b, o, b, b]
[r, r, r, b, o, b, r, b, b]
[r, r, o, b, r, b, r, b, b]
[r, o, r, b, r, b, r, b, b]
[r, b, r, o, r, b, r, b, b]
[r, b, r, b, r, o, r, b, b]
[r, b, r, b, r, b, r, o, b]
[r, b, r, b, r, b, r, b, o]
[r, b, r, b, r, b, o, b, r]
[r, b, r, b, o, b, r, b, r]
[r, b, o, b, r, b, r, b, r]
[o, b, r, b, r, b, r, b, r]
[b, o, r, b, r, b, r, b, r]
[b, b, r, o, r, b, r, b, r]
[b, b, r, b, r, o, r, b, r]
[b, b, r, b, r, b, r, o, r]
[b, b, r, b, r, b, o, r, r]
[b, b, r, b, o, b, r, r, r]
[b, b, o, b, r, b, r, r, r]
[b, b, b, o, r, b, r, r, r]
[b, b, b, b, r, o, r, r, r]
[b, b, b, b, o, r, r, r, r]
*******************************************************
true ;

*******************************************************
[r, r, r, r, o, b, b, b, b]
[r, r, r, r, b, o, b, b, b]
[r, r, r, o, b, r, b, b, b]
[r, r, o, r, b, r, b, b, b]
[r, r, b, r, o, r, b, b, b]
[r, r, b, r, b, r, o, b, b]
[r, r, b, r, b, r, b, o, b]
[r, r, b, r, b, o, b, r, b]
[r, r, b, o, b, r, b, r, b]
[r, o, b, r, b, r, b, r, b]
[o, r, b, r, b, r, b, r, b]
[b, r, o, r, b, r, b, r, b]
[b, r, b, r, o, r, b, r, b]
[b, r, b, r, b, r, o, r, b]
[b, r, b, r, b, r, b, r, o]
[b, r, b, r, b, r, b, o, r]
[b, r, b, r, b, o, b, r, r]
[b, r, b, o, b, r, b, r, r]
[b, o, b, r, b, r, b, r, r]
[b, b, o, r, b, r, b, r, r]
[b, b, b, r, o, r, b, r, r]
[b, b, b, r, b, r, o, r, r]
[b, b, b, r, b, o, r, r, r]
[b, b, b, o, b, r, r, r, r]
[b, b, b, b, o, r, r, r, r]
*******************************************************
true .

?- 

Answer 1

一个简单的Prolog代码,它试图成为最简单和最清晰的代码,并且根本不关心效率:

start([r,r,r,r,e,b,b,b,b]).  % starting position

% can move from a position P1 to position P2
move(P1,P2):- append(A,[r,e|B],P1), append(A,[e,r|B],P2).
move(P1,P2):- append(A,[e,b|B],P1), append(A,[b,e|B],P2).
move(P1,P2):- append(A,[e,r,b|B],P1), append(A,[b,r,e|B],P2).
move(P1,P2):- append(A,[r,b,e|B],P1), append(A,[e,b,r|B],P2).

solved([b,b,b,b,e,r,r,r,r]).   % the target position to be reached

pegs :- start(P), solve(P, [], R), 
        maplist(writeln, R), nl, nl, fail ; true.

% solve( ?InitialPosition, +PreviousPositionsList, ?ResultingPath)
solve(P, Prev, R):- 
    solved(P) -> reverse([P|Prev], R) ; 
    move(P, Q), \+memberchk(Q, Prev), solve(Q, [P|Prev], R).

没什么特别的.在Ideone上花费整整0.08秒来找到两个解决方案,24个移动.

对于N -pegs问题,我们只需要相应地修改start和solved谓词.

荣誉去卡里Swoveland从他们的回答我接过符号(也就是一半的解决方案).一个更高效的代码,按照mat的回答,以Prolog特有的自上而下的方式构建结果列表(类似于差异列表技术,参见tailrecursion-modulo-cons):

swap([r,e|B],[e,r|B]).
swap([e,b|B],[b,e|B]).
swap([e,r,b|B],[b,r,e|B]).
swap([r,b,e|B],[e,b,r|B]).

move(A,B):- swap(A,B).
move([A|B],[A|C]):- move(B,C).

moves(S,[S]):- solved(S).
moves(S,[S|B]):- move(S,Q), moves(Q,B).

pegs(PS) :- start(P), moves(P, PS), maplist( writeln, PS), nl.

通常,任何在它们之间具有位置和移动的棋盘游戏都可以被视为在有效移动定义的位置搜索空间中的搜索问题,即从开始到结束(最终)位置.可以使用各种搜索策略,深度优先,广度优先,迭代深化,最佳优先启发...这将搜索空间视为节点位置(板配置),边缘移动的图形; 否则我们可以说这是move关系的传递性封闭.

有时,move关系被定义为产生新的合法配置(如此处); 有时,更容易定义一般移动关系并检查生成的合法性位置(如在N -queens问题中).在搜索时维护被访问节点列表也是很常见的,并检查任何新发现的节点是否是已访问过的节点之一 - 丢弃该路径,以避免进入循环.

广度优先搜索将明确维护被发现节点的边界,并将其保持为队列,同时一次一个地移动它; 深度首先作为一个堆栈.根据一些启发式方法,最佳的首次搜索将重新排序此前沿.这里,moves/2深度优先是隐含的,因为它依赖于Prolog搜索,它本身就是深度优先的.

有时保证搜索空间不具有这些周期(即成为DAG指导的非循环图),因此不需要检查唯一性.至于最终节点,有时它是由值定义的(就像这里),有时我们对某些条件感兴趣(例如在国际象棋中).请参阅此答案,了解如何使用惰性all_dif/1谓词预先强制实现此唯一性.通过定义谓词,这个问题就变得简单了

pegs(Ps):- 
    path( move, Ps, [r,r,r,r,e,b,b,b,b], [b,b,b,b,e,r,r,r,r]).