/* This is a Prolog-readable version of the code in the class prolog notes. */
parent(elizabeth,charles).
parent(philip,charles).
parent(elizabeth,anne).
parent(philip,anne).
parent(elizabeth,andrew).
parent(philip,andrew).
parent(diana,william).
parent(charles,william).
parent(diana,harry).
parent(charles,harry).
female(elizabeth).
male(philip).
male(charles).
female(anne).
male(andrew).
female(diana).
male(william).
female(sarah).
child(X,Y) :- parent(Y,X).
% X is a child of Y if Y is a parent of X.
mother(X,Y) :- parent(X,Y), female(X).
% X is a mother of Y if X is a female parent of Y
father(X,Y) :- parent(X,Y), male(X).
% X is a father of Y if X is a male parent of Y
son(X,Y) :- child(X,Y), male(X).
% X is a son of Y is X is a male child of Y
daughter(X,Y) :- child(X,Y), female(X).
% X is a daughter of Y if X is a female child of Y.
sibling(X,Y) :- parent(Z,X), parent(Z,Y).
/* A sibling is someone with the same parent */
close_relation(X,Y) :- child(X,Y).
close_relation(X,Y) :- sibling(X,Y).
close_relation(X,Y) :- parent(X,Y).
/* A close relation is either a child, or a sibling, or a parent. */
/* Recursive definition of ancestor */
ancestor(X,X).
ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y).
/* Test membership of element X in list L. If X is input unbound, then this
loops through the elements of L in sequence */
member1(X,L) :- L = [X | REST].
member1(X,L) :- L = [Y | REST], member1(X, REST).
/* More elegant definition of member predicate */
member2(X,[X|_]).
member2(X,[_|REST]) :- member2(X,REST).
/* list_fathers1(L, FATHERS) succeeds if L is a list of people and FATHERS
is the list of the fathers of the people in L. */
list_fathers1(L, FATHERS) :- L = [], FATHERS = [].
list_fathers1(L, FATHERS) :-
L = [FIRSTL | RESTL],
FATHERS = [FIRSTF | RESTF],
father(FIRSTF, FIRSTL),
list_fathers1(RESTL, RESTF).
/* list_fathers2(L,FATHERS) is a more elegant rewriting of list_fathers1. */
list_fathers2([], []).
list_fathers2([FIRST |REST], [FIRSTF| RESTF]) :-
father(FIRSTF,FIRST), list_fathers2(REST,RESTF).
/* append1(L,M,N) succeeds if list N is the appending of lists L and M.
e.g. append1([a,b,c], [d,e,f,g], [a,b,c,d,e,f,g]).
It works by recurring down the elements of L and N. The base case is
where L=[], in which case N = M */
append1(L, M, N) :- L = [], M = N.
append1(L, M, N) :-
L = [X | RESTL], N = [X | RESTN], append1(RESTL, M, RESTN).
/* append2 is a more elegant rewriting of append1 */
append2([], M, M).
append2([X|REST], M, [X|RESTN]) :- append2(REST, M, RESTN).
/* factorial(N, FACT) computes FACT to be N factorial. */
factorial(0,1).
factorial(N,FACT) :- N > 0, M is N - 1, factorial(M,MF), FACT is MF * N.
/* nth_element(L,N,X) succeeds if X is the Nth element of list L. */
nth_element([X|_], 1, X).
nth_element([_|REST],N,X) :- N > 1, M is N-1, nth_element(REST,M,X).
/* unparent(X,Y) succeeds if X is not a parent of Y. Note that for this
to work properly, both X and Y must be bound. */
unparent(X,Y) :- \+parent(X,Y).
/* intersect1(L,M,N) is an attempt to write a predicate which computes the
intersection of lists L and M. This code, however, is buggy. After
first computing the correct intersection, on subsequent backtrackings
it returns all subsets of the intersection. */
intersect1([],M,[]).
intersect1([X|L],M,[X|I]) :- member2(X,M), intersect1(L,M,I).
intersect1([_|L],M,I) :- intersect1(L,M,I).
/* intersect2(L,M,N) is the corrected version of intersect1. It returns
only the correct intersection of L and M, by making sure that if the
second rule applies, the third rule does not. */
intersect2([],M,[]).
intersect2([X|L],M,[X|I]) :- member2(X,M), intersect2(L,M,I).
intersect2([X|L],M,I) :- \+member2(X,M), intersect2(L,M,I).
/* Illustrates the use of the cut operator to ensure that only one
rule is invoked for a given query. */
locomotion(X,swim) :- inst(X, whale), !.
locomotion(X,swim) :- inst(X, seal), !.
locomotion(X,fly) :- inst(X, bat), !.
locomotion(X,run) :- inst(X, mammal), !.
locomotion(X,run) :- inst(X, ostrich), !.
locomotion(X,swim) :- inst(X, penguin), !.
locomotion(X,fly) :- inst(X, bird), !.
locomotion(X,swim) :- inst(X, fish).
inst(wally,whale).
inst(cathy,cow).
inst(X,mammal) :- inst(X,whale).
inst(X,mammal) :- inst(X,cow).
/* A second, and better, way to write a correct intersection operator.
Note the use of the cut operator in the second rule, to make sure that
if the second rule succeeds, then the third rule does not. */
intersect3([], M, []).
intersect3([X | RL], M, [X | RI]) :-
member2(X,M), !, intersect3(RL, M, RI).
intersect3([_ | RL], M, I) :-
intersect3(RL, M, I).
/* mult_list(L,N) multiplies the numbers in L together to compute the product
in N. If 0 is encountered in L, then 0 is returned without further
computation. Note the use of the cut operator in the second rule. Without
that cut operator, if 0 were encountered, the predicate would first
return 0 immediately, and then, on backtracking, proceed with the
multiplication and return 0 again. */
mult_list([],1).
mult_list([0 | _], 0) :- !.
mult_list([X |RL], N) :-
mult_list(RL,N1), N is X * N1.
/* Illustrates the use of the cut/fail construct to create exceptions.
If X is an ostrich, a penguin, or dead, then return "no" X cannot fly;
else, if X is a bird, succeed. */
can_fly(X) :- inst(X,ostrich), !, fail.
can_fly(X) :- inst(X,penguin), !, fail.
can_fly(X) :- dead(X), !, fail.
can_fly(X) :- inst(X, bird).
/* factorize(N,L) binds L to be the list of prime factors of N. */
factorize(1, []) :- !.
factorize(N, [FACT | REST_FACTS]) :-
find_factor(N,FACT,2), N1 is N div FACT, factorize(N1, REST_FACTS).
/* find_factor(N,FACT,LOW) returns the smallest factor of N greater
than or equal to LOW. */
find_factor(N,FACT,FACT) :- R is N mod FACT, R = 0, !.
find_factor(N,FACT,LOW) :-
N1 is LOW+1, N1 =< N, find_factor(N,FACT,N1).
/* assign1(V,VALUE) has the side effect of assigning V to have value
VALUE. The value can be retrieved by calling ``value\_of(V,X).'' */
assign1(V,VALUE) :-
( retract(value_of(V,_)); true),
asserta(value_of(V,VALUE)).
/* display_children(X) prints out all the children of X. It uses backtracking
to achieve the looping. */
display_children(X) :- parent(X,C), nl, write(C), fail.
display_children(_).
/* copy_children(X,Y) makes all the children of X to be also children of Y. */
copy_children(X,Y) :- parent(X,C), assertz(parent(Y,C)), fail.
copy_children(_,_).