The Wronk [Last Update 2002.11.20]

Matthew Wronka
<wronkm@rpi.edu>

Lists and Recursion in Prolog

Recursion in Prolog

In programming, there are often times when we wish to execute portions of our code over and over again. Programming languages may achieve this by doing loops or recursion. In Prolog, recursion is the way!

In Prolog, recursion is a concept of repeately asking the same query at the end of a rule until a base case is satisfied. A few examples may clarify this.

Example 1:

talk(chirac).                                          /* base case */
talk(Person1) :- translate(Person1,Language,Person2),  /*recursive case */
                 talk(Person2).
translate(bush, english, tom).
translate(tom, spanish, john).
translate(john, french, chirac).

?- talk(bush).

In this example, we are trying to find out if there is a way for someone to talk to the French President Chirac (assume that he only speaks French). The first fact we see there is the base case for our recursion. Obviously, Chirac can talk to himself. So, if the query is talk(chirac), it will succeed. The second is the recursive rule. We know this rule is recursive because it query itself (with a different parameter) at the end. This rule determines if here is a person who can speak with a second person and this person can inturn have a way to speak to Chirac. The rest of the facts are just sentances stating which two people can communicate and what language they use to communicate.

To trace though the recursion steps, we made a query to find out if there is a way for Bush to talk to Chirac.

Step 1:
talk(bush) -- The first fact fails because bush does not unify with chirac. When it comes to the recursive rule, bush unifies with Person 1, and the first subgoal translate(bush, Language, Person2) can succeed when we unify Lanugage with english and Person2 with tom. Now, our concern is to see if the second subgoal talk(tom) can be satisfy.

Step 2:
talk(tom) -- The first fact failed again for the same reason. However, for the recursive rule, tom is able to unifie with Person1. Right now, we see the pattern of the recursion. We will need to perform the same procedure as we did in Step 1. The first subgoal translate(tom, Lanugage, Person2) is satisfied by unifying lanuage with spanish and Person2 with john. The second subgoal became talk(john) which awaits to be satisfy. And here we go on with our recursion again.

Step 3:
talk(john) -- The first fact failed again. At the recursive rule john and Person1 unifies. The first subgoal translate(john, Language, Person2) is satisfied with Lanugauge = french and Person2 = Chirac. The second subgoal becomes talk(chirac).

Step 4:
talk(chirac) -- The first fact, our base case succeed. This then satisfy the subgoal talk(john) in step3 which inturn satisfy the subgoal talk(tom) in step2 and which inturn satisfy the goal talk(bush) in step 1. Therefore, the query succeed!

Example 2:

sameRow(X,Y) :- sitNextTo(X,Y).  /* base case */
sameRow(X,Y) :- sitNextTo(X,Z),  /* recursive case */
                sameRow(Z,Y).
sitNextTo(arron,betty).
sitNextTo(betty,cindy).
sitNextTo(cindy,david).
sitNextTo(david,edwin).

?- sameRow(arron,david).

The purpose of this program is to see if person X is sitting at the same row as person Y. X is sitting at the same row as Y if they are sitting next to each other or X is sitting next to some people who is sitting next to Y. The first case is captured by the first rule which is our base case, and the second case is capture by the second rule, which is our recursive case. Let's now trace the program with the query provided.

Step 1:
sameRow(arron,david) -- Base case unifies X with arron and Y with david. However, it failed because there is no fact or rule that can make sitNextTo(arron,david) ture. Then we comes to the recursive case. It unifies X with arron, Y with david and Z with betty. In which case sitNextTo(arron,bettey) succeed. And we recursively query sameRow(betty,david).

Step2:
sameRow(betty,david) -- Base case failed. Recursive case makes the following unification X=betty, Y=david, Z=cindy. The first subgoal of the recursive case satisfied by the fact sitNextTo(betty,cindy). And we recursively makes the query sameRow(cindy,david).

Step3:
sameRow(cindy,david) -- Base case succeed with X=cindy and Y=david. This inturn makes the subgoal sameRow(betty,david) in step2 succeed, which then makes the goal sameRow(arron,david) in step1 succeed.

Charateristics of recursion

  1. Need a base case to signify the place to stop.
  2. The recursive case has the same query (with different parameters) as a subgoal.

Excercise

  1. Given the following code segments, are they recursive?
      a) read(last).
         read(X) :- next(X,Y),
                    read(Y).
      b) eat(cat,fish).
         eat(X,Y):- tasty(X,Y),
                    swallow(Y).
    

    Answers
  2. There are 5 siblings range from the oldest to the youngest:


    (Eldest) tom > mary > joyce > john > tim (Youngest).
    Given any two of the siblings, write a recursive program that can determine if the first sibling is older than the second sibling.

       ie. ?- older(tom, joyce).
           yes
           ?- older(joyce, tom).
           no
    

    Answer

Lists in Prolog

List Unification

A list is a common data-structure in many programming lanuguages. It is like a container that holds a group of related data. The following is an example of a list in Prolog.

[a,b,c,d,e,f]

The members of this list are a, b, c, d, e and f. They are each seperated by a comma, and are enclosed in square brackets []. More examples of lists are :

[23,43,-3,8,-10] /* list of integers */
[lion, elephant, tiger] /* list of animals */
[ [a,b],[c],[d,e,f] ] /* list of lists */
[] /* an empty list */

It's often useful to be able to seperate the head of a list from the rest of the list. The way to do this is by using the bar symbol '|'.

For example:
[a,b,c,d,e,f]=[X|Y]
X will unify with a, the head of the list.
Y will unify with [b,c,d,e,f], the rest of the list.

[a,b,c,d,e,f]=[X,Y|Z]
X will unify with a, and Y will unify with b.
Z will unify with the rest of the list [c,d,e,f]

In the case of an emapty list
[]=[X|Y], it will not unify.

In the case where there is only one element in the list
[a]=[X|Y], X will unify with a, and Y will unify with the empty list [].

-------------------------------------------------------------------

Excercise 1: 
Do the following unify?  If yes, state how they unify.
   a) [a,b,c,d,e] and [A,B|C]
   b) [1,2,3,4] and [4|Tail]
   c) [morning,afternoon,evening] and [T1,T2,T3|T]
   d) [Head|[H|Tail]] and [dog,cat,fish,mouse]

-------------------------------------------------------------------

Search in Lists

The fact that lists can store related data can make things nice and easy. But it would be even better if we can search for the item we want in the list, or to see if the item is already in the list.

To perform a search, we need to use the [head|tail] seperation method that we talked about a while ago. The idea is to recursively compare each head to the item we are looking for. If they do not match, then we will discard the current head and compare the item to the next head. Consider the following example:

   find(X,[X|T]).                     /* base case */
   find(X,[NotX|Tail]):-find(X,Tail). /* recursive case */

Since this is recursion, we will need a base case and a recursive case. The base case tells us that we should stop whenever the head matches the item X we are looking for. and the recursive case says that if the head is not X, discard the head and go on with the recusion with the remaining list tail.
To understand this better, let us make a query and trace:

?- find(e,[a,b,c,d,e,f]).

Step 1:
find(e,[a|b,c,d,e,f]) -- as we can see, this does not unify with the base case, yet it unifies with the recursive case where X=e, NotX=a, Tail=[b,c,d,e,f]. The subgoal is to verify if find(e,[b,c,d,e,f]) is true.

Step 2:
find(e,[b|c,d,e,f]) -- This does not unify with the base case either. We will need to keep going until the base case is reached. In this step, X=e, NotX=b, Tail=[c,d,e,f]. The subgoal is to verify if find(e,[c,d,e,f]) is true.

Step 3:
find(e,[c|d,e,f]) -- This again does not unify with the base case. It unifies with the recursive case with X=e, NotX=c, Tail=[d,e,f]. The subgoal is to verify if find(e,[d,e,f]) is true.

Step 4:
find(e,[d|e,f]) -- Base case failed. Recursive unification with X=e, NotX=d, Tail=[e,f]. The subgoal is to verify if find(e,[e,f]) is true.

Step 5:
find(e,[e|f]) -- Base case satisfied with X=e, and T=[f]. This will make all the subgoals in step 2-4 true, which will inturn make the goal in step 1 true.

The above is a case where an item is found. Let us look at a case where an item will not be found.

?- find(e, [a,b,c,d])

Step1-4 basicly resembles step 1-4 in the example above. There is some difference in the subgoal of the 4th step which is to verify that find(e,[]) is true.

Step5:
find(e,[]) -- This does not unify with the first base case, nor does it unify with the recursive case. Recall from the above example that []=[X|Y] do not unify. Therefore, this subgoal failed, and inturn all the recursive subgoals in Step 2-4 will fail and will inturn make the goal or the query find(e,[a,b,c,d]) fail.

Common Operation on Lists

We can perform many useful operation on a list to achieve what we what to do. The most common ones operation on a list is to append (add) and delete.

  1. Append:

    Given two lists, we want to append the first list to the second list and put the result in a third list.
    append([],List,List). /* base case */
    append([H|T],List2,[H|Result]):- append(T,List2,Result). /* recursive case */

    We will trace through the code with an example.
    ?- append([a,b,c],[x,y,z],Result).

    Step 1:
    append([a|b,c],[x,y,z],[a|Result]) -- Base case fails, recursive case unifies: H=a, T=[b,c], List2=[x,y,z]. The subgoal is to verify that append([b,c],[x,y,z],Result) is ture.

    Step 2:
    append([b|c],[x,y,z],[b|Result]) -- Base case fails, recursive case unifies: H=b, T=[c], List2=[x,y,z]. The subgoal is to verify that append([c],[x,y,z],Result) is ture.

    Step 3:
    append([c|[]],[x,y,z],[c|Result]) -- Base case fails, recursive case unifies: H=c, T=[], List2=[x,y,z]. The subgoal is to verify that append([],[x,y,z],Result) is ture.

    Step 4:
    append([],[x,y,z],Result) -- Base case succeeds: List=[x,y,z] and List=Result, which means Result=[x,y,z]. This will inturn makes all the subgoal succeed, and then the main goal succeed. However, lets trace each exits of the recursion and see how the first list got append to List2.

    Step 5:
    Exit, back to step 3: append([c],[x,y,z],[c,x,y,z]) is ture.

    Step 6:
    Exit, back to step 2: append([b,c],[x,y,z],[b,c,x,y,z]) is ture.

    Step 7:
    Exit, back to step 1: append([a,b,c],[x,y,z],[a,b,c,x,y,z]) is ture.
    Therefore, after executing this query, Result will be the list [a,b,c,x,y,z].

  2. Delete:

    Given a list and an item we want to remove from the list, we will recursively seach for the item, and when we find it, we will remove it from the list, and put the final result on a third list.

    delete([],X,[]).   /* base case */
    /* recursive case with the head matching the item */
    delete([X|T],X,Result):-delete(T,X,Result). 
    /* recursive case with the head not matching the item */
    delete([H|T],X,[H|Result]):- H\=X,
                                 delete(T,X,Result).
    

    If the head matches the item we need to delete, we will disregard that head, and do not push it into the Result list. If the head does not match the item we want to delete, we will keep the head, and push it onto the Reslut list. In order to see this more clearly, we will again trace through the code with an example.
    ?- delete([b,b,c],b,Result).

    Step 1:
    delete([b|b,c],b,Result) -- This unifies with the first recursive case. X=b, T=[b,c]. The subgoal is to verify delete([b,c],b,Result).

    Step 2:
    delete([b|c],b,Result) -- This unifies with the first recursive case again. X=b, T=[c]. The subgoal is to verify delete([c],b,Result).

    Step 3:
    delete([c|[]],b,[c|Result]) -- Both the base case and the first recursive case fail for this one. However, it unifies with the second recursive case, where the head does not match the item we need to find. The subgoal is now to verify delete([],b,Result).

    Step 4:
    delete([],b,Reslut) -- While Reslut can unify with [], the base case succeeds. And since the base case succeeds, all the subgoal in step 2 and 3 will succeed, which inturn will make the goal or the query succeed. To see how the Result list is constructed, we will step out of each recursive step.

    Step 5:
    Exit, back to step 3: delete([c],b,[c]) is true.

    Step 6:
    Exit, back to step 2: delete([b,c],b,[c]) is true.

    Step 7:
    Exit, back to step 1: delete([b,b,c],b,[c]) is true.
    Therefore, after executing this query, Result will be the list [c], which is the origional list with all b's deleted.

    Besides appending and deleteing from a list, we can also perform numerical computation on it. The following is an example.

    sum([],0).                          /* base case */
    sum([X|Tail],Sum):- Sum is Tmp+X,   /* recursive case */
                        sum(Tail,Tmp).  
    

    As you may have already guessed, this program will sum the items in each list and put the result in the variable Sum. The operator is will assign the value of each Tmp+X to Sum. We will give an example query and trace this program together.
    ?- sum([2,4,6],Sum).

    Step 1:
    sum([2|4,6],Sum) -- The base case fails since this is not an empty list. The recursive case unifies this with X=2, Tail=[4,6], Sum=Tmp+X. The subgoals are to verify sum([4,6],Tmp).

    Step 2:
    sum([4|6],Sum) -- The base case fails since this is not an empty list. The recursive case unifies this with X=4, Tail=[6], Sum=Tmp+X. The subgoals are to verify sum([6],Tmp).

    Step 3:
    sum([6|[]],Sum) -- The base case fail since this is not an emapty list. The recursive case unifies this with X=6, Tail=[], Sum=Tmp+X. The subgoals are to verify sum([],Tmp).

    Step 4:
    sum([],0) -- The base case succeeds with Tmp=0.

    Step 5:
    Exit, back to step 3: sum([6],6) is true.

    Step 6:
    Exit, back to step 2: sum([4,6],10) is ture.,

    Step 7:
    Exit, back to step 1: sum([2,4,6], 12) is ture.
    Therefore, the query returns with the answer yes, and Sum=12.

List Excercises:

  1. Given the following code:
               find(X,[X|T]).  
               find(X,[notX|Tail]):-find(X,Tail).  

    and the query:
     find(ruler, [pen, pencil, eraser, ruler]).  

    Show the unification in each step and the result of the query.

    Answer.
  2. Given a list of numbers, write a program that puts all the positive numbers in the list name Pos, and put all the negative numbers in the list name Neg.
    ?- sep_posneg([-1,1,2,0,-5,6,-8],Pos,Neg).
    Pos = [1,2,6]
    Neg = [-1,-5,-8]
    
    Answer.
  3. Modify question 1 so that it not only tells if the element is in a list, but it also finds the positon of the element in the list.
    ?- find([10,20,30,40], 30, N).
    N=3
    
    Answer.

Previous: Rules

Home

Me
About Me
Class Schedule
Prospective Employers
Site
About
Front Page
PHP SysInfo
Texts
State of the World
Email Rules
Lasthope
Stuff
People
Projects
My Computers
Old Site
Links
Inflatable Code
The Register
Slashdot
Everything2
Wiretap
Google
CERT

We have met the enemy, and he is us.
		-- Walt Kelly

Copyright ©2000-2002 Matthew Wronka. This page was last modfied Wed, 20 Nov 2002 18:14:57 -0500.
Valid HTML 4.01! Valid CSS! Best viewed with any HTML 4.01 browser Bobby WorldWide Approved 508 Bobby WorldWide Approved AA
Powered by PHP Powered by Apache Powered by FreeBSD