Here are some useful links:
http://www.doc.gold.ac.uk/~mas02gw/prolog_tutorial/prologpages/lists.htmlTo execute any prolog program (test.pl) -- first install "xsb" for linux which is free or any other version of it.
http://www.anselm.edu/homepage/mmalita/culpro/index.html
http://www.anselm.edu/homepage/mmalita/culpro/index.html
http://kti.mff.cuni.cz/~bartak/prolog/genealogy.html
http://www.engin.umd.umich.edu/CIS/course.des/cis479/prolog/matrix.pro
Then on the command line --------
? ['test'] ------- will compile the program.
Here is a lecture series from one of these links:
Lecture 1
Program 1.1
likes(max, julia).
Program 1.2
likes(max, julia).
likes(max, amabel).
Program 1.3 - a definition of jealousy
likes(max, julia).
likes(max, amabel).
jealous(Jealous, Victim) :-
likes(Person, Jealous),
likes(Person, Victim).
Lecture 2
Program 2.1
lives_in(max, london).
likes(max, amabel).
child(charles, amy, brian).
price(template, 3, 4.75).
assembly(arm, joint(ball, 3)).
Program 2.2
lives_at(brian, boxgrave_rd).
lives_at(mandy, boxgrave_rd).
neighbours(Pers1, Pers2) :-
lives_at(Pers1, Road),
lives_at(Pers2, Road).
Program 2.3
pass(Pass_Mark) :-
module_pass(Mod_Pass),
module_no(Mod_No),
Pass_Mark is Mod_Pass * Mod_No.
% number of modules to be completed
module_no(6).
% individual module pass mark
module_pass(40).
friend_of(max, julia).
friend_of(max, amabel).
friend_of(amabel, richard).
% etc
% 1
friend(Pers, Friend) :-
friend_of(Pers, Friend).
% 2
friend(Pers, Friend) :-
friend_of(Pers, Inter),
friend(Inter, Friend).
Lecture 3
Program 3.1 - inefficient factorial
% 1 - "Input" number is 0
factorial(0, _, 1).
% 2 - base when all args unify
factorial(Numb, Numb, Numb).
% 3 - singly recursive
factorial(Numb, Count, Answ) :-
% don't count past Numb
Count < Numb,
% increment Count
Count1 is Count + 1,
% calculate Count1!
factorial(Numb, Count1, Answ1),
% calculate Count!
Answ is Answ1 * Count.
% factorial/2 calls factorial/3
factorial(Numb, Result) :-
factorial(Numb, 1, Result).
Program 3.2 - fibonacci numbers - not used in 2002/03
% 1 - terminating
fibonacci(1, 1).
% 2 - terminating
fibonacci(2, 1).
% 3 - doubly recursive
fibonacci(Numb, Fib) :-
Numb > 2,
Numb1 is Numb - 1,
Numb2 is Numb - 2,
fibonacci(Numb1, Fib1),
fibonacci(Numb2, Fib2),
Fib is Fib1 + Fib2.
Program 3.3 - displaying a binary tree
display_label(Label, Offset) :-
tab(Offset),
write(Label),
nl.
% 1 - boundary
display_tree(nil, _Offset).
% 2 - recursive
display_tree(bt(Left, Label, Right), Offset) :-
Offset1 is Offset + 5,
display_tree(Left, Offset1),
display_label(Label, Offset),
display_tree(Right, Offset1).
Program 3.4 - efficient factorial
factorial(Numb, Answ) :-
factorial(Numb, 1, 1, Answ).
% 1 - Number is 0
factorial(0, _, _, 1).
% 2 - Number is 2
factorial(Numb, Numb, Answ, Answ).
% 3 - recursive
factorial(Numb, Count, Answ0, Answ) :-
Numb > Count,
Count1 is Count + 1,
Answ1 is Answ0 * Count1,
factorial(Numb, Count1, Answ1, Answ).
Lecture 4
Program 4.1 - graph search
path(a,1).
path(a,3).
path(1,2).
path(1,4).
path(2,5).
path(3,4).
path(4,5).
% 1 - boundary
route(Start, End) :-
path(Start, End).
% 2 - recursive
route(Start, End) :-
path(Start, Via),
route(Via, End).
Program 4.2 - finding the length of a list
% 1 - terminating
len_of_list([], Length, Length).
% 2 - recursive
len_of_list([_Head|Tail], Length1, Length) :-
Length2 is Length1 + 1,
len_of_list(Tail, Length2, Length).
Program 4.3 - is an element a member of a list?
% 1 - terminating
memb(Elem, [Elem|_]).
% 2 - recursive
memb(Elem, [_|Tail]) :-
memb(Elem, Tail).
Program 4.4 - finding the element at the nth position in a list
% 1 - recursive
nth(Count, Item, [_|Tail]) :-
Count > 1,
Count0 is Count - 1,
nth(Count0, Item, Tail).
% 2 - terminating
nth(1, Head, [Head|_]).
Program 4.5 - appending two lists to make a third - or splitting a list into two lists
% 1 - terminating
app([], List, List).
% 2 - recursive
app([Head|L1], L2, [Head|L3]) :-
app(L1, L2, L3).
Program 4.6 - deleting an element from a list - an extension of memb/2 that also inserts an item into a list
% 1 - terminating
delete(Head, [Head|Tail], Tail).
% 2 - recursive
delete(Item, [Head|Tail], [Head|New_Tail]) :-
delete(Item, Tail, New_Tail).
Lecture 5
Program 5.1 - pairing items from two lists
/* ************************************************ */
/* */
/* pair/3 */
/* Summary: List 3 is pairs of items from */
/* Lists 1 & 2. */
/* Arg 1: List. */
/* Arg 2: List. */
/* Arg 3: List. */
/* Author: P J Hancox */
/* Date: 29 October 1998 */
/* */
/* ************************************************ */
% 1 - terminating 1
pair([], [Head|Tail], [Head|Tail]).
% 2 - terminating 2
pair(List, [], List).
% 3 - recursive
pair([Head1|Tail1], [Head2|Tail2],
['<', Head1, Head2, '>'|Tail3]) :-
pair(Tail1, Tail2, Tail3).
Program 5.2 - deleting an element from a list - an extension of memb/2 that also inserts an item into a list. Also used in Lecture 4
/* ************************************************ */
/* */
/* delete/3 */
/* Summary: Arg 3 is Arg 2 with an instance of */
/* Arg 1 deleted. */
/* Arg 1: Term. */
/* Arg 2: List. */
/* Arg 3: List. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
% 1 - terminating
delete(Head, [Head|Tail], Tail).
% 2 - recursive
delete(Item, [Head|Tail], [Head|New_Tail]) :-
delete(Item, Tail, New_Tail).
Program 5.3 - flattens a list
/* ************************************************ */
/* */
/* flatten/2 */
/* Summary: Arg 2 is Arg 1 with all items */
/* extracted from sublists: eg */
/* | ?-flatten([[a,b],e,[[f]]],R). */
/* R = [a,b,e,f] ? ; */
/* no */
/* Arg 1: List. */
/* Arg 2: List. */
/* Author: P J Hancox */
/* Date: 29 October 1999 */
/* */
/* ************************************************ */
% 1 - terminating
flatten([], []).
% 2 - recursive
flatten([Item|Tail1], [Item|Tail2]) :-
\+ is_a_list(Item),
flatten(Tail1, Tail2).
% 3 - recursive
flatten([Item|Tail1], List2) :-
is_a_list(Item),
flatten(Item, List1),
flatten(Tail1, Tail2),
app(List1, Tail2, List2).
/* ************************************************ */
/* */
/* app/3 */
/* Summary: True if Arg 3 is Arg 2 appended to */
/* Arg 1. */
/* Arg 1: List. */
/* Arg 2: List. */
/* Arg 3: List. */
/* Author: P J Hancox */
/* Date: 29 October 1999 */
/* */
/* ************************************************ */
% 1 - terminating
app([], List, List).
% 2 - recursive
app([Head|List1], List2, [Head|List3]) :-
app(List1, List2, List3).
/* ************************************************ */
/* */
/* is_a_list/1 */
/* Summary: True if Arg1 is instantiated and a */
/* list. */
/* Arg 1: List. */
/* Author: P J Hancox */
/* Date: 29 October 1999 */
/* */
/* ************************************************ */
is_a_list(List) :-
nonvar(List),
is_a_list1(List).
/* ************************************************ */
/* */
/* is_a_list1/1 */
/* Summary: True if Arg1 unifies with an empty */
/* list or a list with a head and tail. */
/* Arg 1: List. */
/* Author: P J Hancox */
/* Date: 29 October 1999 */
/* */
/* ************************************************ */
% 1 - list is empty
is_a_list1([]).
% 2 - list has > 0 members
is_a_list1([_|_]).
Program 5.4 - reversing a list - inefficiently
/* ************************************************ */
/* */
/* reverse_naive/2 */
/* Summary: True if Arg2 is Arg 1 in reverse */
/* order. */
/* Arg 1: List. */
/* Arg 2: List. */
/* Author: P J Hancox */
/* Date: 29 October 1999 */
/* */
/* ************************************************ */
% 1 terminating
reverse_naive([], []).
% 2 recursive
reverse_naive([Head|Tail1], Reversed) :-
reverse_naive(Tail1, Tail2),
app(Tail2, [Head], Reversed).
Program 5.5 - reversing a list - efficiently
/* ************************************************ */
/* */
/* reverse_acc/2 */
/* Summary: True if Arg2 is Arg 1 in reverse */
/* order. */
/* Arg 1: List. */
/* Arg 2: List. */
/* Author: P J Hancox */
/* Date: 29 October 1999 */
/* */
/* ************************************************ */
% 1
reverse_acc(List, Tsil) :-
reverse_acc(List, [], Tsil).
/* ************************************************ */
/* */
/* reverse_acc/3 */
/* Summary: True if Arg3 is Arg 1 in reverse */
/* order. */
/* Arg 1: List. */
/* Arg 2: List. */
/* Arg 3: List. */
/* Author: P J Hancox */
/* Date: 29 October 1999 */
/* */
/* ************************************************ */
% 1 terminating condition
reverse_acc([], Reversed, Reversed).
% 2 recursive
reverse_acc([Head|Tail], Rest, Reversed) :-
reverse_acc(Tail, [Head|Rest], Reversed).
Lecture 6
Program 6.1 - classifying a list into vowels and consonants.
/* ************************************************ */
/* */
/* vowel/1 */
/* Summary: True if Arg1 is a vowel. */
/* Arg 1: Letter. */
/* Author: P J Hancox */
/* Date: 30 October 2002 */
/* */
/* ************************************************ */
vowel(a).
vowel(e).
vowel(i).
vowel(o).
vowel(u).
/* ************************************************ */
/* */
/* classify/3 */
/* Summary: Classifies a list of letters into two */
/* lists: vowels and consonants. */
/* Arg 1: List of letters. */
/* Arg 2: List of vowels. */
/* Arg 3: List of consonants. */
/* Author: P J Hancox */
/* Date: 30 October 2002 */
/* */
/* ************************************************ */
% 1 - terminating
classify([], [], []).
% 2 - recursive: letter is a vowel
classify([Vowel|Tail], [Vowel|Vowel_Tail], Non_Vowels) :-
vowel(Vowel),
classify(Tail, Vowel_Tail, Non_Vowels).
% 3 - recursive: letter is a consonant
classify([Non_Vowel|Tail], Vowels, [Non_Vowel|Non_Vowel_Tail]) :-
classify(Tail, Vowels, Non_Vowel_Tail).
Program 6.2 - buggy version of member/2 to show singleton variables
/* ************************************************ */
/* */
/* member/2 */
/* Summary: True if Arg1 occurs in Arg2. */
/* Arg 1: Term. */
/* Arg 2: List. */
/* Author: P J Hancox */
/* Date: 30 October 2002 */
/* */
/* ************************************************ */
% 1 - terminating
member(Head, [Heda|_]).
% 2 - recursive
member(Elem, [_|Tail]) :-
member(Elem, Tail).
Lecture 7
Program 7.1 - a simple course database program
semester2_1 -->
mod, mod, mod, mod,
prog_option,
options2_1.
options2_1 -->
option.
options2_1 -->
elective.
mod --> [sem222].
mod --> [sem236].
mod --> [sem240].
mod --> [sem232a].
prog_option --> [sem241].
prog_option --> [sem242].
elective --> [comm271].
option --> [sem227].
option --> [sem2a2].
Program 7.2 - a simple course database program that checks the name of the student
semester2_1(Student) -->
mod(Student),
mod(Student),
mod(Student),
mod(Student),
prog_option(Student),
options2_1(Student).
options2_1(Student) -->
option(Student).
options2_1(Student) -->
elective(Student).
mod(james) --> [sem222].
mod(james) --> [sem236].
mod(james) --> [sem240].
mod(james) --> [sem232a].
prog_option(james) --> [sem242].
elective(james) --> [comm271].
option(ben) --> [sem227].
Program 7.3 - a simple course database program that checks the name of the student and calculates a total mark
semester2_1(Student, Total_Mark) -->
mod(Student, Mark1),
mod(Student, Mark2),
mod(Student, Mark3),
mod(Student, Mark4),
prog_option(Student, Mark5),
options2_1(Student, Mark6),
{ Total_Mark is Mark1 + Mark2 + Mark3 +
Mark4 + Mark5 + Mark6 }.
options2_1(Student, Mark) -->
option(Student, Mark).
options2_1(Student, Mark) -->
elective(Student, Mark).
mod(james, 57) --> [sem222].
mod(james, 53) --> [sem236].
mod(james, 62) --> [sem240].
mod(james, 55) --> [sem232a].
prog_option(james, 95) --> [sem242].
elective(james, 68) --> [comm271].
option(ben, 54) --> [sem227].
Program 7.4 - a demonstration of how to build a structure representiong an object.
This technique is often used to represent syntactic structure in grammar but can equally well work for other things. This example is the structure of a door.
doors(door(Panel, Hinges, Lock)) -->
hinges(Hinges),
door_panel(Panel),
lock(Lock).
hinges(hinge(brass, 3)) -->
[hinge].
hinges(hinge(steel, 2)) -->
[hinge].
door_panel(panel(white)) -->
[panel].
door_panel(panel(wood_effect)) -->
[panel].
lock(lock(yale)) -->
[lock].
Program 7.5 - a DCG for a Noun Phrase that will not terminate
np(np(NP1, NP2)) -->
np(NP1),
noun(NP2).
np(np(Det)) -->
det(Det).
det(det(the)) --> [the].
noun(noun(car)) --> [car].
Program 7.6 - a DCG for a Noun Phrase that will terminate because of the use of modified functors
np(np(NP1, NP2)) -->
np1(NP1),
noun(NP2).
np1(np(Det)) -->
det(Det).
det(det(the)) --> [the].
noun(noun(car)) --> [car].
Program 7.7 - a DCG for a Noun Phrase that will terminate because of the use of an history list
np(np(NP1, NP2), History0, History, S0, S) :-
\+ memb(entry(np, S0), History0),
np(NP1, [entry(np, S0)|History0], History1, S0, S1),
noun(NP2, [entry(noun, S1)|History1], History, S1, S).
np(np(Det), History0, History) -->
det(Det, History0, History).
det(det(the), History, History) --> [the].
noun(noun(car), History, History) --> [car].
% 1 - terminating
memb(Elem, [Elem|_]).
% 2 - recursive
memb(Elem, [Head|Tail]) :-
\+ (Elem = Head),
memb(Elem, Tail).
Program 7.8 - a DCG for a Noun Phrase that will terminate because of the use of a limited history list
np(np(NP1, NP2), History0, History, S0, S) :-
\+ memb(entry(np, S0), History0),
np(NP1, [entry(np, S0)|History0], History1, S0, S1),
noun(NP2, [entry(noun, S1)|History1], History, S1, S).
np(np(Det), History0, History) -->
det(Det, History0, History).
det(det(the), _History, []) --> [the].
noun(noun(car), _History, []) --> [car].
Program 7.9 - a DCG version of sum_sublist/3
sum_sublist(Elem, List, Sum) :-
find_sublist(Elem, List, Sublist),
sum(Elem, 0, Sum, Sublist, _).
% 1 - terminating
find_sublist(Elem) -->
[Elem].
% 2 - recursive
find_sublist(Elem) -->
[Head],
{ \+ (Head = Elem)},
find_sublist(Elem).
% 1 - terminating
sum(0, Sum, Sum) --> [].
% 2 - recursive
sum(Count, Sum, Sum2) -->
[Head],
{ Sum1 is Sum + Head,
Count1 is Count - 1},
sum(Count1, Sum1, Sum2).
Lecture 8
Program 8.1 - appending two lists to make a third - or splitting a list into two lists
/* ************************************************ */
/* */
/* app/3 */
/* Summary: True if Arg 3 is Arg 2 appended to */
/* Arg 1. */
/* Arg 1: List. */
/* Arg 2: List. */
/* Arg 3: List. */
/* Author: P J Hancox */
/* Date: 29 October 1999 */
/* */
/* ************************************************ */
% 1 - terminating
app([], List, List).
% 2 - recursive
app([Hd|L1],L2,[Hd|L3]) :-
app(L1, L2, L3).
Program 8.2 - is an element a member of a list?
/* ************************************************ */
/* */
/* memb/2 */
/* Summary: True if Arg1 is in Arg2. */
/* Arg 1: Term. */
/* Arg 2: List. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
% 1 - terminating
memb(Elem, [Elem|_]).
% 2 - recursive
memb(Elem, [_|Tail]) :-
memb(Elem, Tail).
Program 8.3 - updating a count of a letter
/* ************************************************ */
/* */
/* update_count/3 */
/* Summary: Increments Arg3 is Arg1 is "a". */
/* Arg 1: Vowel. */
/* Arg 2: Number (accumulator). */
/* Arg 3: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
% 1 - a
update_count(a, A, A1) :-
A1 is A + 1.
% 2 - not "a"
update_count(Letter, A, A) :-
Letter \== a.
Program 8.4 - inefficient factorial
/* ************************************************ */
/* */
/* fac1/2 */
/* Summary: True if Arg2 is the factorial of */
/* Arg1. */
/* Arg 1: Number. */
/* Arg 2: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
% 1 - terminating
fac1(0, 1).
% 2 - recursive - but goes into infinite recursion
% on backtracking
fac1(N, Factorial) :-
N1 is N - 1,
fac1(N1, Factorial1),
Factorial is N * Factorial1.
Program 8.5 - more efficient factorial - using accumulator
/* ************************************************ */
/* */
/* fac2/2 */
/* Summary: True if Arg2 is the factorial of */
/* Arg1. Calls fac2/3. */
/* Arg 1: Number. */
/* Arg 2: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
fac2(Numb, Fact) :-
fac2(Numb, 1, Fact).
/* ************************************************ */
/* */
/* fac2/3 */
/* Summary: True if Arg3 is the factorial of */
/* Arg1. */
/* Arg 1: Number. */
/* Arg 2: Number (accumulator). */
/* Arg 2: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
% 1 - terminating
fac2(0, Fact, Fact).
% 2 - recursive - but goes into infinite recursion
% on backtracking
fac2(N, Accum, Fact) :-
N1 is N - 1,
tab(N1), write(Accum), nl, % we can output this
Accum1 is N * Accum,
fac2(N1, Accum1, Fact).
Program 8.6 - efficient factorial - using accumulator and if...then...else
/* ************************************************ */
/* */
/* fac3/2 */
/* Summary: True if Arg2 is the factorial of */
/* Arg1. Calls fac3/3. */
/* Arg 1: Number. */
/* Arg 2: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
fac3(Numb, Fact) :-
fac3(Numb, 1, Fact).
/* ************************************************ */
/* */
/* fac3/3 */
/* Summary: True if Arg3 is the factorial of */
/* Arg1. Uses if...then...else. */
/* Arg 1: Number. */
/* Arg 2: Number (accumulator). */
/* Arg 2: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
fac3(N, Accum, Fact) :-
( N > 0 ->
N1 is N - 1,
Accum1 is N * Accum,
fac3(N1, Accum1, Fact)
; N =:= 0 ->
Accum = Fact
).
Program 8.7 - maximum of two numbers with a green cut
/* ************************************************ */
/* */
/* max1/3 */
/* Summary: True if Arg3 is the maximum of Arg1 */
/* or Arg2. Works correctly. */
/* Arg 1: Number. */
/* Arg 2: Number. */
/* Arg 2: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
max1(X, Y, X) :-
X >= Y, !. % green cut
max1(X, Y, Y) :-
X < Y.
Program 8.8 - maximum of two numbers with a red cut - gives incorrect results
/* ************************************************ */
/* */
/* max2/3 */
/* Summary: True if Arg3 is the maximum of Arg1 */
/* or Arg2. Works incorrectly because */
/* it allows max2(2,1,1). */
/* Arg 1: Number. */
/* Arg 2: Number. */
/* Arg 2: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
max2(X, Y, X) :-
X >= Y, !.
max2(_X, Y, Y).
Program 8.9 - maximum of two numbers using if...then...else
/* ************************************************ */
/* */
/* max3/3 */
/* Summary: True if Arg3 is the maximum of Arg1 */
/* or Arg2. Works correctly. Uses */
/* if...then...else. Not used in */
/* lecture. */
/* Arg 1: Number. */
/* Arg 2: Number. */
/* Arg 2: Number. */
/* Author: P J Hancox */
/* Date: 22 October 1999 */
/* */
/* ************************************************ */
max3(X, Y, Z) :-
( X >= Y ->
X = Z
; X <>
Y = Z
).
Lecture 9
Program 9.1 - a rule base for defining relationships between parents, children and siblings
The logical inference maker requires rules to work.
% The following must be present - but they are better
% placed in the inference engine.
:- op(400, xfx, if).
:- op(300, xfy, and).
/* ************************************************ */
/* */
/* Rules of inference */
/* */
/* ************************************************ */
father(Father, Child) if
parent(Father, Child) and
male(Father).
mother(Mother, Child) if
parent(Mother, Child) and
female(Mother).
child(Child, Parent) if
parent(Parent, Child).
sibling(Sibling1, Sibling2) if
father(Father, Sibling1) and
father(Father, Sibling2) and
mother(Mother, Sibling1) and
mother(Mother, Sibling2) and
not_equals(Sibling1, Sibling2).
brother(Brother, Sibling) if
sibling(Brother, Sibling) and
male(Brother).
sister(Sister, Sibling) if
sibling(Sister, Sibling) and
female(Sister).
step_sibling(Sibling1, Sibling2) if
father(Father1, Sibling1) and
father(Father2, Sibling2) and
mother(Mother, Sibling1) and
mother(Mother, Sibling2) and
not_equals(Sibling1, Sibling2) and
not_equals(Father1, Father2).
step_sibling(Sibling1, Sibling2) if
father(Father, Sibling1) and
father(Father, Sibling2) and
mother(Mother1, Sibling1) and
mother(Mother2, Sibling2) and
not_equals(Sibling1, Sibling2) and
not_equals(Mother1, Mother2).
step_brother(Brother, Sibling) if
step_sibling(Brother, Sibling) and
male(Brother).
step_sister(Sister, Sibling) if
step_sibling(Sister, Sibling) and
female(Sister).
married(Husband, Wife) if
father(Husband, Child) and
mother(Wife, Child).
Program 9.2 - logical inference by forward chaining
The top-level predicate is go. It then needs to be fed facts, eg:
- male(male).
- female(catherine_of_aragon).
- parent(henry8, mary).
- parent(catherine_of_aragon, mary).
- etc
/* ************************************************ */
/* */
/* Logical inference by forward chaining */
/* Taken from: Gazdar, G. and Mellish, C. */
/* Natural Language Processing in Prolog. */
/* Addison-Wesley, 1989. pp 333-339. */
/* */
/* ************************************************ */
:- op(400, xfx, if).
:- op(300, xfy, and).
:- dynamic(fact/1).
/* ************************************************ */
/* */
/* go/0 */
/* Summary: Runs inference engine. Slightly */
/* adapted from Gazdar & Mellish, p 337. */
/* Author: P J Hancox */
/* Date: 3 December 1999 */
/* */
/* ************************************************ */
go :-
write('Input something: '),
read(Fact),
nl,
add(Fact, 'user input'),
go.
/* ************************************************ */
/* */
/* find_new_consequences/1 */
/* Summary: Finds all new facts inferable from */
/* Arg 1. Based on Gazdar & Mellish's */
/* predicate of the same name, but */
/* doesn't rely of fail/0. */
/* Arg 1: Fact, eg mother(ann, elizabeth). */
/* Author: P J Hancox */
/* Date: 3 December 1999 */
/* */
/* ************************************************ */
find_new_consequences(Fact) :-
findall(new_facts(Theorem, Premises),
(Theorem if Premises,
select(Fact, Premises, Remainder),
all_facts(Remainder)),
New_Facts),
add_new_facts(New_Facts).
/* ************************************************ */
/* */
/* add_new_facts/1 */
/* Summary: Add each new fact to the database. */
/* Arg 1: List of facts. */
/* Author: P J Hancox */
/* Date: 3 December 1999 */
/* */
/* ************************************************ */
% 1- terminating
add_new_facts([]).
% 2 - recursive
add_new_facts([new_facts(Theorem, Premises)|New_Facts]) :-
add(Theorem, Premises),
add_new_facts(New_Facts).
/* ************************************************ */
/* */
/* all_facts/1 */
/* Summary: True is a conjunction of facts is in */
/* the database. Slightly adapted from */
/* Gazdar & Mellish. */
/* Arg 1: Facts (in form F't or (F't and F'ts)) */
/* Author: P J Hancox */
/* Date: 3 December 1999 */
/* */
/* ************************************************ */
% 1 - terminating
all_facts(Fact) :-
\+ (Fact = (_ and _)),
!, % green cut
fact(Fact).
% 2 - recursive
all_facts(Fact and Facts) :-
fact(Fact),
all_facts(Facts).
/* ************************************************ */
/* */
/* select/3 */
/* Summary: True if Arg1 is contained in Arg2. */
/* Arg3 is Arg2 minus Arg1. */
/* Arg 1: Fact */
/* Arg 2: Facts (in form F't or (F't and F'ts)) */
/* Arg 3: Facts (in form true or (F't and F'ts))*/
/* Author: Gazdar & Mellish, p 336. */
/* */
/* ************************************************ */
% 1 - Arg1 and Arg2 match exactly - return "true"
select(Fact, Fact, true).
% 2 - Arg1 matches head of Arg2 exactly - return
% remainder of Arg2
select(Fact, Fact and Facts, Facts).
% 3 - Arg1 isn't the same as head of Arg2, so
% search in remainder of Arg2
select(Fact1, Fact2 and Facts1, Fact2 and Facts2) :-
select(Fact1, Facts1, Facts2).
/* ************************************************ */
/* */
/* add/2 */
/* Summary: Adds new facts to the database and */
/* makes new inferences and outputs new */
/* inferences. Adapted from Gazdar & */
/* Mellish, p 335. */
/* Arg 1: Fact */
/* Arg 2: Premises */
/* Author: P J Hancox */
/* Date: 3 December 1999 */
/* */
/* ************************************************ */
% 1 - stops program - added by PJH
add(stop, _) :-
abort.
% 2 - fact already exists in the database
add(Fact, _) :-
fact(Fact),
!. % green cut
% 3 - fact doesn't exist in the database
% add to db and make new inferences
add(Fact, Premise) :-
\+ fact(Fact),
assert(fact(Fact)),
tab(5),
write('Adding: '),
write(Fact),
nl,
tab(14),
write('from '),
display_premise(Premise, 14),
find_new_consequences(Fact).
/* ************************************************ */
/* */
/* fact/1 */
/* Summary: Base facts. Adapted from Gazdar & */
/* Mellish, p 336. */
/* Arg 1: true */
/* Author: P J Hancox */
/* Date: 3 December 1999 */
/* */
/* ************************************************ */
fact(true).
fact(equals(X, Y)) :-
nonvar(X),
X == Y. % assumes it never sees a variable.
fact(not_equals(X, Y)) :-
nonvar(X),
X \== Y. % assumes it never sees a variable.
/* ************************************************ */
/* */
/* display_premise/2 */
/* Summary: Displays the facts from which the */
/* inference was made. */
/* Arg 1: Premises */
/* Arg 2: Offset (tab width) */
/* Author: P J Hancox */
/* Date: 3 December 1999 */
/* */
/* ************************************************ */
% 1 - terminating
display_premise(Premise, _Offset) :-
\+ (Premise = (_ and _)),
!, % green cut
display_premise(Premise).
% 2 - recursive
display_premise(Premise and Premises, Offset) :-
display_premise(Premise),
tab(Offset),
write('and '),
display_premise(Premises, Offset).
/* ************************************************ */
/* */
/* display_premise/1 */
/* Summary: Displays a fact from which the */
/* inference was made. */
/* Arg 1: Premise */
/* Author: P J Hancox */
/* Date: 3 December 1999 */
/* */
/* ************************************************ */
display_premise(Premise) :-
write(Premise),
nl.
Program 9.3 - a DCG and associated code to interface with the inference maker.
Grammar and dictionary describe some family relations of the Tudor kings and queens of England.
The top-level predicate is run.. Valid sentences include:
- [henry8, is, male].
- [catherine_of_aragon, is, female].
- [henry8, is, a, parent, of, mary].
- [catherine_of_aragon, is, a, parent, of, mary].
- etc
s(_, _) -->
[stop],
{ abort }.
s(s(NP, VP), VP_Sem) -->
np(NP, NP_Sem),
vp(VP, VP_Sem, NP_Sem).
np(propn('Henry VII'), 'Henry VII') -->
[henry7].
np(propn('Henry VIII'), 'Henry VIII') -->
[henry8].
np(propn('Elizabeth of York'), 'Elizabeth of York') -->
[elizabeth_of_york].
np(propn('Catherine of Aragon'), 'Catherine of Aragon') -->
[catherine_of_aragon].
np(propn('Ann Boleyn'), 'Ann Boleyn') -->
[ann_boleyn].
np(propn('Jane Seymour'), 'Jane Seymour') -->
[jane].
np(propn('Anne of Cleeves'), 'Anne of Cleves') -->
[ann_of_cleeves].
np(propn('Catherine Howard'), 'Catherine Howard') -->
[catherine_howard].
np(propn('Catherine Parr'), 'Catherine Parr') -->
[catherine_parr].
np(propn('Edward VI'), 'Edward VI') -->
[edward].
np(propn('Mary Tudor'), 'Mary') -->
[mary].
np(propn('Elizabeth I'), 'Elizabeth I') -->
[elizabeth].
np(np(Det, Noun), Sem) -->
det(Det),
noun(Noun, Sem).
pp(pp(Prep, NP), Sem) -->
prep(Prep),
np(NP, Sem).
vp(vp(is, Adj_P), Sem, Agent) -->
[is],
adj_phrase(Adj_P, Sem),
{ functor(Sem, _, 1),
arg(1, Sem, Agent) }.
vp(vp(is, NP, PP), Sem, Agent) -->
[is],
np(NP, Sem),
pp(PP, Patient),
{ functor(Sem, _, 2),
arg(1, Sem, Agent),
arg(2, Sem, Patient) }.
adj_phrase(adj_p(NP), Sem) -->
np(NP, Sem).
adj_phrase(adj_p(Adj), Sem) -->
adj(Adj, Sem).
adj(adj(female), female(_)) -->
[female].
adj(adj(male), male(_)) -->
[male].
det(det(a)) -->
[a].
det(det(the)) -->
[the].
noun(noun(parent), parent(_, _)) -->
[parent].
prep(prep(of)) -->
[of].
run :-
write('Input text: '),
read(Text),
nl,
s(Tree, Sem, Text, []),
write('Syntax: '),
write(Tree),
nl,
write('Semantics: '),
write(Sem),
nl,
add(Sem, 'user input'),
nl,
run.
Program 9.4 - code for running pre-prepared examples and two examples.
The top-level predicate is run/1.where the argument is the identifier of a group of queries, eg:
run(Text) :-
write('Input text: '),
write(Text),
nl,
s(Tree, Sem, Text, []),
tab(5),
write('Syntax: '),
write(Tree),
nl,
tab(5),
write('Semantics: '),
write(Sem),
nl,
add(Sem, 'user input'),
nl.
example(Corpus) :-
findall(Text, text(Corpus, Text), Texts),
process_texts(Texts).
process_texts([]).
process_texts([Head|Tail]) :-
run(Head),
process_texts(Tail).
text(1, [henry8, is, male]).
text(1, [henry8, is, a, parent, of, mary]).
text(2, [henry8, is, male]).
text(2, [catherine_of_aragon, is, female]).
text(2, [ann_boleyn, is, female]).
text(2, [catherine_parr, is, female]).
text(2, [elizabeth, is, female]).
text(2, [mary, is, female]).
text(2, [edward, is, male]).
text(2, [henry8, is, a, parent, of, mary]).
text(2, [henry8, is, a, parent, of, elizabeth]).
text(2, [henry8, is, a, parent, of, edward]).
text(2, [catherine_of_aragon, is, a, parent, of, mary]).
text(2, [ann_boleyn, is, a, parent, of, elizabeth]).
text(2, [catherine_parr, is, a, parent, of, edward]).
Lecture 10
Program 10.1 - a Prolog program for solving a puzzle
/* ************************************************ */
/* */
/* board/3 */
/* Arg 1: board as a structured object */
/* Arg 2: board as a list */
/* Arg 3: board as a list of rows, columns */
/* and groups of squares */
/* Summary: Represents the board in several ways */
/* to aid processing. Note the use of */
/* shared variables to ensure that the */
/* instantiation of a variable in one */
/* argument of board/3 instantiates the */
/* all instances of the variable. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
board(square(A1, A2, A3, A4, A5, A6,
B1, B2, B3, B4, B5, B6,
C1, C2, C3, C4, C5, C6,
D1, D2, D3, D4, D5, D6,
E1, E2, E3, E4, E5, E6,
F1, F2, F3, F4, F5, F6),
square([A1, A2, A3, A4, A5, A6,
B1, B2, B3, B4, B5, B6,
C1, C2, C3, C4, C5, C6,
D1, D2, D3, D4, D5, D6,
E1, E2, E3, E4, E5, E6,
F1, F2, F3, F4, F5, F6]),
sizes([ % rows
six(A1, A2, A3, A4, A5, A6),
six(B1, B2, B3, B4, B5, B6),
six(C1, C2, C3, C4, C5, C6),
six(D1, D2, D3, D4, D5, D6),
six(E1, E2, E3, E4, E5, E6),
six(F1, F2, F3, F4, F5, F6),
% columns
six(A1, B1, C1, D1, E1, F1),
six(A2, B2, C2, D2, E2, F2),
six(A3, B3, C3, D3, E3, F3),
six(A4, B4, C4, D4, E4, F4),
six(A5, B5, C5, D5, E5, F5),
six(A6, B6, C6, D6, E6, F6d),
% groups
six(A1, A2, A3, A4, B2, C2),
six(A5, A6, B3, B4, B5, C3),
six(B1, C1, D1, D2, D3, E2),
six(B6, C4, C5, C6, D6, E6),
six(D4, D5, E5, F4, F5, F6),
six(E1, E3, E4, F1, F2, F3)])).
/* ************************************************ */
/* */
/* candidates/1 */
/* Arg 1: list of candidates */
/* Summary: Candidates may be used to fill */
/* squares. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
candidates([1,2,3,4,5,6]).
/* ************************************************ */
/* */
/* solve/0 */
/* Summary: Generates and tests solutions to the */
/* puzzle, outputing successful */
/* solutions. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
solve :-
board(Display_Square, square(Square), sizes(Sixes)),
candidates(Candidates),
generate(Square, Candidates),
display_board(Display_Square),
test(Sixes),
display_board(Display_Square).
/* ************************************************ */
/* */
/* generate/2 */
/* Arg 1: list of squares on the board */
/* Arg 2: list of candidates */
/* Summary: Fills squares on the board to */
/* generate possible solutions. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
% 1 - terminating
generate([], _Candiates).
% 2 - recursive
generate([Square|Squares], Candiates) :-
member(Square, Candiates),
generate(Squares, Candiates).
/* ************************************************ */
/* */
/* test/1 */
/* Arg 1: list of rows, columns and groups of */
/* squares on the board */
/* Summary: Tests lines of six squares to ensure */
/* the squares are unique. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
% 1 - terminating
test([]).
% 2 - recursive
test([Six|Sixes]) :-
test_six(Six),
test(Sixes).
/* ************************************************ */
/* */
/* test/1 */
/* Arg 1: a row, column or group of squares */
/* Summary: Tests line of six squares to ensure */
/* the squares are unique. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
test_six(six(Sq1, Sq2, Sq3, Sq4, Sq5, Sq6)) :-
Sq1 =\= Sq2,
Sq1 =\= Sq3,
Sq1 =\= Sq4,
Sq1 =\= Sq5,
Sq1 =\= Sq6,
Sq2 =\= Sq3,
Sq2 =\= Sq4,
Sq2 =\= Sq5,
Sq2 =\= Sq6,
Sq3 =\= Sq4,
Sq3 =\= Sq5,
Sq3 =\= Sq6,
Sq4 =\= Sq5,
Sq4 =\= Sq6,
Sq5 =\= Sq6.
/* ************************************************ */
/* */
/* display_board/1 */
/* Arg 1: board as a structured object */
/* Summary: Displays the board. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
display_board(Board) :-
display_board(0, Board).
/* ************************************************ */
/* */
/* display_board/1 */
/* Arg 1: counter */
/* Arg 2: board as a structured object */
/* Summary: Displays the board. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
% 1 - terminating
display_board(36, _Board) :-
nl, nl.
% 2 - recursive
display_board(Index, Board) :-
Index < 36,
Index1 is Index + 1,
arg(Index1, Board, Cell),
display_square(Index1, Cell),
display_board(Index1, Board).
/* ************************************************ */
/* */
/* display_square/1 */
/* Arg 1: counter */
/* Arg 2: individual square of the board */
/* Summary: Displays an individual square and, if */
/* it is the 6th square of a row, moves */
/* to a new line. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
display_square(Index, Square) :-
( nonvar(Square) ->
write(' '), write(Square), write(' ')
;
write(' ')
),
( (Index) // 6 =:= (Index)/6 ->
nl
;
true
).
/* ************************************************ */
/* */
/* member/2 */
/* */
/* ************************************************ */
% 1 - terminating
member(Term, [Term|_]).
% 2 - recursive
member(Term, [_|Tail]) :-
member(Term, Tail).
/* ************************************************ */
/* */
/* End of program */
/* */
/* ************************************************ */
Program 10.2 - CLP(R) and Prolog programs for converting Celsius and Fahrenheit
:- ensure_loaded(library(clpr)).
/* ************************************************ */
/* */
/* convert_clpr/2 */
/* Arg 1: temperature in degrees Celsius */
/* Arg 2: temperature in degrees Fahrenheit */
/* Summary: Converts between Celsius and */
/* Fahrenheit. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
convert_clpr(Celsius, Fahrenheit) :-
{ Celsius = (Fahrenheit - 32) * 5 / 9 }.
/* ************************************************ */
/* */
/* convert_pl/2 */
/* Arg 1: temperature in degrees Celsius */
/* Arg 2: temperature in degrees Fahrenheit */
/* Summary: Converts Fahrenheit into Celsius. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
convert_pl(Celsius, Fahrenheit) :-
Celsius is (Fahrenheit - 32) * 5 / 9.
/* ************************************************ */
/* */
/* End of program */
/* */
/* ************************************************ */
Program 10.3 - CLP(FD) program for solving a puzzle
:- ensure_loaded(library(clpfd)).
/* ************************************************ */
/* */
/* board/1 */
/* Arg 1: board as a structured object */
/* Summary: Define the domains of the variables */
/* representing the board; imposes */
/* constraints on these variables; */
/* generates the solutions by */
/* "labelling". */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
board(square(A1, A2, A3, A4, A5, A6,
B1, B2, B3, B4, B5, B6,
C1, C2, C3, C4, C5, C6,
D1, D2, D3, D4, D5, D6,
E1, E2, E3, E4, E5, E6,
F1, F2, F3, F4, F5, F6)) :-
A1 #= 1,
B3 #= 1,
B6 #= 3,
C3 #= 2,
D6 #= 2,
E1 #= 3,
E2 #= 6,
F3 #= 4,
F5 #= 5,
% define the domain - ordered by rows
domain([A1, A2, A3, A4, A5, A6,
B1, B2, B3, B4, B5, B6,
C1, C2, C3, C4, C5, C6,
D1, D2, D3, D4, D5, D6,
E1, E2, E3, E4, E5, E6,
F1, F2, F3, F4, F5, F6], 1, 6),
% impose constraints on rows
all_different([A1, A2, A3, A4, A5, A6]),
all_different([B1, B2, B3, B4, B5, B6]),
all_different([C1, C2, C3, C4, C5, C6]),
all_different([D1, D2, D3, D4, D5, D6]),
all_different([E1, E2, E3, E4, E5, E6]),
all_different([F1, F2, F3, F4, F5, F6]),
% impose constraints on columns
all_different([A1, B1, C1, D1, E1, F1]),
all_different([A2, B2, C2, D2, E2, F2]),
all_different([A3, B3, C3, D3, E3, F3]),
all_different([A4, B4, C4, D4, E4, F4]),
all_different([A5, B5, C5, D5, E5, F5]),
all_different([A6, B6, C6, D6, E6, F6]),
% impose constraints on groups
% groups could be constrained as with rows and columns,
% but this is an alternative (longer) way of imposing constraints
A1 #\= A2, A1 #\= A3, A1 #\= A4, A1 #\= B2, A1 #\= C2,
A2 #\= A3, A2 #\= A4, A2 #\= B2, A2 #\= C2,
A3 #\= A4, A3 #\= B2, A3 #\= C2,
A4 #\= B2, A4 #\= C2,
B2 #\= C2,
A5 #\= A6, A5 #\= B3, A5 #\= B4, A5 #\= B5, A5 #\= C3,
A6 #\= B3, A6 #\= B4, A6 #\= B5, A6 #\= C3,
B3 #\= B4, B3 #\= B5, B3 #\= C3,
B4 #\= B5, B4 #\= C3,
B5 #\= C3,
B1 #\= C1, B1 #\= D1, B1 #\= D2, B1 #\= D3, B1 #\= E2,
C1 #\= D1, C1 #\= D2, C1 #\= D3, C1 #\= E2,
D1 #\= D2, D1 #\= D3, D1 #\= E2,
D2 #\= D3, D2 #\= E2,
D3 #\= E2,
B6 #\= C4, B6 #\= C5, B6 #\= C6, B6 #\= D6, B6 #\= E6,
C4 #\= C5, C4 #\= C6, C4 #\= D6, C4 #\= E6,
C5 #\= C6, C5 #\= D6, C5 #\= E6,
C6 #\= D6, C6 #\= E6,
D6 #\= E6,
D4 #\= D5, D4 #\= E5, D4 #\= F4, D4 #\= F5, D4 #\= F6,
D5 #\= E5, D5 #\= F4, D5 #\= F5, D5 #\= F6,
E5 #\= F4, E5 #\= F5, E5 #\= F6,
F4 #\= F5, F4 #\= F6,
F5 #\= F6,
E1 #\= E3, E1 #\= E4, E1 #\= F1, E1 #\= F2, E1 #\= F3,
E3 #\= E4, E3 #\= F1, E3 #\= F2, E3 #\= F3,
E4 #\= F1, E4 #\= F2, E4 #\= F3,
F1 #\= F2, F1 #\= F3,
F2 #\= F3,
% generate the solution by labelling
labeling([], [A1, A2, A3, A4, A5, A6]),
labeling([], [B1, B2, B3, B4, B5, B6]),
labeling([], [C1, C2, C3, C4, C5, C6]),
labeling([], [D1, D2, D3, D4, D5, D6]),
labeling([], [E1, E2, E3, E4, E5, E6]),
labeling([], [F1, F2, F3, F4, F5, F6]).
/* ************************************************ */
/* */
/* solve/0 */
/* Summary: Constrains and generates solutions to */
/* the puzzle, outputing successful */
/* solutions. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
solve :-
board(Square),
display_board(Square).
/* ************************************************ */
/* */
/* display_board/1 */
/* Arg 1: board as a structured object */
/* Summary: Displays the board. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
display_board(Board) :-
display_board(0, Board).
/* ************************************************ */
/* */
/* display_board/1 */
/* Arg 1: counter */
/* Arg 2: board as a structured object */
/* Summary: Displays the board. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
% 1 - terminating
display_board(36, _Board) :-
nl, nl.
% 2 - recursive
display_board(Index, Board) :-
Index < 36,
Index1 is Index + 1,
arg(Index1, Board, Cell),
display_square(Index1, Cell),
display_board(Index1, Board).
/* ************************************************ */
/* */
/* display_square/1 */
/* Arg 1: counter */
/* Arg 2: individual square of the board */
/* Summary: Displays an individual square and, if */
/* it is the 6th square of a row, moves */
/* to a new line. */
/* Author: P J Hancox */
/* Date: 27 November 2004 */
/* */
/* ************************************************ */
display_square(Index, Square) :-
( nonvar(Square) ->
write(' '), write(Square), write(' ')
;
write(' ')
),
( (Index) // 6 =:= (Index)/6 ->
nl
;
true
).
/* ************************************************ */
/* */
/* End of program */
/* */
/* ************************************************ */
No comments:
Post a Comment