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