PROLOG Programming University of Wales, Cardiff January 1997 Omer F. Rana omer@cs.cf.ac.uk Room S/2.03 What is Prolog and why should I bother ? PROLOG : PRogramming in LOGic 5th generation computer language Used in programming for artificial intelligence based on a subset of predicate calculus (Horn clauses) The Edinburgh syntax A DIFFERENT programming style from PASCAL or C [1in] 6in 0.01cm A language for : ARTIFICIAL INTELLIGENCE , with numerous application domains (such as) DATABASES, NATURAL LANGUAGE PROCESSING, IMAGE ANALYSIS, DECISION SUPPORT SYSTEMS, FINANCIAL MODELS, INTERNET APPLICATIONS and many others ... Understanding the experts Intelligent Reasoning Books n' stuff Prolog Programming for Artificial Intelligence Bratko Addison-Wesley, 90 Programming in Prolog, Clocksin and Mellish Berlin : Springer-Verlag 87 The art of Prolog : advanced programming techniques, Sterling and Shapiro MIT P ress, 94 Problem solving with Prolog, Stobo London : Pitman 89 LPA MacProlog32 (technical manuals) Logic Programming Associates However, for an introductory course, any book on Prolog is fine. Course Outline Declarative programming style Translating simple problems into Prolog Language Syntax Computing with Prolog Programming techniques and styles Understanding execution of Prolog programs User interfaces in MacProlog Stand alone applications and link with other programming languages Applications : Databases and the Internet Lab Handout for LPA MacProlog LPA MacProlog32 Will be used for programming in the labs On a (surprise surprise) Macintosh See User Guide for details Mail questions to me at omer@cs.cf.ac.uk Friday-hour for support Programming Practise Lots of chance to play with Prolog , also compiler available on the internet for PC. Emphasis on Logic Programming Comparison between Pascal and Prolog PASCAL is compiled to an executable file. is imperative - consists of a sequence of instructions to execute. program flow composed of conditionals and loops . numerous built-in functions (language grammar). an expression can evaluate to one of many values. PROLOG is interpreted . is declarative - contains a series of definitions which are accessed as required (in any order) by the program during execution. the HOW of solving the problem is NOT defined, only what is TRUE or NOT of a certain state of affairs is described. a statement can either be TRUE or FALSE a few built-in rules, and a few fundamental operations . PASCAL programs contain a series of INSTRUCTIONS given to the computer as PROCEDURES to perform. The order of doing things is SPECIFIED and a number of ACTIONS performed as a consequence. PROLOG programs contain a set of FACTS and RULES . Aspects of the problem which are TRUE or FALSE are described (defined), rather than the method to achieve a RESULT . For instance : likes(omer, donuts) likes(paul, neighbours) Example In predicate calculus green(fonzie) green(puff) green(martian) dragon(godzilla) dragon(puff) The corresponding translation in Prolog will be : fly(X) :- green(X), dragon(X). body antecedents that must be true. A Logical Deduction is called a Query Asking for Confirmation Q : fly(puff) A : yes Q : fly(fonzie) A : no Q : fly(kermit) A : no ( no unproven, not false Asking for values Q : fly(X) A : X = puff Q : dragon(X) A : X = godzilla X = puff Find a fact to match the goal : Binding Some Prolog Facts : Find a fact to match the goal : Binding So in the previous example, for instance, puff was found to be a valid answer. If more than one possible answers existed to the problem, then the first goal variable is unbound (i.e. its value discarded) and the next matching value bound to it. Matching of goals to facts Searching for solutions Fundamental processes in the understanding of how Prolog works. Another Example In predicate calculus : now pick a few students : student(patrick) student(jane) student(gwyn) student(ahmed) student(helen) student(vijay) those with money left / free time : money-left(gwyn) free-time(ahmed) money-left(jane) free-time(jane) money-left(helen) free-time(vijay) Translation Into Prolog : holiday(X) :- student(X), money_left(X). party(X) :- student(X), free_time(X). lucky(X) :- student(X), money_left(X) ; student(X), free_time(X). student(patrick). student(jane). student(gwyn). student(ahmed). student(helen). student(vijay). money_left(gwyn). free_time(ahmed). money_left(jane). free_time(jane). money_left(helen). free_time(vijay). Things to note : Layout : Keep it readable. Spaces, Hyphens and Underscores . Full stops and commas . The Universe of discourse (limited to that defined by the program) Prolog Syntax Follows the Edinburg syntax /* one line comment */ /* Multi line comment */ the rest of this line is a comment Terms are the building blocks of a program for instance, Numbers Integers : 12 0 -24 Floating Point : 2.5 -0.34 10e-4 A query can be used to determine or decide upon number syntax, so for instance : Q : integer(12) A : yes Q : float(10.2) A : yes Q : integer(-7.43) A : no Q : number(-2.34) A : yes Q : number(5322) A : yes integer , float and number are built in predicates. dragon , green and fly are user defined predicates. Atoms Constants that start with a lower case letter, followed by zero or more alphanumeric characters, for instance : donut can dance fortran90 symbolic (sequence of symbolic characters) ++ and those with special meaning in Prolog : ! (exclamation mark) , (coma) ; (semi-colon) quotes (any sequence of characters in single quotes) 'Apple' 'Alia' ' them' again a query format can be used to deduce atoms Q : atom(alia) A : yes Q : atom(123) A : no Q : atomic(123) A : yes ( because is an integer ) Q : atomic('123') A : yes ( because is an atom ) What are the distinctions ? Variables alphanumeric sequence of characters (include ), starting with a capital letter or underscore, such as X Apple name Failed student So a query such as : Q : var(Apple) A : yes Q : nonvar( name) A : no Q : var(ola) A : no Q : var('Apple') A : no ( because is an atom ) Variables can be anonymous, denoted by the (underscore alone), and used when a return value is not needed for instance, born(heather,cardiff) born(ben, prague) Q : born( ,cardiff) A : yes The question being asked is : Is anybody born in cardiff ? , but I do not care who ! Note : Do not use 2 or (number) as a variable name, as this is how MacProlog32 uses anonymous variables, and represents them internally. Scope of a variable Within a clause, all occurrences of an identical variable refer to the same value. For instance : fly(X) :- green(X), dragon(X). and happy(X) :- pass exam(X,Y). here, X in fly(X) and happy(X) are not related. However, the occurrance of X in the definition of fly(X) refer to the same thing. Also, note the change in arity of the clause happy(X) . There are some exceptions however for such anonymous variables : balanced child(X) :- brother(X, ), sister(X, ). Here, the variable represented by refers to different people and would be represented internally as : balanced child(X) :- brother(X, 483), sister(X, 485). The advanced Trace mechanism can be used to show internal variable names Consider the program : check_number(0). check_number(N) :- N < 0, N1 is N+2, check_number(N1). check_number(N) :- N > 0, N1 is N-2, check_number(N1). What happens when we give the queries : check number(4) check number(100) check number(15) check number(125) Query : Q : check number(4) A : yes The program goes into a loop, nothing appears to be happening on the screen. The loop will only stop until there is no more memory left for evaluation. Hence, the program will have to be interrupted. What can we do to prevent this happening ? check number(1). Q : check number(15) A : yes the new information also has to be added at a specific point, because of the way evaluation is performed by Prolog Compound Terms Atom (functor) followed by k 1 terms, enclosed in brackets and seperated by commas k denotes the arity e.g. student(ursula) composer(bach,baroque) disk jockey(X,party(X)) tuples : sequences of terms, enclosed in brackets and separated by commas e.g. representing a date : 23, march, 97) as, is an atom, the tuple can be seen as : ','(10,','(march, 97)) (internal handling) Q : compound( foo(a,B,32)) A : yes Q : compound( ' Others'( Names )) A : yes Q : compound(123) A : no Prolog Programming Translation of a problem into Prolog Facts Blood is red Summer is hot Miles is a jazz performer red( blood). hot( summer). jazz performer( miles). Properties or relationships by predicates. red, hot and jazz_performer are predicate names which denote properties or relations and blood, summer and miles are arguments which denote individuals, or particular occurences. Note : Oder of predicates' arguments is arbitrary but MUST be consistent with our interpretation and maintained throughout. son( john, tom). son( tom, john). Important to decide the order of arguments and then strictly adhere to this format. Lists : days of the week( [mon, tue, wed, thu, fri, sat, sun] ). Order of terms is important . Multiple Ways of Expression red( blood). colour( blood, red). property( blood, colour, red) A predicate is determined by its name and arity : child( ahmed). child( ahmed, peter). child( ahmed, peter, helen). Ahmed is a child. Ahmed is Peter's child. Ahmed is a child of Peter and Helen. child/2 : an unambiguous specification of the predicate with the name child nad with two arguments. Hence : child(ahmed, peter). child( [ahmed, peter], helen). child( helen, 2) Tom and Ann are pupils. Dr. Richard is their lecturer and Prof. Green is their H-O-D. Relations of this type can be expressed using a tree. lecturer( dr_richard, tom). lecturer( dr_richard, ann). h_o_d( prof_green, dr_richard). RULES A person will buy things if he/she needs them and he/she can pay their price buy( Person, Thing) :- needs( Person, Thing), price( Thing, Price), can_pay( Person, Price). Write a Prolog rule for : A Day is nice if it is sunny and not windy. More X will win a boxing match if X will either knock-out Y or if he/she will get more points than Y win_a_boxing_match( X, Y) :- knock_out( X,Y) ; (points( X, Px), points( Y, Py), Px > Py). Write a Prolog rule for : For all X, Y and Z, X is a grandfather of Y if X is a father of Z, and Z is either a father or a mother of Y. Lists Sequences of k 0 terms, enclosed in square brackets and seperated by commas. e.g. [] (empty list) (k = 0) [1, 2, mary, brother(peter,X)] Q: lst([1,a,X]) A: yes Q: lst([ ]) A: yes Q: compound([1,a,X]) A: yes Q: compound([]) A: no List is a Prolog structure used to represent an ordered sequence of terms. Also, ([mon,tue,wed,thu,fri,sat,sun]) Elements of a list can be arbitrary Prolog terms [ dave( 1, date(12, nov 88)), joey( 2, date(15, jul 70)), tomy( 3, date(21, dec 75))] Elements of a list may also be a list [ [a,b], [a], [b], [] ] The Story So Far ... Explanation in logic. Definitions and facts. Predicates / Rules. Translation from a logic construction. Conjunction and Disjunstion. Nested rules. Rule Syntax (Anatomy of a predicate). Atoms, Variables. Anonymous Variables and PlaceHolders. Yes/No Queries. Search-a-database Query. Any problems with these ? Programming Guidelines Meaningful names for variables and predicates. simple predicates. keep database seperate. Put plenty of comments. Do not use variable names like (number) More Examples Two people are neighbours if they live on the same street but in different houses. neighbour( Person_A, Person_B) :- address( Person_A, Street, Num), address( Person_B, Street, Num1). Translate the following into Prolog rules : Nothing is good and bad at the same time. X lives if X is a human, if he/she breathes and if his/her pulse-rate is greater than zero. I hate McDonalds. Liam plays all the songs that the Beatles played without a keyboard. At the restaurant I can have cheese with apple or bread or coffee and chocolate with donuts. A program ... FINALLY!! /* hifi(Name, Rms, Tapes, Cds, Turntable, Price) */ hifi(sony, 28, 2,1,1,279). hifi(aiwa, 25, 2,1,1,249). hifi(sanyo,12, 2,3,1,219). hifi(pioneer,40,2,1,0,379). hifi(akai, 12, 2,3,1,379). preferable( Hifi, Price) :- hifi(Name, Rms, Tapes, Cds, Turntable, Price), Rms > 25. preferable( Hifi, Price) :- hifi(Name, Rms, Tapes, Cds, Turntable, Price), Tapes > 1. will_do( Hifi, Price) :- hifi(Name, Rms, Tapes, Cds, Turntable, Price), Tapes > 0. will_do( Hifi, Price) :- hifi(Name, Rms, Tapes, Cds, Turntable, Price), Rms > 10. Program is constructed from : Procedures : set of clauses about the same relation, containing the same predicate in their heads. Price is a shared variable - restricts range. Procedures are : hifi/6 preferable/2 will do/2 The Program constitutes the formal definition of the problem, it is not yet the solution. The solution is what occurs when we ask Prolog a question. preferable( Hifi, Price), Price < 200. no preferable( Hifi, Price), Price < 300. Hifi=sony, Price=279 Hifi=akai, Price=279) Compound Terms and Structures Most real world objects constitute a combination of items or atoms put together. To denote a structure, we chose a functor and its arguments . An example, a menu : lunch( Soft drink, Main meal, Donut, Beverage) eg : lunch( diet coke, pizza, donut, coffee) donut(jam donut, ring donut, choc donut, caramel donut, custard donut) With lunch now becoming a mouthful : lunch( Soft drink, Main meal, donut(jam donut, ring donut, choc donut, caramel donut, custard donut), Beverage). etc ... As structures get more complex, it is usually better to start representing them as Trees , so that the relationships between sub-structures become more clear. More Lists A non-empty list consists of a HEAD and a TAIL . The FIRST ELEMENT is said to be the HEAD of the list and the rest constitutes the TAIL . We can make this explicit, by using the notation, for instance : [1,2,3] = [1 [2,3]] ["One", "Two", "Three"] "One" ["Two","Three"] [145] 145 [] [] undefined undefined [[1,2],[3,4,5],[]] [1,2] [[3,4,5],[]] [a] a [] List is a very important and useful data structure within Prolog, and extensively used. Equating Lists List1 : [X,Y,Z] List2 : [4,5,6] List1 = List2 X=4, Y=5, Z=6 List1 : ["hello"] List2 : [X Y] List1 = List2 X = "hello", Y=[] List1 : [1,2,3,4] List2 : [X,Y Z] List1 = List2 X=1, Y=2, Z=[3,4] List1 : [1,X] List2 : [Y,3] List1 = List2 Y=1, X=3 List Membership member(X,L) member(b,[a,b,c]). One : member(X,[X Tail]). member(X, [Head Tail]) :- member(X, Tail). Two : member(X,[X _]). member(X, [_ Tail]) :- member(X,Tail). member(2,[1,4,2,3,5]). Ist Clause : No match 2nd Clause : Member if member of [4,2,3,5] Ist Clause : Satisfied Hence Answer = yes Alternate List Representation Possible to represent lists like other Prolog structures using a special functor '.' (dot). .(Head, Tail) For instance, a list like : [miles, evans, holliday, parker, getz] can be expressed as : .(miles, .(evans, .(holliday, .(parker, .(getz,[]))))) The dot notation for internal representation List = [ a, b, c, d Tail ] then extend Tail to Tail = [ e Tail1 ] List = [a, b,c,d,e Tail1] Hence, arbitary extension of lists. Recursive clause A rule defined in terms of itself. i.e. t :- t1,t2, ..., tn where t and atleast one ti have the same functor and arity ancestor(Ancestor, Person) :- parent(Parent, Person), ancestor(Ancestor, Parent). (tail recursion) ancestor(Ancestor, Person) :- parent(Ancestor, Person). (base case) Make head and tail of the following : [X [Y]] [[ a,b,c d],e [ f,g X]] [ a [ b [ c [d]]]] Similarly with lists : list_length([],0). list_length([H T], N) :- list_length(T,N1), N is N1+1. This can be explained as : Length of an empty list is zero (fact) Since each list is composed of a head and a tail, the length of a list is the length of the tail plus one element (the head) i.e. Length of list(L) = length of (H T), L is divided into a head and tail, Length of (H T) = Length of T + 1 The recursive use of the list length relationship allows the length to be calculated. Each time, we are adding on one element (the head) to our calculation. So, how do Prolog programs work then? Given a program and a query , one wants to know if the program can satisfy the query. Based on the resolution principle , at the heart of which lies the process of unification Unification Given 2 terms A and B , determine whether they are equal (not necessarily identical, but involving assignment of values to variables). if A and B are constant, then they match if and only if they are identical If A is a variable and B anything else, theny they match by A becoming instantiated to B. Similarly, if A is anything and B is a variable. if A and B are compound terms, then they match if they have the same main functor (arity must be the same) ; - all their corresponding components match in a pair wise manner, by reapplying the algorithm Examples Q : test(a, X) = test( Y, b) A : X = b, Y = a (this is a unifier (substitution of variables) Q : test(a, X) = test(Y, b) A : no Q : test(a,X) = test(Y, f(Z)) A : X = f(Z), Y = a Q : X = f(X) A : error - term too deep a variable being instantiated by a compound term containing its argument If matching does not succeed, Prolog backtracks , but if successfully done, it produces the most general instantiation of variables Prolog works by defining the problem in a declarative way - this is easier for us, as it more closely resembles our method of thinking, however, Prolog solves a problem using the procedural style nice :- warm. nice :- sunny, not_windy. warm :- temperature( T), T > 20. not_windy :- wind_speed( S), S > 5. sunny. temperature(15). wind_speed( 3). To prove that it is nice, it must first be proved that it is sunny and then that it is not windy or To satisfy the goal nice, first satisfy the goal sunny, and then not windy - Procedural meaning. Prolog tries to match - done by instantiating a variable Backtracking ensures that if a solution exists to a goal, it is found, and if more than one solution exists then they are all found. Consider the hifi example to see how multiple results were obtained The query (question) is a conjunction of atoms or compound terms - also called the goal (if more than one conjunct exists, they are refered to as the subgoals ) The subgoals are satisfied (i.e. get a yes or a value solution), from left to right To satisfy a subgoal, look amongst the relations declared in the program for one with same functor name and arity, i.e. the head of the clauses are inspected. If no match is found between the required query and the head, the subgoal fails (i.e. answer no) If a relation with the same functor as the subgoal is found, try to unify the subgoal with the head of the relation. If the unification fails, reject this relation and try looking for a second one, i.e. the declarations for a same functor are inspected in top to bottom order The above four steps are repeated until : either no unifiable relation is found, in whcih the subgoal fails answer no . or a unifiable relation is found; the tne values given (instantiated) to the variables in the unifier are transmitted through to the other subgoals (if any) and to the body (if any) of the relation; once this transmission is completed, the body of the relation replaces the subgoal in the query conjunction BEcause of the other subgoals and/or the body being possibly empty, the query conjunction may eventually be empty : success (answer yes or values for initial variables in query) This strategy of left to right, top to bottom is know as depth first with backtracking Variables are binded (instantiated) to values while the computation is going forward and they retain those values (no possibility to reassign values like in C or Pascal) When backtracking takes place because of a failure, the computation (or part of it) is undone and some of the bindings of variables becomes undone. Tracing a Prolog program When we make the query : nice. nice becomes the goal to be satisfied. Next, warm becomes the goal to be satisfied, as warm is the first clause Prolog finds. Prolog again searches the program to find a clause whose head matches the desired goal, warm Two goals are found in the body of the rule to be satisfied : temperature (T) and T > 20 . Prolog attempts to satisfy them left to right. When fact temperature(15) is encountered, Prolog tries to satisfy the goal 15 > 20 . This is not possible, so goal fails and Prolog automatically backtracks to the last goal that was matched, i.e. temperature (T), and tries to perform this match in another way. While backtracking (T) gets uninstantiated. To satisfy the goal temperature (T) , Prolog does not start search from the beginning but continues from the clause where this goal was matched last. It starts with the fact temperature (15), and searches for another clause with head of the same name (temperature). = it fails. Prolog again automatically backtracks to the last goal that was successfully matched i.e. to the goal warm . Now it tries to find an alternative clause whose head would match this goal. Search continues from the point where the last match occured, and not from the beginning. Since another clause for warm cannot be found, Prolog backtracks to nice A new clause is now found !! Execution is now performed as above, with the goal to be satisfied now being sunny and not windy . The goal sunny is satisfied by matching it with the fact sunny. Similarly the goal not windy is matched with the relevant clause Now, the two goals to be satisfied are wind speed(S) and S < 5, which are compared with the fact wind speed(3) and the goal 3 < 5, which is the final goal The execution of a Prolog program is therefore non-deterministic because of multiple execution paths. Of course, if all procedures in a program consisted of only one clause, then only one execution path would exist The closed world assumption Prolog program as a set of axioms (as facts and rules) from which we can prove theorems (get answer to questions) using logical deductive reasoning We state a theorem and Prolog tries to prove it (derive it) from the given axioms (program). Hence, the concept of Prolog as a theorem prover . Useful to draw search trees to understand the operation of Prolog in backtracking - Graphical representations always prefered. Lab buy( Person, Thing) :- needs( Person, Thing), price( Thing, Price), can_pay( Person, Price). price(cornflakes,2). price(frosties,3). price(branflakes,2). price(chocolate_cake,1). needs(antonia, frosties). needs(mark, branflakes). can_pay(antonia,4). can_pay(mark,2). Queries : buy(mark,frosties) buy(mark, ) The ladder rule Everytime a ladder encountered, go down it , and to the right as far as possible (still going down any ladder encountered) If can't go further right, remember the current 'floor', climb back up to the top and keep on going right If something fails, backtrack - i.e. go back to last ladder encountered; go down it to the next floor, after the one last visited, and then back up to the right Rules of Execution of Prolog programs Put all goals in the query into a list of goals to be satisfied When all goals are satisfied, execution stops Take first goal (left most), and search program in a top-down manner until a clause whose head matches the goal is satisfied If such a clause exists : Make a variant of the clause Match the head of the variant with the goal Put Goals from the body of the variant at the beginning of the list of goals to be satisfied - go to 3 If such a clause does not exist : Uninstantiate all the variables that were instantiated in the last matching Return to the last successfully matched goal (climbing up the ladder) Search for another clause whose head matches the goal and go to 4 If the no previously matched goals criteria in (4) above can be satisfied, then the goals in question cannot be satisfied, and execution stops Forcing Backtracking miles(sketches_of_spain) miles(a_kind_of_blue) If Prolog is asked miles( X) it will answer with : X = sketches of spain However, we may be interested in obtaining alternate answers To obtain another answer, we force Prolog to invoke backtracking Prolog continues execution by failing the last goal that was satisfied and by backtracking as in normal execution - to find another clause whose head matches goal Hence : miles( X) it will answer with : X = sketches of spain X = a kind of blue no Different types of equality X = Y (X is equal to Y, if X and Y match) X == Y (X is literally equal to Y, if X and Y are identical) X = Y (X is not literally equal to Y - for arbitrary terms X and Y) X =:= Y (the value of X equals the value of Y) X = Y (the value of X is not equal to the value of Y) X is Y (if X matches the value of Y, where X is a variable or a constant, and Y is an arithmetic expression) Membership member1( X, [ X _]). member1( X, [ _ Tail]) :- member1( X, Tail). member2( X, [ _ Tail]) :- member2( X, Tail). member2( X, [ X _]). Consider the execution traces for each, when presented with : member1( 2,[ 1,2,3,4]) member2( 2,[ 1,2,3,4]) Which is better ? Q : holiday( Student), party( Student) A : jane no more solutions Search Tree for this Mamma's and Pappa's ancestor(X,A) :- parent(X,A). ancestor(X,A) :- parent(P,X), ancestor(P,A). parent(a,b). parent(b,c). Q : ancestor(X,A) A : X = b, A = a X = c, A = b, X = c, A = a no more solutions If the ancestor relation is defined differently : ancestor(X,A) :- ancestor(P, A), parent(P,X). ancestor(X,A) :- parent(A,X). parent(a,b). parent(b,c). Q : ancestor(X,A) A : (WAIT!) What is happening in this case ? Is computation taking place, or are we in a loop ? Golden Rules of recursion Declare the BASE CASE(S) of a recursion relation BEFORE the recursive case(s). Make sure that the recursive call within the body of the relation will have arguments that differ from the head of the relation at the moment of execution This depends on the type of arguments used in the goal, e.g. in the last query (ancestor) - only had variables as arguments Dealing with NOT In one of the examples we looked at : nice :- sunny, not_windy. This is really cheating How do we represent the not case Use the built in procedure not with one argument (not/1) So the goal, not(windy) succeeds if the goal windy fails It is possible that the goal is composed of sub-goals , for instance : not((windy, cold;hot)). although the arity is still 1 : goals are combined using and , or primitives Not : implements negation as the failure of proving that the goal is true Prolog assumes that everything defined in a program, or what can be derived from it is true : else : everything false - this is the closed world assumption . Hence, not(clever(user)) it answers yes - even though there is no rule about the user If I have the simple database of facts : tel(james, 465676). tel(mark, 332312). tel(helen, 766786). Then we can pose questions (queries) to Prolog in a number of different ways : tel(mark, N) N = 332312 yes tel(helen, 766786) yes tel(Name, 766786) Name = helen yes tel(Name,Num) Name=james Num=465676 ; Name=mark Num= 332312; ... no Hence, the idea of obtaining information, using the reverse way. For instance, in arithmetic : X is 2 + 18 / 5 X = 5.6 cannot say 5.6 is A + B / C however X = 2 + 18 / 5 and A + B / C = 2 + 5 / 6 A = 2 B = 5 C = 6 Similarly, the use of the predicate not also prevents using procedures in different ways. We can, for instance, use the procedure has_no_children(X) :- not( child(_,X)). only to check whether a certain person has no children, but cannot use it to find these people. An additional condition has to be introduced into the rule, to force X to be instantiated before executing the not( child( ,X)) goal. Hence : has_no_children(X) :- person(X), not( child( _,X)). In this case, the order of the rules is also important Want to define a relation better , for which, better(X,Y) is true if X finished the race before Y X is also better than Y, if X reached the winning post before Z, and Z reached the winning post before Y Could be numerous others between X and Y Need a more general model Need to consider two main cases better(X,Y) :- before(X,Y). better(X,Y) :- before(X,Z), better(Z,Y). before(tom, tim). before(tim, jack). before(jack, jim). before( jim,john). Recursive procedure - with a base case and a general definition Recursive Arithmetic Consider the definition of check numbers from a previous lecture. Another important definition, is of the factorial function : 0! = 1 n! = n*(n-1)! factorial(0,1). factorial(N,F) :- N > 0, N1 is N-1, factorial(N1, F1), F is N * F1. Again, the boundary condition is given first, followed by the definition of the rule The first check is on the input arguments, and validates the calling arguments the repeated call to factorial is then made with a slightly smaller parameter Possible to extend the definition of our racers with the use of a third argument, which encapsulates time - therefore better(X,Y,T) :- before(X,Y,T). better(X,Y,T) :- before(X, Z, T1), better(Z, Y, T2), T is T1 + T2. Ordering in the 3rd goal above is important, because T cannot be evaluated before T1 and T2 have been instantiated We can also perform other arithmetic operations to achieve more statistics about the race, done in the same way as the second definition of better Back to Lists Lists are a recursive data structures Since in a list, the composition is of a head and a tail, where the tail itself could be a list - hence the concept of recursion comes into the definition Hence : Most operations on lists are defined recursively These include definitions already considered : member to list manipulation operations like concatenating lists , deleting elements from lists etc. Membership again : member(X, [X _]). member(X, [ _ Tail]) :- member(X, Tail). X is a member of a list, if X is the head of the list X is a member of the tail Boundary condition is placed first - and satisfied when X is the first element (head) of the list The recursive call in the second clause searches for an element in the tail of the list that is shorter than the original list. The recursive call successively reduces the size of the list by comparing the head of the list with X, then removing the head, and using the remainder, and taking the first element of the remainder as the new head, comparing with X and so on. This process stops when we are left with tail being the empty list Concatenating Lists (combining two lists together into one) : conc( [], L, L). conc( [X L1], L2, [ X L3 ]) :- conc(L1, L2, L3). L3 is obtained by concatenating L1 and L2 together. It works by first stating the base case : i.e. joining an empty list to any list is the list itself A list obtained by concatenating a list L2 with a list whose head is X and tail L1, is a list whose head is X and tail composed of concatenating L1 and L2. Hence, the new formed list, L3, will also have X as its head Issuing the command : conc( [1,2], [3,4], [1,2,3,4]) will return yes Similarly, a query : conc( [1,2], [3,4], L) will return L = [1,2,3,4] Using Conc for more list functions We can write a procedure for deleting elements from within a list delete( X, List, Result) :- conc( L1, [X L2], List), conc( L1, L2, Result). To delete X from list, X should be found as the head of the second (or right) part of the List This partitions the list into L1 and L2 Result is then obtained by removing X, and concatenating the remained of L2 to L1 Sample query : delete(2, [1,2,3,4], Result) Result = [1,3,4] Similarly, one can insert elements into the list : insert(X, List, Result) :- delete(X, Result, List). How does this work ? Try developing the definition in terms of the conc definition earlier It is also possible to look for an arbitrary sublist within the list, this can again be achieved by using the conc definition earlier. Hence : sublist(List, Sublist) :- conc(_, L1, List), conc( Sublist, _, L1). A query of the form : sublist([1,2,3,4,5,6],[3,4,5]) yes Sublist works by assigning L1 to be Sublist and something else , note the use of the anonymous variable) List is then constructed by combining L1 with some something else as the left part Sublist is therefore the left part of some right segment of List Lists - Use Prolog works by Matching and Searching . This works well with processes like backtracking and recursion that we have looked at A data structure within Prolog which can best exploit these is Lists Lists can be used for the representation of many things : from matrices to compound structures we encountered earlier Learn to get used to thinking in definitions and Lists to use Prolog efficiently Searching Graphs Consider the following : The graph is obtained by linking nodes via edges A directed graph is one where the edges also have direction (usually called arcs) The graph above can be described, by simply stating the interconnections : arc(a,c). arc(a,b). arc(c,a). arc(c,b). arc(c,d). Also, we can define a simple procedure which evaluates to true if a path between two given nodes can be found : path(X,Y) :- arc(X,Y). path(X,Y) :- arc(X,Z), path(X,Z). What does this definition tell us? First rule says that a path between X and Y exists, if an arc can be found between X and Y in the database Second rule says that a path exists between X and Y, if a series of arcs (intermediate nodes Z) can be obtained from X to Y BUT If issued the query : path(a,d) Prolog goes into an infinite loop, because of the presence of the cycle between a and c, hence we have to change our definition to overcome this problem So how do we do this ? path(X,Y) :- path(X,Y, []). path(X,Y,_) :- arc(X,Y). path(X,Y,Trail) :- arc(X,Z), not(member(Z,Trail)), path(Z,Y,[X Trail]). what does this do ? In the first case X is directly connected to Y by a single arc - so the Trail list is empty This is defined by the first two rules. The use of the anonymous variable suggests that whatever the Trail, if a direct arc exists - thats fine Third rule uses an indirection, by considering an intermediate node, labelled Z - and tries to determine if Z has been examined already or not Notice the use of member definition along with a list definition. The last path statement is used to say that X has already been examined This prevents the occurrence of cycles and overcomes the problems with the first definition More complex arithmetic manipulation of lists via recursion squares([],[]). squares([ N Tail],[S Stail]) :- S is N*N, squares(Tail, Stail). A procedure for performing a transformation on all elements of a list Gives the square of numbers in a given list First rule : square of an empty list is an empty list Second rule : Input composed of two lists, with each list composed of a head (N for first list and S for second list), and tail (Tail for first list, and Stail for second list) Take the first element of first list and square it First element of second list becomes that result Remove the first element from both lists (as that has now been squared), and perform the same on the remainder of the list i.e. the tail Repeat the process until an empty list is obtained