用 clpfd 过桥拼图

Bridge crossing puzzle with clpfd

我已经尝试用 clpfd 解决 'Escape from Zurg' 问题。 https://web.engr.oregonstate.edu/~erwig/papers/Zurg_JFP04.pdf 玩具从左边开始到右边。这是我的:

:-use_module(library(clpfd)).

toy(buzz,5).
toy(woody,10).
toy(res,20).
toy(hamm,25).

%two toys cross, the time is the max of the two.
cross([A,B],Time):-
  toy(A,T1),
  toy(B,T2),
  dif(A,B),
  Time#=max(T1,T2).
%one toy crosses
cross(A,T):-
  toy(A,T).

%Two toys travel left to right
solve_L(Left,Right,[l_r(A,B,T)|Moves]):-
  select(A,Left,L1),
  select(B,L1,Left2),
  cross([A,B],T),
  solve_R(Left2,[A,B|Right],Moves).

%One toy has to return with the flash light
solve_R([],_,[]).
solve_R(Left,Right,[r_l(A,empty,T)|Moves]):-
  select(A,Right,Right1),
  cross(A,T),
  solve_L([A|Left],Right1,Moves).

solve(Moves,Time):-
   findall(Toy,toy(Toy,_),Toys),
   solve_L(Toys,_,Moves),
   all_times(Moves,Times),
   sum(Times,#=,Time).

all_times([],[]).
all_times(Moves,[Time|Times]):-
  Moves=[H|Tail],
  H=..[_,_,_,Time],
  all_times(Tail,Times).

查询 ?-solve(M,T)?-solve(Moves,T), labeling([min(T)],[T]). 我得到了一个解决方案,但没有一个 =< 60。(我也看不到一个..) 我将如何使用 clpfd 执行此操作?还是最好用link?

中的方法

仅供参考:我也发现了这个http://www.metalevel.at/zurg/zurg.html 其中有一个DCG解决方案。其中内置约束Time=<60,它没有找到最低时间。

我认为用 CLPFD 建模这个谜题可以用 automaton/8 完成。 在序言中我会写

escape_zurg(T,S) :-
    aggregate(min(T,S), (
     solve([5,10,20,25], [], S),
     sum_timing(S, T)), min(T,S)).

solve([A, B], _, [max(A, B)]).
solve(L0, R0, [max(A, B), C|T]) :-
    select(A, L0, L1),
    select(B, L1, L2),
    append([A, B], R0, R1),
    select(C, R1, R2),
    solve([C|L2], R2, T).

sum_timing(S, T) :-
    aggregate(sum(E), member(E, S), T).

产生这个解决方案

?- escape_zurg(T,S).
T = 60,
S = [max(5, 10), 5, max(20, 25), 10, max(10, 5)].

编辑

好吧,automaton/8 远远超出了我的能力... 让我们从更简单的开始:什么可以是状态的简单表示? 在 left/right 上我们有 4 个槽位,可以为空:so

escape_clpfd(T, Sf) :-
    L0 = [_,_,_,_],
    Zs = [0,0,0,0],
    L0 ins 5\/10\/20\/25,
    all_different(L0),
    ...

现在,既然问题这么简单,我们可以'hardcode'改变状态

...
lmove(L0/Zs, 2/2, L1/R1, T1), rmove(L1/R1, 1/3, L2/R2, T2),
lmove(L2/R2, 3/1, L3/R3, T3), rmove(L3/R3, 2/2, L4/R4, T4),
lmove(L4/R4, 4/0, Zs/ _, T5),
...

第一个lmove/4必须从左向右移动2个元素,完成后,我们将在左边有2个零,在右边有2个零。时间 (T1) 将是 max(A,B),其中 A、B 现在是 incognitermove/4 类似,但是 'return' 在 T2 中是唯一的元素(隐身),它将从右向左移动。我们正在对进化进行编码,断言每边 0 的数量(似乎不难概括)。

让我们完成:

...
T #= T1 + T2 + T3 + T4 + T5,
Sf = [T1,T2,T3,T4,T5].

现在,rmove/4更简单了,让我们来编码吧:

rmove(L/R, Lz/Rz, Lu/Ru, M) :-
    move_one(R, L, Ru, Lu, M),
    count_0s(Ru, Rz),
    count_0s(Lu, Lz).

它推迟到 move_one/5 实际工作,然后应用我们在上面硬编码的数字约束:

count_0s(L, Z) :-
    maplist(is_0, L, TF),
    sum(TF, #=, Z).

is_0(V, C) :- V #= 0 #<==> C.

is_0/2 具体化空槽条件,即使真值可数。值得一试:

?- count_0s([2,1,1],X).
X = 0.

?- count_0s([2,1,C],1).
C = 0.

?- count_0s([2,1,C],2).
false.

在 CLP(FD) 中编码 move_one/5 似乎很难。在这里 Prolog 不确定性似乎真的很合适......

move_one(L, R, [Z|Lt], [C|Rt], C) :-
    select(C, L, Lt), is_0(C, 0),
    select(Z, R, Rt), is_0(Z, 1).

select/3 这是一个纯谓词,Prolog 会在需要标注时回溯...

没有最小化,但是在我们得到解决方案后很容易添加。 到目前为止,对我来说似乎都是 'logical'。但是,当然...

?- escape_clpfd(T, S).
false.

所以,这里有龙...

?- spy(lmove),escape_clpfd(T, S).
% Spy point on escape_zurg:lmove/4
 * Call: (9) escape_zurg:lmove([_G12082{clpfd = ...}, _G12164{clpfd = ...}, _G12246{clpfd = ...}, _G12328{clpfd = ...}]/[0, 0, 0, 0], 2/2, _G12658/_G12659, _G12671) ?  creep
   Call: (10) escape_zurg:move_one([_G12082{clpfd = ...}, _G12164{clpfd = ...}, _G12246{clpfd = ...}, _G12328{clpfd = ...}], [0, 0, 0, 0], _G12673, _G12674, _G12661) ? sskip

...等等等等

抱歉,post 如果我有空闲时间来调试,会有解决方案吗...

编辑 有几个错误...这个 lmove/4

lmove(L/R, Lz/Rz, Lu/Ru, max(A, B)) :-
    move_one(L, R, Lt, Rt, A),
    move_one(Lt, Rt, Lu, Ru, B),
    count_0s(Lu, Lz),
    count_0s(Ru, Rz).

至少我们开始获得解决方案(添加变量以从外部连接到标签...)

escape_clpfd(T, Sf, L0) :- ...

?- escape_clpfd(T, S, Vs), label(Vs).
T = 85,
S = [max(5, 10), 10, max(10, 20), 20, max(20, 25)],
Vs = [5, 10, 20, 25] ;
T = 95,
S = [max(5, 10), 10, max(10, 25), 25, max(25, 20)],
Vs = [5, 10, 25, 20] ;
...

编辑

上面的代码有效,但速度慢得令人痛苦:

?- time((escape_clpfd(60, Sf, L0),label(L0))).
% 15,326,054 inferences, 5.466 CPU in 5.485 seconds (100% CPU, 2803917 Lips)
Sf = [max(5, 10), 10, max(20, 25), 5, max(5, 10)],
L0 = [5, 10, 20, 25] 

更改为 move_one/5:

move_one([L|Ls], [R|Rs], [R|Ls], [L|Rs], L) :-
    L #\= 0,
    R #= 0.
move_one([L|Ls], [R|Rs], [L|Lu], [R|Ru], E) :-
    move_one(Ls, Rs, Lu, Ru, E).

我有更好的表现:

?- time((escape_clpfd(60, Sf, L0),label(L0))).
% 423,394 inferences, 0.156 CPU in 0.160 seconds (97% CPU, 2706901 Lips)
Sf = [max(5, 10), 5, max(20, 25), 10, max(5, 10)],
L0 = [5, 10, 20, 25] 

然后,添加到 lmove/4

... A #< B, ...

我得到

% 233,953 inferences, 0.089 CPU in 0.095 seconds (94% CPU, 2621347 Lips)
Sf = [max(5, 10), 5, max(20, 25), 10, max(5, 10)],

整个它仍然比我的纯 Prolog 解决方案慢很多...

编辑

其他小改进:

?- time((escape_clpfd(60, Sf, L0),maplist(#=,L0,[5,10,20,25]))).
% 56,583 inferences, 0.020 CPU in 0.020 seconds (100% CPU, 2901571 Lips)
Sf = [max(5, 10), 5, max(20, 25), 10, max(5, 10)],

其中 all_different/1 已替换为

...
chain(L0, #<),
...

另一个改进:为零计算两边是没有用的:在 lmove 和 rmove 中删除(任意)一侧我们得到

% 35,513 inferences, 0.014 CPU in 0.014 seconds (100% CPU, 2629154 Lips)
Sf = [max(5, 10), 5, max(20, 25), 10, max(5, 10)],

编辑

只是为了好玩,这里是相同的纯(聚合除外)Prolog 解决方案,使用简单的确定性 'lifting' 变量(由 'lifter' 提供):

:- use_module(carlo(snippets/lifter)).

solve([A, B], _, [max(A, B)]).
solve(L0, R0, [max(A, B), C|T]) :-
    solve([C|select(B, select(A, L0, °), °)],
          select(C, append([A, B], R0, °), °),
          T).

顺便说一句,它相当快:

?- time(escape_zurg(T,S)).
% 50,285 inferences, 0.065 CPU in 0.065 seconds (100% CPU, 769223 Lips)
T = 60,
S = [max(5, 10), 5, max(20, 25), 10, max(10, 5)].

(绝对时间不是很好,因为我是运行一个为调试而编译的SWI-Prolog)

不是使用 CLP(FD) 的答案,只是为了展示成本等于或低于 60 的这个谜题存在的两个解决方案(文本太大到发表评论)。

这个谜题有多种变体。 Logtalk 在其 searching/bridge.lgt 示例中包含一个,具有不同的字符集和相应的过桥时间。但是我们可以修补它来解决这个问题的变化(使用当前的 Logtalk git 版本):

?- set_logtalk_flag(complements, allow).
true.

?- {searching(loader)}.
...
% (0 warnings)
true.

?- create_category(patch, [complements(bridge)], [], [initial_state(start, ([5,10,20,25], left, [])), goal_state(end, ([], right, [5,10,20,25]))]).
true.

?- performance::init, bridge::initial_state(Initial), hill_climbing(60)::solve(bridge, Initial, Path, Cost), bridge::print_path(Path), performance::report.
5 10 20 25  lamp _|____________|_ 
20 25  _|____________|_ lamp 5 10 
5 20 25  lamp _|____________|_ 10 
5  _|____________|_ lamp 10 20 25 
5 10  lamp _|____________|_ 20 25 
 _|____________|_ lamp 5 10 20 25 
solution length: 6
state transitions (including previous solutions): 113
ratio solution length / state transitions: 0.05309734513274336
minimum branching degree: 1
average branching degree: 5.304347826086956
maximum branching degree: 10
time: 0.004001000000000032
Initial =  ([5, 10, 20, 25], left, []),
Path = [([5, 10, 20, 25], left, []),  ([20, 25], right, [5, 10]),  ([5, 20, 25], left, [10]),  ([5], right, [10, 20, 25]),  ([5, 10], left, [20, 25]),  ([], right, [5|...])],
Cost = 60 ;
5 10 20 25  lamp _|____________|_ 
20 25  _|____________|_ lamp 5 10 
10 20 25  lamp _|____________|_ 5 
10  _|____________|_ lamp 5 20 25 
5 10  lamp _|____________|_ 20 25 
 _|____________|_ lamp 5 10 20 25 
solution length: 6
state transitions (including previous solutions): 219
ratio solution length / state transitions: 0.0273972602739726
minimum branching degree: 1
average branching degree: 5.764705882352941
maximum branching degree: 10
time: 0.0038759999999999906
Initial =  ([5, 10, 20, 25], left, []),
Path = [([5, 10, 20, 25], left, []),  ([20, 25], right, [5, 10]),  ([10, 20, 25], left, [5]),  ([10], right, [5, 20, 25]),  ([5, 10], left, [20, 25]),  ([], right, [5|...])],
Cost = 60 ;
false.

这是一个 CLP(FD) 版本,基于 code you linked to

主要区别在于,在此版本中,Limit 是参数而不是硬编码值。此外,它还利用 CLP(FD) 约束的灵活性表明,与低级算术相比,您可以在使用约束时更自由地重新排序您的目标,并且更加明确地推理您的代码:

:- use_module(library(clpfd)).

toy_time(buzz,   5).
toy_time(woody, 10).
toy_time(rex,   20).
toy_time(hamm,  25).

moves(Ms, Limit) :-
    phrase(moves(state(0,[buzz,woody,rex,hamm],[]), Limit), Ms).

moves(state(T0,Ls0,Rs0), Limit) -->
    [left_to_right(Toy1,Toy2)],
    { T1 #= T0 + max(Time1,Time2), T1 #=< Limit,
      select(Toy1, Ls0, Ls1), select(Toy2, Ls1, Ls2),
      Toy1 @< Toy2,
      toy_time(Toy1, Time1), toy_time(Toy2, Time2) },
    moves_(state(T1,Ls2,[Toy1,Toy2|Rs0]), Limit).

moves_(state(_,[],_), _)         --> [].
moves_(state(T0,Ls0,Rs0), Limit) -->
    [right_to_left(Toy)],
    { T1 #= T0 + Time, T1 #=< Limit,
      select(Toy, Rs0, Rs1),
      toy_time(Toy, Time) },
    moves(state(T1,[Toy|Ls0],Rs1), Limit).

用法示例,使用迭代加深首先找到最快的解决方案:

?- length(_, Limit), moves(Ms, Limit).
Limit = 60,
Ms = [left_to_right(buzz, woody), right_to_left(buzz), left_to_right(hamm, rex), right_to_left(woody), left_to_right(buzz, woody)] ;
Limit = 60,
Ms = [left_to_right(buzz, woody), right_to_left(woody), left_to_right(hamm, rex), right_to_left(buzz), left_to_right(buzz, woody)] ;
Limit = 61,
Ms = [left_to_right(buzz, woody), right_to_left(buzz), left_to_right(hamm, rex), right_to_left(woody), left_to_right(buzz, woody)] ;
etc.

请注意,此版本使用了 CLP(FD) 约束(用于修剪和算术)和内置 Prolog 回溯的组合,这样的组合是完全合法的。在某些情况下,全局约束(如 CapelliC 提到的 automaton/8)可以完整地表达一个问题,但是将约束与正常回溯相结合对于许多任务来说也是一个很好的策略。

事实上,仅仅发布 CLP(FD) 约束通常是不够的:在 CLP(FD) 的情况下,您通常还需要 labeling/2 提供的(回溯)搜索,以获得具体的解决方案。因此,这种迭代深化类似于 labeling/2 如果您成功地单独使用 CLP(FD) 约束来确定性地表达问题,则将以其他方式执行的搜索。

很好,我们还可以显示:

?- Limit #< 60, moves(Ms, Limit).
false.

编辑:由于对 CLP(FD) 约束感兴趣的用户似乎对 automaton/8 的渴望几乎无法抑制,这很好,我还创建了一个为您提供具有强大全局约束的解决方案。如果您觉得这很有趣,也请为@CapelliC 的回答点赞,因为他最初的想法是为此使用 automaton/8。这个想法是让一个或两个玩具的每个可能(和明智的)运动对应一个唯一的整数,并且这些运动引起自动机不同状态之间的转换。请注意,闪光灯的侧面在状态中也起着重要作用。此外,我们为每条弧线配备一个算术表达式,以跟踪到目前为止所花费的时间。请尝试?- arc(_, As).看看这个自动机的弧线。

:- use_module(library(clpfd)).

toy_time(b,  5).
toy_time(w, 10).
toy_time(r, 20).
toy_time(h, 25).

toys(Toys) :- setof(Toy, T^toy_time(Toy, T), Toys).

arc0(arc0(S0,M,S)) :-
    state(S0),
    state0_movement_state(S0, M, S).

arcs(V, Arcs) :-
    findall(Arc0, arc0(Arc0), Arcs0),
    movements(Ms),
    maplist(arc0_arc(V, Ms), Arcs0, Arcs).

arc0_arc(C, Ms, arc0(S0,M,S), arc(S0, MI, S, [C+T])) :-
    movement_time(M, T),
    nth0(MI, Ms, M).

movement_time(left_to_right(Toy), Time) :- toy_time(Toy, Time).
movement_time(left_to_right(T1,T2), Time) :-
    Time #= max(Time1,Time2),
    toy_time(T1, Time1),
    toy_time(T2, Time2).
movement_time(right_to_left(Toy), Time) :- toy_time(Toy, Time).


state0_movement_state(lrf(Ls0,Rs0,left), left_to_right(T), lrf(Ls,Rs,right)) :-
    select(T, Ls0, Ls),
    sort([T|Rs0], Rs).
state0_movement_state(lrf(Ls0,Rs0,left), left_to_right(T1,T2), S) :-
    state0_movement_state(lrf(Ls0,Rs0,left), left_to_right(T1), lrf(Ls1,Rs1,_)),
    state0_movement_state(lrf(Ls1,Rs1,left), left_to_right(T2), S),
    T1 @< T2.
state0_movement_state(lrf(Ls0,Rs0,right), right_to_left(T), lrf(Ls,Rs,left)) :-
    select(T, Rs0, Rs),
    sort([T|Ls0], Ls).

movements(Moves) :-
    toys(Toys),
    findall(Move, movement(Toys, Move), Moves).

movement(Toys, Move) :-
    member(T, Toys),
    (   Move = left_to_right(T)
    ;   Move = right_to_left(T)
    ).
movement(Toys0, left_to_right(T1, T2)) :-
    select(T1, Toys0, Toys1),
    member(T2, Toys1),
    T1 @< T2.

state(lrf(Lefts,Rights,Flash)) :-
    toys(Toys),
    phrase(lefts(Toys), Lefts),
    foldl(select, Lefts, Toys, Rights),
    ( Flash = left ; Flash = right ).

lefts([]) --> [].
lefts([T|Ts]) --> ( [T] | [] ), lefts(Ts).

现在,终于,我们终于可以使用 automaton/8,我们非常渴望得到一个我们 真正 认为值得携带 "CLP(FD)" 旗帜,与 labeling/2min/1 选项狂欢混合:

?- time((arcs(C, Arcs),
         length(Vs, _),
         automaton(Vs, _, Vs, [source(lrf([b,h,r,w],[],left)),
                               sink(lrf([],[b,h,r,w],right))],
                   Arcs, [C], [0], [Time]),
         labeling([min(Time)], Vs))).

产量:

857,542 inferences, 0.097 CPU in 0.097 seconds(100% CPU, 8848097 Lips)
Arcs = [...],
Time = 60,
Vs = [10, 1, 11, 7, 10] ;
etc.

我把将此类解决方案转换为可读状态转换作为一个简单的练习(约 3 行代码)。

为了更加满意,这比使用普通 Prolog 的原始版本快得多,为此我们有:

?- time((length(_, Limit), moves(Ms, Limit))).
1,666,522 inferences, 0.170 CPU in 0.170 seconds (100% CPU, 9812728 Lips)

这个故事的寓意:如果您直接的 Prolog 解决方案需要十分之一秒以上的时间来生成解决方案,那么您最好学习如何使用最复杂和最强大的全局约束之一来改进运行时间缩短了几毫秒! :-)

但更重要的是,这个例子表明约束传播可以很快得到回报,即使对于相对较小的搜索空间也是如此。使用 CLP(FD) 解决更复杂的搜索问题时,您可以获得更大的相对收益。

请注意第二个版本,虽然它在某种意义上更全局地传播约束,但缺少一个与传播和修剪相关的重要特征:以前,我们能够直接使用该程序来证明存在没有使用直接和自然查询(?- Limit #< 60, moves(Ms, Limit).,但失败)的解决方案花费的时间少于 60 分钟。这只是隐含地从第二个程序得出的,因为我们知道,其他条件不变,更长的列表最多可以增加 花费的时间。不幸的是,length/2 的孤立调用没有得到备忘录。

另一方面,第二个版本能够证明至少在某种意义上同样令人印象深刻的东西,而且它比第一个版本更有效、更直接:甚至没有构建一个单一的显式解决方案,我们可以使用第二个版本来证明任何解(如果有)需要至少 5个交叉点:

?- time((arcs(C, Arcs),
         length(Vs, L),
         automaton(Vs, _, Vs, [source(lrf([b,h,r,w],[],left)),
                               sink(lrf([],[b,h,r,w],right))],
         Arcs, [C], [0], [Time]))).

产量:

331,495 inferences, 0.040 CPU in 0.040 seconds (100% CPU, 8195513 Lips)
...,
L = 5
... .

这仅通过约束传播起作用,不涉及任何 labeling/2!

我认为@mat 已经为我最初尝试做的事情提出了一个很好的答案,但我确实尝试并使用 automaton/4,以及回溯搜索来添加弧线。这是我得到的。但是调用 bridge/2 时出现错误 ERROR: Arguments are not sufficiently instantiated。如果有人对此方法有任何意见或知道为什么会出现此错误,或者如果我使用 automaton/4 完全错误,请在此处发布!

fd_length(L, N) :-
  N #>= 0,
  fd_length(L, N, 0).

fd_length([], N, N0) :-
  N #= N0.
fd_length([_|L], N, N0) :-
  N1 is N0+1,
  N #>= N1,
fd_length(L, N, N1).

left_to_right_arc(L0,R0,Arc):-
  LenL#=<4,
  fd_length(L0,LenL),
  LenR #=4-LenL,
  fd_length(R0,LenR),
  L0 ins 5\/10\/20\/25,
  R0 ins 5\/10\/20\/25,
  append(L0,R0,All),
  all_different(All),
  Before =[L0,R0],
  select(A,L0,L1),
  select(B,L1,L2),
  append([A,B],R0,R1),
  After=[L2,R1],
  Cost #=max(A,B),
  Arc =arc(Before,Cost,After).

right_to_left_arc(L0,R0,Arc):-
  LenL#=<4,
  fd_length(L0,LenL),
  LenR #=4-LenL,
  fd_length(R0,LenR),
  L0 ins 5\/10\/20\/25,
  R0 ins 5\/10\/20\/25,
  append(L0,R0,All),
  all_different(All),
  Before=[L0,R0],
  select(A,R0,R1),
  append([A],L0,L1),
  After=[L1,R1],
  Cost#=A,
  Arc =arc(After,Cost,Before).

pair_of_arcs(Arcs):-
  left_to_right_arc(_,_,ArcLR),
  right_to_left_arc(_,_,ArcRL),
  Arcs =[ArcLR,ArcRL].

pairs_of_arcs(Pairs):-
  L#>=1,
  fd_length(Pairs,L),
  once(maplist(pair_of_arcs,Pairs)).

bridge(Vs,Arcs):-
  pairs_of_arcs(Arcs),
  flatten(Arcs,FArcs),
  automaton(Vs,[source([[5,10,20,25],[]]),sink([[],[5,10,20,25]])],
      FArcs).