OKeefe.R.A.%EDXA%UCL-CS@sri-unix.UUCP (01/28/84)
From: O'Keefe HPS (on ERCC DEC-10) <OKeefe.R.A.%EDXA@UCL-CS>
Here is a set of three graph-searching programs written for
teaching purposes, and the 8-puzzle set up as an example for them to
solve. They really belong in some sort of directory, they are
[400,421,teach,search]puzzle
[400,421,teach,search]depth
[400,421,teach,search]breadt
[400,421,teach,search]guess on the DEC-10, and in
/usr/lib/prolog/search on the VAX here. Beware: they've only been
tested on the 8-puzzle, but they do work on that. Depth-first was
astonishingly difficult, I had a go, Peter Ross pointed out that the
result wasn't truly depth-first and came up with a modified version,
and I pointed out that *that* wasn't dpeth-first either, and came up
with the current version. It's so hard to be stupid!
Divide the body of this message at the @@@@@ lines
@@@@@@@@ PUZZLE @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ %
File : /usr/lib/prolog/search/eight_puzzle % Author : R.A.O'Keefe %
Updated: 12 December 1983 % Purpose: illustrate the searching methods
/* The illustration I have chosen is the well known 8-puzzle.
The state of the game is represented by a tuple of 9 labels,
1 to 8 representing the movable tiles and x representing an
empty square, together with an integer between 1 and 9 which
says where the empty square is. The operations are moving
the empty square u(p), d(own), l(left), or r(right). */
solution(5/b(
1,2,3,
8,x,4,
7,6,5) ).
starting_position(9/b(
1,2,3,
7,8,4,
6,5,x) ).
equivalent(X, X).
operator_applies(Operator, OldX/OldB, NewX/NewB) :-
operator_ok(Operator, OldX, NewX),
new_board(OldX, OldB, NewX, NewB).
operator_ok(u, OldX, NewX) :- OldX > 3, NewX is OldX-3.
operator_ok(d, OldX, NewX) :- OldX < 7, NewX is OldX+3.
operator_ok(l, OldX, NewX) :- OldX mod 3 =\= 1, NewX is OldX-1.
operator_ok(r, OldX, NewX) :- OldX mod 3 =\= 0, NewX is OldX+1.
% new_board(OldX, OldB, NewX, NewB) % creates a New Board which is
essentially the same as the Old Board, % except that the labels at the
Old and New X positions have been % swapped.
new_board(OldX, OldB, NewX, NewB) :-
functor(OldB, F, N),
functor(NewB, F, N),
arg(OldX, OldB, x),
arg(NewX, OldB, L), % L is a label 1..8
arg(OldX, NewB, L),
arg(NewX, NewB, x),
new_board(N, OldB, NewB).
new_board(0, _, _) :- !. new_board(N, OldB, NewB) :-
arg(N, NewB, Lab),
var(Lab),
!,
arg(N, OldB, Lab),
M is N-1,
new_board(M, OldB, NewB). new_board(N, OldB, NewB) :-
M is N-1,
new_board(M, OldB, NewB).
distance(X1/Board1, Distance) :-
solution(X2/Board2),
distance(9, Board1, Board2, 0, Distance).
distance(0, _, _, Distance, Distance) :- !. distance(N, Board1,
Board2, SoFar, Distance) :-
arg(N, Board1, Piece),
arg(N, Board2, Piece),
!,
M is N-1,
distance(M, Board1, Board2, SoFar, Distance). distance(N,
Board1, Board2, SoFar, Distance) :-
M is N-1,
Accum is SoFar+1,
distance(M, Board1, Board2, Accum, Distance).
@@@@@@@@ DEPTH @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ %
File : /usr/lib/prolog/search/depth_first % Author : R.A.O'Keefe %
Updated: 21 December 1983 % Purpose: define a schema for depth first
search
% This schema has four parameters: % starting_position(Start) % binds
Start to the first position to try % solution(Position) % tests
whether a Position is a solution or not % operator_applies(Operator,
OldPosition, NewPosition) % enumerates all the operators which apply
to the % OldPosition, and also gives the NewPosition which % results
from that operator application. % equivalent(Pos1, Pos2) % tests
whether the two positions are essentially % the same. The idea is
that we will only look at % a position once.
% depth_first_search(DepthBound, Position, OperatorList) % returns the
first solution it can find, and the list of % Operators which produced
it: [O1,...,On] means that % applying O1 to the start position, then
O2, then ... and % finally On produces Position. The number of
operators n % will not exceed DepthBound. You may omit DepthBound, in
% which case it is taken to be 10000 (chosen for portability). % The
eight-puzzle problem has a solution at depth 4, so 4 % is a good depth
to try. I have tried depths up to 8 and % got an answer in a
reasonable time.
depth_first_search(Position, History) :-
depth_first_search(10000, Position, History).
depth_first_search(DepthBound, Position, History) :-
starting_position(Start),
depth_first_search([d(DepthBound,Start,[])], [], Position,
History).
depth_first_search([d(_,Position,OpList)|_], _, Position, OpList) :-
solution(Position),
!. % assuming you want only one
depth_first_search([d(_,Position,_)|Rest], Seen, Answer, History) :-
member(OldPos, Seen),
equivalent(OldPos, Position),
!,
depth_first_search(Rest, Seen, Answer, History).
depth_first_search([d(0,_,_)|Rest], Seen, Answer, History) :- !,
depth_first_search(Rest, Seen, Answer, History).
depth_first_search([d(Bound,Position,OpList)|Rest], Seen, Answer,
History) :-
findall(Op, NP^operator_applies(Op, Position, NP), Ops),
% we can't use setof, because that fails when there is no such
Op
NewBound is Bound-1,
fill_out(Ops, NewBound, Position, OpList, Descendants),
append(Descendants, Rest, NewRest),
NewSeen = [Position|Seen],
!,
depth_first_search(NewRest, NewSeen, Answer, History).
fill_out([], _, _, _, []) :- !. fill_out([Op|Ops], Bound, Position,
OpList, [d(Bound,NewPos,[Op|OpList])|Rest]) :-
operator_applies(Op, Position, NewPos), !,
fill_out(Ops, Bound, Position, OpList, Rest).
@@@@@@@@ BREADT @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ %
File : /usr/lib/prolog/search/breadth_first % Author : R.A.O'Keefe %
Updated: 21 December 1983 % Purpose: define a schema for breadth first
search
% This schema has four parameters: % starting_position(Start) % binds
Start to the first position to try % solution(Position) % tests
whether a Position is a solution or not % operator_applies(Operator,
OldPosition, NewPosition) % enumerates all the operators which apply
to the % OldPosition, and also gives the NewPosition which % results
from that operator application. % equivalent(Pos1, Pos2) % tests
whether the two positions are essentially % the same. The idea is
that we will only look at % a position once.
% breadth_first_search(Position, OperatorList) % returns the first
solution it can find, and the list of % Operators which produced it:
[O1,...,On] means that % applying O1 to the start position, then O2,
then ... and % finally On produces Position. There can be no shorter
% solution than this, though there may be other solutions % of the
same length.
breadth_first_search(Position, History) :-
starting_position(Start),
breadth_first_search([Start-[]], [Start], Position, History).
breadth_first_search([Position-OpList|Rest], Seen, Position, OpList)
:-
solution(Position),
!. % assuming you want only one
breadth_first_search([Position-OpList|Rest], Seen, Answer, History) :-
findall(Operator, new_position(Operator, Position, Seen),
Ops),
% we can't use setof, because that fails when there is no such
Op
fill_out(Ops, Position, OpList, Seen, NewSeen, Descendants),
append(Rest, Descendants, NewRest), !,
breadth_first_search(NewRest, NewSeen, Answer, History).
new_position(Operator, Position, Seen) :-
operator_applies(Operator, Position, NewPos),
\+ (
member(OldPos, Seen),
equivalent(OldPos, NewPos)
).
fill_out([], _, _, Seen, Seen, []) :- !. fill_out([Op|Ops], Position,
OpList, Seen, NewSeen, [NewPos-[Op|OpList]|New]) :-
operator_applies(Op, Position, NewPos), !,
fill_out(Ops, Position, OpList, [NewPos|Seen], NewSeen, New).
@@@@@@@@ GUESS @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ %
File : /usr/lib/prolog/search/guess_first % Author : R.A.O'Keefe %
Updated: 21 December 1983 % Purpose: define a schema for guess first
search
% This schema has five parameters: % starting_position(Start) % binds
Start to the first position to try % solution(Position) % tests
whether a Position is a solution or not % operator_applies(Operator,
OldPosition, NewPosition) % enumerates all the operators which apply
to the % OldPosition, and also gives the NewPosition which % results
from that operator application. % equivalent(Pos1, Pos2) % tests
whether the two positions are essentially % the same. The idea is
that we will only look at % a position once. % distance(Position,
Distance) % returns an estimate of how far the Position is % from a
solution. This is only used to rank the % descendants of a node, so
the actual values of % the estimate don't matter too much. See BEST %
for a method where the values *do* matter.
% guess_first_search(Position, OperatorList) % returns the first
solution it can find, and the list of % Operators which produced it:
[O1,...,On] means that % applying O1 to the start position, then O2,
then ... and % finally On produces Position.
guess_first_search(Position, History) :-
starting_position(Start),
guess_first_search([Start-[]], [Start], Position, History).
guess_first_search([Position-OpList|_], _, Position, OpList) :-
solution(Position),
!. % assuming you want only one
guess_first_search([Position-OpList|Rest], Seen, Answer, History) :-
findall(Operator, new_position(Operator, Position, Seen),
Ops),
% we can't use setof, because that fails when there is no such
Op
fill_out(Ops, Position, OpList, Seen, NewSeen, Descendants),
rank(Descendants, ByOrderOfGuess),
append(ByOrderOfGuess, Rest, NewRest),
!,
guess_first_search(NewRest, NewSeen, Answer, History).
new_position(Operator, Position, Seen) :-
operator_applies(Operator, Position, NewPos),
\+ (
member(OldPos, Seen),
equivalent(OldPos, NewPos)
).
fill_out([], _, _, Seen, Seen, []) :- !. fill_out([Op|Ops], Position,
OpList, Seen, NewSeen,
[Distance-(NewPos-[Op|OpList])|New]) :-
operator_applies(Op, Position, NewPos),
distance(NewPos, Distance), !,
fill_out(Ops, Position, OpList, [NewPos|Seen], NewSeen, New).
rank(Keyed, Ranked) :-
keysort(Keyed, Sorted),
strip(Sorted, Ranked).
strip([], []) :- !. strip([_-H|T], [H|R]) :-
strip(T, R).
@@@@@@@@ -END- @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@