Solutions for Session 11

Difference lists

flatten(List,FlatList) :- flatten_diff(List,FlatList-[]).

flatten_diff([],L-L).

flatten_diff(X,[X|L]-L) :- atomic(X), X \==[].

flatten_diff([X|T],A-C) :- 
	flatten_diff(X,A-B), flatten_diff(T,B-C).

lin2(T,L) :- lin_diff(T,L-[]).

lin_diff(nil,A-A).

lin_diff(t(Left,Root,Right),A-D):-
	lin_diff(Left,A-B),
	lin_diff(Right,C-D),
	B=[Root|C].

Missionaries and Cannibals

The answer for this exercice is given in Session 9.

Water Jugs

We want to solve the problem with the minimal number of steps possible. One way to achieve this is with a search algorithm called 'iterative deepening': we first try to find a solution of depth (= number of steps) 1, if that is not possible of depth 2, 3, ..., until we find a solution.

iterative_deepening_bottles(MaxLitersJug1,MaxLitersJug2,RequiredLiters,Solution):-
        % simulate iterative deepening:
	natural(Depth),
        bottle(0,0,MaxLitersJug1,MaxLitersJug2,RequiredLiters,[],Solution,Depth),
        write('Nb of steps: '), write(Depth), nl.

natural(1).
natural(N) :-
	natural(N1),
	N is N1+1.

bottle/8 takes as input the current number of liters in jug 1 and in jug 2, the maximum number of liters in jug 1 and in jug 2, the required number of liters, the accumulated solution so far and the maximum number of steps in the rest of the solution and returns a solution.

The effect of the line natural(Depth) in the definition of the predicate iterative_deepening_bottles is that Depth will be instantiated with a natural number: first 1, if no solution is found with Depth=1 then prolog will backtrack over natural(Depth) and instantiate Depth to 2, and so on.
(Note two subtle issues. First: if we apply this strategy on a problem with no solutions, the program will not terminate (it will keep increasing the depth). If we want to avoid this, we could adapt the natural/1 predicate so that it only generates number smaller than e.g. 100. Second: note that we cannot replace the line natural(Depth) by integer(Depth) (the integer predicate is build-in) since integer(Depth) only succeeds if Depth is already instantiated with an integer but not if it is uninstantiated.)

Now we define the predicate bottle/8.
We have a solution when the required number of liters is in Jug1 or Jug2:

bottle(Required,_,_,_,Required,Solution,Solution,_).
bottle(_,Required,_,_,Required,Solution,Solution,_).

There are only 6 operations possible: empty bottle 1, fill bottle 1, empty bottle 1 in bottle 2 (as far as possible) and the same three operations with bottle 1 and 2 interchanged:

bottle(_,J2,M1,M2,Req,Acc,Solution,D):-
        %empty bottle 1
        D>0,
        no_loop(0/J2,Acc),
        NewD is D - 1,
        bottle(0,J2,M1,M2,Req,[0/J2|Acc],Solution,NewD).

bottle(J1,_,M1,M2,Req,Acc,Solution,D):-
        %empty bottle 2
        D>0,
        no_loop(J1/0,Acc),
        NewD is D - 1,
        bottle(J1,0,M1,M2,Req,[J1/0|Acc],Solution,NewD).

bottle(_,J2,M1,M2,Req,Acc,Solution,D):-
	 %fill bottle 1
        D>0,
        no_loop(M1/J2,Acc),
        NewD is D - 1,
        bottle(M1,J2,M1,M2,Req,[M1/J2|Acc],Solution,NewD).

bottle(J1,_,M1,M2,Req,Acc,Solution,D):-
        %fill bottle 2
        D>0,
        no_loop(J1/M2,Acc),
        NewD is D - 1,
        bottle(J1,M2,M1,M2,Req,[J1/M2|Acc],Solution,NewD).

bottle(J1,J2,M1,M2,Req,Acc,Solution,D):-
         %empty bottle 1 in bottle 2 as far as possible
        D>0,
        NewJ2 is min(J2 + J1,M2),
        NewJ1 is max(0,J1-(M2-J2)),
        no_loop(NewJ1/NewJ2,Acc),
        NewD is D - 1,
        bottle(NewJ1,NewJ2,M1,M2,Req,[NewJ1/NewJ2|Acc],Solution,NewD).

bottle(J1,J2,M1,M2,Req,Acc,Solution,D):-
        %empty bottle 2 in bottle 1 as far as possible
        D>0,
        NewJ1 is min(J1 + J2,M1),
        NewJ2 is max(0,J2-(M1-J1)),
        no_loop(NewJ1/NewJ2,Acc),
        NewD is D - 1,
        bottle(NewJ1,NewJ2,M1,M2,Req,[NewJ1/NewJ2|Acc],Solution,NewD).

The solution looks as follows (we get the solution in reverse order because we used an accumulator; if necessary you can of course reverse this solution):

?- iterative_deepening_bottles(15,16,8,Solution),write(Solution).
Nb of steps: 28
[8/16, 15/9, 0/9, 9/0, 9/16, 15/10, 0/10, 10/0, 10/16, 15/11, 0/11, 11/0, 11/16, 15/12, 
0/12, 12/0, 12/16, 15/13, 0/13, 13/0, 13/16, 15/14, 0/14, 14/0, 14/16, 15/15, 0/15, 15/0]

Solution = [8/16, 15/9, 0/9, 9/0, 9/16, 15/10, 0/10, 10/0, ... /...|...] 

Yes

Knights

apply_move((X,Y),Size,(NewX,NewY)) :-
	sign(SignX), NewX is X+SignX*2,
	sign(SignY), NewY is Y+SignY*1,
	legal_position(Size,NewX,NewY).
apply_move((X,Y),Size,(NewX,NewY)) :-
	sign(SignX), NewX is X+SignX*1,
	sign(SignY), NewY is Y+SignY*2,
	legal_position(Size,NewX,NewY).

sign(-1).
sign(1).

legal_position(Size,X,Y) :-	
        X>=1, 
	X=<Size, 
	Y>=1, 
	Y=<Size.

We use the standard generate-and-test approach:

solve(Size,Solution) :-
	search(Size,(1,1),[(1,1)],Solution).

search(Size,_,Solution,Solution) :-
	solution(Size,Solution).
	
search(Size,CurrentPos,Visited,Solution) :-
	apply_move(CurrentPos,Size,NewPos),
	no_loop(NewPos,Visited),
	search(Size,NewPos,[NewPos|Visited],Solution).

solution(Size,Solution) :-
	SizeSquare is Size*Size,
	length(Solution,SizeSquare).
	
no_loops([]).
no_loops([H|T]) :- 
	no_loop(H,T),
	no_loops(T).

no_loop(_,[]).
no_loop(X,[H|T]):-
        not(X=H),
        no_loop(X,T).

Note that the search space for this problem is huuuge. As expected this naive generate-and-test strategy turns out to be too slow to in practice as you will see when running the program on your computer. Below we will see a much more efficient version.

nb_unvisited(CurrentPos,Size,Visited,N) :-
       findall(Pos1,reachable_unvisited(CurrentPos,Size,Visited,Pos1),Unvisited), 
       length(Unvisited,N).

reachable_unvisited(CurrentPos,Size,Visited,Pos1) :-
	% Pos1 is reachable from CurrentPos and has not been visited before
	apply_move(CurrentPos,Size,Pos1),
	not(member(Pos1,Visited)).

solve_fast(Size,Solution) :-
	search_fast(Size,(1,1),[(1,1)],Solution).

search_fast(Size,_,Solution,Solution) :-
	solution(Size,Solution).
	
search_fast(Size,CurrentPos,Visited,Solution) :-
        % find all possible new positions with their heuristic...
	findall(Heur/NewPos1,(apply_move(CurrentPos,Size,NewPos1),nb_unvisited(NewPos1,Size,Visited,Heur)),NewPositions),
	% ... sort them according to the heuristic ...
        sort(NewPositions,SortedPositions),
        % ... try out the position with the best (=smallest) heuristic first 
        member(_/NewPos,SortedPositions), 
	no_loop(NewPos,Visited),
	search_fast(Size,NewPos,[NewPos|Visited],Solution).

sort/2 is available in SWI prolog. Of course you can define it yourself too if you want (see for instance exercise 2 of Session 4 or exercise 1 of Session 9).

Here is one solution:

?- solve_fast(8,S).      
S = [(8,5),(6,6),(5,8),(7,7),(5,6),(6,4),(4,5),(3,7),(1,8),(2,6),(4,7),(3,5),(5,4),(7,3),(8,1),(6,2),(4,3),(5,5),(3,4),(4,6),(6,5),(4,4),(2,5),(3,3),(1,4),(2,2),(4,1),(5,3),(7,2),(8,4),(6,3),(5,1),(3,2),(1,3),(2,1),(4,2),(6,1),(8,2),(7,4),(8,6),(7,8),(5,7),(3,8),(1,7),(3,6),(2,8),(1,6),(2,4),(1,2),(3,1),(5,2),(7,1),(8,3),(7,5),(8,7),(6,8),(7,6),(8,8),(6,7),(4,8),(2,7),(1,5),(2,3),(1,1)]

On my computer it took Prolog only 0.01 seconds to find this solution!

Organizing a Party

I use a predicate party(M,N,Likes,DisLikes), which has four input parameters: the number of chairs at a table (M), the number of tables (N), a list Likes with information about who likes who and a list DisLikes with information about who dislikes who. For instance if we know that the first and second guest like each other and that the third and fourth guest like each other, the list Likes is [(1,2),(3,4)]. The predicate writes out a list that shows for each guest at which table (s)he is sitting (e.g. the first element of this list is the table number for the first person, ...).

party(M,N,Likes,DisLikes) :-
        NumGuests is N*M,
        length(Guests,NumGuests),
        domain(Guests,1,N),
        add_likes_constraints(Likes,Guests),
        add_dislikes_constraints(DisLikes,Guests),
        check_nbpersons(N,Guests,M),
        labeling([],Guests),
        write(Guests).

add_likes_constraints([],_).
add_likes_constraints([(X,Y)|Likes],Guests) :-
        nth_element(X,Guests,GuestX),
        nth_element(Y,Guests,GuestY),
        GuestX #= GuestY,
        add_likes_constraints(Likes,Guests).

add_dislikes_constraints([],_).
add_dislikes_constraints([(X,Y)|DisLikes],Guests) :-
        nth_element(X,Guests,GuestX),
        nth_element(Y,Guests,GuestY),
        GuestX #\= GuestY,
        add_dislikes_constraints(DisLikes,Guests).


% nth_element(N,List,El): El is the Nth element in List
nth_element(1,[El|_],El).
nth_element(N,[_|T],El) :-
	N1 is N-1,
	nth_element(N1,T,El).


check_nbpersons(1,Guests,M) :- !,
        exactly(1,Guests,M).
check_nbpersons(TableNr,Guests,M) :-
        exactly(TableNr,Guests,M), % of all guests, exactly M sit at table TableNr
        TableNr1 is TableNr-1,
        check_nbpersons(TableNr1,Guests,M).