Prolog Örnekleri | Prolog Examples

Lecture 1


Program 11

likes(max, julia)

Program 12

likes(max, julia)
likes(max, amabel)

Program 13 - a definition of jealousy

likes(max, julia)
likes(max, amabel)

jealous(Jealous, Victim) :-
likes(Person, Jealous),
likes(Person, Victim)

Lecture 2


Program 21

lives_in(max, london)
likes(max, amabel)
child(charles, amy, brian)
price(template, 3, 475)
assembly(arm, joint(ball, 3))

Program 22

lives_at(brian, boxgrave_rd)
lives_at(mandy, boxgrave_rd)

neighbours(Pers1, Pers2) :-
lives_at(Pers1, Road),
lives_at(Pers2, Road)

Program 23

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 31 - 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 32 - 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 33 - 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 34 - 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 41 - 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 42 - 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 43 - is an element a member of a list?

% 1 - terminating
memb(Elem, [Elem|_])
% 2 - recursive
memb(Elem, [_|Tail]) :-
memb(Elem, Tail)

Program 44 - 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 45 - 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 46 - 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 51 - 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 52 - 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 53 - 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 54 - 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 55 - 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 61 - 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 62 - buggy version of member/2 to show singleton variables

<div align="left"> /* ************************************************ */
/* */
/* 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 71 - 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 72 - 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 73 - 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 74 - 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 75 - 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 76 - 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 77 - 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 78 - 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 79 - 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 81 - 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 82 - 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 83 - 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 84 - 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 85 - 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 86 - efficient factorial - using accumulator and ifthenelse

/* ************************************************ */
/* */
/* 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 ifthenelse */
/* 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 87 - 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 88 - 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 89 - maximum of two numbers using ifthenelse

/* ************************************************ */
/* */
/* max3/3 */
/* Summary: True if Arg3 is the maximum of Arg1 */
/* or Arg2 Works correctly Uses */
/* ifthenelse 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 ->
Y = Z
)

Lecture 9



Program 91 - 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 92 - 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

To stop the program, type stop

/* ************************************************ */
/* */
/* 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 93 - 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

To stop the program, enter [stop]


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 94 - code for running pre-prepared examples and two examples

The examples are based on the family relations of the Tudor kings and queens of England No guarantee is given of accuracy as the examples have been devised from memory - in the absence of a suitable family tree
The top-level predicate is run/1where the argument is the identifier of a group of queries, eg:

• | ?- run(1)

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 101 - 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 102 - 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 103 - 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 */
/* */
/* ************************************************ */

Kaynak ( Source ): 06-02630 Software Workshop Prolog - Example programs