PROLOG :- TUTORIAL (Light Edition)

This tutorial is managed at: http://www.csupomona.edu/~jrfisher/www/prolog_tutorial/contents.html#1 Introduction Prolog is a logical and a declarative programming language. The name itself, Prolog, is short for PROgramming in LOGic. Prolog's heritage includes the research on theorem provers and other automated deduction systems developed in the 1960s and 1970s. The inference mechanism of Prolog is based upon Robinson's resolution principle (1965) together with mechanisms for extracting answers proposed by Green (1968). These ideas came together forcefully with the advent of linear resolution procedures. Explicit goal-directed linear resolution procedures, such as those of Kowalski and Kuehner (1971) and Kowalski (1974), gave impetus to the development of a general purpose logic programming system. The "first" Prolog was "Marseille Prolog" based on work by Colmerauer (1970). The first detailed description of the Prolog language was the manual for the Marseille Prolog interpreter (Roussel, 1975). The other major influence on the nature of this first Prolog was that it was designed to facilitate natural language processing. A Prolog program is a set of procedures (the order is indifferent), each procedure consists of one or more clauses (the order of clauses is important). There are two types of clauses: facts and rules. Prolog is the major example of a fourth generation programming language supporting the declarative programming paradigm. The Japanese Fifth-Generation Computer Project, announced in 1981, adopted Prolog as a development language, and thereby focused considerable attention on the language and its capabilities. The programs in this tutorial are written in "standard" (University of) Edinburgh Prolog, as specified in the classic Prolog textbook by authors Clocksin and Mellish (1981,1992). The other major kind of Prolog is the PrologII family of Prologs which are the descendants of Marseille Prolog. The reference to Giannesini, et.al. (1986) uses a version of PrologII. There are differences between these two varieties of Prolog; part of the difference is syntax, and part is semantics. However, students who learn either kind of Prolog can easily adapt to the other kind. This tutorial is intended to be used to help learn the essential, basic concepts of Prolog. The sample programs have been especially chosen to help promote the use of Prolog programming in an artificial intelligence course. Lisp and Prolog are the most frequently used symbolic programming languages for artificial intelligence. They are widely regarded as excellent languages for "exploratory" and "prototype programming". 1. How to Run Prolog The examples in this primer were all developed using either Quintus Prolog running on Digital Equipment Corporation MicroVAXes or using SWI Prolog on either Sun Sparks or in Windows on a PC. SWI (in Holland) has Prolog information and a download area. See ... SWI-Prolog Home Page

SWI-Prolog's home page has lots of information about SWI-Prolog, a download area, and documentation. The examples in this tutorial use a simplified form of interaction with a typical Prolog interpreter. The sample programs should execute similarly on any system using an Edinburgh-style Prolog interpreter or compiler. To start the prolog interpreter type 'prolog' $ prolog after the VMS prompt '$', for Quintus Prolog, or type 'pl' % pl for SWI Prolog, after the Unix prompt '%'. In Windows, SWI-Prolog installs a start icon that can be double clicked to initiate the interpreter. The interpreter then starts in its own window. A startup message or banner may appear, and will soon be followed by a goal prompt similar to the following ?- _ Goals in Prolog are entered by the user following the '?- ' prompt. Many Prologs have on-line help information. Quintus and SWI Prolog have extensive help information. This help is indexed and guides the user. To learn more about it, try ?- help(help). Notice that all of the displayed symbols need to be typed in, followed by a carriage return. To illustrate some particular interactions with prolog, consider the following sample session. Each file referred to is assumed to be a local file in the user's account, which was either created by the user, obtained by copying directly from some other public source, or obtained by saving a text file while using a web browser. The way to achieve the latter is either to follow a URL to the source file and then save, or to select text in a Prolog Tutorial web page, copy it, paste into a text editor window and then save to file. The comments /* ... */ next to goals are referred to in the notes following the session. ?- ['2_1.pl']. /* 1. Load a program from a local file*/ yes ?- listing(factorial/2). /* 2. List program to the screen*/ factorial(0,1).

factorial(A,B) :A > 0, C is A-1, factorial(C,D), B is A*D. yes ?- factorial(10,What). 10 */ What=3628800 ?- ['2_7.pl']. ?- listing(takeout). takeout(A,[A|B],B). takeout(A,[B|C],[B|D}) :takeout(A,C,D). yes ?- takeout(X,[1,2,3,4],Y). [1,2,3,4] */ X=1 Y=[2,3,4] ; types ';' and Enter X=2 Y=[1,3,4] ; X=3 Y=[1,2,4] ; X=4 Y=[1,2,3] ; no /* 5. Take X out of list Prolog waits ... User again ... again ... again ... Means: No more answers. /* 6. Conjunction of /* 3. Compute factorial of

/* 4. Load another program */

?- takeout(X,[1,2,3,4],_), X>3. goals */ X=4 ; no ?- halt.

/* 7. Return to OS */

The italicized comments appearing at the right at various spots in a sample session were added with a text processor. They also serve as reference signposts for the notes after the session. We will discuss some of these points now, while others will be referred to in later discussions. Notes: 1. A Prolog goal is terminated with a period "." In this case the goal was to load a program file. This "bracket" style notation dates back to the first Prolog implementations. Several files can be chain loaded by listing the filenames sequentially within the brackets, separated by commas. In this case, the file's name is 2_1.pl (programs corresponding to Section 7.1 of this tutorial), which contains two prolog programs for calculating the factorial of a positive integer. The actual program in the file is discussed in Section 2.1. The program file was

located in the current directory. If it had not been, then the path to it would have to have been specified in the usual way. One can start Quintus Prolog and automatically load the program file fact.pro as follows: $ prolog fact.pro 2. The built-in predicate 'listing' will list the program in memory -- in this case, the factorial program. The appearance of this listing is a little different than the appearance of the source code in the file, which we will see in Section 2.1. Actually, Quintus Prolog compiles programs unless predicates are declared to be dynamic. Compiled predicates do not have an interactive source listing that can be supplied by a 'listing' goal. So, in order to illustrate this Prolog interpreter feature, the predicates were declared as dynamic in the source code before this sample run. 3. The goal here, 'factorial(10,What)', essentially says "the factorial of 10 is What?". The word 'What' begins with an upper-case letter, denoting a logical variable. Prolog satisfies the goal by finding the value of the variable 'What'. 4. Both "programs" now reside in memory, from the two source files 2_1.pl and 2_7.pl. The 2_7.pl file has many list processing definitions in it. (See Section 2.7.) 5. In the program just loaded is a definition of the logical predicate 'takeout'. The goal 'takeout(X,[1,2,3,4],Y)' asks that X be taken out of list [1,2,3,4] leaving remainder list Y, in all possible ways. There are four ways to do this, as shown in the response. The 'takeout' predicate is discussed in Section 2.7. Note, however, how Prolog is prodded to produce all of the possible answers: After producing each answer, Prolog waits with a cursor at the end of the answer. If the user types a semicolon ';' , Prolog will look for a next answer, and so on. If the user just hits Enter, then Prolog stops looking for answers. 6. A compound or conjunctive goal asks that two individual goals be satisfied. Note the arithmetic goal (built-in relation), 'X>3'. Prolog will attempt to satisfy these goals in the left-to-right order, just as they would be read. In this case, there is only one answer. Note the use of an anonymous variable '_' in the goal, for which no binding is reported ("don't-care variable"). 7. The 'halt' goal always succeeds and returns the user to the operating system. 2.1 Map colorings A famous problem in mathematics concerns coloring adjacent planar regions. Like cartographic maps, it is required that, whatever colors are actually used, no two adjacent regions may not have the same color. Two regions are considered adjacent provided they share some boundary line segment. Consider the following map.

Fig. 2.1.1 We have given numerical names to the regions. To represent which regions are adjacent, consider also the following graph.

Fig. 2.1.2 Here we have erased the original boundaries and have instead drawn an arc between the names of two regions, provided they were adjacent in the original drawing. In fact, the adjacency graph will convey all of the original adjacency information. A Prolog representation for the adjacency information could be represented by the following unit clauses, or facts. adjacent(1,2). adjacent(2,1). adjacent(1,3). adjacent(3,1). adjacent(1,4). adjacent(4,1). adjacent(1,5). adjacent(5,1). adjacent(2,3). adjacent(3,2). adjacent(2,4). adjacent(4,2). adjacent(3,4). adjacent(4,3). adjacent(4,5). adjacent(5,4). If these clauses were loaded into Prolog, we could observe the following behavior for some goals. ?- adjacent(2,3). yes ?- adjacent(5,3). no

?- adjacent(3,R). R = 1 ; R = 2 ; R = 4 ; no One could declare colorings for the regions in Prolog also using unit clauses. color(1,red,a). color(2,blue,a). color(3,green,a). color(4,yellow,a). color(5,blue,a). color(1,red,b). color(2,blue,b). color(3,green,b). color(4,blue,b). color(5,green,b).

Here we have encoded 'a' and 'b' colorings. We want to write a Prolog definition of a conflictive coloring, meaning that two adjacent regions have the same color. For example, here is a Prolog clause, or rule to that effect. conflict(Coloring) :adjacent(X,Y), color(X,Color,Coloring), color(Y,Color,Coloring). For example, ?- conflict(a). no ?- conflict(b). yes ?- conflict(Which). Which = b Here is another version of 'conflict' that has more logical parameters. conflict(R1,R2,Coloring) :adjacent(R1,R2), color(R1,Color,Coloring), color(R2,Color,Coloring). Prolog allows and distinguishes the two definitions of 'conflict'; one has one logical parameter ('conflict/1') and the other has three ('conflict/3'). Now we have ?R1 ?R1 conflict(R1,R2,b). = 2 R2 = 4 conflict(R1,R2,b),color(R1,C,b). = 2 R2 = 4 C = blue

The last goal means that regions 2 and 4 are adjacent and both are blue. Grounded instances like 'conflict(2,4,b)' are said to be consequences of the Prolog program. One way to demonstrate such a consequence is to draw a program clause tree having the consequence as the root of the tree, use clauses of the program to branch the tree, and eventually produce a finite tree having all true leaves. For example, the following clause tree can be constructed using fully grounded instances (no variables) of clauses of the program.

Fig. 2.1.3 To learn more about the visual logic tool used to automatically make digrams like the one in the previous display, click here. The bottom leftmost branch drawn in the tree corresponds to the unit clause adjacent(2,4). which is equivalent in Prolog to the clause adjacent(2,4) :- true. Now, on the other hand, 'conflict(1,3,b)' is not a consequence of the Prolog program because it is not possible to construct a finite finite clause tree using grounded clauses of P containing all 'true' leaves. Likewise, 'conflict(a)' is not a consequence of the program, as one would expect. We will have more to say about program clause trees in subsequent sections. We will revisit the coloring problem again in Section 2.9, where we will develop a Prolog program that can compute all possible colorings (given colors to color with). The famous Four Color Conjecture was that no planar map requires more than four different colors. This was proved by Appel and Haken (1976). The solution used a computer program ( not Prolog) to check on many specific cases of planar maps, in order to rule out possible troublesome cases. The map in in Fig. 2.1.1 does require at least four colors; for example ...

Fig. 2.1.4

Exercise 2.1 If a map has N regions, then estimate how many computations may have to be done in order to determine whether or not the coloring is in conflict. Argue using program clause trees.
/* prolog tutorial adjacent(1,2). adjacent(1,3). adjacent(1,4). adjacent(1,5). adjacent(2,3). adjacent(2,4). adjacent(3,4). adjacent(4,5). 2.1 Map Colorings */ adjacent(2,1). adjacent(3,1). adjacent(4,1). adjacent(5,1). adjacent(3,2). adjacent(4,2). adjacent(4,3). adjacent(5,4).

/*------------------------------------*/ color(1,red,a). color(2,blue,a). color(3,green,a). color(4,yellow,a). color(5,blue,a). color(1,red,b). color(2,blue,b). color(3,green,b). color(4,blue,b). color(5,green,b).

/*------------------------------------*/ conflict(Coloring) :adjacent(X,Y), color(X,Color,Coloring), color(Y,Color,Coloring). /*-------------------------------------*/ conflict(R1,R2,Coloring) :adjacent(R1,R2), color(R1,Color,Coloring), color(R2,Color,Coloring).

2.3 Towers of Hanoi puzzle This object of this famous puzzle is to move N disks from the left peg to the right peg using the center peg as an auxiliary holding peg. At no time can a larger disk be placed upon a smaller disk. The following diagram depicts the starting setup for N=3 disks.

Fig. 2.3 Here is a recursive Prolog program that solves the puzzle. It consists of two clauses. move(1,X,Y,_) :write('Move top disk from '), write(X), write(' to '), write(Y), nl. move(N,X,Y,Z) :N>1, M is N-1, move(M,X,Z,Y), move(1,X,Y,_), move(M,Z,Y,X). The variables filled in by '_' (or any variables beginning with underscore) are 'don't-care' variables. Prolog allows these variables to freely match any structure, but no variable binding results from this gratuitous matching. Here is what happens when Prolog solves the case N=3. ?- move(3,left,right,center). Move top disk from left to right Move top disk from left to center Move top disk from right to center Move top disk from left to right Move top disk from center to left Move top disk from center to right Move top disk from left to right yes The first clause in the program describes the move of a single disk. The second clause declares how a solution could be obtained, recursively. For example, a declarative reading of the second clause for N=3, X=left, Y=right, and Z=center amounts to the following: move(3,left,right,center) if

move(2,left,center,right) and ] * move(1,left,right,center) and move(2,center,right,left). ] ** This declarative reading of the clause is obviously correct. The procedural reading is closely related to the declarative interpretation of the recursive clause. The procedural interpretation would go something like this: In order to satisfy the goal ?- move(3,left,right,center) do this : satisfy the goal ?-move(2,left,center,right), and then satisfy the goal ?-move(1,left,right,center), and then satisfy the goal ?-move(2,center,right,left). Also, we could write the declarative readings for N=2: move(2,left,center,right) if ] * move(1,left,right,center) and move(1,left,center,right) and move(1,right,center,left). move(2,center,right,left) if ] ** move(1,center,left,right) and move(1,center,right,left) and move(1,left,right,center). Now substitute the bodies of these last two implications for the heads and one can "see" the solution that the prolog goal generates. move(3,left,right,center) if move(1,left,right,center) and move(1,left,center,right) and * move(1,right,center,left) and --------------------------move(1,left,right,center) and --------------------------move(1,center,left,right) and move(1,center,right,left) and ** move(1,left,right,center). A procedural reading for this last big implication should be obvious. This example illustrates well three major operations of Prolog: 1) Goals are matched against the head of a rule, and

10

2) the body of the rule (with variables appropriately bound) becomes a new sequence of goals, repeatedly, until 3) some base goal or condition is satisfied, or some simple action is taken (like printing something). The variable matching process is called unification. Exercise 2.3.1 Draw a program clause tree for the goal 'move(3,left,right,center)' show that it is a consequence of the program. How is this clause tree related to the substitution process explained above? Exercise 2.3.2 Try the Prolog goal ?-move(3,left,right,left). What's wrong? Suggest a way to fix this and follow through to see that the fix works.
/* prolog tutorial 2.3 Towers of Hanoi puzzle */ move(1,X,Y,_) :write('Move top disk from '), write(X), write(' to '), write(Y), nl. move(N,X,Y,Z) :N>1, M is N-1, move(M,X,Z,Y), move(1,X,Y,_), move(M,Z,Y,X).

2.7 Prolog lists and sequences Lists Prolog uses brackets [...] as a list builder. The notation [X|Y] refers to a list whose first element is X and whose tail is Y. A finite list can be explicitly enumerated, such as [1,2,3,4]. The following three definitions should make sense to a Lisp programmer, where 'car' refers to the first element of a list, 'cdr' refers to the tail or rest of the list, and 'cons' is the list constructor. car([X|Y],X). cdr([X|Y],Y). cons(X,R,[X|R]). meaning ... The head (car) of [X|Y] is X.

11

 The tail (cdr) of [X|Y] is Y. Putting X at the head and Y as the tail constructs (cons) the list [X|R]. However, we will see that these explicit definitions are unneeded. A list whose head is X and whose tail is Y can just be referred to using the Prolog term [X|Y]. Conversely, if the list can be unified with the Prolog term '[X|Y]' then the first element of the list is bound to (unified with) X and the tail of the list is bound to Y. Many of the predicates discussed in this section are "built-in" for many Prolog interpreters. Consider the following definition of the predicate 'member/2'. member(X,[X|R]). member(X,[Y|R]) :- member(X,R). One can read the clauses the following way, respectively: X is a member of a list whose first element is X. X is a member of a list whose tail is R if X is a member of R. This program can be used in numerous ways. One can test membership: ?- member(2,[1,2,3]). Yes One can generate members of a list: ?- member(X,[1,2,3]). X = 1 ; X = 2 ; X = 3 ; No Here is a derivation tree showing how this last goal generated all of the answers.

12

Fig. 2.7 Each left branch corresponds to a match (unification) against the first clause for 'member' and each right branch corresponds to a match against the second clause. The subgoal 'member(X,[])' on the lowest right branch will not match the head of any 'member' clause. In particular '[]' will not unify with a pattern of the form '[X|R]' because the latter represents a list with at least one element. We will find many other uses for 'member'. This example query ... ?- member([3,Y], [[1,a],[2,m],[3,z],[4,v],[3,p]]). Y = z ; Y = p ; No ... suggests a use where one intends to search in order to find elements paired with a specified element. Here is another, finding elements of a list which satisfy some constraint: ?- member(X,[23,45,67,12,222,19,9,6]), Y is X*X, Y < 100. X = 9 Y = 81 ; X = 6 Y = 36 ; No The definition for 'member' is usually written member(X,[X|_]). member(X,[_|R]) :- member(X,R). where '_' (underscore) designates a "don't-care" variable, usually called anonymous variables. In general, such variables have names whose first character is the underscore. In effect, they match any Prolog term, but no variable binding results from the free match. Notice that this is consistent with the original intentions of the definition of 'member'. Not having to bind values to anonymous variables saves a little run-space and run-time. Related to 'member' is the following definition for 'takeout'.

13

takeout(X,[X|R],R). takeout(X,[F|R],[F|S]) :- takeout(X,R,S). These clauses can be paraphrased in English as follows: When X is taken out of [X|R], R results. When X is taken out of the tail of [X|R], [X|S] results, where S is the result of taking X out of R. For example, ?- takeout(X,[1,2,3],L). X=1 L=[2,3] ; X=2 L=[1,3] ; X=3 L=[1,2] ; No Notice that it would not be appropriate to use any anonymous variables in the definition of 'takeout'. Here is a program clause tree showing that 'takeout(3,[1,2,3],[1,2])' is a consequence of the definition. Pay particular attention to exactly how the clauses are used to construct the tree. takeout(3,[1,2,3],[1,2]) | | takeout(3,[2,3],[2]) | | takeout(3,[3],[]) | | true The following goal, ?- takeout(3,W,[a,b,c]). W = [3,a,b,c] ; W = [a,3,b,c] ; W = [a,b,3,c] ; W = [a,b,c,3] ; No shows that 'takeout(X,Z,W)' can also be interpreted as "insert X into W to produce Z". That is, 'takeout' got its name from just one of its uses. Of course, one could define putin(X,L,R) :- takeout(X,R,L). Here is a definition for appending, or concatenating, two Prolog lists. append([X|Y],Z,[X|W]) :- append(Y,Z,W). append([],X,X). Several kinds of goals are possible: ?- append([1,2,3],[4,5],[1,2,3,4,5]). Yes ?- append([1,2,3],[4,5],A). A = [1,2,3,4,5] ?- append([1,2,3],W,[1,2,3,4,5]). W = [4,5]

14

... and so on. Exercise 2.7.1 Consider the following alternate definition for member: member(X,[_|R) :- member(X,R). member(X,[X|_]). (a) Show that this program would have exactly the same consequences as the original version. (b) Explain, however, how and why this version could produce different Prolog goal behavior. Exercise 2.7.2 Draw a Prolog derivation tree for the goal '?- append([1,2],[a,b,c],A)' . Explain how it is that the first value '[1,2]' is copied in order to compute the result A. Reversing a list can be done with reverse([X|Y],Z,W) :- reverse(Y,[X|Z],W). reverse([],X,X). This program illustrates Prolog's approach to an important strategy -- using an accumulating parameter (the middle variable) -- to accumulate a list answer until the computation is finished. For example, consider the following (partial) derivation tree ?- reverse([1,2,3],[],A) | | reverse([2,3],[1],A) | | reverse([3],[2,1],A) | | reverse([],[3,2,1],A) | | true A = [3,2,1] where the first 'reverse' clause is use three times, and then the second 'reverse' clause is used to "capture" the answer by matching the second and third arguments. One could use the following definition to "hide" the accumulating parameter. reverse(A,R) :- reverse(A,[],R). Exercise 2.7.3 Write a two-parameter version of 'reverse' that does not use the accumulating parameter idea. Use 'append' instead, for example, where one rule would be paraphrased like this ... reverse list [X|R] by reversing R to get T, then append T to [X] What about the efficiency of this version? Compare it to the given 'reverse' above. Here is an interesting definition designed to produce all possible permutations of a list. perm([X|Y],Z) :- perm(Y,W), takeout(X,Z,W). perm([],[]). Think of 'takeout(X,Z,W)' as being used in the "X put into W yields Z" sense here. Then the definitions could paraphrased as follows:

15

 Z is a permutation of [X|Y] provided W is a permutation of Y and then X is put into W to produce Z . [] is the (only) permutation of []. Here is a sample goal for 'perm': ?- perm([1,2,3],P). P = [1,2,3] ; P = [2,1,3] ; P = [2,3,1] ; P = [1,3,2] ; P = [3,1,2] ; P = [3,2,1] ; No The user should try the goal '?- perm(P,[1,2,3]).' Exercise 2.7.4 Construct a program clause tree having all true leaves for 'perm([a,b,c],[c,b,a])'. It is common to represent sets as Prolog lists. This representation has some flaws, such as the fact that Prolog lists are inherently ordered (sets are not), and a list can have multiple occurrences of a particular element (sets do not). However, the list representation is very convenient. Set membership can be computed using the 'member' relation for lists previously discussed. Subsets can be tested using subset([X|R],S) :- member(X,S), subset(R,S). subset([],_). Goals like ?- subset([4,3],[2,3,5,4]). Yes work fine. Why would '?- subset([1,2],W)' and '?- subset(A,[1,2,3])' not be reasonable goals? Union and intersection can be approximated using the following Prolog list versions: union([X|Y],Z,W) :- member(X,Z), union(Y,Z,W). union([X|Y],Z,[X|W]) :- \+ member(X,Z), union(Y,Z,W). union([],Z,Z). intersection([X|Y],M,[X|Z]) :- member(X,M), intersection(Y,M,Z). intersection([X|Y],M,Z) :- \+ member(X,M), intersection(Y,M,Z). intersection([],M,[]). These are intended to be used for goals where the first two variables already have a list value. Sometimes this intention is indicated by writing something like 'union(+,+,-)' to indicate the intended variable profile. For example, ?- union([1,2,3,4],[1,a,b,4],A). A = [2,3,1,a,b,4] ?- intersection([1,2,3,4],[1,a,b,4],B).

16

B = [1,4] Why would goals like '?- union(X,[2,3],[1,3,a,2])' cause difficulty? Some run-time inefficiency results from having to rematch the heads of clauses for both of the definitions. Here is an alternate version of union, using ! instead: union([X|Y],Z,W) :member(X,Z), !, /* do not use next clauses */ union(Y,Z,W). union([X|Y],Z,[X|W]) :- union(Y,Z,W). union([],Z,Z). Exercise 2.7.5 Design and test 'delete(X,L,R)' which is intended to delete all occurrences of X from list L to produce result R. Exercise 2.7.6 Design and test 'prune(A,B)' which is intended to remove multiple occurrences of elements from A to produce result B. For example, ?- prune([a,1,b,2,a,3,a,4,b],B). B = [a,1,b,2,3,4] Try to make it so that B has remaining elements in the order that they occurred in A. Exercise 2.7.7 Design and test 'prefix(A,B)' which tests to see if A is a list prefix of B, and which can generate prefixes of a given list. For example, ?- prefix([1,2,3],[1,2,3,4,5]). yes ?- prefix([1,2],[1,a,2,3]). No ?- prefix(W,[1,2,3]). W = [] ; W = [1] ; W = [1,2] ; W = [1,2,3] ; No Draw a program clause tree showing that 'prefix([1,2],[1,2,3])' is a consequence of your program. Exercise 2.7.8 Design a Prolog predicate 'segment', that tests whether its first list argument is a contiguous segment contained anywhere within the second list argument. For example, ?- segment([a,b,c],[1,c,a,b,c,3]). Yes ?- segment([a,b],[c,a,c,b]). No Draw a clause tree showing that 'segment([a,b,c],[1,c,a,b,c,3])' is a consequence of your program.

17

Various sorting strategies can be implemented using lists in prolog. Here is a Prolog version of merge sort, with intended profile mergesort(+,-). mergesort([],[]). /* covers special case */ mergesort([A],[A]). mergesort([A,B|R],S) :split([A,B|R],L1,L2), mergesort(L1,S1), mergesort(L2,S2), merge(S1,S2,S). split([],[],[]). split([A],[A],[]). split([A,B|R],[A|Ra],[B|Rb]) :-

split(R,Ra,Rb).

merge(A,[],A). merge([],B,B). merge([A|Ra],[B|Rb],[A|M]) :- A =< B, merge(Ra,[B| Rb],M). merge([A|Ra],[B|Rb],[B|M]) :- A > B, merge([A| Ra],Rb,M). Here is a sample goal: ?- mergesort([4,3,6,5,9,1,7],S). S=[1,3,4,5,6,7,9] Prolog list sorting routines suffer all of the relative space and time inefficiencies related with sorting dynamic structures, but often have very cogent specifications in Prolog. Exercise 2.7.9 Design a Prolog implementation of selection sort for lists of numbers. Test your program using various sample runs. Exercise 2.7.10 Design a Prolog implementation of insertion sort for lists of numbers. Test your program using various sample runs. Sequences The kind of sequences most used in Prolog are "comma" sequences. There is no empty sequence (unlike for lists). The shortest sequence has one element. Longer sequences have elements separated by commas ",". An appropriate declaration for the comma operator would be :- op(1000,xfy,','). meaning that comma is right-associative with precedence 1000. (The comma operator is actually built-in.) Here is some Prolog behavior. ?- (H,T) = (1,2,3,4). H = 1 T = 2,3,4 ?- (a) = a. Yes ?- (H,T) = (a). No

18

?- (A,B,C) = (1,2,3,4,5). A = 1 B = 2 C = 3,4,5 Prolog clauses use comma sequences. ?- assert((a(X) :- b(X),c(X),d(X))). %% Note parens around clause X = G1056 ?- clause(a(X),Body), Body=(First,Next). First = b(G1176) Next = c(G1176), d(G1176) Body = b(G1176), c(G1176), d(G1176) X = G1176 Procesing sequences is similar to processing lists, except that the base case for sequences is a unit sequence (one element), whereas for lists the base case is for the empty list. For example, here is a program to append comma sequences ... sequence_append((X,R),S,(X,T)) :!, sequence_append(R,S,T). sequence_append((X),S,(X,S)). Note the use of cut (!) to make sure that the second clause is not available as a alternate choice for multi-element sequences. ?- sequence_append((1,2,3),(a,b,c,d),S). S = 1, 2, 3, a, b, c, d Exercise 2.7.11 Write a Prolog program to reverse a comma sequence. Exercise 2.7.12 Write a Prolog program to prune a comma sequence (delete repeated top-level elements, keeping first, left-most, occurrence). Exercise 2.7.13 Write a Prolog program to test for membership in a comma sequence (similar to member for lists). Other kinds of sequences can be defined by the user. For example, to make left-associative sequences separated by '#', one might use an operator declaration like this ... ?- op(500,yfx,'#'). Yes ?- (A#B) = 1#2#3#4. B = 4 A = 1 # 2 # 3 Notice how left-associativity was what determined the bindings in the second goal!

19

Exercise 2.7.14 Write a Prolog program to test for membership in a # sequence, as defined above. What is the main point of this exercise?
/* prolog tutorial 2.7 Prolog lists */

/* built-in SWI-Prolog member(X,[X|R]). member(X,[Y|R]) :- member(X,R). */ takeout(X,[X|R],R). takeout(X,[F|R],[F|S]) :- takeout(X,R,S). putin(X,L,R) :- takeout(X,R,L). /* built-in SWI-Prolog append([X|Y],Z,[X|W]) :- append(Y,Z,W). append([],X,X). */ */ built-in SWI-Prolog reverse([X|Y],Z,W) :- reverse(Y,[X|Z],W). reverse([],X,X). reverse(A,R) :- reverse(A,[],R). */ perm([X|Y],Z) :- perm(Y,W), takeout(X,Z,W). perm([],[]). subset([X|R],S) :- member(X,S), subset(R,S). subset([],_). union([X|Y],Z,W) :- member(X,Z), union(Y,Z,W). union([X|Y],Z,[X|W]) :- \+ member(X,Z), union(Y,Z,W). union([],Z,Z). intersection([X|Y],M,[X|Z]) :- member(X,M), intersection(Y,M,Z). intersection([X|Y],M,Z) :- \+ member(X,M), intersection(Y,M,Z). intersection([],M,[]). mergesort([],[]). /* covers special case */ mergesort([A],[A]). mergesort([A,B|R],S) :split([A,B|R],L1,L2), mergesort(L1,S1), mergesort(L2,S2), merge(S1,S2,S). split([],[],[]). split([A],[A],[]). split([A,B|R],[A|Ra],[B|Rb]) :merge(A,[],A). merge([],B,B). merge([A|Ra],[B|Rb],[A|M]) :-

split(R,Ra,Rb).

A =<B, merge(Ra,[B|Rb],M).

20

merge([A|Ra],[B|Rb],[B|M]) :-

A >B,

merge([A|Ra],Rb,M).

sequence_append((X,R),S,(X,T)) :!, sequence_append(R,S,T). sequence_append((X),S,(X,S)).

2.11 Chess queens challenge puzzle The challenge is to set N queens on an NxN grid so that no queen can "take" any other queen. Queens can move horizontally, vertically, or along a (45%) diagonal. The following diagram shows a solution for N=4 queens. ________________ | | | Q | | |___|___|___|___| | Q | | | | |___|___|___|___| | | | | Q | |___|___|___|___| | | Q | | | |___|___|___|___| A solution to this puzzle can be represented as a special permutation of the list [1,2,3,4]. For example, the solution pictured above can be represented as [3,1,4,2], meaning that, in the first row place a queen in column 3, in the second row place a queen in column 1, etc. To test whether a given permutation is a solution, one needs to calculate whether the permutation has (or represents a situation where) two or more queens lie on the same diagonal. The representation itself prevents two or more queens in the same row or column. Two queens are on the same / diagonal if and only if the sum of the row and column is the same for each; they are on the same \ diagonal if and only if the difference of their row and column is the same number. The following Prolog program has the details; assume that predicates 'perm' and 'takeout' are defined as in section 2.7. solve(P) :perm([1,2,3,4,5,6,7,8],P), combine([1,2,3,4,5,6,7,8],P,S,D), all_diff(S), all_diff(D). combine([X1|X],[Y1|Y],[S1|S],[D1|D]) :S1 is X1 +Y1, D1 is X1 - Y1, combine(X,Y,S,D). combine([],[],[],[]). all_diff([X|Y]) :all_diff([X]). \+member(X,Y), all_diff(Y).

21

Notice the inclusion of file lists.pro discussed in section 2.6. This is a nice, simple specification that uses 'perm' to generate possible solutions to the puzzle. A sample goal is ?- solve(P). P = [5,2,6,1,7,4,8,3] ; P = [6,3,5,7,1,4,2,8] ; ... ?- setof(P,solve(P),Set), length(Set,L). ... L = 92 The last goal reflects the fact that there are 92 distinct solutions to the queens challenge puzzle for an 8x8 board. One inefficiency that this program suffers is that each permutation is completely calculated before it is checked to see whether it represents a solution to the puzzle. It is easy to see that this is not necessary. For example, suppose that a "partial solution" P = [1,3,2, ...] is up for consideration. The row and column calculations show already the "2" is not a safe move!
/* prolog tutorial 2.11 Chess queens challenge puzzle */ perm([X|Y],Z) :- perm(Y,W), takeout(X,Z,W). perm([],[]). takeout(X,[X|R],R). takeout(X,[F|R],[F|S]) :- takeout(X,R,S). solve(P) :perm([1,2,3,4,5,6,7,8],P), combine([1,2,3,4,5,6,7,8],P,S,D), all_diff(S), all_diff(D). combine([X1|X],[Y1|Y],[S1|S],[D1|D]) :S1 is X1 +Y1, D1 is X1 - Y1, combine(X,Y,S,D). combine([],[],[],[]). all_diff([X|Y]) :all_diff([X]). \+member(X,Y), all_diff(Y).

2.16 Search The previous section discussed graph traversal for a static graph. The nodes and edges were given in advance, rather than calculated while searching for a solution. Consider now situations where search can be specified by starting at a starting state, generating moves to next possible states, check that the move is a safe or allowable one, check that the next state has not been previously visited, and then continue the search from this next state. In Prolog, this specification could take the following explicit form: solve(P) :start(Start), search(Start,[Start],Q),

22

reverse(Q,P). search(S,P,P) :- goal(S), !. */ search(S,Visited,P) :next_state(S,Nxt), state */ safe_state(Nxt), */ no_loop(Nxt,Visited), */ search(Nxt,[Nxt|Visited],P). searching... */ no_loop(Nxt,Visited) :\+member(Nxt,Visited). This is not a complete program, but is instead a superstructure on which a specific program can be constructed. It is a kind of generic search description. One needs to further specify: next_state(S,Nxt) :- < fill in here >. safe_state(Nxt) :- < fill in here >. no_loop(Nxt,Visited) :- < fill in here >. different from default clause */ start(...). goal(...). A diagram depicting the search is as follows: /* done /* generate next /* check safety /* check for loop /* continue

/* if

Fig. 2.16 Note how similar this formulation is to the DFA parser of section 2.11 and the graph determination of section 2.12. The similarity is not mere coincidence! As an example, let us reconsider the 8 queens puzzle of section 2.11. We will use a similar state representation. For example, choosing column 1 for the first row, column 3 for the second row and column 6 for the third row is represented as [6,3,1]. That is, if list L represents having already

23

chosen for k rows (length L = k) then choosing C for the (L+1)st row is represented by the list [C| L]. Safety is calculated in a fashion similar to what was done previously. start([]). goal(S) :- length(S,8). next_state(S,[C|S]) :- member(C,[1,2,3,4,5,6,7,8]), not member(C,S). safe_state([C|S]) :- length(S,L), Sum is C+L+1, Diff is C-L-1, safe_state(S,Sum,Diff). safe_state([],_,_) :- !. safe_state([F|R],Sm,Df) :- length(R,L), X is F+L+1, X \= Sm, Y is F-L-1, Y \= Df, safe_state(R,Sm,Df). Load both the generic search program and the code just previous, and try a goal ... ?- solve(P). P= [[],[1],[5,1],[8,5,1],[6,8,5,1],3,6,8,5,1], [7,3,6,8,5,1],[2,7,3,6,8,5,1], [4,2,7,3,6,8,5,1]] Yes Notice that the solution is actually the last element, [4,2,7,3,6,8,5,1], of this list. The program generated this solution from right to left, but (because of the symmetry in this puzzle) its reverse is also a solution. Also, for this puzzle, there is no real need for the 'no_loop' calculation, since this search never repeats a state. For other applications, the loop check may be essential. The inefficiency noted for the previous program in Section 2.11 (that the whole list was generated before checking safety) is NOT the case for the current program. Exercise 2.16.1 The missionaries and cannibals problem is a good example of a puzzle that can be analyzed according to the search superstructure given above. The problem involves three missionaries and three cannibals, all six of whom are originally on one side of a river. There is one boat that will be used to ferry the missionaries and cannibals to the other side of the river. The boat holds two occupants at most, and there is no way to send the boat across the river without having at least one occupant in the boat. The threat is that, if the cannibals outnumber the missionaries in any circumstance, then the cannibals will cook and eat the missionaries (so the fable goes). Use the search superstructure to design a Prolog program that searches for ways to ferry all six persons to the other side of the river. Suggestion: Use state representation [M,C,B] where M is the number of missionaries and C is the number of cannibals on bank B. The start state is [3,3,left], and the goal state is [3,3,right]. Write specifications for 'start', 'goal', 'next_state' and 'safe_state', and add them to the search superstructure to obtain a complete program to solve

24

this puzzle. Your program should be able to calculate two distinct minimal solutions each involving eleven boat trips across the river. Exercise 2.16.2 Nilsson's A* algorithm is a good Prolog project. See the reference for Nilsson (1980). Develop a Prolog A* program superstructure and then use it to solve the 8-puzzle, which is also discussed in Nilsson's book. This is also the subject of Chapter 5 of the Prolog Tutorial.
%% search.pl -- Section 2.16 of Prolog Tutorial

solve(P) :start(Start), search(Start,[Start],Q), reverse(Q,P). search(S,P,P) :- goal(S), !. search(S,Visited,P) :next_state(S,Nxt), safe_state(Nxt), no_loop(Nxt,Visited), search(Nxt,[Nxt|Visited],P). no_loop(Nxt,Visited) :\+member(Nxt,Visited). %% queen.pl start([]). goal(S) :- length(S,8). next_state(S,[C|S]) :- member(C,[1,2,3,4,5,6,7,8]), not member(C,S). safe_state([C|S]) :- length(S,L), Sum is C+L+1, Diff is C-L-1, safe_state(S,Sum,Diff). safe_state([],_,_) :- !. safe_state([F|R],Sm,Df) :- length(R,L), X is F+L+1, X \= Sm, Y is F-L-1, Y \= Df, safe_state(R,Sm,Df). /* done /* /* /* /* generate next state check safety check for loop continue searching... */ */ */ */ */

2.17 Animal identification game Here is a Prolog version of the animal identification game (simple expert system) presented in a Lisp program in Chapter 6 of Winston and Horn (1985). Load the file and pose the query ?- go. The program uses its identification rules to determine the animal that you have chosen.

25

/* animal.pro animal identification game. start with ?- go. */

go :- hypothesize(Animal), write('I guess that the animal is: '), write(Animal), nl, undo. /* hypotheses to be tested */ hypothesize(cheetah) :- cheetah, !. hypothesize(tiger) :- tiger, !. hypothesize(giraffe) :- giraffe, !. hypothesize(zebra) :- zebra, !. hypothesize(ostrich) :- ostrich, !. hypothesize(penguin) :- penguin, !. hypothesize(albatross) :- albatross, !. hypothesize(unknown). /* no diagnosis */ /* animal identification rules */ cheetah :- mammal, carnivore, verify(has_tawny_color), verify(has_dark_spots). tiger :- mammal, carnivore, verify(has_tawny_color), verify(has_black_stripes). giraffe :- ungulate, verify(has_long_neck), verify(has_long_legs). zebra :- ungulate, verify(has_black_stripes). ostrich :- bird, verify(does_not_fly), verify(has_long_neck). penguin :- bird, verify(does_not_fly), verify(swims), verify(is_black_and_white). albatross :- bird, verify(appears_in_story_Ancient_Mariner), verify(flys_well). /* classification rules */ mammal :- verify(has_hair), !. mammal :- verify(gives_milk). bird :- verify(has_feathers), !. bird :- verify(flys),

26

verify(lays_eggs). carnivore :- verify(eats_meat), !. carnivore :- verify(has_pointed_teeth), verify(has_claws), verify(has_forward_eyes). ungulate :- mammal, verify(has_hooves), !. ungulate :- mammal, verify(chews_cud). /* how to ask questions */ ask(Question) :write('Does the animal have the following attribute: '), write(Question), write('? '), read(Response), nl, ( (Response == yes ; Response == y) -> assert(yes(Question)) ; assert(no(Question)), fail). :- dynamic yes/1,no/1. /* How to verify something */ verify(S) :(yes(S) -> true ; (no(S) -> fail ; ask(S))). /* undo all yes/no assertions */ undo :- retract(yes(_)),fail. undo :- retract(no(_)),fail. undo. The program is mainly interesting with regard to how it tries to verify certain properties that it uses to draw conclusions, and how it asks questions and records the answers for further reference. If a question q is asked and the answer is 'yes', then that answer is recorded by asserting 'yes(q)' and succeeding, otherwise the answer is recorded by asserting 'no(q)' and failing. Even 'yes' answers need to be recorded since a subsequent 'no' answer to a different question while trying to verify the same hypothesis may cause the entire hypothesis to fail, but that same 'yes' answer could lead to a successful verification of a different hypothesis later. This is how the program avoids asking the same question twice. The general method of verifying a condition q is then to check whether 'yes(q)' has been stored in memory, and succeed, or 'no(q)' has been stored, and fail, otherwise ask(q).

27

Chapter 6 builds a general framework for expert systems in Prolog.

5.1 The A* algorithm in Prolog Section 2.16 introduced an outline for a simple Prolog search program. This section discusses heuristic search using the A* algorithm, due to Nilsson (1980). Heuristic search uses a heuristic function to help guide the search. When a node is expanded, each of its children is evaluated using a search function. Each child is placed into a list of nodes -- the so-called open list -- in order determined by the search function evaluation (smaller values first). The heuristic function estimates how much work must be done to reach a goal from the node in question. Typically, the search function f is expressed as f(n) = g(n) + h(n) where g(n) represents the (computed, actual) cost of getting to the node n along the current path to it, and h is the heuristic function. Thus, f(n) estimates the cost or effort to successfully get from start to goal by going through node n (along some particular particular path).

Fig. 5.1 Here is some simple pseudocode from which the Prolog program will be developed.

1. Start with the start node, place it in the (previously empty) list open. 2. Let n be the first node on open. Remove n from open. Fail if open is empty.
3. If n is the goal, then a solution has been found. (One could stop here.) 4. Expand n, obtaining all of its children, and evaluate f(-) for each of them. Insert each of these children into open, maintaining order where the smallest f(-) values come first. 5. Repeat from step 2.

28

When a goal has been reached, one would certainly like to be able to return the solution path from the start to the goal. The pseudocode ignored this feature, but it will be included as the Prolog prototype program is developed. A common cost function g(-) is path length. The cost of getting from the start node to a current node is the length of relevant path. This can be computed incrementally, as will be seen. It is important to realize that this kind of search can follow a contiguous path for a while, until some previously unchosen node n has the current smallest f(-) value, in which case this node n is expanded, and its children considered. Now for the Prolog program for the A* search. Let us assume that State refers to some description of the state of a search. For example State might be a description of the 8-puzzle tile for a specific configuration, as developed in the next section. A Node in the search space (or graph) needs to record the State, the Depth (or path length from the start), the value of f(-) for the node F, and a list of the ancestors A of this node. We will use the Prolog term structure Node = State#Depth#F#A for a node. When Node is expanded to find its children... The state of each child will be computed as a move from State each of these children will have depth Depth + 1, the f(-) value of each child will be calculated, and the ancestor list of a child will be the Prolog list term [ Node|A]. In general, if the Depth is replace by some other cost, the node representation would be similar; just replace Depth by a cost, and compute it appropriately. Also, we will see in the next section (8-puzzle) that the ancestor list might be more conveniently saved as a list of symbolic actions (used to achieve successive states), rather that as a list of the actual full nodes themselves. Other modifications of the prototypical A* algorithm presented in this section might be made, depending on the application. The main predicate for the program is solve(Start,Soln) :- f_function(Start,0,F), search([Start#0#F#[]],S), reverse(S,Soln). f_function(State,D,F) :- h_function(State,H), F is D + H. The 'Start' variable refers to the starting state description. The first parameter for the search predicate represents the open list. The 'h_function' definition needs to be supplied with the particular application. search([State#_#_#Soln | _], Soln) :- goal(State). search([B|R],S) :- expand(B, Children), insert_all(Children, R, NewOpen), search(NewOpen,S). The version of the 'expand' predicate given here simply uses Prolog's bagof computation (thus bundling up a lot of work).

29

expand(State#D#_#A, All_My_Children) :bagof(Child#D1#F#[Move|A], ( D1 is D + 1, move(State,Child,Move), f_function(Child,D1,F) ) , All_My_Children). The (application dependent) 'move' predicate should generate the 'Child' states, in such a way as to obtain them all by backtracking. (See the 8-puzzle example in the next section.) As previously stated, the 'Move' can either be the the whole parent node itself or some appropriate substitute. (Actually, one should rewrite the 'expand' clause if one is going to use the whole node, rather some symbolic representation, as we do in the next section.) Here is the code for insert_all. It is a familiar kind of insertion-sort algorithm ... insert_all([F|R],Open1,Open3) :insert(F,Open1,Open2), insert_all(R,Open2,Open3). insert_all([],Open,Open). insert(B,Open,Open) :- repeat_node(B,Open), ! . insert(B,[C|R],[B,C|R]) :- cheaper(B,C), ! . insert(B,[B1|R],[B1|S]) :- insert(B,R,S), !. insert(B,[],[B]). repeat_node(P#_#_#_, [P#_#_#_|_]). cheaper( _#_#H1#_ , _#_#H2#_ ) :- H1 < H2.

The following exercises ask the reader to formulate A* solutions to various problems or puzzles. See the next section, 5.2 on the 8-puzzle, as an example of how to extend the general A* program of this section to a specific solution of the 8-puzzle. Exercise 5.1.1 Formulate an A* algorithm for the N queens puzzle. (See section 2.11 for a simple, but inefficient, approach.) Exercise 5.1.2 Formulate an A* approach to maze solving.
/* 8_puzzle.pl */ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% A* Algorithm %%% %%% %%% Nodes have form S#D#F#A %%% where S describes the state or configuration %%% D is the depth of the node %%% F is the evaluation function value %%% A is the ancestor list for the node

30

:- op(400,yfx,'#').

/* Node builder notation */

solve(State,Soln) :- f_function(State,0,F), search([State#0#F#[]],S), reverse(S,Soln). f_function(State,D,F) :- h_function(State,H), F is D + H. search([State#_#_#Soln|_], Soln) :- goal(State). search([B|R],S) :- expand(B,Children), insert_all(Children,R,Open), search(Open,S). insert_all([F|R],Open1,Open3) :- insert(F,Open1,Open2), insert_all(R,Open2,Open3). insert_all([],Open,Open). insert(B,Open,Open) :- repeat_node(B,Open), ! . insert(B,[C|R],[B,C|R]) :- cheaper(B,C), ! . insert(B,[B1|R],[B1|S]) :- insert(B,R,S), !. insert(B,[],[B]). repeat_node(P#_#_#_, [P#_#_#_|_]). cheaper( _#_#F1#_ , _#_#F2#_ ) :- F1 < F2. expand(State#D#_#S,All_My_Children) :bagof(Child#D1#F#[Move|S], (D1 is D+1, move(State,Child,Move), f_function(Child,D1,F)), All_My_Children). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 8-puzzle solver %%% %%% %%% State have form A/B/C/D/E/F/G/H/I %%% where {A,...,I} = {0,...,8} %%% 0 represents the empty tile %%% goal(1/2/3/8/0/4/7/6/5). %%% The puzzle moves left( left( left( left( left( left( A/0/C/D/E/F/H/I/J A/B/C/D/0/F/H/I/J A/B/C/D/E/F/H/0/J A/B/0/D/E/F/H/I/J A/B/C/D/E/0/H/I/J A/B/C/D/E/F/H/I/0 , , , , , , 0/A/C/D/E/F/H/I/J A/B/C/0/D/F/H/I/J A/B/C/D/E/F/0/H/J A/0/B/D/E/F/H/I/J A/B/C/D/0/E/H/I/J A/B/C/D/E/F/H/0/I ). ). ). ). ). ).

up( A/B/C/0/E/F/H/I/J , 0/B/C/A/E/F/H/I/J ). up( A/B/C/D/0/F/H/I/J , A/0/C/D/B/F/H/I/J ).

31

up( up( up( up(

A/B/C/D/E/0/H/I/J A/B/C/D/E/F/0/I/J A/B/C/D/E/F/H/0/J A/B/C/D/E/F/H/I/0

, , , ,

A/B/0/D/E/C/H/I/J A/B/C/0/E/F/D/I/J A/B/C/D/0/F/H/E/J A/B/C/D/E/0/H/I/F , , , , , , , , , , , ,

). ). ). ). ). ). ). ). ). ). ). ). ). ). ). ).

right( right( right( right( right( right( down( down( down( down( down( down(

A/0/C/D/E/F/H/I/J A/B/C/D/0/F/H/I/J A/B/C/D/E/F/H/0/J 0/B/C/D/E/F/H/I/J A/B/C/0/E/F/H/I/J A/B/C/D/E/F/0/I/J A/B/C/0/E/F/H/I/J A/B/C/D/0/F/H/I/J A/B/C/D/E/0/H/I/J 0/B/C/D/E/F/H/I/J A/0/C/D/E/F/H/I/J A/B/0/D/E/F/H/I/J

A/C/0/D/E/F/H/I/J A/B/C/D/F/0/H/I/J A/B/C/D/E/F/H/J/0 B/0/C/D/E/F/H/I/J A/B/C/E/0/F/H/I/J A/B/C/D/E/F/I/0/J A/B/C/H/E/F/0/I/J A/B/C/D/I/F/H/0/J A/B/C/D/E/J/H/I/0 D/B/C/0/E/F/H/I/J A/E/C/D/0/F/H/I/J A/B/F/D/E/0/H/I/J

%%% the heuristic function h_function(Puzz,H) :- p_fcn(Puzz,P), s_fcn(Puzz,S), H is P + 3*S. %%% the move move(P,C,left) :- left(P,C). move(P,C,up) :- up(P,C). move(P,C,right) :- right(P,C). move(P,C,down) :- down(P,C). %%% the Manhattan distance function p_fcn(A/B/C/D/E/F/G/H/I, P) :a(A,Pa), b(B,Pb), c(C,Pc), d(D,Pd), e(E,Pe), f(F,Pf), g(G,Pg), h(H,Ph), i(I,Pi), P is Pa+Pb+Pc+Pd+Pe+Pf+Pg+Ph+Pg+Pi. a(0,0). b(0,0). c(0,0). d(0,0). e(0,0). f(0,0). g(0,0). h(0,0). i(0,0). a(1,0). b(1,1). c(1,2). d(1,1). e(1,2). f(1,3). g(1,2). h(1,3). i(1,4). a(2,1). b(2,0). c(2,1). d(2,2). e(2,1). f(2,2). g(2,3). h(2,3). i(2,3). a(3,2). b(3,1). c(3,0). d(3,3). e(3,2). f(3,1). g(3,4). h(3,3). i(3,2). a(4,3). b(4,2). c(4,1). d(4,2). e(4,1). f(4,0). g(4,3). h(4,2). i(4,1). a(5,4). b(5,3). c(5,2). d(5,3). e(5,2). f(5,1). g(5,2). h(5,1). i(5,0). a(6,3). b(6,2). c(6,3). d(6,2). e(6,1). f(6,2). g(6,2). h(6,0). i(6,1). a(7,2). b(7,3). c(7,4). d(7,2). e(7,2). f(7,3). g(7,0). h(7,1). i(7,2). a(8,1). b(8,2). c(8,3). d(8,0). e(8,1). f(8,2). g(8,1). h(8,2). i(8,3).

%%% the out-of-cycle function s_fcn(A/B/C/D/E/F/G/H/I, S) :s_aux(A,B,S1), s_aux(B,C,S2), s_aux(C,F,S3), s_aux(F,I,S4), s_aux(I,H,S5), s_aux(H,G,S6), s_aux(G,D,S7), s_aux(D,A,S8), s_aux(E,S9), S is S1+S2+S3+S4+S5+S6+S7+S8+S9. s_aux(0,0) :- !. s_aux(_,1).

32

s_aux(X,Y,0) :- Y is X+1, !. s_aux(8,1,0) :- !. s_aux(_,_,2). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 8-puzzle animation -- using VT100 character graphics %%% %%% %%% puzzle(P) :- solve(P,S), animate(P,S), message. animate(P,S) :- initialize(P), cursor(1,2), write(S), cursor(1,22), write('Hit ENTER to step solver.'), get0(_X), play_back(S). :- dynamic location/3. %%% So that location of a tile %%% can be retracted/asserted. %%% Location(s) asserted and retracted %%% by puzzle animator below

initialize(A/B/C/D/E/F/H/I/J) :cls, retractall(location(_,_,_)), assert(location(A,20,5)), assert(location(B,30,5)), assert(location(C,40,5)), assert(location(F,40,10)), assert(location(J,40,15)), assert(location(I,30,15)), assert(location(H,20,15)), assert(location(D,20,10)), assert(location(E,30,10)), draw_all. draw_all :- draw(1), draw(2), draw(3), draw(4), draw(5), draw(6), draw(7), draw(8). %%% play_back([left,right,up,...]). play_back([M|R]) :- call(M), get0(_X), play_back(R). play_back([]) :- cursor(1,24). %%% Put cursor out of the way message :- nl,nl, write(' ********************************************'), nl, write(' * Enter 8-puzzle goals in the form ... *'), nl, write(' * ?- puzzle(0/8/1/2/4/3/7/6/5). *'), nl, write(' * Enter goal ''message'' to reread this. *'), nl, write(' ********************************************'), nl, nl. cursor(X,Y) :- put(27), put(91), %%% ESC [ write(Y),

33

put(59), write(X), put(72).

%%% %%%

; M

%%% clear the screen, quickly cls :- put(27), put("["), put("2"), put("J"). %%% video attributes -- bold and blink not working plain :- put(27), put("["), put("0"), put("m"). reverse_video :- put(27), put("["), put("7"), put("m"). %%% Tile objects, character map(s) %%% Each tile should be drawn using the character map, %%% drawn at 'location', which is asserted and retracted %%% by 'playback'. character_map(N, [ [' ',' ',' ',' ',' ',' ',' '], [' ',' ',' ', N ,' ',' ',' '], [' ',' ',' ',' ',' ',' ',' '] ]). %%% move empty tile (spot) to the left left :- retract(location(0,X0,Y0)), Xnew is X0 - 10, location(Tile,Xnew,Y0), assert(location(0,Xnew,Y0)), right(Tile),right(Tile),right(Tile), right(Tile),right(Tile), right(Tile),right(Tile),right(Tile), right(Tile),right(Tile). up :- retract(location(0,X0,Y0)), Ynew is Y0 - 5, location(Tile,X0,Ynew), assert(location(0,X0,Ynew)), down(Tile),down(Tile),down(Tile),down(Tile),down(Tile). right :- retract(location(0,X0,Y0)), Xnew is X0 + 10, location(Tile,Xnew,Y0), assert(location(0,Xnew,Y0)), left(Tile),left(Tile),left(Tile),left(Tile),left(Tile), left(Tile),left(Tile),left(Tile),left(Tile),left(Tile). down :- retract(location(0,X0,Y0)), Ynew is Y0 + 5, location(Tile,X0,Ynew), assert(location(0,X0,Ynew)), up(Tile),up(Tile),up(Tile),up(Tile),up(Tile). draw(Obj) :- reverse_video, character_map(Obj,M), location(Obj,X,Y), draw(X,Y,M), plain. %%% hide tile hide(Obj) :- character_map(Obj,M),

34

location(Obj,X,Y), hide(X,Y,M). hide(_,_,[]). hide(X,Y,[R|G]) :- hide_row(X,Y,R), Y1 is Y + 1, hide(X,Y1,G). hide_row(_,_,[]). hide_row(X,Y,[_|R]) :- cursor(X,Y), write(' '), X1 is X + 1, hide_row(X1,Y,R). %%% draw tile draw(_,_,[]). draw(X,Y,[R|G]) :- draw_row(X,Y,R), Y1 is Y + 1, draw(X,Y1,G). draw_row(_,_,[]). draw_row(X,Y,[P|R]) :- cursor(X,Y), write(P), X1 is X + 1, draw_row(X1,Y,R). %%% Move an Object up up(Obj) :- hide(Obj), retract(location(Obj,X,Y)), Y1 is Y - 1, assert(location(Obj,X,Y1)), draw(Obj). down(Obj) :- hide(Obj), retract(location(Obj,X,Y)), Y1 is Y + 1, assert(location(Obj,X,Y1)), draw(Obj). :- hide(Obj), retract(location(Obj,X,Y)), X1 is X - 1, assert(location(Obj,X1,Y)), draw(Obj).

left(Obj)

right(Obj) :- hide(Obj), retract(location(Obj,X,Y)), X1 is X + 1, assert(location(Obj,X1,Y)), draw(Obj). :- message.

5.2 The 8-puzzle

35

The title of this section refers to a familiar and popular sliding tile puzzle that has been around for at least forty years. The most frequent older versions of this puzzle have numbers or letters an the sliding tiles, and the player is supposed to slide tiles into new positions in order to realign a scrambled puzzle back into a goal alignment. For illustration, we use the 3 x 3 8-tile version, which is depicted here in goal configuration

Fig. 5.2 To represent these puzzle "states" we will use a Prolog term representation employing '/' as a separator. The positions of the tiles are listed (separated by '/') from top to bottom, and from left to right. Use "0" to represent the empty tile (space). For example, the goal is ... goal(1/2/3/8/0/4/7/6/5). The moves are described for the puzzle solver in terms of which direction the empty tile appears to travel. left( A/0/C/D/E/F/H/I/J , 0/A/C/D/E/F/H/I/J ). left( A/B/C/D/0/F/H/I/J , A/B/C/0/D/F/H/I/J ). left( A/B/C/D/E/F/H/0/J , A/B/C/D/E/F/0/H/J ). left( A/B/0/D/E/F/H/I/J , A/0/B/D/E/F/H/I/J ). left( A/B/C/D/E/0/H/I/J , A/B/C/D/0/E/H/I/J ). left( A/B/C/D/E/F/H/I/0 , A/B/C/D/E/F/H/0/I ). up( up( up( up( up( up( A/B/C/0/E/F/H/I/J A/B/C/D/0/F/H/I/J A/B/C/D/E/0/H/I/J A/B/C/D/E/F/0/I/J A/B/C/D/E/F/H/0/J A/B/C/D/E/F/H/I/0 , , , , , , 0/B/C/A/E/F/H/I/J A/0/C/D/B/F/H/I/J A/B/0/D/E/C/H/I/J A/B/C/0/E/F/D/I/J A/B/C/D/0/F/H/E/J A/B/C/D/E/0/H/I/F , , , , , , , , , , , , ). ). ). ). ). ). ). ). ). ). ). ). ). ). ). ). ). ).

right( right( right( right( right( right( down( down( down( down( down( down(

A/0/C/D/E/F/H/I/J A/B/C/D/0/F/H/I/J A/B/C/D/E/F/H/0/J 0/B/C/D/E/F/H/I/J A/B/C/0/E/F/H/I/J A/B/C/D/E/F/0/I/J A/B/C/0/E/F/H/I/J A/B/C/D/0/F/H/I/J A/B/C/D/E/0/H/I/J 0/B/C/D/E/F/H/I/J A/0/C/D/E/F/H/I/J A/B/0/D/E/F/H/I/J

A/C/0/D/E/F/H/I/J A/B/C/D/F/0/H/I/J A/B/C/D/E/F/H/J/0 B/0/C/D/E/F/H/I/J A/B/C/E/0/F/H/I/J A/B/C/D/E/F/I/0/J A/B/C/H/E/F/0/I/J A/B/C/D/I/F/H/0/J A/B/C/D/E/J/H/I/0 D/B/C/0/E/F/H/I/J A/E/C/D/0/F/H/I/J A/B/F/D/E/0/H/I/J

The heuristic function we use here is a combination of two other estimators: p_fcn, the Manhattan distance function, and s_fcn, the sequence function, all as explained in Nilsson (1980), which estimates how badly out-of-sequence the tiles are (around the outside).

36

h_function(Puzz,H) :- p_fcn(Puzz,P), s_fcn(Puzz,S), H is P + 3*S. The 'move' predicate is defined as follows. move(P,C,left) :- left(P,C). move(P,C,up) :- up(P,C). move(P,C,right) :- right(P,C). move(P,C,down) :- down(P,C). Here is the code for p and s. %%% Manhattan distance p_fcn(A/B/C/D/E/F/G/H/I, P) :a(A,Pa), b(B,Pb), c(C,Pc), d(D,Pd), e(E,Pe), f(F,Pf), g(G,Pg), h(H,Ph), i(I,Pi), P is Pa+Pb+Pc+Pd+Pe+Pf+Pg+Ph+Pg+Pi. a(0,0). a(6,3). b(0,0). b(6,2). c(0,0). c(6,3). d(0,0). d(6,2). e(0,0). e(6,1). f(0,0). f(6,2). g(0,0). g(6,2). h(0,0). h(6,0). i(0,0). i(6,1). a(1,0). a(7,2). b(1,0). b(7,3). c(1,2). c(7,4). d(1,1). d(7,2). e(1,2). e(7,2). f(1,3). f(7,3). g(1,2). g(7,0). h(1,3). h(7,1). i(1,4). i(7,2). a(2,1). a(8,1). b(2,0). b(8,2). c(2,1). c(8,3). d(2,2). d(8,0). e(2,1). e(8,1). f(2,2). f(8,2). g(2,3). g(8,1). h(2,3). h(8,2). i(2,3). i(8,3). a(3,2). a(4,3). a(5,4). b(3,1). b(4,2). b(5,3). c(3,0). c(4,1). c(5,2). d(3,3). d(4,2). d(5,3). e(3,2). e(4,1). e(5,2). f(3,1). f(4,0). f(5,1). g(3,4). g(4,3). g(5,2). h(3,3). h(4,2). h(5,1). i(3,2). i(4,1). i(5,0).

%%% the out-of-cycle function s_fcn(A/B/C/D/E/F/G/H/I, S) :s_aux(A,B,S1), s_aux(B,C,S2), s_aux(C,F,S3), s_aux(F,I,S4), s_aux(I,H,S5), s_aux(H,G,S6), s_aux(G,D,S7), s_aux(D,A,S8), s_aux(E,S9), S is S1+S2+S3+S4+S5+S6+S7+S8+S9. s_aux(0,0) :- !. s_aux(_,1). s_aux(X,Y,0) :- Y is X+1, !. s_aux(8,1,0) :- !. s_aux(_,_,2).

37

The Prolog program from the previous section (5.1) and the program outlined in this section can be used as an 8-puzzle solver. ?- solve(0/8/1/2/4/3/7/6/5, S). S = [right, right, down, left, left, up, right, down] ; ... The code for this section also contains a solution animator that is explained in Section 8.2. Exercise 5.2.1 Add statistics to 'solve'; that is, return also the number of nodes expanded, and the number of nodes left on open (at end of a successful search). [Add any other statistics you feel might be interesting to see.] Exercise 5.2.2 Look in the literature for an algorithm that decides, given a starting configuration S for the 8-puzzle, whether or not the goal G is reachable from S. (Half, 9!/2 = 181,440, will be reachable.) Implement this algorithm in Prolog. Exercise 5.2.3 Modify the program to use f(n) = g(n) + p_fcn(n). These searches will result in optimal solutions (if one exists). Using the statistics of Exercise 5.2.1 above to make practical comparisons between solutions using h(n) = p_fcn(n)+3*s_fcn(n) and h(n) = p_fcn(n). 8.1 Action specification for a simple calculator Consider the following action specification for a simple calculator. Informal Requirements or Intentions... 1. The application should be graphical, and should have an appearance similar to the following...

Fig. 8.1

38

2. Buttons should be "active" and button pushes actually activate calculator functions. 3. An internal accumulator maintains a running total value reflecting the operations that have been made so far during use of the calculator. 4. An operator flag indicates what is the pending operation that will be performed once another operand is entered. 5. The display area shows the latest numeral that has been entered, the memory value that is recalled using MR, or the total value computed so far when the = or M+ keys are pushed. 6. The memory for the calculator contains a value, initially zero. It is changed by the M+ and MR keys. Domains ... Button --> Digit | Arithmetic_Operator | Memory_Operator | Clear | Equal Digit --> 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 Numeral --> Digit | Numeral Digit Arithmetic_Operator --> plus | minus | times | plus_minus Memory_Operator --> mem_plus | mem_rec Clear --> clear Equal --> equal Mode --> init | cont Changeable Properties accumulator(N) op(F) displayed(D) memory(M) mode(C) Action push(B) Action Animator where where where where where N F D M C is is is is is Numeral Arithmetic_Operator Numeral Numeral Mode

where B is Button

Animator --> Show_Action | Show_Action Animator Show_Action --> Action Show Show --> ... Action Specifications The calculator registers are modelled as a 4-tuple

39

[a,op,d,m] where accumulator(a) op(op) displayed(d) memory(m) declare (or express) the current "true" values of these changeable properties. An action changes the values of these four registers, that is, an action changes the truth or falsity of the changeable properties... [a,op,d,m] -- Action --> [a',op', d', m'] or Action < - {preconditions}, deny({old properties}), {local calculations}, affirm({new properties}). The specifications are each given in two forms. The first is a more intuitive summary expression, the second is the formal action specification ... action_module(calculator) . %[-,-,d1,-] --push(D)--> [-,-,D,-] mode(init) push(D) < mode(init), deny([displayed(D1),mode(init)]), affirm([displayed(D),mode(cont)]). %[-,-,D1,-] --push(D)--> mode(cont) push(D) < mode(cont), deny(displayed(D1)), New = 10*D1 + D, affirm(displayed(New)). %[a,op,d,m] --push(clear)--> push(clear) < if

[-,-,10*D1+D,-]

if

[0,nop,0,0]

deny([accumulator(A),op(O),displayed(D),memory(M),mode (X)]),

40

affirm([accumulator(0),op(nop),displayed(0),memory(0), mode(init)]). %[a,op,d,m] --push(mem_rec)--> [a,op,m,m] push(mem_rec) < memory(M), deny([displayed(D),mode(X)]), affirm([displayed(M),mode(init)]). %[a,op,d,m] --push(plus)--> [op(a,d),plus,d,m] push(plus) < displayed(D), deny([accumulator(A),op(O),mode(X)]), eval(O,A,D,V), ; use normal arithmetic, i.e., V=O(A,D) affirm([accumulator(V),op(plus),mode(init)]). %[a,op,d,m] --push(minus)--> [op(a,d,minus,d,m] push(minus) lt displayed(D), deny([accumulator(A),op(O),mode(X)]), eval(O,A,D,V), ; use normal arithmetic, i.e., V=O(A,D) affirm([accumulator(V),op(minus),mode(init)]). %[a,op,d,m] --push(times)--> [op(a,d),times,d,m] push(times) < displayed(D), deny([accumulator(A),op(O),mode(X)]), eval(O,A,D,V), ; use normal arithmetic, i.e., V=O(A,D) affirm([accumulator(V),op(times),mode(init)]). %[a,op,d,m] --push(equal)--> [a,nop,op(a,d),m] push(equal) < accumulator(A), deny([op(O),displayed(D),mode(X)]), eval(O,A,D,V), affirm([op(nop),displayed(V),mode(init)]). %[a,op,d,m] --push(mem_plus)--> [a,nop,v,plus(m,v)] where v=op(a,d) push(mem_plus) < accumulator(A), deny([op(O),displayed(D),memory(M),mode(X)]), eval(O,A,D,V), eval(plus,M,V,V1), affirm([op(nop),displayed(V),memory(V1),mode(init)]). %[a,op,d,m] --push(plus_minus)--> [a,op,-d,m]

41

push(clear) < deny([displayed(D),mode(X)]), eval(minus,0,D,V), affirm([displayed(V),mode(init)]). A fairly straightforward translation of the action clauses gives a Prolog prototype. Exercise 8.1 Extend the calculator specification for real arithmetic, implement the specification, and test the implementation.
/* calc.pl -- Action Semantics and Prototype for simple calculator */ /* Action specification: [Acc,Op,Disp,Mem] --Action-->[Acc',Op',Disp',Mem'] /* declare digits */ digit(0). digit(1). digit(2). digit(3). digit(4). digit(5). digit(6). digit(7). digit(8). digit(9). mode(init). /* init at beginning of number, cont while accumulating number */ accumulator(0). memory(0). displayed(0). op(nop). /* [-,-,d1,-] --push(D)--> [-,-,D,-] if mode(init) */ push(D) :- digit(D), retract(mode(init)), retract(displayed(Disp)), assert(displayed(D)), assert(mode(cont)). /* [-,-,Disp,-] --push(D)--> [-,-,10*Disp+D,-] if mode(cont) */ push(D) :- digit(D), mode(cont), retract(displayed(Disp)), D1 is 10*Disp + D, assert(displayed(D1)). /* [a,op,d,m] --push(clear)--> [0,nop,0,0] */ push(clear) :- retract(accumulator(A)), retract(op(O)), retract(displayed(D)), retract(memory(M)), assert(accumulator(0)), */

42

assert(op(nop)), assert(displayed(0)), assert(memory(0)), retract(mode(Mode)), assert(mode(init)). /* [a,op,d,m] --push(mem_rec)--> [a,op,m,m] */ push(mem_rec) :- memory(M), retract(displayed(D)), assert(displayed(M)), retract(mode(Mode)), assert(mode(init)). /* [a,op,d,m] --push(plus)-->[op(a,d),plus,d,m] */ push(plus) :- retract(accumulator(A)), displayed(D), retract(op(O)), eval(O,A,D,R), assert(accumulator(R)), assert(op(plus)), retract(mode(Mode)), assert(mode(init)). /* [a,op,d,m] --push(minus)--> [op(a,d,minus,d,m] */ push(minus) :- retract(accumulator(A)), displayed(D), retract(op(O)), eval(O,A,D,R), assert(accumulator(R)), assert(op(minus)), retract(mode(Mode)), assert(mode(init)). /* [a,op,d,m] --push(times)--> [op(a,d),times,d,m] */ push(times) :- retract(accumulator(A)), displayed(D), retract(op(O)), eval(O,A,D,R), assert(accumulator(R)), assert(op(times)), retract(mode(Mode)), assert(mode(init)). eval(plus,A,B,R) :- R is A + B. eval(times,A,B,R) :- R is A * B. eval(minus,A,B,R) :- R is A - B. eval(nop,A,B,B). /* [a,op,d,m] --push(equal)--> [a,nop,op(a,d),m] */ push(equal) :- accumulator(A), retract(op(O)), retract(displayed(D)), assert(op(nop)), eval(O,A,D,R), assert(displayed(R)), retract(mode(Mode)), assert(mode(init)). /* [a,op,d,m] --push(mem_plus)--> [a,nop,v,plus(m,v)] where v=op(a,d) */ push(mem_plus) :- accumulator(A), retract(op(O)), retract(displayed(D)),

43

eval(O,A,D,R), assert(op(nop)), assert(displayed(R)), retract(memory(M)), eval(plus,M,R,S), assert(memory(S)), retract(mode(Mode)), assert(mode(init)). /* [a,op,d,m] --push(plus_minus)--> [a,op,-d,m] */ push(plus_minus) :- retract(displayed(D)), D1 is -D, assert(displayed(D1)), retract(mode(Mode)), assert(mode(init)). /* Calc reads button events and performs actions corresponding to the buttons that were pushed. Thus 'calc' provides an "animator" for the action specifications. Since most of the specification consists of the action clauses, we have what essentially amounts to an "executable specification" of our calculator. */ calc :- read(Button), push(Button), accumulator(A), write(A), write(','), op(O), write(O), write(','), displayed(D), write(D), write(','), memory(M), write(M), nl, calc.

8.3 Animating the blocks mover This section uses the blocks action planner from Section 2.19 (modified) and the idiomatic English language command and question interface prototype from Section 7.3. In this section we add an animator (much like in the previous section, 8.2) that incorporates the blocks planner and the natural language command and question interface. If the user runs the program in a terminal window, one will initially see something like the following ... ?> Put a on c and c on b --------| a | | | ----------------| b | | | -----------------

44

| c | | | --------=================================== Fig. 8.3 The user enters commands or questions after the prompt at the upper left of the screen (sample input provided above). For commands to rearrange the blocks, the system parses the input, generates a goal list, attempts to compute a plan to accomplish the goal list, and then plays out the plan for successful computations; otherwise, the system tells the user that the command is not possible. The system is also suppose to answer some questions. The reader is advised to load the Prolog code for this section, and to try typing in various inputs, using the idioms of Section 7.3. The graphics animator is quite similar to that in the Section 8.2, and will not be discussed in detail. See the Prolog code for the specifications. The exercises ask the reader to add various command or question idioms to the animator. Exercise 8.3.1 Incorporate the question idiom of Exercise 7.3.1. Exercise 8.3.2 Incorporate the question idiom of Exercise 7.3.2. Exercise 8.3.3 Incorporate the question idiom of Exercise 7.3.3. Exercise 8.3.4 Devise a way to add explanations to the blocks mover of this section so that when the user ask for a rearrangement that is invalid, and is told that the task cannot be completed, then if asked "Why?", the system gives an explanation of why the user's request cannot be carried out. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% blocks.pl %%% Blocks world animator using Natural Language interface. %%% J.R. Fisher %%% [email protected] %%% Last update 5-3-95; 5-4-95; 5-22-95; fall 1996

blocks :- %%% clear the screen cls, %%% show the blocks show(a),show(b),show(c), %%% show the table cursor(15,22), write('========================================='), cursor(15,25), write('Enter ''stop.'' to exit blocks world.'), %%% start NL command-interpreter loop blocks_loop.

45

blocks_loop :- %%% command line in upper left corner of screen cursor(1,1), write('?> '), cursor(1,2), write(' '), cursor(4,1), %%% read command read_line(S), %%% Get users command or question. process(S), %%% Process it. !, %%% again ... blocks_loop. process([stop,'.']) :- !, fail. process(S) :- s(F,S,[]), !, continue(F). process(Q) :- q(F,Q,[]), !, cursor(1,2), answer(F), get0(_X), get0(_Y). process(_) :- cursor(1,2), write('I do not understand! <Hit Enter>'), get0(_X), get0(_Y). continue(Goal_List) :- valid(Goal_List), !, do(Goal_List). continue(_Goal_List) :- cursor(1,2), write('Cannot do that! Enter>'), get0(_X), get0(_Y).

<Hit

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% %%% Command/Question Parser %%% s(L) --> l,c(L),end. end --> ['.'] | ['?']. /* Sample scripts form intended interface requirements.

Please place <put> a on <onto> b, c on d, and d on the table. I want <would like> a on b, c on d, and d on the table. I want <would like> you to put <place> ... Can <could> <would> you <please> put a on b, c on d, and d on the table? */

46

l --> please, place. l --> [i], [want] | [i], [would], [like], you_to_put. l --> ([can] | [could] | [would]), [you], please, place. you_to_put --> [] | [you], [to], place. please --> [] | [please]. place --> [put] | [place]. c([ON]) --> on(ON). c([ON|R]) --> on(ON), comma, c(R). comma --> [','] | ['and'] | [','],[and]. on(on(X,Y)) --> [X], ([on] | [onto] | [on],[top],[of]), [Y]. on(on(X,table)) --> [X],([on] | [onto]), [the], [table]. test_parser :- repeat, write('?? '), read_line(X), s(F,X,[]), nl, write(X), nl, write(F), nl, fail. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% question: Which block is on top of X? :- op(500, xfx, 'is_on_top_of'). q('What' is_on_top_of A) --> [what],[is],[on],[top],[of],[A],end. B is_on_top_of A :- location(A,[X,Y]), Y1 is Y-5, location(B,[X,Y1]), !. 'Nothing' is_on_top_of _A . answer('What' is_on_top_of A) :- call(X is_on_top_of A), say([X,is,on,top,of,A]). say([X|R]) :- write(X), write(' '), say(R). say([]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% %%% Action specifications %%% Uses Logic specification method with assert/retract %%% /* action put A on B */

47

/* Recursive logic specification */ put_on(A,B) :on(A,B). put_on(A,B) :\+ on(A,B), A \== table, A \== B, clear_off(A), clear_off(B), transport(A,B).

/* N.B. "action" used as precondition */

clear_off(table). /* Means that there is room on the table. */ clear_off(A) :/* Means already clear. */ A \== table, \+ on(_X,A). clear_off(A) :A \== table, on(X,A), clear_off(X), /* N.B. recursion */ transport(X,table). do(Glist) :- do_all(Glist,Glist). do_all([G|R],Allgoals) :call(G), !, do_all(R,Allgoals). do_all([G|_],Allgoals) :achieve(G), do_all(Allgoals,Allgoals). do_all([],_). achieve(on(A,B)) :- put_on(A,B). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % %%% Valid list of goals %%% /* 1. on(table,-) is forbidden 2. Should not allow goal which asks to move "nonexistent" block. 3. No blocks can be placed above itself. 4. Cannot put two blocks onto one block (share support). 5. Cannot put one block onto two blocks (overlap). 6. All blocks should be supported by something(? initial condition). 7. Any more??? */

48

valid(Gs) :- \+ member(on(table,_X), Gs), existence_test(Gs), \+ above(X,X,Gs), \+ two_on_one(Gs), \+ one_on_two(Gs). /* A general existence test */ existence_test([]). existence_test([on(A,B)|R]) :- exists(A), exists(B), existence_test(R). exists(table) :- !. exists(A) :- on(A,_) ; on(_,A). above(X,Y,Gs) :- member(on(X,Y),Gs), !. above(X,Y,Gs) :- member(on(Z,Y),Gs), above(X,Z,Gs). two_on_one(Gs) :- member(on(X,Y),Gs), member(on(Z,Y),Gs), X \== Z. one_on_two(Gs) :- member(on(X,Y),Gs), member(on(X,Z),Gs), Y \== Z. /* 'reorder' uses an insertion-sort based upon the calculated height of a block in the resulting list. */ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% %%% Reorder a list of goals so that ... %%% %%% Move lowest blocks (least height in goal list) first. %%% reorder(Goals,Ordered) :- insert_each(Goals,[],Ordered,Goals). insert_each([X|R],In,Out,Gs) :- insert(X,In,Temp,Gs), insert_each(R,Temp,Out,Gs). insert_each([],A,A,_). insert(X,[],[X],_). insert(on(A,B),[on(C,D)|R],S,Gs) :height(A,Gs,Ha), height(C,Gs,Hc), (Ha < Hc -> S=[on(A,B),on(C,D)|R] ; S=[on(C,D)|W], insert(on(A,B),R,W,Gs) ).

49

height(B,L,0) :- \+ member(on(B,_), L). height(B,L,N) :- member(on(B,A),L), height(A,L,M), N is M+1. sample([on(a,b), on(b,c), on(c,table)]). :-[read_line]. /* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Cursor graphics for blocks animator positioning information [20, - ] [30, ] [40, ] [20, 7 ] [30, ] [40, ] [20, 12] [30, ] [40, ] [20, 17] [30, ] [40, ] -==============================-

<--- table

The actions 'up', left', 'right', and 'down' will, in effect, move a block one position; the animation of such a move will show movement for each screen cursor position.

^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ^^ */ on(A,table) :- location(A,[_,17]). on(A,B) :- B \== table, location(A,[X,YA]), location(B,[X,YB]), YB is YA + 5. :- dynamic free_spot_on_table/1, location/2. free_spot_on_table([30,17]). free_spot_on_table([40,17]). %% initially location(a,[20,7]). location(b,[20,12]). location(c,[20,17]). transport(A,B) :- %%% locate B -- table or block (B == table -> retract(free_spot_on_table([BX,BY])) ;

50

location(B,[BX,BY]) ), location(A,[AX,AY]), %%% create new free spot if A == table (AY == 17 -> assert(free_spot_on_table([AX,17])) ; true ), (AY < BY -> Up is 5 ; Up is AY - BY + 10 ), %%% move high enough to clear everything move(up(A),Up), %%% move horizontally over above B (BX < AX -> H is AX - BX, move(left(A),H) ; H is BX - AX, move(right(A),H) ), %%% set A down onto B location(A,[_,Y]), (B == table -> D is BY - Y ; D is BY - Y - 5), move(down(A),D). /* Move block one character pixel position ... */ up(B) :hide(B), retract(location(B,[X,Y])), Y1 is Y - 1, assert(location(B,[X,Y1])), show(B). down(B) :- hide(B), retract(location(B,[X,Y])), Y1 is Y + 1, assert(location(B,[X,Y1])), show(B). left(B) :- hide(B), retract(location(B,[X,Y])), X1 is X - 1, assert(location(B,[X1,Y])), show(B). right(B) :- hide(B), retract(location(B,[X,Y])), X1 is X + 1, assert(location(B,[X1,Y])), show(B). /* move block multiple pixel positions ... */ move(_D,0). move(D,N) :- N > 0, call(D), N1 is N - 1,

51

move(D,N1). /* positioning the VT100 screen cursor */ cursor(X,Y) :- put(27), put(91), %%% ESC [ write(Y), put(59), %%% ; write(X), put(72). %%% M /* clear the screen */ cls :- put(27), put("["), put("2"), put("J"). /* template showing how to draw the blocks */ block_map(B, [['-','-','-','-','-','-','-','-','-'], ['|',' ',' ',' ',' ',' ',' ',' ','|'], ['|',' ',' ',' ', B ,' ',' ',' ','|'], ['|',' ',' ',' ',' ',' ',' ',' ','|'], ['-','-','-','-','-','-','-','-','-'] ]). show(B) :- location(B, [X,Y]), block_map(B,M), draw(X,Y,M). hide(B) :- location(B, [X,Y]), block_map(B,M), hide(X,Y,M). hide(_,_,[]). hide(X,Y,[R|G]) :- hide_row(X,Y,R), Y1 is Y + 1, hide(X,Y1,G). hide_row(_,_,[]). hide_row(X,Y,[_|R]) :- cursor(X,Y), write(' '), X1 is X + 1, hide_row(X1,Y,R). draw(_,_,[]). draw(X,Y,[R|G]) :- draw_row(X,Y,R), Y1 is Y + 1, draw(X,Y1,G). draw_row(_,_,[]). draw_row(X,Y,[P|R]) :- cursor(X,Y), write(P), X1 is X + 1, draw_row(X1,Y,R). /* higest_intevening_stack(A,B,H) :location(A,[AX,AY]), location(B,[BX,BY]),

52

(A == B -> H is 0 ; %%% 0 needs to be converted to absolute coord (AX < BX -> setof(Y,X^(location(_,[X,Y]), AX < X, X < BX, S) ; setof(Y,X^(location(_,[X,Y]), BX < X, X < AX, S) ), max(S,H). */ :- nl, write('**************************************'), nl, write('** Enter goal ''blocks.'' to start. **'), nl, write('**************************************'), nl, nl.

53