与clpfd的桥梁横穿难题

时间：2015-10-06 19:56:06

标签： prolog puzzle clpfd river-crossing-puzzle

我试图解决“逃离泽格”的问题。 clpfd的问题。 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]).我得到一个解决方案，但没有一个=＆lt; 60.（我也看不到......） 我怎么用clpfd做这个？或者最好在链接中使用该方法吗？

仅供参考：我也发现了http://www.metalevel.at/zurg/zurg.html 哪个有DCG解决方案。在其中内置约束Time =＆lt; 60，它没有找到最低时间。

4 个答案:

答案 0 :(得分：5)

这是一个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.

编辑：由于automaton/8对CLP（FD）约束的感兴趣用户似乎几乎无法解释，这很好，我也创建了一个具有强大全球性的解决方案约束你。如果您觉得这很有意思，请同时提出@ 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我们非常渴望找到一个我们真正认为值得携带＆＃的解决方案34; CLP（FD）＆＃34;横幅，与min/1的{​​{1}}选项：

混合在一起 
labeling/2

得到以下特性：

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）解决更复杂的搜索问题时，您可以期待更大的相对增益。

注意虽然第二个版本虽然在某种意义上更全局地传播约束，但缺少一个与传播和修剪有关的重要特性：以前，我们能够直接使用该程序来表明没有解决方案这需要不到60分钟，使用直接和自然的查询（?- 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))). ，失败）。这只是隐含地从第二个程序开始，因为我们知道， ceteris paribus ，更长的列表最多可以增加所花费的时间。不幸的是，?- Limit #< 60, moves(Ms, Limit).的孤立调用没有得到备忘录。

另一方面，第二个版本能够证明在某种意义上至少同样令人印象深刻的东西，并且它比第一个版本更有效，更直接地做到了：没有构建单一的显式解决方案，我们可以使用第二个版本来显示任何解决方案（如果有的话）至少 5个交叉点：

length/2

得到以下特性：

331,495 inferences, 0.040 CPU in 0.040 seconds (100% CPU, 8195513 Lips)
...,
L = 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]))). ！

答案 1 :(得分：3)

我认为使用CLPFD进行建模这个难题可以用automaton / 8来完成。 在Prolog我会写

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远远超出了我的能力范围...... 让我们开始更简单：什么可以是一个简单的国家代表？ 在左/右我们有4个插槽，可以是空的：所以

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

现在，既然问题很简单，我们就可以硬编码＆＃39;国家改变

...
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现在 incognite 。 rmove/4类似，但会返回＆＃39;在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).

选择/ 3它是一个纯粹的谓词，而Prolog会在标记需要时回溯......

没有最小化，但在我们获得解决方案后很容易添加。 到目前为止，所有人似乎都是合乎逻辑的＆＃39;对我来说。但是，当然...... 

?- 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

......等等

很抱歉，如果我有空余的时间来调试，我会发布一个解决方案......

编辑有几个错误......用这个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解决方案，使用简单的确定性提升＆＃39;变量（礼貌＆＃39; lifter＆＃39;）：

:- 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编译进行调试）

答案 2 :(得分：1)

我认为@mat已经为我原本想要做的事情提出了一个很好的答案，但我确实尝试过并使用自动机/ 4，以及回溯搜索来添加弧线。这是我得到的。但是在调用ERROR: Arguments are not sufficiently instantiated时收到错误bridge/2。如果有人对此方法有任何意见或知道为什么会出现此错误，或者我使用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).

答案 3 :(得分：0)

这是不使用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.
相关问题
最新问题