/***************************/
/* */
/* Answers to worksheet 14 */
/* */
/***************************/
/* Be warned that you can't just load this file into Prolog and run the */
/* programs with impunity. It contains multiple definitions of some */
/* predicates (such as goal/1 and sameState/2) from different exercises, */
/* and these may interfere with each other. So, you may need to split the */
/* file up to get several runnable versions. */
/* Exercise 14.1 List Length */
listlength([], 0).
listlength([X|Xs], N) :- listlength(Xs, M), N is M+1.
/* Exercise 14.2 List Length Using An Accumulator */
llength(Xs, N) :- llength_aux(Xs, 0, N).
llength_aux([], N, N).
llength_aux([X|Xs], M, N) :-
P is M+1,
llength_aux(Xs, P, N).
/* Exercise 14.3 Maximum */
max(X, Y, X) :- X>Y.
max(X, Y, Y) :- X =< Y.
/* Exercise 14.4 Maximum in a list */
maxlist([X], X).
maxlist([X1, X2 | Xs], Max) :-
maxlist([X2 | Xs], MaxRest),
max(X1, MaxRest, Max).
/* Exercise 14.5 Water jugs problem encoded for depthfirst search */
/* Representation of state as a pair of integers, state(X, Y), where X is */
/* the amount in the 4-gallon jug and Y is the amount in the 3-gallon jug. */
/* Goal is simply when the 4-gallon jug has two gallons in it, irrespective */
/* of how much is in the 3-gallon jug. */
goal(state(2, N)).
/* successor is defined using Prolog arithmetic. */
successor(state(X, Y), fill(j4, from(tap)), state(4, Y)) :-
X<4.
successor(state(X, Y), fill(j3, from(tap)), state(X, 3)) :-
Y<3.
successor(state(X, Y), empty(j4, to(ground)), state(0, Y)) :-
X>0.
successor(state(X, Y), empty(j3, to(ground)), state(X, 0)) :-
Y>0.
successor(state(X, Y), fill(j4, from(j3)), state(4, Z)) :-
T is X+Y,
T >= 4,
Y>0,
Z is (Y - (4 - X)).
successor(state(X, Y), fill(j3, from(j4)), state(Z, 3)) :-
T is X+Y,
T >= 3,
X>0,
Z is (X - (3 - Y)).
successor(state(X, Y), empty(j3, to(j4)), state(Z, 0)) :-
Z is X+Y,
Z =< 4,
Y>0.
successor(state(X, Y), empty(j4, to(j3)), state(0, Z)) :-
Z is X+Y,
Z =< 3,
X > 0.
/* To check whether two states are the same is trivial. */
sameState(state(X, Y), state(X, Y)).
/* Exercise 14.6 Depth-bounded depthfirst search */
solve(Start, ActionList, MaxDepth) :-
depthfirst([Start], [], RevActionList, MaxDepth),
reverse(RevActionList, ActionList).
depthfirst([State | States], ActionList, ActionList, MaxDepth) :-
goal(State).
depthfirst([State | States], ActionList, FinalActions, MaxDepth) :-
MaxDepth > 0,
successor(State, Action, NewState),
DecMax is MaxDepth - 1,
depthfirst([NewState, State | States],
[Action | ActionList], FinalActions, DecMax).
reverse([], []).
reverse([Head|Tail], Reversed) :- reverse(Tail, Revtail),
append(Revtail, [Head], Reversed).
append([], Xs, Xs).
append([X|Xs], Ys, [X|Zs]) :- append(Xs, Ys, Zs).
/* Exercise 14.7 Sun headlines */
successor(SX, Word, SY) :-
trans(SX, WordSet, SY),
setMember(Word, WordSet).
trans(s1, [daft, brainy, saucy], s1).
trans(s1, [dons, boffins], s2).
trans(s2, [safe, unsafe, kinky], s3).
trans(s3, [sex, footwear], s4).
trans(s4, [shocker, crisis, fury, scandal], s5).
goal(s5).
sameState(SX, SX).
/* Exercise 14.8 Depth-bounded planners */
action(pickup(X), [ontable(X), clear(X), handempty], /* Pre */
[holding(X)], /* Add */
[ontable(X), clear(X), handempty]). /* Del */
action(putdown(X), [holding(X)], /* Pre */
[ontable(X), clear(X), handempty], /* Add */
[holding(X)]). /* Del */
action(stack(X, Y), [holding(X), clear(Y)], /* Pre */
[handempty, on(X, Y), clear(X)], /* Add */
[holding(X), clear(Y)]). /* Del */
action(unstack(X, Y), [handempty, clear(X), on(X, Y)], /* Pre */
[holding(X), clear(Y)], /* Add */
[handempty, clear(X), on(X, Y)]). /* Del */
forwards(InitialState, GoalState, FinalActions, MaxDepth) :-
forwards(InitialState, GoalState, [], FinalActions, MaxDepth).
forwards(CurrentState, GoalState, RevActions, FinalActions, MaxDepth) :-
subset(GoalState, CurrentState),
reverse(RevActions, FinalActions).
forwards(CurrentState, GoalState, RevActions, FinalActions, MaxDepth) :-
MaxDepth > 0,
action(H, P, A, D),
subset(P, CurrentState),
fapply(A, D, CurrentState, NewState),
DecMax is MaxDepth - 1,
forwards(NewState, GoalState, [H|RevActions], FinalActions, DecMax).
fapply(A, D, I, N) :-
setUnion(A, I, Int),
setDiff(Int, D, N).
backwards(InitialState, GoalState, FinalActions, MaxDepth) :-
backwards(InitialState, GoalState, [], FinalActions, MaxDepth).
backwards(InitialState, CurrentState, FinalActions, FinalActions, MaxDepth) :-
subset(CurrentState, InitialState).
backwards(InitialState, CurrentState, Actions, FinalActions, MaxDepth) :-
MaxDepth > 0,
action(H, P, A, D),
setIntersect(A, CurrentState, [E|Es]),
bapply(P, A, D, CurrentState, NewState),
DecMax is MaxDepth - 1,
backwards(InitialState, NewState, [H|Actions], FinalActions, DecMax).
bapply(P, A, D, CurrentState, NewState) :-
setDiff(CurrentState, A, Int),
setUnion(Int, P, NewState).
/* Exercise 14.9 Iterative deepening */
solve(Start, ActionList) :-
id(Start, ActionList, 1).
id(Start, ActionList, D) :-
depthfirst([Start], [], RevActionList, D),
reverse(RevActionList, ActionList).
id(Start, ActionList, D) :-
E is D+1,
id(Start, ActionList, E).
/* Exercise 14.10 Breadth-first search */
/* This was given. */
goal(state(2, 2)).
successor(state(X, Y), up, state(X1, Y)) :-
X1 is X + 1,
legal(state(X1, Y)).
successor(state(X, Y), left, state(X, Y1)) :-
Y1 is Y - 1,
legal(state(X, Y1)).
successor(state(X, Y), right, state(X, Y1)) :-
Y1 is Y + 1,
legal(state(X, Y1)).
successor(state(X, Y), down, state(X1, Y)) :-
X1 is X - 1,
legal(state(X1, Y)).
legal(state(X, Y)) :-
X >= 0, X =< 2, Y >= 0, Y =< 2, \+ (X = 1, Y = 1).
sameState(state(X, Y), state(X, Y)).
/* The issue is whether to store states on the agenda or paths of states. */
/* If you store states, you get a small agenda, and so this is probably */
/* preferable wherever it is possible. But it is not possible in this case */
/* because you then have no way of knowing that a particular sequence of */
/* actions is looping back on itself. So, we will use paths. This means */
/* that our agenda will be a list of lists (each of these lists being */
/* lists of states. */
/* (As an aside, use paths of states may make it easier to modify this to */
/* use AI heuristics that are sensitive to how much work we've done */
/* already, as mentioned by the path length so far.) */
/* Here we initialise the agenda with just one path that contains just */
/* the start state. */
breadthfirst(Start, Solutions) :-
process_agenda([[Start]], [], Solutions).
/* Now, the code that was given. */
process_agenda([], Solutions, Solutions).
process_agenda([Item | Items], Solutions, FinalSolutions) :-
process_agenda_item(Item, Items, NewAgenda, Solutions, NewSolutions),
process_agenda(NewAgenda, NewSolutions, FinalSolutions).
/* And finally, process_agenda_item. Remember the first argument is the */
/* item we are processing, and this is a path of states. To generate its */
/* successors, we must get at its last state, collect all successors to */
/* that state, throw away those that are already somewhere on the path */
/* (to avoid looping back on ourselves), and create new paths for each */
/* successor state that remains. */
/* These are then put at the back of the agenda, to get breadth-first */
/* search. */
/* There are two definitions to handle the case where the state we've */
/* reached is a goal state, in which case the path also goes onto the */
/* solutions list. */
process_agenda_item([State|States], PathAgenda, NewAgenda,
Solutions, [Solution | Solutions]) :-
goal(State),
reverse([State|States], Solution),
findall([NewState, State | States],
(successor(State, Action, NewState),
\+ member(NewState, [State|States])),
NewPaths),
append(PathAgenda, NewPaths, NewAgenda).
process_agenda_item([State|States], PathAgenda, NewAgenda,
Solutions, Solutions) :-
\+ goal(State),
findall([NewState, State | States],
(successor(State, Action, NewState),
\+ visitedBefore(NewState, [State|States])),
NewPaths),
append(PathAgenda, NewPaths, NewAgenda).
/* Note that this only checks that we haven't been to this state before */
/* on the current path; it doesn't check whether we've been there on */
/* some other path. */
/* Note too that I've simplifieds by giving solutions as paths of */
/* states, rather than of actions. Obviously, we would need the agenda */
/* to hold both paths of states and action of actions to remedy this. */
/* Note that you also need definitions of reverse/2, append/2 and */
/* visitedBefore/2 to make this work. */