prologprolog-setofriver-crossing-puzzle

Prolog - wolf goat cabbage

I'm working on a puzzle game named "wolf goat cabbage". The programming language is Prolog.

change(e,w).
change(w,e).
move([X,X,Goat,Cabbage],wolf,[Y,Y,Goat,Cabbage]) :- change(X,Y).
move([X,Wolf,X,Cabbage],goat,[Y,Wolf,Y,Cabbage]) :- change(X,Y).
move([X,Wolf,Goat,X],cabbage,[Y,Wolf,Goat,Y]) :- change(X,Y).
move([X,Wolf,Goat,Cabbage],nothing,[Y,Wolf,Goat,Cabbage]) :- change(X,Y).

oneeq(X,X,WW).
oneeq(X,WWW,X).

safe([Man,Wolf,Goat,Cabbage]) :-
        oneeq(Man,Goat,Wolf),
        oneeq(Man,Goat,Cabbage).

wgc([e,e,e,e],[]).

wgc(Config,[FirstMove|OtherMoves]) :-
        move(Config,FirstMove,NextConfig),
        safe(NextConfig),
        wgc(NextConfig,OtherMoves).

To make it work, I call length(X,7),wgc([w,w,w,w],X). and it shows the result. The problem is that it shows many times first result and then the second result:

X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, wolf, goat, cabbage, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
X = [goat, nothing, cabbage, goat, wolf, nothing, goat] ;
false.

How to show only one time both results? I tried to add ! symbol to wgc:

wgc(Config,[FirstMove|OtherMoves]) :-
        move(Config,FirstMove,NextConfig),
        safe(NextConfig),
        wgc(NextConfig,OtherMoves), !.

...but it show only the first result one time. Any ideas how to fix it?

Solution

  • You can use setof predicate to get a list of unique solutions:

    setof(X, (length(X,7),wgc([w,w,w,w],X)), Sols).

X = X
Sols = [[goat, nothing, cabbage, goat, wolf, nothing, goat], [goat, nothing, wolf, goat, cabbage, nothing, goat]]
Yes (0.00s cpu)