Search code examples
prologpuzzleclpfdriver-crossing-puzzle

Bridge crossing puzzle with clpfd


I have tried to solve the 'Escape from Zurg' problem with clpfd. https://web.engr.oregonstate.edu/~erwig/papers/Zurg_JFP04.pdf Toys start on the left and go to the right. This is what I have:

:-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).

Querying ?-solve(M,T) or ?-solve(Moves,T), labeling([min(T)],[T]). I get a solution but not one =< 60. (I cant see one either..) How would I do this with clpfd? Or is it best to use the method in the link?

FYI: I have also found this http://www.metalevel.at/zurg/zurg.html Which has a DCG solution. In it the constraint Time=<60 is built in, it does not find the lowest time.


Solution

  • Here is a CLP(FD) version, based on the code you linked to.

    The main difference is that in this version, Limit is a parameter instead of a hardcoded value. In addition, it also uses the flexibility of CLP(FD) constraints to show that, compared to low-level arithmetic, you can much more freely reorder your goals when using constraints, and reason about your code much more declaratively:

    :- 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).
    

    Usage example, using iterative deepening to find fastest solutions first:

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

    Note that this version uses a combination of CLP(FD) constraints (for pruning and arithmetic) and built-in Prolog backtracking, and such a combination is perfectly legitimate. In some cases, global constraints (like automaton/8 mentioned by CapelliC) can express a problem in its entirety, but combining constraints with normal backtracking is a good strategy too for many tasks.

    In fact, just posting CLP(FD) constraints is typically not enough anyways: You typically also need a (backtracking) search, provided by labeling/2 in the case of CLP(FD), to obtain concrete solutions. So, this iterative deepening is similar to the search that labeling/2 would otherwise perform if you succeed to express the problem deterministically with CLP(FD) constraints alone.

    Nicely, we can also show:

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

    EDIT: Since the thirst for automaton/8 seems to be almost unquenchable among interested users of CLP(FD) constraints, which is nice, I have also created a solution with this powerful global constraint for you. If you find this interesting, please also upvote @CapelliC's answer, since he had the initial idea to use automaton/8 for this. The idea is to let each possible (and sensible) movement of either one or two toys correspond to a unique integer, and these movements induce transitions between different states of the automaton. Notice that the side of the flash light also plays an important role in states. In addition, we equip each arc with an arithmetic expression to keep track of the time taken so far. Please try out ?- arc(_, As). to see the arcs of this automaton.

    :- 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).
    

    And now, at long last, we can finally use automaton/8 which we so deeply desire for a solution we truly deem worthy of carrying the "CLP(FD)" banner, orgiastically mixed with the min/1 option of labeling/2:

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

    yielding:

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

    I leave translating such solutions to readable state transitions as an easy exercise (~3 lines of code).

    For extra satisfaction, this is much faster than the original version with plain Prolog, for which we had:

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

    The moral of this story: If your straight-forward Prolog solution takes more than a tenth of a second to yield solutions, you better learn how to use one of the most complex and powerful global constraints in order to improve the running time by a few milliseconds! :-)

    On a more serious note though, this example shows that constraint propagation can pay off very soon, even for comparatively small search spaces. You can expect even larger relative gains when solving more complex search problems with CLP(FD).

    Note though that the second version, although it propagates constraints more globally in a sense, lacks an important feature that is also related to propagation and pruning: Previously, we were able to directly use the program to show that there is no solution that takes less than 60 minutes, using a straight-forward and natural query (?- Limit #< 60, moves(Ms, Limit)., which failed). This follows from the second program only implicitly, because we know that, ceteris paribus, longer lists can at most increase the time taken. Unfortunately though, the isolated call of length/2 did not get the memo.

    On the other hand, the second version is able to prove something that is in a sense at least equally impressive, and it does so more efficiently and somewhat more directly than the first version: Without even constructing a single explicit solution, we can use the second version to show that any solution (if there is one) takes at least 5 crossings:

    ?- 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]))).
    

    yielding:

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

    This works by constraint propagation alone, and does not involve any labeling/2!