Optimization for the solution of farmer goat wolf and cabbage problem in Prolog

Question

I am searching for a better algorithm , more computational efficient, for the classical "wolf, goat and cabbage" problem, in Prolog. The algorithm below is based on BFS search for possible situations.

The Problem:

"Once upon a time a farmer went to a market and purchased a wolf, a goat, and a cabbage. On his way home, the farmer came to the bank of a river and rented a boat. But crossing the river by boat, the farmer could carry only himself and a single one of his purchases: the wolf, the goat, or the cabbage.

If left unattended together, the wolf would eat the goat, or the goat would eat the cabbage.

The farmer's challenge was to carry himself and his purchases to the far bank of the river, leaving each purchase intact. How did he do it?"

A current solution for this problem is this one:

writelist([H|T]):-
       write(H), writelist(T).

empty_stack([]).
stack(Top, Stack, [Top|Stack]).
member_stack(Element, Stack):-
       member(Element, Stack).


reverse_print_stack(S):-
               empty_stack(S).
reverse_print_stack(S):-
               stack(E, Rest, S),
               reverse_print_stack(Rest),
               write(E), nl.


unsafe(state(X,Y,Y,C)):-
       opp(X, Y).
unsafe(state(X,W,Y,Y)):-
       opp(X, Y).

move(state(X,X,G,C), state(Y,Y,G,C)):-
       opp(X,Y), not(unsafe(state(Y,Y,G,C))),
       writelist(['try farmer takes wolf ',Y,Y,G,C]),nl.

move(state(X,W,X,C), state(Y,W,Y,C)):-
       opp(X,Y), not(unsafe(state(Y,W,Y,C))),
       writelist(['try farmer takes goat ',Y,W,Y,C]),nl.

move(state(X,W,G,X), state(Y,W,G,Y)):-
       opp(X,Y), not(unsafe(state(Y,W,G,Y))),
       writelist(['try farmer takes cabbage ',Y,W,G,Y]),nl.

move(state(X,W,G,C), state(Y,W,G,C)):-
       opp(X,Y), not(unsafe(state(Y,W,G,C))),
       writelist(['try farmer takes self ',Y,W,G,C]),nl.

move(state(F,W,G,C), state(F,W,G,C)):-
       writelist([' BACKTRACK from: ',F,W,G,C]),nl,fail.

path(Goal, Goal, Been_stack):-
       nl, write('Solution Path is: '), nl,
       reverse_print_stack(Been_stack).


path(State, Goal, Been_stack):-
       move(State, Next_state),
       not(member_stack(Next_state, Been_stack)),
       stack(Next_state, Been_stack, New_been_stack),
       path(Next_state, Goal, New_been_stack),!.


opp(e,w).
opp(w,e).


go(Start, Goal):-
       empty_stack(Empty_been_stack),
       stack(Start, Empty_been_stack, Been_stack),
       path(Start, Goal, Been_stack).


test:-go(state(w,w,w,w), state(e,e,e,e)). ```

Answer 1

Here is a cleaned-up / simplified version (IMHO).

Overall, there is not much to be optimized.

It's standard Depth-First Search for a path through a state space.

For Breadth-First Search, another approach is needed.

One could try to make lookup of visited states faster than linear scanning (i.e. some kind of hashtable), but for a history of length 8 that's really not worth it.

% The state indicates the position of: Farmer, Wolf, Goat, Cabbage
% which is always one of east ('e') or west ('w').

unsafe(state(e,w,w,_)).  % Wolf and Goat are on the same border and the farmer ain't there
unsafe(state(w,e,e,_)).  % Wolf and Goat are on the same border and the farmer ain't there

unsafe(state(e,_,w,w)).  % Goat and Cabbage are on the same border and the farmer ain't there
unsafe(state(w,_,e,e)).  % Goat and Cabbage are on the same border and the farmer ain't there

opp(e,w).
opp(w,e).
       
% Valid next state generation

move(state(X,X,G,C), state(Y,Y,G,C)):-
   opp(X,Y), 
   \+ unsafe(state(Y,Y,G,C)),
   format("try farmer takes wolf ~q -> ~q\n",[state(X,X,G,C), state(Y,Y,G,C)]).

move(state(X,W,X,C), state(Y,W,Y,C)):-
   opp(X,Y),
   \+ unsafe(state(Y,W,Y,C)),
   format("try farmer takes goat ~q -> ~q\n",[state(X,W,X,C), state(Y,W,Y,C)]).

move(state(X,W,G,X), state(Y,W,G,Y)):-
   opp(X,Y),
   \+ unsafe(state(Y,W,G,Y)),   
   format("try farmer takes cabbage ~q -> ~q\n",[state(X,W,G,X), state(Y,W,G,Y)]).
   
move(state(X,W,G,C), state(Y,W,G,C)):-
   opp(X,Y),
   \+ unsafe(state(Y,W,G,C)),
   format("try farmer takes self ~q -> ~q\n",[state(X,W,G,C), state(Y,W,G,C)]).

not_yet_seen(State,History) :-                       % will fail if  member(State, History) 
   member(State, History),
   !,
   format("State ~q already seen\n",[State]),
   fail.

not_yet_seen(_,_).                                   % the replacement: success if \+ member(State, History)
   
path(State, State, History) :-                       % found a solution! (but maybe not the BEST solution)
   !,                                                % don't continue the search down this history
   reverse(History,RevHistory),
   maplist(term_to_atom,RevHistory,RevHistoryAtoms),
   atomic_list_concat(RevHistoryAtoms, '->', OutputAtom),
   length(History,L),
   format("A solution of length ~d: ~q\n",[L,OutputAtom]).

path(CurState, FinalState, History) :-
   move(CurState, NextState),                        % generate a safe next state
   not_yet_seen(NextState, History),                 % that hasn't been seen yet
   (true;(format("Backtracking from using ~q\n",[NextState]),fail)),
   path(NextState, FinalState, [NextState|History]). % add it to the visited states and recurse

go(StartState, FinalState) :- 
   path(StartState, FinalState, [StartState]). % 3rd arg is "history"

test :- 
   go(state(w,w,w,w),  % first everything is west 
      state(e,e,e,e)). % then everything is east

It finds two solutions of history length 8:

?- test.
try farmer takes goat state(w,w,w,w) -> state(e,w,e,w)
try farmer takes goat state(e,w,e,w) -> state(w,w,w,w)
State state(w,w,w,w) already seen
try farmer takes self state(e,w,e,w) -> state(w,w,e,w)
try farmer takes wolf state(w,w,e,w) -> state(e,e,e,w)
try farmer takes wolf state(e,e,e,w) -> state(w,w,e,w)
State state(w,w,e,w) already seen
try farmer takes goat state(e,e,e,w) -> state(w,e,w,w)
try farmer takes goat state(w,e,w,w) -> state(e,e,e,w)
State state(e,e,e,w) already seen
try farmer takes cabbage state(w,e,w,w) -> state(e,e,w,e)
try farmer takes wolf state(e,e,w,e) -> state(w,w,w,e)
try farmer takes wolf state(w,w,w,e) -> state(e,e,w,e)
State state(e,e,w,e) already seen
try farmer takes goat state(w,w,w,e) -> state(e,w,e,e)
try farmer takes goat state(e,w,e,e) -> state(w,w,w,e)
State state(w,w,w,e) already seen
try farmer takes cabbage state(e,w,e,e) -> state(w,w,e,w)
State state(w,w,e,w) already seen
Backtracking from using state(e,w,e,e)
Backtracking from using state(w,w,w,e)
try farmer takes cabbage state(e,e,w,e) -> state(w,e,w,w)
State state(w,e,w,w) already seen
try farmer takes self state(e,e,w,e) -> state(w,e,w,e)
try farmer takes goat state(w,e,w,e) -> state(e,e,e,e)
A solution of length 8: 'state(w,w,w,w)->state(e,w,e,w)->state(w,w,e,w)->state(e,e,e,w)->state(w,e,w,w)->state(e,e,w,e)->state(w,e,w,e)->state(e,e,e,e)'
true ;


Backtracking from using state(e,e,e,e)
try farmer takes self state(w,e,w,e) -> state(e,e,w,e)
State state(e,e,w,e) already seen
Backtracking from using state(w,e,w,e)
Backtracking from using state(e,e,w,e)
Backtracking from using state(w,e,w,w)
Backtracking from using state(e,e,e,w)
try farmer takes cabbage state(w,w,e,w) -> state(e,w,e,e)
try farmer takes goat state(e,w,e,e) -> state(w,w,w,e)
try farmer takes wolf state(w,w,w,e) -> state(e,e,w,e)
try farmer takes wolf state(e,e,w,e) -> state(w,w,w,e)
State state(w,w,w,e) already seen
try farmer takes cabbage state(e,e,w,e) -> state(w,e,w,w)
try farmer takes goat state(w,e,w,w) -> state(e,e,e,w)
try farmer takes wolf state(e,e,e,w) -> state(w,w,e,w)
State state(w,w,e,w) already seen
try farmer takes goat state(e,e,e,w) -> state(w,e,w,w)
State state(w,e,w,w) already seen
Backtracking from using state(e,e,e,w)
try farmer takes cabbage state(w,e,w,w) -> state(e,e,w,e)
State state(e,e,w,e) already seen
Backtracking from using state(w,e,w,w)
try farmer takes self state(e,e,w,e) -> state(w,e,w,e)
try farmer takes goat state(w,e,w,e) -> state(e,e,e,e)
A solution of length 8: 'state(w,w,w,w)->state(e,w,e,w)->state(w,w,e,w)->state(e,w,e,e)->state(w,w,w,e)->state(e,e,w,e)->state(w,e,w,e)->state(e,e,e,e)'
true ;


Backtracking from using state(e,e,e,e)
try farmer takes self state(w,e,w,e) -> state(e,e,w,e)
State state(e,e,w,e) already seen
Backtracking from using state(w,e,w,e)
Backtracking from using state(e,e,w,e)
try farmer takes goat state(w,w,w,e) -> state(e,w,e,e)
State state(e,w,e,e) already seen
Backtracking from using state(w,w,w,e)
try farmer takes cabbage state(e,w,e,e) -> state(w,w,e,w)
State state(w,w,e,w) already seen
Backtracking from using state(e,w,e,e)
try farmer takes self state(w,w,e,w) -> state(e,w,e,w)
State state(e,w,e,w) already seen
Backtracking from using state(w,w,e,w)
Backtracking from using state(e,w,e,w)
false.